module UI.Parameter (drawUI, theMap, handleEvent) where

import UI.Attributes
import Brick
import Brick.Focus
import Brick.Forms
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import Control.Monad.IO.Class
import Lens.Micro.Platform
import States
import StateManagement
import Runners
import qualified Graphics.Vty as V

drawUI :: PS -> [Widget Name]
drawUI :: PS -> [Widget Name]
drawUI = (Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
:[]) (Widget Name -> [Widget Name])
-> (PS -> Widget Name) -> PS -> [Widget Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PS -> Widget Name
ui

ui :: PS -> Widget Name
ui :: PS -> Widget Name
ui PS
s =
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
joinBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
center (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  BorderStyle -> Widget Name -> Widget Name
forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
unicodeRounded (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
border (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
60 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
40 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr (String -> Widget Name
forall n. String -> Widget n
str String
"Select parameters")) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
  Widget Name
forall n. Widget n
hBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1
  (Form Parameters Event Name -> Widget Name
forall n s e. Eq n => Form s e n -> Widget n
renderForm (PS
s PS
-> Getting
     (Form Parameters Event Name) PS (Form Parameters Event Name)
-> Form Parameters Event Name
forall s a. s -> Getting a s a -> a
^. Getting
  (Form Parameters Event Name) PS (Form Parameters Event Name)
Lens' PS (Form Parameters Event Name)
psForm))

handleEvent :: GlobalState -> PS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent :: GlobalState
-> PS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent GlobalState
gs PS
s ev :: BrickEvent Name Event
ev@(VtyEvent Event
e) =
  let form :: Form Parameters Event Name
form = PS
s PS
-> Getting
     (Form Parameters Event Name) PS (Form Parameters Event Name)
-> Form Parameters Event Name
forall s a. s -> Getting a s a -> a
^. Getting
  (Form Parameters Event Name) PS (Form Parameters Event Name)
Lens' PS (Form Parameters Event Name)
psForm

      update :: PS -> GlobalState
update = GlobalState -> PS -> GlobalState
updatePS GlobalState
gs
      continue' :: PS -> EventM n (Next GlobalState)
continue' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (PS -> GlobalState) -> PS -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PS -> GlobalState
update
      continue'' :: Form Parameters Event Name -> EventM n (Next GlobalState)
continue'' Form Parameters Event Name
f = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (PS -> GlobalState) -> PS -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PS -> GlobalState
update (PS -> EventM n (Next GlobalState))
-> PS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ PS
s PS -> (PS -> PS) -> PS
forall a b. a -> (a -> b) -> b
& (Form Parameters Event Name
 -> Identity (Form Parameters Event Name))
-> PS -> Identity PS
Lens' PS (Form Parameters Event Name)
psForm ((Form Parameters Event Name
  -> Identity (Form Parameters Event Name))
 -> PS -> Identity PS)
-> Form Parameters Event Name -> PS -> PS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Form Parameters Event Name
f

      halt' :: GlobalState -> EventM n (Next GlobalState)
halt' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (GlobalState -> GlobalState)
-> GlobalState
-> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> GlobalState
popState

      focus :: FocusRing Name
focus = Form Parameters Event Name -> FocusRing Name
forall s e n. Form s e n -> FocusRing n
formFocus Form Parameters Event Name
form
      (Just Name
n) = FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focus
      down :: EventM n (Next GlobalState)
down = case Name
n of
        Name
ParametersOkField -> GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
        Name
ChunkField1 -> Form Parameters Event Name -> EventM n (Next GlobalState)
forall n. Form Parameters Event Name -> EventM n (Next GlobalState)
continue'' (Form Parameters Event Name -> EventM n (Next GlobalState))
-> Form Parameters Event Name -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ Form Parameters Event Name
form { formFocus :: FocusRing Name
formFocus = FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext (FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext FocusRing Name
focus) }
        Name
_ -> Form Parameters Event Name -> EventM n (Next GlobalState)
forall n. Form Parameters Event Name -> EventM n (Next GlobalState)
continue'' (Form Parameters Event Name -> EventM n (Next GlobalState))
-> Form Parameters Event Name -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ Form Parameters Event Name
form { formFocus :: FocusRing Name
formFocus = FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext FocusRing Name
focus }
      up :: EventM n (Next GlobalState)
up = case Name
n of
        Name
ChunkField1 -> GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
        Name
ChunkField2 -> GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
        Name
SubsetField -> Form Parameters Event Name -> EventM n (Next GlobalState)
forall n. Form Parameters Event Name -> EventM n (Next GlobalState)
continue'' (Form Parameters Event Name -> EventM n (Next GlobalState))
-> Form Parameters Event Name -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ Form Parameters Event Name
form { formFocus :: FocusRing Name
formFocus = FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusPrev (FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusPrev FocusRing Name
focus) }
        Name
_           -> Form Parameters Event Name -> EventM n (Next GlobalState)
forall n. Form Parameters Event Name -> EventM n (Next GlobalState)
continue'' (Form Parameters Event Name -> EventM n (Next GlobalState))
-> Form Parameters Event Name -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ Form Parameters Event Name
form { formFocus :: FocusRing Name
formFocus = FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusPrev FocusRing Name
focus }

  in case Event
e of
      V.EvKey Key
V.KEsc []         -> GlobalState -> EventM Name (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
gs
      V.EvKey (V.KChar Char
'q') []  -> GlobalState -> EventM Name (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
gs
      V.EvKey Key
V.KDown []        -> EventM Name (Next GlobalState)
forall n. EventM n (Next GlobalState)
down
      V.EvKey (V.KChar Char
'j') []  -> EventM Name (Next GlobalState)
forall n. EventM n (Next GlobalState)
down
      V.EvKey Key
V.KUp []          -> EventM Name (Next GlobalState)
forall n. EventM n (Next GlobalState)
up
      V.EvKey (V.KChar Char
'k') []  -> EventM Name (Next GlobalState)
forall n. EventM n (Next GlobalState)
up
      V.EvKey (V.KChar Char
'\t') [] -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
      V.EvKey Key
V.KBackTab []     -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
    
      Event
_ -> case (Event
e, Name
n) of
          (V.EvKey Key
V.KRight [], Name
ChunkField2) -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
          (V.EvKey Key
V.KLeft [],  Name
ChunkField1) -> GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
          (Event, Name)
_ -> do Form Parameters Event Name
f <- BrickEvent Name Event
-> Form Parameters Event Name
-> EventM Name (Form Parameters Event Name)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormEvent BrickEvent Name Event
ev Form Parameters Event Name
form
                  if Form Parameters Event Name -> Parameters
forall s e n. Form s e n -> s
formState Form Parameters Event Name
f Parameters -> Getting Bool Parameters Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Parameters Bool
Lens' Parameters Bool
pOk
                    then GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM Name (Next GlobalState))
-> EventM Name GlobalState -> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (GlobalState
gs GlobalState -> State -> GlobalState
`goToState`)
                          (State -> GlobalState)
-> EventM Name State -> EventM Name GlobalState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO State -> EventM Name State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (GlobalState -> String -> [Card] -> IO State
cardsWithOptionsState
                                      (GlobalState
gs GlobalState -> (GlobalState -> GlobalState) -> GlobalState
forall a b. a -> (a -> b) -> b
& (Parameters -> Identity Parameters)
-> GlobalState -> Identity GlobalState
Lens' GlobalState Parameters
parameters ((Parameters -> Identity Parameters)
 -> GlobalState -> Identity GlobalState)
-> Parameters -> GlobalState -> GlobalState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Form Parameters Event Name -> Parameters
forall s e n. Form s e n -> s
formState Form Parameters Event Name
f)
                                      (PS
s PS -> Getting String PS String -> String
forall s a. s -> Getting a s a -> a
^. Getting String PS String
Lens' PS String
psFp)
                                      (PS
s PS -> Getting [Card] PS [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^. Getting [Card] PS [Card]
Lens' PS [Card]
psCards))
                    else PS -> EventM Name (Next GlobalState)
forall n. PS -> EventM n (Next GlobalState)
continue' (PS
s PS -> (PS -> PS) -> PS
forall a b. a -> (a -> b) -> b
& (Form Parameters Event Name
 -> Identity (Form Parameters Event Name))
-> PS -> Identity PS
Lens' PS (Form Parameters Event Name)
psForm ((Form Parameters Event Name
  -> Identity (Form Parameters Event Name))
 -> PS -> Identity PS)
-> Form Parameters Event Name -> PS -> PS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Form Parameters Event Name
f)

handleEvent GlobalState
gs PS
_ BrickEvent Name Event
_ = GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs