module Summoner.Tui.Form
( SummonForm (..)
, KitForm
, mkForm
, getCurrentFocus
, isActive
, recreateForm
) where
import Brick (Padding (Max), Widget, hBox, padRight, str, txt, vBox, vLimit)
import Brick.Focus (focusGetCurrent)
import Brick.Forms (Form, editField, editTextField, formFocus, formState, listField, newForm,
setFieldConcat, setFormConcat, setFormFocus, (@@=))
import Lens.Micro ((^.))
import Summoner.Default (defaultGHC)
import Summoner.GhcVer (parseGhcVer, showGhcVer)
import Summoner.License (LicenseName)
import Summoner.Text (intercalateMap)
import Summoner.Tui.Field (activeCheckboxField, checkboxField, radioField, strField)
import Summoner.Tui.GroupBorder (groupBorder, (|>))
import Summoner.Tui.Kit
import Summoner.Tui.Widget (borderLabel, hArrange, label)
import qualified Brick.Widgets.Center as C
import qualified Data.Text as T
data SummonForm
= UserOwner
| UserFullName
| UserEmail
| ProjectName
| ProjectDesc
| ProjectCat
| ProjectLicense
| CabalField
| StackField
| Lib
| Exe
| Test
| Bench
| CustomPreludeName
| CustomPreludeModule
| Ghcs
| GitHubEnable
| GitHubDisable
| GitHubNoUpload
| GitHubPrivate
| GitHubTravis
| GitHubAppVeyor
deriving (Show, Eq, Ord, Enum, Bounded)
type KitForm e = Form SummonKit e SummonForm
mkForm :: forall e . SummonKit -> KitForm e
mkForm sk = setFormConcat arrangeColumns $ newForm
( groupBorder "User"
[ 2 |> label "Owner " @@= editTextField (user . owner) UserOwner (Just 1)
, 1 |> label "Full name " @@= editTextField (user . fullName) UserFullName (Just 1)
, 2 |> label "Email " @@= editTextField (user . email) UserEmail (Just 1)
]
++ groupBorder "Project"
[ 2 |> label "Name " @@= editTextField (project . repo) ProjectName (Just 1)
, 3 |> label "Description " @@= editTextField (project . desc) ProjectDesc (Just 2)
, 2 |> label "Category " @@= editTextField (project . category) ProjectCat (Just 1)
, 4 |> vLimit 3 . label "License " @@= listField (const (fromList $ universe @LicenseName))
maybeLicense widgetList 1 ProjectLicense
]
++ [ checkboxField cabal CabalField "Cabal"
, checkboxField stack StackField "Stack"
]
++ groupBorder "Project Meta"
[ 2 |> checkboxField (projectMeta . lib) Lib "Library"
, 1 |> checkboxField (projectMeta . exe) Exe "Executable"
, 1 |> checkboxField (projectMeta . test) Test "Tests"
, 2 |> checkboxField (projectMeta . bench) Bench "Benchmarks"
, 1 |> strField "Custom prelude"
, 1 |> label "Name " @@= editTextField (projectMeta . preludeName) CustomPreludeName (Just 1)
, 2 |> label "Module " @@= editTextField (projectMeta . preludeModule) CustomPreludeModule (Just 1)
, 2 |> label ("GHC versions: " <> toString (showGhcVer defaultGHC) <> " ") @@=
editField
(projectMeta . ghcs)
Ghcs
(Just 1)
(intercalateMap " " showGhcVer)
(traverse parseGhcVer . words . T.intercalate " ")
(txt . T.intercalate "\n")
id
]
++ groupBorder "GitHub"
[ 2 |> setFieldConcat hArrange . radioField (gitHub . enabled)
[ (True, GitHubEnable, "Enable")
, (False, GitHubDisable, "Disable")
]
, 1 |> activeCheckboxField (gitHub . noUpload) isActive GitHubNoUpload "No upload"
, 1 |> activeCheckboxField (gitHub . private) isActive GitHubPrivate "Private"
, 1 |> activeCheckboxField (gitHub . travis) isActive GitHubTravis "Travis"
, 2 |> activeCheckboxField (gitHub . appVeyor) isActive GitHubAppVeyor "AppVeyor"
]
) sk
where
widgetList :: Bool -> LicenseName -> Widget SummonForm
widgetList p l = C.hCenter $ str $ if p then "[" ++ show l ++ "]" else show l
arrangeColumns :: [Widget SummonForm] -> Widget SummonForm
arrangeColumns widgets =
let (column1, columns2) = splitAt 7 widgets in
let (tools, column2) = splitAt 2 columns2 in
hBox [ vBox $ column1 ++ [borderLabel "Tools" $ padRight Max (hArrange tools)]
, vBox column2
]
isActive :: SummonKit -> SummonForm -> Bool
isActive kit = \case
GitHubNoUpload -> isGitHubEnabled
GitHubPrivate -> isGitHubEnabled && isUploadEnabled
GitHubTravis -> isGitHubEnabled
GitHubAppVeyor -> isGitHubEnabled
_ -> True
where
isGitHubEnabled, isUploadEnabled :: Bool
isGitHubEnabled = kit ^. gitHub . enabled
isUploadEnabled = not $ kit ^. gitHub . noUpload
getCurrentFocus :: Form s e n -> Maybe n
getCurrentFocus = focusGetCurrent . formFocus
recreateForm
:: forall e .
(KitForm e -> KitForm e)
-> KitForm e
-> KitForm e
recreateForm validate kitForm = setFocus $ validate $ mkForm $ formState kitForm
where
setFocus :: KitForm e -> KitForm e
setFocus = maybe id setFormFocus (getCurrentFocus kitForm)