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 (unless)
import Control.Monad.IO.Class
import Lens.Micro.Platform
import States
import StateManagement
import Settings
import qualified Brick.Types as T
import qualified Graphics.Vty as V
import UI.BrickHelpers (scrollableViewportPercent, handleClickScroll)

drawUI :: SS -> [Widget Name]
drawUI :: SS -> [Widget Name]
drawUI = (forall a. a -> [a] -> [a]
:[]) 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 =
  forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$
  forall n. Widget n -> Widget n
center forall a b. (a -> b) -> a -> b
$
  forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
unicodeRounded forall a b. (a -> b) -> a -> b
$
  forall n. Widget n -> Widget n
border forall a b. (a -> b) -> a -> b
$
  forall n. Int -> Widget n -> Widget n
hLimitPercent Int
60 forall a b. (a -> b) -> a -> b
$
  forall n. Int -> Widget n -> Widget n
hLimit Int
40 forall a b. (a -> b) -> a -> b
$
  forall n. Widget n -> Widget n
hCenter (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr (forall n. String -> Widget n
str String
"Settings")) forall n. Widget n -> Widget n -> Widget n
<=>
  forall n. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=> 
  Int -> Name -> Widget Name -> Widget Name
scrollableViewportPercent Int
60 Name
SettingsViewport 
  (forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n s e. Eq n => Form s e n -> Widget n
renderForm SS
f)

scroll :: Int -> EventM Name s ()
scroll = forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (forall n. n -> ViewportScroll n
viewportScroll Name
SettingsViewport)

handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
handleEvent :: BrickEvent Name () -> EventM Name GlobalState ()
handleEvent ev :: BrickEvent Name ()
ev@(VtyEvent Event
e) = do
  SS
form <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState SS
ss
  let halt' :: EventM Name GlobalState ()
halt' = forall (m :: * -> *). MonadState GlobalState m => m ()
popState forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Settings -> IO ()
setSettings (forall s e n. Form s e n -> s
formState SS
form))
      focus :: FocusRing Name
focus = forall s e n. Form s e n -> FocusRing n
formFocus SS
form
      (Just Name
n) = forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focus
      down :: EventM Name GlobalState ()
down = if Name
n forall a. Eq a => a -> a -> Bool
/= Name
MaxRecentsField then
               Lens' GlobalState SS
ss forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SS
form { formFocus :: FocusRing Name
formFocus = forall n. FocusRing n -> FocusRing n
focusNext FocusRing Name
focus }
             else forall {s}. Int -> EventM Name s ()
scroll Int
1
      up :: EventM Name GlobalState ()
up = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Name
n forall a. Eq a => a -> a -> Bool
== Name
HintsField) forall a b. (a -> b) -> a -> b
$
             Lens' GlobalState SS
ss forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SS
form { formFocus :: FocusRing Name
formFocus = forall n. FocusRing n -> FocusRing n
focusPrev FocusRing Name
focus }


  case Event
e of
    V.EvKey Key
V.KEsc []         -> EventM Name GlobalState ()
halt'
    V.EvKey (V.KChar Char
'q') []  -> EventM Name GlobalState ()
halt'
    V.EvKey Key
V.KDown []        -> EventM Name GlobalState ()
down
    V.EvKey (V.KChar Char
'j') []  -> EventM Name GlobalState ()
down
    V.EvKey Key
V.KUp []          -> EventM Name GlobalState ()
up
    V.EvKey (V.KChar Char
'k') []  -> EventM Name GlobalState ()
up
    V.EvKey (V.KChar Char
'\t') [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    V.EvKey Key
V.KBackTab []     -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Event
_ -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' GlobalState SS
ss forall a b. (a -> b) -> a -> b
$ forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent BrickEvent Name ()
ev

handleEvent (T.MouseDown (SBClick ClickableScrollbarElement
el Name
SettingsViewport) Button
_ [Modifier]
_ Location
_) = forall n s.
(Int -> EventM n s ())
-> ClickableScrollbarElement -> EventM n s ()
handleClickScroll forall {s}. Int -> EventM Name s ()
scroll ClickableScrollbarElement
el
handleEvent BrickEvent Name ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()