diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,4 +1,15 @@ # Changelog for hascard +## 0.4.0.0 +New: +- UI menu for setting the parameters like shuffling etc. The CLI options are no longer usable with `hascard`. The CLI options have been moved under `hascard run`. Directly providing a file is now also done with `hascard run`. +- Convert TSV files to files compatible with hascard, using the `hascard import` command. (suggested by @g-w1) + +Fixed bugs: +- Focus cycling removed in settings menu for consistency with the other menus. +- Better error for non-existing files +- Allow | character in text +- Allow lists with - in definition cards. Previously this was seen as a multiple choice question without any correct answers, and therefore gave an error. + ## 0.3.0.1 Fixed bugs: - Crash on empty recents list diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -39,7 +39,7 @@ ### 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`. -**Note**: The installation with snapcraft does not work with all terminals, [known issues are with alacritty and st](https://github.com/Yvee1/hascard/issues/3), because of problems with terminfo that I do not know how to solve. With me, this did not happen with the other installation methods so try those if you have a somewhat non-standard terminal. If anyone knows what the problem might be, let me know! +**Note**: Because of problems with snap and terminfo, the snap installation does not work directly with somewhat non-standard terminals like st-256 and alacritty. This is because the snap environment does not have the necessary terminfo files for these terminals, but copying the terminfo file from the system is a workaround (see [this comment](https://github.com/Yvee1/hascard/issues/3#issuecomment-680699000)). ### Install from source Another option is to build hascard and install it from source. For this you can use the Haskell build tool called [stack](https://docs.haskellstack.org/en/stable/README/#how-to-install), or [nix](https://nixos.org/). Then for example clone this repository somewhere: @@ -50,20 +50,34 @@ 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. 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). +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. These decks of flashcards are written in plain text, this is explained in section [Cards](#cards). After selecting a deck, some options can be specified, like whether the deck should be shuffled or how many cards should be reviewed. 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; the most interesting are: +The CLI provides two commands, `run` and `import`. The `hascard run` is essentially the same as just `hascard`, but the `run` command can be given a file to run the application on directly. Instead of specifying the parameters in a menu, they are CLI options. + +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 run deck -s -a 5`. Here `-s` shuffles the deck and `-a 5` specifies we only want to look at 5 of them. + +#### Importing decks +If you have decks in a different format, you might want to convert them into files compatible with hascard. Currently tab-seperated files can be converted to definition or open question cards. For example ``` - -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. +aussi ook +en outre, de plus bovendien +de même evenals +``` +will become +``` +# ook +_aussi_ +--- +# bovendien +_en outre|de plus_ +--- +# evenals +_de même_ +``` +with the command `hascard import input.txt output.txt -r`. More info can be found in the help text at `hascard import --help`. ## Cards 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. @@ -140,4 +154,4 @@

## Miscellaneous info -Written in Haskell, UI built with [brick](https://github.com/jtdaugherty/brick) and parsing of cards done with [parsec](https://github.com/haskell/parsec). Recordings of the terminal were made using [terminalizer](https://github.com/faressoft/terminalizer). The filebrowser widget was mostly copied from the brick [filebrowser demo program](https://github.com/jtdaugherty/brick/blob/master/programs/FileBrowserDemo.hs). Homebrew and Travis configurations were made much easier by [the tutorial from Chris Penner](https://chrispenner.ca/posts/homebrew-haskell). +Written in Haskell, UI built with [brick](https://github.com/jtdaugherty/brick) and parsing of cards done with [megaparsec](https://github.com/mrkkrp/megaparsec). Recordings of the terminal were made using [terminalizer](https://github.com/faressoft/terminalizer). The filebrowser widget was mostly copied from the brick [filebrowser demo program](https://github.com/jtdaugherty/brick/blob/master/programs/FileBrowserDemo.hs). Homebrew and Travis configurations were made much easier by [the tutorial from Chris Penner](https://chrispenner.ca/posts/homebrew-haskell). diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -10,23 +10,39 @@ import Parser import Options.Applicative import System.Directory (makeAbsolute) -import System.FilePath (takeExtension) +import System.FilePath (takeExtension, takeBaseName, takeDirectory) 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 Command = Command + | Run RunOpts + | Import ImportOpts + data Opts = Opts + { _optCommand :: Maybe Command + , _optVersion :: Bool + } + +data RunOpts = RunOpts { _optFile :: Maybe String , _optSubset :: Int , _optChunk :: Chunk , _optShuffle :: Bool , _optBlankMode :: Bool - , _optVersion :: Bool } +data ImportOpts = ImportOpts + { _optInput :: String + , _optOutput :: String + , _optImportType :: ImportType + , _optImportReverse :: Bool } + makeLenses ''Opts +makeLenses ''RunOpts +makeLenses ''ImportOpts main :: IO () main = do @@ -34,22 +50,40 @@ when useEscapeCode $ void (runCommand "echo -n \\\\e[5 q") options <- execParser optsWithHelp - if options ^. optVersion - then putStrLn (showVersion version) - else run options + case (options ^. optVersion, options ^. optCommand) of + (True, _) -> putStrLn (showVersion version) + (_, Just (Run rOpts)) -> run rOpts + (_, Just (Import iOpts)) -> doImport iOpts + (_, Nothing) -> + do g <- createSystemRandom + let gs = GlobalState {_mwc=g, _states=Map.empty, _stack=Stack.empty, _parameters= defaultParameters } + start Nothing gs opts :: Parser Opts opts = Opts + <$> optional (hsubparser + ( command "run" (info (Run <$> runOpts) ( progDesc "Run hascard with CLI options")) + <> command "import" (info (Import <$> importOpts) (progDesc "Convert a TAB delimited file to syntax compatible with hascard. So, terms and definitions should be seperated by tabs, and rows by new lines. When converting to 'open' cards, multiple correct answers can be seperated by semicolons (;), backslashes (/) or commas (,).")))) + <*> switch (long "version" <> short 'v' <> help "Show version number") + +runOpts :: Parser RunOpts +runOpts = RunOpts <$> 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") +importOpts :: Parser ImportOpts +importOpts = ImportOpts + <$> argument str (metavar "INPUT" <> help "A TSV file") + <*> argument str (metavar "DESINATION" <> help "The filename/path to which the output should be saved") + <*> option auto (long "type" <> short 't' <> metavar "'open' or 'def'" <> help "The type of card to which the input is transformed, default: open" <> value Open) + <*> switch (long "reverse" <> short 'r' <> help "Reverse direction of question and answer, i.e. right part becomes the question.") + optsWithHelp :: ParserInfo Opts optsWithHelp = info (opts <**> helper) $ - fullDesc <> progDesc "Run the normal application without argument, or run it directly on a deck of flashcards by providing a text file. Options work either way." + fullDesc <> progDesc "Run the normal application with `hascard`. To run directly on a file, and with CLI options, see `hascard run --help`. For converting TAB seperated files, see `hascard import --help`." <> header "Hascard - a TUI for reviewing notes" nothingIf :: (a -> Bool) -> a -> Maybe a @@ -57,8 +91,11 @@ | 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) } +mkGlobalState :: RunOpts -> GenIO -> GlobalState +mkGlobalState opts gen = + let ps = Parameters { _pShuffle = opts^.optShuffle, _pSubset = nothingIf (<0) (opts^.optSubset) + , _pChunk = opts^.optChunk, _pReviewMode = not (opts^.optBlankMode), _pOk = False } + in GlobalState {_mwc=gen, _states=Map.empty, _stack=Stack.empty, _parameters=ps } cleanFilePath :: FilePath -> IO (Either String FilePath) cleanFilePath fp = case takeExtension fp of @@ -67,12 +104,17 @@ "" -> 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" + [True, _ ] -> Right $ fp <> ".txt" + [_ , True] -> Right $ fp <> ".md" + _ -> Left $ "No .txt or .md file with the name \"" + <> takeBaseName fp + <> "\" in the directory \"" + <> takeDirectory fp + <> "\"" _ -> return $ Left "Incorrect file type, provide a .txt file" -run :: Opts -> IO () +run :: RunOpts -> IO () run opts = run' (opts ^. optFile) where run' Nothing = createSystemRandom >>= start Nothing . mkGlobalState opts @@ -94,3 +136,17 @@ start :: Maybe (FilePath, [Card]) -> GlobalState -> IO () start Nothing gs = runBrickFlashcards (gs `goToState` mainMenuState) start (Just (fp, cards)) gs = runBrickFlashcards =<< (gs `goToState`) <$> cardsWithOptionsState gs fp cards + +doImport :: ImportOpts -> IO () +doImport opts = do + valOrExc <- try $ readFile (opts ^. optInput) :: IO (Either IOError String) + case valOrExc of + Left exc -> putStrLn (displayException exc) + Right val -> do + let mCards = parseImportInput (opts ^. optImportType) (opts ^. optImportReverse) val + case mCards of + Just cards -> do + writeFile (opts ^. optOutput) . cardsToString $ cards + putStrLn "Successfully converted the file." + Nothing -> putStrLn "Failed the conversion." + diff --git a/hascard.cabal b/hascard.cabal --- a/hascard.cabal +++ b/hascard.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: ec2242b52f0e3c490e1e95ddd3da740967817bae67d755d08d1c2182b071abd2 +-- hash: 7c2a1f916052eaf8858f1e8e359e6e1d9c03574003a5f393ef15e395da73feda name: hascard -version: 0.3.0.1 +version: 0.4.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 for more information. category: Application @@ -32,6 +32,8 @@ Debug DeckHandling Glue + Import + Parameters Parser Recents Runners @@ -48,6 +50,7 @@ UI.FileBrowser UI.Info UI.MainMenu + UI.Parameter UI.Settings other-modules: Paths_hascard @@ -67,7 +70,11 @@ , ordered-containers >=0.2.2 && <0.3 , process >=1.6.5 && <1.7 , random-fu >=0.2.7 && <0.3 + , split >=0.2.3 && <0.3 , strict >=0.3.2 && <0.4 + , tasty >=1.2.1 && <1.3 + , tasty-hunit >=0.10.0 && <0.11 + , tasty-quickcheck >=0.10.1 && <0.11 , text >=1.2.3 && <1.3 , vector >=0.12.0 && <0.13 , vty >=5.28.2 && <5.31 @@ -96,7 +103,11 @@ , ordered-containers >=0.2.2 && <0.3 , process >=1.6.5 && <1.7 , random-fu >=0.2.7 && <0.3 + , split >=0.2.3 && <0.3 , strict >=0.3.2 && <0.4 + , tasty >=1.2.1 && <1.3 + , tasty-hunit >=0.10.0 && <0.11 + , tasty-quickcheck >=0.10.1 && <0.11 , text >=1.2.3 && <1.3 , vector >=0.12.0 && <0.13 , vty >=5.28.2 && <5.31 @@ -126,7 +137,11 @@ , ordered-containers >=0.2.2 && <0.3 , process >=1.6.5 && <1.7 , random-fu >=0.2.7 && <0.3 + , split >=0.2.3 && <0.3 , strict >=0.3.2 && <0.4 + , tasty >=1.2.1 && <1.3 + , tasty-hunit >=0.10.0 && <0.11 + , tasty-quickcheck >=0.10.1 && <0.11 , text >=1.2.3 && <1.3 , vector >=0.12.0 && <0.13 , vty >=5.28.2 && <5.31 diff --git a/src/DeckHandling.hs b/src/DeckHandling.hs --- a/src/DeckHandling.hs +++ b/src/DeckHandling.hs @@ -5,10 +5,10 @@ import Types doRandomization :: GlobalState -> [Card] -> IO [Card] -doRandomization state cards = +doRandomization gs 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) + cards' <- if gs^.parameters.pShuffle then sampleFrom (gs^.mwc) (shuffleN n cards) else return cards + return $ maybe cards' (`take` cards') (gs^.parameters.pSubset) doChunking :: Chunk -> [Card] -> [Card] doChunking (Chunk i n) cards = diff --git a/src/Glue.hs b/src/Glue.hs --- a/src/Glue.hs +++ b/src/Glue.hs @@ -9,6 +9,7 @@ import qualified UI.CardSelector as CS import qualified UI.FileBrowser as FB import qualified UI.Cards as C +import qualified UI.Parameter as P globalApp :: App GlobalState Event Name globalApp = App @@ -27,6 +28,7 @@ CardSelectorState s -> CS.drawUI gs s FileBrowserState s -> FB.drawUI s CardsState s -> C.drawUI s + ParameterState s -> P.drawUI s handleEvent :: GlobalState -> BrickEvent Name Event -> EventM Name (Next GlobalState) handleEvent gs ev = @@ -38,6 +40,7 @@ CardSelectorState s -> CS.handleEvent gs s ev FileBrowserState s -> FB.handleEvent gs s ev CardsState s -> C.handleEvent gs s ev + ParameterState s -> P.handleEvent gs s ev handleAttrMap :: GlobalState -> AttrMap handleAttrMap gs = case getState gs of @@ -47,3 +50,4 @@ CardSelectorState _ -> CS.theMap FileBrowserState _ -> FB.theMap CardsState _ -> C.theMap + ParameterState _ -> P.theMap diff --git a/src/Import.hs b/src/Import.hs new file mode 100644 --- /dev/null +++ b/src/Import.hs @@ -0,0 +1,28 @@ +module Import where +import Data.Char (toLower, isSpace) +import Data.List +import Data.List.Split +import qualified Data.List.NonEmpty as NE +import Types + +data ImportType = Def | Open + +instance Read ImportType where + readsPrec _ input = + case map toLower input of + xs | "open" `isPrefixOf` xs -> [(Open, drop 4 xs)] + | "def" `isPrefixOf` xs -> [(Def, drop 3 xs)] + | "definition" `isPrefixOf` xs -> [(Def, drop 10 xs)] + | otherwise -> [] + +parseImportInput :: ImportType -> Bool -> String -> Maybe [Card] +parseImportInput iType reverse input = + let listToTuple [q, a] = Just $ if not reverse then (q, a) else (a, q) + listToTuple _ = Nothing + xs = mapM (listToTuple . splitOn "\t") (lines input) + makeOpen (header, body) = OpenQuestion header + (P "" (NE.fromList (map (dropWhile isSpace) (splitOneOf ",/;" body))) (Normal "")) + + in case iType of + Def -> map (uncurry Definition) <$> xs + Open -> map makeOpen <$> xs diff --git a/src/Parameters.hs b/src/Parameters.hs new file mode 100644 --- /dev/null +++ b/src/Parameters.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE OverloadedStrings, RankNTypes #-} +module Parameters where +import UI.Attributes +import Brick +import Brick.Widgets.Center +import Brick.Forms +import Data.Maybe +import Data.Char (isDigit) +import Data.Text (pack) +import Lens.Micro.Platform +import States +import Text.Read (readMaybe) +import UI.BrickHelpers +import qualified Data.Text as T +import qualified Graphics.Vty as V + +mkParameterForm :: Int -> Parameters -> Form Parameters e Name +mkParameterForm n ps = + let label s w = padBottom (Pad 1) $ padRight (Pad 2) (strWrap s) <+> w + form = newForm + [ label "Select chunk:" @@= chunkField n pChunk ChunkField + , label "Number of cards:" @@= naturalNumberField n (subsetLens n) SubsetField ("/" <> pack (show n)) + , label "Shuffle the deck?" @@= yesnoField True pShuffle ShuffleField "" + , label "Review mode?" @@= yesnoField True pReviewMode ReviewModeField "" + , hCenter @@= okField pOk ParametersOkField "Ok" + ] ps + in setFormFocus ParametersOkField form + +subsetLens :: Int -> Lens' Parameters Int +subsetLens n f ps = + (\n -> ps & pSubset ?~ n) + <$> f (fromMaybe n (ps ^. pSubset)) + +chunkField :: (Ord n, Show n) => Int -> Lens' s Chunk -> n -> s -> FormFieldState s e n +chunkField bound stLens name initialState = + let initVal = initialState ^. stLens + + handleEvent (VtyEvent (V.EvKey (V.KChar c) [])) (Chunk i n, p) | isDigit c = + if p + then let newValue = read (show n ++ [c]) + in return $ if newValue <= bound then (Chunk i newValue, p) else (Chunk i bound, p) + else let newValue = read (show i ++ [c]) + in return $ if newValue <= n then (Chunk newValue n, p) else (Chunk n n, p) + handleEvent (VtyEvent (V.EvKey V.KBS [])) (Chunk i n, p) = + let calcNew x = if null (show x) then 0 else fromMaybe 0 (readMaybe (init (show x))) + in if p + then return $ + let newN = calcNew n + newI = if i <= newN then i else newN + in (Chunk newI newN, p) + else return (Chunk (calcNew i) n, p) + handleEvent (VtyEvent (V.EvKey V.KRight [])) (c, _) = return (c, True) + handleEvent (VtyEvent (V.EvKey V.KLeft [])) (c, _) = return (c, False) + handleEvent (VtyEvent (V.EvKey V.KEnter [])) (c, p) = return (c, not p) + handleEvent _ s = return s + + validate (c@(Chunk i n), _) = if i >= 1 && n >= 1 && i <= n then Just c else Nothing + + in FormFieldState { formFieldState = (initVal, False) + , formFields = [ FormField name validate True + (renderChunk bound name) + handleEvent ] + , formFieldLens = stLens + , formFieldRenderHelper = id + , formFieldConcat = vBox } + +renderChunk :: Int -> n -> Bool -> (Chunk, Bool) -> Widget n +renderChunk bound name foc (Chunk i n, p) = + let addAttr = if foc then withDefAttr focusedFormInputAttr else id + csr x = if foc then showCursor name (Location (length x,0)) else id + val' 0 = "" + val' x = show x + in if p + then str (val' i) <+> str "/" <+> addAttr (csr (val' n) (str (val' n))) + else addAttr (csr (val' i) (str (val' i))) <+> str "/" <+> str (val' n) + +okField :: (Ord n, Show n) => Lens' s Bool -> n -> T.Text -> s -> FormFieldState s e n +okField stLens name label initialState = + let initVal = initialState ^. stLens + + handleEvent (VtyEvent (V.EvKey V.KEnter [])) _ = return True + handleEvent _ s = return s + + in FormFieldState { formFieldState = initVal + , formFields = [ FormField name Just True + (renderOk label name) + handleEvent ] + , formFieldLens = stLens + , formFieldRenderHelper = id + , formFieldConcat = vBox } + +renderOk :: T.Text -> n -> Bool -> Bool -> Widget n +renderOk label _ focus _ = + (if focus then withAttr selectedAttr else id) $ str "Ok" diff --git a/src/Parser.hs b/src/Parser.hs --- a/src/Parser.hs +++ b/src/Parser.hs @@ -42,7 +42,8 @@ header <- pHeader many eol choices <- pChoice `sepBy1` lookAhead (try choicePrefix) - case makeMultipleChoice choices of + msgOrResult <- makeMultipleChoice choices + case msgOrResult of Left errMsg -> do pos <- getSourcePos return . Left $ sourcePosPretty pos <> "\n" <> errMsg Right (correct, incorrects) -> return . Right $ MultipleChoice header correct incorrects @@ -105,11 +106,11 @@ (pre, gap) <- pGap Perforated pre gap <$> pSentence -chars = escaped <|> anySingle +chars = try escaped <|> anySingle escaped = char '\\' >> char '_' pGap = do - pre <- manyTill chars $ lookAhead (try gappedSpecialChars) + pre <- manyTill chars $ lookAhead (try (string "_" <|> seperator)) char '_' gaps <- manyTill (noneOf ['_','|']) (lookAhead (try gappedSpecialChars)) `sepBy1` string "|" char '_' @@ -120,7 +121,7 @@ <|> string "_" pNormal = do - text <- manyTill (noneOf ['_']) $ lookAhead $ try $ gappedSpecialChars <|> eof' + text <- manyTill (noneOf ['_']) $ lookAhead $ try $ seperator <|> eof' return (Normal (dropWhileEnd isSpace' text)) pDef = do @@ -136,15 +137,17 @@ many eol return sep -makeMultipleChoice :: [(Char, String)] -> Either String (CorrectOption, [IncorrectOption]) +makeMultipleChoice :: [(Char, String)] -> Parser (Either String (CorrectOption, [IncorrectOption])) makeMultipleChoice options = makeMultipleChoice' [] [] 0 options where - 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' [] _ _ [] = Left ("multiple choice had no correct answer: \n" ++ showPretty options) + makeMultipleChoice' :: [CorrectOption] -> [IncorrectOption] -> Int -> [(Char, String)] -> Parser (Either String (CorrectOption, [IncorrectOption])) + makeMultipleChoice' [] _ _ [] = fail "woops" + makeMultipleChoice' [c] ics _ [] = return $ Right (c, reverse ics) + makeMultipleChoice' _ _ _ [] = return $ 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" + makeMultipleChoice' _ _ _ _ = return $ Left "impossible" showPretty :: [(Char, String)] -> String showPretty = foldr ((<>) . showOne) "" diff --git a/src/Runners.hs b/src/Runners.hs --- a/src/Runners.hs +++ b/src/Runners.hs @@ -1,9 +1,11 @@ module Runners where import Brick.Widgets.FileBrowser +import Brick.Forms import DeckHandling import Data.Maybe (fromMaybe) import Recents import Lens.Micro.Platform +import Parameters import Settings import States import Types @@ -65,8 +67,8 @@ cardsWithOptionsState :: GlobalState -> FilePath -> [Card] -> IO State cardsWithOptionsState gs fp cards = - let chunked = doChunking (gs^.chunk) cards - in doRandomization gs chunked >>= cardsState (gs^.doReview) fp + let chunked = doChunking (gs^.parameters.pChunk) cards + in doRandomization gs chunked >>= cardsState (gs^.parameters.pReviewMode) fp infoState :: State infoState = InfoState () @@ -83,3 +85,6 @@ ".." -> True '.' : _ -> False _ -> True) + +parameterState :: Parameters -> FilePath -> [Card] -> State +parameterState ps fp cards = ParameterState (PS cards fp (mkParameterForm (length cards) ps)) diff --git a/src/Settings.hs b/src/Settings.hs --- a/src/Settings.hs +++ b/src/Settings.hs @@ -75,55 +75,8 @@ let label s w = padBottom (Pad 1) $ padRight (Pad 2) (strWrap s) <+> w in newForm - [ label "Draw hints using underscores for definition cards" @@= yesnoField hints HintsField "" - , label "Show controls at the bottom of screen" @@= yesnoField controls ControlsField "" - , label "Use the '-n \\e[5 q' escape code to change the cursor to a blinking line on start" @@= yesnoField escapeCode EscapeCodeField "" - , label "Maximum number of recently selected files stored" @@= hLimit 3 @@= naturalNumberField maxRecents MaxRecentsField "" ] - -yesnoField :: (Ord n, Show n) => Lens' s Bool -> n -> T.Text -> s -> FormFieldState s e n -yesnoField stLens name label initialState = - let initVal = initialState ^. stLens - - handleEvent (MouseDown n _ _ _) s | n == name = return $ not s - handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) s = return $ not s - handleEvent (VtyEvent (V.EvKey V.KEnter [])) s = return $ not s - handleEvent _ s = return s - - in FormFieldState { formFieldState = initVal - , formFields = [ FormField name Just True - (renderYesno label name) - handleEvent ] - , formFieldLens = stLens - , formFieldRenderHelper = id - , formFieldConcat = vBox } - -renderYesno :: T.Text -> n -> Bool -> Bool -> Widget n -renderYesno label n foc val = - let addAttr = if foc then withDefAttr focusedFormInputAttr else id - in clickable n $ (if val then addAttr (txt "Yes") else addAttr (txt "No") <+> txt " ") <+> txt label - -naturalNumberField :: (Ord n, Show n) => Lens' s Int -> n -> T.Text -> s -> FormFieldState s e n -naturalNumberField stLens name label initialState = - let initVal = initialState ^. stLens - -- clamp s = - - handleEvent (VtyEvent (V.EvKey (V.KChar c) [])) s | isDigit c = return $ if s < 100 then read (show s ++ [c]) else s - handleEvent (VtyEvent (V.EvKey V.KBS [])) s = return $ case show s of - "" -> 0 - xs -> fromMaybe 0 (readMaybe (init xs)) - handleEvent _ s = return s - - in FormFieldState { formFieldState = initVal - , formFields = [ FormField name Just True - (renderNaturalNumber label name) - handleEvent ] - , formFieldLens = stLens - , formFieldRenderHelper = id - , formFieldConcat = vBox } + [ label "Draw hints using underscores for definition cards" @@= yesnoField False hints HintsField "" + , label "Show controls at the bottom of screen" @@= yesnoField False controls ControlsField "" + , label "Use the '-n \\e[5 q' escape code to change the cursor to a blinking line on start" @@= yesnoField False escapeCode EscapeCodeField "" + , label "Maximum number of recently selected files stored" @@= naturalNumberField 999 maxRecents MaxRecentsField "" ] -renderNaturalNumber :: T.Text -> n -> Bool -> Int -> Widget n -renderNaturalNumber label n foc val = - let addAttr = if foc then withDefAttr focusedFormInputAttr else id - val' = show val - csr = if foc then showCursor n (Location (length val',0)) else id - in csr (addAttr (str val')) <+> txt label <+> hFill ' ' diff --git a/src/StateManagement.hs b/src/StateManagement.hs --- a/src/StateManagement.hs +++ b/src/StateManagement.hs @@ -18,6 +18,7 @@ getMode (CardSelectorState _) = CardSelector getMode (FileBrowserState _) = FileBrowser getMode (CardsState _) = Cards +getMode (ParameterState _) = Parameter getState :: GlobalState -> State getState = fromJust . safeGetState @@ -46,6 +47,9 @@ updateFBS :: GlobalState -> FBS -> GlobalState updateFBS gs s = updateState gs (FileBrowserState s) +updatePS :: GlobalState -> PS -> GlobalState +updatePS gs s = updateState gs (ParameterState s) + goToState :: GlobalState -> State -> GlobalState goToState gs s = gs & states %~ M.insert (getMode s) s & stack %~ insert (getMode s) @@ -53,6 +57,14 @@ moveToState :: GlobalState -> State -> GlobalState moveToState gs = goToState (popState gs) +-- popState until at mode of state s. +removeToState :: GlobalState -> State -> GlobalState +removeToState gs s = go (popState gs) + where go global = + let current = Stack.head (global ^. stack) + in if current == getMode s then moveToState global s + else go (popState global) + popState :: GlobalState -> GlobalState popState gs = let s = gs ^. stack @@ -61,6 +73,12 @@ gs & states %~ M.delete top & stack .~ s' +popStateOrQuit :: GlobalState -> EventM n (Next GlobalState) +popStateOrQuit gs = let gs' = popState gs in + if Stack.size (gs' ^. stack) == 0 + then halt gs' + else continue gs' + safeGetState :: GlobalState -> Maybe State safeGetState gs = do key <- safeHead (gs ^. stack) @@ -71,13 +89,19 @@ 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) +moveToModeOrQuit = moveToModeOrQuit' return moveToModeOrQuit' :: (State -> IO State) -> GlobalState -> Mode -> EventM n (Next GlobalState) moveToModeOrQuit' f gs mode = maybe (halt gs) (\s -> continue . moveToState gs =<< liftIO (f s)) $ M.lookup mode (gs ^. states) +removeToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState) +removeToModeOrQuit = removeToModeOrQuit' return + +removeToModeOrQuit' :: (State -> IO State) -> GlobalState -> Mode -> EventM n (Next GlobalState) +removeToModeOrQuit' f gs mode = + maybe (halt gs) (\s -> continue . removeToState gs =<< liftIO (f s)) $ M.lookup mode (gs ^. states) + refreshRecents :: CSS -> IO CSS refreshRecents s = do rs <- getRecents @@ -85,3 +109,6 @@ options = Vec.fromList (prettyRecents ++ ["Select file from system"]) return $ s & recents .~ rs & list .~ L.list Ordinary options 1 + +refreshRecents' :: GlobalState -> IO GlobalState +refreshRecents' gs = maybe (return gs) ((updateCSS gs <$>) . refreshRecents) ((\(CardSelectorState s) -> s) <$> M.lookup CardSelector (gs^.states)) diff --git a/src/States.hs b/src/States.hs --- a/src/States.hs +++ b/src/States.hs @@ -15,10 +15,20 @@ import qualified Data.Map.Strict as M import qualified Graphics.Vty as V -data Name = HintsField +data Name = + -- Settings + HintsField | ControlsField | EscapeCodeField | MaxRecentsField + + -- Parameters + | ShuffleField + | SubsetField + | ChunkField + | ReviewModeField + | ParametersOkField + | Ordinary deriving (Eq, Ord, Show) type Event = () @@ -29,6 +39,7 @@ | CardSelector | FileBrowser | Cards + | Parameter deriving (Show, Eq, Ord) data State = MainMenuState MMS @@ -36,6 +47,7 @@ | InfoState IS | CardSelectorState CSS | FileBrowserState FBS + | ParameterState PS | CardsState CS data Chunk = Chunk Int Int @@ -54,12 +66,9 @@ data GlobalState = GlobalState { _mwc :: GenIO - , _doShuffle :: Bool - , _subset :: Maybe Int - , _chunk :: Chunk , _stack :: Stack Mode , _states :: Map Mode State - , _doReview :: Bool + , _parameters :: Parameters } data CardState = @@ -176,6 +185,26 @@ , _showHidden :: Bool } +defaultParameters = Parameters + { _pShuffle = False + , _pSubset = Nothing + , _pChunk = Chunk 1 1 + , _pReviewMode = True + , _pOk = False } + +data Parameters = Parameters + { _pShuffle :: Bool + , _pSubset :: Maybe Int + , _pChunk :: Chunk + , _pReviewMode :: Bool + , _pOk :: Bool } + +data PS = PS + { _psCards :: [Card] + , _psFp :: FilePath + , _psForm :: Form Parameters Event Name + } + makeLenses ''State makeLenses ''MMS makeLenses ''GlobalState @@ -184,5 +213,7 @@ makeLenses ''Settings makeLenses ''CSS makeLenses ''FBS +makeLenses ''PS +makeLenses ''Parameters makeLenses ''Popup makeLenses ''PopupState diff --git a/src/UI.hs b/src/UI.hs --- a/src/UI.hs +++ b/src/UI.hs @@ -1,13 +1,32 @@ -module UI (module X, runBrickFlashcards, GlobalState(..), GenIO, Chunk(..), Card, goToState) where +module UI +( module X +, runBrickFlashcards +, GlobalState(..) +, GenIO +, Chunk(..) +, Card +, ImportType(..) +, Parameters(..) + +, goToState + +, cardsToString + +, parseImportInput + +, defaultParameters +) where + import UI.CardSelector as X (addRecent) import Settings as X (getUseEscapeCode) import Runners as X import Brick import Glue +import Import import States import StateManagement -import Types (Card) +import Types (Card, cardsToString) runBrickFlashcards :: GlobalState -> IO () runBrickFlashcards gs = do diff --git a/src/UI/BrickHelpers.hs b/src/UI/BrickHelpers.hs --- a/src/UI/BrickHelpers.hs +++ b/src/UI/BrickHelpers.hs @@ -1,12 +1,19 @@ +{-# LANGUAGE OverloadedStrings, RankNTypes #-} module UI.BrickHelpers where import Text.Wrap import Brick +import Brick.Forms import Brick.Widgets.Border import Brick.Widgets.Center +import Data.Char (isDigit) +import Data.Maybe import Data.Text (pack) import Graphics.Vty (imageWidth, imageHeight, charFill) import Lens.Micro +import Text.Read (readMaybe) import UI.Attributes +import qualified Data.Text as T +import qualified Graphics.Vty as V hCenteredStrWrap :: String -> Widget n hCenteredStrWrap = hCenteredStrWrapWithAttr id @@ -41,20 +48,13 @@ -- | Fill all available space with the specified character. Grows only -- horizontally. hFill :: Char -> Widget n -hFill ch = - Widget Greedy Fixed $ do - c <- getContext - return $ emptyResult & imageL .~ charFill (c^.attrL) ch (c^.availWidthL) 1 +hFill = vLimit 1 . fill -- | 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) +vFill = hLimit 1 . fill --- | Make widget at least some amount of rows high. atLeastV :: Int -> Widget n -> Widget n atLeastV n widget = Widget Fixed Fixed $ do c <- getContext @@ -62,3 +62,59 @@ let h = result^.imageL.to imageHeight dh = n - h if dh > 0 then render $ vLimit n (widget <=> vFill ' ') else render widget + +yesnoField :: (Ord n, Show n) => Bool -> Lens' s Bool -> n -> T.Text -> s -> FormFieldState s e n +yesnoField rightAlign stLens name label initialState = + let initVal = initialState ^. stLens + + handleEvent (MouseDown n _ _ _) s | n == name = return $ not s + handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) s = return $ not s + handleEvent (VtyEvent (V.EvKey V.KEnter [])) s = return $ not s + handleEvent _ s = return s + + in FormFieldState { formFieldState = initVal + , formFields = [ FormField name Just True + (renderYesno rightAlign label name) + handleEvent ] + , formFieldLens = stLens + , formFieldRenderHelper = id + , formFieldConcat = vBox } + +renderYesno :: Bool -> T.Text -> n -> Bool -> Bool -> Widget n +renderYesno rightAlign label n foc val = + let addAttr = if foc then withDefAttr focusedFormInputAttr else id + in clickable n $ + (if val + then addAttr (txt "Yes") + else if rightAlign + then txt " " <+> addAttr (txt "No") + else addAttr (txt "No") <+> txt " ") <+> txt label + +naturalNumberField :: (Ord n, Show n) => Int -> Lens' s Int -> n -> T.Text -> s -> FormFieldState s e n +naturalNumberField bound stLens name postfix initialState = + let initVal = initialState ^. stLens + + handleEvent (VtyEvent (V.EvKey (V.KChar c) [])) s | isDigit c = + let newValue = read (show s ++ [c]) + in return $ if newValue <= bound then newValue else bound + handleEvent (VtyEvent (V.EvKey V.KBS [])) s = return $ case show s of + "" -> 0 + xs -> fromMaybe 0 (readMaybe (init xs)) + handleEvent _ s = return s + + in FormFieldState { formFieldState = initVal + , formFields = [ FormField name Just True + (renderNaturalNumber bound postfix name) + handleEvent ] + , formFieldLens = stLens + , formFieldRenderHelper = id + , formFieldConcat = vBox } + +renderNaturalNumber :: Int -> T.Text -> n -> Bool -> Int -> Widget n +renderNaturalNumber bound postfix n foc val = + let addAttr = if foc then withDefAttr focusedFormInputAttr else id + val' = show val + csr = if foc then showCursor n (Location (length val',0)) else id + in if T.null postfix + then hLimit (length (show bound)) (csr (addAttr (str val')) <+> hFill ' ') + else csr (addAttr (str val')) <+> txt postfix diff --git a/src/UI/CardSelector.hs b/src/UI/CardSelector.hs --- a/src/UI/CardSelector.hs +++ b/src/UI/CardSelector.hs @@ -33,10 +33,6 @@ title :: Widget Name title = withAttr titleAttr $ str "Select a deck of flashcards " -shuffledWidget :: Bool -> Widget Name -shuffledWidget shuffled = withAttr shuffledAttr $ str $ - if shuffled then "(Shuffled)" else "" - drawMenu :: GlobalState -> CSS -> Widget Name drawMenu gs s = joinBorders $ @@ -44,7 +40,7 @@ withBorderStyle unicodeRounded $ border $ hLimitPercent 60 $ - hCenter (title <+> shuffledWidget (gs^.doShuffle)) <=> + hCenter title <=> hBorder <=> hCenter (drawList s) @@ -77,7 +73,6 @@ (Just _, _) -> continue' $ s & exception .~ Nothing (_, e) -> case e of V.EvKey V.KEsc [] -> halt' gs - V.EvKey (V.KChar 's') [] -> continue (gs & doShuffle %~ not) _ -> do l' <- L.handleListEventVi L.handleListEvent e l let s' = (s & list .~ l') in @@ -97,7 +92,7 @@ Right result -> continue =<< liftIO (do s'' <- addRecentInternal s' fp let gs' = update s'' - (gs' `goToState`) <$> cardsWithOptionsState gs' fp result) + return (gs' `goToState` parameterState (gs'^.parameters) fp result)) _ -> continue' s' handleEvent gs _ _ = continue gs diff --git a/src/UI/Cards.hs b/src/UI/Cards.hs --- a/src/UI/Cards.hs +++ b/src/UI/Cards.hs @@ -236,14 +236,14 @@ ---------------------- Events ---------------------- ---------------------------------------------------- halt' :: GlobalState -> EventM n (Next GlobalState) -halt' = flip (moveToModeOrQuit' (\(CardSelectorState s) -> CardSelectorState <$> refreshRecents s)) CardSelector +halt' = flip (removeToModeOrQuit' (\(CardSelectorState s) -> CardSelectorState <$> refreshRecents s)) CardSelector handleEvent :: GlobalState -> CS -> BrickEvent Name Event -> EventM Name (Next GlobalState) handleEvent gs s (VtyEvent e) = let update = updateCS gs continue' = continue . update in case e of - V.EvKey V.KEsc [] -> halt' gs + V.EvKey V.KEsc [] -> popStateOrQuit gs 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 diff --git a/src/UI/FileBrowser.hs b/src/UI/FileBrowser.hs --- a/src/UI/FileBrowser.hs +++ b/src/UI/FileBrowser.hs @@ -75,11 +75,10 @@ Left exc -> continue' (s' & exception' ?~ displayException exc) Right file -> case parseCards file of 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') fp result) + gs' <- refreshRecents' gs + return (gs' `goToState` parameterState (gs'^.parameters) fp result)) _ -> halt' gs _ -> continue' s' diff --git a/src/UI/Info.hs b/src/UI/Info.hs --- a/src/UI/Info.hs +++ b/src/UI/Info.hs @@ -67,4 +67,4 @@ , "" , " * Use F1 to show the answers of a open question" , "" - , " * Use CTRL+Left and CTRL+Right to move to previous and next cards without having to answer them"] + , " * Use CTRL+Left and CTRL+Right to move to previous and next cards without having to answer them; this is disabled in review mode"] diff --git a/src/UI/Parameter.hs b/src/UI/Parameter.hs new file mode 100644 --- /dev/null +++ b/src/UI/Parameter.hs @@ -0,0 +1,68 @@ +module UI.Parameter (drawUI, theMap, handleEvent) where + +import UI.Attributes +import Brick +import Brick.Focus +import Brick.Forms +import Brick.Widgets.Border +import Brick.Widgets.Border.Style +import Brick.Widgets.Center +import Control.Monad.IO.Class +import Lens.Micro.Platform +import States +import StateManagement +import Runners +import qualified Graphics.Vty as V + +drawUI :: PS -> [Widget Name] +drawUI = (:[]) . ui + +ui :: PS -> Widget Name +ui s = + joinBorders $ + center $ + withBorderStyle unicodeRounded $ + border $ + hLimitPercent 60 $ + hLimit 40 $ + hCenter (withAttr titleAttr (str "Select parameters")) <=> + hBorder <=> + padLeftRight 1 + (renderForm (s ^. psForm)) + +handleEvent :: GlobalState -> PS -> BrickEvent Name Event -> EventM Name (Next GlobalState) +handleEvent gs s ev@(VtyEvent e) = + let form = s ^. psForm + + update = updatePS gs + continue' = continue . update + continue'' f = continue . update $ s & psForm .~ f + + halt' = continue . popState + + focus = formFocus form + (Just n) = focusGetCurrent focus + down = if n == ParametersOkField then continue gs + else continue'' $ form { formFocus = focusNext focus } + up = if n == ChunkField then continue gs + else continue'' $ form { formFocus = focusPrev focus } + + in case e of + -- continue gs + V.EvKey V.KEsc [] -> halt' gs + V.EvKey V.KDown [] -> down + V.EvKey (V.KChar 'j') [] -> down + V.EvKey V.KUp [] -> up + V.EvKey (V.KChar 'k') [] -> up + V.EvKey (V.KChar '\t') [] -> continue gs + V.EvKey V.KBackTab [] -> continue gs + _ -> do f <- handleFormEvent ev form + if formState f ^. pOk + then continue =<< (gs `goToState`) + <$> liftIO (cardsWithOptionsState + (gs & parameters .~ formState f) + (s ^. psFp) + (s ^. psCards)) + else continue' (s & psForm .~ f) + +handleEvent gs _ _ = continue gs diff --git a/src/UI/Settings.hs b/src/UI/Settings.hs --- a/src/UI/Settings.hs +++ b/src/UI/Settings.hs @@ -1,7 +1,7 @@ module UI.Settings (State, drawUI, handleEvent, theMap) where import UI.Attributes -import Brick hiding (mergeWithDefault) +import Brick import Brick.Focus import Brick.Forms import Brick.Widgets.Border @@ -33,13 +33,24 @@ handleEvent gs form ev@(VtyEvent e) = let update = updateSS gs continue' = continue . update - halt' global = continue (popState global) <* liftIO (setSettings (formState form)) in + halt' global = continue (popState global) <* liftIO (setSettings (formState form)) + + focus = formFocus form + (Just n) = focusGetCurrent focus + down = if n == MaxRecentsField then continue gs + else continue' $ form { formFocus = focusNext focus } + up = if n == HintsField then continue gs + else continue' $ form { formFocus = focusPrev focus } + + in case e of - 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) } - V.EvKey V.KUp [] -> continue' $ form { formFocus = focusPrev (formFocus form) } - V.EvKey (V.KChar 'k') [] -> continue' $ form { formFocus = focusPrev (formFocus form) } + V.EvKey V.KEsc [] -> halt' gs + V.EvKey V.KDown [] -> down + V.EvKey (V.KChar 'j') [] -> down + V.EvKey V.KUp [] -> up + V.EvKey (V.KChar 'k') [] -> up + V.EvKey (V.KChar '\t') [] -> continue gs + V.EvKey V.KBackTab [] -> continue gs _ -> continue' =<< handleFormEvent ev form handleEvent gs _ _ = continue gs diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,80 @@ +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import DeckHandling +import Parser +import States +import Recents + main :: IO () -main = putStrLn "Test suite not yet implemented" +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Tests" [unitTests] + +unitTests :: TestTree +unitTests = testGroup "Unit tests" + [ testRecents + , testChunking + ] + +testRecents :: TestTree +testRecents = testGroup "Shortening filepaths" + [ testCase "empty recents" $ + shortenFilepaths [] @?= [] + , testRecentsExtension ".txt" + , testRecentsExtension ".md" + , testRecentsMix + ] + +testRecentsExtension :: String -> TestTree +testRecentsExtension ext = testGroup ("Extension " <> ext) + [ testCase "different file names" $ + shortenFilepaths ["some/path/deck1" <> ext, "some/other/path/deck2" <> ext, "some/new/path/deck3" <> ext] + @?= + ["deck1", "deck2", "deck3"] + + , testCase "recents same file name" $ + shortenFilepaths ["/path/to/deck" <> ext, "/path/to/another/deck" <> ext, "other/path/normal" <> ext] + @?= + ["to/deck", "another/deck", "normal"] + + , testCase "recents same directory and file name" $ + shortenFilepaths ["/some/directory/deck" <> ext, "/another/directory/deck" <> ext, "other/path/normal" <> ext] + @?= + ["some/directory/deck", "another/directory/deck", "normal"] + ] + +testRecentsMix :: TestTree +testRecentsMix = testGroup "Mixed extensions" + [ testCase "different file names" $ + shortenFilepaths ["some/path/deck1.txt", "some/other/path/deck2.txt", "some/new/path/deck3.md"] + @?= + ["deck1.txt", "deck2.txt", "deck3.md"] + + , testCase "recents same file name, same extension" $ + shortenFilepaths ["/path/to/deck.txt", "/path/to/another/deck.txt", "other/path/normal.md"] + @?= + ["to/deck.txt", "another/deck.txt", "normal.md"] + + , testCase "recents same file name, different extension" $ + shortenFilepaths ["/path/to/deck.md", "/path/to/another/deck.txt", "other/path/normal.md"] + @?= + ["deck.md", "deck.txt", "normal.md"] + + , testCase "recents same directory and file name, same extension" $ + shortenFilepaths ["/some/directory/deck.md", "/another/directory/deck.md", "other/path/normal.txt"] + @?= + ["some/directory/deck.md", "another/directory/deck.md", "normal.txt"] + + , testCase "recents same directory and file name, different extension" $ + shortenFilepaths ["/some/directory/deck.txt", "/another/directory/deck.md", "other/path/normal.txt"] + @?= + ["deck.txt", "deck.md", "normal.txt"] + ] + +testChunking :: TestTree +testChunking = testGroup "QuickCheck" + [ testProperty "concat . doChunking n == id" $ + \xs n -> n > 0 ==> concat (splitIntoNChunks n xs) == (xs :: [Int]) + ]