hascard 0.4.0.0 → 0.5.0.0
raw patch · 19 files changed
+469/−213 lines, 19 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Parameters: chunkField :: (Ord n, Show n) => Int -> Lens' s Chunk -> n -> s -> FormFieldState s e n
- Parameters: renderChunk :: Int -> n -> Bool -> (Chunk, Bool) -> Widget n
- Parameters: subsetLens :: Int -> Lens' Parameters Int
- States: ChunkField :: Name
+ Parameters: chunkSubsetField :: Int -> Lens' s (Chunk, Int) -> s -> FormFieldState s e Name
+ Parameters: chunkSubsetLens :: Int -> Lens' Parameters (Chunk, Int)
+ States: ChunkField1 :: Name
+ States: ChunkField2 :: Name
+ Types: Image :: String -> String -> External
+ Types: Latex :: String -> External
+ Types: [definition] :: Card -> String
+ Types: [external] :: Card -> Maybe External
+ Types: [perforated] :: Card -> Perforated
+ Types: data External
+ Types: instance GHC.Show.Show Types.External
+ Types: openCardExternal :: FilePath -> Card -> IO ()
+ Types: openCommand :: String
+ Types: openImage :: FilePath -> FilePath -> IO ()
+ Types: openImage' :: FilePath -> IO ()
+ Types: openLatex :: String -> IO ()
+ Types: whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
+ UI: data External
- DeckHandling: doChunking :: Chunk -> [Card] -> [Card]
+ DeckHandling: doChunking :: Chunk -> [a] -> [a]
- DeckHandling: doRandomization :: GlobalState -> [Card] -> IO [Card]
+ DeckHandling: doRandomization :: GlobalState -> [a] -> IO [a]
- Parameters: okField :: (Ord n, Show n) => Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
+ Parameters: okField :: (Ord n, Show n) => Lens' s Bool -> n -> String -> s -> FormFieldState s e n
- Parameters: renderOk :: Text -> n -> Bool -> Bool -> Widget n
+ Parameters: renderOk :: String -> n -> Bool -> Bool -> Widget n
- States: popupState :: forall s_aiJ6. Lens' (Popup s_aiJ6) PopupState
+ States: popupState :: forall s_aemP. Lens' (Popup s_aemP) PopupState
- Types: Definition :: String -> String -> Card
+ Types: Definition :: String -> Maybe External -> String -> Card
- Types: MultipleAnswer :: String -> NonEmpty Option -> Card
+ Types: MultipleAnswer :: String -> Maybe External -> NonEmpty Option -> Card
- Types: MultipleChoice :: String -> CorrectOption -> [IncorrectOption] -> Card
+ Types: MultipleChoice :: String -> Maybe External -> CorrectOption -> [IncorrectOption] -> Card
- Types: OpenQuestion :: String -> Perforated -> Card
+ Types: OpenQuestion :: String -> Maybe External -> Perforated -> Card
- Types: Reorder :: String -> NonEmpty (Int, String) -> Card
+ Types: Reorder :: String -> Maybe External -> NonEmpty (Int, String) -> Card
- UI.BrickHelpers: naturalNumberField :: (Ord n, Show n) => Int -> Lens' s Int -> n -> Text -> s -> FormFieldState s e n
+ UI.BrickHelpers: naturalNumberField :: (Ord n, Show n) => Int -> Lens' s Int -> n -> String -> s -> FormFieldState s e n
- UI.BrickHelpers: renderNaturalNumber :: Int -> Text -> n -> Bool -> Int -> Widget n
+ UI.BrickHelpers: renderNaturalNumber :: Int -> String -> n -> Bool -> Int -> Widget n
- UI.BrickHelpers: renderYesno :: Bool -> Text -> n -> Bool -> Bool -> Widget n
+ UI.BrickHelpers: renderYesno :: Bool -> String -> n -> Bool -> Bool -> Widget n
- UI.BrickHelpers: yesnoField :: (Ord n, Show n) => Bool -> Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
+ UI.BrickHelpers: yesnoField :: (Ord n, Show n) => Bool -> Lens' s Bool -> n -> String -> s -> FormFieldState s e n
Files
- ChangeLog.md +15/−0
- README.md +44/−12
- hascard.cabal +2/−2
- src/DeckHandling.hs +4/−2
- src/Import.hs +2/−2
- src/Parameters.hs +107/−47
- src/Parser.hs +52/−9
- src/Runners.hs +3/−1
- src/States.hs +31/−23
- src/Types.hs +74/−10
- src/UI.hs +2/−1
- src/UI/BrickHelpers.hs +10/−11
- src/UI/CardSelector.hs +6/−5
- src/UI/Cards.hs +78/−63
- src/UI/FileBrowser.hs +3/−1
- src/UI/Info.hs +3/−2
- src/UI/MainMenu.hs +6/−5
- src/UI/Parameter.hs +24/−15
- src/UI/Settings.hs +3/−2
ChangeLog.md view
@@ -1,4 +1,19 @@ # Changelog for hascard+## 0.5.0.0+New:+- References to files can be added inside cards, such that the corresponding files opens when encountering that card. The file opens in a different window using the default application for opening files of that file type configured on your computer. This can be used to add images to questions. The syntax is described [here](https://github.com/Yvee1/hascard#including-files) in the readme.+- LaTeX can be included in a card, which is first converted to a PDF and then opened with a PDF viewer. More info [here](https://github.com/Yvee1/hascard#latex) in the readme.++UI updates to parameter selection:+- Selecting the chunks in the parameter selection window is better+- The deck size visible in the parameter selection window now correctly works together with the chunk option; i.e. the maximum number of cards represents the number of cards in the selected chunk, instead of the total number of cards in the entire deck.++Some other UI updates, thanks to @g-w1:+- When entering text in an answer Control-w will go back a word+- In multiple choice, tab will also toggle the option+- In the flashcard, the "yes or no" prompt can be navigated by 'l' and 'h' for a more vi like experience+- Quitting can be done with 'q' in addition to 'ESC'+ ## 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`.
README.md view
@@ -13,11 +13,15 @@ - [Installation](#installation) - [Usage](#usage) - [Cards](#cards)- - [Definition](#definition)- - [Multiple choice](#multiple-choice)- - [Multiple answer](#multiple-answer)- - [Open question](#open-question)- - [Reorder question](#reorder-question)+ - [Card Types](#card-types)+ - [Definition](#definition)+ - [Multiple choice](#multiple-choice)+ - [Multiple answer](#multiple-answer)+ - [Open question](#open-question)+ - [Reorder question](#reorder-question)+ - [Including files](#including-files)+ - [LaTeX](#latex)+ - [Miscellaneous info](#miscellaneous-info) ## Installation@@ -60,7 +64,7 @@ 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+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 [Quizlet](https://quizlet.com/) decks can be exported to this format. As an example, the following file ``` aussi ook en outre, de plus bovendien@@ -80,9 +84,12 @@ 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.+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. -### Definition+### Card Types+In this section the 5 different types of cards are listed, first the text representation is given and after a gif of 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 ``` # Word or question@@ -93,7 +100,7 @@ <img src="./recordings/definition.gif"></img> </p> -### Multiple choice+#### Multiple choice This is a typical multiple choice question. The question starts with a `#` and the choices follow. Only one answer is correct, and is indicated by a `*`, the other questions are preceded by a `-`. As an example, the following text ```@@ -109,7 +116,7 @@ <img src="./recordings/multiple-choice.gif"></img> </p> -### Multiple answer+#### Multiple answer Multiple choice questions with multiple possible answers is also possible. Here again the question starts with `#` and the options follow. Preceding each option is a box `[ ]` that is filled with a `*` or a `x` if it is correct. For example ```@@ -125,7 +132,7 @@ </p> -### Open question+#### Open question 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 ```@@ -138,7 +145,7 @@ <img src="./recordings/gapped-question.gif"></img> </p> -### Reorder question+#### Reorder question This is a question where you have to put the elements in the correct order. Each element is preceded by a number indicating their correct place. The elements are rendered in the same order as they are written. For example the card ```@@ -152,6 +159,31 @@ <p align="center"> <img src="./recordings/reordering.gif"></img> </p>++### Including files+You might want to include an image with a question. Rendering images in the terminal itself is not well supported, so instead an option is made available to let a file be opened automatically when a question is encountered. This can for example be used to include an image or pdf, which is then opened in the default application for that file type (internally the `xdg-open` command is used for linux, and the `open` command for mac). The syntax for including files is similar to how you include images in markdown, and should be placed directly under the header. For example:+```+# What type of fruit is this?++- Apple+* Pear+- Orange+- Banana+```+references the image `pear.jpeg` in the directory of the text file containing the cards. Files can be added to any of the previously listed card types.++#### LaTeX+For reviewing content with mathematical symbols, functionality is included such that LaTeX can be used. Because LaTeX cannot be rendered in the terminal directly, it is first converted to a pdf file with the `pdflatex` command (the pdf is placed in a temporary directory), and then opened in the default pdf viewer application as if the pdf were included directly like mentioned above. LaTeX can be written between three backticks, and should be placed right below the header. For example, the card+``````+# The l^p metric space+```+The space $(\ell^p, d)$ is a metric space, when $d:\ell^p \times \ell^p \rightarrow \mathbb{R}$ is defined as+$$d(x, y) = \left(\sum_{n=1}^\infty |x_n-y_n|^p\right)^{1/p}$$+```+``````+is an empty definition card and just opens a pdf file containing the mathematical statement in another window.++Note that no `\begin{document}`, `\end{document}` or `\documentclass[]{}` should be specified; this is already done automatically. The LaTeX packages "amsfonts", and "mathtools" are currently the only ones that are loaded. ## Miscellaneous info 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).
hascard.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7c2a1f916052eaf8858f1e8e359e6e1d9c03574003a5f393ef15e395da73feda+-- hash: 79b1be93322160d8b18065165e9cddfd67acd720d9bb7049de3e40cfdd1f4665 name: hascard-version: 0.4.0.0+version: 0.5.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
src/DeckHandling.hs view
@@ -4,16 +4,18 @@ import States import Types -doRandomization :: GlobalState -> [Card] -> IO [Card]+doRandomization :: GlobalState -> [a] -> IO [a] doRandomization gs cards = let n = length cards in do 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 -> [a] -> [a] doChunking (Chunk i n) cards = splitIntoNChunks n cards !! (i-1) +-- Split into chunks that differ a maximum of 1 in size;+-- the larger chunks are all at the front. splitIntoNChunks :: Int -> [a] -> [[a]] splitIntoNChunks n xs = let (q, r) = length xs `quotRem` n
src/Import.hs view
@@ -20,9 +20,9 @@ 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 + makeOpen (header, body) = OpenQuestion header Nothing (P "" (NE.fromList (map (dropWhile isSpace) (splitOneOf ",/;" body))) (Normal "")) in case iType of- Def -> map (uncurry Definition) <$> xs+ Def -> map (\(s1, s2) -> Definition s1 Nothing s2) <$> xs Open -> map makeOpen <$> xs
src/Parameters.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE OverloadedStrings, RankNTypes #-}+{-# LANGUAGE RankNTypes #-} module Parameters where import UI.Attributes import Brick import Brick.Widgets.Center import Brick.Forms+import DeckHandling import Data.Maybe import Data.Char (isDigit) import Data.Text (pack)@@ -18,63 +19,122 @@ 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))+ [ chunkSubsetField n (chunkSubsetLens 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))+chunkSubsetLens :: Int -> Lens' Parameters (Chunk, Int)+chunkSubsetLens n = lens getter setter+ where getter ps = (ps^.pChunk, fromMaybe n (ps^.pSubset))+ setter ps (c, int) = ps & pChunk.~c & pSubset ?~ int -chunkField :: (Ord n, Show n) => Int -> Lens' s Chunk -> n -> s -> FormFieldState s e n-chunkField bound stLens name initialState =- let initVal = initialState ^. stLens+chunkSubsetField :: Int -> Lens' s (Chunk, Int) -> s -> FormFieldState s e Name+chunkSubsetField capacity stLens initialState = + let (initChunk, initInt) = 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+ handleChunkEvent1 :: BrickEvent n e -> (Chunk, Int) -> EventM n (Chunk, Int)+ handleChunkEvent1 (VtyEvent ev) s@(c@(Chunk i n), int) = case ev of+ V.EvKey (V.KChar c) [] | isDigit c -> + let i' = read (show i ++ [c])+ in return $ if i' <= n || n == 0 then (Chunk i' n, getSizeOfChunk (Chunk i' n)) else (Chunk n n, getSizeOfChunk (Chunk n n))+ V.EvKey V.KBS [] ->+ let calcNew x = if null (show x) then 0 else fromMaybe 0 (readMaybe (init (show x)))+ in return (Chunk (calcNew i) n, int)+ _ -> return s+ handleChunkEvent1 _ 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 ]+ handleChunkEvent2 :: BrickEvent n e -> (Chunk, Int) -> EventM n (Chunk, Int)+ handleChunkEvent2 (VtyEvent ev) s@(c@(Chunk i n), int) = case ev of+ V.EvKey (V.KChar c) [] | isDigit c -> + let n' = read (show n ++ [c])+ i' = if i <= n' || n' == 0 then i else n'+ in return $ if n' <= capacity then (Chunk i' n', getSizeOfChunk (Chunk i' n')) else (Chunk i capacity, getSizeOfChunk (Chunk i capacity))+ V.EvKey V.KBS [] ->+ let calcNew x = if null (show x) then 0 else fromMaybe 0 (readMaybe (init (show x)))+ in return $+ let newN = calcNew n+ newI = if i <= newN || newN == 0 then i else newN+ in (Chunk newI newN, int)+ _ -> return s+ handleChunkEvent2 _ s = return s++ handleSubsetEvent :: BrickEvent n e -> (Chunk, Int) -> EventM n (Chunk, Int)+ handleSubsetEvent (VtyEvent ev) s@(ch@(Chunk i n), int) = + let bound = getSizeOfChunk ch in+ case ev of+ V.EvKey (V.KChar c) [] | isDigit c -> + let newValue = read (show int ++ [c])+ int' = if newValue <= bound then newValue else bound+ in return (ch, int')+ V.EvKey V.KBS [] -> + let int' = case show int of+ "" -> 0+ xs -> fromMaybe 0 (readMaybe (init xs))+ in return (ch, int')+ _ -> return s+ handleSubsetEvent _ s = return s++ renderChunk1 :: Bool -> (Chunk, Int) -> Widget Name+ renderChunk1 foc (Chunk i n, _) = + let addAttr = if foc then withDefAttr focusedFormInputAttr else id+ csr x = if foc then showCursor ChunkField1 (Location (length x,0)) else id+ val' 0 = ""+ val' x = show x+ in addAttr (csr (val' i) (str (val' i))) <+> str "/"++ renderChunk2 :: Bool -> (Chunk, Int) -> Widget Name+ renderChunk2 foc (Chunk i n, _) = + let addAttr = if foc then withDefAttr focusedFormInputAttr else id+ csr x = if foc then showCursor ChunkField2 (Location (length x,0)) else id+ val' 0 = ""+ val' x = show x+ in addAttr (csr (val' n) (str (val' n)))++ customConcat :: [Widget Name] -> Widget Name+ customConcat [chunk1, chunk2, subset] = + (str "Select chunk:" <+> hFill ' ' <+> chunk1 <+> chunk2) + <=>+ str " "+ <=>+ (str "Number of cards:" <+> hFill ' ' <+> subset)+ <=>+ str " "+ customConcat _ = error "chunkSubsetField form field concatenation has gone wrong"++ getSizeOfChunk :: Chunk -> Int+ getSizeOfChunk (Chunk i n) = + if i >= 1 && n >= 1 && i <= n+ then length (splitIntoNChunks n [1..capacity] !! (i-1))+ else capacity++ renderSubset :: Bool -> (Chunk, Int) -> Widget Name+ renderSubset foc (c, value) = + let cardsInChunk = getSizeOfChunk c+ in renderNaturalNumber cardsInChunk ("/" <> show cardsInChunk) SubsetField foc value+ + validateChunk (c@(Chunk i n), int) = if i >= 1 && n >= 1 && i <= n then Just (c, int) else Nothing+ validateSubset = Just++ in FormFieldState { formFieldState = (initChunk, initInt)+ , formFields = [ + FormField ChunkField1 validateChunk True+ renderChunk1+ handleChunkEvent1,+ FormField ChunkField2 validateChunk True+ renderChunk2+ handleChunkEvent2,+ FormField SubsetField validateSubset True+ renderSubset+ handleSubsetEvent+ ] , 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)+ , formFieldConcat = customConcat } -okField :: (Ord n, Show n) => Lens' s Bool -> n -> T.Text -> s -> FormFieldState s e n+okField :: (Ord n, Show n) => Lens' s Bool -> n -> String -> s -> FormFieldState s e n okField stLens name label initialState = let initVal = initialState ^. stLens @@ -89,6 +149,6 @@ , formFieldRenderHelper = id , formFieldConcat = vBox } -renderOk :: T.Text -> n -> Bool -> Bool -> Widget n+renderOk :: String -> n -> Bool -> Bool -> Widget n renderOk label _ focus _ = (if focus then withAttr selectedAttr else id) $ str "Ok"
src/Parser.hs view
@@ -12,7 +12,9 @@ import Types import qualified Data.List.NonEmpty as NE +-- Type synonyms for convenience type Parser = Parsec Void String+type CardParser = Parser (Either String Card) uncurry3 f (a, b, c) = f a b c @@ -27,42 +29,71 @@ pCard :: Parser (Either String Card) pCard = try pMultChoice- <|> Right . uncurry MultipleAnswer <$> try pMultAnswer+ <|> try pMultAnswer <|> try pReorder- <|> Right . uncurry OpenQuestion <$> try pOpen- <|> Right . uncurry Definition <$> pDef+ <|> try pOpen+ <|> pDef +pHeader :: Parser String pHeader = do many eol char '#' spaceChar many (noneOf ['\n', '\r']) +pImage :: Parser External+pImage = do+ many eol+ char '!'+ char '['+ alt <- manyTill anySingle (char ']')+ char '('+ img <- manyTill anySingle (char ')')+ return $ Image alt img++pLatex :: Parser External+pLatex = do+ many eol+ string "```"+ Latex <$> manyTill anySingle (try (string "```"))++pMaybeExternal :: Parser (Maybe External)+pMaybeExternal = Just <$> try pImage+ <|> Just <$> try pLatex+ <|> pure Nothing++pMultChoice :: CardParser pMultChoice = do header <- pHeader+ img <- pMaybeExternal many eol choices <- pChoice `sepBy1` lookAhead (try choicePrefix) 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+ Right (correct, incorrects) -> return . Right $ MultipleChoice header img correct incorrects +pChoice :: Parser (Char, String) pChoice = do kind <- oneOf ['*','-'] spaceChar text <- manyTill anySingle $ lookAhead (try (try choicePrefix <|> seperator <|> eof')) return (kind, text) +choicePrefix :: Parser String choicePrefix = string "- " <|> string "* " +pMultAnswer :: CardParser pMultAnswer = do header <- pHeader+ img <- pMaybeExternal many eol options <- pOption `sepBy1` lookAhead (try (char '['))- return (header, NE.fromList options)+ return . Right $ MultipleAnswer header img (NE.fromList options) +pOption :: Parser Option pOption = do char '[' kind <- oneOf ['*','x',' ']@@ -70,38 +101,46 @@ text <- manyTill anySingle $ lookAhead (try (seperator <|> string "[" <|> eof')) return $ makeOption kind (dropWhileEnd isSpace' text) +pReorder :: CardParser pReorder = do header <- pHeader+ img <- pMaybeExternal many eol elements <- pReorderElement `sepBy1` lookAhead (try pReorderPrefix) let numbers = map fst elements if all (`elem` numbers) [1..length numbers]- then return . Right $ Reorder header (NE.fromList elements)+ then return . Right $ Reorder header img (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 :: Parser (Int, String) pReorderElement = do int <- pReorderPrefix text <- manyTill anySingle $ lookAhead (try (try seperator <|> try pReorderPrefix <|> eof')) return (read int, dropWhileEnd isSpace' text) +pReorderPrefix :: Parser String pReorderPrefix = do int <- some digitChar string ". " return int +pOpen :: CardParser pOpen = do header <- pHeader+ img <- pMaybeExternal many eol (pre, gap) <- pGap sentence <- pSentence - return (header, P pre gap sentence)+ return $ Right (OpenQuestion header img (P pre gap sentence)) +pSentence :: Parser Sentence pSentence = try pPerforated <|> pNormal- ++pPerforated :: Parser Sentence pPerforated = do (pre, gap) <- pGap Perforated pre gap <$> pSentence @@ -109,6 +148,7 @@ chars = try escaped <|> anySingle escaped = char '\\' >> char '_' +pGap :: Parser (String, NE.NonEmpty String) pGap = do pre <- manyTill chars $ lookAhead (try (string "_" <|> seperator)) char '_'@@ -120,15 +160,18 @@ <|> string "|" <|> string "_" +pNormal :: Parser Sentence pNormal = do text <- manyTill (noneOf ['_']) $ lookAhead $ try $ seperator <|> eof' return (Normal (dropWhileEnd isSpace' text)) +pDef :: CardParser pDef = do header <- pHeader+ img <- pMaybeExternal many eol descr <- manyTill chars $ lookAhead $ try $ seperator <|> eof'- return (header, dropWhileEnd isSpace' descr)+ return $ Right (Definition header img (dropWhileEnd isSpace' descr)) eof' = eof >> return [] <?> "end of file"
src/Runners.hs view
@@ -8,6 +8,7 @@ import Parameters import Settings import States+import System.FilePath (takeDirectory) import Types import qualified Brick.Widgets.List as L import qualified Data.Vector as Vec@@ -47,7 +48,7 @@ controls <- getShowControls let mFirstCard = safeHead deck- firstCard = fromMaybe (Definition "Empty deck" "Click enter to go back.") mFirstCard+ firstCard = fromMaybe (Definition "Empty deck" Nothing "Click enter to go back.") mFirstCard deck' = maybe [firstCard] (const deck) mFirstCard initialState = @@ -63,6 +64,7 @@ , _popup = Nothing , _pathToFile = fp } + openCardExternal (takeDirectory fp) firstCard return $ CardsState initialState cardsWithOptionsState :: GlobalState -> FilePath -> [Card] -> IO State
src/States.hs view
@@ -23,9 +23,10 @@ | MaxRecentsField -- Parameters- | ShuffleField+ | ChunkField1+ | ChunkField2 | SubsetField- | ChunkField+ | ShuffleField | ReviewModeField | ParametersOkField @@ -103,42 +104,49 @@ defaultCardState :: Card -> CardState defaultCardState Definition{} = DefinitionState { _flipped = False }-defaultCardState (MultipleChoice _ _ ics) = MultipleChoiceState +defaultCardState MultipleChoice{incorrects = ics} = MultipleChoiceState { _highlighted = 0 , _number = length ics + 1 , _tried = M.fromList [(i, False) | i <- [0..length ics]] }-defaultCardState (OpenQuestion _ perforated) = OpenQuestionState +defaultCardState OpenQuestion{perforated=perf} = OpenQuestionState { _gapInput = M.empty , _highlighted = 0- , _number = nGapsInPerforated perforated+ , _number = nGapsInPerforated perf , _entered = False- , _correctGaps = M.fromList [(i, False) | i <- [0..nGapsInPerforated perforated - 1]]+ , _correctGaps = M.fromList [(i, False) | i <- [0..nGapsInPerforated perf - 1]] , _failed = False }-defaultCardState (MultipleAnswer _ answers) = MultipleAnswerState +defaultCardState MultipleAnswer{options=opts} = MultipleAnswerState { _highlighted = 0- , _selected = M.fromList [(i, False) | i <- [0..NE.length answers-1]]+ , _selected = M.fromList [(i, False) | i <- [0..NE.length opts-1]] , _entered = False- , _number = NE.length answers }-defaultCardState (Reorder _ elements) = ReorderState+ , _number = NE.length opts }+defaultCardState Reorder{elements=elts} = ReorderState { _highlighted = 0 , _grabbed = False- , _order = M.fromList (zip [0..] (NE.toList elements))+ , _order = M.fromList (zip [0..] (NE.toList elts)) , _entered = False- , _number = NE.length elements }+ , _number = NE.length elts } data CS = CS- { _cards :: [Card] -- list of flashcards- , _index :: Int -- current card index- , _nCards :: Int -- number of cards- , _currentCard :: Card- , _cardState :: CardState- , _showHints :: Bool- , _showControls :: Bool- , _reviewMode :: Bool- , _correctCards :: [Int] -- list of indices of correct cards- , _popup :: Maybe (Popup CS)- , _pathToFile :: FilePath+ { _cards :: [Card] -- list of flashcards+ , _index :: Int -- current card index+ , _nCards :: Int -- number of cards+ , _currentCard :: Card+ , _cardState :: CardState+ , _showHints :: Bool+ , _showControls :: Bool+ , _reviewMode :: Bool+ , _correctCards :: [Int] -- list of indices of correct cards+ , _popup :: Maybe (Popup CS)+ , _pathToFile :: FilePath }++-- -- Lens for just accessing the cards+-- cards :: Lens' CS [Card]+-- cards = lens (map snd . _cardsAndImages) (\cs cards -> cs {_cardsAndImages = zip (map fst (_cardsAndImages cs)) cards})++-- currentCard :: Lens' CS Card+-- currentCard = lens (snd . _currentCardAndImage) (\cs card -> cs {_currentCardAndImage = (fst (_currentCardAndImage cs), card)}) data Popup s = Popup { drawPopup :: s -> Widget Name
src/Types.hs view
@@ -2,34 +2,98 @@ import Data.Functor import Data.List import Data.List.NonEmpty (NonEmpty)+import System.FilePath+import System.Process+import System.Info+import System.IO import qualified Data.List.NonEmpty as NE+import qualified System.Directory as D -- Word Description-data Card = Definition String String- | OpenQuestion String Perforated+data Card = Definition { + question :: String,+ external :: Maybe External,+ definition :: String }+ | OpenQuestion {+ question :: String,+ external :: Maybe External,+ perforated :: Perforated } | MultipleChoice { question :: String,+ external :: Maybe External, correct :: CorrectOption, incorrects :: [IncorrectOption]} | MultipleAnswer { question :: String,+ external :: Maybe External, options :: NonEmpty Option } | Reorder { question :: String,+ external :: Maybe External, elements :: NonEmpty (Int, String) } 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))+ Definition h img descr -> showHeader h <> show img <> "\n" <> descr+ OpenQuestion h img p -> showHeader h <> show img <> "\n" <> show p+ MultipleChoice h img c inc -> + showHeader h <> show img <> "\n" <> showMultipleChoice c inc+ MultipleAnswer h img opts ->+ showHeader h <> show img <> "\n" <> unlines' (NE.toList (NE.map show opts))+ Reorder h img elts -> + showHeader h <> show img<> "\n" <> unlines' (NE.toList (NE.map showReorder elts))++-- alt file+data External = Image String String+ | Latex String++instance Show External where+ show (Image alt file) = "![" <> alt <> "]" <> "(" <> file <> ")"+ show (Latex text) = "```\n" <> text <> "```" ++openCommand :: String+openCommand = case os of+ "darwin" -> "open"+ "linux" -> "xdg-open"+ _ -> error "Unkown OS for opening images"++openImage :: FilePath -> FilePath -> IO ()+openImage origin relative = openImage' (origin </> relative)++openImage' :: FilePath -> IO ()+openImage' fp = do+ exists <- D.doesFileExist fp + if exists+ then void $ runCommand (openCommand <> " \"" <> fp <> "\"")+ else error $ "The image you were trying to open does not exist: " <> fp++openLatex :: String -> IO ()+openLatex latex = do+ let packages = ["amsfonts", "mathtools"]+ text = unlines $+ [ "\\documentclass[preview]{standalone}" ]+ ++ map (\p -> "\\usepackage{"<>p<>"}") packages +++ [ "\\begin{document}"+ , latex+ , "\\end{document}" ]+ dir <- D.getTemporaryDirectory+ (tempfile, temph) <- openTempFile dir "hascard-latex-"+ hPutStrLn temph text+ hClose temph+ callProcess "pdflatex" ["-output-directory", dir, tempfile]+ openImage' (tempfile <> ".pdf")++openCardExternal :: FilePath -> Card -> IO ()+openCardExternal origin card =+ case external card of+ Nothing -> pure ()+ Just (Image _ relative) -> openImage origin relative+ Just (Latex text) -> openLatex text++whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()+whenJust mg f = maybe (pure ()) f mg data Type = Incorrect | Correct deriving (Show, Eq)
src/UI.hs view
@@ -6,6 +6,7 @@ , GenIO , Chunk(..) , Card+, External , ImportType(..) , Parameters(..) @@ -26,7 +27,7 @@ import Import import States import StateManagement-import Types (Card, cardsToString)+import Types (Card, External, cardsToString) runBrickFlashcards :: GlobalState -> IO () runBrickFlashcards gs = do
src/UI/BrickHelpers.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, RankNTypes #-}+{-# LANGUAGE RankNTypes #-} module UI.BrickHelpers where import Text.Wrap import Brick@@ -12,7 +12,6 @@ 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@@ -63,7 +62,7 @@ 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 :: (Ord n, Show n) => Bool -> Lens' s Bool -> n -> String -> s -> FormFieldState s e n yesnoField rightAlign stLens name label initialState = let initVal = initialState ^. stLens @@ -80,17 +79,17 @@ , formFieldRenderHelper = id , formFieldConcat = vBox } -renderYesno :: Bool -> T.Text -> n -> Bool -> Bool -> Widget n+renderYesno :: Bool -> String -> 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")+ then addAttr (str "Yes") else if rightAlign - then txt " " <+> addAttr (txt "No")- else addAttr (txt "No") <+> txt " ") <+> txt label+ then str " " <+> addAttr (str "No")+ else addAttr (str "No") <+> str " ") <+> str label -naturalNumberField :: (Ord n, Show n) => Int -> Lens' s Int -> n -> T.Text -> s -> FormFieldState s e n+naturalNumberField :: (Ord n, Show n) => Int -> Lens' s Int -> n -> String -> s -> FormFieldState s e n naturalNumberField bound stLens name postfix initialState = let initVal = initialState ^. stLens @@ -110,11 +109,11 @@ , formFieldRenderHelper = id , formFieldConcat = vBox } -renderNaturalNumber :: Int -> T.Text -> n -> Bool -> Int -> Widget n+renderNaturalNumber :: Int -> String -> 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+ in if null postfix then hLimit (length (show bound)) (csr (addAttr (str val')) <+> hFill ' ') - else csr (addAttr (str val')) <+> txt postfix+ else csr (addAttr (str val')) <+> str postfix
src/UI/CardSelector.hs view
@@ -1,4 +1,4 @@-module UI.CardSelector +module UI.CardSelector ( State , drawUI , handleEvent@@ -27,16 +27,16 @@ import qualified UI.Attributes as A drawUI :: GlobalState -> CSS -> [Widget Name]-drawUI gs s = +drawUI gs s = [ drawException (s ^. exception), drawMenu gs s ] title :: Widget Name title = withAttr titleAttr $ str "Select a deck of flashcards " drawMenu :: GlobalState -> CSS -> Widget Name-drawMenu gs s = +drawMenu gs s = joinBorders $- center $ + center $ withBorderStyle unicodeRounded $ border $ hLimitPercent 60 $@@ -73,6 +73,7 @@ (Just _, _) -> continue' $ s & exception .~ Nothing (_, e) -> case e of V.EvKey V.KEsc [] -> halt' gs+ V.EvKey (V.KChar 'q') [] -> halt' gs _ -> do l' <- L.handleListEventVi L.handleListEvent e l let s' = (s & list .~ l') in@@ -80,7 +81,7 @@ V.EvKey V.KEnter [] -> case L.listSelectedElement l' of Nothing -> continue' s'- Just (_, "Select file from system") -> + Just (_, "Select file from system") -> let gs' = update s' in continue =<< (gs' `goToState`) <$> liftIO fileBrowserState Just (i, _) -> do let fp = (s' ^. recents) `S.unsafeElemAt` i
src/UI/Cards.hs view
@@ -11,11 +11,13 @@ import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) import Data.Maybe+import Data.List.Split import Text.Wrap import Data.Text (pack) import UI.Attributes import UI.BrickHelpers import System.FilePath+import Data.List (intercalate) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Data.Map.Strict as M@@ -48,12 +50,12 @@ hLimitPercent 60 w drawFooter :: CS -> Widget Name-drawFooter s = if s^.reviewMode +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)) + 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)@@ -63,23 +65,23 @@ drawCardUI s = let p = 1 in joinBorders $ drawCardBox $ (<=> drawFooter s) $ case (s ^. cards) !! (s ^. index) of- Definition title descr -> drawHeader title+ Definition title _ descr -> drawHeader title <=> B.hBorder <=> padLeftRight p (drawDef s descr <=> str " ")- - MultipleChoice question correct others -> drawHeader question - <=> B.hBorder ++ MultipleChoice question _ correct others -> drawHeader question+ <=> B.hBorder <=> padLeftRight p (drawChoices s (listMultipleChoice correct others) <=> str " ") - OpenQuestion title perforated -> drawHeader title+ OpenQuestion title _ perforated -> drawHeader title <=> B.hBorder <=> padLeftRight p (atLeastV 1 (drawPerforated s perforated) <=> str " ") - MultipleAnswer question options -> drawHeader question+ MultipleAnswer question _ options -> drawHeader question <=> B.hBorder <=> padRight (Pad p) (drawOptions s options <=> str " ") - Reorder question _ -> drawHeader question+ Reorder question _ _ -> drawHeader question <=> B.hBorder <=> padLeftRight p (drawReorder s <=> str " ") @@ -100,7 +102,7 @@ drawHintedDef :: CS -> String -> Widget Name drawHintedDef s def = case s ^. cardState of DefinitionState {_flipped=f} -> if f then drawDescr def else drawDescr [if isSpace' char then char else '_' | char <- def]- _ -> error "impossible: " + _ -> error "impossible: " isSpace' :: Char -> Bool isSpace' '\r' = True@@ -114,17 +116,17 @@ c <- getContext let w = c^.availWidthL render . vBox $ [str " " | _ <- wrapTextToLines wrapSettings w (pack def)]- _ -> error "impossible: " + _ -> error "impossible: " drawChoices :: CS -> [String] -> Widget Name drawChoices s options = case (s ^. cardState, s ^. currentCard) of- (MultipleChoiceState {_highlighted=i, _tried=kvs}, MultipleChoice _ (CorrectOption k _) _) -> vBox formattedOptions- + (MultipleChoiceState {_highlighted=i, _tried=kvs}, MultipleChoice _ _ (CorrectOption k _) _) -> vBox formattedOptions+ where formattedOptions :: [Widget Name] formattedOptions = [ prefix <+> coloring (drawDescr opt) | (j, opt) <- zip [0..] options, let prefix = if i == j then withAttr highlightedChoiceAttr (str "* ") else str " "- chosen = M.findWithDefault False j kvs + chosen = M.findWithDefault False j kvs coloring = case (chosen, j==k) of (False, _) -> id (True, False) -> withAttr incorrectChoiceAttr@@ -134,7 +136,7 @@ drawOptions :: CS -> NonEmpty Option -> Widget Name drawOptions s = case (s ^. cardState, s ^. currentCard) of- (MultipleAnswerState {_highlighted=j, _selected=kvs, _entered=submitted}, _) -> + (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 " "@@ -163,12 +165,12 @@ makeSentenceWidget w state = vBox . fst . makeSentenceWidget' 0 0 where makeSentenceWidget' :: Int -> Int -> Sentence -> ([Widget Name], Bool)- makeSentenceWidget' padding _ (Normal s) = let (ws, _, fit) = wrapStringWithPadding padding w s in (ws, fit) + makeSentenceWidget' padding _ (Normal s) = let (ws, _, fit) = wrapStringWithPadding padding w s in (ws, fit) makeSentenceWidget' padding i (Perforated pre _ post) = case state ^. cardState of OpenQuestionState {_gapInput = kvs, _highlighted=j, _entered=submitted, _correctGaps=cgs} -> let (ws, n, fit') = wrapStringWithPadding padding w pre gap = M.findWithDefault "" i kvs- n' = w - n - textWidth gap + n' = w - n - textWidth gap cursor :: Widget Name -> Widget Name -- i is the index of the gap that we are drawing; j is the gap that is currently selected@@ -179,10 +181,10 @@ (False, _) -> withAttr gapAttr (True, False) -> withAttr incorrectGapAttr (True, True) -> withAttr correctGapAttr- + gapWidget = cursor $ coloring (str gap) in - if n' >= 0 + if n' >= 0 then let (ws1@(w':ws'), fit) = makeSentenceWidget' (w-n') (i+1) post in if fit then ((ws & _last %~ (<+> (gapWidget <+> w'))) ++ ws', fit') else ((ws & _last %~ (<+> gapWidget)) ++ ws1, fit')@@ -195,7 +197,7 @@ wrapStringWithPadding padding w s | null (words s) = ([str ""], padding, True) | otherwise = if textWidth (head (words s)) < w - padding then- let startsWithSpace = head s == ' ' + let startsWithSpace = head s == ' ' s' = if startsWithSpace then " " <> replicate padding 'X' <> tail s else replicate padding 'X' ++ s lastLetter = last s postfix = if lastLetter == ' ' then T.pack [lastLetter] else T.empty@@ -214,7 +216,7 @@ drawReorder :: CS -> Widget Name drawReorder s = case (s ^. cardState, s ^. currentCard) of- (ReorderState {_highlighted=j, _grabbed=g, _order=kvs, _number=n, _entered=submitted}, Reorder _ _) -> + (ReorderState {_highlighted=j, _grabbed=g, _order=kvs, _number=n, _entered=submitted}, Reorder{}) -> vBox . flip map (map (\i -> (i, kvs M.! i)) [0..n-1]) $ \(i, (k, text)) -> let color = case (i == j, g) of@@ -222,7 +224,7 @@ (True, False) -> withAttr highlightedElementAttr _ -> id - number = + number = case (submitted, i+1 == k) of (False, _) -> str (show (i+1) <> ". ") (True, False) -> withAttr incorrectElementAttr (str (show k <> ". "))@@ -252,30 +254,28 @@ case (s ^. cardState, s ^. currentCard) of (DefinitionState{_flipped = f}, _) -> case ev of- V.EvKey V.KEnter [] -> + V.EvKey V.KEnter [] -> if f- then if not (s^.reviewMode) then next gs s + 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 _) _) ->+ (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.KDown [] -> continue' down V.EvKey (V.KChar 'j') [] -> continue' down 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 where frozen = M.findWithDefault False j kvs- + down = if i < n-1 && not frozen then s & (cardState.highlighted) +~ 1 else s@@ -285,12 +285,12 @@ else s correctlyAnswered = i == j && M.size (M.filter (==True) kvs) == 1- - (MultipleAnswerState {_highlighted = i, _number = n, _entered = submitted, _selected = kvs}, MultipleAnswer _ opts) ->++ (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.KDown [] -> continue' down V.EvKey (V.KChar 'j') [] -> continue' down V.EvKey (V.KChar 'c') [] -> continue' $ s & (cardState.entered) .~ True@@ -299,12 +299,17 @@ 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.KChar '\t') [] ->+ if frozen+ then next gs $ s & if correctlyAnswered then correctCards %~ (s^.index:) else id+ else continue' $ s & cardState.selected %~ M.adjust not i + _ -> continue' s where frozen = submitted- + down = if i < n-1 && not frozen then s & (cardState.highlighted) +~ 1 else s@@ -315,7 +320,7 @@ correctlyAnswered = NE.toList (NE.map isOptionCorrect opts) == map snd (M.toAscList kvs) - (OpenQuestionState {_highlighted = i, _number = n, _gapInput = kvs, _correctGaps = cGaps, _failed=fail}, OpenQuestion _ 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' $@@ -325,28 +330,34 @@ & 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' $ + 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' $ ++ V.EvKey V.KRight [] -> continue' $ if i < n - 1 && not frozen then s & (cardState.highlighted) +~ 1 else s - V.EvKey V.KLeft [] -> continue' $ + V.EvKey V.KLeft [] -> continue' $ if i > 0 && not frozen then s & (cardState.highlighted) -~ 1 else s + -- C-w deletes a word back (eg. "test test" -> "test")+ V.EvKey (V.KChar 'w') [V.MCtrl] -> continue' $+ if frozen then s else s & cardState.gapInput.ix i %~ backword+ where backword "" = ""+ backword xs = intercalate " " $ init $ words xs+ V.EvKey (V.KChar c) [] -> continue' $ if frozen then s else s & cardState.gapInput.at i.non "" %~ (++[c]) V.EvKey V.KEnter [] -> if frozen then if fail then next gs s- else next gs (s & correctCards %~ (s^.index:)) + else next gs (s & correctCards %~ (s^.index:)) else continue' s' where sentence = perforatedToSentence perforated gaps = sentenceToGaps sentence@@ -358,17 +369,18 @@ then s' else s' & cardState.failed .~ True - V.EvKey V.KBS [] -> continue' $ ++ 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) ->++ (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.KDown [] -> continue' down V.EvKey (V.KChar 'j') [] -> continue' down V.EvKey (V.KChar 'c') [] -> continue' $ s & (cardState.entered) .~ True@@ -382,8 +394,8 @@ where frozen = submitted- - down = ++ down = case (frozen, i < n - 1, dragging) of (True, _, _) -> s (_, False, _) -> s@@ -398,7 +410,7 @@ (_, _, 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"@@ -406,9 +418,9 @@ 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 = + | s ^. index + 1 < length (s ^. cards) = liftIO (openCardExternal (takeDirectory (s^.pathToFile)) ((s^.cards) !! (s^.index + 1))) *> (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@@ -416,7 +428,7 @@ | otherwise = halt' gs previous :: GlobalState -> CS -> EventM Name (Next GlobalState)-previous gs s | s ^. index > 0 = continue . updateCS gs . straightenState $ s & index -~ 1+previous gs s | s ^. index > 0 = liftIO (openCardExternal (takeDirectory (s^.pathToFile)) ((s^.cards) !! (s^.index - 1))) *> (continue . updateCS gs . straightenState $ s & index -~ 1) | otherwise = continue gs straightenState :: CS -> CS@@ -424,7 +436,7 @@ let card = (s ^. cards) !! (s ^. index) in s & currentCard .~ card & cardState .~ defaultCardState card- + interchange :: (Ord a) => a -> a -> Map a b -> Map a b interchange i j kvs = let vali = kvs M.! i@@ -448,7 +460,7 @@ colorYes = if selected == 1 then selectedYesButtonAttr else yesButtonAttr no = withAttr colorNo $ str "No" yes = withAttr colorYes $ str "Yes" in- centerPopup $ + centerPopup $ B.borderWithLabel (str "Correct?") $ hLimit 20 $ str " " <=>@@ -457,13 +469,16 @@ initialState = CorrectPopup 0 - eventHandler gs s ev = + 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)+ -- Adding vim shortcuts here+ V.EvKey (V.KChar 'h') []-> continue' $ s & popup ?~ (p & popupState.popupSelected .~ 0)+ V.EvKey (V.KChar 'l') []-> 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@@ -471,12 +486,12 @@ finalPopup :: Popup CS finalPopup = Popup drawer eventHandler initialState- where drawer s = - let wrong = withAttr wrongAttr (str (" Incorrect: " <> show nWrong) <+> hFill ' ') + 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 $ + centerPopup $ B.borderWithLabel (str "Finished") $ hLimit 20 $ str " " <=>@@ -498,19 +513,19 @@ (_, True) -> withAttr highlightedOptAttr $ str "*" (True, _) -> withAttr selectedOptAttr $ str "*" _ -> withAttr selectedOptAttr $ str " "- - makeBox lens i = ++ 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 ' ') + 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 $ + centerPopup $ B.borderWithLabel (str "Generate decks") $ hLimit 20 $ str " " <=>@@ -547,8 +562,8 @@ _ -> continue' s generateDecks :: FilePath -> [Card] -> [Int] -> Bool -> Bool -> IO ()-generateDecks fp cards corrects makeCorrect makeIncorrect = - when (makeCorrect || makeIncorrect) $ +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)@@ -558,7 +573,7 @@ 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) = + 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)
src/UI/FileBrowser.hs view
@@ -46,7 +46,7 @@ vBox [ hCenter $ txt "Up/Down: select, h: toggle show hidden files" , hCenter $ txt "/: search, Ctrl-C or Esc: cancel search" , hCenter $ txt "Enter: change directory or select file"- , hCenter $ txt "Esc: quit"+ , hCenter $ txt "Esc or q: quit" ] handleEvent :: GlobalState -> FBS -> BrickEvent Name Event -> EventM Name (Next GlobalState)@@ -58,6 +58,8 @@ (Just _, _) -> continue' $ s & exception' .~ Nothing (_, e) -> case e of V.EvKey V.KEsc [] | not (fileBrowserIsSearching b) ->+ halt' gs+ V.EvKey (V.KChar 'q') [] | 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
src/UI/Info.hs view
@@ -14,7 +14,7 @@ ui :: Widget Name ui = joinBorders $- center $ + center $ withBorderStyle unicodeRounded $ border $ hLimit 40 $@@ -29,6 +29,7 @@ halt' = continue . popState in case e of V.EvKey V.KEsc [] -> halt' gs+ V.EvKey (V.KChar 'q') [] -> halt' gs V.EvKey V.KEnter [] -> halt' gs V.EvKey V.KDown [] -> vScrollBy (viewportScroll Ordinary) 1 >> continue' s V.EvKey (V.KChar 'j') [] -> vScrollBy (viewportScroll Ordinary) 1 >> continue' s@@ -45,7 +46,7 @@ [ (titleAttr, fg V.yellow) ] drawInfo :: Widget Name-drawInfo = +drawInfo = padLeftRight 1 $ vLimitPercent 60 $ viewport Ordinary Vertical (strWrap info)
src/UI/MainMenu.hs view
@@ -19,16 +19,16 @@ title = withAttr titleAttr $ str "┬ ┬┌─┐┌─┐┌─┐┌─┐┬─┐┌┬┐" <=> str "├─┤├─┤└─┐│ ├─┤├┬┘ ││" <=>- str "┴ ┴┴ ┴└─┘└─┘┴ ┴┴└──┴┘" + str "┴ ┴┴ ┴└─┘└─┘┴ ┴┴└──┴┘" drawUI :: MMS -> [Widget Name]-drawUI s = +drawUI s = [ drawMenu s ] drawMenu :: MMS -> Widget Name-drawMenu s = +drawMenu s = joinBorders $- center $ + center $ withBorderStyle unicodeRounded $ border $ hLimit 40 $@@ -49,11 +49,12 @@ let update = updateMMS gs in case e of V.EvKey V.KEsc [] -> halt gs+ V.EvKey (V.KChar 'q') [] -> halt gs V.EvKey V.KEnter [] -> case L.listSelected (s^.l) of Just 0 -> continue =<< (gs `goToState`) <$> liftIO cardSelectorState Just 1 -> continue $ gs `goToState` infoState- Just 2 -> continue =<< (gs `goToState`) <$> liftIO settingsState + Just 2 -> continue =<< (gs `goToState`) <$> liftIO settingsState Just 3 -> halt gs _ -> undefined
src/UI/Parameter.hs view
@@ -20,14 +20,14 @@ ui :: PS -> Widget Name ui s = joinBorders $- center $ + center $ withBorderStyle unicodeRounded $ border $ hLimitPercent 60 $ hLimit 40 $ hCenter (withAttr titleAttr (str "Select parameters")) <=> hBorder <=>- padLeftRight 1 + padLeftRight 1 (renderForm (s ^. psForm)) handleEvent :: GlobalState -> PS -> BrickEvent Name Event -> EventM Name (Next GlobalState)@@ -42,27 +42,36 @@ 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 }+ down = case n of+ ParametersOkField -> continue gs+ ChunkField1 -> continue'' $ form { formFocus = focusNext (focusNext focus) }+ _ -> continue'' $ form { formFocus = focusNext focus }+ up = case n of+ ChunkField1 -> continue gs+ ChunkField2 -> continue gs+ SubsetField -> continue'' $ form { formFocus = focusPrev (focusPrev focus) }+ _ -> continue'' $ form { formFocus = focusPrev focus } in case e of- -- continue gs V.EvKey V.KEsc [] -> halt' gs+ V.EvKey (V.KChar 'q') [] -> 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)+ + _ -> case (e, n) of+ (V.EvKey V.KRight [], ChunkField2) -> continue gs+ (V.EvKey V.KLeft [], ChunkField1) -> 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
src/UI/Settings.hs view
@@ -19,7 +19,7 @@ ui :: SS -> Widget Name ui f = joinBorders $- center $ + center $ withBorderStyle unicodeRounded $ border $ hLimitPercent 60 $@@ -34,7 +34,7 @@ let update = updateSS gs continue' = continue . update halt' global = continue (popState global) <* liftIO (setSettings (formState form))- + focus = formFocus form (Just n) = focusGetCurrent focus down = if n == MaxRecentsField then continue gs@@ -45,6 +45,7 @@ in case e of V.EvKey V.KEsc [] -> halt' gs+ V.EvKey (V.KChar 'q') [] -> halt' gs V.EvKey V.KDown [] -> down V.EvKey (V.KChar 'j') [] -> down V.EvKey V.KUp [] -> up