hascard 0.2.1.0 → 0.3.0.0

raw patch · 19 files changed

+573/−235 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +12/−0
• README.md +19/−5
• app/Main.hs +31/−18
• hascard.cabal +2/−2
• src/Glue.hs +10/−7
• src/Parser.hs +47/−24
• src/Recents.hs +7/−2
• src/Runners.hs +11/−7
• src/States.hs +29/−3
• src/Types.hs +53/−4
• src/UI.hs +1/−1
• src/UI/Attributes.hs +27/−2
• src/UI/BrickHelpers.hs +17/−0
• src/UI/CardSelector.hs +2/−3
• src/UI/Cards.hs +303/−150
• src/UI/FileBrowser.hs +2/−4
• src/UI/Info.hs +0/−1
• src/UI/MainMenu.hs +0/−1
• src/UI/Settings.hs +0/−1

@@ -1,4 +1,16 @@ # Changelog for hascard+## 0.3.0.0+New:+- When reviewing a deck, the amount of correctly and incorrectly answered cards are now displayed.+- After answering a definition card a popup appears asking whether you answered it correctly or not.+- After finishing a deck, there is an option to create new decks from either the correctly answered or incorrectly answered cards, or both. The correct cards of a file named `deck.txt` are stored in `deck+.txt` in the same folder, and the incorrect ones in the file `deck-.txt`. Make sure you do not have files of those names that you want to keep since these _will_ be overwritten.+- The `--blank` or `-b` option was added to use the application without the changes listed above.+- Files with the `.md` extension are also accepted by the application and shown in the filebrowser. ++Fixed bugs:+- Empty open question now takes up 1 row instead of 0 rows, so does not jump like before.+- All parse errors now show a popup instead of crashing the application when reviewing a deck.+ ## 0.2.1.0 New: - A certain chunk of a deck of cards can be reviewed using the `-c i/n` CLI option. For example `hascard -c 3/5` will split the deck into 5 chunks, and review the 3rd one. These chunks can be used with the shuffle and amount options too.

@@ -1,4 +1,8 @@ # hascard+[![Build Status](https://travis-ci.org/Yvee1/hascard.svg?branch=master)](https://travis-ci.org/Yvee1/hascard) [![Hackage](https://img.shields.io/hackage/v/hascard.svg)](https://hackage.haskell.org/package/hascard) [![GitHub tag](https://img.shields.io/github/tag/Yvee1/hascard.svg)](https://github.com/Yvee1/hascard/releases)+++ A minimal commandline utility for reviewing notes. 'Flashcards' can be written in markdown-like syntax.  ![a recording of example usage of the hascard application](./recordings/recording.gif)@@ -25,7 +29,7 @@ ```  ### Binary-Linux and macOS binaries are available under [releases](https://github.com/Yvee1/hascard/releases/). To be able to run it from any directory, it has to be added to the PATH. This can be done by copying it to e.g. the `/usr/local/bin` directory.+Ubuntu and macOS binaries are available under [releases](https://github.com/Yvee1/hascard/releases/). To be able to run it from any directory, it has to be added to the PATH. This can be done by copying it to e.g. the `/usr/local/bin` directory.  ### Snapcraft Hascard is also on [snapcraft](https://snapcraft.io/hascard). Installation instructions are on that site. If you already have snap installed you can just install hascard via `sudo snap install hascard`. By default snap applications are isolated from the system and run in a sandbox. This means that hascard does not have permission to read or write any files on the system aside from those under `%HOME/snap/hascard`. To be able to read cards also in other directories under the home directory, hascard makes use of the `home` interface which might need to be enabled manually using `sudo snap connect hascard:home :home`.@@ -41,13 +45,23 @@ and do `stack install hascard` or `nix-build` respectively.  ## Usage-Simply run `hascard` to open the main application. Menu navigation can be done with the arrow keys or with the 'j' and 'k' keys. The controls for the different cards can be found at the bottom of the screen by default. This, and a couple other things, can be changed in the settings menu. Currently there is no functionality for making cards inside the hascard application itself, but they can easily be written in your favorite text editor since the syntax is human-friendly. +Simply run `hascard` to open the main application. Menu navigation can be done with the arrow keys or with the 'j' and 'k' keys. The controls for the different cards can be found at the bottom of the screen by default. This, and a couple other things, can be changed in the settings menu. A deck of cards can be opened using the built-in filebrowser, and recently selected decks will appear in the selection menu. The application can also be run directly on a file by giving it as an argument. These decks of flashcards are written in plain text, this is explained in section [Cards](#cards).  +After finishing a deck, there is an option to create new decks from the correctly answered or incorrectly answered cards, or both. The correct cards of a file named `deck.txt` are stored in `deck+.txt` in the same folder, and the incorrect ones in the file `deck-.txt`. Make sure you do not have files of those names that you want to keep since these _will_ be overwritten.+ ### CLI-The CLI provides some options for running hascard; to see them all run `hascard -h`. As an example, say you have a file `deck.txt` with lots of cards in it and you want to review 5 random ones, you can use `hascard deck -s -a 5`. Here `-s` shuffles the deck and `-a 5` specifies we only want to look at 5 of them.+The CLI provides some options for running hascard; the most interesting are:+```+  -a,--amount n            Use the first n cards in the deck (most useful+                           combined with shuffle)+  -c,--chunk i/n           Split the deck into n chunks, and review the i'th+                           one. Counting starts at 1.+  -s,--shuffle             Randomize card order+  ```+As an example, say you have a file `deck.txt` with lots of cards in it and you want to review 5 random ones, you can use `hascard deck -s -a 5`. Here `-s` shuffles the deck and `-a 5` specifies we only want to look at 5 of them.  ## Cards-Decks of cards are written in `.txt` files. Cards are seperated with a line containing three dashes `---`. For examples, see the [`/cards`](https://github.com/Yvee1/hascard/tree/master/cards) directory. In this section the 5 different types of cards are listed, with the syntax and how it is represented in the application.+Decks of cards are written in `.txt` or `.md` files. Cards are seperated with a line containing three dashes `---`. For examples, see the [`/cards`](https://github.com/Yvee1/hascard/tree/master/cards) directory. In this section the 5 different types of cards are listed, with the syntax and how it is represented in the application.  ### Definition This is the simplest card, it simply has a title and can be flipped to show the contents. For example the following card@@ -86,7 +100,7 @@ ![](./recordings/multiple-answer.gif)  ### Open question-Open questions are also supported. The words that have to be filled in should be surrounded by underscores `_`. Multiple answer possibilities can also be given by seperating them with vertical bars `|`. As an example, the card+Open questions are also supported. The words that have to be filled in should be surrounded by underscores `_`. Underscores can also be escaped by `\_` if they are part of the text, like is done in [`cards/analysis3.txt`](https://github.com/Yvee1/hascard/blob/48b5c0751ac72df791402b88c033e05488c9350d/cards/analysis3.txt#L34-L37t). Multiple answer possibilities can also be given by seperating them with vertical bars `|`. As an example, the card  ``` # Fill in the gaps

@@ -14,6 +14,7 @@ import System.Process (runCommand) import System.Random.MWC (createSystemRandom) import qualified Data.Map.Strict as Map (empty)+import qualified System.Directory as D import qualified Stack  data Opts = Opts@@ -21,6 +22,7 @@   , _optSubset       :: Int   , _optChunk        :: Chunk   , _optShuffle      :: Bool+  , _optBlankMode    :: Bool   , _optVersion      :: Bool   } @@ -38,10 +40,11 @@  opts :: Parser Opts opts = Opts-  <$> optional (argument str (metavar "FILE" <> help "A .txt file containing flashcards"))+  <$> optional (argument str (metavar "FILE" <> help "A .txt or .md file containing flashcards"))   <*> option auto (long "amount" <> short 'a' <> metavar "n" <> help "Use the first n cards in the deck (most useful combined with shuffle)" <> value (-1))   <*> option auto (long "chunk" <> short 'c' <> metavar "i/n" <> help "Split the deck into n chunks, and review the i'th one. Counting starts at 1." <> value (Chunk 1 1))   <*> switch (long "shuffle" <> short 's' <> help "Randomize card order")+  <*> switch (long "blank" <> short 'b' <> help "Disable review mode: do not keep track of which questions were correctly and incorrectly answered")   <*> switch (long "version" <> short 'v' <> help "Show version number")  optsWithHelp :: ParserInfo Opts@@ -54,30 +57,40 @@   | p a = Nothing   | otherwise = Just a +mkGlobalState :: Opts -> GenIO -> GlobalState+mkGlobalState opts gen = GlobalState {_mwc=gen, _doShuffle=opts^.optShuffle, _subset=nothingIf (<0) (opts^.optSubset), _states=Map.empty, _stack=Stack.empty, _chunk=opts^.optChunk, _doReview=not (opts^.optBlankMode) }++cleanFilePath :: FilePath -> IO (Either String FilePath)+cleanFilePath fp = case takeExtension fp of+  ".txt" -> return $ Right fp+  ".md"  -> return $ Right fp+  ""     -> do existence <- mapM D.doesFileExist [fp <> ".txt", fp <> ".md"]+               return $ case existence of+                 [True, True] -> Left "Both a .txt and .md file of this name exist, and it is unclear which to use. Specify the file extension."+                 True:_       -> Right $ fp <> ".txt"     +                 _            -> Right $ fp <> ".md"+              +  _      -> return $ Left "Incorrect file type, provide a .txt file"+   run :: Opts -> IO () run opts = run' (opts ^. optFile)   where-    mkGlobalState gen = GlobalState {_mwc=gen, _doShuffle=opts^.optShuffle, _subset=nothingIf (<0) (opts^.optSubset), _states=Map.empty, _stack=Stack.empty, _chunk=opts^.optChunk }-    run' Nothing = createSystemRandom >>= start Nothing . mkGlobalState-    run' (Just file) = do-      let filepath =-            case takeExtension file of-              ""     -> Just $ file <> ".txt"-              ".txt" -> Just file-              _      -> Nothing-      case filepath of-        Nothing -> putStrLn "Incorrect file type, provide a .txt file"-        Just textfile -> do-          valOrExc <- try (readFile textfile) :: IO (Either IOError String)+    run' Nothing = createSystemRandom >>= start Nothing . mkGlobalState opts+    run' (Just dirtyFp) = do+      msgOrFp <- cleanFilePath dirtyFp+      case msgOrFp of+        Left msg -> putStrLn msg+        Right fp -> do+          valOrExc <- try (readFile fp) :: IO (Either IOError String)           case valOrExc of             Left exc -> putStrLn (displayException exc)             Right val -> case parseCards val of-              Left parseError -> putStr (errorBundlePretty parseError)+              Left parseError -> putStr parseError               Right result ->                 do gen <- createSystemRandom-                   makeAbsolute textfile >>= addRecent-                   start (Just result) (mkGlobalState gen)+                   makeAbsolute fp >>= addRecent+                   start (Just (fp, result)) (mkGlobalState opts gen) -start :: Maybe [Card] -> GlobalState -> IO ()+start :: Maybe (FilePath, [Card]) -> GlobalState -> IO () start Nothing gs = runBrickFlashcards (gs `goToState` mainMenuState)-start (Just cards) gs = runBrickFlashcards =<< (gs `goToState`) <$> cardsWithOptionsState gs cards+start (Just (fp, cards)) gs = runBrickFlashcards =<< (gs `goToState`) <$> cardsWithOptionsState gs fp cards

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 217faba3ee5ad528be6ef3a365d0be4b6fcd322a10bead39904ac669a0869a05+-- hash: 37f6ac9df04a4bff9b2328a1faf264f14723a098a8f2c51b8d8a7f551eba0bb5  name:           hascard-version:        0.2.1.0+version:        0.3.0.0 synopsis:       A TUI for reviewing notes using 'flashcards' written with markdown-like syntax. description:    Hascard is a text-based user interface for reviewing notes using flashcards. Cards are written in markdown-like syntax. Please see the README file on GitHub at <https://github.com/Yvee1/hascard#readme> for more information. category:       Application

@@ -2,6 +2,7 @@ import Brick import States import StateManagement+import qualified Graphics.Vty     as V import qualified UI.MainMenu      as MM import qualified UI.Settings      as S import qualified UI.Info          as I@@ -28,13 +29,15 @@   CardsState        s ->  C.drawUI s  handleEvent :: GlobalState -> BrickEvent Name Event -> EventM Name (Next GlobalState)-handleEvent gs ev = case getState gs of-  MainMenuState     s -> MM.handleEvent gs s ev-  SettingsState     s ->  S.handleEvent gs s ev-  InfoState         s ->  I.handleEvent gs s ev-  CardSelectorState s -> CS.handleEvent gs s ev-  FileBrowserState  s -> FB.handleEvent gs s ev-  CardsState        s ->  C.handleEvent gs s ev+handleEvent gs ev =+  if ev == VtyEvent (V.EvKey (V.KChar 'c') [V.MCtrl]) then halt gs else+  case getState gs of+    MainMenuState     s -> MM.handleEvent gs s ev+    SettingsState     s ->  S.handleEvent gs s ev+    InfoState         s ->  I.handleEvent gs s ev+    CardSelectorState s -> CS.handleEvent gs s ev+    FileBrowserState  s -> FB.handleEvent gs s ev+    CardsState        s ->  C.handleEvent gs s ev  handleAttrMap :: GlobalState -> AttrMap handleAttrMap gs = case getState gs of

@@ -1,26 +1,37 @@ {-# LANGUAGE DataKinds, ExistentialQuantification, GADTs, KindSignatures, OverloadedStrings #-}-module Parser (parseCards, errorBundlePretty) where+module Parser (parseCards) where   +import Control.Arrow+import Data.Char (isSpace)+import Data.List (dropWhileEnd) import Data.Void-import qualified Data.List.NonEmpty as NE import Text.Megaparsec import Text.Megaparsec.Char+import Text.Wrap+import Data.Text (pack, unpack) import Types+import qualified Data.List.NonEmpty as NE  type Parser = Parsec Void String  uncurry3 f (a, b, c) = f a b c -parseCards :: String -> Either (ParseErrorBundle String Void) [Card]-parseCards = parse pCards "failed when parsing cards"+parseCards :: String -> Either String [Card]+parseCards s = case parse pCards "failed when parsing cards" s of+  Left parseErrorBundle -> Left $ errorBundlePretty (parseErrorBundle :: ParseErrorBundle String Void)+  Right msgOrCards -> left wrap (sequence msgOrCards)+    where wrap = unlines . map unpack . wrapTextToLines (WrapSettings {preserveIndentation=False, breakLongWords=True}) 40 . pack +pCards :: Parser [Either String Card] pCards = (pCard `sepEndBy1` seperator) <* eof-pCard =  uncurry3 MultipleChoice<$> try pMultChoice-     <|> uncurry MultipleAnswer <$> try pMultAnswer-     <|> uncurry Reorder <$> try pReorder-     <|> uncurry OpenQuestion <$> try pOpen-     <|> uncurry Definition <$> pDef +pCard :: Parser (Either String Card)+pCard =  try pMultChoice+     <|> Right . uncurry MultipleAnswer <$> try pMultAnswer+     <|> try pReorder+     <|> Right . uncurry OpenQuestion <$> try pOpen+     <|> Right . uncurry Definition <$> pDef+ pHeader = do   many eol   char '#'@@ -31,8 +42,10 @@   header <- pHeader   many eol   choices <- pChoice `sepBy1` lookAhead (try choicePrefix)-  let (correct, incorrects) = makeMultipleChoice choices-  return (header, correct, incorrects)+  case makeMultipleChoice choices of+    Left errMsg -> do pos <- getSourcePos+                      return . Left $ sourcePosPretty pos <> "\n" <> errMsg+    Right (correct, incorrects) -> return . Right $ MultipleChoice header correct incorrects  pChoice = do   kind <- oneOf ['*','-']@@ -54,7 +67,7 @@   kind <- oneOf ['*','x',' ']   string "] "   text <- manyTill anySingle $ lookAhead (try (seperator <|> string "[" <|> eof'))-  return $ makeOption kind text+  return $ makeOption kind (dropWhileEnd isSpace' text)  pReorder = do   header <- pHeader@@ -62,14 +75,15 @@   elements <- pReorderElement `sepBy1` lookAhead (try pReorderPrefix)   let numbers = map fst elements   if all (`elem` numbers) [1..length numbers]-    then return (header, NE.fromList elements)-    else error $ "A reordering question should have numbers starting from 1 and increase from there without skipping any numbers, but this is not the case:\n" +    then return . Right $ Reorder header (NE.fromList elements)+    else do pos <- getSourcePos+            return . Left $ sourcePosPretty pos <> "\n" <> "A reordering question should have numbers starting from 1 and increase from there without skipping any numbers, but this is not the case:\n"                      <> unlines (map show numbers)  pReorderElement = do   int <- pReorderPrefix   text <- manyTill anySingle $ lookAhead (try (try seperator <|> try pReorderPrefix <|> eof'))-  return (read int, text)+  return (read int, dropWhileEnd isSpace' text)  pReorderPrefix = do   int <- some digitChar@@ -107,13 +121,13 @@  pNormal = do   text <- manyTill (noneOf ['_']) $ lookAhead $ try $ gappedSpecialChars <|> eof'-  return (Normal text)+  return (Normal (dropWhileEnd isSpace' text))  pDef = do   header <- pHeader   many eol   descr <- manyTill chars $ lookAhead $ try $ seperator <|> eof'-  return (header, descr)+  return (header, dropWhileEnd isSpace' descr)  eof' = eof >> return [] <?> "end of file" @@ -122,17 +136,26 @@   many eol   return sep -makeMultipleChoice :: [(Char, String)] -> (CorrectOption, [IncorrectOption])+makeMultipleChoice :: [(Char, String)] -> Either String (CorrectOption, [IncorrectOption]) makeMultipleChoice options = makeMultipleChoice' [] [] 0 options   where-    makeMultipleChoice' [] _ _ [] = error ("multiple choice had no correct answer: \n" ++ show options)-    makeMultipleChoice' [c] ics _ [] = (c, reverse ics)-    makeMultipleChoice' _ _ _ [] = error ("multiple choice had multiple correct answers: \n" ++ show options)-    makeMultipleChoice' cs ics i (('-', text) : opts) = makeMultipleChoice' cs (IncorrectOption text : ics) (i+1) opts-    makeMultipleChoice' cs ics i (('*', text) : opts) = makeMultipleChoice' (CorrectOption i text : cs) ics (i+1) opts-    makeMultipleChoice' _  _   _ _ = error "impossible"+    makeMultipleChoice' [] _ _ [] = Left ("multiple choice had no correct answer: \n" ++ showPretty options)+    makeMultipleChoice' [c] ics _ [] = Right (c, reverse ics)+    makeMultipleChoice' _ _ _ [] = Left ("multiple choice had multiple correct answers: \n" ++ showPretty options)+    makeMultipleChoice' cs ics i (('-', text) : opts) = makeMultipleChoice' cs (IncorrectOption (dropWhileEnd isSpace' text) : ics) (i+1) opts+    makeMultipleChoice' cs ics i (('*', text) : opts) = makeMultipleChoice' (CorrectOption i (dropWhileEnd isSpace' text) : cs) ics (i+1) opts+    makeMultipleChoice' _  _   _ _ = Left "impossible" +    showPretty :: [(Char, String)] -> String+    showPretty = foldr ((<>) . showOne) ""++    showOne (c, s) = [c] <> " " <>  s+ makeOption :: Char -> String -> Option makeOption kind text   | kind `elem` ['*','x'] = Option Correct text   | otherwise             = Option Incorrect text++isSpace' :: Char -> Bool+isSpace' '\r' = True+isSpace' a    = isSpace a

@@ -4,7 +4,7 @@ import Settings import Stack (Stack) import System.Environment (lookupEnv)-import System.FilePath ((</>), splitFileName, dropExtension, splitPath, joinPath)+import System.FilePath ((</>), splitFileName, takeExtension, dropExtension, splitPath, joinPath) import qualified Stack as S import qualified System.Directory as D import qualified System.IO.Strict as IOS (readFile)@@ -68,8 +68,13 @@ initLast (x:xs) = let (xs', y) = initLast xs                    in (x:xs', y) +prep :: [FilePath] -> ([String], [FilePath])+prep fps@(fp:_) = if all ((== takeExtension fp) . takeExtension) fps+  then unzip (map ((\(pre, fn) -> (pre, dropExtension fn)) . splitFileName) fps)+  else unzip (map splitFileName fps)+ shortenFilepaths :: [FilePath] -> [FilePath]-shortenFilepaths fps = uncurry shortenFilepaths' (unzip (map ((\(pre, fn) -> (pre, dropExtension fn)) . splitFileName) fps))+shortenFilepaths = uncurry shortenFilepaths' . prep    where     shortenFilepaths' prefixes abbreviations =       let ds = duplicates abbreviations in

@@ -39,8 +39,8 @@ safeHead [] = Nothing safeHead (x:_) = Just x -cardsState :: [Card] -> IO State-cardsState deck = do+cardsState :: Bool -> FilePath -> [Card] -> IO State+cardsState doReview fp deck = do   hints    <- getShowHints   controls <- getShowControls @@ -55,14 +55,18 @@            , _cardState = defaultCardState firstCard            , _nCards = length deck'            , _showHints = hints-           , _showControls = controls }+           , _showControls = controls+           , _reviewMode = maybe False (const doReview) mFirstCard+           , _correctCards = []+           , _popup = Nothing+           , _pathToFile = fp }     return $ CardsState initialState -cardsWithOptionsState :: GlobalState -> [Card] -> IO State-cardsWithOptionsState gs cards = +cardsWithOptionsState :: GlobalState -> FilePath -> [Card] -> IO State+cardsWithOptionsState gs fp cards =   let chunked = doChunking (gs^.chunk) cards-  in doRandomization gs chunked >>= cardsState+  in doRandomization gs chunked >>= cardsState (gs^.doReview) fp  infoState :: State infoState = InfoState ()@@ -74,7 +78,7 @@   return $ FileBrowserState (FBS filteredBrowser Nothing [] Nothing False)  entryFilter :: Bool -> FileInfo -> Bool-entryFilter acceptHidden info = fileExtensionMatch "txt" info && (acceptHidden || +entryFilter acceptHidden info = (fileExtensionMatch "txt" info || fileExtensionMatch "md" info) && (acceptHidden ||    case fileInfoFilename info of     ".."    -> True     '.' : _ -> False

@@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell #-}-module States where+module States (module States, GenIO) where +import Brick (Widget, EventM, Next) import Brick.Forms (Form) import Brick.Widgets.FileBrowser import Brick.Widgets.List (List)@@ -12,6 +13,7 @@ import Types import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as M+import qualified Graphics.Vty as V  data Name = HintsField           | ControlsField@@ -57,6 +59,7 @@   , _chunk      :: Chunk   , _stack      :: Stack Mode   , _states     :: Map Mode State+  , _doReview   :: Bool   }  data CardState = @@ -79,6 +82,7 @@   , _number         :: Int   , _entered        :: Bool   , _correctGaps    :: Map Int Bool+  , _failed         :: Bool   }   | ReorderState   { _highlighted    :: Int@@ -99,7 +103,8 @@   , _highlighted = 0   , _number = nGapsInPerforated perforated   , _entered = False-  , _correctGaps = M.fromList [(i, False) | i <- [0..nGapsInPerforated perforated - 1]] }+  , _correctGaps = M.fromList [(i, False) | i <- [0..nGapsInPerforated perforated - 1]]+  , _failed = False } defaultCardState (MultipleAnswer _ answers) = MultipleAnswerState    { _highlighted = 0   , _selected = M.fromList [(i, False) | i <- [0..NE.length answers-1]]@@ -120,9 +125,28 @@   , _cardState      :: CardState   , _showHints      :: Bool   , _showControls   :: Bool-  -- , _incorrectCards :: [Int]      -- list of indices of incorrect answers+  , _reviewMode     :: Bool+  , _correctCards   :: [Int]      -- list of indices of correct cards+  , _popup          :: Maybe (Popup CS)+  , _pathToFile     :: FilePath   } +data Popup s = Popup +  { drawPopup        :: s -> Widget Name+  , handlePopupEvent :: GlobalState -> s -> V.Event -> EventM Name (Next GlobalState)+  , _popupState      :: PopupState+  }++data PopupState = +    CorrectPopup+      { _popupSelected :: Int }+  | FinalPopup+  | DeckMakerPopup+      { _popupSelected     :: Int+      , _makeDeckIncorrect :: Bool+      , _makeDeckCorrect   :: Bool }+  deriving Eq+ newtype MMS = MMS    { _l  :: List Name String } @@ -160,3 +184,5 @@ makeLenses ''Settings makeLenses ''CSS makeLenses ''FBS+makeLenses ''Popup+makeLenses ''PopupState

@@ -1,5 +1,8 @@ module Types where+import Data.Functor+import Data.List import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE  --                     Word   Description data Card = Definition String String@@ -15,8 +18,19 @@             question   :: String,             elements   :: NonEmpty (Int, String)           }-  deriving Show +instance Show Card where+  show card = let showHeader h = "# " <> h <> "\n"+    in case card of+      Definition h descr -> showHeader h <> descr+      OpenQuestion h p -> showHeader h <> show p+      MultipleChoice h c inc -> +        showHeader h <> showMultipleChoice c inc+      MultipleAnswer h opts ->+        showHeader h <> unlines' (NE.toList (NE.map show opts))+      Reorder h elts -> +        showHeader h <> unlines' (NE.toList (NE.map showReorder elts))+ data Type = Incorrect | Correct   deriving (Show, Eq) data CorrectOption = CorrectOption Int String@@ -24,16 +38,47 @@ newtype IncorrectOption = IncorrectOption String   deriving Show data Option = Option Type String-  deriving Show+instance Show Option where+  show (Option Correct str)   = "[*] " <> str+  show (Option Incorrect str) = "[ ] " <> str  --                         Pre    Gap               Post data Sentence = Perforated String (NonEmpty String) Sentence               | Normal String-  deriving Show +instance Show Sentence where+  show = foldSentence id (\pre gap sent -> pre <> "_" <> concat (NE.intersperse "|" gap) <> "_" <> sent)+ data Perforated = P String (NonEmpty String) Sentence-  deriving Show +instance Show Perforated where+  show = show . perforatedToSentence++listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]+listMultipleChoice c = reverse . listMultipleChoice' [] 0 c+  where listMultipleChoice' opts i (CorrectOption j cStr) [] = +          if i == j+            then cStr : opts+            else opts+        listMultipleChoice' opts i c'@(CorrectOption j cStr) ics@(IncorrectOption icStr : ics') = +          if i == j+            then listMultipleChoice' (cStr  : opts) (i+1) c' ics+            else listMultipleChoice' (icStr : opts) (i+1) c' ics'++unlines' :: [String] -> String+unlines' = intercalate "\n"++showMultipleChoice :: CorrectOption -> [IncorrectOption] -> String+showMultipleChoice c@(CorrectOption i _) inc = +  unlines' . map showOne $ zip [0..] (listMultipleChoice c inc)+    where showOne (j, s) = (if i == j then "* " else "- ") <> s++showReorder :: (Int, String) -> String+showReorder (i, s) = show i <> ". " <> s++cardsToString :: [Card] -> String+cardsToString = unlines . intersperse "---" . map show+ nGapsInSentence :: Sentence -> Int nGapsInSentence = nGapsInSentence' 0   where@@ -58,3 +103,7 @@  sentenceToGaps :: Sentence -> [NonEmpty String] sentenceToGaps = foldSentence (const []) (\_ gap acc -> gap : acc)++isOptionCorrect :: Option -> Bool+isOptionCorrect (Option Correct _) = True+isOptionCorrect _                  = False

@@ -1,4 +1,4 @@-module UI (module X, runBrickFlashcards, GlobalState(..), Chunk(..), Card, goToState) where+module UI (module X, runBrickFlashcards, GlobalState(..), GenIO, Chunk(..), Card, goToState) where  import UI.CardSelector as X (addRecent) import Settings        as X (getUseEscapeCode)

@@ -60,6 +60,24 @@ shuffledAttr :: AttrName shuffledAttr = attrName "shuffled indicator" +yesButtonAttr :: AttrName+yesButtonAttr = attrName "yes button"++noButtonAttr :: AttrName+noButtonAttr = attrName "no button"++selectedYesButtonAttr :: AttrName+selectedYesButtonAttr = attrName "selected yes button"++selectedNoButtonAttr :: AttrName+selectedNoButtonAttr = attrName "selected no button"++correctAttr :: AttrName+correctAttr = attrName "correct"++wrongAttr :: AttrName+wrongAttr = attrName "incorrect"+ theMap :: AttrMap theMap = attrMap defAttr   [ (titleAttr, fg yellow)@@ -78,7 +96,14 @@   , (correctElementAttr, fg green)   , (incorrectElementAttr, fg red)   , (gapAttr, defAttr `withStyle` underline)-  , (selectedAttr, fg white `withStyle` underline)+  , (selectedAttr, defAttr `withStyle` underline)   , (exceptionAttr, fg red)   , (focusedFormInputAttr, defAttr `withStyle` underline)-  , (shuffledAttr, fg red) ]+  , (shuffledAttr, fg red)+  , (correctAttr, fg green)+  , (wrongAttr, fg red)+  , (yesButtonAttr, fg green)+  , (noButtonAttr, fg red)+  , (selectedYesButtonAttr, fg green `withStyle` underline)+  , (selectedNoButtonAttr, fg red `withStyle` underline)+  ]

@@ -45,3 +45,20 @@     Widget Greedy Fixed $ do       c <- getContext       return $ emptyResult & imageL .~ charFill (c^.attrL) ch (c^.availWidthL) 1++-- | Fill all available space with the specified character. Grows only+-- vertically.+vFill :: Char -> Widget n+vFill ch =+    Widget Fixed Greedy $ do+      c <- getContext+      return $ emptyResult & imageL .~ charFill (c^.attrL) ch 1 (c^.availHeightL)++-- | Make widget at least some amount of rows high.+atLeastV :: Int -> Widget n -> Widget n+atLeastV n widget = Widget Fixed Fixed $ do+  c <- getContext+  result <- render widget+  let h  = result^.imageL.to imageHeight+      dh = n - h+  if dh > 0 then render $ vLimit n (widget <=> vFill ' ') else render widget

@@ -76,7 +76,6 @@         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 's') []  -> continue (gs & doShuffle %~ not) @@ -94,11 +93,11 @@                                 case fileOrExc of                                   Left exc -> continue' (s' & exception ?~ displayException exc)                                   Right file -> case parseCards file of-                                    Left parseError -> continue' (s' & exception ?~ errorBundlePretty parseError)+                                    Left parseError -> continue' (s' & exception ?~ parseError)                                     Right result -> continue =<< liftIO (do                                       s'' <- addRecentInternal s' fp                                       let gs' = update s''-                                      (gs' `goToState`) <$> cardsWithOptionsState gs' result)+                                      (gs' `goToState`) <$> cardsWithOptionsState gs' fp result)                         _ -> continue' s'  handleEvent gs _ _ = continue gs

@@ -1,18 +1,21 @@ module UI.Cards (Card, State(..), drawUI, handleEvent, theMap) where  import Brick+import Control.Monad+import Control.Monad.IO.Class import Lens.Micro.Platform import Types import States import StateManagement import Data.Char (isSpace)-import Data.List (dropWhileEnd) import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map)+import Data.Maybe import Text.Wrap import Data.Text (pack) import UI.Attributes import UI.BrickHelpers+import System.FilePath import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Data.Map.Strict as M@@ -26,7 +29,7 @@ ---------------------------------------------------  drawUI :: CS -> [Widget Name]-drawUI s =  [drawCardUI s <=> drawInfo s]+drawUI s =  [maybe emptyWidget (`drawPopup` s) (s^.popup), drawCardUI s <=> drawInfo s]  drawInfo :: CS -> Widget Name drawInfo s = if not (s ^. showControls) then emptyWidget else@@ -44,12 +47,21 @@                 withAttr textboxAttr $                 hLimitPercent 60 w -drawProgress :: CS -> Widget Name-drawProgress s = C.hCenter $ str (show (s^.index + 1) ++ "/" ++ show (s^.nCards))+drawFooter :: CS -> Widget Name+drawFooter s = if s^.reviewMode +  then padLeftRight 1 $ wrong <+> progress <+> correct+  else progress+  -- not guaranteed that progress is horizontally centered i think+  where progress = C.hCenter $ str (show (s^.index + 1) ++ "/" ++ show (s^.nCards))+        wrong = withAttr wrongAttr (str ("✗ " <> show nWrong)) +        correct = withAttr correctAttr (str ("✓ " <> show nCorrect))+        nCorrect = length (s^.correctCards)+        nWrong = s^.index - nCorrect + (if endCard then 1 else 0)+        endCard = maybe False (isFinalPopup . view popupState) (s^.popup)  drawCardUI :: CS -> Widget Name drawCardUI s = let p = 1 in-  joinBorders $ drawCardBox $ (<=> drawProgress s) $+  joinBorders $ drawCardBox $ (<=> drawFooter s) $   case (s ^. cards) !! (s ^. index) of     Definition title descr -> drawHeader title                           <=> B.hBorder@@ -61,15 +73,15 @@      OpenQuestion title perforated -> drawHeader title                                  <=> B.hBorder-                                 <=> padLeftRight p (drawPerforated s perforated <=> str " ")+                                 <=> padLeftRight p (atLeastV 1 (drawPerforated s perforated) <=> str " ")      MultipleAnswer question options -> drawHeader question                                    <=> B.hBorder                                    <=> padRight (Pad p) (drawOptions s options <=> str " ")      Reorder question _ -> drawHeader question-                             <=> B.hBorder-                             <=> padLeftRight p (drawReorder s <=> str " ")+                      <=> B.hBorder+                      <=> padLeftRight p (drawReorder s <=> str " ")  drawHeader :: String -> Widget Name drawHeader title = withAttr titleAttr $@@ -79,15 +91,8 @@ wrapSettings :: WrapSettings wrapSettings = WrapSettings {preserveIndentation=False, breakLongWords=True} -isSpace' :: Char -> Bool-isSpace' '\r' = True-isSpace' a    = isSpace a- drawDescr :: String -> Widget Name-drawDescr descr =-  strWrapWith wrapSettings descr'-    where-      descr' = dropWhileEnd isSpace' descr+drawDescr = strWrapWith wrapSettings  drawDef :: CS -> String -> Widget Name drawDef s def = if s ^. showHints then drawHintedDef s def else drawNormalDef s def@@ -97,6 +102,10 @@   DefinitionState {_flipped=f} -> if f then drawDescr def else drawDescr [if isSpace' char then char else '_' | char <- def]   _ -> error "impossible: "  +isSpace' :: Char -> Bool+isSpace' '\r' = True+isSpace' a    = isSpace a+ drawNormalDef:: CS -> String -> Widget Name drawNormalDef s def = case s ^. cardState of   DefinitionState {_flipped=f} -> if f@@ -104,21 +113,9 @@     else Widget Greedy Fixed $ do       c <- getContext       let w = c^.availWidthL-      let def' = dropWhileEnd isSpace' def-      render . vBox $ [str " " | _ <- wrapTextToLines wrapSettings w (pack def')]+      render . vBox $ [str " " | _ <- wrapTextToLines wrapSettings w (pack def)]   _ -> error "impossible: "  -listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]-listMultipleChoice c = reverse . listMultipleChoice' [] 0 c-  where listMultipleChoice' opts i (CorrectOption j cStr) [] = -          if i == j-            then cStr : opts-            else opts-        listMultipleChoice' opts i c'@(CorrectOption j cStr) ics@(IncorrectOption icStr : ics') = -          if i == j-            then listMultipleChoice' (cStr  : opts) (i+1) c' ics-            else listMultipleChoice' (icStr : opts) (i+1) c' ics'- drawChoices :: CS -> [String] -> Widget Name drawChoices s options = case (s ^. cardState, s ^. currentCard) of   (MultipleChoiceState {_highlighted=i, _tried=kvs}, MultipleChoice _ (CorrectOption k _) _)  -> vBox formattedOptions@@ -140,15 +137,15 @@   (MultipleAnswerState {_highlighted=j, _selected=kvs, _entered=submitted}, _) ->      vBox . NE.toList .  NE.map drawOption . (`NE.zip` NE.fromList [0..])       where drawOption (Option kind text, i) = coloring (str "[") <+> coloring (highlighting (str symbol)) <+> coloring (str "] ") <+> drawDescr text-                where symbol = if (i == j && not submitted) || enabled then "*" else " "-                      enabled = M.findWithDefault False i kvs-                      highlighting = if i == j && not submitted then withAttr highlightedOptAttr else id-                      coloring = case (submitted, enabled, kind) of-                                   (True, True, Correct) -> withAttr correctOptAttr-                                   (True, False, Incorrect) -> withAttr correctOptAttr-                                   (True, _, _) -> withAttr incorrectOptAttr-                                   (False, True, _) -> withAttr selectedOptAttr-                                   _ -> id+              where symbol = if (i == j && not submitted) || enabled then "*" else " "+                    enabled = M.findWithDefault False i kvs+                    highlighting = if i == j && not submitted then withAttr highlightedOptAttr else id+                    coloring = case (submitted, enabled, kind) of+                                  (True, True, Correct) -> withAttr correctOptAttr+                                  (True, False, Incorrect) -> withAttr correctOptAttr+                                  (True, _, _) -> withAttr incorrectOptAttr+                                  (False, True, _) -> withAttr selectedOptAttr+                                  _ -> id    _ -> error "hopefully this is never shown" @@ -247,150 +244,175 @@       continue' = continue . update in     case e of       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+      V.EvKey V.KRight [V.MCtrl]       -> if not (s^.reviewMode) then next gs s else continue gs+      V.EvKey V.KLeft  [V.MCtrl]       -> if not (s^.reviewMode) then previous gs s else continue gs -      ev -> case (s ^. cardState, s ^. currentCard) of-        (DefinitionState{_flipped = f}, _) ->-          case ev of-            V.EvKey V.KEnter [] -> -              if f-                then next gs s -                else continue' $ s & cardState.flipped %~ not-            _ -> continue' s+      ev ->+        flip (`maybe` (\p -> handlePopupEvent p gs s ev)) (s ^. popup) $+          case (s ^. cardState, s ^. currentCard) of+            (DefinitionState{_flipped = f}, _) ->+              case ev of+                V.EvKey V.KEnter [] -> +                  if f+                    then if not (s^.reviewMode) then next gs s +                      else continue' (s & popup ?~ correctPopup)+                    else continue' $ s & cardState.flipped %~ not+                _ -> continue' s -        (MultipleChoiceState {_highlighted = i, _number = n, _tried = kvs}, MultipleChoice _ (CorrectOption j _) _) ->-          case ev of-            V.EvKey V.KUp [] -> continue' up-            V.EvKey (V.KChar 'k') [] -> continue' up-            V.EvKey V.KDown [] -> continue' down -            V.EvKey (V.KChar 'j') [] -> continue' down+            (MultipleChoiceState {_highlighted = i, _number = n, _tried = kvs}, MultipleChoice _ (CorrectOption j _) _) ->+              case ev of+                V.EvKey V.KUp [] -> continue' up+                V.EvKey (V.KChar 'k') [] -> continue' up+                V.EvKey V.KDown [] -> continue' down +                V.EvKey (V.KChar 'j') [] -> continue' down -            V.EvKey V.KEnter [] ->-                if frozen-                  then next gs s-                  else continue' $ s & cardState.tried %~ M.insert i True+                V.EvKey V.KEnter [] ->+                    if frozen+                      then next gs $ s & if correctlyAnswered then correctCards %~ (s^.index:) else id+                      else continue' $ s & cardState.tried %~ M.insert i True+                                         -            _ -> continue' s+                _ -> continue' s -          where frozen = M.findWithDefault False j kvs+              where frozen = M.findWithDefault False j kvs+                +                    down = if i < n-1 && not frozen+                            then s & (cardState.highlighted) +~ 1+                            else s++                    up = if i > 0 && not frozen+                          then s & (cardState.highlighted) -~ 1+                          else s++                    correctlyAnswered = i == j && M.size (M.filter (==True) kvs) == 1             -                down = if i < n-1 && not frozen-                        then s & (cardState.highlighted) +~ 1-                        else s+            (MultipleAnswerState {_highlighted = i, _number = n, _entered = submitted, _selected = kvs}, MultipleAnswer _ opts) ->+              case ev of+                V.EvKey V.KUp [] -> continue' up+                V.EvKey (V.KChar 'k') [] -> continue' up+                V.EvKey V.KDown [] -> continue' down +                V.EvKey (V.KChar 'j') [] -> continue' down -                up = if i > 0 && not frozen-                      then s & (cardState.highlighted) -~ 1-                      else s-        -        (MultipleAnswerState {_highlighted = i, _number = n, _entered = submitted}, MultipleAnswer {}) ->-          case ev of-            V.EvKey V.KUp [] -> continue' up-            V.EvKey (V.KChar 'k') [] -> continue' up-            V.EvKey V.KDown [] -> continue' down -            V.EvKey (V.KChar 'j') [] -> continue' down+                V.EvKey (V.KChar 'c') [] -> continue' $ s & (cardState.entered) .~ True -            V.EvKey (V.KChar 'c') [] -> continue' $ s & (cardState.entered) .~ True+                V.EvKey V.KEnter [] ->+                    if frozen+                      then next gs $ s & if correctlyAnswered then correctCards %~ (s^.index:) else id+                      else continue' $ s & cardState.selected %~ M.adjust not i -            V.EvKey V.KEnter [] ->-                if frozen-                  then next gs s-                  else continue' $ s & cardState.selected %~ M.adjust not i+                _ -> continue' s -            _ -> continue' s +              where frozen = submitted+                +                    down = if i < n-1 && not frozen+                            then s & (cardState.highlighted) +~ 1+                            else s -          where frozen = submitted-            -                down = if i < n-1 && not frozen-                        then s & (cardState.highlighted) +~ 1-                        else s+                    up = if i > 0 && not frozen+                          then s & (cardState.highlighted) -~ 1+                          else s -                up = if i > 0 && not frozen-                      then s & (cardState.highlighted) -~ 1-                      else s+                    correctlyAnswered = NE.toList (NE.map isOptionCorrect opts) == map snd (M.toAscList kvs) -        (OpenQuestionState {_highlighted = i, _number = n, _gapInput = kvs, _correctGaps = cGaps}, OpenQuestion _ perforated) ->-          let correct = M.foldr (&&) True cGaps in-            case ev of-              V.EvKey (V.KFun 1) [] -> continue' $-                s & cardState.gapInput .~ correctAnswers-                  & cardState.entered .~ True-                  & cardState.correctGaps .~ M.fromAscList [(i, True) | i <- [0..n-1]]-                      where correctAnswers = M.fromAscList $ zip [0..] $ map NE.head (sentenceToGaps (perforatedToSentence perforated))+            (OpenQuestionState {_highlighted = i, _number = n, _gapInput = kvs, _correctGaps = cGaps, _failed=fail}, OpenQuestion _ perforated) ->+              let frozen = M.foldr (&&) True cGaps in+                case ev of+                  V.EvKey (V.KFun 1) [] -> continue' $+                    s & cardState.gapInput .~ correctAnswers+                      & cardState.entered .~ True+                      & cardState.failed .~ True+                      & cardState.correctGaps .~ M.fromAscList [(i, True) | i <- [0..n-1]]+                          where correctAnswers = M.fromAscList $ zip [0..] $ map NE.head (sentenceToGaps (perforatedToSentence perforated)) -              V.EvKey (V.KChar '\t') [] -> continue' $ -                if i < n - 1 && not correct-                  then s & (cardState.highlighted) +~ 1-                  else s & (cardState.highlighted) .~ 0-              -              V.EvKey V.KRight [] -> continue' $ -                if i < n - 1 && not correct-                  then s & (cardState.highlighted) +~ 1-                  else s+                  V.EvKey (V.KChar '\t') [] -> continue' $ +                    if i < n - 1 && not frozen+                      then s & (cardState.highlighted) +~ 1+                      else s & (cardState.highlighted) .~ 0+                  +                  V.EvKey V.KRight [] -> continue' $ +                    if i < n - 1 && not frozen+                      then s & (cardState.highlighted) +~ 1+                      else s -              V.EvKey V.KLeft [] -> continue' $ -                if i > 0 && not correct-                  then s & (cardState.highlighted) -~ 1-                  else s+                  V.EvKey V.KLeft [] -> continue' $ +                    if i > 0 && not frozen+                      then s & (cardState.highlighted) -~ 1+                      else s -              V.EvKey (V.KChar c) [] -> continue' $-                if correct then s else s & cardState.gapInput.at i.non "" %~ (++[c])+                  V.EvKey (V.KChar c) [] -> continue' $+                    if frozen then s else s & cardState.gapInput.at i.non "" %~ (++[c]) -              V.EvKey V.KEnter [] -> if correct then next gs s else continue' s'-                  where sentence = perforatedToSentence perforated-                        gaps = sentenceToGaps sentence+                  V.EvKey V.KEnter [] -> if frozen+                    then if fail+                      then next gs s+                      else next gs (s & correctCards %~ (s^.index:)) +                    else continue' s'+                      where sentence = perforatedToSentence perforated+                            gaps = sentenceToGaps sentence -                        s' = s & (cardState.correctGaps) %~ M.mapWithKey (\j _ -> M.findWithDefault "" j kvs `elem` gaps !! j)  & (cardState.entered) .~ True+                            s' = s & (cardState.correctGaps) %~ M.mapWithKey (\j _ -> M.findWithDefault "" j kvs `elem` gaps !! j)+                                  & (cardState.entered) .~ True -              V.EvKey V.KBS [] -> continue' $ -                  if correct then s else s & cardState.gapInput.ix i %~ backspace-                where backspace "" = ""-                      backspace xs = init xs-              _ -> continue' s-          -        (ReorderState {_highlighted = i, _entered = submitted, _grabbed=dragging, _number = n }, Reorder _ _) ->-          case ev of-            V.EvKey V.KUp [] -> continue' up-            V.EvKey (V.KChar 'k') [] -> continue' up-            V.EvKey V.KDown [] -> continue' down -            V.EvKey (V.KChar 'j') [] -> continue' down+                            s'' = if M.foldr (&&) True (s' ^. cardState.correctGaps)+                                    then s'+                                    else s' & cardState.failed .~ True -            V.EvKey (V.KChar 'c') [] -> continue' $ s & (cardState.entered) .~ True+                  V.EvKey V.KBS [] -> continue' $ +                      if frozen then s else s & cardState.gapInput.ix i %~ backspace+                    where backspace "" = ""+                          backspace xs = init xs+                  _ -> continue' s+              +            (ReorderState {_highlighted = i, _entered = submitted, _grabbed=dragging, _number = n, _order = kvs }, Reorder _ elts) ->+              case ev of+                V.EvKey V.KUp [] -> continue' up+                V.EvKey (V.KChar 'k') [] -> continue' up+                V.EvKey V.KDown [] -> continue' down +                V.EvKey (V.KChar 'j') [] -> continue' down -            V.EvKey V.KEnter [] ->-                if frozen-                  then next gs s-                  else continue' $ s & cardState.grabbed %~ not+                V.EvKey (V.KChar 'c') [] -> continue' $ s & (cardState.entered) .~ True -            _ -> continue' s+                V.EvKey V.KEnter [] ->+                    if frozen+                      then next gs $ s & if correct then correctCards %~ (s^.index:) else id+                      else continue' $ s & cardState.grabbed %~ not +                _ -> continue' s -          where frozen = submitted-            -                down = -                  case (frozen, i < n - 1, dragging) of-                    (True, _, _)  -> s-                    (_, False, _) -> s-                    (_, _, False) -> s & (cardState.highlighted) +~ 1-                    (_, _, True)  -> s & (cardState.highlighted) +~ 1-                                      & (cardState.order) %~ interchange i (i+1) -                up =-                  case (frozen, i > 0, dragging) of-                    (True, _, _)  -> s-                    (_, False, _) -> s-                    (_, _, False) -> s & (cardState.highlighted) -~ 1-                    (_, _, True)  -> s & (cardState.highlighted) -~ 1-                                      & (cardState.order) %~ interchange i (i-1)+              where frozen = submitted+                +                    down = +                      case (frozen, i < n - 1, dragging) of+                        (True, _, _)  -> s+                        (_, False, _) -> s+                        (_, _, False) -> s & (cardState.highlighted) +~ 1+                        (_, _, True)  -> s & (cardState.highlighted) +~ 1+                                          & (cardState.order) %~ interchange i (i+1) -        _ -> error "impossible"+                    up =+                      case (frozen, i > 0, dragging) of+                        (True, _, _)  -> s+                        (_, False, _) -> s+                        (_, _, False) -> s & (cardState.highlighted) -~ 1+                        (_, _, True)  -> s & (cardState.highlighted) -~ 1+                                          & (cardState.order) %~ interchange i (i-1)+                                        +                    correct = all (uncurry (==) . (\i -> (i+1, fst (kvs M.! i)))) [0..n-1]++            _ -> error "impossible" 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+  | s ^. reviewMode                      = +      let thePopup = +            if null (s^.correctCards) || length (s^. correctCards) == length (s^.cards)+              then finalPopup+              else deckMakerPopup+      in continue . updateCS gs $ s & popup ?~ thePopup   | otherwise                            = halt' gs  previous :: GlobalState -> CS -> EventM Name (Next GlobalState)@@ -408,3 +430,134 @@   let vali = kvs M.! i       valj = kvs M.! j in   M.insert j vali (M.insert i valj kvs)++----------------------------------------------------+---------------------- Popups ----------------------+----------------------------------------------------++isFinalPopup :: PopupState -> Bool+isFinalPopup FinalPopup       = True+isFinalPopup DeckMakerPopup{} = True+isFinalPopup _                = False++correctPopup :: Popup CS+correctPopup = Popup drawer eventHandler initialState+  where drawer s =+          let selected = maybe 0 (^?! popupState.popupSelected) (s^.popup)+              colorNo  = if selected == 0 then selectedNoButtonAttr else noButtonAttr+              colorYes = if selected == 1 then selectedYesButtonAttr else yesButtonAttr+              no = withAttr colorNo $ str "No"+              yes = withAttr colorYes $ str "Yes" in+                centerPopup $ +                B.borderWithLabel (str "Correct?") $+                hLimit 20 $+                str " " <=>+                str " " <=>+                (hFill ' ' <+> no <+> hFill ' ' <+> yes <+> hFill ' ')++        initialState = CorrectPopup 0++        eventHandler gs s ev = +          let update = updateCS gs+              continue' = continue . update+              p = fromJust (s ^. popup)+            in case ev of+              V.EvKey V.KLeft  [] -> continue' $ s & popup ?~ (p & popupState.popupSelected .~ 0)+              V.EvKey V.KRight [] -> continue' $ s & popup ?~ (p & popupState.popupSelected .~ 1)+              -- V.EvKey V.KRight [] -> s & popup .~ popupState.popupSelected .~ Just 1+              V.EvKey V.KEnter [] -> next gs $ s & popup .~ Nothing+                                                 & if p ^?! popupState.popupSelected == 1 then correctCards %~ (s^.index:) else id+              _ -> continue' s++finalPopup :: Popup CS+finalPopup = Popup drawer eventHandler initialState+  where drawer s = +          let wrong    = withAttr wrongAttr   (str (" Incorrect: " <> show nWrong)   <+> hFill ' ') +              correct  = withAttr correctAttr (str (" Correct:   " <> show nCorrect) <+> hFill ' ')+              nCorrect = length (s^.correctCards)+              nWrong   = s^.index + 1 - nCorrect in+                centerPopup $ +                B.borderWithLabel (str "Finished") $+                hLimit 20 $+                str " " <=>+                wrong <=>+                correct++        initialState = FinalPopup++        eventHandler gs s (V.EvKey V.KEnter []) = halt' gs++deckMakerPopup :: Popup CS+deckMakerPopup = Popup drawer eventHandler initialState+  where drawer s =+          let state    = fromMaybe initialState $ view popupState <$> s^.popup+              j = state ^?! popupSelected++              makeSym lens i = case (state ^?! lens, i == j) of+                (_, True) -> withAttr highlightedOptAttr $ str "*"+                (True, _) -> withAttr selectedOptAttr    $ str "*"+                _         -> withAttr selectedOptAttr    $ str " "+            +              makeBox lens i = +                (if state ^?! lens then withAttr selectedOptAttr else id) $+                  str "[" <+> makeSym lens i <+> str "]"++              wBox = makeBox makeDeckIncorrect 0+              cBox = makeBox makeDeckCorrect 1++              wrong    = wBox <+> withAttr wrongAttr   (str (" Incorrect: " <> show nWrong)   <+> hFill ' ') +              correct  = cBox <+> withAttr correctAttr (str (" Correct:   " <> show nCorrect) <+> hFill ' ')+              nCorrect = length (s^.correctCards)+              nWrong   = s^.index + 1 - nCorrect in+                centerPopup $ +                B.borderWithLabel (str "Generate decks") $+                hLimit 20 $+                str " " <=>+                wrong <=>+                correct <=>+                str " " <=>+                C.hCenter ((if j == 2 then withAttr selectedAttr else id) (str "Ok"))++        initialState = DeckMakerPopup 0 False False++        eventHandler gs s ev =+          let update = updateCS gs+              continue' = continue . update+              p = fromJust (s ^. popup)+              state = p ^. popupState+          in case state ^?! popupSelected of+            0 -> case ev of+              V.EvKey V.KEnter []      -> continue' $ s & popup ?~ (p & popupState.makeDeckIncorrect %~ not)+              V.EvKey V.KDown  []      -> continue' $ s & popup ?~ (p & popupState.popupSelected +~ 1)+              V.EvKey (V.KChar 'j') [] -> continue' $ s & popup ?~ (p & popupState.popupSelected +~ 1)+              _ -> continue' s+            1 -> case ev of+              V.EvKey V.KEnter []      -> continue' $ s & popup ?~ (p & popupState.makeDeckCorrect %~ not)+              V.EvKey V.KDown  []      -> continue' $ s & popup ?~ (p & popupState.popupSelected +~ 1)+              V.EvKey (V.KChar 'j') [] -> continue' $ s & popup ?~ (p & popupState.popupSelected +~ 1)+              V.EvKey V.KUp  []        -> continue' $ s & popup ?~ (p & popupState.popupSelected -~ 1)+              V.EvKey (V.KChar 'k') [] -> continue' $ s & popup ?~ (p & popupState.popupSelected -~ 1)+              _ -> continue' s+            2 -> case ev of+              V.EvKey V.KEnter []      -> liftIO (generateDecks (s ^. pathToFile) (s ^. cards) (s ^. correctCards) (state ^?! makeDeckCorrect) (state ^?! makeDeckIncorrect))+                                       *> halt' gs+              V.EvKey V.KUp  []        -> continue' $ s & popup ?~ (p & popupState.popupSelected -~ 1)+              V.EvKey (V.KChar 'k') [] -> continue' $ s & popup ?~ (p & popupState.popupSelected -~ 1)+              _ -> continue' s++generateDecks :: FilePath -> [Card] -> [Int] -> Bool -> Bool -> IO ()+generateDecks fp cards corrects makeCorrect makeIncorrect = +  when (makeCorrect || makeIncorrect) $ +    do let (correct, incorrect) = splitCorrectIncorrect cards corrects+       when makeCorrect   $ writeFile (replaceBaseName fp (takeBaseName fp <> "+")) (cardsToString correct)+       when makeIncorrect $ writeFile (replaceBaseName fp (takeBaseName fp <> "-")) (cardsToString incorrect)++-- gets list of cards, list of indices of correct cards; returns (correct, incorrect)+splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])+splitCorrectIncorrect cards indices = doSplit [] [] (zip [0..] cards) (reverse indices)+  where doSplit cs ws [] _  = (reverse cs, reverse ws)+        doSplit cs ws ((_, x):xs) [] = doSplit cs (x:ws) xs []+        doSplit cs ws ((j, x):xs) (i:is) = +          if i == j+            then doSplit (x:cs) ws xs is+            else doSplit cs (x:ws) xs (i:is)

@@ -59,8 +59,6 @@       (_, e) -> case e of         V.EvKey V.KEsc [] | not (fileBrowserIsSearching b) ->             halt' gs-        V.EvKey (V.KChar 'c') [V.MCtrl] | not (fileBrowserIsSearching b) ->-            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,12 +74,12 @@                           case fileOrExc of                             Left exc -> continue' (s' & exception' ?~ displayException exc)                             Right file -> case parseCards file of-                              Left parseError -> continue' (s & exception' ?~ errorBundlePretty parseError)+                              Left parseError -> continue' (s & exception' ?~ parseError)                               -- Right result -> halt' (s' & parsedCards .~ result & filePath ?~ fp)                               Right result -> continue =<< liftIO (do                                       addRecent fp                                       let gs' = update s'-                                      (gs' `moveToState`) <$> cardsWithOptionsState (update s') result)+                                      (gs' `moveToState`) <$> cardsWithOptionsState (update s') fp result)                         _ -> halt' gs                  _ -> continue' s'

@@ -28,7 +28,6 @@       continue' = continue . update       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.KEnter [] -> halt' gs       V.EvKey V.KDown [] -> vScrollBy (viewportScroll Ordinary) 1 >> continue' s

@@ -48,7 +48,6 @@ handleEvent gs s (VtyEvent e) =   let update = updateMMS gs in     case e of-      V.EvKey (V.KChar 'c') [V.MCtrl]  -> halt gs       V.EvKey V.KEsc [] -> halt gs       V.EvKey V.KEnter [] ->         case L.listSelected (s^.l) of

@@ -35,7 +35,6 @@       continue' = continue . update       halt' global = continue (popState global) <* liftIO (setSettings (formState form))  in     case e of-      V.EvKey (V.KChar 'c') [V.MCtrl] -> halt' gs       V.EvKey V.KEsc [] -> halt' gs       V.EvKey V.KDown [] -> continue' $ form { formFocus = focusNext (formFocus form) }       V.EvKey (V.KChar 'j') [] -> continue' $ form { formFocus = focusNext (formFocus form) }