diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -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`.
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -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 @@
-### 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 @@
-### 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 @@
-### 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 @@
-### 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 @@
+
+### 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).
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: 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 for more information.
category: Application
diff --git a/src/DeckHandling.hs b/src/DeckHandling.hs
--- a/src/DeckHandling.hs
+++ b/src/DeckHandling.hs
@@ -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
diff --git a/src/Import.hs b/src/Import.hs
--- a/src/Import.hs
+++ b/src/Import.hs
@@ -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
diff --git a/src/Parameters.hs b/src/Parameters.hs
--- a/src/Parameters.hs
+++ b/src/Parameters.hs
@@ -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"
diff --git a/src/Parser.hs b/src/Parser.hs
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -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"
diff --git a/src/Runners.hs b/src/Runners.hs
--- a/src/Runners.hs
+++ b/src/Runners.hs
@@ -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
diff --git a/src/States.hs b/src/States.hs
--- a/src/States.hs
+++ b/src/States.hs
@@ -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
diff --git a/src/Types.hs b/src/Types.hs
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -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)
diff --git a/src/UI.hs b/src/UI.hs
--- a/src/UI.hs
+++ b/src/UI.hs
@@ -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
diff --git a/src/UI/BrickHelpers.hs b/src/UI/BrickHelpers.hs
--- a/src/UI/BrickHelpers.hs
+++ b/src/UI/BrickHelpers.hs
@@ -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
diff --git a/src/UI/CardSelector.hs b/src/UI/CardSelector.hs
--- a/src/UI/CardSelector.hs
+++ b/src/UI/CardSelector.hs
@@ -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
diff --git a/src/UI/Cards.hs b/src/UI/Cards.hs
--- a/src/UI/Cards.hs
+++ b/src/UI/Cards.hs
@@ -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)
diff --git a/src/UI/FileBrowser.hs b/src/UI/FileBrowser.hs
--- a/src/UI/FileBrowser.hs
+++ b/src/UI/FileBrowser.hs
@@ -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
diff --git a/src/UI/Info.hs b/src/UI/Info.hs
--- a/src/UI/Info.hs
+++ b/src/UI/Info.hs
@@ -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)
diff --git a/src/UI/MainMenu.hs b/src/UI/MainMenu.hs
--- a/src/UI/MainMenu.hs
+++ b/src/UI/MainMenu.hs
@@ -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
diff --git a/src/UI/Parameter.hs b/src/UI/Parameter.hs
--- a/src/UI/Parameter.hs
+++ b/src/UI/Parameter.hs
@@ -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
diff --git a/src/UI/Settings.hs b/src/UI/Settings.hs
--- a/src/UI/Settings.hs
+++ b/src/UI/Settings.hs
@@ -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