{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE GADTs #-}
module GHCup.Brick.Widgets.Menu where
import qualified GHCup.Brick.Attributes as Attributes
import qualified GHCup.Brick.Common as Common
import Brick
( BrickEvent(..),
EventM,
Widget(..),
(<+>))
import qualified Brick
import qualified Brick.Widgets.Border as Border
import qualified Brick.Widgets.Border.Style as Border
import qualified Brick.Widgets.Center as Brick
import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.Edit as Edit
import Brick.Focus (FocusRing)
import qualified Brick.Focus as F
import Data.Function ( (&))
import Prelude hiding ( appendFile )
import Data.Maybe
import qualified Data.Text as T
import Optics.TH (makeLensesFor)
import qualified Graphics.Vty as Vty
import Optics.State.Operators ((%=), (.=))
import Optics.Optic ((%))
import Optics.State (use, assign)
import GHCup.Types (KeyCombination(..))
import Optics (Lens', to, lens, _1, over)
import Optics.Operators ( (^.), (.~) )
import Data.Foldable (find, foldl')
import Data.List.NonEmpty ( NonEmpty (..) )
import qualified Data.List.NonEmpty as NE
type Formatter n = Bool -> Widget n -> Widget n
type Label = T.Text
type HelpMessage = T.Text
type ButtonName n = n
idFormatter :: Formatter n
idFormatter :: forall n. Formatter n
idFormatter = (Widget n -> Widget n) -> Bool -> Widget n -> Widget n
forall a b. a -> b -> a
const Widget n -> Widget n
forall a. a -> a
id
type ErrorMessage = T.Text
data ErrorStatus = Valid | Invalid ErrorMessage deriving (ErrorStatus -> ErrorStatus -> Bool
(ErrorStatus -> ErrorStatus -> Bool)
-> (ErrorStatus -> ErrorStatus -> Bool) -> Eq ErrorStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorStatus -> ErrorStatus -> Bool
== :: ErrorStatus -> ErrorStatus -> Bool
$c/= :: ErrorStatus -> ErrorStatus -> Bool
/= :: ErrorStatus -> ErrorStatus -> Bool
Eq)
emptyLens :: Lens' s ()
emptyLens :: forall s. Lens' s ()
emptyLens = (s -> ()) -> (s -> () -> s) -> Lens s s () ()
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (() -> s -> ()
forall a b. a -> b -> a
const ()) (\s
s ()
_ -> s
s)
data FieldInput a b n =
FieldInput
{ forall a b n. FieldInput a b n -> b
inputState :: b
, forall a b n. FieldInput a b n -> b -> Either ErrorMessage a
inputValidator :: b -> Either ErrorMessage a
, forall a b n. FieldInput a b n -> ErrorMessage
inputHelp :: HelpMessage
, forall a b n.
FieldInput a b n
-> Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputRender :: Bool
-> ErrorStatus
-> HelpMessage
-> Label
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
, forall a b n. FieldInput a b n -> BrickEvent n () -> EventM n b ()
inputHandler :: BrickEvent n () -> EventM n b ()
}
makeLensesFor
[ ("inputState", "inputStateL")
, ("inputValidator", "inputValidatorL")
, ("inputName", "inputNameL")
, ("inputHelp", "inputHelpL")
]
''FieldInput
data s n where
::
{ ()
fieldAccesor :: Lens' s a
, ()
fieldInput :: FieldInput a b n
, forall s n. MenuField s n -> ErrorMessage
fieldLabel :: Label
, forall s n. MenuField s n -> ErrorStatus
fieldStatus :: ErrorStatus
, forall s n. MenuField s n -> n
fieldName :: n
} -> MenuField s n
isValidField :: MenuField s n -> Bool
isValidField :: forall s n. MenuField s n -> Bool
isValidField = (ErrorStatus -> ErrorStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ErrorStatus
Valid) (ErrorStatus -> Bool)
-> (MenuField s n -> ErrorStatus) -> MenuField s n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuField s n -> ErrorStatus
forall s n. MenuField s n -> ErrorStatus
fieldStatus
makeLensesFor
[ ("fieldLabel", "fieldLabelL")
, ("fieldStatus", "fieldStatusL")
]
''MenuField
data SelectState i n = SelectState
{ forall i n. SelectState i n -> (NonEmpty (Int, (i, Bool)), Bool)
selectStateItems :: (NonEmpty (Int, (i, Bool)), Bool)
, forall i n. SelectState i n -> Maybe (Editor ErrorMessage n)
selectStateEditState :: Maybe (Edit.Editor T.Text n)
, forall i n. SelectState i n -> FocusRing Int
selectStateFocusRing :: FocusRing Int
, forall i n. SelectState i n -> Bool
selectStateOverlayOpen :: Bool
}
makeLensesFor
[ ("selectStateItems", "selectStateItemsL")
, ("selectStateEditState", "selectStateEditStateL")
, ("selectStateFocusRing", "selectStateFocusRingL")
, ("selectStateOverlayOpen", "selectStateOverlayOpenL")
]
''SelectState
data EditState n = EditState
{ forall n. EditState n -> Editor ErrorMessage n
editState :: Edit.Editor T.Text n
, forall n. EditState n -> Bool
editStateOverlayOpen :: Bool
}
makeLensesFor
[ ("editState", "editStateL")
, ("editStateOverlayOpen", "editStateOverlayOpenL")
]
''EditState
data =
{ MenuKeyBindings -> KeyCombination
mKbUp :: KeyCombination
, MenuKeyBindings -> KeyCombination
mKbDown :: KeyCombination
, MenuKeyBindings -> KeyCombination
mKbQuit :: KeyCombination
}
deriving (Int -> MenuKeyBindings -> ShowS
[MenuKeyBindings] -> ShowS
MenuKeyBindings -> String
(Int -> MenuKeyBindings -> ShowS)
-> (MenuKeyBindings -> String)
-> ([MenuKeyBindings] -> ShowS)
-> Show MenuKeyBindings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MenuKeyBindings -> ShowS
showsPrec :: Int -> MenuKeyBindings -> ShowS
$cshow :: MenuKeyBindings -> String
show :: MenuKeyBindings -> String
$cshowList :: [MenuKeyBindings] -> ShowS
showList :: [MenuKeyBindings] -> ShowS
Show)
makeLensesFor
[ ("mKbUp", "mKbUpL")
, ("mKbDown", "mKbDownL")
, ("mKbQuit", "mKbQuitL")
]
''MenuKeyBindings
fieldHelpMsgL :: Lens' (MenuField s n) HelpMessage
fieldHelpMsgL :: forall s n. Lens' (MenuField s n) ErrorMessage
fieldHelpMsgL = (MenuField s n -> ErrorMessage)
-> (MenuField s n -> ErrorMessage -> MenuField s n)
-> Lens (MenuField s n) (MenuField s n) ErrorMessage ErrorMessage
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens MenuField s n -> ErrorMessage
forall s n. MenuField s n -> ErrorMessage
g MenuField s n -> ErrorMessage -> MenuField s n
forall {s} {n}. MenuField s n -> ErrorMessage -> MenuField s n
s
where g :: MenuField s n -> ErrorMessage
g (MenuField {n
ErrorMessage
Lens' s a
FieldInput a b n
ErrorStatus
fieldAccesor :: ()
fieldInput :: ()
fieldLabel :: forall s n. MenuField s n -> ErrorMessage
fieldStatus :: forall s n. MenuField s n -> ErrorStatus
fieldName :: forall s n. MenuField s n -> n
fieldAccesor :: Lens' s a
fieldInput :: FieldInput a b n
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
..})= FieldInput a b n
fieldInput FieldInput a b n
-> Optic' A_Lens NoIx (FieldInput a b n) ErrorMessage
-> ErrorMessage
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (FieldInput a b n) ErrorMessage
forall a b n. Lens' (FieldInput a b n) ErrorMessage
inputHelpL
s :: MenuField s n -> ErrorMessage -> MenuField s n
s (MenuField{n
ErrorMessage
Lens' s a
FieldInput a b n
ErrorStatus
fieldAccesor :: ()
fieldInput :: ()
fieldLabel :: forall s n. MenuField s n -> ErrorMessage
fieldStatus :: forall s n. MenuField s n -> ErrorStatus
fieldName :: forall s n. MenuField s n -> n
fieldAccesor :: Lens' s a
fieldInput :: FieldInput a b n
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
..}) ErrorMessage
msg = MenuField {fieldInput :: FieldInput a b n
fieldInput = FieldInput a b n
fieldInput FieldInput a b n
-> (FieldInput a b n -> FieldInput a b n) -> FieldInput a b n
forall a b. a -> (a -> b) -> b
& Lens' (FieldInput a b n) ErrorMessage
forall a b n. Lens' (FieldInput a b n) ErrorMessage
inputHelpL Lens' (FieldInput a b n) ErrorMessage
-> ErrorMessage -> FieldInput a b n -> FieldInput a b n
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ErrorMessage
msg , n
ErrorMessage
Lens' s a
ErrorStatus
fieldAccesor :: Lens' s a
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
fieldAccesor :: Lens' s a
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
..}
drawField :: Formatter n -> Bool -> MenuField s n -> Widget n
drawField :: forall n s. Formatter n -> Bool -> MenuField s n -> Widget n
drawField Formatter n
amp Bool
focus (MenuField { fieldInput :: ()
fieldInput = FieldInput {b
ErrorMessage
b -> Either ErrorMessage a
Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
BrickEvent n () -> EventM n b ()
inputState :: forall a b n. FieldInput a b n -> b
inputValidator :: forall a b n. FieldInput a b n -> b -> Either ErrorMessage a
inputHelp :: forall a b n. FieldInput a b n -> ErrorMessage
inputRender :: forall a b n.
FieldInput a b n
-> Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputHandler :: forall a b n. FieldInput a b n -> BrickEvent n () -> EventM n b ()
inputState :: b
inputValidator :: b -> Either ErrorMessage a
inputHelp :: ErrorMessage
inputRender :: Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputHandler :: BrickEvent n () -> EventM n b ()
..}, n
ErrorMessage
Lens' s a
ErrorStatus
fieldAccesor :: ()
fieldLabel :: forall s n. MenuField s n -> ErrorMessage
fieldStatus :: forall s n. MenuField s n -> ErrorStatus
fieldName :: forall s n. MenuField s n -> n
fieldAccesor :: Lens' s a
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
..}) =
let (Widget n
input, Maybe (Widget n)
overlay) = Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputRender Bool
focus ErrorStatus
fieldStatus ErrorMessage
inputHelp ErrorMessage
fieldLabel b
inputState (Formatter n
amp Bool
focus)
in case (Bool
focus, Maybe (Widget n)
overlay) of
(Bool
True, Maybe (Widget n)
Nothing) -> n -> Widget n -> Widget n
forall n. n -> Widget n -> Widget n
Common.enableScreenReader n
fieldName (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
Brick.visible Widget n
input
(Bool, Maybe (Widget n))
_ -> Widget n
input
drawFieldOverlay :: MenuField s n -> Maybe (Widget n)
drawFieldOverlay :: forall s n. MenuField s n -> Maybe (Widget n)
drawFieldOverlay (MenuField { fieldInput :: ()
fieldInput = FieldInput {b
ErrorMessage
b -> Either ErrorMessage a
Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
BrickEvent n () -> EventM n b ()
inputState :: forall a b n. FieldInput a b n -> b
inputValidator :: forall a b n. FieldInput a b n -> b -> Either ErrorMessage a
inputHelp :: forall a b n. FieldInput a b n -> ErrorMessage
inputRender :: forall a b n.
FieldInput a b n
-> Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputHandler :: forall a b n. FieldInput a b n -> BrickEvent n () -> EventM n b ()
inputState :: b
inputValidator :: b -> Either ErrorMessage a
inputHelp :: ErrorMessage
inputRender :: Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputHandler :: BrickEvent n () -> EventM n b ()
..}, n
ErrorMessage
Lens' s a
ErrorStatus
fieldAccesor :: ()
fieldLabel :: forall s n. MenuField s n -> ErrorMessage
fieldStatus :: forall s n. MenuField s n -> ErrorStatus
fieldName :: forall s n. MenuField s n -> n
fieldAccesor :: Lens' s a
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
..}) =
(Widget n, Maybe (Widget n)) -> Maybe (Widget n)
forall a b. (a, b) -> b
snd ((Widget n, Maybe (Widget n)) -> Maybe (Widget n))
-> (Widget n, Maybe (Widget n)) -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputRender Bool
True ErrorStatus
fieldStatus ErrorMessage
inputHelp ErrorMessage
fieldLabel b
inputState Widget n -> Widget n
forall a. a -> a
id
instance Brick.Named (MenuField s n) n where
getName :: MenuField s n -> n
getName :: MenuField s n -> n
getName MenuField s n
entry = MenuField s n
entry MenuField s n -> (MenuField s n -> n) -> n
forall a b. a -> (a -> b) -> b
& MenuField s n -> n
forall s n. MenuField s n -> n
fieldName
type CheckBoxField = MenuField
createCheckBoxInput :: FieldInput Bool Bool n
createCheckBoxInput :: forall n. FieldInput Bool Bool n
createCheckBoxInput = Bool
-> (Bool -> Either ErrorMessage Bool)
-> ErrorMessage
-> (Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> Bool
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n)))
-> (BrickEvent n () -> EventM n Bool ())
-> FieldInput Bool Bool n
forall a b n.
b
-> (b -> Either ErrorMessage a)
-> ErrorMessage
-> (Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n)))
-> (BrickEvent n () -> EventM n b ())
-> FieldInput a b n
FieldInput Bool
False Bool -> Either ErrorMessage Bool
forall a b. b -> Either a b
Right ErrorMessage
"" Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> Bool
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
forall {p} {p} {n} {n} {a}.
Bool
-> p
-> ErrorMessage
-> p
-> Bool
-> (Widget n -> Widget n)
-> (Widget n, Maybe a)
checkBoxRender BrickEvent n () -> EventM n Bool ()
forall {n} {e}. BrickEvent n e -> EventM n Bool ()
checkBoxHandler
where
border :: Widget n -> Widget n
border Widget n
w = ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"[" Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
2) Widget n
w) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"]"
drawBool :: Bool -> Widget n
drawBool Bool
b =
if Bool
b
then Widget n -> Widget n
forall n. Widget n -> Widget n
border (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.installedAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
Common.checkBoxSelectedSign
else Widget n -> Widget n
forall n. Widget n -> Widget n
border (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.notInstalledAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
Common.notInstalledSign
checkBoxRender :: Bool
-> p
-> ErrorMessage
-> p
-> Bool
-> (Widget n -> Widget n)
-> (Widget n, Maybe a)
checkBoxRender Bool
focus p
_ ErrorMessage
help p
_ Bool
check Widget n -> Widget n
f = (, Maybe a
forall a. Maybe a
Nothing) (Widget n -> (Widget n, Maybe a))
-> Widget n -> (Widget n, Maybe a)
forall a b. (a -> b) -> a -> b
$
let core :: Widget n
core = Widget n -> Widget n
f (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Widget n
forall {n}. Bool -> Widget n
drawBool Bool
check
in if Bool
focus
then Widget n
core
else Widget n
core Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n)
-> (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsHelpMsg (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage
help)
checkBoxHandler :: BrickEvent n e -> EventM n Bool ()
checkBoxHandler = \case
VtyEvent (Vty.EvKey Key
Vty.KEnter []) -> (Bool -> Bool) -> EventM n Bool ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
Brick.modify Bool -> Bool
not
BrickEvent n e
_ -> () -> EventM n Bool ()
forall a. a -> EventM n Bool a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
createCheckBoxField :: n -> Lens' s Bool -> CheckBoxField s n
createCheckBoxField :: forall n s. n -> Lens' s Bool -> CheckBoxField s n
createCheckBoxField n
name Lens' s Bool
access = Lens' s Bool
-> FieldInput Bool Bool n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
forall s a b n.
Lens' s a
-> FieldInput a b n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
MenuField Lens' s Bool
access FieldInput Bool Bool n
forall n. FieldInput Bool Bool n
createCheckBoxInput ErrorMessage
"" ErrorStatus
Valid n
name
type EditableField = MenuField
createEditableInput :: (Ord n, Show n) => T.Text -> n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (EditState n) n
createEditableInput :: forall n a.
(Ord n, Show n) =>
ErrorMessage
-> n
-> (ErrorMessage -> Either ErrorMessage a)
-> FieldInput a (EditState n) n
createEditableInput ErrorMessage
initText n
name ErrorMessage -> Either ErrorMessage a
validator = EditState n
-> (EditState n -> Either ErrorMessage a)
-> ErrorMessage
-> (Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> EditState n
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n)))
-> (BrickEvent n () -> EventM n (EditState n) ())
-> FieldInput a (EditState n) n
forall a b n.
b
-> (b -> Either ErrorMessage a)
-> ErrorMessage
-> (Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n)))
-> (BrickEvent n () -> EventM n b ())
-> FieldInput a b n
FieldInput EditState n
initEdit EditState n -> Either ErrorMessage a
validateEditContent ErrorMessage
"" Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> EditState n
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
drawEdit BrickEvent n () -> EventM n (EditState n) ()
forall {n} {e}. Eq n => BrickEvent n e -> EventM n (EditState n) ()
handler
where
drawEdit :: Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> EditState n
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
drawEdit Bool
focus ErrorStatus
errMsg ErrorMessage
help ErrorMessage
label (EditState Editor ErrorMessage n
edi Bool
overlayOpen) Widget n -> Widget n
amp = (Widget n
field, Maybe (Widget n)
mOverlay)
where
field :: Widget n
field =
let
borderBox :: Widget n -> Widget n
borderBox Widget n
w = Widget n -> Widget n
amp (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Brick.vLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
forall n. Widget n
Border.vBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight Padding
Brick.Max Widget n
w Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
Border.vBorder)
editorContents :: Widget n
editorContents = ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall a b. (a -> b) -> a -> b
$ [ErrorMessage] -> ErrorMessage
T.unlines ([ErrorMessage] -> ErrorMessage) -> [ErrorMessage] -> ErrorMessage
forall a b. (a -> b) -> a -> b
$ Editor ErrorMessage n -> [ErrorMessage]
forall t n. Monoid t => Editor t n -> [t]
Edit.getEditContents Editor ErrorMessage n
edi
isEditorEmpty :: Bool
isEditorEmpty = Editor ErrorMessage n -> [ErrorMessage]
forall t n. Monoid t => Editor t n -> [t]
Edit.getEditContents Editor ErrorMessage n
edi [ErrorMessage] -> [ErrorMessage] -> Bool
forall a. Eq a => a -> a -> Bool
== [ErrorMessage
forall a. Monoid a => a
mempty]
Bool -> Bool -> Bool
|| Editor ErrorMessage n -> [ErrorMessage]
forall t n. Monoid t => Editor t n -> [t]
Edit.getEditContents Editor ErrorMessage n
edi [ErrorMessage] -> [ErrorMessage] -> Bool
forall a. Eq a => a -> a -> Bool
== [ErrorMessage
initText]
in case ErrorStatus
errMsg of
ErrorStatus
Valid | Bool
isEditorEmpty -> Widget n -> Widget n
borderBox (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsHelpMsg ErrorMessage
help
| Bool
otherwise -> Widget n -> Widget n
borderBox Widget n
editorContents
Invalid ErrorMessage
msg
| Bool
focus Bool -> Bool -> Bool
&& Bool
isEditorEmpty -> Widget n -> Widget n
borderBox (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsHelpMsg ErrorMessage
help
| Bool
focus -> Widget n -> Widget n
borderBox Widget n
editorContents
| Bool
otherwise -> Widget n -> Widget n
borderBox (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsErrMsg ErrorMessage
msg
mOverlay :: Maybe (Widget n)
mOverlay = if Bool
overlayOpen
then Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (ErrorMessage -> Widget n -> Widget n
forall n. ErrorMessage -> Widget n -> Widget n
overlayLayer (ErrorMessage
"Edit " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
label) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
overlay)
else Maybe (Widget n)
forall a. Maybe a
Nothing
overlay :: Widget n
overlay = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
Brick.vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
[ ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txtWrap ErrorMessage
help
, Widget n -> Widget n
forall n. Widget n -> Widget n
Border.border (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ([ErrorMessage] -> Widget n)
-> Bool -> Editor ErrorMessage n -> Widget n
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
Edit.renderEditor (ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt (ErrorMessage -> Widget n)
-> ([ErrorMessage] -> ErrorMessage) -> [ErrorMessage] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrorMessage] -> ErrorMessage
T.unlines) Bool
focus Editor ErrorMessage n
edi
, case ErrorStatus
errMsg of
Invalid ErrorMessage
msg -> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsErrMsg ErrorMessage
msg
ErrorStatus
_ -> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
" "
, Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight Padding
Brick.Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"Press Enter to go back"
]
handler :: BrickEvent n e -> EventM n (EditState n) ()
handler BrickEvent n e
ev = do
(EditState Editor ErrorMessage n
edi Bool
overlayOpen) <- EventM n (EditState n) (EditState n)
forall s (m :: * -> *). MonadState s m => m s
Brick.get
if Bool
overlayOpen
then case BrickEvent n e
ev of
VtyEvent (Vty.EvKey Key
Vty.KEnter []) -> Lens' (EditState n) Bool
forall n. Lens' (EditState n) Bool
editStateOverlayOpenL Lens' (EditState n) Bool -> Bool -> EventM n (EditState n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Bool
False
BrickEvent n e
_ -> Optic
A_Lens
NoIx
(EditState n)
(EditState n)
(Editor ErrorMessage n)
(Editor ErrorMessage n)
-> EventM n (Editor ErrorMessage n) () -> EventM n (EditState n) ()
forall {m :: * -> *} {n :: * -> *} {s} {t} {k} {c} {is :: IxList}.
(Zoom m n s t, Is k A_Lens, Functor (Zoomed m c)) =>
Optic k is t t s s -> m c -> n c
Common.zoom Optic
A_Lens
NoIx
(EditState n)
(EditState n)
(Editor ErrorMessage n)
(Editor ErrorMessage n)
forall n n.
Lens
(EditState n)
(EditState n)
(Editor ErrorMessage n)
(Editor ErrorMessage n)
editStateL (EventM n (Editor ErrorMessage n) () -> EventM n (EditState n) ())
-> EventM n (Editor ErrorMessage n) () -> EventM n (EditState n) ()
forall a b. (a -> b) -> a -> b
$ BrickEvent n e -> EventM n (Editor ErrorMessage n) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
Edit.handleEditorEvent BrickEvent n e
ev
else case BrickEvent n e
ev of
VtyEvent (Vty.EvKey Key
Vty.KEnter []) -> Lens' (EditState n) Bool
forall n. Lens' (EditState n) Bool
editStateOverlayOpenL Lens' (EditState n) Bool -> Bool -> EventM n (EditState n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Bool
True
BrickEvent n e
_ -> () -> EventM n (EditState n) ()
forall a. a -> EventM n (EditState n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
validateEditContent :: EditState n -> Either ErrorMessage a
validateEditContent = ErrorMessage -> Either ErrorMessage a
validator (ErrorMessage -> Either ErrorMessage a)
-> (EditState n -> ErrorMessage)
-> EditState n
-> Either ErrorMessage a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ErrorMessage -> ErrorMessage
ErrorMessage -> ErrorMessage
T.init (ErrorMessage -> ErrorMessage)
-> (EditState n -> ErrorMessage) -> EditState n -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrorMessage] -> ErrorMessage
T.unlines ([ErrorMessage] -> ErrorMessage)
-> (EditState n -> [ErrorMessage]) -> EditState n -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor ErrorMessage n -> [ErrorMessage]
forall t n. Monoid t => Editor t n -> [t]
Edit.getEditContents (Editor ErrorMessage n -> [ErrorMessage])
-> (EditState n -> Editor ErrorMessage n)
-> EditState n
-> [ErrorMessage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditState n -> Editor ErrorMessage n
forall n. EditState n -> Editor ErrorMessage n
editState
initEdit :: EditState n
initEdit = Editor ErrorMessage n -> Bool -> EditState n
forall n. Editor ErrorMessage n -> Bool -> EditState n
EditState (n -> Maybe Int -> ErrorMessage -> Editor ErrorMessage n
forall n. n -> Maybe Int -> ErrorMessage -> Editor ErrorMessage n
Edit.editorText n
name (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) ErrorMessage
initText) Bool
False
createEditableField' :: (Eq n, Ord n, Show n) => T.Text -> n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n
createEditableField' :: forall n a s.
(Eq n, Ord n, Show n) =>
ErrorMessage
-> n
-> (ErrorMessage -> Either ErrorMessage a)
-> Lens' s a
-> EditableField s n
createEditableField' ErrorMessage
initText n
name ErrorMessage -> Either ErrorMessage a
validator Lens' s a
access = Lens' s a
-> FieldInput a (EditState n) n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
forall s a b n.
Lens' s a
-> FieldInput a b n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
MenuField Lens' s a
access FieldInput a (EditState n) n
input ErrorMessage
"" ErrorStatus
Valid n
name
where
input :: FieldInput a (EditState n) n
input = ErrorMessage
-> n
-> (ErrorMessage -> Either ErrorMessage a)
-> FieldInput a (EditState n) n
forall n a.
(Ord n, Show n) =>
ErrorMessage
-> n
-> (ErrorMessage -> Either ErrorMessage a)
-> FieldInput a (EditState n) n
createEditableInput ErrorMessage
initText n
name ErrorMessage -> Either ErrorMessage a
validator
createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n
createEditableField :: forall n a s.
(Eq n, Ord n, Show n) =>
n
-> (ErrorMessage -> Either ErrorMessage a)
-> Lens' s a
-> EditableField s n
createEditableField = ErrorMessage
-> n
-> (ErrorMessage -> Either ErrorMessage a)
-> Lens' s a
-> EditableField s n
forall n a s.
(Eq n, Ord n, Show n) =>
ErrorMessage
-> n
-> (ErrorMessage -> Either ErrorMessage a)
-> Lens' s a
-> EditableField s n
createEditableField' ErrorMessage
""
type Button = MenuField
createButtonInput :: FieldInput () () n
createButtonInput :: forall n. FieldInput () () n
createButtonInput = ()
-> (() -> Either ErrorMessage ())
-> ErrorMessage
-> (Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> ()
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n)))
-> (BrickEvent n () -> EventM n () ())
-> FieldInput () () n
forall a b n.
b
-> (b -> Either ErrorMessage a)
-> ErrorMessage
-> (Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n)))
-> (BrickEvent n () -> EventM n b ())
-> FieldInput a b n
FieldInput () () -> Either ErrorMessage ()
forall a b. b -> Either a b
Right ErrorMessage
"" Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> ()
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
forall {p} {p} {n} {a} {a}.
Bool
-> ErrorStatus
-> ErrorMessage
-> p
-> p
-> (Widget n -> a)
-> (a, Maybe a)
drawButton (EventM n () () -> BrickEvent n () -> EventM n () ()
forall a b. a -> b -> a
const (EventM n () () -> BrickEvent n () -> EventM n () ())
-> EventM n () () -> BrickEvent n () -> EventM n () ()
forall a b. (a -> b) -> a -> b
$ () -> EventM n () ()
forall a. a -> EventM n () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
where
drawButton :: Bool
-> ErrorStatus
-> ErrorMessage
-> p
-> p
-> (Widget n -> a)
-> (a, Maybe a)
drawButton Bool
True (Invalid ErrorMessage
err) ErrorMessage
_ p
_ p
_ Widget n -> a
amp = (Widget n -> a
amp (Widget n -> a) -> (ErrorMessage -> Widget n) -> ErrorMessage -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsErrMsg (ErrorMessage -> a) -> ErrorMessage -> a
forall a b. (a -> b) -> a -> b
$ ErrorMessage
err, Maybe a
forall a. Maybe a
Nothing)
drawButton Bool
_ ErrorStatus
_ ErrorMessage
help p
_ p
_ Widget n -> a
amp =
let pad :: Widget n -> Widget n
pad = if [ErrorMessage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ErrorMessage -> [ErrorMessage]
T.lines ErrorMessage
help) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padTop (Int -> Padding
Brick.Pad Int
1) else Widget n -> Widget n
forall a. a -> a
id
in (Widget n -> a
amp (Widget n -> a) -> (ErrorMessage -> Widget n) -> ErrorMessage -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
pad (Widget n -> Widget n)
-> (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsHelpMsg (ErrorMessage -> a) -> ErrorMessage -> a
forall a b. (a -> b) -> a -> b
$ ErrorMessage
help, Maybe a
forall a. Maybe a
Nothing)
createButtonField :: n -> Button s n
createButtonField :: forall n s. n -> Button s n
createButtonField = Lens' s ()
-> FieldInput () () n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
forall s a b n.
Lens' s a
-> FieldInput a b n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
MenuField Lens' s ()
forall s. Lens' s ()
emptyLens FieldInput () () n
forall n. FieldInput () () n
createButtonInput ErrorMessage
"" ErrorStatus
Valid
type SelectField = MenuField
createSelectInput :: (Ord n, Show n)
=> NonEmpty i
-> (i -> T.Text)
-> (Int -> (NonEmpty (Int, (i, Bool)), Bool) -> ((NonEmpty (Int, (i, Bool))), Bool))
-> (([i], Maybe T.Text) -> Either ErrorMessage k)
-> n
-> Maybe n
-> MenuKeyBindings
-> FieldInput k (SelectState i n) n
createSelectInput :: forall n i k.
(Ord n, Show n) =>
NonEmpty i
-> (i -> ErrorMessage)
-> (Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> (([i], Maybe ErrorMessage) -> Either ErrorMessage k)
-> n
-> Maybe n
-> MenuKeyBindings
-> FieldInput k (SelectState i n) n
createSelectInput NonEmpty i
items i -> ErrorMessage
showItem Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
updateSelection ([i], Maybe ErrorMessage) -> Either ErrorMessage k
validator n
viewportFieldName Maybe n
mEditFieldName MenuKeyBindings
kb
= SelectState i n
-> (SelectState i n -> Either ErrorMessage k)
-> ErrorMessage
-> (Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> SelectState i n
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n)))
-> (BrickEvent n () -> EventM n (SelectState i n) ())
-> FieldInput k (SelectState i n) n
forall a b n.
b
-> (b -> Either ErrorMessage a)
-> ErrorMessage
-> (Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n)))
-> (BrickEvent n () -> EventM n b ())
-> FieldInput a b n
FieldInput SelectState i n
initState (([i], Maybe ErrorMessage) -> Either ErrorMessage k
validator (([i], Maybe ErrorMessage) -> Either ErrorMessage k)
-> (SelectState i n -> ([i], Maybe ErrorMessage))
-> SelectState i n
-> Either ErrorMessage k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectState i n -> ([i], Maybe ErrorMessage)
forall {a} {n}. SelectState a n -> ([a], Maybe ErrorMessage)
getSelectedItems) ErrorMessage
"" Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> SelectState i n
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
selectRender BrickEvent n () -> EventM n (SelectState i n) ()
selectHandler
where
totalRows :: Int
totalRows = (if Maybe n -> Bool
forall a. Maybe a -> Bool
isJust Maybe n
mEditFieldName then Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1 else Int -> Int
forall a. a -> a
id) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty i -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty i
items
initState :: SelectState i n
initState = (NonEmpty (Int, (i, Bool)), Bool)
-> Maybe (Editor ErrorMessage n)
-> FocusRing Int
-> Bool
-> SelectState i n
forall i n.
(NonEmpty (Int, (i, Bool)), Bool)
-> Maybe (Editor ErrorMessage n)
-> FocusRing Int
-> Bool
-> SelectState i n
SelectState
(NonEmpty Int -> NonEmpty (i, Bool) -> NonEmpty (Int, (i, Bool))
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip (Int
1 Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
NE.:| [Int
2..]) (NonEmpty (i, Bool) -> NonEmpty (Int, (i, Bool)))
-> NonEmpty (i, Bool) -> NonEmpty (Int, (i, Bool))
forall a b. (a -> b) -> a -> b
$ (i -> (i, Bool)) -> NonEmpty i -> NonEmpty (i, Bool)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Bool
False) NonEmpty i
items, Bool
False)
((\n
n -> n -> Maybe Int -> ErrorMessage -> Editor ErrorMessage n
forall n. n -> Maybe Int -> ErrorMessage -> Editor ErrorMessage n
Edit.editorText n
n (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) ErrorMessage
"") (n -> Editor ErrorMessage n)
-> Maybe n -> Maybe (Editor ErrorMessage n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe n
mEditFieldName)
([Int] -> FocusRing Int
forall n. [n] -> FocusRing n
F.focusRing [Int
1.. Int
totalRows])
Bool
False
getSelectedItems :: SelectState a n -> ([a], Maybe ErrorMessage)
getSelectedItems (SelectState {Bool
Maybe (Editor ErrorMessage n)
(NonEmpty (Int, (a, Bool)), Bool)
FocusRing Int
selectStateItems :: forall i n. SelectState i n -> (NonEmpty (Int, (i, Bool)), Bool)
selectStateEditState :: forall i n. SelectState i n -> Maybe (Editor ErrorMessage n)
selectStateFocusRing :: forall i n. SelectState i n -> FocusRing Int
selectStateOverlayOpen :: forall i n. SelectState i n -> Bool
selectStateItems :: (NonEmpty (Int, (a, Bool)), Bool)
selectStateEditState :: Maybe (Editor ErrorMessage n)
selectStateFocusRing :: FocusRing Int
selectStateOverlayOpen :: Bool
..}) =
( ((Int, (a, Bool)) -> a) -> [(Int, (a, Bool))] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, Bool) -> a
forall a b. (a, b) -> a
fst ((a, Bool) -> a)
-> ((Int, (a, Bool)) -> (a, Bool)) -> (Int, (a, Bool)) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (a, Bool)) -> (a, Bool)
forall a b. (a, b) -> b
snd) ([(Int, (a, Bool))] -> [a])
-> ((NonEmpty (Int, (a, Bool)), Bool) -> [(Int, (a, Bool))])
-> (NonEmpty (Int, (a, Bool)), Bool)
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int, (a, Bool)) -> Bool)
-> [(Int, (a, Bool))] -> [(Int, (a, Bool))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a, Bool) -> Bool
forall a b. (a, b) -> b
snd ((a, Bool) -> Bool)
-> ((Int, (a, Bool)) -> (a, Bool)) -> (Int, (a, Bool)) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (a, Bool)) -> (a, Bool)
forall a b. (a, b) -> b
snd)) ([(Int, (a, Bool))] -> [(Int, (a, Bool))])
-> ((NonEmpty (Int, (a, Bool)), Bool) -> [(Int, (a, Bool))])
-> (NonEmpty (Int, (a, Bool)), Bool)
-> [(Int, (a, Bool))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Int, (a, Bool)) -> [(Int, (a, Bool))]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Int, (a, Bool)) -> [(Int, (a, Bool))])
-> ((NonEmpty (Int, (a, Bool)), Bool) -> NonEmpty (Int, (a, Bool)))
-> (NonEmpty (Int, (a, Bool)), Bool)
-> [(Int, (a, Bool))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Int, (a, Bool)), Bool) -> NonEmpty (Int, (a, Bool))
forall a b. (a, b) -> a
fst ((NonEmpty (Int, (a, Bool)), Bool) -> [a])
-> (NonEmpty (Int, (a, Bool)), Bool) -> [a]
forall a b. (a -> b) -> a -> b
$ (NonEmpty (Int, (a, Bool)), Bool)
selectStateItems
, if (NonEmpty (Int, (a, Bool)), Bool) -> Bool
forall a b. (a, b) -> b
snd (NonEmpty (Int, (a, Bool)), Bool)
selectStateItems then (HasCallStack => ErrorMessage -> ErrorMessage
ErrorMessage -> ErrorMessage
T.init (ErrorMessage -> ErrorMessage)
-> (Editor ErrorMessage n -> ErrorMessage)
-> Editor ErrorMessage n
-> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrorMessage] -> ErrorMessage
T.unlines ([ErrorMessage] -> ErrorMessage)
-> (Editor ErrorMessage n -> [ErrorMessage])
-> Editor ErrorMessage n
-> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor ErrorMessage n -> [ErrorMessage]
forall t n. Monoid t => Editor t n -> [t]
Edit.getEditContents (Editor ErrorMessage n -> ErrorMessage)
-> Maybe (Editor ErrorMessage n) -> Maybe ErrorMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Editor ErrorMessage n)
selectStateEditState) else Maybe ErrorMessage
forall a. Maybe a
Nothing)
border :: Widget n -> Widget n
border Widget n
w = ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"[" Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
1) Widget n
w) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"]"
selectRender :: Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> SelectState i n
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
selectRender Bool
focus ErrorStatus
errMsg ErrorMessage
help ErrorMessage
label SelectState i n
s Widget n -> Widget n
amp = (Widget n
field, Maybe (Widget n)
mOverlay)
where
field :: Widget n
field =
let mContents :: Maybe [Widget n]
mContents = case SelectState i n -> ([i], Maybe ErrorMessage)
forall {a} {n}. SelectState a n -> ([a], Maybe ErrorMessage)
getSelectedItems SelectState i n
s of
([], Maybe ErrorMessage
Nothing) -> Maybe [Widget n]
forall a. Maybe a
Nothing
([i]
xs, Maybe ErrorMessage
mTxt) -> [Widget n] -> Maybe [Widget n]
forall a. a -> Maybe a
Just ([Widget n] -> Maybe [Widget n]) -> [Widget n] -> Maybe [Widget n]
forall a b. (a -> b) -> a -> b
$ (i -> Widget n) -> [i] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n) -> (i -> Widget n) -> i -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt (ErrorMessage -> Widget n) -> (i -> ErrorMessage) -> i -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> ErrorMessage
showItem) [i]
xs
[Widget n] -> [Widget n] -> [Widget n]
forall a. [a] -> [a] -> [a]
++ (case Maybe ErrorMessage
mTxt of Just ErrorMessage
t -> [ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
t]; Maybe ErrorMessage
Nothing -> [])
in Widget n -> Widget n
amp (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ case (ErrorStatus
errMsg, Maybe [Widget n]
mContents) of
(ErrorStatus
Valid, Maybe [Widget n]
Nothing) -> (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n)
-> (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsHelpMsg (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage
help)
(ErrorStatus
Valid, Just [Widget n]
contents) -> Widget n -> Widget n
forall n. Widget n -> Widget n
border (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
Brick.hBox [Widget n]
contents
(Invalid ErrorMessage
msg, Maybe [Widget n]
Nothing)
| Bool
focus -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n)
-> (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsHelpMsg (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage
help
| Bool
otherwise -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsErrMsg ErrorMessage
msg
(Invalid ErrorMessage
msg, Just [Widget n]
contents)
| Bool
focus -> Widget n -> Widget n
forall n. Widget n -> Widget n
border (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
Brick.hBox [Widget n]
contents
| Bool
otherwise -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsErrMsg ErrorMessage
msg
mOverlay :: Maybe (Widget n)
mOverlay = if SelectState i n -> Bool
forall i n. SelectState i n -> Bool
selectStateOverlayOpen SelectState i n
s
then Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (ErrorMessage -> Widget n -> Widget n
forall n. ErrorMessage -> Widget n -> Widget n
overlayLayer (ErrorMessage
"Select " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
label) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ SelectState i n -> ErrorStatus -> ErrorMessage -> Widget n
overlay SelectState i n
s ErrorStatus
errMsg ErrorMessage
help)
else Maybe (Widget n)
forall a. Maybe a
Nothing
overlay :: SelectState i n -> ErrorStatus -> ErrorMessage -> Widget n
overlay (SelectState {Bool
Maybe (Editor ErrorMessage n)
(NonEmpty (Int, (i, Bool)), Bool)
FocusRing Int
selectStateItems :: forall i n. SelectState i n -> (NonEmpty (Int, (i, Bool)), Bool)
selectStateEditState :: forall i n. SelectState i n -> Maybe (Editor ErrorMessage n)
selectStateFocusRing :: forall i n. SelectState i n -> FocusRing Int
selectStateOverlayOpen :: forall i n. SelectState i n -> Bool
selectStateItems :: (NonEmpty (Int, (i, Bool)), Bool)
selectStateEditState :: Maybe (Editor ErrorMessage n)
selectStateFocusRing :: FocusRing Int
selectStateOverlayOpen :: Bool
..}) ErrorStatus
errMsg ErrorMessage
help = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
Brick.vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
[ if Bool
txtFieldFocused
then ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txtWrap ErrorMessage
"Press Enter to finish editing and select custom value. Press Up/Down keys to navigate"
else ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"Press "
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> KeyCombination -> Widget n
forall n. KeyCombination -> Widget n
Common.keyToWidget (MenuKeyBindings
kb MenuKeyBindings
-> Lens' MenuKeyBindings KeyCombination -> KeyCombination
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' MenuKeyBindings KeyCombination
mKbQuitL)
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
" to go back, Press Enter to select"
, case ErrorStatus
errMsg of Invalid ErrorMessage
msg -> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
renderAsErrMsg ErrorMessage
msg; ErrorStatus
_ -> Widget n
forall n. Widget n
Brick.emptyWidget
, Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Brick.vLimit (Int
totalRows) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ VScrollBarOrientation -> Widget n -> Widget n
forall n. VScrollBarOrientation -> Widget n -> Widget n
Brick.withVScrollBars VScrollBarOrientation
Brick.OnRight
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ n -> ViewportType -> Widget n -> Widget n
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
Brick.viewport n
viewportFieldName ViewportType
Brick.Vertical
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
Brick.vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n]
mEditableField [Widget n] -> [Widget n] -> [Widget n]
forall a. [a] -> [a] -> [a]
++ (NonEmpty (Widget n) -> [Widget n]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Widget n) -> [Widget n])
-> NonEmpty (Widget n) -> [Widget n]
forall a b. (a -> b) -> a -> b
$ ((Int, (i, Bool)) -> Widget n)
-> NonEmpty (Int, (i, Bool)) -> NonEmpty (Widget n)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> (Int, (i, Bool)) -> Widget n
mkSelectRow Int
focused) ((NonEmpty (Int, (i, Bool)), Bool) -> NonEmpty (Int, (i, Bool))
forall a b. (a, b) -> a
fst (NonEmpty (Int, (i, Bool)), Bool)
selectStateItems))
]
where focused :: Int
focused = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ FocusRing Int -> Maybe Int
forall n. FocusRing n -> Maybe n
F.focusGetCurrent FocusRing Int
selectStateFocusRing
txtFieldFocused :: Bool
txtFieldFocused = Int
focused Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
totalRows
mEditableField :: [Widget n]
mEditableField = case Maybe (Editor ErrorMessage n)
selectStateEditState of
Just Editor ErrorMessage n
edi -> [ Bool -> Editor ErrorMessage n -> Bool -> ErrorMessage -> Widget n
forall {n} {p}.
(Ord n, Show n) =>
Bool -> Editor ErrorMessage n -> Bool -> p -> Widget n
mkEditTextRow Bool
txtFieldFocused Editor ErrorMessage n
edi ((NonEmpty (Int, (i, Bool)), Bool) -> Bool
forall a b. (a, b) -> b
snd (NonEmpty (Int, (i, Bool)), Bool)
selectStateItems) ErrorMessage
help ]
Maybe (Editor ErrorMessage n)
Nothing -> []
mkSelectRow :: Int -> (Int, (i, Bool)) -> Widget n
mkSelectRow Int
focused (Int
ix, (i
item, Bool
selected)) = (if Int
focused Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix then Widget n -> Widget n
forall n. Widget n -> Widget n
Brick.visible else Widget n -> Widget n
forall a. a -> a
id) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"[" Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
1) Widget n
m) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"] "
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (ErrorMessage -> Bool -> Widget n
forall n. ErrorMessage -> Bool -> Widget n
renderAslabel (i -> ErrorMessage
showItem i
item) (Int
focused Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix))
where m :: Widget n
m = if Bool
selected then ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"*" else ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
" "
mkEditTextRow :: Bool -> Editor ErrorMessage n -> Bool -> p -> Widget n
mkEditTextRow Bool
focused Editor ErrorMessage n
edi Bool
selected p
help = (if Bool
focused then Widget n -> Widget n
forall n. Widget n -> Widget n
Brick.visible else Widget n -> Widget n
forall a. a -> a
id) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"[" Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight (Int -> Padding
Brick.Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Brick.Pad Int
1) Widget n
m) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"] "
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> if Bool -> Bool
not Bool
focused Bool -> Bool -> Bool
&& Editor ErrorMessage n -> [ErrorMessage]
forall t n. Monoid t => Editor t n -> [t]
Edit.getEditContents Editor ErrorMessage n
edi [ErrorMessage] -> [ErrorMessage] -> Bool
forall a. Eq a => a -> a -> Bool
== [ErrorMessage
forall a. Monoid a => a
mempty]
then ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"(Specify custom text value)"
else Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Brick.vLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
forall n. Widget n
Border.vBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight Padding
Brick.Max (([ErrorMessage] -> Widget n)
-> Bool -> Editor ErrorMessage n -> Widget n
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
Edit.renderEditor (ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt (ErrorMessage -> Widget n)
-> ([ErrorMessage] -> ErrorMessage) -> [ErrorMessage] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrorMessage] -> ErrorMessage
T.unlines) Bool
focused Editor ErrorMessage n
edi) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
Border.vBorder
where m :: Widget n
m = if Bool
selected then ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"*" else ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
" "
selectHandler :: BrickEvent n () -> EventM n (SelectState i n) ()
selectHandler BrickEvent n ()
ev = do
SelectState i n
s <- EventM n (SelectState i n) (SelectState i n)
forall s (m :: * -> *). MonadState s m => m s
Brick.get
if SelectState i n -> Bool
forall i n. SelectState i n -> Bool
selectStateOverlayOpen SelectState i n
s
then do
Maybe Int
focused <- Optic' A_Getter NoIx (SelectState i n) (Maybe Int)
-> EventM n (SelectState i n) (Maybe Int)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Lens' (SelectState i n) (FocusRing Int)
forall i n. Lens' (SelectState i n) (FocusRing Int)
selectStateFocusRingL Lens' (SelectState i n) (FocusRing Int)
-> Optic
A_Getter
NoIx
(FocusRing Int)
(FocusRing Int)
(Maybe Int)
(Maybe Int)
-> Optic' A_Getter NoIx (SelectState i n) (Maybe Int)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (FocusRing Int -> Maybe Int)
-> Optic
A_Getter
NoIx
(FocusRing Int)
(FocusRing Int)
(Maybe Int)
(Maybe Int)
forall s a. (s -> a) -> Getter s a
to FocusRing Int -> Maybe Int
forall n. FocusRing n -> Maybe n
F.focusGetCurrent)
Maybe (Editor ErrorMessage n)
mEditState <- Optic'
A_Lens NoIx (SelectState i n) (Maybe (Editor ErrorMessage n))
-> EventM n (SelectState i n) (Maybe (Editor ErrorMessage n))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic'
A_Lens NoIx (SelectState i n) (Maybe (Editor ErrorMessage n))
forall i n n.
Lens
(SelectState i n)
(SelectState i n)
(Maybe (Editor ErrorMessage n))
(Maybe (Editor ErrorMessage n))
selectStateEditStateL
case (Maybe Int
focused, Maybe (Editor ErrorMessage n)
mEditState) of
(Just Int
ix, Just Editor ErrorMessage n
edi)
| Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
totalRows -> case BrickEvent n ()
ev of
VtyEvent (Vty.EvKey Key
Vty.KEnter []) -> do
Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
forall i n i.
Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
selectStateItemsL Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
-> ((NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
updateSelection Int
ix
Lens' (SelectState i n) (FocusRing Int)
forall i n. Lens' (SelectState i n) (FocusRing Int)
selectStateFocusRingL Lens' (SelectState i n) (FocusRing Int)
-> (FocusRing Int -> FocusRing Int)
-> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= FocusRing Int -> FocusRing Int
forall n. FocusRing n -> FocusRing n
F.focusNext
VtyEvent (Vty.EvKey Key
Vty.KDown []) -> Lens' (SelectState i n) (FocusRing Int)
forall i n. Lens' (SelectState i n) (FocusRing Int)
selectStateFocusRingL Lens' (SelectState i n) (FocusRing Int)
-> (FocusRing Int -> FocusRing Int)
-> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= FocusRing Int -> FocusRing Int
forall n. FocusRing n -> FocusRing n
F.focusNext
VtyEvent (Vty.EvKey Key
Vty.KUp []) -> Lens' (SelectState i n) (FocusRing Int)
forall i n. Lens' (SelectState i n) (FocusRing Int)
selectStateFocusRingL Lens' (SelectState i n) (FocusRing Int)
-> (FocusRing Int -> FocusRing Int)
-> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= FocusRing Int -> FocusRing Int
forall n. FocusRing n -> FocusRing n
F.focusPrev
BrickEvent n ()
_ -> do
Editor ErrorMessage n
newEdi <- Editor ErrorMessage n
-> EventM n (Editor ErrorMessage n) ()
-> EventM n (SelectState i n) (Editor ErrorMessage n)
forall a n b s. a -> EventM n a b -> EventM n s a
Brick.nestEventM' Editor ErrorMessage n
edi (EventM n (Editor ErrorMessage n) ()
-> EventM n (SelectState i n) (Editor ErrorMessage n))
-> EventM n (Editor ErrorMessage n) ()
-> EventM n (SelectState i n) (Editor ErrorMessage n)
forall a b. (a -> b) -> a -> b
$ BrickEvent n () -> EventM n (Editor ErrorMessage n) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
Edit.handleEditorEvent BrickEvent n ()
ev
Optic'
A_Lens NoIx (SelectState i n) (Maybe (Editor ErrorMessage n))
-> Maybe (Editor ErrorMessage n) -> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic'
A_Lens NoIx (SelectState i n) (Maybe (Editor ErrorMessage n))
forall i n n.
Lens
(SelectState i n)
(SelectState i n)
(Maybe (Editor ErrorMessage n))
(Maybe (Editor ErrorMessage n))
selectStateEditStateL (Editor ErrorMessage n -> Maybe (Editor ErrorMessage n)
forall a. a -> Maybe a
Just Editor ErrorMessage n
newEdi)
Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
forall i n i.
Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
selectStateItemsL Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
-> ((NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
updateSelection Int
ix
(Maybe Int, Maybe (Editor ErrorMessage n))
_ -> case BrickEvent n ()
ev of
VtyEvent (Vty.EvKey Key
k [Modifier]
m)
| Key -> [Modifier] -> KeyCombination
KeyCombination Key
k [Modifier]
m KeyCombination -> KeyCombination -> Bool
forall a. Eq a => a -> a -> Bool
== MenuKeyBindings
kb MenuKeyBindings
-> Lens' MenuKeyBindings KeyCombination -> KeyCombination
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' MenuKeyBindings KeyCombination
mKbQuitL -> Lens' (SelectState i n) Bool
forall i n. Lens' (SelectState i n) Bool
selectStateOverlayOpenL Lens' (SelectState i n) Bool
-> Bool -> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Bool
False
| Key -> [Modifier] -> KeyCombination
KeyCombination Key
k [Modifier]
m KeyCombination -> KeyCombination -> Bool
forall a. Eq a => a -> a -> Bool
== MenuKeyBindings
kb MenuKeyBindings
-> Lens' MenuKeyBindings KeyCombination -> KeyCombination
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' MenuKeyBindings KeyCombination
mKbUpL -> Lens' (SelectState i n) (FocusRing Int)
forall i n. Lens' (SelectState i n) (FocusRing Int)
selectStateFocusRingL Lens' (SelectState i n) (FocusRing Int)
-> (FocusRing Int -> FocusRing Int)
-> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= FocusRing Int -> FocusRing Int
forall n. FocusRing n -> FocusRing n
F.focusPrev
| Key -> [Modifier] -> KeyCombination
KeyCombination Key
k [Modifier]
m KeyCombination -> KeyCombination -> Bool
forall a. Eq a => a -> a -> Bool
== MenuKeyBindings
kb MenuKeyBindings
-> Lens' MenuKeyBindings KeyCombination -> KeyCombination
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' MenuKeyBindings KeyCombination
mKbDownL -> Lens' (SelectState i n) (FocusRing Int)
forall i n. Lens' (SelectState i n) (FocusRing Int)
selectStateFocusRingL Lens' (SelectState i n) (FocusRing Int)
-> (FocusRing Int -> FocusRing Int)
-> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= FocusRing Int -> FocusRing Int
forall n. FocusRing n -> FocusRing n
F.focusNext
VtyEvent (Vty.EvKey Key
Vty.KEnter []) -> do
Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
forall i n i.
Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
selectStateItemsL Lens
(SelectState i n)
(SelectState i n)
(NonEmpty (Int, (i, Bool)), Bool)
(NonEmpty (Int, (i, Bool)), Bool)
-> ((NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
updateSelection (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
focused)
BrickEvent n ()
_ -> () -> EventM n (SelectState i n) ()
forall a. a -> EventM n (SelectState i n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else case BrickEvent n ()
ev of
VtyEvent (Vty.EvKey Key
Vty.KEnter []) -> Lens' (SelectState i n) Bool
forall i n. Lens' (SelectState i n) Bool
selectStateOverlayOpenL Lens' (SelectState i n) Bool
-> Bool -> EventM n (SelectState i n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Bool
True
BrickEvent n ()
_ -> () -> EventM n (SelectState i n) ()
forall a. a -> EventM n (SelectState i n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
createSelectField :: (Ord n, Show n) => n -> Lens' s (Maybe i) -> NonEmpty i -> (i -> T.Text) -> MenuKeyBindings -> SelectField s n
createSelectField :: forall n s i.
(Ord n, Show n) =>
n
-> Lens' s (Maybe i)
-> NonEmpty i
-> (i -> ErrorMessage)
-> MenuKeyBindings
-> SelectField s n
createSelectField n
name Lens' s (Maybe i)
access NonEmpty i
items i -> ErrorMessage
showItem MenuKeyBindings
keyBindings = Lens' s (Maybe i)
-> FieldInput (Maybe i) (SelectState i n) n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
forall s a b n.
Lens' s a
-> FieldInput a b n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
MenuField Lens' s (Maybe i)
access (NonEmpty i
-> (i -> ErrorMessage)
-> (Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> (([i], Maybe ErrorMessage) -> Either ErrorMessage (Maybe i))
-> n
-> Maybe n
-> MenuKeyBindings
-> FieldInput (Maybe i) (SelectState i n) n
forall n i k.
(Ord n, Show n) =>
NonEmpty i
-> (i -> ErrorMessage)
-> (Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> (([i], Maybe ErrorMessage) -> Either ErrorMessage k)
-> n
-> Maybe n
-> MenuKeyBindings
-> FieldInput k (SelectState i n) n
createSelectInput NonEmpty i
items i -> ErrorMessage
showItem Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
forall i a.
Int
-> (NonEmpty (Int, (i, Bool)), a) -> (NonEmpty (Int, (i, Bool)), a)
singleSelect ([i], Maybe ErrorMessage) -> Either ErrorMessage (Maybe i)
forall {b} {b} {a}. ([b], b) -> Either a (Maybe b)
getSelection n
name Maybe n
forall a. Maybe a
Nothing MenuKeyBindings
keyBindings) ErrorMessage
"" ErrorStatus
Valid n
name
where
singleSelect :: Int -> (NonEmpty (Int, (i, Bool)), a) -> (NonEmpty (Int, (i, Bool)), a)
singleSelect :: forall i a.
Int
-> (NonEmpty (Int, (i, Bool)), a) -> (NonEmpty (Int, (i, Bool)), a)
singleSelect Int
ix = Optic
A_Lens
NoIx
(NonEmpty (Int, (i, Bool)), a)
(NonEmpty (Int, (i, Bool)), a)
(NonEmpty (Int, (i, Bool)))
(NonEmpty (Int, (i, Bool)))
-> (NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool)))
-> (NonEmpty (Int, (i, Bool)), a)
-> (NonEmpty (Int, (i, Bool)), a)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
A_Lens
NoIx
(NonEmpty (Int, (i, Bool)), a)
(NonEmpty (Int, (i, Bool)), a)
(NonEmpty (Int, (i, Bool)))
(NonEmpty (Int, (i, Bool)))
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool)))
-> (NonEmpty (Int, (i, Bool)), a)
-> (NonEmpty (Int, (i, Bool)), a))
-> (NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool)))
-> (NonEmpty (Int, (i, Bool)), a)
-> (NonEmpty (Int, (i, Bool)), a)
forall a b. (a -> b) -> a -> b
$ ((Int, (i, Bool)) -> (Int, (i, Bool)))
-> NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
ix', (i
i, Bool
b)) -> if Int
ix' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix then (Int
ix', (i
i, Bool
True)) else (Int
ix', (i
i, Bool
False)))
getSelection :: ([b], b) -> Either a (Maybe b)
getSelection = Maybe b -> Either a (Maybe b)
forall a b. b -> Either a b
Right (Maybe b -> Either a (Maybe b))
-> (([b], b) -> Maybe b) -> ([b], b) -> Either a (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty b -> b) -> Maybe (NonEmpty b) -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty b -> b
forall a. NonEmpty a -> a
NE.head (Maybe (NonEmpty b) -> Maybe b)
-> (([b], b) -> Maybe (NonEmpty b)) -> ([b], b) -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Maybe (NonEmpty b)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([b] -> Maybe (NonEmpty b))
-> (([b], b) -> [b]) -> ([b], b) -> Maybe (NonEmpty b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b], b) -> [b]
forall a b. (a, b) -> a
fst
createMultiSelectField :: (Ord n, Show n) => n -> Lens' s [i] -> NonEmpty i -> (i -> T.Text) -> MenuKeyBindings -> SelectField s n
createMultiSelectField :: forall n s i.
(Ord n, Show n) =>
n
-> Lens' s [i]
-> NonEmpty i
-> (i -> ErrorMessage)
-> MenuKeyBindings
-> SelectField s n
createMultiSelectField n
name Lens' s [i]
access NonEmpty i
items i -> ErrorMessage
showItem MenuKeyBindings
keyBindings = Lens' s [i]
-> FieldInput [i] (SelectState i n) n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
forall s a b n.
Lens' s a
-> FieldInput a b n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
MenuField Lens' s [i]
access (NonEmpty i
-> (i -> ErrorMessage)
-> (Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> (([i], Maybe ErrorMessage) -> Either ErrorMessage [i])
-> n
-> Maybe n
-> MenuKeyBindings
-> FieldInput [i] (SelectState i n) n
forall n i k.
(Ord n, Show n) =>
NonEmpty i
-> (i -> ErrorMessage)
-> (Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> (([i], Maybe ErrorMessage) -> Either ErrorMessage k)
-> n
-> Maybe n
-> MenuKeyBindings
-> FieldInput k (SelectState i n) n
createSelectInput NonEmpty i
items i -> ErrorMessage
showItem Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
forall i a.
Int
-> (NonEmpty (Int, (i, Bool)), a) -> (NonEmpty (Int, (i, Bool)), a)
multiSelect ([i] -> Either ErrorMessage [i]
forall a b. b -> Either a b
Right ([i] -> Either ErrorMessage [i])
-> (([i], Maybe ErrorMessage) -> [i])
-> ([i], Maybe ErrorMessage)
-> Either ErrorMessage [i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([i], Maybe ErrorMessage) -> [i]
forall a b. (a, b) -> a
fst) n
name Maybe n
forall a. Maybe a
Nothing MenuKeyBindings
keyBindings) ErrorMessage
"" ErrorStatus
Valid n
name
where
multiSelect :: Int -> (NonEmpty (Int, (i, Bool)), a) -> (NonEmpty (Int, (i, Bool)), a)
multiSelect :: forall i a.
Int
-> (NonEmpty (Int, (i, Bool)), a) -> (NonEmpty (Int, (i, Bool)), a)
multiSelect Int
ix = Optic
A_Lens
NoIx
(NonEmpty (Int, (i, Bool)), a)
(NonEmpty (Int, (i, Bool)), a)
(NonEmpty (Int, (i, Bool)))
(NonEmpty (Int, (i, Bool)))
-> (NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool)))
-> (NonEmpty (Int, (i, Bool)), a)
-> (NonEmpty (Int, (i, Bool)), a)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
A_Lens
NoIx
(NonEmpty (Int, (i, Bool)), a)
(NonEmpty (Int, (i, Bool)), a)
(NonEmpty (Int, (i, Bool)))
(NonEmpty (Int, (i, Bool)))
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool)))
-> (NonEmpty (Int, (i, Bool)), a)
-> (NonEmpty (Int, (i, Bool)), a))
-> (NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool)))
-> (NonEmpty (Int, (i, Bool)), a)
-> (NonEmpty (Int, (i, Bool)), a)
forall a b. (a -> b) -> a -> b
$ ((Int, (i, Bool)) -> (Int, (i, Bool)))
-> NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
ix', (i
i, Bool
b)) -> if Int
ix' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix then (Int
ix', (i
i, Bool -> Bool
not Bool
b)) else (Int
ix', (i
i, Bool
b)))
createSelectFieldWithEditable :: (Ord n, Show n) => n -> n -> Lens' s (Either a i) -> (T.Text -> Either ErrorMessage a) -> NonEmpty i -> (i -> T.Text) -> MenuKeyBindings -> SelectField s n
createSelectFieldWithEditable :: forall n s a i.
(Ord n, Show n) =>
n
-> n
-> Lens' s (Either a i)
-> (ErrorMessage -> Either ErrorMessage a)
-> NonEmpty i
-> (i -> ErrorMessage)
-> MenuKeyBindings
-> SelectField s n
createSelectFieldWithEditable n
name n
editFieldName Lens' s (Either a i)
access ErrorMessage -> Either ErrorMessage a
validator NonEmpty i
items i -> ErrorMessage
showItem MenuKeyBindings
keyBindings = Lens' s (Either a i)
-> FieldInput (Either a i) (SelectState i n) n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
forall s a b n.
Lens' s a
-> FieldInput a b n
-> ErrorMessage
-> ErrorStatus
-> n
-> MenuField s n
MenuField Lens' s (Either a i)
access (NonEmpty i
-> (i -> ErrorMessage)
-> (Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> (([i], Maybe ErrorMessage) -> Either ErrorMessage (Either a i))
-> n
-> Maybe n
-> MenuKeyBindings
-> FieldInput (Either a i) (SelectState i n) n
forall n i k.
(Ord n, Show n) =>
NonEmpty i
-> (i -> ErrorMessage)
-> (Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool))
-> (([i], Maybe ErrorMessage) -> Either ErrorMessage k)
-> n
-> Maybe n
-> MenuKeyBindings
-> FieldInput k (SelectState i n) n
createSelectInput NonEmpty i
items i -> ErrorMessage
showItem Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
forall i.
Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
singleSelect ([i], Maybe ErrorMessage) -> Either ErrorMessage (Either a i)
getSelection n
name (n -> Maybe n
forall a. a -> Maybe a
Just n
editFieldName) MenuKeyBindings
keyBindings) ErrorMessage
"" ErrorStatus
Valid n
name
where
singleSelect :: Int -> (NonEmpty (Int, (i, Bool)), Bool) -> (NonEmpty (Int, (i, Bool)), Bool)
singleSelect :: forall i.
Int
-> (NonEmpty (Int, (i, Bool)), Bool)
-> (NonEmpty (Int, (i, Bool)), Bool)
singleSelect Int
ix (NonEmpty (Int, (i, Bool))
ne, Bool
a) = (((Int, (i, Bool)) -> (Int, (i, Bool)))
-> NonEmpty (Int, (i, Bool)) -> NonEmpty (Int, (i, Bool))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
ix', (i
i, Bool
b)) -> if Int
ix' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix then (Int
ix', (i
i, Bool
True)) else (Int
ix', (i
i, Bool
False))) NonEmpty (Int, (i, Bool))
ne, Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (Int, (i, Bool)) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Int, (i, Bool))
ne Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
getSelection :: ([i], Maybe ErrorMessage) -> Either ErrorMessage (Either a i)
getSelection ([i]
_, Just ErrorMessage
txt) = (ErrorMessage -> Either ErrorMessage (Either a i))
-> (a -> Either ErrorMessage (Either a i))
-> Either ErrorMessage a
-> Either ErrorMessage (Either a i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrorMessage -> Either ErrorMessage (Either a i)
forall a b. a -> Either a b
Left (Either a i -> Either ErrorMessage (Either a i)
forall a b. b -> Either a b
Right (Either a i -> Either ErrorMessage (Either a i))
-> (a -> Either a i) -> a -> Either ErrorMessage (Either a i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a i
forall a b. a -> Either a b
Left) (Either ErrorMessage a -> Either ErrorMessage (Either a i))
-> Either ErrorMessage a -> Either ErrorMessage (Either a i)
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Either ErrorMessage a
validator ErrorMessage
txt
getSelection ([i]
ls, Maybe ErrorMessage
_) = Either ErrorMessage (Either a i)
-> (NonEmpty i -> Either ErrorMessage (Either a i))
-> Maybe (NonEmpty i)
-> Either ErrorMessage (Either a i)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((ErrorMessage -> Either ErrorMessage (Either a i))
-> (a -> Either ErrorMessage (Either a i))
-> Either ErrorMessage a
-> Either ErrorMessage (Either a i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrorMessage -> Either ErrorMessage (Either a i)
forall a b. a -> Either a b
Left (Either a i -> Either ErrorMessage (Either a i)
forall a b. b -> Either a b
Right (Either a i -> Either ErrorMessage (Either a i))
-> (a -> Either a i) -> a -> Either ErrorMessage (Either a i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a i
forall a b. a -> Either a b
Left) (Either ErrorMessage a -> Either ErrorMessage (Either a i))
-> Either ErrorMessage a -> Either ErrorMessage (Either a i)
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Either ErrorMessage a
validator ErrorMessage
"") (Either a i -> Either ErrorMessage (Either a i)
forall a b. b -> Either a b
Right (Either a i -> Either ErrorMessage (Either a i))
-> (NonEmpty i -> Either a i)
-> NonEmpty i
-> Either ErrorMessage (Either a i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either a i
forall a b. b -> Either a b
Right (i -> Either a i) -> (NonEmpty i -> i) -> NonEmpty i -> Either a i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty i -> i
forall a. NonEmpty a -> a
NE.head) (Maybe (NonEmpty i) -> Either ErrorMessage (Either a i))
-> Maybe (NonEmpty i) -> Either ErrorMessage (Either a i)
forall a b. (a -> b) -> a -> b
$ [i] -> Maybe (NonEmpty i)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [i]
ls
highlighted :: Widget n -> Widget n
highlighted :: forall n. Widget n -> Widget n
highlighted = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
L.listSelectedFocusedAttr
renderAslabel :: T.Text -> Bool -> Widget n
renderAslabel :: forall n. ErrorMessage -> Bool -> Widget n
renderAslabel ErrorMessage
t Bool
focus =
if Bool
focus
then Widget n -> Widget n
forall n. Widget n -> Widget n
highlighted (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
t
else ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
t
leftify :: Int -> Brick.Widget n -> Brick.Widget n
leftify :: forall n. Int -> Widget n -> Widget n
leftify Int
i = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Brick.hLimit Int
i (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight Padding
Brick.Max
rightify :: Int -> Brick.Widget n -> Brick.Widget n
rightify :: forall n. Int -> Widget n -> Widget n
rightify Int
i = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Brick.hLimit Int
i (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft Padding
Brick.Max
renderAsHelpMsg :: T.Text -> Widget n
renderAsHelpMsg :: forall n. ErrorMessage -> Widget n
renderAsHelpMsg = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.helpMsgAttr (Widget n -> Widget n)
-> (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt
renderAsErrMsg :: T.Text -> Widget n
renderAsErrMsg :: forall n. ErrorMessage -> Widget n
renderAsErrMsg = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.errMsgAttr (Widget n -> Widget n)
-> (ErrorMessage -> Widget n) -> ErrorMessage -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt
overlayLayer :: T.Text -> Brick.Widget n -> Brick.Widget n
overlayLayer :: forall n. ErrorMessage -> Widget n -> Widget n
overlayLayer ErrorMessage
layer_name =
Widget n -> Widget n
forall n. Widget n -> Widget n
Brick.centerLayer
(Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Brick.hLimitPercent Int
50
(Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Brick.vLimitPercent Int
65
(Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BorderStyle -> Widget n -> Widget n
forall n. BorderStyle -> Widget n -> Widget n
Brick.withBorderStyle BorderStyle
Border.unicode
(Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
Border.borderWithLabel (ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
layer_name)
data s n
=
{ :: [MenuField s n]
, :: s
, :: s -> Maybe ErrorMessage
, :: [Button s n]
, :: FocusRing n
, :: MenuKeyBindings
, :: n
, :: T.Text
}
isValidMenu :: Menu s n -> Bool
Menu s n
m = ((MenuField s n -> Bool) -> [MenuField s n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MenuField s n -> Bool
forall s n. MenuField s n -> Bool
isValidField ([MenuField s n] -> Bool) -> [MenuField s n] -> Bool
forall a b. (a -> b) -> a -> b
$ Menu s n -> [MenuField s n]
forall s n. Menu s n -> [MenuField s n]
menuFields Menu s n
m)
Bool -> Bool -> Bool
&& (case (Menu s n -> s -> Maybe ErrorMessage
forall s n. Menu s n -> s -> Maybe ErrorMessage
menuValidator Menu s n
m) (Menu s n -> s
forall s n. Menu s n -> s
menuState Menu s n
m) of { Maybe ErrorMessage
Nothing -> Bool
True; Maybe ErrorMessage
_ -> Bool
False })
createMenu :: n -> s -> T.Text -> (s -> Maybe ErrorMessage)
-> MenuKeyBindings -> [Button s n] -> [MenuField s n] -> Menu s n
n
n s
initial ErrorMessage
title s -> Maybe ErrorMessage
validator MenuKeyBindings
keys [Button s n]
buttons [Button s n]
fields = [Button s n]
-> s
-> (s -> Maybe ErrorMessage)
-> [Button s n]
-> FocusRing n
-> MenuKeyBindings
-> n
-> ErrorMessage
-> Menu s n
forall s n.
[MenuField s n]
-> s
-> (s -> Maybe ErrorMessage)
-> [MenuField s n]
-> FocusRing n
-> MenuKeyBindings
-> n
-> ErrorMessage
-> Menu s n
Menu [Button s n]
fields s
initial s -> Maybe ErrorMessage
validator [Button s n]
buttons FocusRing n
ring MenuKeyBindings
keys n
n ErrorMessage
title
where ring :: FocusRing n
ring = [n] -> FocusRing n
forall n. [n] -> FocusRing n
F.focusRing ([n] -> FocusRing n) -> [n] -> FocusRing n
forall a b. (a -> b) -> a -> b
$ [Button s n
field Button s n -> (Button s n -> n) -> n
forall a b. a -> (a -> b) -> b
& Button s n -> n
forall s n. MenuField s n -> n
fieldName | Button s n
field <- [Button s n]
fields] [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++ [Button s n
button Button s n -> (Button s n -> n) -> n
forall a b. a -> (a -> b) -> b
& Button s n -> n
forall s n. MenuField s n -> n
fieldName | Button s n
button <- [Button s n]
buttons]
handlerMenu :: forall n e s. Eq n => BrickEvent n e -> EventM n (Menu s n) ()
handlerMenu :: forall n e s. Eq n => BrickEvent n e -> EventM n (Menu s n) ()
handlerMenu BrickEvent n e
ev = do
[MenuField s n]
fields <- Optic' A_Lens NoIx (Menu s n) [MenuField s n]
-> EventM n (Menu s n) [MenuField s n]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuFieldsL
MenuKeyBindings
kb <- Optic' A_Lens NoIx (Menu s n) MenuKeyBindings
-> EventM n (Menu s n) MenuKeyBindings
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens NoIx (Menu s n) MenuKeyBindings
forall s n. Lens' (Menu s n) MenuKeyBindings
menuKeyBindingsL
Maybe n
focused <- Optic' A_Getter NoIx (Menu s n) (Maybe n)
-> EventM n (Menu s n) (Maybe n)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic' A_Getter NoIx (Menu s n) (Maybe n)
-> EventM n (Menu s n) (Maybe n))
-> Optic' A_Getter NoIx (Menu s n) (Maybe n)
-> EventM n (Menu s n) (Maybe n)
forall a b. (a -> b) -> a -> b
$ Lens' (Menu s n) (FocusRing n)
forall s n. Lens' (Menu s n) (FocusRing n)
menuFocusRingL Lens' (Menu s n) (FocusRing n)
-> Optic
A_Getter NoIx (FocusRing n) (FocusRing n) (Maybe n) (Maybe n)
-> Optic' A_Getter NoIx (Menu s n) (Maybe n)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (FocusRing n -> Maybe n)
-> Optic
A_Getter NoIx (FocusRing n) (FocusRing n) (Maybe n) (Maybe n)
forall s a. (s -> a) -> Getter s a
to FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
F.focusGetCurrent
let focusedField :: Maybe (MenuField s n)
focusedField = (\n
n -> (MenuField s n -> Bool) -> [MenuField s n] -> Maybe (MenuField s n)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MenuField s n
x -> MenuField s n -> n
forall a n. Named a n => a -> n
Brick.getName MenuField s n
x n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
n) [MenuField s n]
fields) (n -> Maybe (MenuField s n)) -> Maybe n -> Maybe (MenuField s n)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe n
focused
propagateEvent :: Event -> EventM n (Menu s n) ()
propagateEvent Event
e = case Maybe n
focused of
Maybe n
Nothing -> () -> EventM n (Menu s n) ()
forall a. a -> EventM n (Menu s n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just n
n -> do
[MenuField s n]
updated_fields <- n
-> BrickEvent n ()
-> [MenuField s n]
-> EventM n (Menu s n) [MenuField s n]
updateFields n
n (Event -> BrickEvent n ()
forall n e. Event -> BrickEvent n e
VtyEvent Event
e) [MenuField s n]
fields
s -> Maybe ErrorMessage
validator <- Optic' A_Lens NoIx (Menu s n) (s -> Maybe ErrorMessage)
-> EventM n (Menu s n) (s -> Maybe ErrorMessage)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens NoIx (Menu s n) (s -> Maybe ErrorMessage)
forall s n. Lens' (Menu s n) (s -> Maybe ErrorMessage)
menuValidatorL
s
state <- Optic' A_Lens NoIx (Menu s n) s -> EventM n (Menu s n) s
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens NoIx (Menu s n) s
forall s n. Lens' (Menu s n) s
menuStateL
if (MenuField s n -> Bool) -> [MenuField s n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MenuField s n -> Bool
forall s n. MenuField s n -> Bool
isValidField [MenuField s n]
updated_fields
then case s -> Maybe ErrorMessage
validator s
state of
Maybe ErrorMessage
Nothing -> Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuButtonsL Optic' A_Lens NoIx (Menu s n) [MenuField s n]
-> ([MenuField s n] -> [MenuField s n]) -> EventM n (Menu s n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (MenuField s n -> MenuField s n)
-> [MenuField s n] -> [MenuField s n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lens' (MenuField s n) ErrorStatus
forall s n. Lens' (MenuField s n) ErrorStatus
fieldStatusL Lens' (MenuField s n) ErrorStatus
-> ErrorStatus -> MenuField s n -> MenuField s n
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ErrorStatus
Valid)
Just ErrorMessage
err -> Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuButtonsL Optic' A_Lens NoIx (Menu s n) [MenuField s n]
-> ([MenuField s n] -> [MenuField s n]) -> EventM n (Menu s n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (MenuField s n -> MenuField s n)
-> [MenuField s n] -> [MenuField s n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lens' (MenuField s n) ErrorStatus
forall s n. Lens' (MenuField s n) ErrorStatus
fieldStatusL Lens' (MenuField s n) ErrorStatus
-> ErrorStatus -> MenuField s n -> MenuField s n
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ErrorMessage -> ErrorStatus
Invalid ErrorMessage
err)
else Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuButtonsL Optic' A_Lens NoIx (Menu s n) [MenuField s n]
-> ([MenuField s n] -> [MenuField s n]) -> EventM n (Menu s n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (MenuField s n -> MenuField s n)
-> [MenuField s n] -> [MenuField s n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lens' (MenuField s n) ErrorStatus
forall s n. Lens' (MenuField s n) ErrorStatus
fieldStatusL Lens' (MenuField s n) ErrorStatus
-> ErrorStatus -> MenuField s n -> MenuField s n
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ErrorMessage -> ErrorStatus
Invalid ErrorMessage
"Some fields are invalid")
Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuFieldsL Optic' A_Lens NoIx (Menu s n) [MenuField s n]
-> [MenuField s n] -> EventM n (Menu s n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= [MenuField s n]
updated_fields
case (MenuField s n -> Maybe (Widget n)
forall s n. MenuField s n -> Maybe (Widget n)
drawFieldOverlay (MenuField s n -> Maybe (Widget n))
-> Maybe (MenuField s n) -> Maybe (Widget n)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (MenuField s n)
focusedField) of
Just Widget n
_ -> case BrickEvent n e
ev of
VtyEvent Event
e -> Event -> EventM n (Menu s n) ()
propagateEvent Event
e
BrickEvent n e
_ -> () -> EventM n (Menu s n) ()
forall a. a -> EventM n (Menu s n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe (Widget n)
Nothing -> case BrickEvent n e
ev of
VtyEvent (Vty.EvKey Key
k [Modifier]
m)
| Key -> [Modifier] -> KeyCombination
KeyCombination Key
k [Modifier]
m KeyCombination -> KeyCombination -> Bool
forall a. Eq a => a -> a -> Bool
== MenuKeyBindings
kb MenuKeyBindings
-> Lens' MenuKeyBindings KeyCombination -> KeyCombination
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' MenuKeyBindings KeyCombination
mKbUpL -> Lens' (Menu s n) (FocusRing n)
forall s n. Lens' (Menu s n) (FocusRing n)
menuFocusRingL Lens' (Menu s n) (FocusRing n)
-> (FocusRing n -> FocusRing n) -> EventM n (Menu s n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= FocusRing n -> FocusRing n
forall n. FocusRing n -> FocusRing n
F.focusPrev
| Key -> [Modifier] -> KeyCombination
KeyCombination Key
k [Modifier]
m KeyCombination -> KeyCombination -> Bool
forall a. Eq a => a -> a -> Bool
== MenuKeyBindings
kb MenuKeyBindings
-> Lens' MenuKeyBindings KeyCombination -> KeyCombination
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' MenuKeyBindings KeyCombination
mKbDownL -> Lens' (Menu s n) (FocusRing n)
forall s n. Lens' (Menu s n) (FocusRing n)
menuFocusRingL Lens' (Menu s n) (FocusRing n)
-> (FocusRing n -> FocusRing n) -> EventM n (Menu s n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= FocusRing n -> FocusRing n
forall n. FocusRing n -> FocusRing n
F.focusNext
VtyEvent Event
e -> Event -> EventM n (Menu s n) ()
propagateEvent Event
e
BrickEvent n e
_ -> () -> EventM n (Menu s n) ()
forall a. a -> EventM n (Menu s n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
updateFields :: n -> BrickEvent n () -> [MenuField s n] -> EventM n (Menu s n) [MenuField s n]
updateFields :: n
-> BrickEvent n ()
-> [MenuField s n]
-> EventM n (Menu s n) [MenuField s n]
updateFields n
n BrickEvent n ()
e = (MenuField s n -> EventM n (Menu s n) (MenuField s n))
-> [MenuField s n] -> EventM n (Menu s n) [MenuField s n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((MenuField s n -> EventM n (Menu s n) (MenuField s n))
-> [MenuField s n] -> EventM n (Menu s n) [MenuField s n])
-> (MenuField s n -> EventM n (Menu s n) (MenuField s n))
-> [MenuField s n]
-> EventM n (Menu s n) [MenuField s n]
forall a b. (a -> b) -> a -> b
$ \x :: MenuField s n
x@(MenuField {fieldInput :: ()
fieldInput = FieldInput {b
ErrorMessage
b -> Either ErrorMessage a
Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
BrickEvent n () -> EventM n b ()
inputState :: forall a b n. FieldInput a b n -> b
inputValidator :: forall a b n. FieldInput a b n -> b -> Either ErrorMessage a
inputHelp :: forall a b n. FieldInput a b n -> ErrorMessage
inputRender :: forall a b n.
FieldInput a b n
-> Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputHandler :: forall a b n. FieldInput a b n -> BrickEvent n () -> EventM n b ()
inputState :: b
inputValidator :: b -> Either ErrorMessage a
inputHelp :: ErrorMessage
inputRender :: Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputHandler :: BrickEvent n () -> EventM n b ()
..}, n
ErrorMessage
Lens' s a
ErrorStatus
fieldAccesor :: ()
fieldLabel :: forall s n. MenuField s n -> ErrorMessage
fieldStatus :: forall s n. MenuField s n -> ErrorStatus
fieldName :: forall s n. MenuField s n -> n
fieldAccesor :: Lens' s a
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
..}) ->
if MenuField s n -> n
forall a n. Named a n => a -> n
Brick.getName MenuField s n
x n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
n
then do
b
newb <- b -> EventM n b () -> EventM n (Menu s n) b
forall a n b s. a -> EventM n a b -> EventM n s a
Brick.nestEventM' b
inputState (BrickEvent n () -> EventM n b ()
inputHandler BrickEvent n ()
e)
let newField :: MenuField s n
newField = MenuField {fieldInput :: FieldInput a b n
fieldInput = (FieldInput {inputState :: b
inputState=b
newb, ErrorMessage
b -> Either ErrorMessage a
Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
BrickEvent n () -> EventM n b ()
inputValidator :: b -> Either ErrorMessage a
inputHelp :: ErrorMessage
inputRender :: Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputHandler :: BrickEvent n () -> EventM n b ()
inputValidator :: b -> Either ErrorMessage a
inputHelp :: ErrorMessage
inputRender :: Bool
-> ErrorStatus
-> ErrorMessage
-> ErrorMessage
-> b
-> (Widget n -> Widget n)
-> (Widget n, Maybe (Widget n))
inputHandler :: BrickEvent n () -> EventM n b ()
..}) , n
ErrorMessage
Lens' s a
ErrorStatus
fieldAccesor :: Lens' s a
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
fieldAccesor :: Lens' s a
fieldLabel :: ErrorMessage
fieldStatus :: ErrorStatus
fieldName :: n
..}
case b -> Either ErrorMessage a
inputValidator b
newb of
Left ErrorMessage
errmsg -> MenuField s n -> EventM n (Menu s n) (MenuField s n)
forall a. a -> EventM n (Menu s n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MenuField s n -> EventM n (Menu s n) (MenuField s n))
-> MenuField s n -> EventM n (Menu s n) (MenuField s n)
forall a b. (a -> b) -> a -> b
$ MenuField s n
newField MenuField s n -> (MenuField s n -> MenuField s n) -> MenuField s n
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s n) ErrorStatus
forall s n. Lens' (MenuField s n) ErrorStatus
fieldStatusL Lens' (MenuField s n) ErrorStatus
-> ErrorStatus -> MenuField s n -> MenuField s n
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ErrorMessage -> ErrorStatus
Invalid ErrorMessage
errmsg
Right a
a -> Optic' A_Lens NoIx (Menu s n) s
forall s n. Lens' (Menu s n) s
menuStateL Optic' A_Lens NoIx (Menu s n) s
-> Lens' s a -> Optic A_Lens NoIx (Menu s n) (Menu s n) a a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Lens' s a
fieldAccesor Optic A_Lens NoIx (Menu s n) (Menu s n) a a
-> a -> EventM n (Menu s n) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= a
a EventM n (Menu s n) ()
-> EventM n (Menu s n) (MenuField s n)
-> EventM n (Menu s n) (MenuField s n)
forall a b.
EventM n (Menu s n) a
-> EventM n (Menu s n) b -> EventM n (Menu s n) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MenuField s n -> EventM n (Menu s n) (MenuField s n)
forall a. a -> EventM n (Menu s n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MenuField s n
newField MenuField s n -> (MenuField s n -> MenuField s n) -> MenuField s n
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s n) ErrorStatus
forall s n. Lens' (MenuField s n) ErrorStatus
fieldStatusL Lens' (MenuField s n) ErrorStatus
-> ErrorStatus -> MenuField s n -> MenuField s n
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ErrorStatus
Valid)
else MenuField s n -> EventM n (Menu s n) (MenuField s n)
forall a. a -> EventM n (Menu s n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MenuField s n
x
drawMenu :: (Eq n, Ord n, Show n, Brick.Named (MenuField s n) n) => Menu s n -> [Widget n]
Menu s n
menu =
[Widget n]
overlays [Widget n] -> [Widget n] -> [Widget n]
forall a. [a] -> [a] -> [a]
++
[ErrorMessage -> Widget n -> Widget n
forall n. ErrorMessage -> Widget n -> Widget n
Common.frontwardLayer (Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) ErrorMessage -> ErrorMessage
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) ErrorMessage
forall s n. Lens' (Menu s n) ErrorMessage
menuTitleL) Widget n
mainLayer]
where
mainLayer :: Widget n
mainLayer = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
Brick.vBox
[ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
Brick.vBox [Widget n]
buttonWidgets
, Widget n
forall n. Widget n
Common.separator
, Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Brick.vLimit ([ErrorMessage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ErrorMessage]
fieldLabels) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ VScrollBarOrientation -> Widget n -> Widget n
forall n. VScrollBarOrientation -> Widget n -> Widget n
Brick.withVScrollBars VScrollBarOrientation
Brick.OnRight
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ n -> ViewportType -> Widget n -> Widget n
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
Brick.viewport (Menu s n
menu Menu s n -> Optic' A_Lens NoIx (Menu s n) n -> n
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) n
forall s n. Lens' (Menu s n) n
menuNameL) ViewportType
Brick.Vertical
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
Brick.vBox [Widget n]
fieldWidgets
, ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
" "
, Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padRight Padding
Brick.Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
"Press "
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> KeyCombination -> Widget n
forall n. KeyCombination -> Widget n
Common.keyToWidget (Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) KeyCombination -> KeyCombination
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' (Menu s n) MenuKeyBindings
forall s n. Lens' (Menu s n) MenuKeyBindings
menuKeyBindingsL Lens' (Menu s n) MenuKeyBindings
-> Lens' MenuKeyBindings KeyCombination
-> Optic' A_Lens NoIx (Menu s n) KeyCombination
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Lens' MenuKeyBindings KeyCombination
mKbQuitL)
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
" to go back, Press Enter to edit the highlighted field"
]
fieldLabels :: [ErrorMessage]
fieldLabels = [MenuField s n
field MenuField s n -> (MenuField s n -> ErrorMessage) -> ErrorMessage
forall a b. a -> (a -> b) -> b
& MenuField s n -> ErrorMessage
forall s n. MenuField s n -> ErrorMessage
fieldLabel | MenuField s n
field <- Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) [MenuField s n] -> [MenuField s n]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuFieldsL]
buttonLabels :: [ErrorMessage]
buttonLabels = [MenuField s n
button MenuField s n -> (MenuField s n -> ErrorMessage) -> ErrorMessage
forall a b. a -> (a -> b) -> b
& MenuField s n -> ErrorMessage
forall s n. MenuField s n -> ErrorMessage
fieldLabel | MenuField s n
button <- Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) [MenuField s n] -> [MenuField s n]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuButtonsL]
allLabels :: [ErrorMessage]
allLabels = [ErrorMessage]
fieldLabels [ErrorMessage] -> [ErrorMessage] -> [ErrorMessage]
forall a. [a] -> [a] -> [a]
++ [ErrorMessage]
buttonLabels
maxWidth :: Int
maxWidth = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
5 ((ErrorMessage -> Int) -> [ErrorMessage] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorMessage -> Int
forall a. TextWidth a => a -> Int
Brick.textWidth [ErrorMessage]
allLabels)
amplifiers :: [Bool -> Widget n -> Widget n]
amplifiers =
let labelsWidgets :: [Bool -> Widget n]
labelsWidgets = (ErrorMessage -> Bool -> Widget n)
-> [ErrorMessage] -> [Bool -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorMessage -> Bool -> Widget n
forall n. ErrorMessage -> Bool -> Widget n
renderAslabel [ErrorMessage]
fieldLabels
in ((Bool -> Widget n) -> Bool -> Widget n -> Widget n)
-> [Bool -> Widget n] -> [Bool -> Widget n -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool -> Widget n
f Bool
b -> ((Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
rightify (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Bool -> Widget n
f Bool
b Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ErrorMessage -> Widget n
forall n. ErrorMessage -> Widget n
Brick.txt ErrorMessage
" ")) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>) ) [Bool -> Widget n]
labelsWidgets
drawFields :: [Bool -> MenuField s n -> Widget n]
drawFields = ((Bool -> Widget n -> Widget n)
-> Bool -> MenuField s n -> Widget n)
-> [Bool -> Widget n -> Widget n]
-> [Bool -> MenuField s n -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Widget n -> Widget n) -> Bool -> MenuField s n -> Widget n
forall n s. Formatter n -> Bool -> MenuField s n -> Widget n
drawField [Bool -> Widget n -> Widget n]
amplifiers
fieldWidgets :: [Widget n]
fieldWidgets = ((Bool -> MenuField s n -> Widget n) -> MenuField s n -> Widget n)
-> [Bool -> MenuField s n -> Widget n]
-> [MenuField s n]
-> [Widget n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (FocusRing n
-> (Bool -> MenuField s n -> Widget n) -> MenuField s n -> Widget n
forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
F.withFocusRing (Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) (FocusRing n) -> FocusRing n
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) (FocusRing n)
forall s n. Lens' (Menu s n) (FocusRing n)
menuFocusRingL)) [Bool -> MenuField s n -> Widget n]
drawFields (Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) [MenuField s n] -> [MenuField s n]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuFieldsL)
buttonAmplifiers :: [Bool -> Widget n -> Widget n]
buttonAmplifiers =
let buttonAsWidgets :: [Bool -> Widget n]
buttonAsWidgets = (ErrorMessage -> Bool -> Widget n)
-> [ErrorMessage] -> [Bool -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorMessage -> Bool -> Widget n
forall n. ErrorMessage -> Bool -> Widget n
renderAslabel [ErrorMessage]
buttonLabels
in ((Bool -> Widget n) -> Bool -> Widget n -> Widget n)
-> [Bool -> Widget n] -> [Bool -> Widget n -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool -> Widget n
f Bool
b -> ((Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
leftify (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
forall n. Widget n -> Widget n
Border.border (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Widget n
f Bool
b) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>) ) [Bool -> Widget n]
buttonAsWidgets
drawButtons :: [Bool -> MenuField s n -> Widget n]
drawButtons = ((Bool -> Widget n -> Widget n)
-> Bool -> MenuField s n -> Widget n)
-> [Bool -> Widget n -> Widget n]
-> [Bool -> MenuField s n -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Widget n -> Widget n) -> Bool -> MenuField s n -> Widget n
forall n s. Formatter n -> Bool -> MenuField s n -> Widget n
drawField [Bool -> Widget n -> Widget n]
buttonAmplifiers
buttonWidgets :: [Widget n]
buttonWidgets = ((Bool -> MenuField s n -> Widget n) -> MenuField s n -> Widget n)
-> [Bool -> MenuField s n -> Widget n]
-> [MenuField s n]
-> [Widget n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (FocusRing n
-> (Bool -> MenuField s n -> Widget n) -> MenuField s n -> Widget n
forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
F.withFocusRing (Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) (FocusRing n) -> FocusRing n
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) (FocusRing n)
forall s n. Lens' (Menu s n) (FocusRing n)
menuFocusRingL)) [Bool -> MenuField s n -> Widget n]
drawButtons (Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) [MenuField s n] -> [MenuField s n]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuButtonsL)
overlays :: [Widget n]
overlays = [Maybe (Widget n)] -> [Widget n]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Widget n)] -> [Widget n])
-> [Maybe (Widget n)] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ (MenuField s n -> Maybe (Widget n))
-> [MenuField s n] -> [Maybe (Widget n)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MenuField s n -> Maybe (Widget n)
forall s n. MenuField s n -> Maybe (Widget n)
drawFieldOverlay (Menu s n
menu Menu s n
-> Optic' A_Lens NoIx (Menu s n) [MenuField s n] -> [MenuField s n]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Menu s n) [MenuField s n]
forall s n. Lens' (Menu s n) [MenuField s n]
menuFieldsL)