1module UI.CardSelector
2  ( State
3  , drawUI
4  , handleEvent
5  , theMap
6  , getRecents
7  , getRecentsFile
8  , addRecent ) where
9
10import Brick
11import Brick.Widgets.Border
12import Brick.Widgets.Border.Style
13import Brick.Widgets.Center
14import Control.Exception (displayException, try)
15import Control.Monad.IO.Class
16import Lens.Micro.Platform
17import Parser
18import Recents
19import Runners
20import States
21import StateManagement
22import UI.Attributes hiding (theMap)
23import UI.BrickHelpers
24import qualified Brick.Widgets.List as L
25import qualified Graphics.Vty as V
26import qualified Stack as S
27import qualified UI.Attributes as A
28
29drawUI :: GlobalState -> CSS -> [Widget Name]
30drawUI gs s =
31  [ drawException (s ^. exception), drawMenu gs s ]
32
33title :: Widget Name
34title = withAttr titleAttr $ str "Select a deck of flashcards "
35
36shuffledWidget :: Bool -> Widget Name
37shuffledWidget shuffled = withAttr shuffledAttr $ str $
38    if shuffled then "(Shuffled)" else ""
39
40drawMenu :: GlobalState -> CSS -> Widget Name
41drawMenu gs s =
42  joinBorders $
43  center $
44  withBorderStyle unicodeRounded $
45  border $
46  hLimitPercent 60 $
47  hCenter (title <+> shuffledWidget (gs^.doShuffle)) <=>
48  hBorder <=>
49  hCenter (drawList s)
50
51drawList :: CSS -> Widget Name
52drawList s = vLimit (s ^. maxRecentsToShow + 1)  $
53             L.renderListWithIndex (drawListElement l) True l
54              where l = s ^. list
55
56drawListElement :: L.List Name String -> Int -> Bool -> String -> Widget Name
57drawListElement l i selected = hCenteredStrWrapWithAttr (wAttr1 . wAttr2)
58  where wAttr1 = if selected then withDefAttr selectedAttr else id
59        wAttr2 = if i == length l - 1 then withAttr lastElementAttr else id
60
61lastElementAttr :: AttrName
62lastElementAttr = attrName "last element"
63
64theMap :: AttrMap
65theMap = applyAttrMappings
66    [ (L.listAttr, V.defAttr)
67    , (selectedAttr, fg V.white `V.withStyle` V.underline)
68    , (titleAttr, fg V.yellow)
69    , (lastElementAttr, fg V.blue) ] A.theMap
70
71handleEvent :: GlobalState -> CSS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
72handleEvent gs s@CSS{_list=l, _exception=exc} (VtyEvent ev) =
73  let update = updateCSS gs
74      continue' = continue . update
75      halt' = continue . popState in
76        case (exc, ev) of
77          (Just _, _) -> continue' $ s & exception .~ Nothing
78          (_, e) -> case e of
79            V.EvKey V.KEsc [] -> halt' gs
80            V.EvKey (V.KChar 's') []  -> continue (gs & doShuffle %~ not)
81
82            _ -> do l' <- L.handleListEventVi L.handleListEvent e l
83                    let s' = (s & list .~ l') in
84                      case e of
85                        V.EvKey V.KEnter [] ->
86                          case L.listSelectedElement l' of
87                            Nothing -> continue' s'
88                            Just (_, "Select file from system") ->
89                              let gs' = update s' in continue =<< (gs' `goToState`) <$> liftIO fileBrowserState
90                            Just (i, _) -> do
91                                let fp = (s' ^. recents) `S.unsafeElemAt` i
92                                fileOrExc <- liftIO (try (readFile fp) :: IO (Either IOError String))
93                                case fileOrExc of
94                                  Left exc -> continue' (s' & exception ?~ displayException exc)
95                                  Right file -> case parseCards file of
96                                    Left parseError -> continue' (s' & exception ?~ parseError)
97                                    Right result -> continue =<< liftIO (do
98                                      s'' <- addRecentInternal s' fp
99                                      let gs' = update s''
100                                      (gs' `goToState`) <$> cardsWithOptionsState gs' fp result)
101                        _ -> continue' s'
102
103handleEvent gs _ _ = continue gs
104
105addRecentInternal :: CSS -> FilePath -> IO CSS
106addRecentInternal s fp = do
107  addRecent fp
108  refreshRecents s