From 388f84316e91dea187b82f21516312dc981abc82 Mon Sep 17 00:00:00 2001 From: Steven van den Broek Date: Mon, 3 Aug 2020 08:39:59 +0200 Subject: [PATCH] Fix menu navigation --- app/Main.hs | 4 ++-- src/Runners.hs | 38 +++++++++++++++++++------------------- src/States.hs | 7 +++++++ src/UI.hs | 2 +- src/UI/CardSelector.hs | 6 ++++-- src/UI/Cards.hs | 2 +- src/UI/FileBrowser.hs | 3 ++- src/UI/Info.hs | 2 +- src/UI/MainMenu.hs | 6 +++--- src/UI/Settings.hs | 2 +- 10 files changed, 41 insertions(+), 31 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 09266a3..9d7e404 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -78,5 +78,5 @@ run opts = run' (opts ^. optFile) start (Just result) (mkGlobalState gen) start :: Maybe [Card] -> GlobalState -> IO () -start Nothing gs = runBrickFlashcards (runMainMenuUI gs) -start (Just cards) gs = runBrickFlashcards =<< runCardsWithOptions gs cards \ No newline at end of file +start Nothing gs = runBrickFlashcards (gs `goToState` mainMenuState) +start (Just cards) gs = runBrickFlashcards =<< (gs `goToState`) <$> cardsWithOptionsState gs cards \ No newline at end of file diff --git a/src/Runners.hs b/src/Runners.hs index 4108424..bc0e4df 100644 --- a/src/Runners.hs +++ b/src/Runners.hs @@ -9,16 +9,16 @@ import qualified Brick.Widgets.List as L import qualified Data.Vector as Vec import qualified Stack as S -runCardSelectorUI :: GlobalState -> IO GlobalState -runCardSelectorUI gs = do +cardSelectorState :: IO State +cardSelectorState = 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 + return $ CardSelectorState initialState -runMainMenuUI :: GlobalState -> GlobalState -runMainMenuUI gs = +mainMenuState :: State +mainMenuState = let options = Vec.fromList [ "Select" , "Info" @@ -26,10 +26,10 @@ runMainMenuUI gs = , "Quit" ] initialState = MMS (L.list () options 1) in - gs `goToState` MainMenuState initialState + MainMenuState initialState -runCardsUI :: GlobalState -> [Card] -> IO GlobalState -runCardsUI gs deck = do +cardsState :: [Card] -> IO State +cardsState deck = do hints <- getShowHints controls <- getShowControls @@ -42,24 +42,24 @@ runCardsUI gs deck = do , _showHints = hints , _showControls = controls } - return $ gs `goToState` CardsState initialState + return $ CardsState initialState -runCardsWithOptions :: GlobalState -> [Card] -> IO GlobalState -runCardsWithOptions state cards = doRandomization state cards >>= runCardsUI state +cardsWithOptionsState :: GlobalState -> [Card] -> IO State +cardsWithOptionsState gs cards = doRandomization gs cards >>= cardsState -runSettingsUI :: GlobalState -> IO GlobalState -runSettingsUI gs = do +settingsState :: IO State +settingsState = do currentSettings <- getSettings - return $ gs `goToState` SettingsState (0, currentSettings) + return $ SettingsState (0, currentSettings) -runInfoUI :: GlobalState -> GlobalState -runInfoUI = (`goToState` InfoState ()) +infoState :: State +infoState = InfoState () -runFileBrowserUI :: GlobalState -> IO GlobalState -runFileBrowserUI gs = do +fileBrowserState :: IO State +fileBrowserState = do browser <- newFileBrowser selectNonDirectories () Nothing let filteredBrowser = setFileBrowserEntryFilter (Just (entryFilter False)) browser - return $ gs `goToState` FileBrowserState (FBS filteredBrowser Nothing [] Nothing False) + return $ FileBrowserState (FBS filteredBrowser Nothing [] Nothing False) entryFilter :: Bool -> FileInfo -> Bool entryFilter acceptHidden info = fileExtensionMatch "txt" info && (acceptHidden || diff --git a/src/States.hs b/src/States.hs index d29fab5..e11984a 100644 --- a/src/States.hs +++ b/src/States.hs @@ -174,6 +174,9 @@ goToState :: GlobalState -> State -> GlobalState goToState gs s = gs & states %~ M.insert (getMode s) s & stack %~ insert (getMode s) +moveToState :: GlobalState -> State -> GlobalState +moveToState gs = goToState (popState gs) + popState :: GlobalState -> GlobalState popState gs = let s = gs ^. stack @@ -190,3 +193,7 @@ safeGetState gs = do goToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState) goToModeOrQuit gs mode = maybe (halt gs) (continue . goToState gs) $ M.lookup mode (gs ^. states) + +moveToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState) +moveToModeOrQuit gs mode = + maybe (halt gs) (continue . moveToState gs) $ M.lookup mode (gs ^. states) \ No newline at end of file diff --git a/src/UI.hs b/src/UI.hs index 700106e..4b49d18 100644 --- a/src/UI.hs +++ b/src/UI.hs @@ -1,4 +1,4 @@ -module UI (module X, runBrickFlashcards, GlobalState(..), Card) where +module UI (module X, runBrickFlashcards, GlobalState(..), Card, goToState) where import UI.CardSelector as X (addRecent) import Settings as X (getUseEscapeCode) diff --git a/src/UI/CardSelector.hs b/src/UI/CardSelector.hs index 6e53447..872bdee 100644 --- a/src/UI/CardSelector.hs +++ b/src/UI/CardSelector.hs @@ -81,7 +81,8 @@ 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") -> continue =<< liftIO (runFileBrowserUI (update s')) + Just (_, "Select file from system") -> + let gs' = update s' in continue =<< (gs' `goToState`) <$> liftIO fileBrowserState Just (i, _) -> do let fp = (s' ^. recents) `S.unsafeElemAt` i fileOrExc <- liftIO (try (readFile fp) :: IO (Either IOError String)) @@ -91,7 +92,8 @@ handleEvent gs s@CSS{_list=l, _exception=exc} (VtyEvent ev) = Left parseError -> continue' (s' & exception ?~ errorBundlePretty parseError) Right result -> continue =<< liftIO (do s'' <- addRecentInternal s' fp - runCardsWithOptions (update s'') result) + let gs' = update s'' + (gs' `goToState`) <$> cardsWithOptionsState gs' result) _ -> continue' s' handleEvent gs _ _ = continue gs diff --git a/src/UI/Cards.hs b/src/UI/Cards.hs index 0fb77d1..069743f 100644 --- a/src/UI/Cards.hs +++ b/src/UI/Cards.hs @@ -244,7 +244,7 @@ handleEvent :: GlobalState -> CS -> BrickEvent Name Event -> EventM Name (Next G handleEvent gs s (VtyEvent e) = let update = updateCS gs continue' = continue . update - halt' = flip goToModeOrQuit CardSelector in + halt' = flip moveToModeOrQuit CardSelector in case e of V.EvKey V.KEsc [] -> halt' gs V.EvKey (V.KChar 'c') [V.MCtrl] -> halt' gs diff --git a/src/UI/FileBrowser.hs b/src/UI/FileBrowser.hs index 6ad3c3b..89e2776 100644 --- a/src/UI/FileBrowser.hs +++ b/src/UI/FileBrowser.hs @@ -79,7 +79,8 @@ handleEvent gs s@FBS{_fb=b, _exception'=excep} (VtyEvent ev) = -- Right result -> halt' (s' & parsedCards .~ result & filePath ?~ fp) Right result -> continue =<< liftIO (do addRecent fp - runCardsWithOptions (update s') result) + let gs' = update s' + (gs' `moveToState`) <$> cardsWithOptionsState (update s') result) _ -> halt' gs _ -> continue' s' diff --git a/src/UI/Info.hs b/src/UI/Info.hs index 7d0bfbf..f850385 100644 --- a/src/UI/Info.hs +++ b/src/UI/Info.hs @@ -52,4 +52,4 @@ drawInfo = info :: String info = - "Hascard is a text-based user interface for reviewing notes using 'flashcards'. Cards are written in markdown-like syntax; for more info see the README file. Use the --help flag for information on the command line options.\n\nControls:\n * Use arrows or the j and k keys for menu navigation\n * Enter confirms a selection, flips a card or continues to the next card\n * Use TAB or the arrow keys for navigating gaps in open questions\n * Use the c key for confirming reorder questions or multiple choice questions with more than 1 possible answer\n * Use F1 to show the answers of a open question.\n * Use CTRL+Left and CTRL+Right to move to previous and next cards without having to answer them" \ No newline at end of file + "Hascard is a text-based user interface for reviewing notes using 'flashcards'. Cards are written in markdown-like syntax; for more info see the README file. Use the --help flag for information on the command line options.\n\nControls:\n * Use arrows or the j and k keys for menu navigation\n\n * Enter confirms a selection, flips a card or continues to the next card\n\n * Use TAB or the arrow keys for navigating gaps in open questions\n\n * Use the c key for confirming reorder questions or multiple choice questions with more than 1 possible answer\n\n * Use F1 to show the answers of a open question.\n\n * Use CTRL+Left and CTRL+Right to move to previous and next cards without having to answer them" \ No newline at end of file diff --git a/src/UI/MainMenu.hs b/src/UI/MainMenu.hs index f1d80cd..409ccd4 100644 --- a/src/UI/MainMenu.hs +++ b/src/UI/MainMenu.hs @@ -50,9 +50,9 @@ handleEvent gs s (VtyEvent e) = V.EvKey V.KEsc [] -> halt gs V.EvKey V.KEnter [] -> case L.listSelected (s^.l) of - Just 0 -> continue =<< liftIO (runCardSelectorUI gs) - Just 1 -> continue $ runInfoUI gs - Just 2 -> continue =<< liftIO (runSettingsUI gs) + Just 0 -> continue =<< (gs `goToState`) <$> liftIO cardSelectorState + Just 1 -> continue $ gs `goToState` infoState + Just 2 -> continue =<< (gs `goToState`) <$> liftIO settingsState Just 3 -> halt gs _ -> undefined diff --git a/src/UI/Settings.hs b/src/UI/Settings.hs index 11adcc7..8f9ad03 100644 --- a/src/UI/Settings.hs +++ b/src/UI/Settings.hs @@ -63,6 +63,6 @@ drawSettings s = vBox $ map (drawSetting s) (zip [0..] descriptions) drawSetting :: SS -> (Int, String) -> Widget Name drawSetting (selected, settings) (i, text) = - strWrap text <+> str " " <+> word + (strWrap text <+> str " " <+> word) <=> str " " where word = if settings ! i then underline (str "Yes") else underline (str "No") <+> str " " underline = if i == selected then withAttr selectedAttr else id