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