module UI.Settings (State, drawUI, handleEvent, theMap) 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 States
import StateManagement
import Settings
import qualified Graphics.Vty as V

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

ui :: SS -> Widget Name
ui :: SS -> Widget Name
ui SS
f =
  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
"Settings")) 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
  (SS -> Widget Name
forall n s e. Eq n => Form s e n -> Widget n
renderForm SS
f)

handleEvent :: GlobalState -> SS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent :: GlobalState
-> SS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent GlobalState
gs SS
form ev :: BrickEvent Name Event
ev@(VtyEvent Event
e) =
  let update :: SS -> GlobalState
update = GlobalState -> SS -> GlobalState
updateSS GlobalState
gs
      continue' :: SS -> EventM n (Next GlobalState)
continue' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (SS -> GlobalState) -> SS -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SS -> GlobalState
update
      halt' :: GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
global = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> GlobalState
popState GlobalState
global) EventM n (Next GlobalState)
-> EventM n Event -> EventM n (Next GlobalState)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO Event -> EventM n Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Settings -> IO Event
setSettings (SS -> Settings
forall s e n. Form s e n -> s
formState SS
form))

      focus :: FocusRing Name
focus = SS -> FocusRing Name
forall s e n. Form s e n -> FocusRing n
formFocus SS
form
      (Just Name
n) = FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focus
      down :: EventM n (Next GlobalState)
down = if Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
MaxRecentsField then GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
        else SS -> EventM n (Next GlobalState)
forall n. SS -> EventM n (Next GlobalState)
continue' (SS -> EventM n (Next GlobalState))
-> SS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ SS
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 = if Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
HintsField then GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
        else SS -> EventM n (Next GlobalState)
forall n. SS -> EventM n (Next GlobalState)
continue' (SS -> EventM n (Next GlobalState))
-> SS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ SS
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
_ -> SS -> EventM Name (Next GlobalState)
forall n. SS -> EventM n (Next GlobalState)
continue' (SS -> EventM Name (Next GlobalState))
-> EventM Name SS -> EventM Name (Next GlobalState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BrickEvent Name Event -> SS -> EventM Name SS
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormEvent BrickEvent Name Event
ev SS
form

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