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 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 -> GenericList Name Vector 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 (GenericList Name Vector String
-> Int -> Bool -> String -> Widget Name
drawListElement GenericList Name Vector String
l) Bool
True GenericList Name Vector String
l
              where l :: GenericList Name Vector String
l = CSS
s CSS
-> Getting
     (GenericList Name Vector String)
     CSS
     (GenericList Name Vector String)
-> GenericList Name Vector String
forall s a. s -> Getting a s a -> a
^. Getting
  (GenericList Name Vector String)
  CSS
  (GenericList Name Vector String)
Lens' CSS (GenericList Name Vector String)
list

drawListElement :: L.List Name String -> Int -> Bool -> String -> Widget Name
drawListElement :: GenericList Name Vector String
-> Int -> Bool -> String -> Widget Name
drawListElement GenericList Name Vector 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
== GenericList Name Vector String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList Name Vector 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 :: GlobalState -> CSS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent :: GlobalState
-> CSS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent GlobalState
gs s :: CSS
s@CSS{_list :: CSS -> GenericList Name Vector String
_list=GenericList Name Vector String
l, _exception :: CSS -> Maybe String
_exception=Maybe String
exc} (VtyEvent Event
ev) =
  let update :: CSS -> GlobalState
update = GlobalState -> CSS -> GlobalState
updateCSS GlobalState
gs
      continue' :: CSS -> EventM n (Next GlobalState)
continue' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (CSS -> GlobalState) -> CSS -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSS -> GlobalState
update
      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 in
        case (Maybe String
exc, Event
ev) of
          (Just String
_, Event
_) -> CSS -> EventM Name (Next GlobalState)
forall n. CSS -> EventM n (Next GlobalState)
continue' (CSS -> EventM Name (Next GlobalState))
-> CSS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CSS
s CSS -> (CSS -> CSS) -> CSS
forall a b. a -> (a -> b) -> b
& (Maybe String -> Identity (Maybe String)) -> CSS -> Identity CSS
Lens' CSS (Maybe String)
exception ((Maybe String -> Identity (Maybe String)) -> CSS -> Identity CSS)
-> Maybe String -> CSS -> CSS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe String
forall a. Maybe a
Nothing
          (Maybe String
_, Event
e) -> 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

            Event
_ -> do GenericList Name Vector String
l' <- (Event
 -> GenericList Name Vector String
 -> EventM Name (GenericList Name Vector String))
-> Event
-> GenericList Name Vector String
-> EventM Name (GenericList Name Vector String)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
(Event -> GenericList n t e -> EventM n (GenericList n t e))
-> Event -> GenericList n t e -> EventM n (GenericList n t e)
L.handleListEventVi Event
-> GenericList Name Vector String
-> EventM Name (GenericList Name Vector String)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
L.handleListEvent Event
e GenericList Name Vector String
l
                    let s' :: CSS
s' = (CSS
s CSS -> (CSS -> CSS) -> CSS
forall a b. a -> (a -> b) -> b
& (GenericList Name Vector String
 -> Identity (GenericList Name Vector String))
-> CSS -> Identity CSS
Lens' CSS (GenericList Name Vector String)
list ((GenericList Name Vector String
  -> Identity (GenericList Name Vector String))
 -> CSS -> Identity CSS)
-> GenericList Name Vector String -> CSS -> CSS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GenericList Name Vector String
l') in
                      case Event
e of
                        V.EvKey Key
V.KEnter [] ->
                          case GenericList Name Vector String -> Maybe (Int, String)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
L.listSelectedElement GenericList Name Vector String
l' of
                            Maybe (Int, String)
Nothing -> CSS -> EventM Name (Next GlobalState)
forall n. CSS -> EventM n (Next GlobalState)
continue' CSS
s'
                            Just (Int
_, String
"Select file from system") ->
                              let gs' :: GlobalState
gs' = CSS -> GlobalState
update CSS
s' in 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 IO State
fileBrowserState
                            Just (Int
i, String
_) -> do
                                let fp :: String
fp = (CSS
s' CSS -> Getting (Stack String) CSS (Stack String) -> Stack String
forall s a. s -> Getting a s a -> a
^. Getting (Stack String) CSS (Stack String)
Lens' CSS (Stack String)
recents) Stack String -> Int -> String
forall a. Stack a -> Int -> a
`S.unsafeElemAt` Int
i
                                Either IOError String
fileOrExc <- IO (Either IOError String) -> EventM Name (Either IOError String)
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 -> EventM Name (Next GlobalState)
forall n. CSS -> EventM n (Next GlobalState)
continue' (CSS
s' CSS -> (CSS -> CSS) -> CSS
forall a b. a -> (a -> b) -> b
& (Maybe String -> Identity (Maybe String)) -> CSS -> Identity CSS
Lens' CSS (Maybe String)
exception ((Maybe String -> Identity (Maybe String)) -> CSS -> Identity CSS)
-> String -> CSS -> CSS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ 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 -> EventM Name (Next GlobalState)
forall n. CSS -> EventM n (Next GlobalState)
continue' (CSS
s' CSS -> (CSS -> CSS) -> CSS
forall a b. a -> (a -> b) -> b
& (Maybe String -> Identity (Maybe String)) -> CSS -> Identity CSS
Lens' CSS (Maybe String)
exception ((Maybe String -> Identity (Maybe String)) -> CSS -> Identity CSS)
-> String -> CSS -> CSS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String
parseError)
                                    Right [Card]
result -> 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
=<< IO GlobalState -> EventM Name GlobalState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
                                      CSS
s'' <- CSS -> String -> IO CSS
addRecentInternal CSS
s' String
fp
                                      let gs' :: GlobalState
gs' = CSS -> GlobalState
update CSS
s''
                                      GlobalState -> IO GlobalState
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalState
gs' GlobalState -> State -> GlobalState
`goToState` Parameters -> String -> [Card] -> State
parameterState (GlobalState
gs'GlobalState
-> Getting Parameters GlobalState Parameters -> Parameters
forall s a. s -> Getting a s a -> a
^.Getting Parameters GlobalState Parameters
Lens' GlobalState Parameters
parameters) String
fp [Card]
result))
                        Event
_ -> CSS -> EventM Name (Next GlobalState)
forall n. CSS -> EventM n (Next GlobalState)
continue' CSS
s'

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

addRecentInternal :: CSS -> FilePath -> IO CSS
addRecentInternal :: CSS -> String -> IO CSS
addRecentInternal CSS
s String
fp = do
  String -> IO Event
addRecent String
fp
  CSS -> IO CSS
refreshRecents CSS
s