{-# LANGUAGE FlexibleContexts #-}

module UI.CardSelector
  ( State
  , drawUI
  , handleEvent
  , theMap
  , getRecents
  , getRecentsFile
  , addRecent ) where

import Brick
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import Control.Exception (displayException, try)
import Control.Monad.IO.Class
import Control.Monad.State.Class
import Lens.Micro.Platform
import Parser
import Recents
import Runners
import States
import StateManagement
import UI.Attributes hiding (theMap)
import UI.BrickHelpers
import qualified Brick.Widgets.List as L
import qualified Graphics.Vty as V
import qualified Stack as S
import qualified UI.Attributes as A

drawUI :: GlobalState -> CSS -> [Widget Name]
drawUI :: GlobalState -> CSS -> [Widget Name]
drawUI GlobalState
gs CSS
s =
  [ forall n. Maybe String -> Widget n
drawException (CSS
s forall s a. s -> Getting a s a -> a
^. Lens' CSS (Maybe String)
exception), GlobalState -> CSS -> Widget Name
drawMenu GlobalState
gs CSS
s ]

title :: Widget Name
title :: Widget Name
title = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Select a deck of flashcards "

drawMenu :: GlobalState -> CSS -> Widget Name
drawMenu :: GlobalState -> CSS -> Widget Name
drawMenu GlobalState
gs CSS
s =
  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. Widget n -> Widget n
hCenter Widget Name
title forall n. Widget n -> Widget n -> Widget n
<=>
  forall n. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=>
  forall n. Widget n -> Widget n
hCenter (CSS -> Widget Name
drawList CSS
s)

drawList :: CSS -> Widget Name
drawList :: CSS -> Widget Name
drawList CSS
s = forall n. Int -> Widget n -> Widget n
vLimit (CSS
s forall s a. s -> Getting a s a -> a
^. Lens' CSS Int
maxRecentsToShow forall a. Num a => a -> a -> a
+ Int
1)  forall a b. (a -> b) -> a -> b
$
             forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
L.renderListWithIndex (List Name String -> Int -> Bool -> String -> Widget Name
drawListElement List Name String
l) Bool
True List Name String
l
              where l :: List Name String
l = CSS
s forall s a. s -> Getting a s a -> a
^. Lens' CSS (List Name String)
list

drawListElement :: L.List Name String -> Int -> Bool -> String -> Widget Name
drawListElement :: List Name String -> Int -> Bool -> String -> Widget Name
drawListElement List Name String
l Int
i Bool
selected = forall n. (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr (forall n. Widget n -> Widget n
wAttr1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n
wAttr2)
  where wAttr1 :: Widget n -> Widget n
wAttr1 = if Bool
selected then forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
selectedAttr else forall a. a -> a
id
        wAttr2 :: Widget n -> Widget n
wAttr2 = if Int
i forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length List Name String
l forall a. Num a => a -> a -> a
- Int
1 then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
lastElementAttr else forall a. a -> a
id

lastElementAttr :: AttrName
lastElementAttr :: AttrName
lastElementAttr = String -> AttrName
attrName String
"last element"

theMap :: AttrMap
theMap :: AttrMap
theMap = [(AttrName, Attr)] -> AttrMap -> AttrMap
applyAttrMappings
    [ (AttrName
L.listAttr, Attr
V.defAttr)
    , (AttrName
selectedAttr, Color -> Attr
fg Color
V.white Attr -> Style -> Attr
`V.withStyle` Style
V.underline)
    , (AttrName
titleAttr, Color -> Attr
fg Color
V.yellow)
    , (AttrName
lastElementAttr, Color -> Attr
fg Color
V.blue) ] AttrMap
A.theMap

handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
handleEvent :: BrickEvent Name () -> EventM Name GlobalState ()
handleEvent (VtyEvent Event
ev) = do
  List Name String
l <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CSS
cssforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CSS (List Name String)
list
  Maybe String
exc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CSS
cssforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CSS (Maybe String)
exception
  case (Maybe String
exc, Event
ev) of
    (Just String
_, Event
_) -> Lens' GlobalState CSS
cssforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CSS (Maybe String)
exception forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
    (Maybe String
_, Event
e) -> case Event
e of
      V.EvKey Key
V.KEsc [] -> forall (m :: * -> *). MonadState GlobalState m => m ()
popState
      V.EvKey (V.KChar Char
'q') []  -> forall (m :: * -> *). MonadState GlobalState m => m ()
popState

      Event
_ -> do forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' GlobalState CSS
cssforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CSS (List Name String)
list) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
(Event -> EventM n (GenericList n t e) ())
-> Event -> EventM n (GenericList n t e) ()
L.handleListEventVi forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
L.handleListEvent Event
e
              case Event
e of
                V.EvKey Key
V.KEnter [] -> do
                  Maybe (Int, String)
selected <- forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
L.listSelectedElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' GlobalState CSS
cssforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CSS (List Name String)
list)
                  case Maybe (Int, String)
selected of
                    Just (Int
_, String
"Select file from system") -> do
                      State
fbs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO State
fileBrowserState
                      forall (m :: * -> *). MonadState GlobalState m => State -> m ()
goToState State
fbs
                    Just (Int
i, String
_) -> do
                        String
fp <- (forall a. Stack a -> Int -> a
`S.unsafeElemAt` Int
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' GlobalState CSS
cssforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CSS (Stack String)
recents)
                        Either IOError String
fileOrExc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
readFile String
fp) :: IO (Either IOError String))
                        case Either IOError String
fileOrExc of
                          Left IOError
exc -> Lens' GlobalState CSS
cssforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CSS (Maybe String)
exception forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= forall e. Exception e => e -> String
displayException IOError
exc
                          Right String
file -> case String -> Either String [Card]
parseCards String
file of
                            Left String
parseError -> Lens' GlobalState CSS
cssforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CSS (Maybe String)
exception forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= String
parseError
                            Right [Card]
result -> do
                              forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' GlobalState CSS
css forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadState CSS m, MonadIO m) =>
String -> m ()
addRecentInternal String
fp
                              Parameters
params <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState Parameters
parameters
                              forall (m :: * -> *). MonadState GlobalState m => State -> m ()
goToState (Parameters -> String -> [Card] -> State
parameterState Parameters
params String
fp [Card]
result)
                Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleEvent BrickEvent Name ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

addRecentInternal ::(MonadState CSS m, MonadIO m) => FilePath -> m ()
addRecentInternal :: forall (m :: * -> *).
(MonadState CSS m, MonadIO m) =>
String -> m ()
addRecentInternal String
fp = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
addRecent String
fp
  forall (m :: * -> *). (MonadState CSS m, MonadIO m) => m ()
refreshRecents