{-# 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 =
  [ Maybe String -> Widget Name
forall n. Maybe String -> Widget n
drawException (CSS
s CSS -> Getting (Maybe String) CSS (Maybe String) -> Maybe String
forall s a. s -> Getting a s a -> a
^. Getting (Maybe String) CSS (Maybe String)
Lens' CSS (Maybe String)
exception), GlobalState -> CSS -> Widget Name
drawMenu GlobalState
gs CSS
s ]

title :: Widget Name
title :: Widget Name
title = AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
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 =
  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
$
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter Widget Name
title 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
<=>
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (CSS -> Widget Name
drawList CSS
s)

drawList :: CSS -> Widget Name
drawList :: CSS -> Widget Name
drawList CSS
s = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit (CSS
s CSS -> Getting Int CSS Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int CSS Int
Lens' CSS Int
maxRecentsToShow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)  (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
             (Int -> Bool -> String -> Widget Name)
-> Bool -> List Name String -> Widget Name
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 CSS
-> Getting (List Name String) CSS (List Name String)
-> List Name String
forall s a. s -> Getting a s a -> a
^. Getting (List Name String) CSS (List Name String)
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 = (Widget Name -> Widget Name) -> String -> Widget Name
forall n. (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr (Widget Name -> Widget Name
forall n. Widget n -> Widget n
wAttr1 (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall n. Widget n -> Widget n
wAttr2)
  where wAttr1 :: Widget n -> Widget n
wAttr1 = if Bool
selected then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
selectedAttr else Widget n -> Widget n
forall a. a -> a
id
        wAttr2 :: Widget n -> Widget n
wAttr2 = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== List Name String -> Int
forall a. GenericList Name Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length List Name String
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
lastElementAttr else Widget n -> Widget n
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 <- Getting (List Name String) GlobalState (List Name String)
-> EventM Name GlobalState (List Name String)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (List Name String) GlobalState (List Name String)
 -> EventM Name GlobalState (List Name String))
-> Getting (List Name String) GlobalState (List Name String)
-> EventM Name GlobalState (List Name String)
forall a b. (a -> b) -> a -> b
$ (CSS -> Const (List Name String) CSS)
-> GlobalState -> Const (List Name String) GlobalState
Lens' GlobalState CSS
css((CSS -> Const (List Name String) CSS)
 -> GlobalState -> Const (List Name String) GlobalState)
-> Getting (List Name String) CSS (List Name String)
-> Getting (List Name String) GlobalState (List Name String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting (List Name String) CSS (List Name String)
Lens' CSS (List Name String)
list
  Maybe String
exc <- Getting (Maybe String) GlobalState (Maybe String)
-> EventM Name GlobalState (Maybe String)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe String) GlobalState (Maybe String)
 -> EventM Name GlobalState (Maybe String))
-> Getting (Maybe String) GlobalState (Maybe String)
-> EventM Name GlobalState (Maybe String)
forall a b. (a -> b) -> a -> b
$ (CSS -> Const (Maybe String) CSS)
-> GlobalState -> Const (Maybe String) GlobalState
Lens' GlobalState CSS
css((CSS -> Const (Maybe String) CSS)
 -> GlobalState -> Const (Maybe String) GlobalState)
-> Getting (Maybe String) CSS (Maybe String)
-> Getting (Maybe String) GlobalState (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting (Maybe String) CSS (Maybe String)
Lens' CSS (Maybe String)
exception
  case (Maybe String
exc, Event
ev) of
    (Just String
_, Event
_) -> (CSS -> Identity CSS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CSS
css((CSS -> Identity CSS) -> GlobalState -> Identity GlobalState)
-> ((Maybe String -> Identity (Maybe String))
    -> CSS -> Identity CSS)
-> (Maybe String -> Identity (Maybe String))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe String -> Identity (Maybe String)) -> CSS -> Identity CSS
Lens' CSS (Maybe String)
exception ((Maybe String -> Identity (Maybe String))
 -> GlobalState -> Identity GlobalState)
-> Maybe String -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe String
forall a. Maybe a
Nothing
    (Maybe String
_, Event
e) -> case Event
e of
      V.EvKey Key
V.KEsc [] -> EventM Name GlobalState ()
forall (m :: * -> *). MonadState GlobalState m => m ()
popState
      V.EvKey (V.KChar Char
'q') []  -> EventM Name GlobalState ()
forall (m :: * -> *). MonadState GlobalState m => m ()
popState

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

handleEvent BrickEvent Name ()
_ = () -> EventM Name GlobalState ()
forall a. a -> EventM Name GlobalState a
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
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
addRecent String
fp
  m ()
forall (m :: * -> *). (MonadState CSS m, MonadIO m) => m ()
refreshRecents