Кирпичные формы с динамическими полями

Я взял bricks FormDemo.hs, удалил ненужные фрагменты и изменил его оттуда. Код зависит от containers и microlens-ghc. Возможно, есть более чистое решение, но это работает.

Вместо использования типа записи, как обычно, мы используем Map. Важная часть — at, которая дает линзу для нашей карты. Один довольно досадный недостаток заключается в том, что мы получаем Maybe повсюду, но у меня такое ощущение, что мы не сможем избавиться от него типобезопасным способом без зависимых типов.

Еще одним отличием от оригинальной демонстрации является наша специальная функция editMaybeTextField, которая необходима для обработки значений Maybe.

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Data.Text qualified as T
import Lens.Micro (Lens')

import Graphics.Vty qualified as V
import Graphics.Vty.Platform.Unix (mkVty)

import Brick
import Brick.Focus (
    focusRingCursor,
 )
import Brick.Forms (
    Form,
    FormFieldState,
    editField,
    focusedFormInputAttr,
    formFocus,
    formState,
    handleFormEvent,
    invalidFormInputAttr,
    newForm,
    renderForm,
    (@@=),
 )
import Brick.Widgets.Edit qualified as E
import Data.Map
import Data.Maybe (fromMaybe)
import Lens.Micro.GHC (at)

type FieldName = T.Text
type Properties = Map T.Text T.Text

makeFieldLens :: T.Text -> Lens' Properties (Maybe T.Text)
makeFieldLens = at @Properties

mkForm :: [FieldName] -> Properties -> Form Properties e (Maybe T.Text)
mkForm fieldNames =
    let label s w = padBottom (Pad 1) (vLimit 1 $ hLimit 15 $ txt s <+> fill ' ') <+> w
        createField :: FieldName -> Properties -> FormFieldState Properties e (Maybe T.Text)
        createField fieldName = label fieldName @@= editMaybeTextField (makeFieldLens fieldName) (Just fieldName) (Just 1)
     in newForm (fmap createField fieldNames)

editMaybeTextField ::
    (Ord n, Show n) =>
    Lens' s (Maybe T.Text) ->
    n ->
    Maybe Int ->
    s ->
    FormFieldState s e n
editMaybeTextField stLens n limit =
    let ini = fromMaybe ""
        val = Just . Just . T.intercalate "\n"
        renderText = txt . T.intercalate "\n"
     in editField stLens n limit ini val renderText id

theMap :: AttrMap
theMap =
    attrMap
        V.defAttr
        [ (E.editAttr, V.white `on` V.black)
        , (E.editFocusedAttr, V.black `on` V.yellow)
        , (invalidFormInputAttr, V.white `on` V.red)
        , (focusedFormInputAttr, V.black `on` V.yellow)
        ]

draw :: Form Properties e (Maybe T.Text) -> [Widget (Maybe T.Text)]
draw f = [renderForm f]

app :: App (Form Properties e (Maybe T.Text)) e (Maybe T.Text)
app =
    App
        { appDraw = draw
        , appHandleEvent = \ev -> do
            case ev of
                VtyEvent (V.EvKey V.KEsc []) -> halt
                _ -> handleFormEvent ev
        , appChooseCursor = focusRingCursor formFocus
        , appStartEvent = return ()
        , appAttrMap = const theMap
        }

getFieldNames :: IO [T.Text]
getFieldNames = pure ["something", "somethingelse"]

main :: IO ()
main = do
    fieldNames <- getFieldNames

    let buildVty = mkVty V.defaultConfig
        initialValues = fromList (fmap (,"") fieldNames)
        f = mkForm fieldNames initialValues

    initialVty <- buildVty
    f' <- customMain initialVty buildVty Nothing app f
    print $ formState f'