Yvee1/hascard
1
1
Fork 0
mirror of https://github.com/Yvee1/hascard.git synced 2024-11-22 12:51:58 +03:00
Code Issues Projects Releases Wiki Activity

Make it compile and basic functionality

Browse Source
This commit is contained in:
Steven van den Broek 2020-08-02 12:15:55 +02:00
parent d45921e57f
commit 33fb7881b3
13 changed files with 307 additions and 213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
app/Main.hs
View File

@ -14,6 +14,8 @@ import System.Directory (makeAbsolute)
import System.FilePath (takeExtension)
import System.Process (runCommand)
import System.Random.MWC (createSystemRandom, GenIO)
import qualified Data.Map.Strict as Map (empty)
import qualified Stack
data Opts = Opts
{ _optFile :: Maybe String
@ -54,7 +56,7 @@ nothingIf p a
run :: Opts -> IO ()
run opts = run' (opts ^. optFile)
where
mkGlobalState gen = GlobalState {_mwc=gen, _doShuffle=opts^.optShuffle, _subset=nothingIf (<0) (opts^.optSubset) }
mkGlobalState gen = GlobalState {_mwc=gen, _doShuffle=opts^.optShuffle, _subset=nothingIf (<0) (opts^.optSubset), _states=Map.empty, _stack=Stack.empty }
run' Nothing = createSystemRandom >>= start Nothing . mkGlobalState
run' (Just file) = do
let filepath =
@ -76,5 +78,5 @@ run opts = run' (opts ^. optFile)
start (Just result) (mkGlobalState gen)
start :: Maybe [Card] -> GlobalState -> IO ()
start Nothing gs = runBrickFlashcards gs
start (Just cards) gs = runCardsWithOptions gs cards
start Nothing gs = runBrickFlashcards (runMainMenuUI gs)
start (Just cards) gs = runBrickFlashcards =<< runCardsWithOptions gs cards

11
src/DeckHandling.hs Normal file
View File

@ -0,0 +1,11 @@
module DeckHandling where
import Data.Random
import Lens.Micro.Platform
import States
import Types
doRandomization :: GlobalState -> [Card] -> IO [Card]
doRandomization state cards =
let n = length cards in do
cards' <- if state^.doShuffle then sampleFrom (state^.mwc) (shuffleN n cards) else return cards
return $ maybe cards' (`take` cards') (state^.subset)

34
src/Glue.hs
View File

@ -48,29 +48,13 @@ handleAttrMap gs = case getState gs of
FileBrowserState _ -> FB.theMap
CardsState _ -> C.theMap
runCardsUI :: GlobalState -> [Card] -> IO GlobalState
runCardsUI gs deck = do
hints <- S.getShowHints
controls <- S.getShowControls
-- runMainMenuUI :: GlobalState -> GlobalState
-- runMainMenuUI gs =
-- let options = Vec.fromList
-- [ "Select"
-- , "Info"
-- , "Settings"
-- , "Quit" ]
let initialState =
C.State { C._cards = deck
, C._index = 0
, C._currentCard = head deck
, C._cardState = C.defaultCardState (head deck)
, C._nCards = length deck
, C._showHints = hints
, C._showControls = controls }
return $ goToState initialState
runMainMenuUI :: GlobalState -> GlobalState
runMainMenuUI gs =
let options = Vec.fromList
[ "Select"
, "Info"
, "Settings"
, "Quit" ]
initialState = MM.State (L.list () options 1) gs in
goToState initialState
-- initialState = MMS (L.list () options 1) in
-- gs `goToState` MainMenuState initialState

93
src/Recents.hs Normal file
View File

@ -0,0 +1,93 @@
module Recents where
import Control.Monad (filterM)
import Data.List (sort)
import Stack (Stack)
import System.Environment (lookupEnv)
import System.FilePath ((</>), splitFileName, dropExtension, splitPath, joinPath)
import qualified Data.Vector as Vec
import qualified Stack as S
import qualified System.Directory as D
import qualified System.IO.Strict as IOS (readFile)
getRecents :: IO (Stack FilePath)
getRecents = do
rf <- getRecentsFile
exists <- D.doesFileExist rf
if exists
then removeDeletedFiles rf
else return S.empty
removeDeletedFiles :: FilePath -> IO (Stack FilePath)
removeDeletedFiles fp = do
file <- IOS.readFile fp
existing <- S.fromList <$> filterM D.doesFileExist (lines file)
writeRecents existing
return existing
maxRecents :: Int
maxRecents = 5
addRecent :: FilePath -> IO ()
addRecent fp = do
rs <- getRecents
let rs' = fp `S.insert` rs
rs'' = if S.size rs' <= maxRecents
then rs'
else S.removeLast rs'
writeRecents rs''
writeRecents :: Stack FilePath -> IO ()
writeRecents stack = do
file <- getRecentsFile
writeFile file $ unlines (S.toList stack)
getRecentsFile :: IO FilePath
getRecentsFile = do
maybeSnap <- lookupEnv "SNAP_USER_DATA"
xdg <- D.getXdgDirectory D.XdgData "hascard"
let dir = case maybeSnap of
Just path | not (null path) -> path
| otherwise -> xdg
Nothing -> xdg
D.createDirectoryIfMissing True dir
return (dir </> "recents")
initLast :: [a] -> ([a], a)
initLast [x] = ([], x)
initLast (x:xs) = let (xs', y) = initLast xs
in (x:xs', y)
shortenFilepaths :: [FilePath] -> [FilePath]
shortenFilepaths fps = uncurry shortenFilepaths' (unzip (map ((\(pre, fn) -> (pre, dropExtension fn)) . splitFileName) fps))
where
shortenFilepaths' prefixes abbreviations =
let ds = duplicates abbreviations in
if null ds then abbreviations else
shortenFilepaths'
(flip map (zip [0..] prefixes) (
\(i, pre) -> if i `elem` ds then
joinPath (init (splitPath pre)) else pre
))
(flip map (zip [0..] abbreviations) (
\(i, abbr) -> if i `elem` ds then
last (splitPath (prefixes !! i)) ++ abbr
else abbr) )
duplicates :: Eq a => [a] -> [Int]
duplicates = sort . map fst . duplicates' 0 [] []
where duplicates' _ _ acc [] = acc
duplicates' i seen acc (x:xs) = duplicates' (i+1) ((i, x) : seen) acc' xs
where acc' = case (getPairsWithValue x acc, getPairsWithValue x seen) of
([], []) -> acc
([], ys) -> (i, x) : ys ++ acc
(_, _) -> (i, x) : acc
-- acc' = if getPairsWithValue x seen then (i, x) : acc else acc
getPairsWithValue :: Eq a => a -> [(Int, a)] -> [(Int, a)]
getPairsWithValue y [] = []
getPairsWithValue y ((i, x):xs)
| x == y = (i, x) : getPairsWithValue y xs
| otherwise = getPairsWithValue y xs

12
src/Stack.hs
View File

@ -27,8 +27,18 @@ safeHead = (`elemAt` 0)
last :: Stack a -> a
last s = s `unsafeElemAt` (Stack.size s - 1)
pop :: Ord a => Stack a -> Stack a
pop s = OS.delete (Stack.head s) s
popWithInfo :: Ord a => Stack a -> (Stack a, a, a)
popWithInfo s = let
top = Stack.head s
s' = OS.delete top s
top' = Stack.head s' in
(s', top, top')
tail :: Ord a => Stack a -> [a]
tail s = toList $ OS.delete (Stack.head s) s
tail = toList . pop
elemAt :: Stack a -> Int -> Maybe a
elemAt = OS.elemAt

76
src/States.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
module States where
import Brick.Widgets.FileBrowser
@ -23,6 +23,9 @@ data Mode = MainMenu
| Cards
deriving (Show, Eq, Ord)
-- class HasMode t where
-- getMode :: t -> Mode
data State = MainMenuState MMS
| SettingsState SS
| InfoState IS
@ -77,20 +80,31 @@ data CS = CS
, _showControls :: Bool
-- , _incorrectCards :: [Int] -- list of indices of incorrect answers
}
-- instance HasMode CS where
-- getMode = const Cards
newtype MMS = MMS
{ _l :: List Name String }
-- instance HasMode MMS where
-- getMode = const MainMenu
type IS = ()
-- instance HasMode IS where
-- getMode = const Info
type Settings = Map Int Bool
type SS = (Int, Settings)
-- instance HasMode SS where
-- getMode = const Settings
data CSS = CSS
{ _list :: List Name String
, _exception :: Maybe String
, _recents :: Stack FilePath
}
-- instance HasMode CSS where
-- getMode = const CardSelector
data FBS = FBS
{ _fb :: FileBrowser Name
@ -99,6 +113,16 @@ data FBS = FBS
, _filePath :: Maybe FilePath
, _showHidden :: Bool
}
-- instance HasMode FBS where
-- getMode = const FileBrowser
getMode :: State -> Mode
getMode (MainMenuState _) = MainMenu
getMode (SettingsState _) = Settings
getMode (InfoState _) = Info
getMode (CardSelectorState _) = CardSelector
getMode (FileBrowserState _) = FileBrowser
getMode (CardsState _) = Cards
makeLenses ''State
makeLenses ''MMS
@ -112,12 +136,13 @@ getState :: GlobalState -> State
getState = fromJust . safeGetState
updateState :: GlobalState -> State -> GlobalState
updateState gs s@(MainMenuState _) = gs & states %~ Map.insert MainMenu s
updateState gs s@(SettingsState _) = gs & states %~ Map.insert Settings s
updateState gs s@(InfoState _) = gs & states %~ Map.insert Info s
updateState gs s@(CardSelectorState _) = gs & states %~ Map.insert CardSelector s
updateState gs s@(FileBrowserState _) = gs & states %~ Map.insert FileBrowser s
-- updateState gs s@(MainMenuState _) = gs & states %~ Map.insert MainMenu s
-- updateState gs s@(MainMenuState _) = gs & states %~ Map.insert MainMenu s
-- updateState gs s@(SettingsState _) = gs & states %~ Map.insert Settings s
-- updateState gs s@(InfoState _) = gs & states %~ Map.insert Info s
-- updateState gs s@(CardSelectorState _) = gs & states %~ Map.insert CardSelector s
-- updateState gs s@(FileBrowserState _) = gs & states %~ Map.insert FileBrowser s
-- updateState gs s@(CardsState _) = gs & states %~ Map.insert Cards s
updateState gs s = gs & states %~ Map.insert (getMode s) s
updateMMS :: GlobalState -> MMS -> GlobalState
updateMMS gs s = updateState gs (MainMenuState s)
@ -125,6 +150,9 @@ updateMMS gs s = updateState gs (MainMenuState s)
updateSS :: GlobalState -> SS -> GlobalState
updateSS gs s = updateState gs (SettingsState s)
updateIS :: GlobalState -> IS -> GlobalState
updateIS gs s = updateState gs (InfoState s)
updateCS :: GlobalState -> CS -> GlobalState
updateCS gs s = updateState gs (CardsState s)
@ -137,17 +165,29 @@ updateInfo gs s = updateState gs (InfoState s)
updateFBS :: GlobalState -> FBS -> GlobalState
updateFBS gs s = updateState gs (FileBrowserState s)
goToState :: State -> GlobalState -> GlobalState
goToState s@(MainMenuState _) gs = gs & states %~ Map.insert MainMenu s
& stack %~ insert MainMenu
goToState s@(SettingsState _) gs = gs & states %~ Map.insert Settings s
& stack %~ insert Settings
goToState s@(InfoState _) gs = gs & states %~ Map.insert Info s
& stack %~ insert Info
goToState s@(CardSelectorState _) gs = gs & states %~ Map.insert CardSelector s
& stack %~ insert CardSelector
goToState s@(FileBrowserState _) gs = gs & states %~ Map.insert FileBrowser s
& stack %~ insert FileBrowser
goToState :: GlobalState -> State -> GlobalState
-- goToState gs s@(MainMenuState _) = gs & states %~ Map.insert MainMenu s
-- & stack %~ insert MainMenu
-- goToState gs s@(SettingsState _) = gs & states %~ Map.insert Settings s
-- & stack %~ insert Settings
-- goToState gs s@(InfoState _) = gs & states %~ Map.insert Info s
-- & stack %~ insert Info
-- goToState gs s@(CardSelectorState _) = gs & states %~ Map.insert CardSelector s
-- & stack %~ insert CardSelector
-- goToState gs s@(FileBrowserState _) = gs & states %~ Map.insert FileBrowser s
-- & stack %~ insert FileBrowser
-- goToState gs s@(CardsState _) = gs & states %~ Map.insert Cards s
-- & stack %~ insert Cards
goToState gs s = gs & states %~ Map.insert (getMode s) s
& stack %~ insert (getMode s)
popState :: GlobalState -> GlobalState
popState gs = let
s = gs ^. stack
top = Stack.head s
s' = Stack.pop s in
gs & states %~ Map.delete top
& stack .~ s'
safeGetState :: GlobalState -> Maybe State
safeGetState gs = do

21
src/UI.hs
View File

@ -1,13 +1,18 @@
module UI (module X, runBrickFlashcards) where
module UI (module X, runBrickFlashcards, GlobalState(..), Card) where
import UI.Cards as X (runCardsUI)
import UI.CardSelector as X
import UI.Cards as X (runCardsUI, runCardsWithOptions)
import UI.CardSelector as X (addRecent)
import UI.MainMenu as X (runMainMenuUI)
import UI.Settings as X
import Types as X (mwc, doShuffle, subset, Card)
import GlobalState as X (GlobalState (..))
import GlobalState (globalApp)
import UI.Settings as X (getUseEscapeCode)
-- import Types as X (mwc, doShuffle, subset, Card)
-- import GlobalState as X (GlobalState (..))
-- import GlobalState (globalApp)
import Brick
import Glue
import States
import Types (Card)
runBrickFlashcards :: GlobalState -> IO ()
runBrickFlashcards gs = do
defaultMain globalApp gs
_ <- defaultMain globalApp gs
return ()

152
src/UI/CardSelector.hs
View File

@ -6,7 +6,8 @@ module UI.CardSelector
, theMap
, getRecents
, getRecentsFile
, addRecent) where
, addRecent
, runCardSelectorUI ) where
import Brick
import Brick.Widgets.Border
@ -17,10 +18,9 @@ import Control.Monad (filterM)
import Control.Monad.IO.Class
import Data.Functor (void)
import Data.List (sort)
import Data.Random
import Lens.Micro.Platform
import Parser
import Stack (Stack)
import Recents
import System.Environment (lookupEnv)
import System.FilePath ((</>), splitFileName, dropExtension, splitPath, joinPath)
import States
@ -28,15 +28,21 @@ import Types
import UI.Attributes hiding (theMap)
import UI.BrickHelpers
import UI.FileBrowser (runFileBrowserUI)
import UI.Cards (Card)
import UI.Cards (Card, runCardsUI, runCardsWithOptions)
import qualified Brick.Widgets.List as L
import qualified Data.Vector as Vec
import qualified Graphics.Vty as V
import qualified Stack as S
import qualified System.Directory as D
import qualified System.IO.Strict as IOS (readFile)
import qualified UI.Attributes as A
runCardSelectorUI :: GlobalState -> IO GlobalState
runCardSelectorUI gs = do
rs <- getRecents
let prettyRecents = shortenFilepaths (S.toList rs)
let options = Vec.fromList (prettyRecents ++ ["Select file from system"])
let initialState = CSS (L.list () options 1) Nothing rs
return $ gs `goToState` CardSelectorState initialState
drawUI :: CSS -> [Widget Name]
drawUI s =
[ drawException (s ^. exception), drawMenu s ]
@ -79,12 +85,12 @@ handleEvent :: GlobalState -> CSS -> BrickEvent Name Event -> EventM Name (Next
handleEvent gs s@CSS{_list=l, _exception=exc} (VtyEvent ev) =
let update = updateCSS gs
continue' = continue . update
halt' = halt . update in
halt' = continue . popState in
case (exc, ev) of
(Just _, _) -> continue' $ s & exception .~ Nothing
(_, e) -> case e of
V.EvKey (V.KChar 'c') [V.MCtrl] -> halt gs
V.EvKey V.KEsc [] -> halt gs
V.EvKey (V.KChar 'c') [V.MCtrl] -> halt' gs
V.EvKey V.KEsc [] -> halt' gs
_ -> do l' <- L.handleListEventVi L.handleListEvent e l
let s' = (s & list .~ l') in
@ -92,7 +98,7 @@ handleEvent gs s@CSS{_list=l, _exception=exc} (VtyEvent ev) =
V.EvKey V.KEnter [] ->
case L.listSelectedElement l' of
Nothing -> continue' s'
Just (_, "Select file from system") -> liftIO (runFileBrowser (update s')) >>= continue
Just (_, "Select file from system") -> continue =<< liftIO (runFileBrowser (update s'))
Just (i, _) -> do
let fp = (s' ^. recents) `S.unsafeElemAt` i
fileOrExc <- liftIO (try (readFile fp) :: IO (Either IOError String))
@ -100,110 +106,20 @@ handleEvent gs s@CSS{_list=l, _exception=exc} (VtyEvent ev) =
Left exc -> continue' (s' & exception ?~ displayException exc)
Right file -> case parseCards file of
Left parseError -> continue' (s' & exception ?~ errorBundlePretty parseError)
Right result -> suspendAndResume $ do
Right result -> continue =<< liftIO (do
s'' <- addRecentInternal s' fp
-- _ <- runCardsWithOptions (s^.gs) result
return $ update (s'' & exception .~ Nothing)
let s''' = s'' & exception .~ Nothing
runCardsWithOptions (update s''') result)
-- return $ update ()
_ -> continue' s'
handleEvent gs _ _ = continue gs
-- runCardSelectorUI :: GlobalState -> IO ()
-- runCardSelectorUI gs = do
-- rs <- getRecents
-- let prettyRecents = shortenFilepaths (S.toList rs)
-- let options = Vec.fromList (prettyRecents ++ ["Select file from system"])
-- let initialState = State (L.list () options 1) Nothing rs gs
-- _ <- defaultMain app initialState
-- return ()
getRecents :: IO (Stack FilePath)
getRecents = do
rf <- getRecentsFile
exists <- D.doesFileExist rf
if exists
then removeDeletedFiles rf
else return S.empty
removeDeletedFiles :: FilePath -> IO (Stack FilePath)
removeDeletedFiles fp = do
file <- IOS.readFile fp
existing <- S.fromList <$> filterM D.doesFileExist (lines file)
writeRecents existing
return existing
maxRecents :: Int
maxRecents = 5
addRecent :: FilePath -> IO ()
addRecent fp = do
rs <- getRecents
let rs' = fp `S.insert` rs
rs'' = if S.size rs' <= maxRecents
then rs'
else S.removeLast rs'
writeRecents rs''
addRecentInternal :: CSS -> FilePath -> IO CSS
addRecentInternal s fp = do
addRecent fp
refreshRecents s
writeRecents :: Stack FilePath -> IO ()
writeRecents stack = do
file <- getRecentsFile
writeFile file $ unlines (S.toList stack)
getRecentsFile :: IO FilePath
getRecentsFile = do
maybeSnap <- lookupEnv "SNAP_USER_DATA"
xdg <- D.getXdgDirectory D.XdgData "hascard"
let dir = case maybeSnap of
Just path | not (null path) -> path
| otherwise -> xdg
Nothing -> xdg
D.createDirectoryIfMissing True dir
return (dir </> "recents")
initLast :: [a] -> ([a], a)
initLast [x] = ([], x)
initLast (x:xs) = let (xs', y) = initLast xs
in (x:xs', y)
shortenFilepaths :: [FilePath] -> [FilePath]
shortenFilepaths fps = uncurry shortenFilepaths' (unzip (map ((\(pre, fn) -> (pre, dropExtension fn)) . splitFileName) fps))
where
shortenFilepaths' prefixes abbreviations =
let ds = duplicates abbreviations in
if null ds then abbreviations else
shortenFilepaths'
(flip map (zip [0..] prefixes) (
\(i, pre) -> if i `elem` ds then
joinPath (init (splitPath pre)) else pre
))
(flip map (zip [0..] abbreviations) (
\(i, abbr) -> if i `elem` ds then
last (splitPath (prefixes !! i)) ++ abbr
else abbr) )
duplicates :: Eq a => [a] -> [Int]
duplicates = sort . map fst . duplicates' 0 [] []
where duplicates' _ _ acc [] = acc
duplicates' i seen acc (x:xs) = duplicates' (i+1) ((i, x) : seen) acc' xs
where acc' = case (getPairsWithValue x acc, getPairsWithValue x seen) of
([], []) -> acc
([], ys) -> (i, x) : ys ++ acc
(_, _) -> (i, x) : acc
-- acc' = if getPairsWithValue x seen then (i, x) : acc else acc
getPairsWithValue :: Eq a => a -> [(Int, a)] -> [(Int, a)]
getPairsWithValue y [] = []
getPairsWithValue y ((i, x):xs)
| x == y = (i, x) : getPairsWithValue y xs
| otherwise = getPairsWithValue y xs
runFileBrowser :: GlobalState -> IO GlobalState
runFileBrowser gs = do
result <- runFileBrowserUI gs
-- maybe (return s) (\(cards, fp) -> addRecentInternal s fp <* runCardsWithOptions (s^.gs) cards) result
return result
refreshRecents :: CSS -> IO CSS
refreshRecents s = do
@ -213,17 +129,7 @@ refreshRecents s = do
return $ s & recents .~ rs
& list .~ L.list () options 1
runFileBrowser :: GlobalState -> IO GlobalState
runFileBrowser gs = do
result <- runFileBrowserUI gs
-- maybe (return s) (\(cards, fp) -> addRecentInternal s fp <* runCardsWithOptions (s^.gs) cards) result
return result
-- runCardsWithOptions :: GlobalState -> [Card] -> IO ()
-- runCardsWithOptions state cards = void $ doRandomization state cards >>= runCardsUI state
-- doRandomization :: GlobalState -> [Card] -> IO [Card]
-- doRandomization state cards =
-- let n = length cards in do
-- cards' <- if state^.doShuffle then sampleFrom (state^.mwc) (shuffleN n cards) else return cards
-- return $ maybe cards' (`take` cards') (state^.subset)
addRecentInternal :: CSS -> FilePath -> IO CSS
addRecentInternal s fp = do
addRecent fp
refreshRecents s

31
src/UI/Cards.hs
View File

@ -1,4 +1,4 @@
module UI.Cards (Card, State(..), drawUI, handleEvent, theMap, defaultCardState) where
module UI.Cards (Card, State(..), drawUI, handleEvent, theMap, defaultCardState, runCardsUI, runCardsWithOptions) where
import Brick
import Lens.Micro.Platform
@ -10,6 +10,7 @@ import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Text.Wrap
import Data.Text (pack)
import DeckHandling
import UI.Attributes
import UI.BrickHelpers
import UI.Settings (getShowHints, getShowControls)
@ -45,6 +46,25 @@ defaultCardState (Reorder _ elements) = ReorderState
, _entered = False
, _number = NE.length elements }
runCardsUI :: GlobalState -> [Card] -> IO GlobalState
runCardsUI gs deck = do
hints <- getShowHints
controls <- getShowControls
let initialState =
CS { _cards = deck
, _index = 0
, _currentCard = head deck
, _cardState = defaultCardState (head deck)
, _nCards = length deck
, _showHints = hints
, _showControls = controls }
return $ gs `goToState` CardsState initialState
runCardsWithOptions :: GlobalState -> [Card] -> IO GlobalState
runCardsWithOptions state cards = doRandomization state cards >>= runCardsUI state
---------------------------------------------------
--------------------- DRAWING ---------------------
---------------------------------------------------
@ -266,10 +286,11 @@ drawReorder s elements = case (s ^. cardState, s ^. currentCard) of
handleEvent :: GlobalState -> CS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent gs s (VtyEvent e) =
let update = updateCS gs
continue' = continue . update in
continue' = continue . update
halt' = continue . popState in
case e of
V.EvKey V.KEsc [] -> halt gs
V.EvKey (V.KChar 'c') [V.MCtrl] -> halt gs
V.EvKey V.KEsc [] -> halt' gs
V.EvKey (V.KChar 'c') [V.MCtrl] -> halt' gs
V.EvKey V.KRight [V.MCtrl] -> next gs s
V.EvKey V.KLeft [V.MCtrl] -> previous gs s
@ -413,7 +434,7 @@ handleEvent gs _ _ = continue gs
next :: GlobalState -> CS -> EventM Name (Next GlobalState)
next gs s
| s ^. index + 1 < length (s ^. cards) = continue . updateCS gs . straightenState $ s & index +~ 1
| otherwise = halt gs
| otherwise = continue $ popState gs
previous :: GlobalState -> CS -> EventM Name (Next GlobalState)
previous gs s | s ^. index > 0 = continue . updateCS gs . straightenState $ s & index -~ 1

18
src/UI/FileBrowser.hs
View File

@ -13,7 +13,9 @@ import Control.Monad.IO.Class
import Lens.Micro.Platform
import Parser
import States
import Recents
import UI.BrickHelpers
import UI.Cards (runCardsWithOptions)
import qualified UI.Attributes as A
import qualified Graphics.Vty as V
@ -50,14 +52,14 @@ handleEvent :: GlobalState -> FBS -> BrickEvent Name Event -> EventM Name (Next
handleEvent gs s@FBS{_fb=b, _exception'=excep} (VtyEvent ev) =
let update = updateFBS gs
continue' = continue . update
halt' = halt . update in
halt' = continue . popState in
case (excep, ev) of
(Just _, _) -> continue' $ s & exception' .~ Nothing
(_, e) -> case e of
V.EvKey V.KEsc [] | not (fileBrowserIsSearching b) ->
halt gs
halt' gs
V.EvKey (V.KChar 'c') [V.MCtrl] | not (fileBrowserIsSearching b) ->
halt gs
halt' gs
V.EvKey (V.KChar 'h') [] | not (fileBrowserIsSearching b) -> let s' = s & showHidden %~ not in
continue' $ s' & fb .~ setFileBrowserEntryFilter (Just (entryFilter (s' ^. showHidden))) b
_ -> do
@ -76,8 +78,12 @@ handleEvent gs s@FBS{_fb=b, _exception'=excep} (VtyEvent ev) =
Left exc -> continue' (s' & exception' ?~ displayException exc)
Right file -> case parseCards file of
Left parseError -> continue' (s & exception' ?~ errorBundlePretty parseError)
Right result -> halt' (s' & parsedCards .~ result & filePath ?~ fp)
_ -> halt gs
-- Right result -> halt' (s' & parsedCards .~ result & filePath ?~ fp)
Right result -> continue =<< liftIO (do
addRecent fp
let s'' = s' & exception' .~ Nothing
runCardsWithOptions (update s'') result)
_ -> halt' gs
_ -> continue' s'
handleEvent gs _ _ = continue gs
@ -86,7 +92,7 @@ runFileBrowserUI :: GlobalState -> IO GlobalState
runFileBrowserUI gs = do
browser <- newFileBrowser selectNonDirectories () Nothing
let filteredBrowser = setFileBrowserEntryFilter (Just (entryFilter False)) browser
return $ goToState (FileBrowserState (FBS filteredBrowser Nothing [] Nothing False)) gs
return $ gs `goToState` FileBrowserState (FBS filteredBrowser Nothing [] Nothing False)
-- browser <- newFileBrowser selectNonDirectories () Nothing
-- let filteredBrowser = setFileBrowserEntryFilter (Just (entryFilter False)) browser

29
src/UI/Info.hs
View File

@ -8,7 +8,7 @@ import Control.Monad (void)
import States
import qualified Graphics.Vty as V
drawUI :: State -> [Widget Name]
drawUI :: IS -> [Widget Name]
drawUI = (:[]) . const ui
ui :: Widget Name
@ -22,18 +22,21 @@ ui =
hBorder <=>
drawInfo
handleEvent :: GlobalState -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent s (VtyEvent e) =
handleEvent :: GlobalState -> IS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent gs s (VtyEvent e) =
let update = updateIS gs
continue' = continue . update
halt' = continue . popState in
case e of
V.EvKey (V.KChar 'c') [V.MCtrl] -> halt s
V.EvKey V.KEsc [] -> halt s
V.EvKey V.KEnter [] -> halt s
V.EvKey V.KDown [] -> vScrollBy (viewportScroll ()) 1 >> continue s
V.EvKey (V.KChar 'j') [] -> vScrollBy (viewportScroll ()) 1 >> continue s
V.EvKey V.KUp [] -> vScrollBy (viewportScroll ()) (-1) >> continue s
V.EvKey (V.KChar 'k') [] -> vScrollBy (viewportScroll ()) (-1) >> continue s
_ -> continue s
handleEvent s _ = continue s
V.EvKey (V.KChar 'c') [V.MCtrl] -> halt' gs
V.EvKey V.KEsc [] -> halt' gs
V.EvKey V.KEnter [] -> halt' gs
V.EvKey V.KDown [] -> vScrollBy (viewportScroll ()) 1 >> continue' s
V.EvKey (V.KChar 'j') [] -> vScrollBy (viewportScroll ()) 1 >> continue' s
V.EvKey V.KUp [] -> vScrollBy (viewportScroll ()) (-1) >> continue' s
V.EvKey (V.KChar 'k') [] -> vScrollBy (viewportScroll ()) (-1) >> continue' s
_ -> continue' s
handleEvent gs _ _ = continue gs
titleAttr :: AttrName
titleAttr = attrName "title"
@ -49,7 +52,7 @@ drawInfo =
viewport () Vertical (strWrap info)
runInfoUI :: GlobalState -> GlobalState
runInfoUI = goToState (InfoState ())
runInfoUI = (`goToState` InfoState ())
info :: String
info =

26
src/UI/MainMenu.hs
View File

@ -1,22 +1,34 @@
{-# LANGUAGE TemplateHaskell #-}
module UI.MainMenu (State (..), drawUI, handleEvent, theMap) where
module UI.MainMenu (State (..), drawUI, handleEvent, theMap, runMainMenuUI) where
import Brick
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import Control.Monad.IO.Class
import Data.Functor (($>))
import Lens.Micro.Platform
import States
import UI.Attributes
import UI.BrickHelpers
-- import UI.CardSelector (runCardSelectorUI)
-- import UI.Info (runInfoUI)
-- import UI.Settings (runSettingsUI)
import UI.CardSelector (runCardSelectorUI)
import UI.Info (runInfoUI)
import UI.Settings (runSettingsUI)
import qualified Data.Vector as Vec
import qualified Graphics.Vty as V
import qualified Brick.Widgets.List as L
runMainMenuUI :: GlobalState -> GlobalState
runMainMenuUI gs =
let options = Vec.fromList
[ "Select"
, "Info"
, "Settings"
, "Quit" ]
initialState = MMS (L.list () options 1) in
gs `goToState` MainMenuState initialState
title :: Widget Name
title = withAttr titleAttr $
str "┬ ┬┌─┐┌─┐┌─┐┌─┐┬─┐┌┬┐" <=>
@ -54,9 +66,9 @@ handleEvent gs s (VtyEvent e) =
V.EvKey V.KEsc [] -> halt gs
V.EvKey V.KEnter [] ->
case L.listSelected (s^.l) of
-- Just 0 -> suspendAndResume $ runCardSelectorUI (s^.gs)$> s
-- Just 1 -> suspendAndResume $ runInfoUI $> s
-- Just 2 -> suspendAndResume $ runSettingsUI $> s
Just 0 -> continue =<< liftIO (runCardSelectorUI gs)
Just 1 -> continue $ runInfoUI gs
Just 2 -> continue =<< liftIO (runSettingsUI gs)
Just 3 -> halt gs
_ -> undefined

9
src/UI/Settings.hs
View File

@ -34,10 +34,11 @@ ui s =
handleEvent :: GlobalState -> SS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent gs s@(i, settings) (VtyEvent e) =
let update = updateSS gs in
let update = updateSS gs
halt' = continue . popState in
case e of
V.EvKey (V.KChar 'c') [V.MCtrl] -> halt gs
V.EvKey V.KEsc [] -> halt gs
V.EvKey (V.KChar 'c') [V.MCtrl] -> halt' gs
V.EvKey V.KEsc [] -> halt' gs
V.EvKey V.KEnter [] -> continue $ update (i, settings')
where settings' = M.adjust not i settings
V.EvKey V.KUp [] -> continue $ update (max 0 (i-1), settings)
@ -75,7 +76,7 @@ runSettingsUI :: GlobalState -> IO GlobalState
runSettingsUI gs = do
currentSettings <- getSettings
-- (_, newSettings) <- defaultMain app (0, currentSettings)
return $ goToState (SettingsState (0, currentSettings)) gs
return $ gs `goToState` SettingsState (0, currentSettings)
-- setSettings newSettings