hascard 0.1.4.0 → 0.2.0.0

raw patch · 7 files changed

+260/−101 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• README.md +15/−1
• hascard.cabal +2/−2
• src/Parser.hs +27/−4
• src/Types.hs +9/−6
• src/UI/Cards.hs +198/−87
• src/UI/Info.hs +1/−1

@@ -1,4 +1,12 @@ # Changelog for hascard+## 0.2.0.0+New:+- A new type of card is available: reorder the elements. This could break previous definition or open question cards if they had the same format as the new reorder the elements card. In that case change the 1. 2. etc. to something like 1), 2) which is not seen as a reorder type card.+- For open question cards, if you don't know the answer you can click F1 which shows the correct answer++Fixed bugs:+- Hinted definitions were not accurate because the carriage return character \r was not seen as whitespace, but as content+ ## 0.1.4.0 New: - Deleted or moved files are also no longer shown in the recently selected files list

@@ -11,6 +11,7 @@   - [Multiple choice](#multiple-choice)   - [Multiple answer](#multiple-answer)   - [Open question](#open-question)+  - [Reorder question](#reorder-question) - [Miscellaneous info](#miscellaneous-info)  ## Installation@@ -46,7 +47,7 @@ The CLI provides some options for running hascard; to see them all run `hascard -h`. As an example, say you have a file `deck.txt` with lots of cards in it and you want to review 5 random ones, you can use `hascard deck -s -a 5`. Here `-s` shuffles the deck and `-a 5` specifies we only want to look at 5 of them.  ## Cards-Decks of cards are written in `.txt` files. Cards are seperated with a line containing three dashes `---`. For examples, see the [`/cards`](https://github.com/Yvee1/hascard/tree/master/cards) directory. In this section the 4 different cards are listed, with the syntax and how it is represented in the application.+Decks of cards are written in `.txt` files. Cards are seperated with a line containing three dashes `---`. For examples, see the [`/cards`](https://github.com/Yvee1/hascard/tree/master/cards) directory. In this section the 5 different types of cards are listed, with the syntax and how it is represented in the application.  ### Definition This is the simplest card, it simply has a title and can be flipped to show the contents. For example the following card@@ -93,6 +94,19 @@ ``` behaves like this ![](./recordings/gapped-question.gif)++### 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++```+# Order the letters in alphabetical order+4. u+1. l+2. p+3. s+```+will look like+![](./recordings/reordering.gif)  ## Miscellaneous info Written in Haskell, UI built with [brick](https://github.com/jtdaugherty/brick) and parsing of cards done with [parsec](https://github.com/haskell/parsec). Recordings of the terminal were made using [terminalizer](https://github.com/faressoft/terminalizer). The filebrowser widget was mostly copied from the brick [filebrowser demo program](https://github.com/jtdaugherty/brick/blob/master/programs/FileBrowserDemo.hs). Homebrew and Travis configurations were made much easier by [the tutorial from Chris Penner](https://chrispenner.ca/posts/homebrew-haskell).

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a9024c106965452173618e8284b174a2d9eed387ee8d472593b02ef6472e1bb4+-- hash: e6105cfe9b053345660f9321206316f1bf88e4f94f56b7cde5625a5b521fc74b  name:           hascard-version:        0.1.4.0+version:        0.2.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

@@ -13,6 +13,7 @@ pCards = pCard `sepEndBy1` seperator pCard =  uncurry3 MultipleChoice<$> try pMultChoice      <|> uncurry MultipleAnswer <$> try pMultAnswer+     <|> uncurry Reorder <$> try pReorder      <|> uncurry OpenQuestion <$> try pOpen      <|> uncurry Definition <$> pDef @@ -32,7 +33,7 @@ pChoice = do   kind <- oneOf "*-"   space-  text <- manyTill anyChar $ lookAhead (try (try choicePrefix <|> seperator <|> (eof >> return [])))+  text <- manyTill anyChar $ lookAhead (try (try choicePrefix <|> seperator <|> eof'))   return (kind, text)  choicePrefix =  string "- "@@ -48,9 +49,29 @@   char '['   kind <- oneOf "*x "   string "] "-  text <- manyTill anyChar $ lookAhead (try (seperator <|> string "[" <|> (eof >> return [])))+  text <- manyTill anyChar $ lookAhead (try (seperator <|> string "[" <|> eof'))   return $ makeOption kind text +pReorder = do+  header <- pHeader+  many eol+  elements <- pReorderElement `sepBy1` lookAhead (try pReorderPrefix)+  let numbers = map fst elements+  if all (`elem` numbers) [1..length numbers]+    then return (header, NE.fromList elements)+    else error $ "A reordering question should have numbers starting from 1 and increase from there without skipping any numbers, but this is not the case:\n" +                    <> unlines (map show numbers)++pReorderElement = do+  int <- pReorderPrefix+  text <- manyTill anyChar $ lookAhead (try (try seperator <|> try pReorderPrefix <|> eof'))+  return (read int, text)++pReorderPrefix = do+  int <- many1 digit+  string ". "+  return int+ pOpen = do   header <- pHeader   many eol@@ -81,13 +102,13 @@                   <|> string "_"  pNormal = do-  text <- manyTill (noneOf "_") $ lookAhead $ try $ gappedSpecialChars <|> (eof >> return [])+  text <- manyTill (noneOf "_") $ lookAhead $ try $ gappedSpecialChars <|> eof'   return (Normal text)  pDef = do   header <- pHeader   many eol-  descr <- manyTill chars $ lookAhead (try (seperator <|> (eof >> return [])))+  descr <- manyTill chars $ lookAhead $ try $ seperator <|> eof'   return (header, descr)  eol =  try (string "\n\r")@@ -95,6 +116,8 @@     <|> string "\n"     <|> string "\r"     <?> "end of line"++eof' = eof >> return [] <?> "end of file"  seperator = do   sep <- string "---"

@@ -15,13 +15,16 @@ data Card = Definition String String           | OpenQuestion String Perforated           | MultipleChoice {-            mcQuestion   :: String,-            mcCorrect    :: CorrectOption,-            mcIncorrects :: [IncorrectOption]}-          -- | MultipleAnswer String (NE.NonEmpty Answer) +            question   :: String,+            correct    :: CorrectOption,+            incorrects :: [IncorrectOption]}           | MultipleAnswer {-            maQuestion   :: String,-            maOptions    :: NonEmpty Option }+            question   :: String,+            options    :: NonEmpty Option }+          | Reorder {+            question   :: String,+            elements   :: NonEmpty (Int, String)+          }              deriving Show 

@@ -4,7 +4,7 @@ import Brick import Lens.Micro.Platform import Types-import Data.Char (isSeparator, isSpace)+import Data.Char (isSpace) import Data.List (dropWhileEnd) import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map)@@ -28,22 +28,29 @@   { _flipped        :: Bool }   | MultipleChoiceState   { _highlighted    :: Int-  , _nChoices       :: Int+  , _number         :: Int   , _tried          :: Map Int Bool      -- indices of tried choices   }   | MultipleAnswerState   { _highlighted    :: Int   , _selected       :: Map Int Bool-  , _nChoices       :: Int+  , _number         :: Int   , _entered        :: Bool   }   | OpenQuestionState   { _gapInput       :: Map Int String   , _highlighted    :: Int-  , _nGaps          :: Int+  , _number         :: Int   , _entered        :: Bool   , _correctGaps    :: Map Int Bool   }+  | ReorderState+  { _highlighted    :: Int+  , _grabbed        :: Bool +  , _order          :: Map Int (Int, String)+  , _entered        :: Bool+  , _number         :: Int+  }  data State = State   { _cards          :: [Card]     -- list of flashcards@@ -63,19 +70,25 @@ defaultCardState Definition{} = DefinitionState { _flipped = False } defaultCardState (MultipleChoice _ _ ics) = MultipleChoiceState    { _highlighted = 0-  , _nChoices = length ics + 1+  , _number = length ics + 1   , _tried = M.fromList [(i, False) | i <- [0..length ics]] } defaultCardState (OpenQuestion _ perforated) = OpenQuestionState    { _gapInput = M.empty   , _highlighted = 0-  , _nGaps = nGapsInPerforated perforated+  , _number = nGapsInPerforated perforated   , _entered = False   , _correctGaps = M.fromList [(i, False) | i <- [0..nGapsInPerforated perforated - 1]] } defaultCardState (MultipleAnswer _ answers) = MultipleAnswerState    { _highlighted = 0   , _selected = M.fromList [(i, False) | i <- [0..NE.length answers-1]]   , _entered = False-  , _nChoices = NE.length answers }+  , _number = NE.length answers }+defaultCardState (Reorder _ elements) = ReorderState+  { _highlighted = 0+  , _grabbed = False+  , _order = M.fromList (zip [0..] (NE.toList elements))+  , _entered = False+  , _number = NE.length elements }  app :: App State Event Name app = App @@ -86,6 +99,24 @@   , appAttrMap = const theMap   } +runCardsUI :: GlobalState -> [Card] -> IO State+runCardsUI gs deck = do+  hints <- getShowHints+  controls <- getShowControls++  let initialState = State { _cards = deck+                           , _index = 0+                           , _currentCard = head deck+                           , _cardState = defaultCardState (head deck)+                           , _nCards = length deck+                           , _showHints = hints+                           , _showControls = controls }+  defaultMain app initialState++---------------------------------------------------+--------------------- DRAWING ---------------------+---------------------------------------------------+ drawUI :: State -> [Widget Name] drawUI s =  [drawCardUI s <=> drawInfo s] @@ -93,13 +124,35 @@ drawInfo s = if not (s ^. showControls) then emptyWidget else   strWrap . ("ESC: quit" <>) $ case s ^. cardState of     DefinitionState {}     -> ", ENTER: flip card / continue"-    MultipleChoiceState {} -> ", ENTER: confirm answer / continue"-    MultipleAnswerState {} -> ", ENTER: select / continue, c: confirm selection"-    OpenQuestionState {}   -> ", LEFT/RIGHT/TAB: navigate gaps, ENTER: confirm answer / continue"+    MultipleChoiceState {} -> ", ENTER: submit answer / continue"+    MultipleAnswerState {} -> ", ENTER: select / continue, c: submit selection"+    OpenQuestionState {}   -> ", LEFT/RIGHT/TAB: navigate gaps, ENTER: submit answer / continue, F1: show answer"+    ReorderState {}        -> ", ENTER: grab, c: submit answer" +drawCardBox :: Widget Name -> Widget Name+drawCardBox w = C.center $+                withBorderStyle BS.unicodeRounded $+                B.border $+                withAttr textboxAttr $+                hLimitPercent 60 w+ drawProgress :: State -> Widget Name drawProgress s = C.hCenter $ str (show (s^.index + 1) ++ "/" ++ show (s^.nCards)) +drawCardUI :: State -> Widget Name+drawCardUI s = let p = 1 in+  joinBorders $ drawCardBox $ (<=> drawProgress s) $+  case (s ^. cards) !! (s ^. index) of+    Definition title descr -> drawHeader title <=> B.hBorder <=> padLeftRight p (drawDef s descr <=> str " ")+                              +    MultipleChoice question correct others -> drawHeader question <=> B.hBorder <=> padLeftRight p (drawChoices s (listMultipleChoice correct others) <=> str " ")++    OpenQuestion title perforated -> drawHeader title <=> B.hBorder <=> padLeftRight p (drawPerforated s perforated <=> str " ")++    MultipleAnswer question options -> drawHeader question <=> B.hBorder <=> padRight (Pad p) (drawOptions s options <=> str " ")++    Reorder question elements -> drawHeader question <=> B.hBorder <=> padLeftRight p (drawReorder s elements <=> str " ")+ drawHeader :: String -> Widget Name drawHeader title = withAttr titleAttr $                    padLeftRight 1 $@@ -108,41 +161,22 @@ wrapSettings :: WrapSettings wrapSettings = WrapSettings {preserveIndentation=False, breakLongWords=True} +isSpace' :: Char -> Bool+isSpace' '\r' = True+isSpace' a    = isSpace a+ drawDescr :: String -> Widget Name drawDescr descr =   strWrapWith wrapSettings descr'     where-      descr' = dropWhileEnd isSpace descr--listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]-listMultipleChoice c = reverse . listMultipleChoice' [] 0 c-  where listMultipleChoice' opts i (CorrectOption j cStr) [] = -          if i == j-            then cStr : opts-            else opts-        listMultipleChoice' opts i c'@(CorrectOption j cStr) ics@(IncorrectOption icStr : ics') = -          if i == j-            then listMultipleChoice' (cStr  : opts) (i+1) c' ics-            else listMultipleChoice' (icStr : opts) (i+1) c' ics'--drawCardUI :: State -> Widget Name-drawCardUI s = let p = 1 in-  joinBorders $ drawCardBox $ (<=> drawProgress s) $-  case (s ^. cards) !! (s ^. index) of-    Definition title descr -> drawHeader title <=> B.hBorder <=> padLeftRight p (drawDef s descr <=> str " ")-                              -    MultipleChoice question correct others -> drawHeader question <=> B.hBorder <=> padLeftRight p (drawChoices s (listMultipleChoice correct others) <=> str " ")--    OpenQuestion title perforated -> drawHeader title <=> B.hBorder <=> padLeftRight p (drawPerforated s perforated <=> str " ")--    MultipleAnswer question options -> drawHeader question <=> B.hBorder <=> padRight (Pad p) (drawOptions s options <=> str " ")+      descr' = dropWhileEnd isSpace' descr  drawDef :: State -> String -> Widget Name drawDef s def = if s ^. showHints then drawHintedDef s def else drawNormalDef s def  drawHintedDef :: State -> String -> Widget Name drawHintedDef s def = case s ^. cardState of-  DefinitionState {_flipped=f} -> if f then drawDescr def else drawDescr [if isSeparator char || char == '\n' then char else '_' | char <- def]+  DefinitionState {_flipped=f} -> if f then drawDescr def else drawDescr [if isSpace' char then char else '_' | char <- def]   _ -> error "impossible: "   drawNormalDef:: State -> String -> Widget Name@@ -152,10 +186,21 @@     else Widget Greedy Fixed $ do       c <- getContext       let w = c^.availWidthL-      let def' = dropWhileEnd isSpace def+      let def' = dropWhileEnd isSpace' def       render . vBox $ [str " " | _ <- wrapTextToLines wrapSettings w (pack def')]   _ -> error "impossible: "  +listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]+listMultipleChoice c = reverse . listMultipleChoice' [] 0 c+  where listMultipleChoice' opts i (CorrectOption j cStr) [] = +          if i == j+            then cStr : opts+            else opts+        listMultipleChoice' opts i c'@(CorrectOption j cStr) ics@(IncorrectOption icStr : ics') = +          if i == j+            then listMultipleChoice' (cStr  : opts) (i+1) c' ics+            else listMultipleChoice' (icStr : opts) (i+1) c' ics'+ drawChoices :: State -> [String] -> Widget Name drawChoices s options = case (s ^. cardState, s ^. currentCard) of   (MultipleChoiceState {_highlighted=i, _tried=kvs}, MultipleChoice _ (CorrectOption k _) _)  -> vBox formattedOptions@@ -208,11 +253,11 @@       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 - length 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-            cursor = if i == j then showCursor () (Location (length gap, 0)) else id+            cursor = if i == j then showCursor () (Location (textWidth gap, 0)) else id              correct = M.findWithDefault False i cgs             coloring = case (submitted, correct) of@@ -226,7 +271,7 @@                 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')-              else let (ws1@(w':ws'), fit) = makeSentenceWidget' (length gap) (i+1) post in+              else let (ws1@(w':ws'), fit) = makeSentenceWidget' (textWidth gap) (i+1) post in                 if fit then (ws ++ [gapWidget <+> w'] ++ ws', fit')                 else (ws ++ [gapWidget] ++ ws1, fit')       _ -> error "PANIC!"@@ -234,14 +279,14 @@ wrapStringWithPadding :: Int -> Int -> String -> ([Widget Name], Int, Bool) wrapStringWithPadding padding w s   | null (words s) = ([str ""], padding, True)-  | otherwise = if length (head (words s)) < w - padding then+  | otherwise = if textWidth (head (words s)) < w - padding then     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         ts = wrapTextToLines wrapSettings w (pack s') & ix 0 %~ (if startsWithSpace then (T.pack " " `T.append`) . T.drop (padding + 1) else T.drop padding)         ts' = ts & _last %~ (`T.append` postfix)-        padding' = T.length (last ts') + (if length ts' == 1 then 1 else 0) * padding in+        padding' = textWidth (last ts') + (if length ts' == 1 then 1 else 0) * padding in           (map txt (filter (/=T.empty) ts'), padding', True)   else     let lastLetter = last s@@ -250,15 +295,32 @@         postfix = if lastLetter == ' ' then T.pack [lastLetter] else T.empty         ts = wrapTextToLines wrapSettings w (pack s')         ts' = ts & _last %~ (`T.append` postfix) in-    (map txt (filter (/=T.empty) ts'), T.length (last ts'), False)+    (map txt (filter (/=T.empty) ts'), textWidth (last ts'), False) -drawCardBox :: Widget Name -> Widget Name-drawCardBox w = C.center $-                withBorderStyle BS.unicodeRounded $-                B.border $-                withAttr textboxAttr $-                hLimitPercent 60 w+drawReorder :: State -> NonEmpty (Int, String) -> Widget Name+drawReorder s elements = case (s ^. cardState, s ^. currentCard) of+  (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+                  (True, True ) -> withAttr grabbedElementAttr+                  (True, False) -> withAttr highlightedElementAttr+                  _             -> id +          number = +            case (submitted, i+1 == k) of+              (False, _)    -> str (show (i+1) <> ". ")+              (True, False) -> withAttr incorrectElementAttr (str (show k <> ". "))+              (True, True ) -> withAttr correctElementAttr (str (show k <> ". "))+      in+        number <+> color (drawDescr text)++  _ -> error "cardstate mismatch"++----------------------------------------------------+---------------------- Events ----------------------+----------------------------------------------------+ handleEvent :: State -> BrickEvent Name Event -> EventM Name (Next State) handleEvent s (VtyEvent e) = case e of   V.EvKey V.KEsc []                -> halt s@@ -275,7 +337,7 @@             else continue $ s & cardState.flipped %~ not         _ -> continue s -    (MultipleChoiceState {_highlighted = i, _nChoices = 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@@ -291,7 +353,7 @@        where frozen = M.findWithDefault False j kvs         -            down = if i < n - 1 && not frozen+            down = if i < n-1 && not frozen                      then s & (cardState.highlighted) +~ 1                      else s @@ -299,7 +361,7 @@                    then s & (cardState.highlighted) -~ 1                    else s     -    (MultipleAnswerState {_highlighted = i, _nChoices = n, _entered = submitted}, MultipleAnswer {}) ->+    (MultipleAnswerState {_highlighted = i, _number = n, _entered = submitted}, MultipleAnswer {}) ->       case ev of         V.EvKey V.KUp [] -> continue up         V.EvKey (V.KChar 'k') [] -> continue up@@ -318,7 +380,7 @@        where frozen = submitted         -            down = if i < n - 1 && not frozen+            down = if i < n-1 && not frozen                      then s & (cardState.highlighted) +~ 1                      else s @@ -326,9 +388,15 @@                    then s & (cardState.highlighted) -~ 1                    else s -    (OpenQuestionState {_highlighted = i, _nGaps = n, _gapInput = kvs, _correctGaps = cGaps}, OpenQuestion _ perforated) ->+    (OpenQuestionState {_highlighted = i, _number = n, _gapInput = kvs, _correctGaps = cGaps}, OpenQuestion _ perforated) ->       let correct = M.foldr (&&) True cGaps in         case ev of+          V.EvKey (V.KFun 1) [] -> continue $+            s & cardState.gapInput .~ correctAnswers+              & cardState.entered .~ True+              & cardState.correctGaps .~ M.fromAscList [(i, True) | i <- [0..n-1]]+                  where correctAnswers = M.fromAscList $ zip [0..] $ map NE.head (sentenceToGaps (perforatedToSentence perforated))+           V.EvKey (V.KChar '\t') [] -> continue $              if i < n - 1 && not correct               then s & (cardState.highlighted) +~ 1@@ -359,9 +427,69 @@                   backspace xs = init xs           _ -> continue s       +    (ReorderState {_highlighted = i, _entered = submitted, _grabbed=dragging, _number = n }, Reorder _ _) ->+      case ev of+        V.EvKey V.KUp [] -> continue up+        V.EvKey (V.KChar 'k') [] -> continue up+        V.EvKey V.KDown [] -> continue down +        V.EvKey (V.KChar 'j') [] -> continue down++        V.EvKey (V.KChar 'c') [] -> continue $ s & (cardState.entered) .~ True++        V.EvKey V.KEnter [] ->+            if frozen+              then next s+              else continue $ s & cardState.grabbed %~ not++        _ -> continue s+++      where frozen = submitted+        +            down = +              case (frozen, i < n - 1, dragging) of+                (True, _, _)  -> s+                (_, False, _) -> s+                (_, _, False) -> s & (cardState.highlighted) +~ 1+                (_, _, True)  -> s & (cardState.highlighted) +~ 1+                                   & (cardState.order) %~ interchange i (i+1)++            up =+              case (frozen, i > 0, dragging) of+                (True, _, _)  -> s+                (_, False, _) -> s+                (_, _, False) -> s & (cardState.highlighted) -~ 1+                (_, _, True)  -> s & (cardState.highlighted) -~ 1+                                   & (cardState.order) %~ interchange i (i-1)+     _ -> error "impossible" handleEvent s _ = continue s-      ++next :: State -> EventM Name (Next State)+next s+  | s ^. index + 1 < length (s ^. cards) = continue . updateState $ s & index +~ 1+  | otherwise                            = halt s++previous :: State -> EventM Name (Next State)+previous s | s ^. index > 0 = continue . updateState $ s & index -~ 1+           | otherwise      = continue s++updateState :: State -> State+updateState s =+  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+      valj = kvs M.! j in+  M.insert j vali (M.insert i valj kvs)++----------------------------------------------------+-------------------- Attributes --------------------+----------------------------------------------------+ titleAttr :: AttrName titleAttr = attrName "title" @@ -389,9 +517,6 @@ incorrectOptAttr :: AttrName incorrectOptAttr = attrName "incorrect option" -hiddenAttr :: AttrName-hiddenAttr = attrName "hidden"- gapAttr :: AttrName gapAttr = attrName "gap" @@ -401,6 +526,18 @@ correctGapAttr :: AttrName correctGapAttr = attrName "correct gap" +highlightedElementAttr :: AttrName+highlightedElementAttr = attrName "highlighted element"++grabbedElementAttr :: AttrName+grabbedElementAttr = attrName "grabbed element"++correctElementAttr :: AttrName+correctElementAttr = attrName "correct element"++incorrectElementAttr :: AttrName+incorrectElementAttr = attrName "incorrect element"+ theMap :: AttrMap theMap = attrMap V.defAttr   [ (titleAttr, fg V.yellow)@@ -414,35 +551,9 @@   , (selectedOptAttr, fg V.blue)   , (incorrectOptAttr, fg V.red)   , (correctOptAttr, fg V.green)-  , (hiddenAttr, fg V.black)+  , (highlightedElementAttr, fg V.yellow)+  , (grabbedElementAttr, fg V.blue)+  , (correctElementAttr, fg V.green)+  , (incorrectElementAttr, fg V.red)   , (gapAttr, V.defAttr `V.withStyle` V.underline)   ]--runCardsUI :: GlobalState -> [Card] -> IO State-runCardsUI gs deck = do-  hints <- getShowHints-  controls <- getShowControls--  let initialState = State { _cards = deck-                           , _index = 0-                           , _currentCard = head deck-                           , _cardState = defaultCardState (head deck)-                           , _nCards = length deck-                           , _showHints = hints-                           , _showControls = controls }-  defaultMain app initialState--next :: State -> EventM Name (Next State)-next s-  | s ^. index + 1 < length (s ^. cards) = continue . updateState $ s & index +~ 1-  | otherwise                            = halt s--previous :: State -> EventM Name (Next State)-previous s | s ^. index > 0 = continue . updateState $ s & index -~ 1-           | otherwise      = continue s--updateState :: State -> State-updateState s =-  let card = (s ^. cards) !! (s ^. index) in s-    & currentCard .~ card-    & cardState .~ defaultCardState card

@@ -62,4 +62,4 @@  info :: String info = -  "Hascard is a text-based user interface for reviewing notes using 'flashcards'. Cards are written in markdown-like syntax; for more info see the README file. Use the --help flag for information on the command line options.\n\nControls:\n * Use arrows or the j and k keys for menu navigation\n * Enter confirms a selection, flips a card or continues to the next card\n * Use TAB or the arrow keys for navigating gaps in open questions\n * Use the c key for confirming multiple choice questions with more than 1 possible answer\n * Use CTRL+Left and CTRL+Right to move to previous and next cards without having to answer them"+  "Hascard is a text-based user interface for reviewing notes using 'flashcards'. Cards are written in markdown-like syntax; for more info see the README file. Use the --help flag for information on the command line options.\n\nControls:\n * Use arrows or the j and k keys for menu navigation\n * Enter confirms a selection, flips a card or continues to the next card\n * Use TAB or the arrow keys for navigating gaps in open questions\n * Use the c key for confirming reorder questions or multiple choice questions with more than 1 possible answer\n * Use F1 to show the answers of a open question.\n * Use CTRL+Left and CTRL+Right to move to previous and next cards without having to answer them"