{- |
Copyright: (c) 2018-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Form layout and form fields data types.
-}

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 Relude.Extra.Enum (universe)

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


-- | Form that is used for @new@ command.
data SummonForm
    -- User
    = UserOwner
    | UserFullName
    | UserEmail

    -- Project
    | ProjectName
    | ProjectDesc
    | ProjectCat
    | ProjectLicense

    -- Build tools
    | CabalField
    | StackField

    -- Project Meta
    | Lib
    | Exe
    | Test
    | Bench
    | CustomPreludeName
    | CustomPreludeModule
    | Ghcs

      -- GitHub fields
    | GitHubEnable
    | GitHubDisable
    | GitHubNoUpload
    | GitHubPrivate
    | GitHubActions
    | GitHubTravis
    | GitHubAppVeyor
    deriving stock (Int -> SummonForm -> ShowS
[SummonForm] -> ShowS
SummonForm -> String
(Int -> SummonForm -> ShowS)
-> (SummonForm -> String)
-> ([SummonForm] -> ShowS)
-> Show SummonForm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SummonForm] -> ShowS
$cshowList :: [SummonForm] -> ShowS
show :: SummonForm -> String
$cshow :: SummonForm -> String
showsPrec :: Int -> SummonForm -> ShowS
$cshowsPrec :: Int -> SummonForm -> ShowS
Show, SummonForm -> SummonForm -> Bool
(SummonForm -> SummonForm -> Bool)
-> (SummonForm -> SummonForm -> Bool) -> Eq SummonForm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SummonForm -> SummonForm -> Bool
$c/= :: SummonForm -> SummonForm -> Bool
== :: SummonForm -> SummonForm -> Bool
$c== :: SummonForm -> SummonForm -> Bool
Eq, Eq SummonForm
Eq SummonForm =>
(SummonForm -> SummonForm -> Ordering)
-> (SummonForm -> SummonForm -> Bool)
-> (SummonForm -> SummonForm -> Bool)
-> (SummonForm -> SummonForm -> Bool)
-> (SummonForm -> SummonForm -> Bool)
-> (SummonForm -> SummonForm -> SummonForm)
-> (SummonForm -> SummonForm -> SummonForm)
-> Ord SummonForm
SummonForm -> SummonForm -> Bool
SummonForm -> SummonForm -> Ordering
SummonForm -> SummonForm -> SummonForm
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SummonForm -> SummonForm -> SummonForm
$cmin :: SummonForm -> SummonForm -> SummonForm
max :: SummonForm -> SummonForm -> SummonForm
$cmax :: SummonForm -> SummonForm -> SummonForm
>= :: SummonForm -> SummonForm -> Bool
$c>= :: SummonForm -> SummonForm -> Bool
> :: SummonForm -> SummonForm -> Bool
$c> :: SummonForm -> SummonForm -> Bool
<= :: SummonForm -> SummonForm -> Bool
$c<= :: SummonForm -> SummonForm -> Bool
< :: SummonForm -> SummonForm -> Bool
$c< :: SummonForm -> SummonForm -> Bool
compare :: SummonForm -> SummonForm -> Ordering
$ccompare :: SummonForm -> SummonForm -> Ordering
$cp1Ord :: Eq SummonForm
Ord, Int -> SummonForm
SummonForm -> Int
SummonForm -> [SummonForm]
SummonForm -> SummonForm
SummonForm -> SummonForm -> [SummonForm]
SummonForm -> SummonForm -> SummonForm -> [SummonForm]
(SummonForm -> SummonForm)
-> (SummonForm -> SummonForm)
-> (Int -> SummonForm)
-> (SummonForm -> Int)
-> (SummonForm -> [SummonForm])
-> (SummonForm -> SummonForm -> [SummonForm])
-> (SummonForm -> SummonForm -> [SummonForm])
-> (SummonForm -> SummonForm -> SummonForm -> [SummonForm])
-> Enum SummonForm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SummonForm -> SummonForm -> SummonForm -> [SummonForm]
$cenumFromThenTo :: SummonForm -> SummonForm -> SummonForm -> [SummonForm]
enumFromTo :: SummonForm -> SummonForm -> [SummonForm]
$cenumFromTo :: SummonForm -> SummonForm -> [SummonForm]
enumFromThen :: SummonForm -> SummonForm -> [SummonForm]
$cenumFromThen :: SummonForm -> SummonForm -> [SummonForm]
enumFrom :: SummonForm -> [SummonForm]
$cenumFrom :: SummonForm -> [SummonForm]
fromEnum :: SummonForm -> Int
$cfromEnum :: SummonForm -> Int
toEnum :: Int -> SummonForm
$ctoEnum :: Int -> SummonForm
pred :: SummonForm -> SummonForm
$cpred :: SummonForm -> SummonForm
succ :: SummonForm -> SummonForm
$csucc :: SummonForm -> SummonForm
Enum, SummonForm
SummonForm -> SummonForm -> Bounded SummonForm
forall a. a -> a -> Bounded a
maxBound :: SummonForm
$cmaxBound :: SummonForm
minBound :: SummonForm
$cminBound :: SummonForm
Bounded)

-- | Alias for type of the @summoner@ form.
type KitForm e = Form SummonKit e SummonForm

-- | Creates the input form from the given initial 'SummonKit'.
mkForm :: forall e . SummonKit -> KitForm e
mkForm :: SummonKit -> KitForm e
mkForm sk :: SummonKit
sk = ([Widget SummonForm] -> Widget SummonForm)
-> KitForm e -> KitForm e
forall n s e. ([Widget n] -> Widget n) -> Form s e n -> Form s e n
setFormConcat [Widget SummonForm] -> Widget SummonForm
arrangeColumns (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall a b. (a -> b) -> a -> b
$ [SummonKit -> FormFieldState SummonKit e SummonForm]
-> SummonKit -> KitForm e
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm
    ( String
-> [(Int, SummonKit -> FormFieldState SummonKit e SummonForm)]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
forall s e n.
String
-> [(Int, s -> FormFieldState s e n)]
-> [s -> FormFieldState s e n]
groupBorder "User"
        [ 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "Owner     " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' SummonKit Text
-> SummonForm
-> Maybe Int
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasOwner s a => Lens' s a
owner) SummonForm
UserOwner (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "Full name " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' SummonKit Text
-> SummonForm
-> Maybe Int
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasFullName s a => Lens' s a
fullName) SummonForm
UserFullName (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
        , 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "Email     " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' SummonKit Text
-> SummonForm
-> Maybe Int
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasEmail s a => Lens' s a
email) SummonForm
UserEmail (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
        ]
   [SummonKit -> FormFieldState SummonKit e SummonForm]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
forall a. [a] -> [a] -> [a]
++ String
-> [(Int, SummonKit -> FormFieldState SummonKit e SummonForm)]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
forall s e n.
String
-> [(Int, s -> FormFieldState s e n)]
-> [s -> FormFieldState s e n]
groupBorder "Project"
        [ 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "Name        " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' SummonKit Text
-> SummonForm
-> Maybe Int
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasRepo s a => Lens' s a
repo) SummonForm
ProjectName (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
        , 3 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "Description " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' SummonKit Text
-> SummonForm
-> Maybe Int
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasDesc s a => Lens' s a
desc) SummonForm
ProjectDesc (Int -> Maybe Int
forall a. a -> Maybe a
Just 2)
        , 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "Category    " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' SummonKit Text
-> SummonForm
-> Maybe Int
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasCategory s a => Lens' s a
category) SummonForm
ProjectCat (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
        , 4 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Int -> Widget SummonForm -> Widget SummonForm
forall n. Int -> Widget n -> Widget n
vLimit 3 (Widget SummonForm -> Widget SummonForm)
-> (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm
-> Widget SummonForm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "License " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= (SummonKit -> Vector LicenseName)
-> Lens' SummonKit (Maybe LicenseName)
-> (Bool -> LicenseName -> Widget SummonForm)
-> Int
-> SummonForm
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall s e n a.
(Ord n, Show n, Eq a) =>
(s -> Vector a)
-> Lens' s (Maybe a)
-> (Bool -> a -> Widget n)
-> Int
-> n
-> s
-> FormFieldState s e n
listField (Vector LicenseName -> SummonKit -> Vector LicenseName
forall a b. a -> b -> a
const ([Item (Vector LicenseName)] -> Vector LicenseName
forall l. IsList l => [Item l] -> l
fromList ([Item (Vector LicenseName)] -> Vector LicenseName)
-> [Item (Vector LicenseName)] -> Vector LicenseName
forall a b. (a -> b) -> a -> b
$ (Bounded LicenseName, Enum LicenseName) => [LicenseName]
forall a. (Bounded a, Enum a) => [a]
universe @LicenseName))
              Lens' SummonKit (Maybe LicenseName)
maybeLicense Bool -> LicenseName -> Widget SummonForm
widgetList 1 SummonForm
ProjectLicense
        ]
   -- ++ groupBorder "Tools"
   --      [ 2 |> checkboxField cabal CabalField "Cabal"
   --      , 2 |> checkboxField stack StackField "Stack"
   --      ]
   [SummonKit -> FormFieldState SummonKit e SummonForm]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
forall a. [a] -> [a] -> [a]
++   [ Lens' SummonKit Bool
-> SummonForm
-> Text
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField forall s a. HasCabal s a => Lens' s a
Lens' SummonKit Bool
cabal SummonForm
CabalField "Cabal"
        , Lens' SummonKit Bool
-> SummonForm
-> Text
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField forall s a. HasStack s a => Lens' s a
Lens' SummonKit Bool
stack SummonForm
StackField "Stack"
        ]

   [SummonKit -> FormFieldState SummonKit e SummonForm]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
forall a. [a] -> [a] -> [a]
++ String
-> [(Int, SummonKit -> FormFieldState SummonKit e SummonForm)]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
forall s e n.
String
-> [(Int, s -> FormFieldState s e n)]
-> [s -> FormFieldState s e n]
groupBorder "Project Meta"
        [ 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> SummonForm
-> Text
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> ProjectMeta -> f ProjectMeta)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ProjectMeta -> f ProjectMeta
forall s a. HasLib s a => Lens' s a
lib) SummonForm
Lib "Library"
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> SummonForm
-> Text
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> ProjectMeta -> f ProjectMeta)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ProjectMeta -> f ProjectMeta
forall s a. HasExe s a => Lens' s a
exe) SummonForm
Exe "Executable"
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> SummonForm
-> Text
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> ProjectMeta -> f ProjectMeta)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ProjectMeta -> f ProjectMeta
forall s a. HasTest s a => Lens' s a
test) SummonForm
Test "Tests"
        , 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> SummonForm
-> Text
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> ProjectMeta -> f ProjectMeta)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ProjectMeta -> f ProjectMeta
forall s a. HasBench s a => Lens' s a
bench) SummonForm
Bench "Benchmarks"
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> SummonKit -> FormFieldState SummonKit e SummonForm
forall s e n. String -> s -> FormFieldState s e n
strField "Custom prelude"
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "Name   " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' SummonKit Text
-> SummonForm
-> Maybe Int
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> ProjectMeta -> f ProjectMeta)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> ProjectMeta -> f ProjectMeta
forall s a. HasPreludeName s a => Lens' s a
preludeName) SummonForm
CustomPreludeName (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
        , 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label "Module " (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' SummonKit Text
-> SummonForm
-> Maybe Int
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> ProjectMeta -> f ProjectMeta)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> ProjectMeta -> f ProjectMeta
forall s a. HasPreludeModule s a => Lens' s a
preludeModule) SummonForm
CustomPreludeModule (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
        , 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
label ("GHC versions: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString (GhcVer -> Text
showGhcVer GhcVer
defaultGHC) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " ") (Widget SummonForm -> Widget SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@=
            Lens' SummonKit [GhcVer]
-> SummonForm
-> Maybe Int
-> ([GhcVer] -> Text)
-> ([Text] -> Maybe [GhcVer])
-> ([Text] -> Widget SummonForm)
-> (Widget SummonForm -> Widget SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s a e.
(Ord n, Show n) =>
Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField
                ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> (([GhcVer] -> f [GhcVer]) -> ProjectMeta -> f ProjectMeta)
-> ([GhcVer] -> f [GhcVer])
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GhcVer] -> f [GhcVer]) -> ProjectMeta -> f ProjectMeta
forall s a. HasGhcs s a => Lens' s a
ghcs)
                SummonForm
Ghcs
                (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
                (Text -> (GhcVer -> Text) -> [GhcVer] -> Text
forall a. Text -> (a -> Text) -> [a] -> Text
intercalateMap " " GhcVer -> Text
showGhcVer)
                ((Text -> Maybe GhcVer) -> [Text] -> Maybe [GhcVer]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Maybe GhcVer
parseGhcVer ([Text] -> Maybe [GhcVer])
-> ([Text] -> [Text]) -> [Text] -> Maybe [GhcVer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall t. IsText t "words" => t -> [t]
words (Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate " ")
                (Text -> Widget SummonForm
forall n. Text -> Widget n
txt (Text -> Widget SummonForm)
-> ([Text] -> Text) -> [Text] -> Widget SummonForm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate "\n")
                Widget SummonForm -> Widget SummonForm
forall a. a -> a
id
        ]
   [SummonKit -> FormFieldState SummonKit e SummonForm]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
forall a. [a] -> [a] -> [a]
++ String
-> [(Int, SummonKit -> FormFieldState SummonKit e SummonForm)]
-> [SummonKit -> FormFieldState SummonKit e SummonForm]
forall s e n.
String
-> [(Int, s -> FormFieldState s e n)]
-> [s -> FormFieldState s e n]
groupBorder "GitHub"
        [ 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> ([Widget SummonForm] -> Widget SummonForm)
-> FormFieldState SummonKit e SummonForm
-> FormFieldState SummonKit e SummonForm
forall n s e.
([Widget n] -> Widget n)
-> FormFieldState s e n -> FormFieldState s e n
setFieldConcat [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
hArrange (FormFieldState SummonKit e SummonForm
 -> FormFieldState SummonKit e SummonForm)
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SummonKit Bool
-> [(Bool, SummonForm, Text)]
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n a s e.
(Ord n, Show n, Eq a) =>
Lens' s a -> [(a, n, Text)] -> s -> FormFieldState s e n
radioField ((GitHub -> f GitHub) -> SummonKit -> f SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> f GitHub) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> GitHub -> f GitHub)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> GitHub -> f GitHub
forall s a. HasEnabled s a => Lens' s a
enabled)
            [ (Bool
True, SummonForm
GitHubEnable, "Enable")
            , (Bool
False, SummonForm
GitHubDisable, "Disable")
            ]
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> (SummonKit -> SummonForm -> Bool)
-> SummonForm
-> String
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
Ord n =>
Lens' s Bool
-> (s -> n -> Bool) -> n -> String -> s -> FormFieldState s e n
activeCheckboxField ((GitHub -> f GitHub) -> SummonKit -> f SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> f GitHub) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> GitHub -> f GitHub)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> GitHub -> f GitHub
forall s a. HasNoUpload s a => Lens' s a
noUpload) SummonKit -> SummonForm -> Bool
isActive SummonForm
GitHubNoUpload "No upload"
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> (SummonKit -> SummonForm -> Bool)
-> SummonForm
-> String
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
Ord n =>
Lens' s Bool
-> (s -> n -> Bool) -> n -> String -> s -> FormFieldState s e n
activeCheckboxField ((GitHub -> f GitHub) -> SummonKit -> f SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> f GitHub) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> GitHub -> f GitHub)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> GitHub -> f GitHub
forall s a. HasPrivate s a => Lens' s a
private)  SummonKit -> SummonForm -> Bool
isActive SummonForm
GitHubPrivate  "Private"
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> (SummonKit -> SummonForm -> Bool)
-> SummonForm
-> String
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
Ord n =>
Lens' s Bool
-> (s -> n -> Bool) -> n -> String -> s -> FormFieldState s e n
activeCheckboxField ((GitHub -> f GitHub) -> SummonKit -> f SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> f GitHub) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> GitHub -> f GitHub)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> GitHub -> f GitHub
forall s a. HasActions s a => Lens' s a
actions)  SummonKit -> SummonForm -> Bool
isActive SummonForm
GitHubActions  "GitHub Actions"
        , 1 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> (SummonKit -> SummonForm -> Bool)
-> SummonForm
-> String
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
Ord n =>
Lens' s Bool
-> (s -> n -> Bool) -> n -> String -> s -> FormFieldState s e n
activeCheckboxField ((GitHub -> f GitHub) -> SummonKit -> f SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> f GitHub) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> GitHub -> f GitHub)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> GitHub -> f GitHub
forall s a. HasTravis s a => Lens' s a
travis)   SummonKit -> SummonForm -> Bool
isActive SummonForm
GitHubTravis   "Travis"
        , 2 Int
-> (SummonKit -> FormFieldState SummonKit e SummonForm)
-> (Int, SummonKit -> FormFieldState SummonKit e SummonForm)
forall a. Int -> a -> (Int, a)
|> Lens' SummonKit Bool
-> (SummonKit -> SummonForm -> Bool)
-> SummonForm
-> String
-> SummonKit
-> FormFieldState SummonKit e SummonForm
forall n s e.
Ord n =>
Lens' s Bool
-> (s -> n -> Bool) -> n -> String -> s -> FormFieldState s e n
activeCheckboxField ((GitHub -> f GitHub) -> SummonKit -> f SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> f GitHub) -> SummonKit -> f SummonKit)
-> ((Bool -> f Bool) -> GitHub -> f GitHub)
-> (Bool -> f Bool)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> GitHub -> f GitHub
forall s a. HasAppVeyor s a => Lens' s a
appVeyor) SummonKit -> SummonForm -> Bool
isActive SummonForm
GitHubAppVeyor "AppVeyor"
        ]
    ) SummonKit
sk
  where
    widgetList :: Bool -> LicenseName -> Widget SummonForm
    widgetList :: Bool -> LicenseName -> Widget SummonForm
widgetList p :: Bool
p l :: LicenseName
l = Widget SummonForm -> Widget SummonForm
forall n. Widget n -> Widget n
C.hCenter (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ String -> Widget SummonForm
forall n. String -> Widget n
str (String -> Widget SummonForm) -> String -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ if Bool
p then "[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LicenseName -> String
forall b a. (Show a, IsString b) => a -> b
show LicenseName
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]" else LicenseName -> String
forall b a. (Show a, IsString b) => a -> b
show LicenseName
l

    arrangeColumns :: [Widget SummonForm] -> Widget SummonForm
    arrangeColumns :: [Widget SummonForm] -> Widget SummonForm
arrangeColumns widgets :: [Widget SummonForm]
widgets =
        let (column1 :: [Widget SummonForm]
column1, columns2 :: [Widget SummonForm]
columns2) = Int
-> [Widget SummonForm]
-> ([Widget SummonForm], [Widget SummonForm])
forall a. Int -> [a] -> ([a], [a])
splitAt 7 [Widget SummonForm]
widgets in
        let (tools :: [Widget SummonForm]
tools, column2 :: [Widget SummonForm]
column2) = Int
-> [Widget SummonForm]
-> ([Widget SummonForm], [Widget SummonForm])
forall a. Int -> [a] -> ([a], [a])
splitAt 2 [Widget SummonForm]
columns2 in
        [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
hBox [ [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
vBox ([Widget SummonForm] -> Widget SummonForm)
-> [Widget SummonForm] -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ [Widget SummonForm]
column1 [Widget SummonForm] -> [Widget SummonForm] -> [Widget SummonForm]
forall a. [a] -> [a] -> [a]
++ [String -> Widget SummonForm -> Widget SummonForm
forall n. String -> Widget n -> Widget n
borderLabel "Tools" (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ Padding -> Widget SummonForm -> Widget SummonForm
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max ([Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
hArrange [Widget SummonForm]
tools)]
             , [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
vBox [Widget SummonForm]
column2
             ]

-- | Returns 'True' when form field is active depending on the current state of 'SummonKit'.
isActive :: SummonKit -> SummonForm -> Bool
isActive :: SummonKit -> SummonForm -> Bool
isActive kit :: SummonKit
kit = \case
    GitHubNoUpload -> Bool
isGitHubEnabled
    GitHubPrivate  -> Bool
isGitHubEnabled Bool -> Bool -> Bool
&& Bool
isUploadEnabled
    GitHubActions  -> Bool
isGitHubEnabled Bool -> Bool -> Bool
&& (SummonKit
kit SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool SummonKit Bool
forall s a. HasCabal s a => Lens' s a
cabal)
    GitHubTravis   -> Bool
isGitHubEnabled
    GitHubAppVeyor -> Bool
isGitHubEnabled
    _ -> Bool
True
  where
    isGitHubEnabled, isUploadEnabled :: Bool
    isGitHubEnabled :: Bool
isGitHubEnabled = SummonKit
kit SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GitHub -> Const Bool GitHub) -> SummonKit -> Const Bool SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> Const Bool GitHub)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub
forall s a. HasEnabled s a => Lens' s a
enabled
    isUploadEnabled :: Bool
isUploadEnabled = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SummonKit
kit SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GitHub -> Const Bool GitHub) -> SummonKit -> Const Bool SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> Const Bool GitHub)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub
forall s a. HasNoUpload s a => Lens' s a
noUpload

-- | Gets current focus of the form.
getCurrentFocus :: Form s e n -> Maybe n
getCurrentFocus :: Form s e n -> Maybe n
getCurrentFocus = FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (FocusRing n -> Maybe n)
-> (Form s e n -> FocusRing n) -> Form s e n -> Maybe n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus

{- | Create form from scratch using its current state. This is needed to
activate/deactivate checkboxes. Should be done with care to preserve focus and
fields validation.
-}
recreateForm
    :: forall e .
       (KitForm e -> KitForm e)  -- ^ Validation function
    -> KitForm e  -- ^ Original form
    -> KitForm e  -- ^ New form
recreateForm :: (KitForm e -> KitForm e) -> KitForm e -> KitForm e
recreateForm validate :: KitForm e -> KitForm e
validate kitForm :: KitForm e
kitForm = KitForm e -> KitForm e
setFocus (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall a b. (a -> b) -> a -> b
$ KitForm e -> KitForm e
validate (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall a b. (a -> b) -> a -> b
$ SummonKit -> KitForm e
forall e. SummonKit -> KitForm e
mkForm (SummonKit -> KitForm e) -> SummonKit -> KitForm e
forall a b. (a -> b) -> a -> b
$ KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
kitForm
  where
    setFocus :: KitForm e -> KitForm e
    setFocus :: KitForm e -> KitForm e
setFocus = (KitForm e -> KitForm e)
-> (SummonForm -> KitForm e -> KitForm e)
-> Maybe SummonForm
-> KitForm e
-> KitForm e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe KitForm e -> KitForm e
forall a. a -> a
id SummonForm -> KitForm e -> KitForm e
forall n s e. Eq n => n -> Form s e n -> Form s e n
setFormFocus (KitForm e -> Maybe SummonForm
forall s e n. Form s e n -> Maybe n
getCurrentFocus KitForm e
kitForm)