packages feed

hascard 0.6.0.1 → 0.6.0.2

raw patch · 31 files changed

+3629/−3621 lines, 31 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ States: [_previousInput] :: CardState -> Map Int String
+ States: previousInput :: Traversal' CardState (Map Int String)
- States: OpenQuestionState :: Map Int String -> Int -> Int -> Bool -> Map Int Bool -> Bool -> CardState
+ States: OpenQuestionState :: Map Int String -> Int -> Int -> Bool -> Map Int Bool -> Bool -> Map Int String -> CardState
- States: popupState :: forall s_adFj d_adFk. Lens' (Popup s_adFj d_adFk) PopupState
+ States: popupState :: forall s_aeXp d_aeXq. Lens' (Popup s_aeXp d_aeXq) PopupState

Files

ChangeLog.md view
@@ -1,138 +1,142 @@-# Changelog for hascard
-## 0.6.0.1
-Fixes:
-- Change key for showing answer to open questions from F1 to Shift+Tab, which should cause fewer conflicts with existing keybindings (issue #31).
-
-## 0.6.0.0
-New:
-- Windows support.
-- `export` CLI command for exporting hascard cards to delimited text files (issue #33).
-- Possibility to vertically scroll flashcards if they are long enough (issue #25).
-- Scrollbars for menus where scrolling is possible, which can be controlled by mouse if the terminal supports this.
-- Setting for shuffling answers to multiple choice/answer questions (issue #19).
-
-Fixes:
-- Improved navigation of parameter selection menu.
-- An empty definition card does not need to be flipped.
-
-## 0.5.0.3.1
-Update versions and information
-
-## 0.5.0.3
-New:
-- Improved `hascard import` functionality: delimiters can be specified via CLI options (fixes issue #17).
-
-Fixed bug:
-- Removed redundant newline after header
-
-## 0.5.0.2
-New:
-- Setting for changing case sensitivity of open questions. Default behaviour is case sensitive, which was also the functionality before this setting was added.
-
-Fixed bug:
-- When the open question was gotten right after the first try, it was still counted as correct in review mode
-
-## 0.5.0.1
-Fixed bugs:
-- When generating new decks from correct or incorrect cards, 'Nothing' was added as the first line
-- When a gap was the last part of a sentence, the newline was not shown correctly
-
-## 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`.
-- Convert TSV files to files compatible with hascard, using the `hascard import` command. (suggested by @g-w1)
-
-Fixed bugs:
-- Focus cycling removed in settings menu for consistency with the other menus.
-- Better error for non-existing files
-- Allow | character in text
-- Allow lists with - in definition cards. Previously this was seen as a multiple choice question without any correct answers, and therefore gave an error.
-
-## 0.3.0.1
-Fixed bugs:
-- Crash on empty recents list
-- Crash on any key other than Enter at FinalPopup
-
-## 0.3.0.0
-New:
-- When reviewing a deck, the amount of correctly and incorrectly answered cards are now displayed.
-- After answering a definition card a popup appears asking whether you answered it correctly or not.
-- After finishing a deck, there is an option to create new decks from either the correctly answered or incorrectly answered cards, or both. The correct cards of a file named `deck.txt` are stored in `deck+.txt` in the same folder, and the incorrect ones in the file `deck-.txt`. Make sure you do not have files of those names that you want to keep since these _will_ be overwritten.
-- The `--blank` or `-b` option was added to use the application without the changes listed above.
-- Files with the `.md` extension are also accepted by the application and shown in the filebrowser. 
-
-Fixed bugs:
-- Empty open question now takes up 1 row instead of 0 rows, so does not jump like before.
-- All parse errors now show a popup instead of crashing the application when reviewing a deck.
-
-## 0.2.1.0
-New:
-- A certain chunk of a deck of cards can be reviewed using the `-c i/n` CLI option. For example `hascard -c 3/5` will split the deck into 5 chunks, and review the 3rd one. These chunks can be used with the shuffle and amount options too.
-- Visual indicator in the deck selector menu for whether the deck is being shuffled or not.
-- Shuffling can be toggled inside the deck selector menu using the 's' key.
-- Most parsing error messages now show up as a pop-up box with nicer formattting than before.
-- The maximum number of recently selected decks stored and shown can now be changed in the settings menu.
-
-Fixed bugs:
-- Flickering when switching between menus is gone. This was done by merging the seperate Brick applications into one.
-
-## 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
-
-Fixed bugs:
-- A new line after the last seperator `---` caused the parsing to fail, now it does not
-- If the last card was an open question and there was no `---` at the end, it was shown as a definition card (issue #6, thanks @stemvork)
-
-## 0.1.3.0
-New:
-- Add `-s` shuffle flag and `-a` amount option to CLI.
-- Add macOS binary and homebrew formula
-
-## 0.1.2.0
-New:
-- Hidden files/directories (so starting with '.') are now hidden by default, and can be shown by pressing 'h' in the filebrowser
-
-
-Fixed bugs:
-- Parsing now succeeds even if the text file does not end with ---
-- When passing a file to the CLI, the absolute path is saved instead of the relative one, preventing issues with the 'recently selected files'
-
-## 0.1.1.0
-New:
-- Add nix build support (by @srid)
-- Recently used decks are now ordered by most recent first
-- Recently used decks now have unique names. Previously only the filename was shown, but now path is shown up to unique name
-
-Fixed bugs:
-- Failed parsing of settings file now results in default settings instead of error
-- After selecting a file from system, the card selector had to be refreshed before the file appeared in the recently selected decks list. The file is now present immediately
-- Directly selecting a card via the CLI now also adds it to the recents list
-- Selecting a card via the CLI now returns an error if it has a different filetype than '.txt'. If no filetype is given, '.txt' is assumed.
-
-
-## 0.1.0.0
-Initial release
+# Changelog for hascard+## 0.6.0.2+Fixes:+- Remove Shift+Tab key binding as it is unreliable. We switch to a different approach: show the correct answer(s) when submitting empty answer(s) (which is not correct) or submitting the same answer(s) twice in a row.++## 0.6.0.1+Fixes:+- Change key for showing answer to open questions from F1 to Shift+Tab, which should cause fewer conflicts with existing keybindings (issue #31).++## 0.6.0.0+New:+- Windows support.+- `export` CLI command for exporting hascard cards to delimited text files (issue #33).+- Possibility to vertically scroll flashcards if they are long enough (issue #25).+- Scrollbars for menus where scrolling is possible, which can be controlled by mouse if the terminal supports this.+- Setting for shuffling answers to multiple choice/answer questions (issue #19).++Fixes:+- Improved navigation of parameter selection menu.+- An empty definition card does not need to be flipped.++## 0.5.0.3.1+Update versions and information++## 0.5.0.3+New:+- Improved `hascard import` functionality: delimiters can be specified via CLI options (fixes issue #17).++Fixed bug:+- Removed redundant newline after header++## 0.5.0.2+New:+- Setting for changing case sensitivity of open questions. Default behaviour is case sensitive, which was also the functionality before this setting was added.++Fixed bug:+- When the open question was gotten right after the first try, it was still counted as correct in review mode++## 0.5.0.1+Fixed bugs:+- When generating new decks from correct or incorrect cards, 'Nothing' was added as the first line+- When a gap was the last part of a sentence, the newline was not shown correctly++## 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`.+- Convert TSV files to files compatible with hascard, using the `hascard import` command. (suggested by @g-w1)++Fixed bugs:+- Focus cycling removed in settings menu for consistency with the other menus.+- Better error for non-existing files+- Allow | character in text+- Allow lists with - in definition cards. Previously this was seen as a multiple choice question without any correct answers, and therefore gave an error.++## 0.3.0.1+Fixed bugs:+- Crash on empty recents list+- Crash on any key other than Enter at FinalPopup++## 0.3.0.0+New:+- When reviewing a deck, the amount of correctly and incorrectly answered cards are now displayed.+- After answering a definition card a popup appears asking whether you answered it correctly or not.+- After finishing a deck, there is an option to create new decks from either the correctly answered or incorrectly answered cards, or both. The correct cards of a file named `deck.txt` are stored in `deck+.txt` in the same folder, and the incorrect ones in the file `deck-.txt`. Make sure you do not have files of those names that you want to keep since these _will_ be overwritten.+- The `--blank` or `-b` option was added to use the application without the changes listed above.+- Files with the `.md` extension are also accepted by the application and shown in the filebrowser. ++Fixed bugs:+- Empty open question now takes up 1 row instead of 0 rows, so does not jump like before.+- All parse errors now show a popup instead of crashing the application when reviewing a deck.++## 0.2.1.0+New:+- A certain chunk of a deck of cards can be reviewed using the `-c i/n` CLI option. For example `hascard -c 3/5` will split the deck into 5 chunks, and review the 3rd one. These chunks can be used with the shuffle and amount options too.+- Visual indicator in the deck selector menu for whether the deck is being shuffled or not.+- Shuffling can be toggled inside the deck selector menu using the 's' key.+- Most parsing error messages now show up as a pop-up box with nicer formattting than before.+- The maximum number of recently selected decks stored and shown can now be changed in the settings menu.++Fixed bugs:+- Flickering when switching between menus is gone. This was done by merging the seperate Brick applications into one.++## 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++Fixed bugs:+- A new line after the last seperator `---` caused the parsing to fail, now it does not+- If the last card was an open question and there was no `---` at the end, it was shown as a definition card (issue #6, thanks @stemvork)++## 0.1.3.0+New:+- Add `-s` shuffle flag and `-a` amount option to CLI.+- Add macOS binary and homebrew formula++## 0.1.2.0+New:+- Hidden files/directories (so starting with '.') are now hidden by default, and can be shown by pressing 'h' in the filebrowser+++Fixed bugs:+- Parsing now succeeds even if the text file does not end with ---+- When passing a file to the CLI, the absolute path is saved instead of the relative one, preventing issues with the 'recently selected files'++## 0.1.1.0+New:+- Add nix build support (by @srid)+- Recently used decks are now ordered by most recent first+- Recently used decks now have unique names. Previously only the filename was shown, but now path is shown up to unique name++Fixed bugs:+- Failed parsing of settings file now results in default settings instead of error+- After selecting a file from system, the card selector had to be refreshed before the file appeared in the recently selected decks list. The file is now present immediately+- Directly selecting a card via the CLI now also adds it to the recents list+- Selecting a card via the CLI now returns an error if it has a different filetype than '.txt'. If no filetype is given, '.txt' is assumed.+++## 0.1.0.0+Initial release
LICENSE view
@@ -1,30 +1,30 @@-Copyright Steven van den Broek (c) 2020
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Steven van den Broek nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+Copyright Steven van den Broek (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Steven van den Broek nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -1,193 +1,193 @@-# hascard
-[![Build Status](https://github.com/Yvee1/hascard/actions/workflows/build.yml/badge.svg)](https://github.com/Yvee1/hascard/actions) [![GitHub tag](https://img.shields.io/github/tag/Yvee1/hascard.svg)](https://github.com/Yvee1/hascard/releases) [![AUR](https://img.shields.io/aur/version/hascard)](https://aur.archlinux.org/packages/hascard/) [![Hackage](https://img.shields.io/hackage/v/hascard.svg)](https://hackage.haskell.org/package/hascard)
-
-
-
-A minimal commandline utility for reviewing notes. 'Flashcards' can be written in markdown-like syntax.
-
-<p align="center">
-<img alt="a recording of example usage of the hascard application" src="./recordings/recording.gif">
-</p>
-
-## Contents
-- [Installation](#installation)
-- [Usage](#usage)
-- [Cards](#cards)
-  - [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 (experimental)](#latex-experimental)
-  
-- [Miscellaneous info](#miscellaneous-info)
-
-## Installation
-Windows, Linux and macOS are supported.
-
-### Homebrew (for macOS)
-For macOS users an installation using homebrew is provided via a custom tap. You can run 
-```
-brew update
-brew install Yvee1/tools/hascard
-```
-
-### Binary
-Ubuntu, macOS, and Windows binaries are available under [releases](https://github.com/Yvee1/hascard/releases/). To be able to run it from any directory, it has to be added to the PATH. In Linux, this can be achieved, for example, by copying it to the `/usr/local/bin` directory.
-
-### Arch Linux
-Thanks to [loki7990](https://github.com/loki7990), hascard is also on the AUR: https://aur.archlinux.org/packages/hascard/.
-
-### Snapcraft
-Hascard is also on [snapcraft](https://snapcraft.io/hascard). Installation instructions are on that site. If you already have snap installed you can just install hascard via `sudo snap install hascard`. By default snap applications are isolated from the system and run in a sandbox. This means that hascard does not have permission to read or write any files on the system aside from those under `%HOME/snap/hascard`. To be able to read cards also in other directories under the home directory, hascard makes use of the `home` interface which might need to be enabled manually using `sudo snap connect hascard:home :home`.
-
-**Note**: Because of problems with snap and terminfo, the snap installation does not work directly with somewhat non-standard terminals like st-256 and alacritty. This is because the snap environment does not have the necessary terminfo files for these terminals, but copying the terminfo file from the system is a workaround (see [this comment](https://github.com/Yvee1/hascard/issues/3#issuecomment-680699000)).
-
-### Install from source
-Another option is to build hascard and install it from source. For this you can use the Haskell build tool called [stack](https://docs.haskellstack.org/en/stable/README/#how-to-install), or [nix](https://nixos.org/). Then for example clone this repository somewhere:
-```
-git clone https://github.com/Yvee1/hascard.git
-cd hascard
-```
-and do `stack install hascard` or `nix-build` respectively.
-
-## Usage
-Simply run `hascard` to open the main application. Menu navigation can be done with the arrow keys or with the 'j' and 'k' keys. The controls for the different cards can be found at the bottom of the screen by default. This, and a couple other things, can be changed in the settings menu. A deck of cards can be opened using the built-in filebrowser, and recently selected decks will appear in the selection menu. These decks of flashcards are written in plain text, this is explained in section [Cards](#cards). After selecting a deck, some options can be specified, like whether the deck should be shuffled or how many cards should be reviewed.
-
-After finishing a deck, there is an option to create new decks from the correctly answered or incorrectly answered cards, or both. The correct cards of a file named `deck.txt` are stored in `deck+.txt` in the same folder, and the incorrect ones in the file `deck-.txt`. Make sure you do not have files of those names that you want to keep since these _will_ be overwritten.
-
-### CLI
-The CLI provides three commands, `run`, `import`, `export`. The `hascard run` command is essentially the same as just `hascard`, but the `run` command can be given a file to run the application on directly. When run on a file directly, parameters like whether to shuffle the deck are specified via CLI options instead of in a menu.
-
-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. For more info, see `hascard run --help`.
-
-#### Importing decks
-If you have decks in a different format, you might want to convert them into files compatible with hascard. Currently, delimited text 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
-de même	evenals
-```
-will become
-```
-# ook
-_aussi_
----
-# bovendien
-_en outre|de plus_
----
-# evenals
-_de même_
-```
-with the command `hascard import input.txt output.txt -r`. More info can be found in the help text at `hascard import --help`.
-
-#### Exporting decks
-Similarly, one may want to convert hascard cards to delimited text files for use in other applications.
-This functionality is provided by `hascard export`. For more info, see `hascard export --help`.
-
-## Cards
-Decks of cards are written in `.txt` or `.md` files. A deck contains multiple cards which are seperated with a line containing three dashes `---`. For examples, see the [`/cards`](https://github.com/Yvee1/hascard/tree/master/cards) directory. 
-
-### 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
-Explanation or definition of this word, or the answer to the question.
-```
-will result in
-<p align="center">
-  <img src="./recordings/definition.gif"></img>
-</p>
-
-#### 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
-
-```
-# Multiple choice question, (only one answer is right)
-- Choice 1
-* Choice 2 (this is the correct answer)
-- Choice 3
-- Choice 4
-```
-
-gets rendered as
-<p align="center">
-  <img src="./recordings/multiple-choice.gif"></img>
-</p>
-
-#### Multiple answer
-Multiple choice questions with multiple possible answers are also available. 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
-
-```
-# Multiple answer question
-[*] Option 1 (this is a correct answer)
-[ ] Option 2
-[*] Option 3 (this is a correct answer)
-[ ] Option 4
-```
-results in
-<p align="center">
-  <img src="./recordings/multiple-answer.gif"></img>
-</p>
-                                                           
-
-#### 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
-
-```
-# Fill in the gaps
-The symbol € is for the currency named _Euro_, and is used in the _EU|European Union_.
-```
-behaves like this
-
-<p align="center">
-  <img src="./recordings/gapped-question.gif"></img>
-</p>
-
-#### 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
-<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?
-![](pear.jpeg)
-- 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. Text in the square brackets which in markdown is used for providing alt-text has no function at the moment.
-
-#### LaTeX (experimental)
-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+[![Build Status](https://github.com/Yvee1/hascard/actions/workflows/build.yml/badge.svg)](https://github.com/Yvee1/hascard/actions) [![GitHub tag](https://img.shields.io/github/tag/Yvee1/hascard.svg)](https://github.com/Yvee1/hascard/releases) [![AUR](https://img.shields.io/aur/version/hascard)](https://aur.archlinux.org/packages/hascard/) [![Hackage](https://img.shields.io/hackage/v/hascard.svg)](https://hackage.haskell.org/package/hascard)++++A minimal commandline utility for reviewing notes. 'Flashcards' can be written in markdown-like syntax.++<p align="center">+<img alt="a recording of example usage of the hascard application" src="./recordings/recording.gif">+</p>++## Contents+- [Installation](#installation)+- [Usage](#usage)+- [Cards](#cards)+  - [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 (experimental)](#latex-experimental)+  +- [Miscellaneous info](#miscellaneous-info)++## Installation+Windows, Linux and macOS are supported.++### Homebrew (for macOS)+For macOS users an installation using homebrew is provided via a custom tap. You can run +```+brew update+brew install Yvee1/tools/hascard+```++### Binary+Ubuntu, macOS, and Windows binaries are available under [releases](https://github.com/Yvee1/hascard/releases/). To be able to run it from any directory, it has to be added to the PATH. In Linux, this can be achieved, for example, by copying it to the `/usr/local/bin` directory.++### Arch Linux+Thanks to [loki7990](https://github.com/loki7990), hascard is also on the AUR: https://aur.archlinux.org/packages/hascard/.++### Snapcraft+Hascard is also on [snapcraft](https://snapcraft.io/hascard). Installation instructions are on that site. If you already have snap installed you can just install hascard via `sudo snap install hascard`. By default snap applications are isolated from the system and run in a sandbox. This means that hascard does not have permission to read or write any files on the system aside from those under `%HOME/snap/hascard`. To be able to read cards also in other directories under the home directory, hascard makes use of the `home` interface which might need to be enabled manually using `sudo snap connect hascard:home :home`.++**Note**: Because of problems with snap and terminfo, the snap installation does not work directly with somewhat non-standard terminals like st-256 and alacritty. This is because the snap environment does not have the necessary terminfo files for these terminals, but copying the terminfo file from the system is a workaround (see [this comment](https://github.com/Yvee1/hascard/issues/3#issuecomment-680699000)).++### Install from source+Another option is to build hascard and install it from source. For this you can use the Haskell build tool called [stack](https://docs.haskellstack.org/en/stable/README/#how-to-install), or [nix](https://nixos.org/). Then for example clone this repository somewhere:+```+git clone https://github.com/Yvee1/hascard.git+cd hascard+```+and do `stack install hascard` or `nix-build` respectively.++## Usage+Simply run `hascard` to open the main application. Menu navigation can be done with the arrow keys or with the 'j' and 'k' keys. The controls for the different cards can be found at the bottom of the screen by default. This, and a couple other things, can be changed in the settings menu. A deck of cards can be opened using the built-in filebrowser, and recently selected decks will appear in the selection menu. These decks of flashcards are written in plain text, this is explained in section [Cards](#cards). After selecting a deck, some options can be specified, like whether the deck should be shuffled or how many cards should be reviewed.++After finishing a deck, there is an option to create new decks from the correctly answered or incorrectly answered cards, or both. The correct cards of a file named `deck.txt` are stored in `deck+.txt` in the same folder, and the incorrect ones in the file `deck-.txt`. Make sure you do not have files of those names that you want to keep since these _will_ be overwritten.++### CLI+The CLI provides three commands, `run`, `import`, `export`. The `hascard run` command is essentially the same as just `hascard`, but the `run` command can be given a file to run the application on directly. When run on a file directly, parameters like whether to shuffle the deck are specified via CLI options instead of in a menu.++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. For more info, see `hascard run --help`.++#### Importing decks+If you have decks in a different format, you might want to convert them into files compatible with hascard. Currently, delimited text 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+de même	evenals+```+will become+```+# ook+_aussi_+---+# bovendien+_en outre|de plus_+---+# evenals+_de même_+```+with the command `hascard import input.txt output.txt -r`. More info can be found in the help text at `hascard import --help`.++#### Exporting decks+Similarly, one may want to convert hascard cards to delimited text files for use in other applications.+This functionality is provided by `hascard export`. For more info, see `hascard export --help`.++## Cards+Decks of cards are written in `.txt` or `.md` files. A deck contains multiple cards which are seperated with a line containing three dashes `---`. For examples, see the [`/cards`](https://github.com/Yvee1/hascard/tree/master/cards) directory. ++### 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+Explanation or definition of this word, or the answer to the question.+```+will result in+<p align="center">+  <img src="./recordings/definition.gif"></img>+</p>++#### 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++```+# Multiple choice question, (only one answer is right)+- Choice 1+* Choice 2 (this is the correct answer)+- Choice 3+- Choice 4+```++gets rendered as+<p align="center">+  <img src="./recordings/multiple-choice.gif"></img>+</p>++#### Multiple answer+Multiple choice questions with multiple possible answers are also available. 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++```+# Multiple answer question+[*] Option 1 (this is a correct answer)+[ ] Option 2+[*] Option 3 (this is a correct answer)+[ ] Option 4+```+results in+<p align="center">+  <img src="./recordings/multiple-answer.gif"></img>+</p>+                                                           ++#### 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++```+# Fill in the gaps+The symbol € is for the currency named _Euro_, and is used in the _EU|European Union_.+```+behaves like this++<p align="center">+  <img src="./recordings/gapped-question.gif"></img>+</p>++#### 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+<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?+![](pear.jpeg)+- 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. Text in the square brackets which in markdown is used for providing alt-text has no function at the moment.++#### LaTeX (experimental)+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).
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
app/Main.hs view
@@ -1,190 +1,190 @@-{-# LANGUAGE TemplateHaskell #-}
-module Main where
-
-import UI
-import Control.Exception (displayException, try)
-import Control.Monad (void, when)
-import Data.Either.Extra (mapLeft)
-import Data.Version (showVersion)
-import Data.Void
-import Export
-import Lens.Micro.Platform
-import Paths_hascard (version)
-import Parser
-import Options.Applicative hiding (many)
-import System.Directory (makeAbsolute)
-import System.FilePath (takeExtension, takeBaseName, takeDirectory)
-import System.Process (runCommand)
-import System.Random.MWC (createSystemRandom)
-import Text.Megaparsec (parse, many, errorBundlePretty, ParseErrorBundle)
-import Text.Megaparsec.Char.Lexer (charLiteral)
-import qualified Data.Map.Strict as Map (empty)
-import qualified System.Directory as D
-import qualified Stack
-
-data Command = Command
-  | Run RunOpts
-  | Import ImportOpts
-  | Export ExportOpts
-
-data Opts = Opts
-  { _optCommand      :: Maybe Command
-  , _optVersion      :: Bool
-  }
-
-data RunOpts = RunOpts
-  { _optFile         :: Maybe String
-  , _optSubset       :: Int
-  , _optChunk        :: Chunk
-  , _optShuffle      :: Bool
-  , _optBlankMode    :: Bool
-  }
-
-makeLenses ''Opts
-makeLenses ''RunOpts
-makeLenses ''ImportOpts
-
-main :: IO ()
-main = do
-  useEscapeCode <- getUseEscapeCode
-  when useEscapeCode $ void (runCommand "echo -n \\\\e[5 q")
-  
-  options <- execParser optsWithHelp
-  case (options ^. optVersion, options ^. optCommand) of
-    (True, _)                -> putStrLn (showVersion version)
-    (_, Just (Run rOpts))    -> run rOpts
-    (_, Just (Import iOpts)) -> doImport iOpts
-    (_, Just (Export eOpts)) -> doExport eOpts
-    (_, Nothing)             ->
-      do g <- createSystemRandom 
-         let gs = GlobalState {_mwc=g, _states=Map.empty, _stack=Stack.empty, _parameters= defaultParameters }
-         start Nothing gs
-
-opts :: Parser Opts
-opts = Opts
-  <$> optional (hsubparser
-    (  command "run" (info (Run <$> runOpts) ( progDesc "Run hascard with CLI options"))
-    <> command "import" (info (Import <$> importOpts) (progDesc "Convert a delimited text file (e.g. exported from Quizlet) to a file compatible with hascard.\
-    \ The delimiters can be specified via CLI options. By default, terms and definitions are assumed to be separated by tabs, and different cards by new lines.\
-    \ Either 'Definition' cards are generated (traditional flashcards), or 'Open question' cards (where the answer needs to be typed).\
-    \ For 'Open question' cards, a delimiter can be specified that separates multiple correct answers."))
-    <> command "export" (info (Export <$> exportOpts) (progDesc "Convert hascard cards to a delimited text file. Only definition and open question cards can be exported"))))
-  <*> switch (long "version" <> short 'v' <> help "Show version number")
-
-runOpts :: Parser RunOpts
-runOpts = RunOpts
-  <$> optional (argument str (metavar "FILE" <> help "A .txt or .md file containing flashcards"))
-  <*> option auto (long "amount" <> short 'a' <> metavar "n" <> help "Use the first n cards in the deck (most useful combined with shuffle)" <> value (-1))
-  <*> option auto (long "chunk" <> short 'c' <> metavar "i/n" <> help "Split the deck into n chunks, and review the i'th one. Counting starts at 1." <> value (Chunk 1 1))
-  <*> switch (long "shuffle" <> short 's' <> help "Randomize card order")
-  <*> switch (long "blank" <> short 'b' <> help "Disable review mode: do not keep track of which questions were correctly and incorrectly answered")
-
-importOpts :: Parser ImportOpts
-importOpts = ImportOpts
-  <$> argument str (metavar "INPUT" <> help "A delimited text file")
-  <*> argument str (metavar "DESINATION" <> help "The filename/path to which the output should be saved")
-  <*> option auto (long "type" <> short 't' <> metavar "'open' or 'def'" <> help "The type of card to which the input is transformed; default: open." <> value Open)
-  <*> switch (long "reverse" <> short 'r' <> help "Reverse direction of question and answer, i.e. right part becomes the question.")
-  <*> strOption (long "row-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate different cards; default: \\n." <> value "\n")
-  <*> strOption (long "term-def-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate terms and definitions; default: \\t." <> value "\t")
-  <*> optional (strOption (long "def-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate different definitions for the same term; no delimiter is used by default."))
-
-exportOpts :: Parser ExportOpts
-exportOpts = ExportOpts
-  <$> argument str (metavar "INPUT" <> help "A file containing hascard cards")
-  <*> argument str (metavar "DESINATION" <> help "The filename/path to which the output should be saved")
-  <*> strOption (long "card-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate different cards; default: \\n." <> value "\n")
-  <*> strOption (long "question-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate terms and definitions; default: ,." <> value ",")
-
-optsWithHelp :: ParserInfo Opts
-optsWithHelp = info (opts <**> helper) $
-              fullDesc <> progDesc "Run the normal application with `hascard`. To run directly on a file, and with CLI options, see `hascard run --help`.\
-              \ For converting delimited text files, see `hascard import --help`."
-              <> header "Hascard - a TUI for reviewing notes"
-
-nothingIf :: (a -> Bool) -> a -> Maybe a
-nothingIf p a
-  | p a = Nothing
-  | otherwise = Just a
-
-mkGlobalState :: RunOpts -> GenIO -> GlobalState
-mkGlobalState opts gen = 
-  let ps = Parameters { _pShuffle = opts^.optShuffle, _pSubset = nothingIf (<0) (opts^.optSubset)
-                      , _pChunk = opts^.optChunk, _pReviewMode = not (opts^.optBlankMode), _pOk = False }
-  in GlobalState {_mwc=gen, _states=Map.empty, _stack=Stack.empty, _parameters=ps }
-
-cleanFilePath :: FilePath -> IO (Either String FilePath)
-cleanFilePath fp = case takeExtension fp of
-  ".txt" -> return $ Right fp
-  ".md"  -> return $ Right fp
-  ""     -> do existence <- mapM D.doesFileExist [fp <> ".txt", fp <> ".md"]
-               return $ case existence of
-                 [True, True] -> Left "Both a .txt and .md file of this name exist, and it is unclear which to use. Specify the file extension."
-                 [True, _   ] -> Right $ fp <> ".txt"     
-                 [_   , True] -> Right $ fp <> ".md"
-                 _            -> Left $ "No .txt or .md file with the name \""
-                                        <> takeBaseName fp
-                                        <> "\" in the directory \""
-                                        <> takeDirectory fp
-                                        <> "\""
-              
-  _      -> return $ Left "Incorrect file type, provide a .txt file"
-  
-run :: RunOpts -> IO ()
-run opts = run' (opts ^. optFile)
-  where
-    run' Nothing = createSystemRandom >>= start Nothing . mkGlobalState opts
-    run' (Just dirtyFp) = do
-      msgOrFp <- cleanFilePath dirtyFp
-      case msgOrFp of
-        Left msg -> putStrLn msg
-        Right fp -> do
-          valOrExc <- try (readFile fp) :: IO (Either IOError String)
-          case valOrExc of
-            Left exc -> putStrLn (displayException exc)
-            Right val -> case parseCards val of
-              Left parseError -> putStr parseError
-              Right result ->
-                do gen <- createSystemRandom
-                   makeAbsolute fp >>= addRecent
-                   start (Just (fp, result)) (mkGlobalState opts gen)
-
-start :: Maybe (FilePath, [Card]) -> GlobalState -> IO ()
-start Nothing gs = runBrickFlashcards (gs `goToState_` mainMenuState)
-start (Just (fp, cards)) gs = runBrickFlashcards =<< (gs `goToState_`) <$> cardsWithOptionsState gs fp cards
-
-doImport :: ImportOpts -> IO ()
-doImport opts' = do
-  let opts = opts' & optRowDelimiter %~ parseStringLiteral
-  valOrExc <- try $ readFile (opts ^. optInput) :: IO (Either IOError String)
-  case valOrExc of
-    Left exc -> putStrLn (displayException exc)
-    Right val -> do
-      let mCards = parseImportInput opts val
-      case mCards of
-        Right cards -> do
-          writeFile (opts ^. optOutput) . cardsToString $ cards
-          putStrLn "Successfully converted the file."
-        Left msg -> putStrLn msg
-
-doExport :: ExportOpts -> IO ()
-doExport opts' = do
-  let opts = opts' & optCardDelimiter %~ parseStringLiteral
-                   & optQuestionDelimiter %~ parseStringLiteral
-  valOrExc <- try $ readFile (opts ^. optExportInput) :: IO (Either IOError String)
-  let eitherResult = do
-        val <- mapLeft displayException valOrExc
-        cards <- parseCards val
-        exportCards opts cards
-
-
-  case eitherResult of
-    Left msg -> putStrLn msg
-    Right output -> do
-      writeFile (opts ^. optExportOutput) output
-      putStrLn "Successfully converted the file."
-         
-parseStringLiteral :: String -> String
-parseStringLiteral s = case parse (many charLiteral) "" s of
-  Left errorBundle -> error (errorBundlePretty (errorBundle :: ParseErrorBundle String Void))
+{-# LANGUAGE TemplateHaskell #-}+module Main where++import UI+import Control.Exception (displayException, try)+import Control.Monad (void, when)+import Data.Either.Extra (mapLeft)+import Data.Version (showVersion)+import Data.Void+import Export+import Lens.Micro.Platform+import Paths_hascard (version)+import Parser+import Options.Applicative hiding (many)+import System.Directory (makeAbsolute)+import System.FilePath (takeExtension, takeBaseName, takeDirectory)+import System.Process (runCommand)+import System.Random.MWC (createSystemRandom)+import Text.Megaparsec (parse, many, errorBundlePretty, ParseErrorBundle)+import Text.Megaparsec.Char.Lexer (charLiteral)+import qualified Data.Map.Strict as Map (empty)+import qualified System.Directory as D+import qualified Stack++data Command = Command+  | Run RunOpts+  | Import ImportOpts+  | Export ExportOpts++data Opts = Opts+  { _optCommand      :: Maybe Command+  , _optVersion      :: Bool+  }++data RunOpts = RunOpts+  { _optFile         :: Maybe String+  , _optSubset       :: Int+  , _optChunk        :: Chunk+  , _optShuffle      :: Bool+  , _optBlankMode    :: Bool+  }++makeLenses ''Opts+makeLenses ''RunOpts+makeLenses ''ImportOpts++main :: IO ()+main = do+  useEscapeCode <- getUseEscapeCode+  when useEscapeCode $ void (runCommand "echo -n \\\\e[5 q")+  +  options <- execParser optsWithHelp+  case (options ^. optVersion, options ^. optCommand) of+    (True, _)                -> putStrLn (showVersion version)+    (_, Just (Run rOpts))    -> run rOpts+    (_, Just (Import iOpts)) -> doImport iOpts+    (_, Just (Export eOpts)) -> doExport eOpts+    (_, Nothing)             ->+      do g <- createSystemRandom +         let gs = GlobalState {_mwc=g, _states=Map.empty, _stack=Stack.empty, _parameters= defaultParameters }+         start Nothing gs++opts :: Parser Opts+opts = Opts+  <$> optional (hsubparser+    (  command "run" (info (Run <$> runOpts) ( progDesc "Run hascard with CLI options"))+    <> command "import" (info (Import <$> importOpts) (progDesc "Convert a delimited text file (e.g. exported from Quizlet) to a file compatible with hascard.\+    \ The delimiters can be specified via CLI options. By default, terms and definitions are assumed to be separated by tabs, and different cards by new lines.\+    \ Either 'Definition' cards are generated (traditional flashcards), or 'Open question' cards (where the answer needs to be typed).\+    \ For 'Open question' cards, a delimiter can be specified that separates multiple correct answers."))+    <> command "export" (info (Export <$> exportOpts) (progDesc "Convert hascard cards to a delimited text file. Only definition and open question cards can be exported"))))+  <*> switch (long "version" <> short 'v' <> help "Show version number")++runOpts :: Parser RunOpts+runOpts = RunOpts+  <$> optional (argument str (metavar "FILE" <> help "A .txt or .md file containing flashcards"))+  <*> option auto (long "amount" <> short 'a' <> metavar "n" <> help "Use the first n cards in the deck (most useful combined with shuffle)" <> value (-1))+  <*> option auto (long "chunk" <> short 'c' <> metavar "i/n" <> help "Split the deck into n chunks, and review the i'th one. Counting starts at 1." <> value (Chunk 1 1))+  <*> switch (long "shuffle" <> short 's' <> help "Randomize card order")+  <*> switch (long "blank" <> short 'b' <> help "Disable review mode: do not keep track of which questions were correctly and incorrectly answered")++importOpts :: Parser ImportOpts+importOpts = ImportOpts+  <$> argument str (metavar "INPUT" <> help "A delimited text file")+  <*> argument str (metavar "DESINATION" <> help "The filename/path to which the output should be saved")+  <*> option auto (long "type" <> short 't' <> metavar "'open' or 'def'" <> help "The type of card to which the input is transformed; default: open." <> value Open)+  <*> switch (long "reverse" <> short 'r' <> help "Reverse direction of question and answer, i.e. right part becomes the question.")+  <*> strOption (long "row-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate different cards; default: \\n." <> value "\n")+  <*> strOption (long "term-def-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate terms and definitions; default: \\t." <> value "\t")+  <*> optional (strOption (long "def-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate different definitions for the same term; no delimiter is used by default."))++exportOpts :: Parser ExportOpts+exportOpts = ExportOpts+  <$> argument str (metavar "INPUT" <> help "A file containing hascard cards")+  <*> argument str (metavar "DESINATION" <> help "The filename/path to which the output should be saved")+  <*> strOption (long "card-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate different cards; default: \\n." <> value "\n")+  <*> strOption (long "question-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate terms and definitions; default: ,." <> value ",")++optsWithHelp :: ParserInfo Opts+optsWithHelp = info (opts <**> helper) $+              fullDesc <> progDesc "Run the normal application with `hascard`. To run directly on a file, and with CLI options, see `hascard run --help`.\+              \ For converting delimited text files, see `hascard import --help`."+              <> header "Hascard - a TUI for reviewing notes"++nothingIf :: (a -> Bool) -> a -> Maybe a+nothingIf p a+  | p a = Nothing+  | otherwise = Just a++mkGlobalState :: RunOpts -> GenIO -> GlobalState+mkGlobalState opts gen = +  let ps = Parameters { _pShuffle = opts^.optShuffle, _pSubset = nothingIf (<0) (opts^.optSubset)+                      , _pChunk = opts^.optChunk, _pReviewMode = not (opts^.optBlankMode), _pOk = False }+  in GlobalState {_mwc=gen, _states=Map.empty, _stack=Stack.empty, _parameters=ps }++cleanFilePath :: FilePath -> IO (Either String FilePath)+cleanFilePath fp = case takeExtension fp of+  ".txt" -> return $ Right fp+  ".md"  -> return $ Right fp+  ""     -> do existence <- mapM D.doesFileExist [fp <> ".txt", fp <> ".md"]+               return $ case existence of+                 [True, True] -> Left "Both a .txt and .md file of this name exist, and it is unclear which to use. Specify the file extension."+                 [True, _   ] -> Right $ fp <> ".txt"     +                 [_   , True] -> Right $ fp <> ".md"+                 _            -> Left $ "No .txt or .md file with the name \""+                                        <> takeBaseName fp+                                        <> "\" in the directory \""+                                        <> takeDirectory fp+                                        <> "\""+              +  _      -> return $ Left "Incorrect file type, provide a .txt file"+  +run :: RunOpts -> IO ()+run opts = run' (opts ^. optFile)+  where+    run' Nothing = createSystemRandom >>= start Nothing . mkGlobalState opts+    run' (Just dirtyFp) = do+      msgOrFp <- cleanFilePath dirtyFp+      case msgOrFp of+        Left msg -> putStrLn msg+        Right fp -> do+          valOrExc <- try (readFile fp) :: IO (Either IOError String)+          case valOrExc of+            Left exc -> putStrLn (displayException exc)+            Right val -> case parseCards val of+              Left parseError -> putStr parseError+              Right result ->+                do gen <- createSystemRandom+                   makeAbsolute fp >>= addRecent+                   start (Just (fp, result)) (mkGlobalState opts gen)++start :: Maybe (FilePath, [Card]) -> GlobalState -> IO ()+start Nothing gs = runBrickFlashcards (gs `goToState_` mainMenuState)+start (Just (fp, cards)) gs = runBrickFlashcards =<< (gs `goToState_`) <$> cardsWithOptionsState gs fp cards++doImport :: ImportOpts -> IO ()+doImport opts' = do+  let opts = opts' & optRowDelimiter %~ parseStringLiteral+  valOrExc <- try $ readFile (opts ^. optInput) :: IO (Either IOError String)+  case valOrExc of+    Left exc -> putStrLn (displayException exc)+    Right val -> do+      let mCards = parseImportInput opts val+      case mCards of+        Right cards -> do+          writeFile (opts ^. optOutput) . cardsToString $ cards+          putStrLn "Successfully converted the file."+        Left msg -> putStrLn msg++doExport :: ExportOpts -> IO ()+doExport opts' = do+  let opts = opts' & optCardDelimiter %~ parseStringLiteral+                   & optQuestionDelimiter %~ parseStringLiteral+  valOrExc <- try $ readFile (opts ^. optExportInput) :: IO (Either IOError String)+  let eitherResult = do+        val <- mapLeft displayException valOrExc+        cards <- parseCards val+        exportCards opts cards+++  case eitherResult of+    Left msg -> putStrLn msg+    Right output -> do+      writeFile (opts ^. optExportOutput) output+      putStrLn "Successfully converted the file."+         +parseStringLiteral :: String -> String+parseStringLiteral s = case parse (many charLiteral) "" s of+  Left errorBundle -> error (errorBundlePretty (errorBundle :: ParseErrorBundle String Void))   Right result -> result
hascard.cabal view
@@ -1,11 +1,11 @@-cabal-version: 1.12
+cabal-version: 1.12  -- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           hascard-version:        0.6.0.1+version:        0.6.0.2 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/Debug.hs view
@@ -1,7 +1,7 @@-module Debug where
-import System.IO.Unsafe (unsafePerformIO)
-
-debugToFile :: String -> a -> a
-debugToFile s expr = unsafePerformIO $ do
-  appendFile "log.txt" s
+module Debug where+import System.IO.Unsafe (unsafePerformIO)++debugToFile :: String -> a -> a+debugToFile s expr = unsafePerformIO $ do+  appendFile "log.txt" s   return expr
src/DeckHandling.hs view
@@ -1,51 +1,51 @@-module DeckHandling where
-import Control.Monad (forM)
-import qualified Data.List.NonEmpty as NE
-import Data.Random
-import Lens.Micro.Platform
-import States
-import Types
-
-doRandomization :: GlobalState -> Bool -> [Card] -> IO ([Int], [Card])
-doRandomization gs shuffleAnswers cards = do
-    let ixs = [0..length cards - 1]
-    shuffledIxs <- if gs^.parameters.pShuffle then sampleFrom (gs^.mwc) (shuffle ixs) else return ixs
-    let cards' = map (cards !!) shuffledIxs
-    cards'' <- if shuffleAnswers
-      then sampleFrom (gs^.mwc) $ mapM shuffleCard cards'
-      else return cards'
-    return $ (shuffledIxs, cards'')
-
-shuffleCard :: Card -> RVar Card
-shuffleCard (c@MultipleAnswer{}) = do
-  shuffledOptions <- shuffle . NE.toList $ options c
-  return $ c { options = NE.fromList shuffledOptions }
-shuffleCard (c@MultipleChoice{}) = do
-  let CorrectOption ic sc = correct c
-      ixs = [0..length (incorrects c)]
-  shuffledIxs <- shuffle ixs
-  let ic' = shuffledIxs !! ic
-      corrOpt = CorrectOption ic' sc
-      incOpts = map (\i -> (incorrects c !!) $ if i > ic' then i - 1 else i) (filter (/= ic') shuffledIxs)
-  return $ c { correct = corrOpt, incorrects = incOpts } 
-shuffleCard c = return c
-
-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
-      qs = replicate n q
-      rs = replicate r 1 ++ repeat 0
-      chunkSizes = zipWith (+) qs rs
-  in makeChunksOfSizes chunkSizes xs
-
-makeChunksOfSizes :: [Int] -> [a] -> [[a]]
-makeChunksOfSizes [] _ = []
-makeChunksOfSizes (n:ns) xs = 
-  let (chunk, rest) = splitAt n xs
+module DeckHandling where+import Control.Monad (forM)+import qualified Data.List.NonEmpty as NE+import Data.Random+import Lens.Micro.Platform+import States+import Types++doRandomization :: GlobalState -> Bool -> [Card] -> IO ([Int], [Card])+doRandomization gs shuffleAnswers cards = do+    let ixs = [0..length cards - 1]+    shuffledIxs <- if gs^.parameters.pShuffle then sampleFrom (gs^.mwc) (shuffle ixs) else return ixs+    let cards' = map (cards !!) shuffledIxs+    cards'' <- if shuffleAnswers+      then sampleFrom (gs^.mwc) $ mapM shuffleCard cards'+      else return cards'+    return $ (shuffledIxs, cards'')++shuffleCard :: Card -> RVar Card+shuffleCard (c@MultipleAnswer{}) = do+  shuffledOptions <- shuffle . NE.toList $ options c+  return $ c { options = NE.fromList shuffledOptions }+shuffleCard (c@MultipleChoice{}) = do+  let CorrectOption ic sc = correct c+      ixs = [0..length (incorrects c)]+  shuffledIxs <- shuffle ixs+  let ic' = shuffledIxs !! ic+      corrOpt = CorrectOption ic' sc+      incOpts = map (\i -> (incorrects c !!) $ if i > ic' then i - 1 else i) (filter (/= ic') shuffledIxs)+  return $ c { correct = corrOpt, incorrects = incOpts } +shuffleCard c = return c++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+      qs = replicate n q+      rs = replicate r 1 ++ repeat 0+      chunkSizes = zipWith (+) qs rs+  in makeChunksOfSizes chunkSizes xs++makeChunksOfSizes :: [Int] -> [a] -> [[a]]+makeChunksOfSizes [] _ = []+makeChunksOfSizes (n:ns) xs = +  let (chunk, rest) = splitAt n xs   in chunk : makeChunksOfSizes ns rest
src/Export.hs view
@@ -1,41 +1,41 @@-{-# LANGUAGE TemplateHaskell #-}
-module Export where
-
-import Lens.Micro.Platform
-import qualified Data.List.NonEmpty as NE
-import Types
-import Data.Either.Extra (mapRight)
-import Data.List.Extra (replace)
-import Data.List (intercalate, stripPrefix, tails, isPrefixOf)
-
-data ExportOpts = ExportOpts
-  { _optExportInput       :: String 
-  , _optExportOutput      :: String
-  , _optCardDelimiter     :: String 
-  , _optQuestionDelimiter :: String 
-  }
-
-makeLenses ''ExportOpts
-
-exportCards :: ExportOpts -> [Card] -> Either String String
-exportCards opts = mapRight (intercalate (opts ^. optCardDelimiter)) 
-                 . mapM (exportCard opts)
-
-exportCard :: ExportOpts -> Card -> Either String String
-exportCard opts (Definition {question=q, definition=d}) = Right $
-  escape opts q <> (opts ^. optQuestionDelimiter) <> escape opts d
-exportCard opts (OpenQuestion {question=q, perforated=p}) = Right $
-  escape opts q <> (opts ^. optQuestionDelimiter) <> escape opts (fillPerforated p)
-exportCard _ _ = Left "Only definition and open question cards can be exported."
-
-fillPerforated :: Perforated -> String
-fillPerforated = foldSentence id fSent . perforatedToSentence
-  where fSent pre gaps post = pre <> concat (NE.intersperse "/" gaps) <> post
-
-escape :: ExportOpts -> String -> String
-escape opts s = if s `contains` (opts ^. optCardDelimiter) || s `contains` (opts ^. optQuestionDelimiter)
-  then "\"" <> replace "\"" "\"\"" s <> "\""
-  else s
-
-contains :: Eq a => [a] -> [a] -> Bool
-contains str substr = any (isPrefixOf substr) (tails str)
+{-# LANGUAGE TemplateHaskell #-}+module Export where++import Lens.Micro.Platform+import qualified Data.List.NonEmpty as NE+import Types+import Data.Either.Extra (mapRight)+import Data.List.Extra (replace)+import Data.List (intercalate, stripPrefix, tails, isPrefixOf)++data ExportOpts = ExportOpts+  { _optExportInput       :: String +  , _optExportOutput      :: String+  , _optCardDelimiter     :: String +  , _optQuestionDelimiter :: String +  }++makeLenses ''ExportOpts++exportCards :: ExportOpts -> [Card] -> Either String String+exportCards opts = mapRight (intercalate (opts ^. optCardDelimiter)) +                 . mapM (exportCard opts)++exportCard :: ExportOpts -> Card -> Either String String+exportCard opts (Definition {question=q, definition=d}) = Right $+  escape opts q <> (opts ^. optQuestionDelimiter) <> escape opts d+exportCard opts (OpenQuestion {question=q, perforated=p}) = Right $+  escape opts q <> (opts ^. optQuestionDelimiter) <> escape opts (fillPerforated p)+exportCard _ _ = Left "Only definition and open question cards can be exported."++fillPerforated :: Perforated -> String+fillPerforated = foldSentence id fSent . perforatedToSentence+  where fSent pre gaps post = pre <> concat (NE.intersperse "/" gaps) <> post++escape :: ExportOpts -> String -> String+escape opts s = if s `contains` (opts ^. optCardDelimiter) || s `contains` (opts ^. optQuestionDelimiter)+  then "\"" <> replace "\"" "\"\"" s <> "\""+  else s++contains :: Eq a => [a] -> [a] -> Bool+contains str substr = any (isPrefixOf substr) (tails str)
src/Glue.hs view
@@ -1,62 +1,62 @@-module Glue where
-import Brick
-import Control.Monad (when)
-import Control.Monad.State.Lazy
-import States
-import StateManagement
-import qualified Graphics.Vty     as V
-import qualified UI.MainMenu      as MM
-import qualified UI.Settings      as S
-import qualified UI.Info          as I
-import qualified UI.CardSelector  as CS
-import qualified UI.FileBrowser   as FB
-import qualified UI.Cards         as C
-import qualified UI.Parameter     as P
-
-globalApp :: App GlobalState Event Name
-globalApp = App
-  { appDraw = drawUI
-  , appChooseCursor = showFirstCursor
-  , appHandleEvent = handleEvent
-  , appStartEvent = enableMouse
-  , appAttrMap = handleAttrMap
-  }
-
-enableMouse = do
-  vty <- getVtyHandle
-  let output = V.outputIface vty
-  when (V.supportsMode output V.Mouse) $
-      liftIO $ V.setMode output V.Mouse True
-
-drawUI :: GlobalState -> [Widget Name]
-drawUI gs = case evalState getState gs of
-  MainMenuState     s -> MM.drawUI s
-  SettingsState     s ->  S.drawUI s
-  InfoState         s ->  I.drawUI s
-  CardSelectorState s -> CS.drawUI gs s
-  FileBrowserState  s -> FB.drawUI s
-  CardsState        s ->  C.drawUI s
-  ParameterState    s ->  P.drawUI s
-
-handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
-handleEvent ev = do
-  if ev == VtyEvent (V.EvKey (V.KChar 'c') [V.MCtrl]) then halt else do
-    s <- getState
-    case s of
-      MainMenuState     s -> MM.handleEvent ev
-      SettingsState     s ->  S.handleEvent ev
-      InfoState         s ->  I.handleEvent ev
-      CardSelectorState s -> CS.handleEvent ev
-      FileBrowserState  s -> FB.handleEvent ev
-      CardsState        s ->  C.handleEvent ev
-      ParameterState    s ->  P.handleEvent ev
-
-handleAttrMap :: GlobalState -> AttrMap
-handleAttrMap gs = case evalState getState gs of
-  MainMenuState     _ -> MM.theMap
-  SettingsState     _ ->  S.theMap
-  InfoState         _ ->  I.theMap
-  CardSelectorState _ -> CS.theMap
-  FileBrowserState  _ -> FB.theMap
-  CardsState        _ ->  C.theMap
+module Glue where+import Brick+import Control.Monad (when)+import Control.Monad.State.Lazy+import States+import StateManagement+import qualified Graphics.Vty     as V+import qualified UI.MainMenu      as MM+import qualified UI.Settings      as S+import qualified UI.Info          as I+import qualified UI.CardSelector  as CS+import qualified UI.FileBrowser   as FB+import qualified UI.Cards         as C+import qualified UI.Parameter     as P++globalApp :: App GlobalState Event Name+globalApp = App+  { appDraw = drawUI+  , appChooseCursor = showFirstCursor+  , appHandleEvent = handleEvent+  , appStartEvent = enableMouse+  , appAttrMap = handleAttrMap+  }++enableMouse = do+  vty <- getVtyHandle+  let output = V.outputIface vty+  when (V.supportsMode output V.Mouse) $+      liftIO $ V.setMode output V.Mouse True++drawUI :: GlobalState -> [Widget Name]+drawUI gs = case evalState getState gs of+  MainMenuState     s -> MM.drawUI s+  SettingsState     s ->  S.drawUI s+  InfoState         s ->  I.drawUI s+  CardSelectorState s -> CS.drawUI gs s+  FileBrowserState  s -> FB.drawUI s+  CardsState        s ->  C.drawUI s+  ParameterState    s ->  P.drawUI s++handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()+handleEvent ev = do+  if ev == VtyEvent (V.EvKey (V.KChar 'c') [V.MCtrl]) then halt else do+    s <- getState+    case s of+      MainMenuState     s -> MM.handleEvent ev+      SettingsState     s ->  S.handleEvent ev+      InfoState         s ->  I.handleEvent ev+      CardSelectorState s -> CS.handleEvent ev+      FileBrowserState  s -> FB.handleEvent ev+      CardsState        s ->  C.handleEvent ev+      ParameterState    s ->  P.handleEvent ev++handleAttrMap :: GlobalState -> AttrMap+handleAttrMap gs = case evalState getState gs of+  MainMenuState     _ -> MM.theMap+  SettingsState     _ ->  S.theMap+  InfoState         _ ->  I.theMap+  CardSelectorState _ -> CS.theMap+  FileBrowserState  _ -> FB.theMap+  CardsState        _ ->  C.theMap   ParameterState    _ ->  P.theMap
src/Import.hs view
@@ -1,96 +1,96 @@-{-# LANGUAGE TemplateHaskell #-}
-module Import where
-import Control.Monad (void)
-import Data.Char (toLower, isSpace)
-import Data.List
--- import Data.List.Split
-import qualified Data.List.NonEmpty as NE
-import Data.Void
-import Lens.Micro.Platform
-import Text.Megaparsec
-import Text.Megaparsec.Char
-import Text.Megaparsec.Debug
-import Types
-
-data ImportType = Def | Open
-
-data ImportOpts = ImportOpts
-  { _optInput            :: String 
-  , _optOutput           :: String
-  , _optImportType       :: ImportType
-  , _optImportReverse    :: Bool
-  , _optRowDelimiter     :: String
-  , _optTermDefDelimiter :: String
-  , _optDefDelimiter     :: Maybe String }
-
-makeLenses ''ImportOpts
-
-instance Read ImportType where
-  readsPrec _ input =
-    case map toLower input of
-      xs | "open"       `isPrefixOf` xs -> [(Open, drop 4 xs)]
-         | "def"        `isPrefixOf` xs -> [(Def,  drop 3 xs)]
-         | "definition" `isPrefixOf` xs -> [(Def, drop 10 xs)]
-         | otherwise -> []
-
-type Parser = Parsec Void String
-
-rowDelimiter :: String
-rowDelimiter = "\n\n"
-
-termDefDelimiter :: String
-termDefDelimiter = "\t"
-
-defDelimiter :: String
-defDelimiter = ","
-
-parseImportInput :: ImportOpts -> String -> Either String [Card]
-parseImportInput opts s = case parse (pImportInput opts) "failed import parsing" s of
-  Left parseErrorBundle -> Left $ errorBundlePretty (parseErrorBundle :: ParseErrorBundle String Void)
-  Right cards -> Right cards
-
-pImportInput :: ImportOpts -> Parser [Card]
-pImportInput opts = pRow opts `sepEndBy1` (void (try (pRowDelimiter *> eol)) <|> void pRowDelimiter <|> void (many eol) <|> eof)
-  where pRowDelimiter = string (opts ^. optRowDelimiter)
-
-pRow :: ImportOpts -> Parser Card
-pRow opts =
-  let
-    pTermDefDelimiter = string (opts ^. optTermDefDelimiter)
-    pDefDelimiter = string <$> (opts ^. optDefDelimiter)
-    pTerm = manyTill anySingle . lookAhead . try $ pSpecial opts
-    pDefs = maybe (fmap (:[]) (pDef opts)) (pDef opts `sepBy`) pDefDelimiter
-    defBeforeTerm = opts ^. optImportReverse
-  in
-    case (defBeforeTerm, opts ^. optImportType) of
-      (False, Open) -> do
-        term <- pTerm
-        pTermDefDelimiter
-        defs <- pDefs
-        return $ OpenQuestion (filter (/= '\n') term) Nothing (P "" (NE.fromList (map (dropWhile isSpace) defs)) (Normal ""))
-      (True, Open) -> do
-        defs <- pDefs
-        pTermDefDelimiter
-        term <- pTerm
-        return $ OpenQuestion (filter (/= '\n') term) Nothing (P "" (NE.fromList (map (dropWhile isSpace) defs)) (Normal ""))
-      (False, Def) -> do
-        term <- pTerm
-        pTermDefDelimiter
-        def <- pDef opts
-        return $ Definition (filter (/= '\n') term) Nothing def
-      (True, Def) -> do
-        def <- pDef opts
-        pTermDefDelimiter
-        term <- pTerm
-        return $ Definition (filter (/= '\n') term) Nothing def
-
-pDef :: ImportOpts -> Parser String
-pDef opts = maybe
-  (manyTill anySingle . lookAhead . try $ pSpecial opts)
-  (\pDefDelimiter -> manyTill anySingle . lookAhead . try $ void pDefDelimiter <|> pSpecial opts)
-  (string <$> (opts ^. optDefDelimiter))
-
-pSpecial :: ImportOpts -> Parser ()
-pSpecial opts = void pTermDefDelimiter <|> void pRowDelimiter <|> (eol *> eof) <> eof
-  where pTermDefDelimiter = string (opts ^. optTermDefDelimiter)
-        pRowDelimiter = string (opts ^. optRowDelimiter)
+{-# LANGUAGE TemplateHaskell #-}+module Import where+import Control.Monad (void)+import Data.Char (toLower, isSpace)+import Data.List+-- import Data.List.Split+import qualified Data.List.NonEmpty as NE+import Data.Void+import Lens.Micro.Platform+import Text.Megaparsec+import Text.Megaparsec.Char+import Text.Megaparsec.Debug+import Types++data ImportType = Def | Open++data ImportOpts = ImportOpts+  { _optInput            :: String +  , _optOutput           :: String+  , _optImportType       :: ImportType+  , _optImportReverse    :: Bool+  , _optRowDelimiter     :: String+  , _optTermDefDelimiter :: String+  , _optDefDelimiter     :: Maybe String }++makeLenses ''ImportOpts++instance Read ImportType where+  readsPrec _ input =+    case map toLower input of+      xs | "open"       `isPrefixOf` xs -> [(Open, drop 4 xs)]+         | "def"        `isPrefixOf` xs -> [(Def,  drop 3 xs)]+         | "definition" `isPrefixOf` xs -> [(Def, drop 10 xs)]+         | otherwise -> []++type Parser = Parsec Void String++rowDelimiter :: String+rowDelimiter = "\n\n"++termDefDelimiter :: String+termDefDelimiter = "\t"++defDelimiter :: String+defDelimiter = ","++parseImportInput :: ImportOpts -> String -> Either String [Card]+parseImportInput opts s = case parse (pImportInput opts) "failed import parsing" s of+  Left parseErrorBundle -> Left $ errorBundlePretty (parseErrorBundle :: ParseErrorBundle String Void)+  Right cards -> Right cards++pImportInput :: ImportOpts -> Parser [Card]+pImportInput opts = pRow opts `sepEndBy1` (void (try (pRowDelimiter *> eol)) <|> void pRowDelimiter <|> void (many eol) <|> eof)+  where pRowDelimiter = string (opts ^. optRowDelimiter)++pRow :: ImportOpts -> Parser Card+pRow opts =+  let+    pTermDefDelimiter = string (opts ^. optTermDefDelimiter)+    pDefDelimiter = string <$> (opts ^. optDefDelimiter)+    pTerm = manyTill anySingle . lookAhead . try $ pSpecial opts+    pDefs = maybe (fmap (:[]) (pDef opts)) (pDef opts `sepBy`) pDefDelimiter+    defBeforeTerm = opts ^. optImportReverse+  in+    case (defBeforeTerm, opts ^. optImportType) of+      (False, Open) -> do+        term <- pTerm+        pTermDefDelimiter+        defs <- pDefs+        return $ OpenQuestion (filter (/= '\n') term) Nothing (P "" (NE.fromList (map (dropWhile isSpace) defs)) (Normal ""))+      (True, Open) -> do+        defs <- pDefs+        pTermDefDelimiter+        term <- pTerm+        return $ OpenQuestion (filter (/= '\n') term) Nothing (P "" (NE.fromList (map (dropWhile isSpace) defs)) (Normal ""))+      (False, Def) -> do+        term <- pTerm+        pTermDefDelimiter+        def <- pDef opts+        return $ Definition (filter (/= '\n') term) Nothing def+      (True, Def) -> do+        def <- pDef opts+        pTermDefDelimiter+        term <- pTerm+        return $ Definition (filter (/= '\n') term) Nothing def++pDef :: ImportOpts -> Parser String+pDef opts = maybe+  (manyTill anySingle . lookAhead . try $ pSpecial opts)+  (\pDefDelimiter -> manyTill anySingle . lookAhead . try $ void pDefDelimiter <|> pSpecial opts)+  (string <$> (opts ^. optDefDelimiter))++pSpecial :: ImportOpts -> Parser ()+pSpecial opts = void pTermDefDelimiter <|> void pRowDelimiter <|> (eol *> eof) <> eof+  where pTermDefDelimiter = string (opts ^. optTermDefDelimiter)+        pRowDelimiter = string (opts ^. optRowDelimiter)
src/Parameters.hs view
@@ -1,162 +1,162 @@-{-# LANGUAGE RankNTypes, FlexibleContexts #-}
-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)
-import Lens.Micro.Platform
-import States
-import Text.Read (readMaybe)
-import UI.BrickHelpers
-import qualified Data.Text as T
-import qualified Graphics.Vty as V
-
-mkParameterForm :: Int -> Parameters -> Form Parameters e Name
-mkParameterForm n ps =
-  let label s w = padBottom (Pad 1) $ padRight (Pad 2) (strWrap s) <+> w
-      form = newForm
-        [ 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
-
-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
-
-chunkSubsetField :: Int -> Lens' s (Chunk, Int) -> s -> FormFieldState s e Name
-chunkSubsetField capacity stLens initialState = 
-  let (initChunk, initInt) = initialState ^. stLens
-
-      handleChunkEvent1 :: BrickEvent n e -> EventM n (Chunk, Int) ()
-      handleChunkEvent1 (VtyEvent ev) = do
-        s@(c@(Chunk i n), int) <- get
-        case ev of
-          V.EvKey (V.KChar c) [] | isDigit c -> do 
-            let i' = read (show i ++ [c])
-            put $ 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 [] -> do
-            let calcNew x = if null (show x) then 0 else fromMaybe 0 (readMaybe (init (show x)))
-            put (Chunk (calcNew i) n, int)
-          _ -> return ()
-      handleChunkEvent1 _ = return ()
-
-      handleChunkEvent2 :: BrickEvent n e -> EventM n (Chunk, Int) ()
-      handleChunkEvent2 (VtyEvent ev) = do 
-        s@(c@(Chunk i n), int) <- get
-        case ev of
-          V.EvKey (V.KChar c) [] | isDigit c -> do
-            let n' = read (show n ++ [c])
-                i' = if i <= n' || n' == 0 then i else n'
-            put $ if n' <= capacity then (Chunk i' n', getSizeOfChunk (Chunk i' n')) else (Chunk i capacity, getSizeOfChunk (Chunk i capacity))
-          V.EvKey V.KBS [] -> do
-            let calcNew x = if null (show x) then 0 else fromMaybe 0 (readMaybe (init (show x)))
-                newN = calcNew n
-                newI = if i <= newN || newN == 0 then i else newN
-            put (Chunk newI newN, int)
-          _ -> return ()
-      handleChunkEvent2 _ = return ()
-
-      handleSubsetEvent :: BrickEvent n e -> EventM n (Chunk, Int) ()
-      handleSubsetEvent (VtyEvent ev) = do
-        s@(ch@(Chunk i n), int) <- get
-        let bound = getSizeOfChunk ch in
-          case ev of
-          V.EvKey (V.KChar c) [] | isDigit c -> do
-            let newValue = read (show int ++ [c])
-                int' = min newValue bound
-            put (ch, int')
-          V.EvKey V.KBS [] -> do
-            let int' = case show int of
-                            "" -> 0
-                            xs -> fromMaybe 0 (readMaybe (init xs))
-            put (ch, int')
-          _ -> return ()
-      handleSubsetEvent _ = return ()
-
-      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
-                    , formFieldUpdate = const
-                    , formFieldRenderHelper = id
-                    , formFieldConcat = customConcat
-                    , formFieldVisibilityMode = ShowAugmentedField }
-
-okField :: (Ord n, Show n) => Lens' s Bool -> n -> String -> s -> FormFieldState s e n
-okField stLens name label initialState =
-  let initVal = initialState ^. stLens
-
-      handleEvent (VtyEvent (V.EvKey V.KEnter [])) = put True
-      handleEvent _ = return ()
-  
-  in FormFieldState { formFieldState = initVal
-                    , formFields = [ FormField name Just True 
-                                       (renderOk label name)
-                                       handleEvent ]
-                    , formFieldLens = stLens
-                    , formFieldUpdate = const
-                    , formFieldRenderHelper = id
-                    , formFieldConcat = vBox
-                    , formFieldVisibilityMode = ShowAugmentedField }
-
-renderOk :: String -> n -> Bool -> Bool -> Widget n
-renderOk label _ focus _ =
-  (if focus then withAttr selectedAttr else id) $ str "Ok"
+{-# LANGUAGE RankNTypes, FlexibleContexts #-}+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)+import Lens.Micro.Platform+import States+import Text.Read (readMaybe)+import UI.BrickHelpers+import qualified Data.Text as T+import qualified Graphics.Vty as V++mkParameterForm :: Int -> Parameters -> Form Parameters e Name+mkParameterForm n ps =+  let label s w = padBottom (Pad 1) $ padRight (Pad 2) (strWrap s) <+> w+      form = newForm+        [ 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++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++chunkSubsetField :: Int -> Lens' s (Chunk, Int) -> s -> FormFieldState s e Name+chunkSubsetField capacity stLens initialState = +  let (initChunk, initInt) = initialState ^. stLens++      handleChunkEvent1 :: BrickEvent n e -> EventM n (Chunk, Int) ()+      handleChunkEvent1 (VtyEvent ev) = do+        s@(c@(Chunk i n), int) <- get+        case ev of+          V.EvKey (V.KChar c) [] | isDigit c -> do +            let i' = read (show i ++ [c])+            put $ 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 [] -> do+            let calcNew x = if null (show x) then 0 else fromMaybe 0 (readMaybe (init (show x)))+            put (Chunk (calcNew i) n, int)+          _ -> return ()+      handleChunkEvent1 _ = return ()++      handleChunkEvent2 :: BrickEvent n e -> EventM n (Chunk, Int) ()+      handleChunkEvent2 (VtyEvent ev) = do +        s@(c@(Chunk i n), int) <- get+        case ev of+          V.EvKey (V.KChar c) [] | isDigit c -> do+            let n' = read (show n ++ [c])+                i' = if i <= n' || n' == 0 then i else n'+            put $ if n' <= capacity then (Chunk i' n', getSizeOfChunk (Chunk i' n')) else (Chunk i capacity, getSizeOfChunk (Chunk i capacity))+          V.EvKey V.KBS [] -> do+            let calcNew x = if null (show x) then 0 else fromMaybe 0 (readMaybe (init (show x)))+                newN = calcNew n+                newI = if i <= newN || newN == 0 then i else newN+            put (Chunk newI newN, int)+          _ -> return ()+      handleChunkEvent2 _ = return ()++      handleSubsetEvent :: BrickEvent n e -> EventM n (Chunk, Int) ()+      handleSubsetEvent (VtyEvent ev) = do+        s@(ch@(Chunk i n), int) <- get+        let bound = getSizeOfChunk ch in+          case ev of+          V.EvKey (V.KChar c) [] | isDigit c -> do+            let newValue = read (show int ++ [c])+                int' = min newValue bound+            put (ch, int')+          V.EvKey V.KBS [] -> do+            let int' = case show int of+                            "" -> 0+                            xs -> fromMaybe 0 (readMaybe (init xs))+            put (ch, int')+          _ -> return ()+      handleSubsetEvent _ = return ()++      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+                    , formFieldUpdate = const+                    , formFieldRenderHelper = id+                    , formFieldConcat = customConcat+                    , formFieldVisibilityMode = ShowAugmentedField }++okField :: (Ord n, Show n) => Lens' s Bool -> n -> String -> s -> FormFieldState s e n+okField stLens name label initialState =+  let initVal = initialState ^. stLens++      handleEvent (VtyEvent (V.EvKey V.KEnter [])) = put True+      handleEvent _ = return ()+  +  in FormFieldState { formFieldState = initVal+                    , formFields = [ FormField name Just True +                                       (renderOk label name)+                                       handleEvent ]+                    , formFieldLens = stLens+                    , formFieldUpdate = const+                    , formFieldRenderHelper = id+                    , formFieldConcat = vBox+                    , formFieldVisibilityMode = ShowAugmentedField }++renderOk :: String -> n -> Bool -> Bool -> Widget n+renderOk label _ focus _ =+  (if focus then withAttr selectedAttr else id) $ str "Ok"
src/Parser.hs view
@@ -1,207 +1,207 @@-{-# LANGUAGE DataKinds, ExistentialQuantification, GADTs, KindSignatures, OverloadedStrings #-}
-module Parser (parseCards) where
-  
-import Control.Arrow
-import Data.Char (isSpace)
-import Data.List (dropWhileEnd)
-import Data.Void
-import Text.Megaparsec
-import Text.Megaparsec.Char
-import Text.Wrap
-import Data.Text (pack, unpack)
-import Types
-import qualified Data.List.NonEmpty as NE
-
--- Type synonyms for convenience
-type Parser = Parsec Void String
-type CardParser = Parser (Either String Card)
-
-uncurry3 f (a, b, c) = f a b c
-
-parseCards :: String -> Either String [Card]
-parseCards s = case parse pCards "failed when parsing cards" s of
-  Left parseErrorBundle -> Left $ errorBundlePretty (parseErrorBundle :: ParseErrorBundle String Void)
-  Right msgOrCards -> left wrap (sequence msgOrCards)
-    where wrap = unlines . map unpack . wrapTextToLines (defaultWrapSettings {preserveIndentation=False, breakLongWords=True}) 40 . pack
-
-pCards :: Parser [Either String Card]
-pCards = (pCard `sepEndBy1` seperator) <* eof
-
-pCard :: Parser (Either String Card)
-pCard =  try pMultChoice
-     <|> try pMultAnswer
-     <|> try pReorder
-     <|> 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 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 . Right $ MultipleAnswer header img (NE.fromList options)
-
-pOption :: Parser Option
-pOption = do
-  char '['
-  kind <- oneOf ['*','x',' ']
-  string "] "
-  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 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 $ 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 
-
-chars = try escaped <|> anySingle
-escaped = char '\\' >> char '_'
-
-pGap :: Parser (String, NE.NonEmpty String)
-pGap = do
-  pre <- manyTill chars $ lookAhead (try (string "_" <|> seperator))
-  char '_'
-  gaps <- manyTill (noneOf ['_','|']) (lookAhead (try gappedSpecialChars)) `sepBy1` string "|"
-  char '_'
-  return (pre, NE.fromList gaps)
-
-gappedSpecialChars =  seperator
-                  <|> 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 $ Right (Definition header img (dropWhileEnd isSpace' descr))
-
-eof' = eof >> return [] <?> "end of file"
-
-seperator = do
-  sep <- string "---"
-  many eol
-  return sep
-
-makeMultipleChoice :: [(Char, String)] -> Parser (Either String (CorrectOption, [IncorrectOption]))
-makeMultipleChoice options = makeMultipleChoice' [] [] 0 options
-  where
-    -- makeMultipleChoice' [] _ _ [] = Left ("multiple choice had no correct answer: \n" ++ showPretty options)
-    makeMultipleChoice' :: [CorrectOption] -> [IncorrectOption] -> Int -> [(Char, String)] -> Parser (Either String (CorrectOption, [IncorrectOption]))
-    makeMultipleChoice' [] _ _ [] = fail "woops"
-    makeMultipleChoice' [c] ics _ [] = return $ Right (c, reverse ics)
-    makeMultipleChoice' _ _ _ [] = return $ Left ("multiple choice had multiple correct answers: \n" ++ showPretty options)
-    makeMultipleChoice' cs ics i (('-', text) : opts) = makeMultipleChoice' cs (IncorrectOption (dropWhileEnd isSpace' text) : ics) (i+1) opts
-    makeMultipleChoice' cs ics i (('*', text) : opts) = makeMultipleChoice' (CorrectOption i (dropWhileEnd isSpace' text) : cs) ics (i+1) opts
-    makeMultipleChoice' _  _   _ _ = return $ Left "impossible"
-
-    showPretty :: [(Char, String)] -> String
-    showPretty = foldr ((<>) . showOne) ""
-
-    showOne (c, s) = [c] <> " " <>  s
-
-makeOption :: Char -> String -> Option
-makeOption kind text
-  | kind `elem` ['*','x'] = Option Correct text
-  | otherwise             = Option Incorrect text
-
-isSpace' :: Char -> Bool
-isSpace' '\r' = True
-isSpace' a    = isSpace a
+{-# LANGUAGE DataKinds, ExistentialQuantification, GADTs, KindSignatures, OverloadedStrings #-}+module Parser (parseCards) where+  +import Control.Arrow+import Data.Char (isSpace)+import Data.List (dropWhileEnd)+import Data.Void+import Text.Megaparsec+import Text.Megaparsec.Char+import Text.Wrap+import Data.Text (pack, unpack)+import Types+import qualified Data.List.NonEmpty as NE++-- Type synonyms for convenience+type Parser = Parsec Void String+type CardParser = Parser (Either String Card)++uncurry3 f (a, b, c) = f a b c++parseCards :: String -> Either String [Card]+parseCards s = case parse pCards "failed when parsing cards" s of+  Left parseErrorBundle -> Left $ errorBundlePretty (parseErrorBundle :: ParseErrorBundle String Void)+  Right msgOrCards -> left wrap (sequence msgOrCards)+    where wrap = unlines . map unpack . wrapTextToLines (defaultWrapSettings {preserveIndentation=False, breakLongWords=True}) 40 . pack++pCards :: Parser [Either String Card]+pCards = (pCard `sepEndBy1` seperator) <* eof++pCard :: Parser (Either String Card)+pCard =  try pMultChoice+     <|> try pMultAnswer+     <|> try pReorder+     <|> 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 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 . Right $ MultipleAnswer header img (NE.fromList options)++pOption :: Parser Option+pOption = do+  char '['+  kind <- oneOf ['*','x',' ']+  string "] "+  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 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 $ 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 ++chars = try escaped <|> anySingle+escaped = char '\\' >> char '_'++pGap :: Parser (String, NE.NonEmpty String)+pGap = do+  pre <- manyTill chars $ lookAhead (try (string "_" <|> seperator))+  char '_'+  gaps <- manyTill (noneOf ['_','|']) (lookAhead (try gappedSpecialChars)) `sepBy1` string "|"+  char '_'+  return (pre, NE.fromList gaps)++gappedSpecialChars =  seperator+                  <|> 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 $ Right (Definition header img (dropWhileEnd isSpace' descr))++eof' = eof >> return [] <?> "end of file"++seperator = do+  sep <- string "---"+  many eol+  return sep++makeMultipleChoice :: [(Char, String)] -> Parser (Either String (CorrectOption, [IncorrectOption]))+makeMultipleChoice options = makeMultipleChoice' [] [] 0 options+  where+    -- makeMultipleChoice' [] _ _ [] = Left ("multiple choice had no correct answer: \n" ++ showPretty options)+    makeMultipleChoice' :: [CorrectOption] -> [IncorrectOption] -> Int -> [(Char, String)] -> Parser (Either String (CorrectOption, [IncorrectOption]))+    makeMultipleChoice' [] _ _ [] = fail "woops"+    makeMultipleChoice' [c] ics _ [] = return $ Right (c, reverse ics)+    makeMultipleChoice' _ _ _ [] = return $ Left ("multiple choice had multiple correct answers: \n" ++ showPretty options)+    makeMultipleChoice' cs ics i (('-', text) : opts) = makeMultipleChoice' cs (IncorrectOption (dropWhileEnd isSpace' text) : ics) (i+1) opts+    makeMultipleChoice' cs ics i (('*', text) : opts) = makeMultipleChoice' (CorrectOption i (dropWhileEnd isSpace' text) : cs) ics (i+1) opts+    makeMultipleChoice' _  _   _ _ = return $ Left "impossible"++    showPretty :: [(Char, String)] -> String+    showPretty = foldr ((<>) . showOne) ""++    showOne (c, s) = [c] <> " " <>  s++makeOption :: Char -> String -> Option+makeOption kind text+  | kind `elem` ['*','x'] = Option Correct text+  | otherwise             = Option Incorrect text++isSpace' :: Char -> Bool+isSpace' '\r' = True+isSpace' a    = isSpace a
src/Recents.hs view
@@ -1,108 +1,108 @@-module Recents where
-import Control.Monad (filterM)
-import Data.List (sort)
-import Settings
-import Stack (Stack)
-import System.Environment (lookupEnv)
-import System.FilePath ((</>), splitFileName, takeExtension, dropExtension, splitPath, joinPath)
-import qualified Stack as S
-import qualified System.Directory as D
-import qualified System.IO.Strict as IOS (readFile)
-
-getRecents :: IO (Stack FilePath)
-getRecents = do
-  rf <- getRecentsFile
-  exists <- D.doesFileExist rf
-  if exists
-    then removeDeletedFiles rf *> clampRecents rf
-    else return S.empty
-
-removeDeletedFiles :: FilePath -> IO (Stack FilePath)
-removeDeletedFiles fp = do
-  contents <- IOS.readFile fp
-  existing <- S.fromList <$> filterM D.doesFileExist (lines contents)
-  writeRecents existing
-  return existing
-
-parseRecents :: String -> Stack FilePath
-parseRecents = S.fromList . lines
-
-clampRecents :: FilePath -> IO (Stack FilePath)
-clampRecents fp = do
-  rs <- parseRecents <$> IOS.readFile fp
-  maxRs <- getMaxRecents
-  let clamped = S.takeStack maxRs rs
-  writeRecents clamped
-  return clamped
-
-addRecent :: FilePath -> IO ()
-addRecent fp = do
-  rs <- getRecents
-  maxRecents <- getMaxRecents
-  let rs'  = fp `S.insert` rs 
-      rs'' = if S.size rs' <= maxRecents
-              then rs'
-              else S.removeLast rs'
-  writeRecents rs''
-
-writeRecents :: Stack FilePath -> IO ()
-writeRecents stack = do
-  file <- getRecentsFile
-  writeFile file $ unlines (S.toList stack)
-
-getRecentsFile :: IO FilePath
-getRecentsFile = do
-  maybeSnap <- lookupEnv "SNAP_USER_DATA"
-  xdg <- D.getXdgDirectory D.XdgData "hascard"
-
-  let dir = case maybeSnap of
-                Just path | not (null path) -> path
-                          | otherwise       -> xdg
-                Nothing                     -> xdg
-  D.createDirectoryIfMissing True dir
-
-  return (dir </> "recents")
-
-initLast :: [a] -> ([a], a)
-initLast [x] = ([], x)
-initLast (x:xs) = let (xs', y) = initLast xs
-                   in (x:xs', y)
-
-prep :: [FilePath] -> ([String], [FilePath])
-prep [] = ([], [])
-prep fps@(fp:_) = if all ((== takeExtension fp) . takeExtension) fps
-  then unzip (map ((\(pre, fn) -> (pre, dropExtension fn)) . splitFileName) fps)
-  else unzip (map splitFileName fps)
-
-shortenFilepaths :: [FilePath] -> [FilePath]
-shortenFilepaths = uncurry shortenFilepaths' . prep 
-  where
-    shortenFilepaths' prefixes abbreviations =
-      let ds = duplicates abbreviations in
-        if null ds then abbreviations else
-          shortenFilepaths' 
-            (flip map (zip [0..] prefixes) (
-              \(i, pre) -> if i `elem` ds then
-                joinPath (init (splitPath pre)) else pre
-            ))
-            (flip map (zip [0..] abbreviations) (
-              \(i, abbr) -> if i `elem` ds then 
-                last (splitPath (prefixes !! i)) ++ abbr
-                else abbr) )
-          
-
-duplicates :: Eq a => [a] -> [Int]
-duplicates = sort . map fst . duplicates' 0 [] []
-  where duplicates' _ _    acc []     = acc
-        duplicates' i seen acc (x:xs) = duplicates' (i+1) ((i, x) : seen) acc' xs
-          where acc' = case (getPairsWithValue x acc, getPairsWithValue x seen) of
-                  ([], []) -> acc
-                  ([], ys) -> (i, x) : ys ++ acc
-                  (_, _)   -> (i, x) : acc
-                -- acc' = if getPairsWithValue x seen then (i, x) : acc else acc 
-
-getPairsWithValue :: Eq a => a -> [(Int, a)] -> [(Int, a)]
-getPairsWithValue _ []       = []
-getPairsWithValue y ((i, x):xs)
-  | x == y    = (i, x) : getPairsWithValue y xs
-  | otherwise = getPairsWithValue y xs
+module Recents where+import Control.Monad (filterM)+import Data.List (sort)+import Settings+import Stack (Stack)+import System.Environment (lookupEnv)+import System.FilePath ((</>), splitFileName, takeExtension, dropExtension, splitPath, joinPath)+import qualified Stack as S+import qualified System.Directory as D+import qualified System.IO.Strict as IOS (readFile)++getRecents :: IO (Stack FilePath)+getRecents = do+  rf <- getRecentsFile+  exists <- D.doesFileExist rf+  if exists+    then removeDeletedFiles rf *> clampRecents rf+    else return S.empty++removeDeletedFiles :: FilePath -> IO (Stack FilePath)+removeDeletedFiles fp = do+  contents <- IOS.readFile fp+  existing <- S.fromList <$> filterM D.doesFileExist (lines contents)+  writeRecents existing+  return existing++parseRecents :: String -> Stack FilePath+parseRecents = S.fromList . lines++clampRecents :: FilePath -> IO (Stack FilePath)+clampRecents fp = do+  rs <- parseRecents <$> IOS.readFile fp+  maxRs <- getMaxRecents+  let clamped = S.takeStack maxRs rs+  writeRecents clamped+  return clamped++addRecent :: FilePath -> IO ()+addRecent fp = do+  rs <- getRecents+  maxRecents <- getMaxRecents+  let rs'  = fp `S.insert` rs +      rs'' = if S.size rs' <= maxRecents+              then rs'+              else S.removeLast rs'+  writeRecents rs''++writeRecents :: Stack FilePath -> IO ()+writeRecents stack = do+  file <- getRecentsFile+  writeFile file $ unlines (S.toList stack)++getRecentsFile :: IO FilePath+getRecentsFile = do+  maybeSnap <- lookupEnv "SNAP_USER_DATA"+  xdg <- D.getXdgDirectory D.XdgData "hascard"++  let dir = case maybeSnap of+                Just path | not (null path) -> path+                          | otherwise       -> xdg+                Nothing                     -> xdg+  D.createDirectoryIfMissing True dir++  return (dir </> "recents")++initLast :: [a] -> ([a], a)+initLast [x] = ([], x)+initLast (x:xs) = let (xs', y) = initLast xs+                   in (x:xs', y)++prep :: [FilePath] -> ([String], [FilePath])+prep [] = ([], [])+prep fps@(fp:_) = if all ((== takeExtension fp) . takeExtension) fps+  then unzip (map ((\(pre, fn) -> (pre, dropExtension fn)) . splitFileName) fps)+  else unzip (map splitFileName fps)++shortenFilepaths :: [FilePath] -> [FilePath]+shortenFilepaths = uncurry shortenFilepaths' . prep +  where+    shortenFilepaths' prefixes abbreviations =+      let ds = duplicates abbreviations in+        if null ds then abbreviations else+          shortenFilepaths' +            (flip map (zip [0..] prefixes) (+              \(i, pre) -> if i `elem` ds then+                joinPath (init (splitPath pre)) else pre+            ))+            (flip map (zip [0..] abbreviations) (+              \(i, abbr) -> if i `elem` ds then +                last (splitPath (prefixes !! i)) ++ abbr+                else abbr) )+          ++duplicates :: Eq a => [a] -> [Int]+duplicates = sort . map fst . duplicates' 0 [] []+  where duplicates' _ _    acc []     = acc+        duplicates' i seen acc (x:xs) = duplicates' (i+1) ((i, x) : seen) acc' xs+          where acc' = case (getPairsWithValue x acc, getPairsWithValue x seen) of+                  ([], []) -> acc+                  ([], ys) -> (i, x) : ys ++ acc+                  (_, _)   -> (i, x) : acc+                -- acc' = if getPairsWithValue x seen then (i, x) : acc else acc ++getPairsWithValue :: Eq a => a -> [(Int, a)] -> [(Int, a)]+getPairsWithValue _ []       = []+getPairsWithValue y ((i, x):xs)+  | x == y    = (i, x) : getPairsWithValue y xs+  | otherwise = getPairsWithValue y xs
src/Runners.hs view
@@ -1,108 +1,108 @@-{-# LANGUAGE FlexibleContexts #-}
-module Runners where
-import Brick.Widgets.FileBrowser
-import Brick.Forms
-import Control.Monad.IO.Class
-import Control.Monad.State.Class
-import DeckHandling
-import Data.Maybe (fromMaybe)
-import Recents
-import Lens.Micro.Platform
-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
-import qualified Stack as S
-
-cardSelectorState :: IO State
-cardSelectorState = do
-  rs <- getRecents
-  maxRs <- getMaxRecents
-  let prettyRecents = shortenFilepaths (S.toList rs)
-      options = Vec.fromList (prettyRecents ++ ["Select file from system"])
-      initialState = CSS
-        { _list = L.list RecentsList options 1
-        , _exception = Nothing
-        , _recents = rs
-        , _maxRecentsToShow = maxRs }
-  return $ CardSelectorState initialState
-
-mainMenuState :: State
-mainMenuState = 
-  let options = Vec.fromList 
-                  [ "Select"
-                  , "Info"
-                  , "Settings"
-                  , "Quit" ]
-
-      initialState = MMS (L.list MainMenuList options 1) in
-  MainMenuState initialState
-
-safeHead :: [a] -> Maybe a
-safeHead [] = Nothing
-safeHead (x:_) = Just x
-
-cardsState :: Bool -> FilePath -> [Card] -> [Card] -> [Int] -> IO State
-cardsState doReview fp originalDeck shuffledDeck ixs = do
-  hints    <- getShowHints
-  controls <- getShowControls
-  caseSensitive <- getCaseSensitive
-
-  let mFirstCard = safeHead shuffledDeck
-      firstCard = fromMaybe (Definition "Empty deck" Nothing "Click enter to go back.") mFirstCard
-      deck' = maybe [firstCard] (const shuffledDeck) mFirstCard
-
-      initialState = 
-        CS { _originalCards = originalDeck
-           , _shownCards = deck'
-           , _indexMapping = ixs
-           , _index = 0
-           , _currentCard = firstCard
-           , _cardState = defaultCardState firstCard
-           , _nCards = length deck'
-           , _showHints = hints
-           , _showControls = controls
-           , _isCaseSensitive = caseSensitive
-           , _reviewMode = maybe False (const doReview) mFirstCard
-           , _correctCards = []
-           , _popup = Nothing
-           , _pathToFile = fp }
- 
-  openCardExternal (takeDirectory fp) firstCard
-  return $ CardsState initialState
-
-cardsWithOptionsStateM :: (MonadState GlobalState m, MonadIO m) => FilePath -> [Card] -> m State
-cardsWithOptionsStateM fp cards = do
-  gs <- get
-  liftIO $ cardsWithOptionsState gs fp cards
-
-cardsWithOptionsState :: GlobalState -> FilePath -> [Card] -> IO State
-cardsWithOptionsState gs fp cards =
-  let chunked = doChunking (gs^.parameters.pChunk) cards
-      trimmed = maybe id take (gs^.parameters.pSubset) chunked
-  in do
-    shuffleAnswers <- getShuffleAnswers
-    (ixs, shuffledCards) <- doRandomization gs shuffleAnswers trimmed
-    cardsState (gs^.parameters.pReviewMode) fp trimmed shuffledCards ixs
-
-infoState :: State
-infoState = InfoState ()
-
-fileBrowserState :: IO State
-fileBrowserState = do
-  browser <- newFileBrowser selectNonDirectories FileBrowserList Nothing
-  let filteredBrowser = setFileBrowserEntryFilter (Just (entryFilter False)) browser
-  return $ FileBrowserState (FBS filteredBrowser Nothing [] Nothing False)
-
-entryFilter :: Bool -> FileInfo -> Bool
-entryFilter acceptHidden info = (fileExtensionMatch "txt" info || fileExtensionMatch "md" info) && (acceptHidden || 
-  case fileInfoFilename info of
-    ".."    -> True
-    '.' : _ -> False
-    _       -> True)
-
-parameterState :: Parameters -> FilePath -> [Card] -> State
+{-# LANGUAGE FlexibleContexts #-}+module Runners where+import Brick.Widgets.FileBrowser+import Brick.Forms+import Control.Monad.IO.Class+import Control.Monad.State.Class+import DeckHandling+import Data.Maybe (fromMaybe)+import Recents+import Lens.Micro.Platform+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+import qualified Stack as S++cardSelectorState :: IO State+cardSelectorState = do+  rs <- getRecents+  maxRs <- getMaxRecents+  let prettyRecents = shortenFilepaths (S.toList rs)+      options = Vec.fromList (prettyRecents ++ ["Select file from system"])+      initialState = CSS+        { _list = L.list RecentsList options 1+        , _exception = Nothing+        , _recents = rs+        , _maxRecentsToShow = maxRs }+  return $ CardSelectorState initialState++mainMenuState :: State+mainMenuState = +  let options = Vec.fromList +                  [ "Select"+                  , "Info"+                  , "Settings"+                  , "Quit" ]++      initialState = MMS (L.list MainMenuList options 1) in+  MainMenuState initialState++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (x:_) = Just x++cardsState :: Bool -> FilePath -> [Card] -> [Card] -> [Int] -> IO State+cardsState doReview fp originalDeck shuffledDeck ixs = do+  hints    <- getShowHints+  controls <- getShowControls+  caseSensitive <- getCaseSensitive++  let mFirstCard = safeHead shuffledDeck+      firstCard = fromMaybe (Definition "Empty deck" Nothing "Click enter to go back.") mFirstCard+      deck' = maybe [firstCard] (const shuffledDeck) mFirstCard++      initialState = +        CS { _originalCards = originalDeck+           , _shownCards = deck'+           , _indexMapping = ixs+           , _index = 0+           , _currentCard = firstCard+           , _cardState = defaultCardState firstCard+           , _nCards = length deck'+           , _showHints = hints+           , _showControls = controls+           , _isCaseSensitive = caseSensitive+           , _reviewMode = maybe False (const doReview) mFirstCard+           , _correctCards = []+           , _popup = Nothing+           , _pathToFile = fp }+ +  openCardExternal (takeDirectory fp) firstCard+  return $ CardsState initialState++cardsWithOptionsStateM :: (MonadState GlobalState m, MonadIO m) => FilePath -> [Card] -> m State+cardsWithOptionsStateM fp cards = do+  gs <- get+  liftIO $ cardsWithOptionsState gs fp cards++cardsWithOptionsState :: GlobalState -> FilePath -> [Card] -> IO State+cardsWithOptionsState gs fp cards =+  let chunked = doChunking (gs^.parameters.pChunk) cards+      trimmed = maybe id take (gs^.parameters.pSubset) chunked+  in do+    shuffleAnswers <- getShuffleAnswers+    (ixs, shuffledCards) <- doRandomization gs shuffleAnswers trimmed+    cardsState (gs^.parameters.pReviewMode) fp trimmed shuffledCards ixs++infoState :: State+infoState = InfoState ()++fileBrowserState :: IO State+fileBrowserState = do+  browser <- newFileBrowser selectNonDirectories FileBrowserList Nothing+  let filteredBrowser = setFileBrowserEntryFilter (Just (entryFilter False)) browser+  return $ FileBrowserState (FBS filteredBrowser Nothing [] Nothing False)++entryFilter :: Bool -> FileInfo -> Bool+entryFilter acceptHidden info = (fileExtensionMatch "txt" info || fileExtensionMatch "md" info) && (acceptHidden || +  case fileInfoFilename info of+    ".."    -> True+    '.' : _ -> False+    _       -> True)++parameterState :: Parameters -> FilePath -> [Card] -> State parameterState ps fp cards = ParameterState (PS cards fp (mkParameterForm (length cards) ps))
src/Settings.hs view
@@ -1,95 +1,95 @@-{-# LANGUAGE OverloadedStrings, RankNTypes #-}
-module Settings where
-import Brick
-import Brick.Forms
-import UI.BrickHelpers
-import Data.Char (isDigit)
-import States
-import Data.Maybe
-import System.FilePath ((</>))
-import System.Environment (lookupEnv)
-import Text.Read (readMaybe)
-import Lens.Micro.Platform
-import qualified Data.Text as T
-import qualified Graphics.Vty as V
-import qualified System.Directory as D
-
-getShowHints :: IO Bool
-getShowHints = do
-  settings <- getSettings
-  return $ settings ^. hints
-
-getShowControls :: IO Bool
-getShowControls = do
-  settings <- getSettings
-  return $ settings ^. controls
-
-getCaseSensitive :: IO Bool
-getCaseSensitive = do
-  settings <- getSettings
-  return $ settings ^. caseSensitive
-
-getShuffleAnswers :: IO Bool
-getShuffleAnswers = do
-  settings <- getSettings
-  return $ settings ^. shuffleAnswers
-
-getUseEscapeCode :: IO Bool
-getUseEscapeCode = do
-  settings <- getSettings
-  return $ settings ^. escapeCode
-
-getMaxRecents :: IO Int
-getMaxRecents = do
-  settings <- getSettings
-  return $ settings ^. maxRecents
-
-getSettings :: IO Settings
-getSettings = do
-  sf <- getSettingsFile
-  exists <- D.doesFileExist sf
-  if exists 
-    then do
-      maybeSettings <- parseSettings <$> readFile sf
-      maybe (return defaultSettings) return maybeSettings
-  else return defaultSettings
-
-parseSettings :: String -> Maybe Settings
-parseSettings = readMaybe
-
-getSettingsFile :: IO FilePath
-getSettingsFile = do
-  maybeSnap <- lookupEnv "SNAP_USER_DATA"
-  xdg <- D.getXdgDirectory D.XdgConfig "hascard"
-
-  let dir = case maybeSnap of
-                Just path | not (null path) -> path
-                          | otherwise       -> xdg
-                Nothing                     -> xdg
-  D.createDirectoryIfMissing True dir
-  return (dir </> "settings")
-
-defaultSettings :: Settings
-defaultSettings = FormState { _hints=False, _controls=True, _caseSensitive=True, 
-  _shuffleAnswers=False, _escapeCode=False, _maxRecents=5}
-
-setSettings :: Settings -> IO ()
-setSettings settings = do
-  sf <- getSettingsFile
-  writeFile sf (show settings)
-
-settingsState :: IO State
-settingsState = SettingsState . mkForm <$> getSettings
-
-mkForm :: Settings -> Form Settings e Name
-mkForm =
-  let label s w = padBottom (Pad 1) $ padRight (Pad 2) (strWrap s) <+> w
-  
-  in newForm
-    [ label "Draw hints using underscores for definition cards" @@= yesnoField False hints HintsField ""
-    , label "Show controls at the bottom of screen" @@= yesnoField False controls ControlsField ""
-    , label "Open questions are case sensitive" @@= yesnoField False caseSensitive CaseSensitiveField ""
-    , label "Shuffle answers to multiple choice questions" @@= yesnoField False shuffleAnswers ShuffleAnswersField ""
-    , label "Use the '-n \\e[5 q' escape code to change the cursor to a blinking line on start" @@= yesnoField False escapeCode EscapeCodeField ""
-    , label "Maximum number of recently selected files stored" @@= naturalNumberField 999 maxRecents MaxRecentsField "" ]
-
+{-# LANGUAGE OverloadedStrings, RankNTypes #-}+module Settings where+import Brick+import Brick.Forms+import UI.BrickHelpers+import Data.Char (isDigit)+import States+import Data.Maybe+import System.FilePath ((</>))+import System.Environment (lookupEnv)+import Text.Read (readMaybe)+import Lens.Micro.Platform+import qualified Data.Text as T+import qualified Graphics.Vty as V+import qualified System.Directory as D++getShowHints :: IO Bool+getShowHints = do+  settings <- getSettings+  return $ settings ^. hints++getShowControls :: IO Bool+getShowControls = do+  settings <- getSettings+  return $ settings ^. controls++getCaseSensitive :: IO Bool+getCaseSensitive = do+  settings <- getSettings+  return $ settings ^. caseSensitive++getShuffleAnswers :: IO Bool+getShuffleAnswers = do+  settings <- getSettings+  return $ settings ^. shuffleAnswers++getUseEscapeCode :: IO Bool+getUseEscapeCode = do+  settings <- getSettings+  return $ settings ^. escapeCode++getMaxRecents :: IO Int+getMaxRecents = do+  settings <- getSettings+  return $ settings ^. maxRecents++getSettings :: IO Settings+getSettings = do+  sf <- getSettingsFile+  exists <- D.doesFileExist sf+  if exists +    then do+      maybeSettings <- parseSettings <$> readFile sf+      maybe (return defaultSettings) return maybeSettings+  else return defaultSettings++parseSettings :: String -> Maybe Settings+parseSettings = readMaybe++getSettingsFile :: IO FilePath+getSettingsFile = do+  maybeSnap <- lookupEnv "SNAP_USER_DATA"+  xdg <- D.getXdgDirectory D.XdgConfig "hascard"++  let dir = case maybeSnap of+                Just path | not (null path) -> path+                          | otherwise       -> xdg+                Nothing                     -> xdg+  D.createDirectoryIfMissing True dir+  return (dir </> "settings")++defaultSettings :: Settings+defaultSettings = FormState { _hints=False, _controls=True, _caseSensitive=True, +  _shuffleAnswers=False, _escapeCode=False, _maxRecents=5}++setSettings :: Settings -> IO ()+setSettings settings = do+  sf <- getSettingsFile+  writeFile sf (show settings)++settingsState :: IO State+settingsState = SettingsState . mkForm <$> getSettings++mkForm :: Settings -> Form Settings e Name+mkForm =+  let label s w = padBottom (Pad 1) $ padRight (Pad 2) (strWrap s) <+> w+  +  in newForm+    [ label "Draw hints using underscores for definition cards" @@= yesnoField False hints HintsField ""+    , label "Show controls at the bottom of screen" @@= yesnoField False controls ControlsField ""+    , label "Open questions are case sensitive" @@= yesnoField False caseSensitive CaseSensitiveField ""+    , label "Shuffle answers to multiple choice questions" @@= yesnoField False shuffleAnswers ShuffleAnswersField ""+    , label "Use the '-n \\e[5 q' escape code to change the cursor to a blinking line on start" @@= yesnoField False escapeCode EscapeCodeField ""+    , label "Maximum number of recently selected files stored" @@= naturalNumberField 999 maxRecents MaxRecentsField "" ]+
src/Stack.hs view
@@ -1,59 +1,59 @@-module Stack (module Stack, module X) where
-import Data.Maybe (fromJust)
-import Data.Foldable as X (toList)
-import Data.Set.Ordered (OSet, (|<))
-import qualified Data.Set.Ordered as OS
-
-type Stack a = OSet a
-
-empty :: Stack a
-empty = OS.empty
-
-singleton :: a -> Stack a
-singleton = OS.singleton
-
-insert :: Ord a => a -> Stack a -> Stack a
-insert = (|<)
-
-removeLast :: Ord a => Stack a -> Stack a
-removeLast s = OS.delete (Stack.last s) s
-
-head :: Stack a -> a
-head = (`unsafeElemAt` 0)
-
-safeHead :: Stack a -> Maybe a
-safeHead = (`elemAt` 0)
-
-last :: Stack a -> a
-last s = s `unsafeElemAt` (Stack.size s - 1)
-
-pop :: Ord a => Stack a -> Stack a
-pop s = OS.delete (Stack.head s) s
-
-popWithInfo :: Ord a => Stack a -> (Stack a, a, a)
-popWithInfo s = let
-  top  = Stack.head s
-  s'   = OS.delete top s
-  top' = Stack.head s' in
-    (s', top, top')
-
-tail :: Ord a => Stack a -> [a]
-tail = toList . pop
-
-elemAt :: Stack a -> Int -> Maybe a
-elemAt = OS.elemAt
-
-takeStack :: Ord a => Int -> Stack a -> Stack a
-takeStack n = fromList . take n . toList
-
-unsafeElemAt :: Stack a -> Int -> a
-unsafeElemAt s = fromJust . OS.elemAt s
-
-fromList :: Ord a => [a] -> Stack a
-fromList = OS.fromList
-
--- toList :: Ord a => Stack a -> [a]
--- toList = toList
-
-size :: Stack a -> Int
+module Stack (module Stack, module X) where+import Data.Maybe (fromJust)+import Data.Foldable as X (toList)+import Data.Set.Ordered (OSet, (|<))+import qualified Data.Set.Ordered as OS++type Stack a = OSet a++empty :: Stack a+empty = OS.empty++singleton :: a -> Stack a+singleton = OS.singleton++insert :: Ord a => a -> Stack a -> Stack a+insert = (|<)++removeLast :: Ord a => Stack a -> Stack a+removeLast s = OS.delete (Stack.last s) s++head :: Stack a -> a+head = (`unsafeElemAt` 0)++safeHead :: Stack a -> Maybe a+safeHead = (`elemAt` 0)++last :: Stack a -> a+last s = s `unsafeElemAt` (Stack.size s - 1)++pop :: Ord a => Stack a -> Stack a+pop s = OS.delete (Stack.head s) s++popWithInfo :: Ord a => Stack a -> (Stack a, a, a)+popWithInfo s = let+  top  = Stack.head s+  s'   = OS.delete top s+  top' = Stack.head s' in+    (s', top, top')++tail :: Ord a => Stack a -> [a]+tail = toList . pop++elemAt :: Stack a -> Int -> Maybe a+elemAt = OS.elemAt++takeStack :: Ord a => Int -> Stack a -> Stack a+takeStack n = fromList . take n . toList++unsafeElemAt :: Stack a -> Int -> a+unsafeElemAt s = fromJust . OS.elemAt s++fromList :: Ord a => [a] -> Stack a+fromList = OS.fromList++-- toList :: Ord a => Stack a -> [a]+-- toList = toList++size :: Stack a -> Int size = OS.size
src/StateManagement.hs view
@@ -1,139 +1,139 @@-{-# LANGUAGE FlexibleContexts #-}
-module StateManagement where
-import Brick
-import Control.Monad.IO.Class
-import Control.Monad.State.Class
-import Control.Monad.State.Lazy (execState)
-import Control.Monad (when, (<=<))
-import Data.Maybe (fromJust)
-import Lens.Micro.Platform
-import Recents
-import States hiding (cardState)
-import Stack hiding (head)
-import qualified Brick.Widgets.List as L
-import qualified Data.Vector as Vec
-import qualified Data.Map.Strict as M
-import qualified Stack
-
-getMode :: State -> Mode
-getMode (MainMenuState     _) = MainMenu
-getMode (SettingsState     _) = Settings
-getMode (InfoState         _) = Info
-getMode (CardSelectorState _) = CardSelector
-getMode (FileBrowserState  _) = FileBrowser
-getMode (CardsState        _) = Cards
-getMode (ParameterState    _) = Parameter
-
-getState :: MonadState GlobalState m => m State
-getState = fromJust <$> safeGetState
-
-mms :: Lens' GlobalState MMS
-mms = lens (\gs -> mmsCast . fromJust $ M.lookup MainMenu (gs ^. states)) (\gs s -> gs & states %~ M.insert MainMenu (MainMenuState s))
-  where mmsCast s@(MainMenuState mms) = mms
-        mmsCast _ = error "impossible"
-
-ss :: Lens' GlobalState SS
-ss = lens (\gs -> ssCast . fromJust $ M.lookup Settings (gs ^. states)) (\gs s -> gs & states %~ M.insert Settings (SettingsState s))
-  where ssCast s@(SettingsState ss) = ss
-        ssCast _ = error "impossible"
-
-is :: Lens' GlobalState IS
-is = lens (\gs -> isCast . fromJust $ M.lookup Info (gs ^. states)) (\gs s -> gs & states %~ M.insert Info (InfoState s))
-  where isCast s@(InfoState ss) = ss
-        isCast _ = error "impossible"
-
-cs :: Lens' GlobalState CS
-cs = lens (\gs -> csCast . fromJust $ M.lookup Cards (gs ^. states)) (\gs s -> gs & states %~ M.insert Cards (CardsState s))
-  where csCast s@(CardsState cs) = cs
-        csCast _ = error "impossible"
-
-css :: Lens' GlobalState CSS
-css = lens (\gs -> cssCast . fromJust $ M.lookup CardSelector (gs ^. states)) (\gs s -> gs & states %~ M.insert CardSelector (CardSelectorState s))
-  where cssCast s@(CardSelectorState css) = css
-        cssCast _ = error "impossible"
-
-fbs :: Lens' GlobalState FBS
-fbs = lens (\gs -> fbsCast . fromJust $ M.lookup FileBrowser (gs ^. states)) (\gs s -> gs & states %~ M.insert FileBrowser (FileBrowserState s))
-  where fbsCast s@(FileBrowserState fbs) = fbs
-        fbsCast _ = error "impossible"
-
-ps :: Lens' GlobalState PS
-ps = lens (\gs -> psCast . fromJust $ M.lookup Parameter (gs ^. states)) (\gs s -> gs & states %~ M.insert Parameter (ParameterState s))
-  where psCast s@(ParameterState ps) = ps
-        psCast _ = error "impossible"
-
-goToState_ :: GlobalState -> State -> GlobalState
-goToState_ gs s = execState (goToState s) gs
-
-goToState :: MonadState GlobalState m => State -> m ()
-goToState s = do states %= M.insert (getMode s) s
-                 stack  %= insert (getMode s)
-
-moveToState :: MonadState GlobalState m => State -> m ()
-moveToState s = do
-  popState
-  goToState s
-
--- popState until at mode of state s.
-removeToState :: MonadState GlobalState m => State -> m ()
-removeToState s = do
-  popState
-  current <- Stack.head <$> use stack
-  if current == getMode s 
-    then moveToState s
-    else removeToState s
-
-popState :: MonadState GlobalState m => m ()
-popState = do
-  s <- use stack
-  let top = Stack.head s
-      s'  = Stack.pop s
-  states %= M.delete top
-  stack  .= s'
-
-popStateOrQuit :: EventM n GlobalState ()
-popStateOrQuit = 
-  do popState
-     s <- use stack
-     when (Stack.size s == 0) halt
-
-safeGetState :: MonadState GlobalState m => m (Maybe State)
-safeGetState = do
-  gs <- get
-  return $ do 
-    key <- safeHead (gs ^. stack)
-    M.lookup key (gs ^. states)
-
-goToModeOrQuit :: Mode -> EventM n GlobalState ()
-goToModeOrQuit mode = do
-  mMode <- M.lookup mode <$> use states
-  maybe halt goToState mMode 
-
-removeToMode :: MonadState GlobalState m => Mode -> m ()
-removeToMode m = do
-  popState
-  current <- Stack.head <$> use stack
-  if current == m
-    then return ()
-    else removeToMode m
-
-removeToModeOrQuit :: Mode -> EventM n GlobalState ()
-removeToModeOrQuit = removeToModeOrQuit' $ return ()
-
-removeToModeOrQuit' :: EventM n GlobalState () -> Mode -> EventM n GlobalState ()
-removeToModeOrQuit' beforeMoving mode = do
-  mState <- M.lookup mode <$> use states
-  case mState of
-    Nothing -> halt
-    Just m -> do
-      gs <- get
-      beforeMoving
-      removeToMode mode
-
-refreshRecents :: (MonadState CSS m, MonadIO m) => m ()
-refreshRecents = do
-  rs <- liftIO getRecents
-  let prettyRecents = shortenFilepaths (toList rs)
-      options       = Vec.fromList (prettyRecents ++ ["Select file from system"])
-  recents .= rs
-  list .= L.list RecentsList options 1
+{-# LANGUAGE FlexibleContexts #-}+module StateManagement where+import Brick+import Control.Monad.IO.Class+import Control.Monad.State.Class+import Control.Monad.State.Lazy (execState)+import Control.Monad (when, (<=<))+import Data.Maybe (fromJust)+import Lens.Micro.Platform+import Recents+import States hiding (cardState)+import Stack hiding (head)+import qualified Brick.Widgets.List as L+import qualified Data.Vector as Vec+import qualified Data.Map.Strict as M+import qualified Stack++getMode :: State -> Mode+getMode (MainMenuState     _) = MainMenu+getMode (SettingsState     _) = Settings+getMode (InfoState         _) = Info+getMode (CardSelectorState _) = CardSelector+getMode (FileBrowserState  _) = FileBrowser+getMode (CardsState        _) = Cards+getMode (ParameterState    _) = Parameter++getState :: MonadState GlobalState m => m State+getState = fromJust <$> safeGetState++mms :: Lens' GlobalState MMS+mms = lens (\gs -> mmsCast . fromJust $ M.lookup MainMenu (gs ^. states)) (\gs s -> gs & states %~ M.insert MainMenu (MainMenuState s))+  where mmsCast s@(MainMenuState mms) = mms+        mmsCast _ = error "impossible"++ss :: Lens' GlobalState SS+ss = lens (\gs -> ssCast . fromJust $ M.lookup Settings (gs ^. states)) (\gs s -> gs & states %~ M.insert Settings (SettingsState s))+  where ssCast s@(SettingsState ss) = ss+        ssCast _ = error "impossible"++is :: Lens' GlobalState IS+is = lens (\gs -> isCast . fromJust $ M.lookup Info (gs ^. states)) (\gs s -> gs & states %~ M.insert Info (InfoState s))+  where isCast s@(InfoState ss) = ss+        isCast _ = error "impossible"++cs :: Lens' GlobalState CS+cs = lens (\gs -> csCast . fromJust $ M.lookup Cards (gs ^. states)) (\gs s -> gs & states %~ M.insert Cards (CardsState s))+  where csCast s@(CardsState cs) = cs+        csCast _ = error "impossible"++css :: Lens' GlobalState CSS+css = lens (\gs -> cssCast . fromJust $ M.lookup CardSelector (gs ^. states)) (\gs s -> gs & states %~ M.insert CardSelector (CardSelectorState s))+  where cssCast s@(CardSelectorState css) = css+        cssCast _ = error "impossible"++fbs :: Lens' GlobalState FBS+fbs = lens (\gs -> fbsCast . fromJust $ M.lookup FileBrowser (gs ^. states)) (\gs s -> gs & states %~ M.insert FileBrowser (FileBrowserState s))+  where fbsCast s@(FileBrowserState fbs) = fbs+        fbsCast _ = error "impossible"++ps :: Lens' GlobalState PS+ps = lens (\gs -> psCast . fromJust $ M.lookup Parameter (gs ^. states)) (\gs s -> gs & states %~ M.insert Parameter (ParameterState s))+  where psCast s@(ParameterState ps) = ps+        psCast _ = error "impossible"++goToState_ :: GlobalState -> State -> GlobalState+goToState_ gs s = execState (goToState s) gs++goToState :: MonadState GlobalState m => State -> m ()+goToState s = do states %= M.insert (getMode s) s+                 stack  %= insert (getMode s)++moveToState :: MonadState GlobalState m => State -> m ()+moveToState s = do+  popState+  goToState s++-- popState until at mode of state s.+removeToState :: MonadState GlobalState m => State -> m ()+removeToState s = do+  popState+  current <- Stack.head <$> use stack+  if current == getMode s +    then moveToState s+    else removeToState s++popState :: MonadState GlobalState m => m ()+popState = do+  s <- use stack+  let top = Stack.head s+      s'  = Stack.pop s+  states %= M.delete top+  stack  .= s'++popStateOrQuit :: EventM n GlobalState ()+popStateOrQuit = +  do popState+     s <- use stack+     when (Stack.size s == 0) halt++safeGetState :: MonadState GlobalState m => m (Maybe State)+safeGetState = do+  gs <- get+  return $ do +    key <- safeHead (gs ^. stack)+    M.lookup key (gs ^. states)++goToModeOrQuit :: Mode -> EventM n GlobalState ()+goToModeOrQuit mode = do+  mMode <- M.lookup mode <$> use states+  maybe halt goToState mMode ++removeToMode :: MonadState GlobalState m => Mode -> m ()+removeToMode m = do+  popState+  current <- Stack.head <$> use stack+  if current == m+    then return ()+    else removeToMode m++removeToModeOrQuit :: Mode -> EventM n GlobalState ()+removeToModeOrQuit = removeToModeOrQuit' $ return ()++removeToModeOrQuit' :: EventM n GlobalState () -> Mode -> EventM n GlobalState ()+removeToModeOrQuit' beforeMoving mode = do+  mState <- M.lookup mode <$> use states+  case mState of+    Nothing -> halt+    Just m -> do+      gs <- get+      beforeMoving+      removeToMode mode++refreshRecents :: (MonadState CSS m, MonadIO m) => m ()+refreshRecents = do+  rs <- liftIO getRecents+  let prettyRecents = shortenFilepaths (toList rs)+      options       = Vec.fromList (prettyRecents ++ ["Select file from system"])+  recents .= rs+  list .= L.list RecentsList options 1
src/States.hs view
@@ -1,242 +1,244 @@-{-# LANGUAGE TemplateHaskell #-}
-module States (module States, GenIO) where
-
-import Brick (Widget, EventM)
-import Brick.Forms (Form)
-import Brick.Widgets.FileBrowser
-import Brick.Widgets.List (List)
-import Data.Char (isDigit)
-import Data.Map.Strict (Map)
-import Lens.Micro.Platform
-import System.Random.MWC (GenIO)
-import Stack hiding (head)
-import Types
-import qualified Brick.Types as T
-import qualified Data.List.NonEmpty as NE
-import qualified Data.Map.Strict as M
-import qualified Graphics.Vty as V
-
-data Name = 
-          -- Settings
-            HintsField
-          | ControlsField
-          | CaseSensitiveField
-          | ShuffleAnswersField
-          | EscapeCodeField
-          | MaxRecentsField
-
-          -- Parameters
-          | ChunkField1
-          | ChunkField2
-          | SubsetField
-          | ShuffleField
-          | ReviewModeField
-          | ParametersOkField
-
-          | Ordinary
-          | MainMenuList
-          | InfoViewport
-          | SettingsViewport
-          | CardViewport Int
-          | RecentsList
-          | FileBrowserList
-          | SBClick T.ClickableScrollbarElement Name
-  deriving (Eq, Ord, Show)
-type Event = ()
-
-data Mode  = MainMenu    
-           | Settings    
-           | Info        
-           | CardSelector
-           | FileBrowser 
-           | Cards
-           | Parameter
-  deriving (Show, Eq, Ord)
-
-data State = MainMenuState     MMS
-           | SettingsState     SS
-           | InfoState         IS
-           | CardSelectorState CSS
-           | FileBrowserState  FBS
-           | ParameterState    PS
-           | CardsState        CS
-
-data Chunk = Chunk Int Int
-
-instance Show Chunk where
-  show (Chunk i n) = show i <> "/" <> show n
-
-instance Read Chunk where
-  readsPrec _ input =
-    let (i', rest1) = span isDigit input
-        i = read i' :: Int
-        (c:rest2) = rest1
-        (n', rest3) = span isDigit rest2
-        n = read n' :: Int
-    in [(Chunk i n, rest3) | c `elem` ['/', ' '] && n >= i && i >= 1] 
-
-data GlobalState = GlobalState
-  { _mwc        :: GenIO
-  , _stack      :: Stack Mode
-  , _states     :: Map Mode State
-  , _parameters :: Parameters
-  }
-
-data CardState = 
-    DefinitionState
-  { _flipped        :: Bool }
-  | MultipleChoiceState
-  { _highlighted    :: Int
-  , _number         :: Int
-  , _tried          :: Map Int Bool      -- indices of tried choices
-  }
-  | MultipleAnswerState
-  { _highlighted    :: Int
-  , _selected       :: Map Int Bool
-  , _number         :: Int
-  , _entered        :: Bool
-  }
-  | OpenQuestionState
-  { _gapInput       :: Map Int String
-  , _highlighted    :: Int
-  , _number         :: Int
-  , _entered        :: Bool
-  , _correctGaps    :: Map Int Bool
-  , _failed         :: Bool
-  }
-  | ReorderState
-  { _highlighted    :: Int
-  , _grabbed        :: Bool 
-  , _order          :: Map Int (Int, String)
-  , _entered        :: Bool
-  , _number         :: Int
-  }
-
-defaultCardState :: Card -> CardState
-defaultCardState Definition{} = DefinitionState { _flipped = False }
-defaultCardState MultipleChoice{incorrects = ics} = MultipleChoiceState 
-  { _highlighted = 0
-  , _number = length ics + 1
-  , _tried = M.fromList [(i, False) | i <- [0..length ics]] }
-defaultCardState OpenQuestion{perforated=perf} = OpenQuestionState 
-  { _gapInput = M.empty
-  , _highlighted = 0
-  , _number = nGapsInPerforated perf
-  , _entered = False
-  , _correctGaps = M.fromList [(i, False) | i <- [0..nGapsInPerforated perf - 1]]
-  , _failed = False }
-defaultCardState MultipleAnswer{options=opts} = MultipleAnswerState 
-  { _highlighted = 0
-  , _selected = M.fromList [(i, False) | i <- [0..NE.length opts-1]]
-  , _entered = False
-  , _number = NE.length opts }
-defaultCardState Reorder{elements=elts} = ReorderState
-  { _highlighted = 0
-  , _grabbed = False
-  , _order = M.fromList (zip [0..] (NE.toList elts))
-  , _entered = False
-  , _number = NE.length elts }
-
-data CS = CS
-  { _originalCards       :: [Card]     -- the deck as it was parsed
-  , _shownCards          :: [Card]     -- the deck after shuffling answers and cards
-  , _indexMapping        :: [Int]      -- contains the order that shownCards has wrt originalCards
-  , _index               :: Int        -- current card index
-  , _nCards              :: Int        -- number of cards
-  , _currentCard         :: Card
-  , _cardState           :: CardState
-  , _showHints           :: Bool
-  , _showControls        :: Bool
-  , _isCaseSensitive     :: Bool      
-  , _reviewMode          :: Bool
-  , _correctCards        :: [Int]      -- list of indices of correct cards
-  , _popup               :: Maybe (Popup GlobalState 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 d = Popup
-  { drawPopup        :: d -> Widget Name
-  , handlePopupEvent :: V.Event -> EventM Name s ()
-  , _popupState      :: PopupState
-  }
-
-data PopupState = 
-    CorrectPopup
-      { _popupSelected :: Int }
-  | FinalPopup
-  | DeckMakerPopup
-      { _popupSelected     :: Int
-      , _makeDeckIncorrect :: Bool
-      , _makeDeckCorrect   :: Bool }
-  deriving Eq
-
-newtype MMS = MMS 
-  { _l  :: List Name String }
-
-type IS = ()
-
-data Settings = FormState
-  { _hints           :: Bool
-  , _controls        :: Bool
-  , _caseSensitive   :: Bool
-  , _shuffleAnswers  :: Bool
-  , _escapeCode      :: Bool
-  , _maxRecents      :: Int }
-  deriving (Read, Show)
-
-type SS = Form Settings Event Name
-
-data CSS = CSS
-  { _list             :: List Name String
-  , _exception        :: Maybe String
-  , _recents          :: Stack FilePath
-  , _maxRecentsToShow :: Int
-  }
-
-data FBS = FBS
-  { _fb          :: FileBrowser Name
-  , _exception'  :: Maybe String
-  , _parsedCards :: [Card]
-  , _filePath    :: Maybe FilePath
-  , _showHidden  :: Bool
-  }
-
-defaultParameters = Parameters
-  { _pShuffle    = False
-  , _pSubset     = Nothing
-  , _pChunk      = Chunk 1 1
-  , _pReviewMode = True
-  , _pOk         = False }
-
-data Parameters = Parameters
-  { _pShuffle    :: Bool
-  , _pSubset     :: Maybe Int
-  , _pChunk      :: Chunk
-  , _pReviewMode :: Bool
-  , _pOk         :: Bool }
-
-data PS = PS
-  { _psCards     :: [Card]
-  , _psFp        :: FilePath
-  , _psForm      :: Form Parameters Event Name
-  }
-
-makeLenses ''State
-makeLenses ''MMS
-makeLenses ''GlobalState
-makeLenses ''CardState
-makeLenses ''CS
-makeLenses ''Settings
-makeLenses ''CSS
-makeLenses ''FBS
-makeLenses ''PS
-makeLenses ''Parameters
-makeLenses ''Popup
+{-# LANGUAGE TemplateHaskell #-}+module States (module States, GenIO) where++import Brick (Widget, EventM)+import Brick.Forms (Form)+import Brick.Widgets.FileBrowser+import Brick.Widgets.List (List)+import Data.Char (isDigit)+import Data.Map.Strict (Map)+import Lens.Micro.Platform+import System.Random.MWC (GenIO)+import Stack hiding (head)+import Types+import qualified Brick.Types as T+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as M+import qualified Graphics.Vty as V++data Name = +          -- Settings+            HintsField+          | ControlsField+          | CaseSensitiveField+          | ShuffleAnswersField+          | EscapeCodeField+          | MaxRecentsField++          -- Parameters+          | ChunkField1+          | ChunkField2+          | SubsetField+          | ShuffleField+          | ReviewModeField+          | ParametersOkField++          | Ordinary+          | MainMenuList+          | InfoViewport+          | SettingsViewport+          | CardViewport Int+          | RecentsList+          | FileBrowserList+          | SBClick T.ClickableScrollbarElement Name+  deriving (Eq, Ord, Show)+type Event = ()++data Mode  = MainMenu    +           | Settings    +           | Info        +           | CardSelector+           | FileBrowser +           | Cards+           | Parameter+  deriving (Show, Eq, Ord)++data State = MainMenuState     MMS+           | SettingsState     SS+           | InfoState         IS+           | CardSelectorState CSS+           | FileBrowserState  FBS+           | ParameterState    PS+           | CardsState        CS++data Chunk = Chunk Int Int++instance Show Chunk where+  show (Chunk i n) = show i <> "/" <> show n++instance Read Chunk where+  readsPrec _ input =+    let (i', rest1) = span isDigit input+        i = read i' :: Int+        (c:rest2) = rest1+        (n', rest3) = span isDigit rest2+        n = read n' :: Int+    in [(Chunk i n, rest3) | c `elem` ['/', ' '] && n >= i && i >= 1] ++data GlobalState = GlobalState+  { _mwc        :: GenIO+  , _stack      :: Stack Mode+  , _states     :: Map Mode State+  , _parameters :: Parameters+  }++data CardState = +    DefinitionState+  { _flipped        :: Bool }+  | MultipleChoiceState+  { _highlighted    :: Int+  , _number         :: Int+  , _tried          :: Map Int Bool      -- indices of tried choices+  }+  | MultipleAnswerState+  { _highlighted    :: Int+  , _selected       :: Map Int Bool+  , _number         :: Int+  , _entered        :: Bool+  }+  | OpenQuestionState+  { _gapInput       :: Map Int String+  , _highlighted    :: Int+  , _number         :: Int+  , _entered        :: Bool+  , _correctGaps    :: Map Int Bool+  , _failed         :: Bool+  , _previousInput  :: Map Int String+  }+  | ReorderState+  { _highlighted    :: Int+  , _grabbed        :: Bool +  , _order          :: Map Int (Int, String)+  , _entered        :: Bool+  , _number         :: Int+  }++defaultCardState :: Card -> CardState+defaultCardState Definition{} = DefinitionState { _flipped = False }+defaultCardState MultipleChoice{incorrects = ics} = MultipleChoiceState +  { _highlighted = 0+  , _number = length ics + 1+  , _tried = M.fromList [(i, False) | i <- [0..length ics]] }+defaultCardState OpenQuestion{perforated=perf} = OpenQuestionState +  { _gapInput = M.empty+  , _highlighted = 0+  , _number = nGapsInPerforated perf+  , _entered = False+  , _correctGaps = M.fromList [(i, False) | i <- [0..nGapsInPerforated perf - 1]]+  , _failed = False+  , _previousInput = M.empty }+defaultCardState MultipleAnswer{options=opts} = MultipleAnswerState +  { _highlighted = 0+  , _selected = M.fromList [(i, False) | i <- [0..NE.length opts-1]]+  , _entered = False+  , _number = NE.length opts }+defaultCardState Reorder{elements=elts} = ReorderState+  { _highlighted = 0+  , _grabbed = False+  , _order = M.fromList (zip [0..] (NE.toList elts))+  , _entered = False+  , _number = NE.length elts }++data CS = CS+  { _originalCards       :: [Card]     -- the deck as it was parsed+  , _shownCards          :: [Card]     -- the deck after shuffling answers and cards+  , _indexMapping        :: [Int]      -- contains the order that shownCards has wrt originalCards+  , _index               :: Int        -- current card index+  , _nCards              :: Int        -- number of cards+  , _currentCard         :: Card+  , _cardState           :: CardState+  , _showHints           :: Bool+  , _showControls        :: Bool+  , _isCaseSensitive     :: Bool      +  , _reviewMode          :: Bool+  , _correctCards        :: [Int]      -- list of indices of correct cards+  , _popup               :: Maybe (Popup GlobalState 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 d = Popup+  { drawPopup        :: d -> Widget Name+  , handlePopupEvent :: V.Event -> EventM Name s ()+  , _popupState      :: PopupState+  }++data PopupState = +    CorrectPopup+      { _popupSelected :: Int }+  | FinalPopup+  | DeckMakerPopup+      { _popupSelected     :: Int+      , _makeDeckIncorrect :: Bool+      , _makeDeckCorrect   :: Bool }+  deriving Eq++newtype MMS = MMS +  { _l  :: List Name String }++type IS = ()++data Settings = FormState+  { _hints           :: Bool+  , _controls        :: Bool+  , _caseSensitive   :: Bool+  , _shuffleAnswers  :: Bool+  , _escapeCode      :: Bool+  , _maxRecents      :: Int }+  deriving (Read, Show)++type SS = Form Settings Event Name++data CSS = CSS+  { _list             :: List Name String+  , _exception        :: Maybe String+  , _recents          :: Stack FilePath+  , _maxRecentsToShow :: Int+  }++data FBS = FBS+  { _fb          :: FileBrowser Name+  , _exception'  :: Maybe String+  , _parsedCards :: [Card]+  , _filePath    :: Maybe FilePath+  , _showHidden  :: Bool+  }++defaultParameters = Parameters+  { _pShuffle    = False+  , _pSubset     = Nothing+  , _pChunk      = Chunk 1 1+  , _pReviewMode = True+  , _pOk         = False }++data Parameters = Parameters+  { _pShuffle    :: Bool+  , _pSubset     :: Maybe Int+  , _pChunk      :: Chunk+  , _pReviewMode :: Bool+  , _pOk         :: Bool }++data PS = PS+  { _psCards     :: [Card]+  , _psFp        :: FilePath+  , _psForm      :: Form Parameters Event Name+  }++makeLenses ''State+makeLenses ''MMS+makeLenses ''GlobalState+makeLenses ''CardState+makeLenses ''CS+makeLenses ''Settings+makeLenses ''CSS+makeLenses ''FBS+makeLenses ''PS+makeLenses ''Parameters+makeLenses ''Popup makeLenses ''PopupState
src/Types.hs view
@@ -1,174 +1,174 @@-module Types where
-import Data.Functor
-import Data.List ( intercalate, intersperse )
-import Data.List.NonEmpty (NonEmpty)
-import System.FilePath ( (</>) )
-import System.Process ( runCommand, readProcess )
-import System.Info ( os )
-import System.IO ( openTempFile, hPutStrLn, hClose )
-import qualified Data.List.NonEmpty as NE
-import qualified System.Directory as D
-
---                     Word   Description
-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 img descr -> showHeader h <> maybe "" ((<>"\n") . show) img <> descr
-      OpenQuestion h img p -> showHeader h <> maybe "" ((<>"\n") . show) img <> show p
-      MultipleChoice h img c inc -> 
-        showHeader h <> maybe "" ((<>"\n") . show) img <> showMultipleChoice c inc
-      MultipleAnswer h img opts ->
-        showHeader h <> maybe "" ((<>"\n") . show) img <> unlines' (NE.toList (NE.map show opts))
-      Reorder h img elts -> 
-        showHeader h <>maybe "" ((<>"\n") . show) img <> 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"
-  "mingw32" -> ""
-  _         -> error $ "Unknown OS (" <> os <> ") for opening files"
-
-openFile :: FilePath -> FilePath -> IO ()
-openFile origin relative = openFile' (origin </> relative)
-
-openFile' :: FilePath -> IO ()
-openFile' fp = do
-  exists <- D.doesFileExist fp 
-  if exists
-    then void $ runCommand (openCommand <> " \"" <> fp <> "\"")
-    else error $ "The file 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
-  readProcess "pdflatex" ["-output-directory", dir, tempfile] ""
-  openFile' (tempfile <> ".pdf")
-
-openCardExternal :: FilePath -> Card -> IO ()
-openCardExternal origin card =
-  case external card of
-    Nothing -> pure ()
-    Just (Image _ relative) -> openFile 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)
-data CorrectOption = CorrectOption Int String
-  deriving Show
-newtype IncorrectOption = IncorrectOption String
-  deriving Show
-data Option = Option Type String
-instance Show Option where
-  show (Option Correct str)   = "[*] " <> str
-  show (Option Incorrect str) = "[ ] " <> str
-
---                         Pre    Gap               Post
-data Sentence = Perforated String (NonEmpty String) Sentence
-              | Normal String
-
-instance Show Sentence where
-  show = foldSentence id (\pre gap sent -> pre <> "_" <> concat (NE.intersperse "|" gap) <> "_" <> sent)
-
-data Perforated = P String (NonEmpty String) Sentence
-
-instance Show Perforated where
-  show = show . perforatedToSentence
-
-listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]
-listMultipleChoice c = reverse . listMultipleChoice' [] 0 c
-  where listMultipleChoice' opts i (CorrectOption j cStr) [] = 
-          if i == j
-            then cStr : opts
-            else opts
-        listMultipleChoice' opts i c'@(CorrectOption j cStr) ics@(IncorrectOption icStr : ics') = 
-          if i == j
-            then listMultipleChoice' (cStr  : opts) (i+1) c' ics
-            else listMultipleChoice' (icStr : opts) (i+1) c' ics'
-
-unlines' :: [String] -> String
-unlines' = intercalate "\n"
-
-showMultipleChoice :: CorrectOption -> [IncorrectOption] -> String
-showMultipleChoice c@(CorrectOption i _) inc = 
-  unlines' . map showOne $ zip [0..] (listMultipleChoice c inc)
-    where showOne (j, s) = (if i == j then "* " else "- ") <> s
-
-showReorder :: (Int, String) -> String
-showReorder (i, s) = show i <> ". " <> s
-
-cardsToString :: [Card] -> String
-cardsToString = unlines . intersperse "---" . map show
-
-nGapsInSentence :: Sentence -> Int
-nGapsInSentence = nGapsInSentence' 0
-  where
-    nGapsInSentence' acc (Normal _) = acc
-    nGapsInSentence' acc (Perforated _ _ post) = nGapsInSentence' (1+acc) post
-
-foldSentence :: (String -> a) -> (String -> NonEmpty String -> a -> a) -> Sentence -> a
-foldSentence norm perf = f where
-  f (Normal text) = norm text
-  f (Perforated pre gap sent) = perf pre gap (f sent)
-
-foldSentenceIndex :: (String -> Int -> a) -> (String -> NonEmpty String -> a -> Int -> a) -> Sentence -> a
-foldSentenceIndex norm perf = f 0 where
-  f i (Normal text) = norm text i
-  f i (Perforated pre gap sent) = perf pre gap (f (i+1) sent) i
-
-perforatedToSentence :: Perforated -> Sentence
-perforatedToSentence (P pre gap sentence) = Perforated pre gap sentence
-
-nGapsInPerforated :: Perforated -> Int
-nGapsInPerforated = nGapsInSentence . perforatedToSentence
-
-sentenceToGaps :: Sentence -> [NonEmpty String]
-sentenceToGaps = foldSentence (const []) (\_ gap acc -> gap : acc)
-
-isOptionCorrect :: Option -> Bool
-isOptionCorrect (Option Correct _) = True
+module Types where+import Data.Functor+import Data.List ( intercalate, intersperse )+import Data.List.NonEmpty (NonEmpty)+import System.FilePath ( (</>) )+import System.Process ( runCommand, readProcess )+import System.Info ( os )+import System.IO ( openTempFile, hPutStrLn, hClose )+import qualified Data.List.NonEmpty as NE+import qualified System.Directory as D++--                     Word   Description+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 img descr -> showHeader h <> maybe "" ((<>"\n") . show) img <> descr+      OpenQuestion h img p -> showHeader h <> maybe "" ((<>"\n") . show) img <> show p+      MultipleChoice h img c inc -> +        showHeader h <> maybe "" ((<>"\n") . show) img <> showMultipleChoice c inc+      MultipleAnswer h img opts ->+        showHeader h <> maybe "" ((<>"\n") . show) img <> unlines' (NE.toList (NE.map show opts))+      Reorder h img elts -> +        showHeader h <>maybe "" ((<>"\n") . show) img <> 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"+  "mingw32" -> ""+  _         -> error $ "Unknown OS (" <> os <> ") for opening files"++openFile :: FilePath -> FilePath -> IO ()+openFile origin relative = openFile' (origin </> relative)++openFile' :: FilePath -> IO ()+openFile' fp = do+  exists <- D.doesFileExist fp +  if exists+    then void $ runCommand (openCommand <> " \"" <> fp <> "\"")+    else error $ "The file 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+  readProcess "pdflatex" ["-output-directory", dir, tempfile] ""+  openFile' (tempfile <> ".pdf")++openCardExternal :: FilePath -> Card -> IO ()+openCardExternal origin card =+  case external card of+    Nothing -> pure ()+    Just (Image _ relative) -> openFile 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)+data CorrectOption = CorrectOption Int String+  deriving Show+newtype IncorrectOption = IncorrectOption String+  deriving Show+data Option = Option Type String+instance Show Option where+  show (Option Correct str)   = "[*] " <> str+  show (Option Incorrect str) = "[ ] " <> str++--                         Pre    Gap               Post+data Sentence = Perforated String (NonEmpty String) Sentence+              | Normal String++instance Show Sentence where+  show = foldSentence id (\pre gap sent -> pre <> "_" <> concat (NE.intersperse "|" gap) <> "_" <> sent)++data Perforated = P String (NonEmpty String) Sentence++instance Show Perforated where+  show = show . perforatedToSentence++listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]+listMultipleChoice c = reverse . listMultipleChoice' [] 0 c+  where listMultipleChoice' opts i (CorrectOption j cStr) [] = +          if i == j+            then cStr : opts+            else opts+        listMultipleChoice' opts i c'@(CorrectOption j cStr) ics@(IncorrectOption icStr : ics') = +          if i == j+            then listMultipleChoice' (cStr  : opts) (i+1) c' ics+            else listMultipleChoice' (icStr : opts) (i+1) c' ics'++unlines' :: [String] -> String+unlines' = intercalate "\n"++showMultipleChoice :: CorrectOption -> [IncorrectOption] -> String+showMultipleChoice c@(CorrectOption i _) inc = +  unlines' . map showOne $ zip [0..] (listMultipleChoice c inc)+    where showOne (j, s) = (if i == j then "* " else "- ") <> s++showReorder :: (Int, String) -> String+showReorder (i, s) = show i <> ". " <> s++cardsToString :: [Card] -> String+cardsToString = unlines . intersperse "---" . map show++nGapsInSentence :: Sentence -> Int+nGapsInSentence = nGapsInSentence' 0+  where+    nGapsInSentence' acc (Normal _) = acc+    nGapsInSentence' acc (Perforated _ _ post) = nGapsInSentence' (1+acc) post++foldSentence :: (String -> a) -> (String -> NonEmpty String -> a -> a) -> Sentence -> a+foldSentence norm perf = f where+  f (Normal text) = norm text+  f (Perforated pre gap sent) = perf pre gap (f sent)++foldSentenceIndex :: (String -> Int -> a) -> (String -> NonEmpty String -> a -> Int -> a) -> Sentence -> a+foldSentenceIndex norm perf = f 0 where+  f i (Normal text) = norm text i+  f i (Perforated pre gap sent) = perf pre gap (f (i+1) sent) i++perforatedToSentence :: Perforated -> Sentence+perforatedToSentence (P pre gap sentence) = Perforated pre gap sentence++nGapsInPerforated :: Perforated -> Int+nGapsInPerforated = nGapsInSentence . perforatedToSentence++sentenceToGaps :: Sentence -> [NonEmpty String]+sentenceToGaps = foldSentence (const []) (\_ gap acc -> gap : acc)++isOptionCorrect :: Option -> Bool+isOptionCorrect (Option Correct _) = True isOptionCorrect _                  = False
src/UI.hs view
@@ -1,37 +1,37 @@-module UI 
-( module X
-, runBrickFlashcards
-
-, GlobalState(..)
-, GenIO
-, Chunk(..)
-, Card
-, External
-, ImportType(..)
-, ImportOpts(..)
-, Parameters(..)
-
-, goToState_
-
-, cardsToString
-
-, parseImportInput
-
-, defaultParameters
-) where
-
-import UI.CardSelector as X (addRecent)
-import Settings        as X (getUseEscapeCode)
-import Runners         as X
-import Brick
-import Export
-import Glue
-import Import
-import States
-import StateManagement
-import Types (Card, External, cardsToString)
-
-runBrickFlashcards :: GlobalState -> IO ()
-runBrickFlashcards gs = do
-  _ <- defaultMain globalApp gs
+module UI +( module X+, runBrickFlashcards++, GlobalState(..)+, GenIO+, Chunk(..)+, Card+, External+, ImportType(..)+, ImportOpts(..)+, Parameters(..)++, goToState_++, cardsToString++, parseImportInput++, defaultParameters+) where++import UI.CardSelector as X (addRecent)+import Settings        as X (getUseEscapeCode)+import Runners         as X+import Brick+import Export+import Glue+import Import+import States+import StateManagement+import Types (Card, External, cardsToString)++runBrickFlashcards :: GlobalState -> IO ()+runBrickFlashcards gs = do+  _ <- defaultMain globalApp gs   return ()
src/UI/Attributes.hs view
@@ -1,109 +1,109 @@-module UI.Attributes where
-import Brick
-import Brick.Forms
-import Graphics.Vty
-
-titleAttr :: AttrName
-titleAttr = attrName "title"
-
-selectedAttr :: AttrName
-selectedAttr = attrName "selected"
-
-textboxAttr :: AttrName
-textboxAttr = attrName "textbox"
-
-highlightedChoiceAttr :: AttrName
-highlightedChoiceAttr = attrName "highlighted choice"
-
-incorrectChoiceAttr :: AttrName
-incorrectChoiceAttr = attrName "incorrect choice"
-
-correctChoiceAttr :: AttrName
-correctChoiceAttr = attrName "correct choice"
-
-highlightedOptAttr :: AttrName
-highlightedOptAttr = attrName "highlighted option"
-
-selectedOptAttr :: AttrName
-selectedOptAttr = attrName "selected option"
-
-correctOptAttr :: AttrName
-correctOptAttr = attrName "correct option"
-
-incorrectOptAttr :: AttrName
-incorrectOptAttr = attrName "incorrect option"
-
-gapAttr :: AttrName
-gapAttr = attrName "gap"
-
-incorrectGapAttr :: AttrName
-incorrectGapAttr = attrName "incorrect gap"
-
-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"
-
-exceptionAttr :: AttrName
-exceptionAttr = attrName "exception"
-
-shuffledAttr :: AttrName
-shuffledAttr = attrName "shuffled indicator"
-
-yesButtonAttr :: AttrName
-yesButtonAttr = attrName "yes button"
-
-noButtonAttr :: AttrName
-noButtonAttr = attrName "no button"
-
-selectedYesButtonAttr :: AttrName
-selectedYesButtonAttr = attrName "selected yes button"
-
-selectedNoButtonAttr :: AttrName
-selectedNoButtonAttr = attrName "selected no button"
-
-correctAttr :: AttrName
-correctAttr = attrName "correct"
-
-wrongAttr :: AttrName
-wrongAttr = attrName "incorrect"
-
-theMap :: AttrMap
-theMap = attrMap defAttr
-  [ (titleAttr, fg yellow)
-  , (textboxAttr, defAttr)
-  , (highlightedChoiceAttr, fg yellow)
-  , (incorrectChoiceAttr, fg red)
-  , (correctChoiceAttr, fg green)
-  , (incorrectGapAttr, fg red `withStyle` underline)
-  , (correctGapAttr, fg green `withStyle` underline)
-  , (highlightedOptAttr, fg yellow)
-  , (selectedOptAttr, fg blue)
-  , (incorrectOptAttr, fg red)
-  , (correctOptAttr, fg green)
-  , (highlightedElementAttr, fg yellow)
-  , (grabbedElementAttr, fg blue)
-  , (correctElementAttr, fg green)
-  , (incorrectElementAttr, fg red)
-  , (gapAttr, defAttr `withStyle` underline)
-  , (selectedAttr, defAttr `withStyle` underline)
-  , (exceptionAttr, fg red)
-  , (focusedFormInputAttr, defAttr `withStyle` underline)
-  , (shuffledAttr, fg red)
-  , (correctAttr, fg green)
-  , (wrongAttr, fg red)
-  , (yesButtonAttr, fg green)
-  , (noButtonAttr, fg red)
-  , (selectedYesButtonAttr, fg green `withStyle` underline)
-  , (selectedNoButtonAttr, fg red `withStyle` underline)
+module UI.Attributes where+import Brick+import Brick.Forms+import Graphics.Vty++titleAttr :: AttrName+titleAttr = attrName "title"++selectedAttr :: AttrName+selectedAttr = attrName "selected"++textboxAttr :: AttrName+textboxAttr = attrName "textbox"++highlightedChoiceAttr :: AttrName+highlightedChoiceAttr = attrName "highlighted choice"++incorrectChoiceAttr :: AttrName+incorrectChoiceAttr = attrName "incorrect choice"++correctChoiceAttr :: AttrName+correctChoiceAttr = attrName "correct choice"++highlightedOptAttr :: AttrName+highlightedOptAttr = attrName "highlighted option"++selectedOptAttr :: AttrName+selectedOptAttr = attrName "selected option"++correctOptAttr :: AttrName+correctOptAttr = attrName "correct option"++incorrectOptAttr :: AttrName+incorrectOptAttr = attrName "incorrect option"++gapAttr :: AttrName+gapAttr = attrName "gap"++incorrectGapAttr :: AttrName+incorrectGapAttr = attrName "incorrect gap"++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"++exceptionAttr :: AttrName+exceptionAttr = attrName "exception"++shuffledAttr :: AttrName+shuffledAttr = attrName "shuffled indicator"++yesButtonAttr :: AttrName+yesButtonAttr = attrName "yes button"++noButtonAttr :: AttrName+noButtonAttr = attrName "no button"++selectedYesButtonAttr :: AttrName+selectedYesButtonAttr = attrName "selected yes button"++selectedNoButtonAttr :: AttrName+selectedNoButtonAttr = attrName "selected no button"++correctAttr :: AttrName+correctAttr = attrName "correct"++wrongAttr :: AttrName+wrongAttr = attrName "incorrect"++theMap :: AttrMap+theMap = attrMap defAttr+  [ (titleAttr, fg yellow)+  , (textboxAttr, defAttr)+  , (highlightedChoiceAttr, fg yellow)+  , (incorrectChoiceAttr, fg red)+  , (correctChoiceAttr, fg green)+  , (incorrectGapAttr, fg red `withStyle` underline)+  , (correctGapAttr, fg green `withStyle` underline)+  , (highlightedOptAttr, fg yellow)+  , (selectedOptAttr, fg blue)+  , (incorrectOptAttr, fg red)+  , (correctOptAttr, fg green)+  , (highlightedElementAttr, fg yellow)+  , (grabbedElementAttr, fg blue)+  , (correctElementAttr, fg green)+  , (incorrectElementAttr, fg red)+  , (gapAttr, defAttr `withStyle` underline)+  , (selectedAttr, defAttr `withStyle` underline)+  , (exceptionAttr, fg red)+  , (focusedFormInputAttr, defAttr `withStyle` underline)+  , (shuffledAttr, fg red)+  , (correctAttr, fg green)+  , (wrongAttr, fg red)+  , (yesButtonAttr, fg green)+  , (noButtonAttr, fg red)+  , (selectedYesButtonAttr, fg green `withStyle` underline)+  , (selectedNoButtonAttr, fg red `withStyle` underline)   ]
src/UI/BrickHelpers.hs view
@@ -1,172 +1,172 @@-{-# LANGUAGE RankNTypes, FlexibleContexts #-}
-module UI.BrickHelpers where
-import Text.Wrap
-import Brick
-import Brick.Forms
-import Brick.Widgets.Border
-import Brick.Widgets.Center
-import Data.Char (isDigit)
-import Data.Maybe
-import Data.Text (pack)
-import Graphics.Vty (imageWidth, imageHeight, charFill)
-import Lens.Micro
-import States (Name(SBClick))
-import Text.Read (readMaybe)
-import UI.Attributes
-import qualified Graphics.Vty as V
-import qualified Brick.Types as T
-
-hCenteredStrWrap :: String -> Widget n
-hCenteredStrWrap = hCenteredStrWrapWithAttr id
-
-hCenteredStrWrapWithAttr :: (Widget n -> Widget n) -> String -> Widget n
-hCenteredStrWrapWithAttr attr p = Widget Greedy Fixed $ do
-  c <- getContext
-  let w = c^.availWidthL
-  let result = vBox $ map (hCenter . attr . txt) $ wrapTextToLines (defaultWrapSettings {preserveIndentation=False, breakLongWords=True}) w (pack p)
-  render result
-
--- Somewhat inefficient because rendering is done just to
--- determine the width and height. So don't use this if the
--- rendering is expensive.
-centerPopup :: Widget n -> Widget n
-centerPopup widget = Widget Fixed Fixed $ do
-  c <- getContext
-  result <- render widget
-  let w = result^.imageL.to imageWidth
-      h = result^.imageL.to imageHeight
-      x = (c^.availWidthL - w) `div` 2
-      y = (c^.availHeightL - h) `div` 2
-  render $ translateBy (Location (x, y)) widget
-
-drawException :: Maybe String -> Widget n
-drawException Nothing = emptyWidget
-drawException (Just e) =
-        centerPopup $ 
-        borderWithLabel (str "Error") $
-        withAttr exceptionAttr $ str e
-
--- | Fill all available space with the specified character. Grows only
--- horizontally.
-hFill :: Char -> Widget n
-hFill = vLimit 1 . fill
-
--- | Fill all available space with the specified character. Grows only
--- vertically.
-vFill :: Char -> Widget n
-vFill = hLimit 1 . fill
-
-atLeastV :: Int -> Widget n -> Widget n
-atLeastV n widget = Widget Fixed Fixed $ do
-  c <- getContext
-  result <- render widget
-  let h  = result^.imageL.to imageHeight
-      dh = n - h
-  if dh > 0 then render $ vLimit n (widget <=> vFill ' ') else render widget
-
-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
-
-      handleEvent (MouseDown n _ _ _) | n == name = modify not
-      handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) = modify not
-      handleEvent (VtyEvent (V.EvKey V.KEnter [])) = modify not
-      handleEvent _ = return ()
-  
-  in FormFieldState { formFieldState = initVal
-                    , formFields = [ FormField name Just True 
-                                       (renderYesno rightAlign label name)
-                                       handleEvent ]
-                    , formFieldLens = stLens
-                    , formFieldUpdate = const
-                    , formFieldRenderHelper = id
-                    , formFieldConcat = vBox
-                    , formFieldVisibilityMode = ShowAugmentedField }
-
-renderYesno :: Ord n => 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 (str "Yes")
-      else if rightAlign 
-        then str " " <+> addAttr (str "No")
-        else addAttr (str "No") <+> str " ") <+> str label
-
-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
-
-      handleEvent (VtyEvent (V.EvKey (V.KChar c) [])) | isDigit c =
-           do s <- get
-              let newValue = read (show s ++ [c])
-              put $ min newValue bound
-      handleEvent (VtyEvent (V.EvKey V.KBS [])) = 
-        do s <- get
-           put $ case show s of
-             "" -> 0
-             xs -> fromMaybe 0 (readMaybe (init xs))
-      handleEvent _ = return ()
-  
-  in FormFieldState { formFieldState = initVal
-                    , formFields = [ FormField name Just True 
-                                       (renderNaturalNumber bound postfix name)
-                                       handleEvent ]
-                    , formFieldLens = stLens
-                    , formFieldUpdate = const
-                    , formFieldRenderHelper = id
-                    , formFieldConcat = vBox
-                    , formFieldVisibilityMode = ShowAugmentedField }
-
-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 null postfix
-    then hLimit (length (show bound)) (csr (addAttr (str val')) <+> hFill ' ') 
-    else csr (addAttr (str val')) <+> str postfix
-
--- https://github.com/jtdaugherty/brick/issues/290#issuecomment-699570168
-fixedHeightOrViewport :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n
-fixedHeightOrViewport maxHeight vpName w =
-    Widget Fixed Fixed $ do
-        -- Render the viewport contents in advance
-        result <- render w
-        -- If the contents will fit in the maximum allowed rows,
-        -- just return the content without putting it in a viewport.
-        if imageHeight (image result) <= maxHeight
-            then return result
-            -- Otherwise put the contents (pre-rendered) in a viewport
-            -- and limit the height to the maximum allowable height.
-            else render (vLimit maxHeight $
-                         viewport vpName Vertical $
-                         Widget Fixed Fixed $ return result)
-
-fixedHeightOrViewportPercent :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n
-fixedHeightOrViewportPercent percentage vpName w =
-    Widget Fixed Fixed $ do
-        result <- render w
-        available <- availHeight <$> getContext
-
-        if imageHeight (image result) <= percentage * available `div` 100
-            then return result
-            else render (vLimitPercent percentage $
-                         viewport vpName Vertical w)
-
-handleClickScroll :: (Int -> EventM n s ()) -> ClickableScrollbarElement -> EventM n s ()
-handleClickScroll scroll el =
-  case el of
-    T.SBHandleBefore -> scroll (-1)
-    T.SBHandleAfter  -> scroll 1
-    T.SBTroughBefore -> scroll (-10)
-    T.SBTroughAfter  -> scroll 10
-    T.SBBar          -> return ()
-
-scrollableViewportPercent :: Int -> Name -> Widget Name -> Widget Name
-scrollableViewportPercent percent n =
-  withClickableVScrollBars SBClick .
-  withVScrollBarHandles .
-  withVScrollBars OnRight .
-  fixedHeightOrViewportPercent percent n .
-  padRight (Pad 1) 
+{-# LANGUAGE RankNTypes, FlexibleContexts #-}+module UI.BrickHelpers where+import Text.Wrap+import Brick+import Brick.Forms+import Brick.Widgets.Border+import Brick.Widgets.Center+import Data.Char (isDigit)+import Data.Maybe+import Data.Text (pack)+import Graphics.Vty (imageWidth, imageHeight, charFill)+import Lens.Micro+import States (Name(SBClick))+import Text.Read (readMaybe)+import UI.Attributes+import qualified Graphics.Vty as V+import qualified Brick.Types as T++hCenteredStrWrap :: String -> Widget n+hCenteredStrWrap = hCenteredStrWrapWithAttr id++hCenteredStrWrapWithAttr :: (Widget n -> Widget n) -> String -> Widget n+hCenteredStrWrapWithAttr attr p = Widget Greedy Fixed $ do+  c <- getContext+  let w = c^.availWidthL+  let result = vBox $ map (hCenter . attr . txt) $ wrapTextToLines (defaultWrapSettings {preserveIndentation=False, breakLongWords=True}) w (pack p)+  render result++-- Somewhat inefficient because rendering is done just to+-- determine the width and height. So don't use this if the+-- rendering is expensive.+centerPopup :: Widget n -> Widget n+centerPopup widget = Widget Fixed Fixed $ do+  c <- getContext+  result <- render widget+  let w = result^.imageL.to imageWidth+      h = result^.imageL.to imageHeight+      x = (c^.availWidthL - w) `div` 2+      y = (c^.availHeightL - h) `div` 2+  render $ translateBy (Location (x, y)) widget++drawException :: Maybe String -> Widget n+drawException Nothing = emptyWidget+drawException (Just e) =+        centerPopup $ +        borderWithLabel (str "Error") $+        withAttr exceptionAttr $ str e++-- | Fill all available space with the specified character. Grows only+-- horizontally.+hFill :: Char -> Widget n+hFill = vLimit 1 . fill++-- | Fill all available space with the specified character. Grows only+-- vertically.+vFill :: Char -> Widget n+vFill = hLimit 1 . fill++atLeastV :: Int -> Widget n -> Widget n+atLeastV n widget = Widget Fixed Fixed $ do+  c <- getContext+  result <- render widget+  let h  = result^.imageL.to imageHeight+      dh = n - h+  if dh > 0 then render $ vLimit n (widget <=> vFill ' ') else render widget++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++      handleEvent (MouseDown n _ _ _) | n == name = modify not+      handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) = modify not+      handleEvent (VtyEvent (V.EvKey V.KEnter [])) = modify not+      handleEvent _ = return ()+  +  in FormFieldState { formFieldState = initVal+                    , formFields = [ FormField name Just True +                                       (renderYesno rightAlign label name)+                                       handleEvent ]+                    , formFieldLens = stLens+                    , formFieldUpdate = const+                    , formFieldRenderHelper = id+                    , formFieldConcat = vBox+                    , formFieldVisibilityMode = ShowAugmentedField }++renderYesno :: Ord n => 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 (str "Yes")+      else if rightAlign +        then str " " <+> addAttr (str "No")+        else addAttr (str "No") <+> str " ") <+> str label++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++      handleEvent (VtyEvent (V.EvKey (V.KChar c) [])) | isDigit c =+           do s <- get+              let newValue = read (show s ++ [c])+              put $ min newValue bound+      handleEvent (VtyEvent (V.EvKey V.KBS [])) = +        do s <- get+           put $ case show s of+             "" -> 0+             xs -> fromMaybe 0 (readMaybe (init xs))+      handleEvent _ = return ()+  +  in FormFieldState { formFieldState = initVal+                    , formFields = [ FormField name Just True +                                       (renderNaturalNumber bound postfix name)+                                       handleEvent ]+                    , formFieldLens = stLens+                    , formFieldUpdate = const+                    , formFieldRenderHelper = id+                    , formFieldConcat = vBox+                    , formFieldVisibilityMode = ShowAugmentedField }++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 null postfix+    then hLimit (length (show bound)) (csr (addAttr (str val')) <+> hFill ' ') +    else csr (addAttr (str val')) <+> str postfix++-- https://github.com/jtdaugherty/brick/issues/290#issuecomment-699570168+fixedHeightOrViewport :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n+fixedHeightOrViewport maxHeight vpName w =+    Widget Fixed Fixed $ do+        -- Render the viewport contents in advance+        result <- render w+        -- If the contents will fit in the maximum allowed rows,+        -- just return the content without putting it in a viewport.+        if imageHeight (image result) <= maxHeight+            then return result+            -- Otherwise put the contents (pre-rendered) in a viewport+            -- and limit the height to the maximum allowable height.+            else render (vLimit maxHeight $+                         viewport vpName Vertical $+                         Widget Fixed Fixed $ return result)++fixedHeightOrViewportPercent :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n+fixedHeightOrViewportPercent percentage vpName w =+    Widget Fixed Fixed $ do+        result <- render w+        available <- availHeight <$> getContext++        if imageHeight (image result) <= percentage * available `div` 100+            then return result+            else render (vLimitPercent percentage $+                         viewport vpName Vertical w)++handleClickScroll :: (Int -> EventM n s ()) -> ClickableScrollbarElement -> EventM n s ()+handleClickScroll scroll el =+  case el of+    T.SBHandleBefore -> scroll (-1)+    T.SBHandleAfter  -> scroll 1+    T.SBTroughBefore -> scroll (-10)+    T.SBTroughAfter  -> scroll 10+    T.SBBar          -> return ()++scrollableViewportPercent :: Int -> Name -> Widget Name -> Widget Name+scrollableViewportPercent percent n =+  withClickableVScrollBars SBClick .+  withVScrollBarHandles .+  withVScrollBars OnRight .+  fixedHeightOrViewportPercent percent n .+  padRight (Pad 1) 
src/UI/CardSelector.hs view
@@ -1,106 +1,106 @@-{-# LANGUAGE FlexibleContexts #-}
-
-module UI.CardSelector
-  ( State
-  , drawUI
-  , handleEvent
-  , theMap
-  , getRecents
-  , getRecentsFile
-  , addRecent ) where
-
-import Brick
-import Brick.Widgets.Border
-import Brick.Widgets.Border.Style
-import Brick.Widgets.Center
-import Control.Exception (displayException, try)
-import Control.Monad.IO.Class
-import Control.Monad.State.Class
-import Lens.Micro.Platform
-import Parser
-import Recents
-import Runners
-import States
-import StateManagement
-import UI.Attributes hiding (theMap)
-import UI.BrickHelpers
-import qualified Brick.Widgets.List as L
-import qualified Graphics.Vty as V
-import qualified Stack as S
-import qualified UI.Attributes as A
-
-drawUI :: GlobalState -> CSS -> [Widget Name]
-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 =
-  joinBorders $
-  center $
-  withBorderStyle unicodeRounded $
-  border $
-  hLimitPercent 60 $
-  hCenter title <=>
-  hBorder <=>
-  hCenter (drawList s)
-
-drawList :: CSS -> Widget Name
-drawList s = vLimit (s ^. maxRecentsToShow + 1)  $
-             L.renderListWithIndex (drawListElement l) True l
-              where l = s ^. list
-
-drawListElement :: L.List Name String -> Int -> Bool -> String -> Widget Name
-drawListElement l i selected = hCenteredStrWrapWithAttr (wAttr1 . wAttr2)
-  where wAttr1 = if selected then withDefAttr selectedAttr else id
-        wAttr2 = if i == length l - 1 then withAttr lastElementAttr else id
-
-lastElementAttr :: AttrName
-lastElementAttr = attrName "last element"
-
-theMap :: AttrMap
-theMap = applyAttrMappings
-    [ (L.listAttr, V.defAttr)
-    , (selectedAttr, fg V.white `V.withStyle` V.underline)
-    , (titleAttr, fg V.yellow)
-    , (lastElementAttr, fg V.blue) ] A.theMap
-
-handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
-handleEvent (VtyEvent ev) = do
-  l <- use $ css.list
-  exc <- use $ css.exception
-  case (exc, ev) of
-    (Just _, _) -> css.exception .= Nothing
-    (_, e) -> case e of
-      V.EvKey V.KEsc [] -> popState
-      V.EvKey (V.KChar 'q') []  -> popState
-
-      _ -> do zoom (css.list) $ L.handleListEventVi L.handleListEvent e
-              case e of
-                V.EvKey V.KEnter [] -> do
-                  selected <- L.listSelectedElement <$> use (css.list)
-                  case selected of
-                    Just (_, "Select file from system") -> do
-                      fbs <- liftIO fileBrowserState
-                      goToState fbs
-                    Just (i, _) -> do
-                        fp <- (`S.unsafeElemAt` i) <$> use (css.recents)
-                        fileOrExc <- liftIO (try (readFile fp) :: IO (Either IOError String))
-                        case fileOrExc of
-                          Left exc -> css.exception ?= displayException exc
-                          Right file -> case parseCards file of
-                            Left parseError -> css.exception ?= parseError
-                            Right result -> do
-                              zoom css $ addRecentInternal fp
-                              params <- use parameters
-                              goToState (parameterState params fp result)
-                _ -> return ()
-
-handleEvent _ = return ()
-
-addRecentInternal ::(MonadState CSS m, MonadIO m) => FilePath -> m ()
-addRecentInternal fp = do
-  liftIO $ addRecent fp
-  refreshRecents
+{-# LANGUAGE FlexibleContexts #-}++module UI.CardSelector+  ( State+  , drawUI+  , handleEvent+  , theMap+  , getRecents+  , getRecentsFile+  , addRecent ) where++import Brick+import Brick.Widgets.Border+import Brick.Widgets.Border.Style+import Brick.Widgets.Center+import Control.Exception (displayException, try)+import Control.Monad.IO.Class+import Control.Monad.State.Class+import Lens.Micro.Platform+import Parser+import Recents+import Runners+import States+import StateManagement+import UI.Attributes hiding (theMap)+import UI.BrickHelpers+import qualified Brick.Widgets.List as L+import qualified Graphics.Vty as V+import qualified Stack as S+import qualified UI.Attributes as A++drawUI :: GlobalState -> CSS -> [Widget Name]+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 =+  joinBorders $+  center $+  withBorderStyle unicodeRounded $+  border $+  hLimitPercent 60 $+  hCenter title <=>+  hBorder <=>+  hCenter (drawList s)++drawList :: CSS -> Widget Name+drawList s = vLimit (s ^. maxRecentsToShow + 1)  $+             L.renderListWithIndex (drawListElement l) True l+              where l = s ^. list++drawListElement :: L.List Name String -> Int -> Bool -> String -> Widget Name+drawListElement l i selected = hCenteredStrWrapWithAttr (wAttr1 . wAttr2)+  where wAttr1 = if selected then withDefAttr selectedAttr else id+        wAttr2 = if i == length l - 1 then withAttr lastElementAttr else id++lastElementAttr :: AttrName+lastElementAttr = attrName "last element"++theMap :: AttrMap+theMap = applyAttrMappings+    [ (L.listAttr, V.defAttr)+    , (selectedAttr, fg V.white `V.withStyle` V.underline)+    , (titleAttr, fg V.yellow)+    , (lastElementAttr, fg V.blue) ] A.theMap++handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()+handleEvent (VtyEvent ev) = do+  l <- use $ css.list+  exc <- use $ css.exception+  case (exc, ev) of+    (Just _, _) -> css.exception .= Nothing+    (_, e) -> case e of+      V.EvKey V.KEsc [] -> popState+      V.EvKey (V.KChar 'q') []  -> popState++      _ -> do zoom (css.list) $ L.handleListEventVi L.handleListEvent e+              case e of+                V.EvKey V.KEnter [] -> do+                  selected <- L.listSelectedElement <$> use (css.list)+                  case selected of+                    Just (_, "Select file from system") -> do+                      fbs <- liftIO fileBrowserState+                      goToState fbs+                    Just (i, _) -> do+                        fp <- (`S.unsafeElemAt` i) <$> use (css.recents)+                        fileOrExc <- liftIO (try (readFile fp) :: IO (Either IOError String))+                        case fileOrExc of+                          Left exc -> css.exception ?= displayException exc+                          Right file -> case parseCards file of+                            Left parseError -> css.exception ?= parseError+                            Right result -> do+                              zoom css $ addRecentInternal fp+                              params <- use parameters+                              goToState (parameterState params fp result)+                _ -> return ()++handleEvent _ = return ()++addRecentInternal ::(MonadState CSS m, MonadIO m) => FilePath -> m ()+addRecentInternal fp = do+  liftIO $ addRecent fp+  refreshRecents
src/UI/Cards.hs view
@@ -1,659 +1,663 @@-{-# LANGUAGE FlexibleContexts #-}
-module UI.Cards (Card, State(..), drawUI, handleEvent, theMap) where
-
-import Brick
-import Control.Monad
-import Control.Monad.Extra (whenM, notM, unlessM)
-import Control.Monad.IO.Class
-import Control.Monad.State.Class
-import Lens.Micro.Platform
-import Types
-import States
-import StateManagement
-import Data.Char (isSpace, toLower)
-import Data.List (sortOn)
-import Data.List.NonEmpty (NonEmpty)
-import Data.Map.Strict (Map)
-import Data.Maybe
-import Data.List.Split
-import Debug
-import Text.Wrap
-import Data.Text (pack)
-import UI.Attributes
-import UI.BrickHelpers
-import System.FilePath
-import Data.List (intercalate)
-import qualified Brick.Types as BT
-import qualified Data.List.NonEmpty as NE
-import qualified Data.Text as T
-import qualified Data.Map.Strict as M
-import qualified Brick.Widgets.Border as B
-import qualified Brick.Widgets.Border.Style as BS
-import qualified Brick.Widgets.Center as C
-import qualified Graphics.Vty as V
-
----------------------------------------------------
---------------------- DRAWING ---------------------
----------------------------------------------------
-
-drawUI :: CS -> [Widget Name]
-drawUI s =  [maybe emptyWidget (`drawPopup` s) (s^.popup), drawCardUI s <=> drawInfo s]
-
-drawInfo :: CS -> Widget Name
-drawInfo s = if not (s ^. showControls) then emptyWidget else
-  strWrap . ("Esc: quit" <>) $ case s ^. cardState of
-    DefinitionState {}     -> ", Enter: flip card / continue"
-    MultipleChoiceState {} -> ", Enter: submit answer / continue"
-    MultipleAnswerState {} -> ", Enter: select / continue, c: submit selection"
-    OpenQuestionState {}   -> ", Left/Right/Tab: navigate gaps, Enter: submit answer / continue, Shift+Tab: 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
-
-drawFooter :: CS -> Widget Name
-drawFooter s = if s^.reviewMode
-  then padLeftRight 1 $ wrong <+> progress <+> correct
-  else progress
-  -- not guaranteed that progress is horizontally centered i think
-  where progress = C.hCenter $ str (show (s^.index + 1) ++ "/" ++ show (s^.nCards))
-        wrong = withAttr wrongAttr (str ("✗ " <> show nWrong))
-        correct = withAttr correctAttr (str ("✓ " <> show nCorrect))
-        nCorrect = length (s^.correctCards)
-        nWrong = s^.index - nCorrect + (if endCard then 1 else 0)
-        endCard = maybe False (isFinalPopup . view popupState) (s^.popup)
-
-drawCardUI :: CS -> Widget Name
-drawCardUI s = 
-  let card = (s ^. shownCards) !! (s ^. index)
-  in
-  joinBorders $ 
-  drawCardBox $ 
-  drawHeader card
-  <=>
-  B.hBorder
-  <=>
-  scrollableViewportPercent 60 (CardViewport (s ^. index))
-  (drawContent s card)
-  <=>
-  str " "
-  <=>
-  drawFooter s
-
-drawHeader :: Card -> Widget Name
-drawHeader (Definition title _ _) = drawTitle title
-drawHeader (MultipleChoice question _ _ _) = drawTitle question
-drawHeader (OpenQuestion question _ _) = drawTitle question
-drawHeader (MultipleAnswer question _ _) = drawTitle question
-drawHeader (Reorder question _ _) = drawTitle question
-
-drawContent :: CS -> Card -> Widget Name
-drawContent s (Definition _ _ descr) = padLeftRight 1 $ drawDef s descr
-drawContent s (MultipleChoice _ _ correct others) = padLeftRight 1 $ drawChoices s (listMultipleChoice correct others)
-drawContent s (OpenQuestion _ _ perforated) = padLeftRight 1 $ drawPerforated s perforated
-drawContent s (MultipleAnswer _ _ options) = padRight (Pad 1) $ drawOptions s options
-drawContent s (Reorder{}) = padLeftRight 1 $ drawReorder s
-
-drawTitle :: String -> Widget n
-drawTitle title = withAttr titleAttr $
-                   padLeftRight 1 $
-                   hCenteredStrWrap title
-
-wrapSettings :: WrapSettings
-wrapSettings = defaultWrapSettings {preserveIndentation=False, breakLongWords=True}
-
-drawDescr :: String -> Widget Name
-drawDescr = strWrapWith wrapSettings
-
-drawDef :: CS -> String -> Widget Name
-drawDef s def = if s ^. showHints then drawHintedDef s def else drawNormalDef s def
-
-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: "
-
-isSpace' :: Char -> Bool
-isSpace' '\r' = True
-isSpace' a    = isSpace a
-
-drawNormalDef:: CS -> String -> Widget Name
-drawNormalDef s def = case s ^. cardState of
-  DefinitionState {_flipped=f} -> if f
-    then drawDescr def
-    else Widget Greedy Fixed $ do
-      c <- getContext
-      let w = c^.availWidthL
-      render . vBox $ [str " " | _ <- wrapTextToLines wrapSettings w (pack def)]
-  _ -> 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
-
-             where formattedOptions :: [Widget Name]
-                   formattedOptions = [ visibility $ 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
-                                            visibility = if i == j && not chosen then visible else id
-                                            coloring = case (chosen, j==k) of
-                                              (False, _)    -> id
-                                              (True, False) -> withAttr incorrectChoiceAttr
-                                              (True, True)  -> withAttr correctChoiceAttr
-                                          ]
-  _ -> error "impossible"
-
-drawOptions :: CS -> NonEmpty Option -> Widget Name
-drawOptions s = case (s ^. cardState, s ^. currentCard) of
-  (MultipleAnswerState {_highlighted=j, _selected=kvs, _entered=submitted}, _) ->
-    vBox . NE.toList .  NE.map drawOption . (`NE.zip` NE.fromList [0..])
-      where drawOption (Option kind text, i) = visibility $ coloring (str "[") <+> coloring (highlighting (str symbol)) <+> coloring (str "] ") <+> drawDescr text
-              where symbol = if (i == j && not submitted) || enabled then "*" else " "
-                    enabled = M.findWithDefault False i kvs
-                    highlighting = if i == j && not submitted then withAttr highlightedOptAttr else id
-                    visibility = if i == j && not submitted then visible else id
-                    coloring = case (submitted, enabled, kind) of
-                                  (True, True, Correct) -> withAttr correctOptAttr
-                                  (True, False, Incorrect) -> withAttr correctOptAttr
-                                  (True, _, _) -> withAttr incorrectOptAttr
-                                  (False, True, _) -> withAttr selectedOptAttr
-                                  _ -> id
-
-  _ -> error "hopefully this is never shown"
-
-
-drawPerforated :: CS -> Perforated -> Widget Name
-drawPerforated s p = drawSentence s $ perforatedToSentence p
-
-drawSentence :: CS -> Sentence -> Widget Name
-drawSentence state sentence = Widget Greedy Fixed $ do
-  c <- getContext
-  let w = c^.availWidthL
-  render $ makeSentenceWidget w state sentence
-
-makeSentenceWidget :: Int -> CS -> Sentence -> Widget Name
-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 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
-            stored = M.findWithDefault "" i kvs
-            gap = if stored == "" then "░" else stored
-            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 Ordinary (Location (textWidth gap, 0)) else id
-
-            visibility = if i == j && not submitted then visible else id
-            correct = M.findWithDefault False i cgs
-            coloring = case (submitted, correct) of
-              (False, _) -> withAttr gapAttr
-              (True, False) -> withAttr incorrectGapAttr
-              (True, True) -> withAttr correctGapAttr
-
-            gapWidget = visibility . cursor $ coloring (str gap) in
-
-              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')
-              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!"
-
-wrapStringWithPadding :: Int -> Int -> String -> ([Widget Name], Int, Bool)
-wrapStringWithPadding padding w s
-  | null (words s) = ([str ""], padding, True)
-  | 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
-        prefix = if head s `elem` ['\n', '\r'] then T.pack " " else T.empty
-        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' = prefix : (ts & _last %~ (`T.append` postfix))
-        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
-        (x: xs) = s
-        s' = if x == ' ' then xs else s
-        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'), textWidth (last ts'), False)
-
-drawReorder :: CS -> Widget Name
-drawReorder s = 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
-
-          visibility = if i == j && not submitted then visible else 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 visibility $ number <+> color (drawDescr text)
-
-  _ -> error "cardstate mismatch"
-
-----------------------------------------------------
----------------------- Events ----------------------
-----------------------------------------------------
-halt' :: EventM n GlobalState ()
-halt' = removeToModeOrQuit' beforeMoving CardSelector
-  where beforeMoving = zoom css refreshRecents
-
-scroll :: CS -> Int -> EventM Name s ()
-scroll s = scroll' $ s ^. index
-
-scroll' :: Int -> Int -> EventM Name s ()
-scroll' i = vScrollBy $ viewportScroll $ CardViewport i
-
-handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
-handleEvent (VtyEvent e) =
-  -- let update = updateCS gs
-  --     continue' = continue . update in
-  case e of
-    V.EvKey V.KEsc []          -> popStateOrQuit
-    V.EvKey V.KRight [V.MCtrl] -> (whenM.notM.use $ cs.reviewMode) next
-    V.EvKey V.KLeft  [V.MCtrl] -> (whenM.notM.use $ cs.reviewMode) previous
-
-    ev -> do
-      pUp <- use $ cs.popup
-      s <- use cs
-      flip (`maybe` (`handlePopupEvent` ev)) pUp $
-        case (s ^. cardState, s ^. currentCard) of
-          (DefinitionState{_flipped = f}, Definition {definition = d}) ->
-            case ev of
-              V.EvKey V.KEnter []  ->
-                if f || all isSpace d 
-                  then if not (s^.reviewMode) then next
-                    else cs.popup ?= correctPopup
-                  else cs.cardState.flipped %= not
-              V.EvKey V.KUp [] -> up
-              V.EvKey (V.KChar 'k') [] -> up
-              V.EvKey V.KDown [] -> down
-              V.EvKey (V.KChar 'j') [] -> down
-              _ -> return ()
-
-              where up = when f $ scroll s (-1)
-                    down = when f $ scroll s 1
-
-          (MultipleChoiceState {_highlighted = i, _number = n, _tried = kvs}, MultipleChoice _ _ (CorrectOption j _) _) ->
-            case ev of
-              V.EvKey V.KUp [] -> up
-              V.EvKey (V.KChar 'k') [] -> up
-              V.EvKey V.KDown [] -> down
-              V.EvKey (V.KChar 'j') [] -> down
-
-              V.EvKey V.KEnter [] ->
-                  if frozen
-                    then do when correctlyAnswered $ cs.correctCards %= (s^.index:)
-                            next
-                    else cs.cardState.tried %= M.insert i True
-              _ -> return ()
-
-            where frozen = M.findWithDefault False j kvs
-
-                  down = if not frozen 
-                         then when (i < n-1) $ cs.cardState.highlighted += 1
-                         else scroll s 1
-
-                  up = if not frozen 
-                       then when (i > 0) $ cs.cardState.highlighted -= 1
-                       else scroll s (-1)
-
-                  correctlyAnswered = i == j && M.size (M.filter id kvs) == 1
-
-          (MultipleAnswerState {_highlighted = i, _number = n, _entered = submitted, _selected = kvs}, MultipleAnswer _ _ opts) ->
-            case ev of
-              V.EvKey V.KUp [] -> up
-              V.EvKey (V.KChar 'k') [] -> up
-              V.EvKey V.KDown [] -> down
-              V.EvKey (V.KChar 'j') [] -> down
-
-              V.EvKey (V.KChar 'c') [] -> cs.cardState.entered .= True
-
-              V.EvKey V.KEnter [] ->
-                  if frozen
-                    then do when correctlyAnswered $ cs.correctCards %= (s^.index:)
-                            next
-                    else cs.cardState.selected %= M.adjust not i
-              V.EvKey (V.KChar '\t') [] ->
-                  if frozen
-                    then do when correctlyAnswered $ cs.correctCards %= (s^.index:)
-                            next
-                    else cs.cardState.selected %= M.adjust not i
-
-
-              _ -> return ()
-
-
-            where frozen = submitted
-
-                  down = if not frozen 
-                         then when (i < n-1) $ cs.cardState.highlighted += 1
-                         else scroll s 1
-
-                  up = if not frozen 
-                       then when (i > 0) $ cs.cardState.highlighted -= 1
-                       else scroll s (-1)
-
-                  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) ->
-            case ev of
-              V.EvKey (V.KChar '\t') [V.MShift] -> zoom (cs.cardState) $ do
-                gapInput .= correctAnswers
-                entered .= True
-                failed .= True
-                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') [] -> zoom (cs.cardState) $ do
-                if i < n - 1 && not frozen
-                  then highlighted += 1
-                  else highlighted .= 0
-
-              V.EvKey V.KRight [] -> 
-                when (i < n - 1 && not frozen) $
-                  cs.cardState.highlighted += 1
-
-              V.EvKey V.KLeft [] ->
-                when (i > 0 && not frozen) $
-                  cs.cardState.highlighted -= 1
-
-              -- C-w deletes a word back (eg. "test test" -> "test")
-              V.EvKey (V.KChar 'w') [V.MCtrl] -> zoom (cs.cardState) $ do
-                  unless frozen $ gapInput.ix i %= backword
-                where backword "" = ""
-                      backword xs = unwords . init . words $ xs
-
-              V.EvKey V.KUp [] -> up
-              V.EvKey V.KDown [] -> down
-
-              V.EvKey (V.KChar c) [] -> zoom (cs.cardState) $ do
-                  unless frozen $ gapInput.at i.non "" %= (++[c])
-                  when frozen $ case c of
-                    'k' -> up
-                    'j' -> down
-                    _ -> return ()
-
-              V.EvKey V.KEnter [] -> case (frozen, fail) of
-                (False, _) -> zoom cs $ do
-                  let sentence = perforatedToSentence perforated
-                      gaps = sentenceToGaps sentence
-
-                      wordIsCorrect :: String -> NonEmpty String -> Bool
-                      wordIsCorrect = if s^.isCaseSensitive
-                        then elem
-                        else (\word possibilites -> map toLower word `elem` NE.map (map toLower) possibilites)
-
-                  cardState.correctGaps %= M.mapWithKey (\j _ -> M.findWithDefault "" j kvs `wordIsCorrect` (gaps !! j))
-                  cardState.entered .= True
-
-                  unlessM (M.foldr (&&) True <$> use (cardState.correctGaps)) $
-                    cardState.failed .= True
-
-                (_, True) -> next
-                (_, False) -> do
-                  cs.correctCards %= (s^.index:)
-                  next
-
-              V.EvKey V.KBS [] -> unless frozen $
-                  cs.cardState.gapInput.ix i %= backspace
-                where backspace "" = ""
-                      backspace xs = init xs
-
-              _ -> return ()
-
-              where frozen = M.foldr (&&) True cGaps
-                    down = scroll s 1
-                    up = scroll s (-1)
-
-          (ReorderState {_highlighted = i, _entered = submitted, _grabbed=dragging, _number = n, _order = kvs }, Reorder _ _ elts) ->
-            case ev of
-              V.EvKey V.KUp [] -> up
-              V.EvKey (V.KChar 'k') [] -> up
-              V.EvKey V.KDown [] -> down
-              V.EvKey (V.KChar 'j') [] -> down
-              V.EvKey (V.KChar 'c') [] -> cs.cardState.entered .= True
-              V.EvKey V.KEnter [] ->
-                  if frozen
-                    then do when correct $ cs.correctCards %= (s^.index:)
-                            next
-                    else cs.cardState.grabbed %= not
-
-              _ -> return ()
-
-
-            where frozen = submitted
-
-                  down = zoom (cs.cardState) $
-                    case (frozen, i < n - 1, dragging) of
-                      (True, _, _)  -> scroll s 1
-                      (_, False, _) -> return ()
-                      (_, _, False) -> highlighted += 1
-                      (_, _, True)  -> do highlighted += 1
-                                          order %= interchange i (i+1)
-
-                  up = zoom (cs.cardState) $
-                    case (frozen, i > 0, dragging) of
-                      (True, _, _)  -> scroll s (-1)
-                      (_, False, _) -> return ()
-                      (_, _, False) -> highlighted -= 1
-                      (_, _, True)  -> do highlighted -= 1
-                                          order %= interchange i (i-1)
-
-                  correct = all (uncurry (==) . (\i -> (i+1, fst (kvs M.! i)))) [0..n-1]
-
-          _ -> error "impossible"
-handleEvent (BT.MouseDown (SBClick el (CardViewport i)) _ _ _) = handleClickScroll (scroll' i) el
-handleEvent _ = return ()
-
-next :: EventM Name GlobalState ()
-next = do
-  i <- use $ cs.index
-  sc <- use $ cs.shownCards
-  rm <- use $ cs.reviewMode
-  case (i + 1 < length sc, rm) of
-    (True, _) -> zoom cs $ do
-      fp <- use pathToFile
-      sc <- use shownCards
-      liftIO (openCardExternal (takeDirectory fp) (sc !! (i + 1))) 
-      index += 1
-      straightenState
-    (_, True) -> zoom cs $ do
-      cc <- use correctCards
-      let thePopup = 
-            if null cc || length cc == length sc
-              then finalPopup
-              else deckMakerPopup
-      popup ?= thePopup
-    _ -> halt'
-
-previous :: EventM Name GlobalState ()
-previous = zoom cs $ do
-  i <- use index
-  when (i > 0) $ do
-    fp <- use pathToFile
-    sc <- use shownCards
-    liftIO (openCardExternal (takeDirectory fp) (sc !! (i - 1))) 
-    index -= 1
-    straightenState
-
-straightenState :: MonadState CS m => m ()
-straightenState = do
-  sc <- use shownCards
-  i <- use index
-  let card = sc !! i
-  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)
-
-----------------------------------------------------
----------------------- Popups ----------------------
-----------------------------------------------------
-
-isFinalPopup :: PopupState -> Bool
-isFinalPopup FinalPopup       = True
-isFinalPopup DeckMakerPopup{} = True
-isFinalPopup _                = False
-
-correctPopup :: Popup GlobalState CS
-correctPopup = Popup drawer eventHandler initialState
-  where drawer s =
-          let selected = maybe 0 (^?! popupState.popupSelected) (s^.popup)
-              colorNo  = if selected == 0 then selectedNoButtonAttr else noButtonAttr
-              colorYes = if selected == 1 then selectedYesButtonAttr else yesButtonAttr
-              no = withAttr colorNo $ str "No"
-              yes = withAttr colorYes $ str "Yes" in
-                centerPopup $
-                B.borderWithLabel (str "Correct?") $
-                hLimit 20 $
-                str " " <=>
-                str " " <=>
-                (hFill ' ' <+> no <+> hFill ' ' <+> yes <+> hFill ' ')
-
-        initialState = CorrectPopup 0
-
-        eventHandler ev = do
-          p <- fromJust <$> use (cs.popup)
-          let ps = cs.popup._Just.popupState
-          case ev of
-            V.EvKey V.KLeft  [] -> ps.popupSelected .= 0
-            V.EvKey V.KRight [] -> ps.popupSelected .= 1
-            -- Adding vim shortcuts here
-            V.EvKey (V.KChar 'h') [] -> ps.popupSelected .= 0
-            V.EvKey (V.KChar 'l') [] -> ps.popupSelected .= 1
-
-            V.EvKey V.KEnter [] -> do
-               cs.popup .= Nothing
-               when (p ^?! popupState.popupSelected == 1) $
-                 do i <- use $ cs.index
-                    cs.correctCards %= (i:) 
-               next
-            _ -> return ()
-
-finalPopup :: Popup GlobalState CS
-finalPopup = Popup drawer eventHandler initialState
-  where drawer s =
-          let wrong    = withAttr wrongAttr   (str (" Incorrect: " <> show nWrong)   <+> hFill ' ')
-              correct  = withAttr correctAttr (str (" Correct:   " <> show nCorrect) <+> hFill ' ')
-              nCorrect = length (s^.correctCards)
-              nWrong   = s^.index + 1 - nCorrect in
-                centerPopup $
-                B.borderWithLabel (str "Finished") $
-                hLimit 20 $
-                str " " <=>
-                wrong <=>
-                correct
-
-        initialState = FinalPopup
-
-        eventHandler (V.EvKey V.KEnter []) = halt'
-        eventHandler _ = return ()
-
-deckMakerPopup :: Popup GlobalState CS
-deckMakerPopup = Popup drawer eventHandler initialState
-  where drawer s =
-          let state    = maybe initialState (view popupState) (s^.popup)
-              j = state ^?! popupSelected
-
-              makeSym lens i = case (state ^?! lens, i == j) of
-                (_, True) -> withAttr highlightedOptAttr $ str "*"
-                (True, _) -> withAttr selectedOptAttr    $ str "*"
-                _         -> withAttr selectedOptAttr    $ str " "
-
-              makeBox lens i =
-                (if state ^?! lens then withAttr selectedOptAttr else id) $
-                  str "[" <+> makeSym lens i <+> str "]"
-
-              wBox = makeBox makeDeckIncorrect 0
-              cBox = makeBox makeDeckCorrect 1
-
-              wrong    = wBox <+> withAttr wrongAttr   (str (" Incorrect: " <> show nWrong)   <+> hFill ' ')
-              correct  = cBox <+> withAttr correctAttr (str (" Correct:   " <> show nCorrect) <+> hFill ' ')
-              nCorrect = length (s^.correctCards)
-              nWrong   = s^.index + 1 - nCorrect in
-                centerPopup $
-                B.borderWithLabel (str "Generate decks") $
-                hLimit 20 $
-                str " " <=>
-                wrong <=>
-                correct <=>
-                str " " <=>
-                C.hCenter ((if j == 2 then withAttr selectedAttr else id) (str "Ok"))
-
-        initialState = DeckMakerPopup 0 False False
-
-        eventHandler ev = do
-          im <- use $ cs.indexMapping
-          ccs <- use $ cs.correctCards
-          let originalCorrects = 
-                sortOn negate (map (im !!) ccs)
-          p <- fromJust <$> use (cs.popup)
-          let ps = cs.popup._Just.popupState
-          let state = p ^. popupState
-
-          case state ^?! popupSelected of
-            0 -> case ev of
-              V.EvKey V.KEnter []      -> ps.makeDeckIncorrect %= not
-              V.EvKey V.KDown  []      -> ps.popupSelected += 1
-              V.EvKey (V.KChar 'j') [] -> ps.popupSelected += 1
-              _ -> return ()
-            1 -> case ev of
-              V.EvKey V.KEnter []      -> ps.makeDeckCorrect %= not
-              V.EvKey V.KDown  []      -> ps.popupSelected += 1
-              V.EvKey (V.KChar 'j') [] -> ps.popupSelected += 1
-              V.EvKey V.KUp  []        -> ps.popupSelected -= 1
-              V.EvKey (V.KChar 'k') [] -> ps.popupSelected -= 1
-              _ -> return ()
-            2 -> case ev of
-              V.EvKey V.KEnter []      -> do
-                fp <- use $ cs.pathToFile
-                ocs <- use $ cs.originalCards
-                liftIO $ generateDecks fp ocs originalCorrects (state ^?! makeDeckCorrect) (state ^?! makeDeckIncorrect)
-                halt'
-              V.EvKey V.KUp  []        -> ps.popupSelected -= 1
-              V.EvKey (V.KChar 'k') [] -> ps.popupSelected -= 1
-              _ -> return ()
-
-generateDecks :: FilePath -> [Card] -> [Int] -> Bool -> Bool -> IO ()
-generateDecks fp cards corrects makeCorrect makeIncorrect =
-  when (makeCorrect || makeIncorrect) $
-    do let (correct, incorrect) = splitCorrectIncorrect cards corrects
-       when makeCorrect   $ writeFile (replaceBaseName fp (takeBaseName fp <> "+")) (cardsToString correct)
-       when makeIncorrect $ writeFile (replaceBaseName fp (takeBaseName fp <> "-")) (cardsToString incorrect)
-
--- gets list of cards, list of indices of correct cards in decreasing order; returns (correct, incorrect)
-splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])
-splitCorrectIncorrect cards indices = doSplit [] [] (zip [0..] cards) (reverse indices)
-  where doSplit cs ws [] _  = (reverse cs, reverse ws)
-        doSplit cs ws ((_, x):xs) [] = doSplit cs (x:ws) xs []
-        doSplit cs ws ((j, x):xs) (i:is) =
-          if i == j
-            then doSplit (x:cs) ws xs is
-            else doSplit cs (x:ws) xs (i:is)
+{-# LANGUAGE FlexibleContexts #-}+module UI.Cards (Card, State(..), drawUI, handleEvent, theMap) where++import Brick+import Control.Monad+import Control.Monad.Extra (whenM, notM, unlessM)+import Control.Monad.IO.Class+import Control.Monad.State.Class+import Lens.Micro.Platform+import Types+import States+import StateManagement+import Data.Char (isSpace, toLower)+import Data.List (sortOn)+import Data.List.NonEmpty (NonEmpty)+import Data.Map.Strict (Map)+import Data.Maybe+import Data.List.Split+import Debug+import Text.Wrap+import Data.Text (pack)+import UI.Attributes+import UI.BrickHelpers+import System.FilePath+import Data.List (intercalate)+import qualified Brick.Types as BT+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+import qualified Data.Map.Strict as M+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Border.Style as BS+import qualified Brick.Widgets.Center as C+import qualified Graphics.Vty as V++---------------------------------------------------+--------------------- DRAWING ---------------------+---------------------------------------------------++drawUI :: CS -> [Widget Name]+drawUI s =  [maybe emptyWidget (`drawPopup` s) (s^.popup), drawCardUI s <=> drawInfo s]++drawInfo :: CS -> Widget Name+drawInfo s = if not (s ^. showControls) then emptyWidget else+  strWrap . ("Esc: quit" <>) $ case s ^. cardState of+    DefinitionState {}     -> ", Enter: flip card / continue"+    MultipleChoiceState {} -> ", Enter: submit answer / continue"+    MultipleAnswerState {} -> ", Enter: select / continue, c: submit selection"+    OpenQuestionState {}   -> ", Left/Right/Tab: navigate gaps, Enter: submit answer / continue"+    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++drawFooter :: CS -> Widget Name+drawFooter s = if s^.reviewMode+  then padLeftRight 1 $ wrong <+> progress <+> correct+  else progress+  -- not guaranteed that progress is horizontally centered i think+  where progress = C.hCenter $ str (show (s^.index + 1) ++ "/" ++ show (s^.nCards))+        wrong = withAttr wrongAttr (str ("✗ " <> show nWrong))+        correct = withAttr correctAttr (str ("✓ " <> show nCorrect))+        nCorrect = length (s^.correctCards)+        nWrong = s^.index - nCorrect + (if endCard then 1 else 0)+        endCard = maybe False (isFinalPopup . view popupState) (s^.popup)++drawCardUI :: CS -> Widget Name+drawCardUI s = +  let card = (s ^. shownCards) !! (s ^. index)+  in+  joinBorders $ +  drawCardBox $ +  drawHeader card+  <=>+  B.hBorder+  <=>+  scrollableViewportPercent 60 (CardViewport (s ^. index))+  (drawContent s card)+  <=>+  str " "+  <=>+  drawFooter s++drawHeader :: Card -> Widget Name+drawHeader (Definition title _ _) = drawTitle title+drawHeader (MultipleChoice question _ _ _) = drawTitle question+drawHeader (OpenQuestion question _ _) = drawTitle question+drawHeader (MultipleAnswer question _ _) = drawTitle question+drawHeader (Reorder question _ _) = drawTitle question++drawContent :: CS -> Card -> Widget Name+drawContent s (Definition _ _ descr) = padLeftRight 1 $ drawDef s descr+drawContent s (MultipleChoice _ _ correct others) = padLeftRight 1 $ drawChoices s (listMultipleChoice correct others)+drawContent s (OpenQuestion _ _ perforated) = padLeftRight 1 $ drawPerforated s perforated+drawContent s (MultipleAnswer _ _ options) = padRight (Pad 1) $ drawOptions s options+drawContent s (Reorder{}) = padLeftRight 1 $ drawReorder s++drawTitle :: String -> Widget n+drawTitle title = withAttr titleAttr $+                   padLeftRight 1 $+                   hCenteredStrWrap title++wrapSettings :: WrapSettings+wrapSettings = defaultWrapSettings {preserveIndentation=False, breakLongWords=True}++drawDescr :: String -> Widget Name+drawDescr = strWrapWith wrapSettings++drawDef :: CS -> String -> Widget Name+drawDef s def = if s ^. showHints then drawHintedDef s def else drawNormalDef s def++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: "++isSpace' :: Char -> Bool+isSpace' '\r' = True+isSpace' a    = isSpace a++drawNormalDef:: CS -> String -> Widget Name+drawNormalDef s def = case s ^. cardState of+  DefinitionState {_flipped=f} -> if f+    then drawDescr def+    else Widget Greedy Fixed $ do+      c <- getContext+      let w = c^.availWidthL+      render . vBox $ [str " " | _ <- wrapTextToLines wrapSettings w (pack def)]+  _ -> 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++             where formattedOptions :: [Widget Name]+                   formattedOptions = [ visibility $ 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+                                            visibility = if i == j && not chosen then visible else id+                                            coloring = case (chosen, j==k) of+                                              (False, _)    -> id+                                              (True, False) -> withAttr incorrectChoiceAttr+                                              (True, True)  -> withAttr correctChoiceAttr+                                          ]+  _ -> error "impossible"++drawOptions :: CS -> NonEmpty Option -> Widget Name+drawOptions s = case (s ^. cardState, s ^. currentCard) of+  (MultipleAnswerState {_highlighted=j, _selected=kvs, _entered=submitted}, _) ->+    vBox . NE.toList .  NE.map drawOption . (`NE.zip` NE.fromList [0..])+      where drawOption (Option kind text, i) = visibility $ coloring (str "[") <+> coloring (highlighting (str symbol)) <+> coloring (str "] ") <+> drawDescr text+              where symbol = if (i == j && not submitted) || enabled then "*" else " "+                    enabled = M.findWithDefault False i kvs+                    highlighting = if i == j && not submitted then withAttr highlightedOptAttr else id+                    visibility = if i == j && not submitted then visible else id+                    coloring = case (submitted, enabled, kind) of+                                  (True, True, Correct) -> withAttr correctOptAttr+                                  (True, False, Incorrect) -> withAttr correctOptAttr+                                  (True, _, _) -> withAttr incorrectOptAttr+                                  (False, True, _) -> withAttr selectedOptAttr+                                  _ -> id++  _ -> error "hopefully this is never shown"+++drawPerforated :: CS -> Perforated -> Widget Name+drawPerforated s p = drawSentence s $ perforatedToSentence p++drawSentence :: CS -> Sentence -> Widget Name+drawSentence state sentence = Widget Greedy Fixed $ do+  c <- getContext+  let w = c^.availWidthL+  render $ makeSentenceWidget w state sentence++makeSentenceWidget :: Int -> CS -> Sentence -> Widget Name+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 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+            stored = M.findWithDefault "" i kvs+            gap = if stored == "" then "░" else stored+            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 Ordinary (Location (textWidth gap, 0)) else id++            visibility = if i == j && not submitted then visible else id+            correct = M.findWithDefault False i cgs+            coloring = case (submitted, correct) of+              (False, _) -> withAttr gapAttr+              (True, False) -> withAttr incorrectGapAttr+              (True, True) -> withAttr correctGapAttr++            gapWidget = visibility . cursor $ coloring (str gap) in++              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')+              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!"++wrapStringWithPadding :: Int -> Int -> String -> ([Widget Name], Int, Bool)+wrapStringWithPadding padding w s+  | null (words s) = ([str ""], padding, True)+  | 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+        prefix = if head s `elem` ['\n', '\r'] then T.pack " " else T.empty+        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' = prefix : (ts & _last %~ (`T.append` postfix))+        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+        (x: xs) = s+        s' = if x == ' ' then xs else s+        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'), textWidth (last ts'), False)++drawReorder :: CS -> Widget Name+drawReorder s = 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++          visibility = if i == j && not submitted then visible else 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 visibility $ number <+> color (drawDescr text)++  _ -> error "cardstate mismatch"++----------------------------------------------------+---------------------- Events ----------------------+----------------------------------------------------+halt' :: EventM n GlobalState ()+halt' = removeToModeOrQuit' beforeMoving CardSelector+  where beforeMoving = zoom css refreshRecents++scroll :: CS -> Int -> EventM Name s ()+scroll s = scroll' $ s ^. index++scroll' :: Int -> Int -> EventM Name s ()+scroll' i = vScrollBy $ viewportScroll $ CardViewport i++handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()+handleEvent (VtyEvent e) =+  -- let update = updateCS gs+  --     continue' = continue . update in+  case e of+    V.EvKey V.KEsc []          -> popStateOrQuit+    V.EvKey V.KRight [V.MCtrl] -> (whenM.notM.use $ cs.reviewMode) next+    V.EvKey V.KLeft  [V.MCtrl] -> (whenM.notM.use $ cs.reviewMode) previous++    ev -> do+      pUp <- use $ cs.popup+      s <- use cs+      flip (`maybe` (`handlePopupEvent` ev)) pUp $+        case (s ^. cardState, s ^. currentCard) of+          (DefinitionState{_flipped = f}, Definition {definition = d}) ->+            case ev of+              V.EvKey V.KEnter []  ->+                if f || all isSpace d +                  then if not (s^.reviewMode) then next+                    else cs.popup ?= correctPopup+                  else cs.cardState.flipped %= not+              V.EvKey V.KUp [] -> up+              V.EvKey (V.KChar 'k') [] -> up+              V.EvKey V.KDown [] -> down+              V.EvKey (V.KChar 'j') [] -> down+              _ -> return ()++              where up = when f $ scroll s (-1)+                    down = when f $ scroll s 1++          (MultipleChoiceState {_highlighted = i, _number = n, _tried = kvs}, MultipleChoice _ _ (CorrectOption j _) _) ->+            case ev of+              V.EvKey V.KUp [] -> up+              V.EvKey (V.KChar 'k') [] -> up+              V.EvKey V.KDown [] -> down+              V.EvKey (V.KChar 'j') [] -> down++              V.EvKey V.KEnter [] ->+                  if frozen+                    then do when correctlyAnswered $ cs.correctCards %= (s^.index:)+                            next+                    else cs.cardState.tried %= M.insert i True+              _ -> return ()++            where frozen = M.findWithDefault False j kvs++                  down = if not frozen +                         then when (i < n-1) $ cs.cardState.highlighted += 1+                         else scroll s 1++                  up = if not frozen +                       then when (i > 0) $ cs.cardState.highlighted -= 1+                       else scroll s (-1)++                  correctlyAnswered = i == j && M.size (M.filter id kvs) == 1++          (MultipleAnswerState {_highlighted = i, _number = n, _entered = submitted, _selected = kvs}, MultipleAnswer _ _ opts) ->+            case ev of+              V.EvKey V.KUp [] -> up+              V.EvKey (V.KChar 'k') [] -> up+              V.EvKey V.KDown [] -> down+              V.EvKey (V.KChar 'j') [] -> down++              V.EvKey (V.KChar 'c') [] -> cs.cardState.entered .= True++              V.EvKey V.KEnter [] ->+                  if frozen+                    then do when correctlyAnswered $ cs.correctCards %= (s^.index:)+                            next+                    else cs.cardState.selected %= M.adjust not i+              V.EvKey (V.KChar '\t') [] ->+                  if frozen+                    then do when correctlyAnswered $ cs.correctCards %= (s^.index:)+                            next+                    else cs.cardState.selected %= M.adjust not i+++              _ -> return ()+++            where frozen = submitted++                  down = if not frozen +                         then when (i < n-1) $ cs.cardState.highlighted += 1+                         else scroll s 1++                  up = if not frozen +                       then when (i > 0) $ cs.cardState.highlighted -= 1+                       else scroll s (-1)++                  correctlyAnswered = NE.toList (NE.map isOptionCorrect opts) == map snd (M.toAscList kvs)++          (OpenQuestionState {_highlighted = i, _number = n, _gapInput = kvs, _correctGaps = cGaps, _failed=fail, _previousInput = pkvs}, OpenQuestion _ _ perforated) ->+            let frozen = M.foldr (&&) True cGaps+                down = scroll s 1+                up = scroll s (-1) in+            case ev of+              V.EvKey (V.KChar '\t') [] -> zoom (cs.cardState) $ do+                if i < n - 1 && not frozen+                  then highlighted += 1+                  else highlighted .= 0++              V.EvKey V.KRight [] -> +                when (i < n - 1 && not frozen) $+                  cs.cardState.highlighted += 1++              V.EvKey V.KLeft [] ->+                when (i > 0 && not frozen) $+                  cs.cardState.highlighted -= 1++              -- C-w deletes a word back (eg. "test test" -> "test")+              V.EvKey (V.KChar 'w') [V.MCtrl] -> zoom (cs.cardState) $ do+                  unless frozen $ gapInput.ix i %= backword+                where backword "" = ""+                      backword xs = unwords . init . words $ xs++              V.EvKey V.KUp [] -> up+              V.EvKey V.KDown [] -> down++              V.EvKey (V.KChar c) [] -> zoom (cs.cardState) $ do+                  unless frozen $ gapInput.at i.non "" %= (++[c])+                  when frozen $ case c of+                    'k' -> up+                    'j' -> down+                    _ -> return ()++              V.EvKey V.KEnter [] -> case (frozen, fail) of+                (False, _) -> zoom (cs.cardState) $ do+                  let sentence = perforatedToSentence perforated+                      gaps = sentenceToGaps sentence++                      wordIsCorrect :: String -> NonEmpty String -> Bool+                      wordIsCorrect = if s^.isCaseSensitive+                        then elem+                        else (\word possibilites -> map toLower word `elem` NE.map (map toLower) possibilites)++                      allEmpty = all null kvs+                      sameAsPrevious = kvs == pkvs++                  correctGaps %= M.mapWithKey (\j _ -> M.findWithDefault "" j kvs `wordIsCorrect` (gaps !! j))+                  entered .= True++                  allCorrect <- M.foldr (&&) True <$> use correctGaps++                  when (allEmpty && not allCorrect || sameAsPrevious) $ do+                    let correctAnswers = M.fromAscList $ zip [0..] $ map NE.head (sentenceToGaps (perforatedToSentence perforated))+                    correctGaps .= M.fromAscList [(i, True) | i <- [0..n-1]]+                    gapInput .= correctAnswers++                  unless allCorrect $+                    failed .= True++                  previousInput .= kvs++                (_, True) -> next+                (_, False) -> do+                  cs.correctCards %= (s^.index:)+                  next++              V.EvKey V.KBS [] -> unless frozen $+                  cs.cardState.gapInput.ix i %= backspace+                where backspace "" = ""+                      backspace xs = init xs++              _ -> return ()++          (ReorderState {_highlighted = i, _entered = submitted, _grabbed=dragging, _number = n, _order = kvs }, Reorder _ _ elts) ->+            case ev of+              V.EvKey V.KUp [] -> up+              V.EvKey (V.KChar 'k') [] -> up+              V.EvKey V.KDown [] -> down+              V.EvKey (V.KChar 'j') [] -> down+              V.EvKey (V.KChar 'c') [] -> cs.cardState.entered .= True+              V.EvKey V.KEnter [] ->+                  if frozen+                    then do when correct $ cs.correctCards %= (s^.index:)+                            next+                    else cs.cardState.grabbed %= not++              _ -> return ()+++            where frozen = submitted++                  down = zoom (cs.cardState) $+                    case (frozen, i < n - 1, dragging) of+                      (True, _, _)  -> scroll s 1+                      (_, False, _) -> return ()+                      (_, _, False) -> highlighted += 1+                      (_, _, True)  -> do highlighted += 1+                                          order %= interchange i (i+1)++                  up = zoom (cs.cardState) $+                    case (frozen, i > 0, dragging) of+                      (True, _, _)  -> scroll s (-1)+                      (_, False, _) -> return ()+                      (_, _, False) -> highlighted -= 1+                      (_, _, True)  -> do highlighted -= 1+                                          order %= interchange i (i-1)++                  correct = all (uncurry (==) . (\i -> (i+1, fst (kvs M.! i)))) [0..n-1]++          _ -> error "impossible"+handleEvent (BT.MouseDown (SBClick el (CardViewport i)) _ _ _) = handleClickScroll (scroll' i) el+handleEvent _ = return ()++next :: EventM Name GlobalState ()+next = do+  i <- use $ cs.index+  sc <- use $ cs.shownCards+  rm <- use $ cs.reviewMode+  case (i + 1 < length sc, rm) of+    (True, _) -> zoom cs $ do+      fp <- use pathToFile+      sc <- use shownCards+      liftIO (openCardExternal (takeDirectory fp) (sc !! (i + 1))) +      index += 1+      straightenState+    (_, True) -> zoom cs $ do+      cc <- use correctCards+      let thePopup = +            if null cc || length cc == length sc+              then finalPopup+              else deckMakerPopup+      popup ?= thePopup+    _ -> halt'++previous :: EventM Name GlobalState ()+previous = zoom cs $ do+  i <- use index+  when (i > 0) $ do+    fp <- use pathToFile+    sc <- use shownCards+    liftIO (openCardExternal (takeDirectory fp) (sc !! (i - 1))) +    index -= 1+    straightenState++straightenState :: MonadState CS m => m ()+straightenState = do+  sc <- use shownCards+  i <- use index+  let card = sc !! i+  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)++----------------------------------------------------+---------------------- Popups ----------------------+----------------------------------------------------++isFinalPopup :: PopupState -> Bool+isFinalPopup FinalPopup       = True+isFinalPopup DeckMakerPopup{} = True+isFinalPopup _                = False++correctPopup :: Popup GlobalState CS+correctPopup = Popup drawer eventHandler initialState+  where drawer s =+          let selected = maybe 0 (^?! popupState.popupSelected) (s^.popup)+              colorNo  = if selected == 0 then selectedNoButtonAttr else noButtonAttr+              colorYes = if selected == 1 then selectedYesButtonAttr else yesButtonAttr+              no = withAttr colorNo $ str "No"+              yes = withAttr colorYes $ str "Yes" in+                centerPopup $+                B.borderWithLabel (str "Correct?") $+                hLimit 20 $+                str " " <=>+                str " " <=>+                (hFill ' ' <+> no <+> hFill ' ' <+> yes <+> hFill ' ')++        initialState = CorrectPopup 0++        eventHandler ev = do+          p <- fromJust <$> use (cs.popup)+          let ps = cs.popup._Just.popupState+          case ev of+            V.EvKey V.KLeft  [] -> ps.popupSelected .= 0+            V.EvKey V.KRight [] -> ps.popupSelected .= 1+            -- Adding vim shortcuts here+            V.EvKey (V.KChar 'h') [] -> ps.popupSelected .= 0+            V.EvKey (V.KChar 'l') [] -> ps.popupSelected .= 1++            V.EvKey V.KEnter [] -> do+               cs.popup .= Nothing+               when (p ^?! popupState.popupSelected == 1) $+                 do i <- use $ cs.index+                    cs.correctCards %= (i:) +               next+            _ -> return ()++finalPopup :: Popup GlobalState CS+finalPopup = Popup drawer eventHandler initialState+  where drawer s =+          let wrong    = withAttr wrongAttr   (str (" Incorrect: " <> show nWrong)   <+> hFill ' ')+              correct  = withAttr correctAttr (str (" Correct:   " <> show nCorrect) <+> hFill ' ')+              nCorrect = length (s^.correctCards)+              nWrong   = s^.index + 1 - nCorrect in+                centerPopup $+                B.borderWithLabel (str "Finished") $+                hLimit 20 $+                str " " <=>+                wrong <=>+                correct++        initialState = FinalPopup++        eventHandler (V.EvKey V.KEnter []) = halt'+        eventHandler _ = return ()++deckMakerPopup :: Popup GlobalState CS+deckMakerPopup = Popup drawer eventHandler initialState+  where drawer s =+          let state    = maybe initialState (view popupState) (s^.popup)+              j = state ^?! popupSelected++              makeSym lens i = case (state ^?! lens, i == j) of+                (_, True) -> withAttr highlightedOptAttr $ str "*"+                (True, _) -> withAttr selectedOptAttr    $ str "*"+                _         -> withAttr selectedOptAttr    $ str " "++              makeBox lens i =+                (if state ^?! lens then withAttr selectedOptAttr else id) $+                  str "[" <+> makeSym lens i <+> str "]"++              wBox = makeBox makeDeckIncorrect 0+              cBox = makeBox makeDeckCorrect 1++              wrong    = wBox <+> withAttr wrongAttr   (str (" Incorrect: " <> show nWrong)   <+> hFill ' ')+              correct  = cBox <+> withAttr correctAttr (str (" Correct:   " <> show nCorrect) <+> hFill ' ')+              nCorrect = length (s^.correctCards)+              nWrong   = s^.index + 1 - nCorrect in+                centerPopup $+                B.borderWithLabel (str "Generate decks") $+                hLimit 20 $+                str " " <=>+                wrong <=>+                correct <=>+                str " " <=>+                C.hCenter ((if j == 2 then withAttr selectedAttr else id) (str "Ok"))++        initialState = DeckMakerPopup 0 False False++        eventHandler ev = do+          im <- use $ cs.indexMapping+          ccs <- use $ cs.correctCards+          let originalCorrects = +                sortOn negate (map (im !!) ccs)+          p <- fromJust <$> use (cs.popup)+          let ps = cs.popup._Just.popupState+          let state = p ^. popupState++          case state ^?! popupSelected of+            0 -> case ev of+              V.EvKey V.KEnter []      -> ps.makeDeckIncorrect %= not+              V.EvKey V.KDown  []      -> ps.popupSelected += 1+              V.EvKey (V.KChar 'j') [] -> ps.popupSelected += 1+              _ -> return ()+            1 -> case ev of+              V.EvKey V.KEnter []      -> ps.makeDeckCorrect %= not+              V.EvKey V.KDown  []      -> ps.popupSelected += 1+              V.EvKey (V.KChar 'j') [] -> ps.popupSelected += 1+              V.EvKey V.KUp  []        -> ps.popupSelected -= 1+              V.EvKey (V.KChar 'k') [] -> ps.popupSelected -= 1+              _ -> return ()+            2 -> case ev of+              V.EvKey V.KEnter []      -> do+                fp <- use $ cs.pathToFile+                ocs <- use $ cs.originalCards+                liftIO $ generateDecks fp ocs originalCorrects (state ^?! makeDeckCorrect) (state ^?! makeDeckIncorrect)+                halt'+              V.EvKey V.KUp  []        -> ps.popupSelected -= 1+              V.EvKey (V.KChar 'k') [] -> ps.popupSelected -= 1+              _ -> return ()++generateDecks :: FilePath -> [Card] -> [Int] -> Bool -> Bool -> IO ()+generateDecks fp cards corrects makeCorrect makeIncorrect =+  when (makeCorrect || makeIncorrect) $+    do let (correct, incorrect) = splitCorrectIncorrect cards corrects+       when makeCorrect   $ writeFile (replaceBaseName fp (takeBaseName fp <> "+")) (cardsToString correct)+       when makeIncorrect $ writeFile (replaceBaseName fp (takeBaseName fp <> "-")) (cardsToString incorrect)++-- gets list of cards, list of indices of correct cards in decreasing order; returns (correct, incorrect)+splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])+splitCorrectIncorrect cards indices = doSplit [] [] (zip [0..] cards) (reverse indices)+  where doSplit cs ws [] _  = (reverse cs, reverse ws)+        doSplit cs ws ((_, x):xs) [] = doSplit cs (x:ws) xs []+        doSplit cs ws ((j, x):xs) (i:is) =+          if i == j+            then doSplit (x:cs) ws xs is+            else doSplit cs (x:ws) xs (i:is)
src/UI/FileBrowser.hs view
@@ -1,84 +1,84 @@-{-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}
-
-module UI.FileBrowser (State, drawUI, handleEvent, theMap) where
-
-import Brick
-import Brick.Widgets.Border
-import Brick.Widgets.Center
-import Brick.Widgets.List
-import Brick.Widgets.FileBrowser
-import Control.Exception (displayException, try)
-import Control.Monad.IO.Class
-import Lens.Micro.Platform
-import Parser
-import States
-import StateManagement
-import Recents
-import Runners
-import UI.BrickHelpers
-import qualified UI.Attributes as A
-import qualified Graphics.Vty as V
-
-theMap :: AttrMap
-theMap = applyAttrMappings
-    [ (listSelectedFocusedAttr, V.black `on` V.yellow)
-    , (fileBrowserCurrentDirectoryAttr, V.white `on` V.blue)
-    , (fileBrowserSelectionInfoAttr, V.white `on` V.blue)
-    , (fileBrowserDirectoryAttr, fg V.blue)
-    , (fileBrowserBlockDeviceAttr, fg V.magenta)
-    , (fileBrowserCharacterDeviceAttr, fg V.green)
-    , (fileBrowserNamedPipeAttr, fg V.yellow)
-    , (fileBrowserSymbolicLinkAttr, fg V.cyan)
-    , (fileBrowserUnixSocketAttr, fg V.red)
-    , (fileBrowserSelectedAttr, V.white `on` V.magenta)
-    ] A.theMap
-
-drawUI :: FBS -> [Widget Name]
-drawUI FBS{_fb=b, _exception'=exc} = [drawException exc, center $ ui <=> help]
-    where
-        ui = hCenter $
-             vLimit 15 $
-             hLimit 50 $
-             borderWithLabel (txt "Choose a file") $
-             renderFileBrowser True b
-        help = padTop (Pad 1) $
-               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 or q: quit"
-                    ]
-
-handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
-handleEvent (VtyEvent ev) = do
-    excep <- use $ fbs.exception'
-    b <- use $ fbs.fb
-    case (excep, ev) of
-      (Just _, _) -> fbs.exception' .= Nothing
-      (_, e) -> case e of
-        V.EvKey V.KEsc [] | not (fileBrowserIsSearching b) -> popState
-        V.EvKey (V.KChar 'q') [] | not (fileBrowserIsSearching b) -> popState
-        V.EvKey (V.KChar 'h') [] | not (fileBrowserIsSearching b) -> do
-            fbs.showHidden %= not
-            eFilter <- Just . entryFilter <$> use (fbs.showHidden)
-            fbs.fb .= setFileBrowserEntryFilter eFilter b
-        _ -> do
-            zoom (fbs.fb) $ handleFileBrowserEvent ev
-            b' <- use $ fbs.fb
-            case (ev, fileBrowserSelection b') of
-                (V.EvKey V.KEnter [], []) -> return ()
-                (V.EvKey V.KEnter [], [fileInfo]) -> do
-                    let fp = fileInfoFilePath fileInfo
-                    fileOrExc <- liftIO (try (readFile fp) :: IO (Either IOError String))
-                    case fileOrExc of
-                        Left exc -> fbs.exception' ?= displayException exc
-                        Right file -> case parseCards file of
-                            Left parseError -> fbs.exception' ?= parseError
-                            Right result -> do
-                                    liftIO $ addRecent fp
-                                    zoom css refreshRecents
-                                    params <- use parameters
-                                    goToState $ parameterState params fp result
-                (V.EvKey V.KEnter [], _) -> popState
-                _ -> return ()
-handleEvent _ = return ()
+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}++module UI.FileBrowser (State, drawUI, handleEvent, theMap) where++import Brick+import Brick.Widgets.Border+import Brick.Widgets.Center+import Brick.Widgets.List+import Brick.Widgets.FileBrowser+import Control.Exception (displayException, try)+import Control.Monad.IO.Class+import Lens.Micro.Platform+import Parser+import States+import StateManagement+import Recents+import Runners+import UI.BrickHelpers+import qualified UI.Attributes as A+import qualified Graphics.Vty as V++theMap :: AttrMap+theMap = applyAttrMappings+    [ (listSelectedFocusedAttr, V.black `on` V.yellow)+    , (fileBrowserCurrentDirectoryAttr, V.white `on` V.blue)+    , (fileBrowserSelectionInfoAttr, V.white `on` V.blue)+    , (fileBrowserDirectoryAttr, fg V.blue)+    , (fileBrowserBlockDeviceAttr, fg V.magenta)+    , (fileBrowserCharacterDeviceAttr, fg V.green)+    , (fileBrowserNamedPipeAttr, fg V.yellow)+    , (fileBrowserSymbolicLinkAttr, fg V.cyan)+    , (fileBrowserUnixSocketAttr, fg V.red)+    , (fileBrowserSelectedAttr, V.white `on` V.magenta)+    ] A.theMap++drawUI :: FBS -> [Widget Name]+drawUI FBS{_fb=b, _exception'=exc} = [drawException exc, center $ ui <=> help]+    where+        ui = hCenter $+             vLimit 15 $+             hLimit 50 $+             borderWithLabel (txt "Choose a file") $+             renderFileBrowser True b+        help = padTop (Pad 1) $+               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 or q: quit"+                    ]++handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()+handleEvent (VtyEvent ev) = do+    excep <- use $ fbs.exception'+    b <- use $ fbs.fb+    case (excep, ev) of+      (Just _, _) -> fbs.exception' .= Nothing+      (_, e) -> case e of+        V.EvKey V.KEsc [] | not (fileBrowserIsSearching b) -> popState+        V.EvKey (V.KChar 'q') [] | not (fileBrowserIsSearching b) -> popState+        V.EvKey (V.KChar 'h') [] | not (fileBrowserIsSearching b) -> do+            fbs.showHidden %= not+            eFilter <- Just . entryFilter <$> use (fbs.showHidden)+            fbs.fb .= setFileBrowserEntryFilter eFilter b+        _ -> do+            zoom (fbs.fb) $ handleFileBrowserEvent ev+            b' <- use $ fbs.fb+            case (ev, fileBrowserSelection b') of+                (V.EvKey V.KEnter [], []) -> return ()+                (V.EvKey V.KEnter [], [fileInfo]) -> do+                    let fp = fileInfoFilePath fileInfo+                    fileOrExc <- liftIO (try (readFile fp) :: IO (Either IOError String))+                    case fileOrExc of+                        Left exc -> fbs.exception' ?= displayException exc+                        Right file -> case parseCards file of+                            Left parseError -> fbs.exception' ?= parseError+                            Right result -> do+                                    liftIO $ addRecent fp+                                    zoom css refreshRecents+                                    params <- use parameters+                                    goToState $ parameterState params fp result+                (V.EvKey V.KEnter [], _) -> popState+                _ -> return ()+handleEvent _ = return ()
src/UI/Info.hs view
@@ -1,72 +1,70 @@-module UI.Info (State, drawUI, handleEvent, theMap) where
-
-import Brick
-import Brick.Widgets.Border
-import Brick.Widgets.Border.Style
-import Brick.Widgets.Center
-import States
-import StateManagement
-import qualified Brick.Types as T
-import qualified Graphics.Vty as V
-import UI.BrickHelpers
-
-drawUI :: IS -> [Widget Name]
-drawUI = (:[]) . const ui
-
-ui :: Widget Name
-ui =
-  joinBorders $
-  center $
-  withBorderStyle unicodeRounded $
-  border $
-  hLimit 40 $
-  hCenter (withAttr titleAttr (str "Info")) <=>
-  hBorder <=>
-  drawInfo
-
-scroll :: Int -> EventM Name s ()
-scroll = vScrollBy (viewportScroll InfoViewport)
-
-handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
-handleEvent (VtyEvent e) = do
-  case e of
-    V.EvKey V.KEsc [] -> popState
-    V.EvKey (V.KChar 'q') [] -> popState
-    V.EvKey V.KEnter [] -> popState
-    V.EvKey V.KDown [] -> scroll 1
-    V.EvKey (V.KChar 'j') [] -> scroll 1
-    V.EvKey V.KUp [] -> scroll (-1)
-    V.EvKey (V.KChar 'k') [] -> scroll (-1)
-    _ -> return ()
-handleEvent (T.MouseDown (SBClick el InfoViewport) _ _ _) = handleClickScroll scroll el
-handleEvent _ = return ()
-
-titleAttr :: AttrName
-titleAttr = attrName "title"
-
-theMap :: AttrMap
-theMap = attrMap V.defAttr
-    [ (titleAttr, fg V.yellow) ]
-
-drawInfo :: Widget Name
-drawInfo =
-  padLeft (Pad 1) $
-  scrollableViewportPercent 60 InfoViewport $
-  strWrap info
-
-info :: String
-info = unlines
-  [ "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."
-  , ""
-  , "Controls:"
-  , " * Use arrows or the j and k keys for menu navigation"
-  , ""
-  , " * Enter confirms a selection, flips a card or continues to the next card"
-  , ""
-  , " * Use Tab or the arrow keys for navigating gaps in open questions"
-  , ""
-  , " * Use the c key for confirming reorder questions or multiple choice questions with more than 1 possible answer"
-  , ""
-  , " * Use Shift+Tab to show the answers of a open question"
-  , ""
-  , " * Use Ctrl+Left and Ctrl+Right to move to previous and next cards without having to answer them; this is disabled in review mode"]
+module UI.Info (State, drawUI, handleEvent, theMap) where++import Brick+import Brick.Widgets.Border+import Brick.Widgets.Border.Style+import Brick.Widgets.Center+import States+import StateManagement+import qualified Brick.Types as T+import qualified Graphics.Vty as V+import UI.BrickHelpers++drawUI :: IS -> [Widget Name]+drawUI = (:[]) . const ui++ui :: Widget Name+ui =+  joinBorders $+  center $+  withBorderStyle unicodeRounded $+  border $+  hLimit 40 $+  hCenter (withAttr titleAttr (str "Info")) <=>+  hBorder <=>+  drawInfo++scroll :: Int -> EventM Name s ()+scroll = vScrollBy (viewportScroll InfoViewport)++handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()+handleEvent (VtyEvent e) = do+  case e of+    V.EvKey V.KEsc [] -> popState+    V.EvKey (V.KChar 'q') [] -> popState+    V.EvKey V.KEnter [] -> popState+    V.EvKey V.KDown [] -> scroll 1+    V.EvKey (V.KChar 'j') [] -> scroll 1+    V.EvKey V.KUp [] -> scroll (-1)+    V.EvKey (V.KChar 'k') [] -> scroll (-1)+    _ -> return ()+handleEvent (T.MouseDown (SBClick el InfoViewport) _ _ _) = handleClickScroll scroll el+handleEvent _ = return ()++titleAttr :: AttrName+titleAttr = attrName "title"++theMap :: AttrMap+theMap = attrMap V.defAttr+    [ (titleAttr, fg V.yellow) ]++drawInfo :: Widget Name+drawInfo =+  padLeft (Pad 1) $+  scrollableViewportPercent 60 InfoViewport $+  strWrap info++info :: String+info = unlines+  [ "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."+  , ""+  , "Controls:"+  , " * Use arrows or the j and k keys for menu navigation"+  , ""+  , " * Enter confirms a selection, flips a card or continues to the next card"+  , ""+  , " * Use Tab or the arrow keys for navigating gaps in open questions"+  , ""+  , " * Use the c key for confirming reorder questions or multiple choice questions with more than 1 possible answer"+  , ""+  , " * Use Ctrl+Left and Ctrl+Right to move to previous and next cards without having to answer them; this is disabled in review mode"]
src/UI/MainMenu.hs view
@@ -1,61 +1,61 @@-module UI.MainMenu (State (..), drawUI, handleEvent, theMap) where
-
-import Brick
-import Brick.Widgets.Border
-import Brick.Widgets.Border.Style
-import Brick.Widgets.Center
-import Control.Monad.IO.Class
-import Lens.Micro.Platform
-import Runners
-import Settings
-import States
-import StateManagement
-import UI.Attributes
-import UI.BrickHelpers
-import qualified Graphics.Vty as V
-import qualified Brick.Widgets.List as L
-
-title :: Widget Name
-title = withAttr titleAttr $
-        str "┬ ┬┌─┐┌─┐┌─┐┌─┐┬─┐┌┬┐" <=>
-        str "├─┤├─┤└─┐│  ├─┤├┬┘ ││" <=>
-        str "┴ ┴┴ ┴└─┘└─┘┴ ┴┴└──┴┘"
-
-drawUI :: MMS -> [Widget Name]
-drawUI s =
-  [ drawMenu s ]
-
-drawMenu :: MMS -> Widget Name
-drawMenu s =
-  joinBorders $
-  center $
-  withBorderStyle unicodeRounded $
-  border $
-  hLimit 40 $
-  hCenter title <=>
-  hBorder <=>
-  drawList s
-
-drawList :: MMS -> Widget Name
-drawList s = vLimit 4 $
-             L.renderList drawListElement True (s^.l)
-
-drawListElement :: Bool -> String -> Widget Name
-drawListElement selected = hCenteredStrWrapWithAttr attr
-  where attr = if selected then withAttr selectedAttr else id
-
-handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
-handleEvent (VtyEvent e) = case e of
-  V.EvKey V.KEsc [] -> halt
-  V.EvKey (V.KChar 'q') []  -> halt
-  V.EvKey V.KEnter [] -> do
-    list <- use (mms.l)
-    case L.listSelected list of
-      Just 0 -> goToState =<< liftIO cardSelectorState
-      Just 1 -> goToState infoState
-      Just 2 -> goToState =<< liftIO settingsState
-      Just 3 -> halt
-      _ -> undefined
-
-  ev -> zoom (mms.l) $ L.handleListEventVi L.handleListEvent ev
-handleEvent _ = return ()
+module UI.MainMenu (State (..), drawUI, handleEvent, theMap) where++import Brick+import Brick.Widgets.Border+import Brick.Widgets.Border.Style+import Brick.Widgets.Center+import Control.Monad.IO.Class+import Lens.Micro.Platform+import Runners+import Settings+import States+import StateManagement+import UI.Attributes+import UI.BrickHelpers+import qualified Graphics.Vty as V+import qualified Brick.Widgets.List as L++title :: Widget Name+title = withAttr titleAttr $+        str "┬ ┬┌─┐┌─┐┌─┐┌─┐┬─┐┌┬┐" <=>+        str "├─┤├─┤└─┐│  ├─┤├┬┘ ││" <=>+        str "┴ ┴┴ ┴└─┘└─┘┴ ┴┴└──┴┘"++drawUI :: MMS -> [Widget Name]+drawUI s =+  [ drawMenu s ]++drawMenu :: MMS -> Widget Name+drawMenu s =+  joinBorders $+  center $+  withBorderStyle unicodeRounded $+  border $+  hLimit 40 $+  hCenter title <=>+  hBorder <=>+  drawList s++drawList :: MMS -> Widget Name+drawList s = vLimit 4 $+             L.renderList drawListElement True (s^.l)++drawListElement :: Bool -> String -> Widget Name+drawListElement selected = hCenteredStrWrapWithAttr attr+  where attr = if selected then withAttr selectedAttr else id++handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()+handleEvent (VtyEvent e) = case e of+  V.EvKey V.KEsc [] -> halt+  V.EvKey (V.KChar 'q') []  -> halt+  V.EvKey V.KEnter [] -> do+    list <- use (mms.l)+    case L.listSelected list of+      Just 0 -> goToState =<< liftIO cardSelectorState+      Just 1 -> goToState infoState+      Just 2 -> goToState =<< liftIO settingsState+      Just 3 -> halt+      _ -> undefined++  ev -> zoom (mms.l) $ L.handleListEventVi L.handleListEvent ev+handleEvent _ = return ()
src/UI/Parameter.hs view
@@ -1,83 +1,83 @@-module UI.Parameter (drawUI, theMap, handleEvent) where
-
-import UI.Attributes
-import Brick
-import Brick.Focus
-import Brick.Forms
-import Brick.Widgets.Border
-import Brick.Widgets.Border.Style
-import Brick.Widgets.Center
-import Control.Monad (when)
-import Control.Monad.IO.Class
-import Lens.Micro.Platform
-import States
-import StateManagement
-import Runners
-import qualified Graphics.Vty as V
-
-drawUI :: PS -> [Widget Name]
-drawUI = (:[]) . ui
-
-ui :: PS -> Widget Name
-ui s =
-  joinBorders $
-  center $
-  withBorderStyle unicodeRounded $
-  border $
-  hLimitPercent 60 $
-  hLimit 40 $
-  hCenter (withAttr titleAttr (str "Select parameters")) <=>
-  hBorder <=>
-  padLeftRight 1
-  (renderForm (s ^. psForm))
-
-handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
-handleEvent ev@(VtyEvent e) = do
-  s <- use ps
-  let form = s ^. psForm
-      focus = formFocus form
-      (Just n) = focusGetCurrent focus
-      down = zoom ps $ case n of
-        ParametersOkField -> return ()
-        ChunkField1 -> psForm .= form { formFocus = focusNext (focusNext focus) }
-        _ -> psForm .= form { formFocus = focusNext focus }
-      up = zoom ps $ case n of
-        ChunkField1 -> return ()
-        ChunkField2 -> return ()
-        SubsetField -> psForm .= form { formFocus = focusPrev (focusPrev focus) }
-        _           -> psForm .= form { formFocus = focusPrev focus }
-      right = zoom ps $ case n of
-        ChunkField1 -> psForm .= form { formFocus = focusNext focus }
-        _ -> return ()
-      left = zoom ps $ case n of
-        ChunkField2 -> psForm .= form { formFocus = focusPrev focus }
-        _ -> return ()
-
-  case e of
-      V.EvKey V.KEsc []         -> popState
-      V.EvKey (V.KChar 'q') []  -> popState
-      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') [] -> return ()
-      V.EvKey V.KBackTab []     -> return ()
-      V.EvKey (V.KChar 'h') []  -> left
-      V.EvKey (V.KChar 'l') []  -> right
-    
-      _ -> case (e, n) of
-          (V.EvKey V.KRight [], ChunkField2) -> return ()
-          (V.EvKey V.KLeft [],  ChunkField1) -> return ()
-          (V.EvKey V.KRight [], SubsetField) -> return ()
-          (V.EvKey V.KLeft [],  SubsetField) -> return ()
-          _ -> do zoom (ps.psForm) $ handleFormEvent ev
-                  f <- use $ ps.psForm
-                  when (formState f ^. pOk) $ do
-                    parameters .= formState f
-                    parameters.pOk .= False
-                    paramsWithoutOk <- use parameters
-                    ps.psForm .= updateFormState paramsWithoutOk f
-                    state <- cardsWithOptionsStateM (s ^. psFp) (s ^. psCards)
-                    goToState state
-
-handleEvent _ = return ()
+module UI.Parameter (drawUI, theMap, handleEvent) where++import UI.Attributes+import Brick+import Brick.Focus+import Brick.Forms+import Brick.Widgets.Border+import Brick.Widgets.Border.Style+import Brick.Widgets.Center+import Control.Monad (when)+import Control.Monad.IO.Class+import Lens.Micro.Platform+import States+import StateManagement+import Runners+import qualified Graphics.Vty as V++drawUI :: PS -> [Widget Name]+drawUI = (:[]) . ui++ui :: PS -> Widget Name+ui s =+  joinBorders $+  center $+  withBorderStyle unicodeRounded $+  border $+  hLimitPercent 60 $+  hLimit 40 $+  hCenter (withAttr titleAttr (str "Select parameters")) <=>+  hBorder <=>+  padLeftRight 1+  (renderForm (s ^. psForm))++handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()+handleEvent ev@(VtyEvent e) = do+  s <- use ps+  let form = s ^. psForm+      focus = formFocus form+      (Just n) = focusGetCurrent focus+      down = zoom ps $ case n of+        ParametersOkField -> return ()+        ChunkField1 -> psForm .= form { formFocus = focusNext (focusNext focus) }+        _ -> psForm .= form { formFocus = focusNext focus }+      up = zoom ps $ case n of+        ChunkField1 -> return ()+        ChunkField2 -> return ()+        SubsetField -> psForm .= form { formFocus = focusPrev (focusPrev focus) }+        _           -> psForm .= form { formFocus = focusPrev focus }+      right = zoom ps $ case n of+        ChunkField1 -> psForm .= form { formFocus = focusNext focus }+        _ -> return ()+      left = zoom ps $ case n of+        ChunkField2 -> psForm .= form { formFocus = focusPrev focus }+        _ -> return ()++  case e of+      V.EvKey V.KEsc []         -> popState+      V.EvKey (V.KChar 'q') []  -> popState+      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') [] -> return ()+      V.EvKey V.KBackTab []     -> return ()+      V.EvKey (V.KChar 'h') []  -> left+      V.EvKey (V.KChar 'l') []  -> right+    +      _ -> case (e, n) of+          (V.EvKey V.KRight [], ChunkField2) -> return ()+          (V.EvKey V.KLeft [],  ChunkField1) -> return ()+          (V.EvKey V.KRight [], SubsetField) -> return ()+          (V.EvKey V.KLeft [],  SubsetField) -> return ()+          _ -> do zoom (ps.psForm) $ handleFormEvent ev+                  f <- use $ ps.psForm+                  when (formState f ^. pOk) $ do+                    parameters .= formState f+                    parameters.pOk .= False+                    paramsWithoutOk <- use parameters+                    ps.psForm .= updateFormState paramsWithoutOk f+                    state <- cardsWithOptionsStateM (s ^. psFp) (s ^. psCards)+                    goToState state++handleEvent _ = return ()
src/UI/Settings.hs view
@@ -1,63 +1,63 @@-module UI.Settings (State, drawUI, handleEvent, theMap) where
-
-import UI.Attributes
-import Brick
-import Brick.Focus
-import Brick.Forms
-import Brick.Widgets.Border
-import Brick.Widgets.Border.Style
-import Brick.Widgets.Center
-import Control.Monad (unless)
-import Control.Monad.IO.Class
-import Lens.Micro.Platform
-import States
-import StateManagement
-import Settings
-import qualified Brick.Types as T
-import qualified Graphics.Vty as V
-import UI.BrickHelpers (scrollableViewportPercent, handleClickScroll)
-
-drawUI :: SS -> [Widget Name]
-drawUI = (:[]) . ui
-
-ui :: SS -> Widget Name
-ui f =
-  joinBorders $
-  center $
-  withBorderStyle unicodeRounded $
-  border $
-  hLimitPercent 60 $
-  hLimit 40 $
-  hCenter (withAttr titleAttr (str "Settings")) <=>
-  hBorder <=> 
-  scrollableViewportPercent 60 SettingsViewport 
-  (padLeft (Pad 1) $ renderForm f)
-
-scroll = vScrollBy (viewportScroll SettingsViewport)
-
-handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
-handleEvent ev@(VtyEvent e) = do
-  form <- use ss
-  let halt' = popState <* liftIO (setSettings (formState form))
-      focus = formFocus form
-      (Just n) = focusGetCurrent focus
-      down = if n /= MaxRecentsField then
-               ss .= form { formFocus = focusNext focus }
-             else scroll 1
-      up = unless (n == HintsField) $
-             ss .= form { formFocus = focusPrev focus }
-
-
-  case e of
-    V.EvKey V.KEsc []         -> halt'
-    V.EvKey (V.KChar 'q') []  -> halt'
-    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') [] -> return ()
-    V.EvKey V.KBackTab []     -> return ()
-    _ -> zoom ss $ handleFormEvent ev
-
-handleEvent (T.MouseDown (SBClick el SettingsViewport) _ _ _) = handleClickScroll scroll el
-handleEvent _ = return ()
+module UI.Settings (State, drawUI, handleEvent, theMap) where++import UI.Attributes+import Brick+import Brick.Focus+import Brick.Forms+import Brick.Widgets.Border+import Brick.Widgets.Border.Style+import Brick.Widgets.Center+import Control.Monad (unless)+import Control.Monad.IO.Class+import Lens.Micro.Platform+import States+import StateManagement+import Settings+import qualified Brick.Types as T+import qualified Graphics.Vty as V+import UI.BrickHelpers (scrollableViewportPercent, handleClickScroll)++drawUI :: SS -> [Widget Name]+drawUI = (:[]) . ui++ui :: SS -> Widget Name+ui f =+  joinBorders $+  center $+  withBorderStyle unicodeRounded $+  border $+  hLimitPercent 60 $+  hLimit 40 $+  hCenter (withAttr titleAttr (str "Settings")) <=>+  hBorder <=> +  scrollableViewportPercent 60 SettingsViewport +  (padLeft (Pad 1) $ renderForm f)++scroll = vScrollBy (viewportScroll SettingsViewport)++handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()+handleEvent ev@(VtyEvent e) = do+  form <- use ss+  let halt' = popState <* liftIO (setSettings (formState form))+      focus = formFocus form+      (Just n) = focusGetCurrent focus+      down = if n /= MaxRecentsField then+               ss .= form { formFocus = focusNext focus }+             else scroll 1+      up = unless (n == HintsField) $+             ss .= form { formFocus = focusPrev focus }+++  case e of+    V.EvKey V.KEsc []         -> halt'+    V.EvKey (V.KChar 'q') []  -> halt'+    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') [] -> return ()+    V.EvKey V.KBackTab []     -> return ()+    _ -> zoom ss $ handleFormEvent ev++handleEvent (T.MouseDown (SBClick el SettingsViewport) _ _ _) = handleClickScroll scroll el+handleEvent _ = return ()
test/Spec.hs view
@@ -1,80 +1,80 @@-import Test.Tasty
-import Test.Tasty.HUnit
-import Test.Tasty.QuickCheck
-import DeckHandling
-import Parser
-import States
-import Recents
-
-main :: IO ()
-main = defaultMain tests
-
-tests :: TestTree
-tests = testGroup "Tests" [unitTests]
-
-unitTests :: TestTree
-unitTests = testGroup "Unit tests"
-  [ testRecents
-  , testChunking
-  ]
-
-testRecents :: TestTree
-testRecents = testGroup "Shortening filepaths"
-  [ testCase "empty recents" $
-      shortenFilepaths [] @?= []
-  , testRecentsExtension ".txt"
-  , testRecentsExtension ".md"
-  , testRecentsMix
-  ]
-
-testRecentsExtension :: String -> TestTree
-testRecentsExtension ext = testGroup ("Extension " <> ext)
-  [ testCase "different file names" $
-      shortenFilepaths ["some/path/deck1" <> ext, "some/other/path/deck2" <> ext, "some/new/path/deck3" <> ext]
-      @?=
-      ["deck1", "deck2", "deck3"]
-
-  , testCase "recents same file name" $
-      shortenFilepaths ["/path/to/deck" <> ext, "/path/to/another/deck" <> ext, "other/path/normal" <> ext]
-      @?=
-      ["to/deck", "another/deck", "normal"] 
-
-  , testCase "recents same directory and file name" $
-      shortenFilepaths ["/some/directory/deck" <> ext, "/another/directory/deck" <> ext, "other/path/normal" <> ext]
-      @?=
-      ["some/directory/deck", "another/directory/deck", "normal"]
-  ]
-
-testRecentsMix :: TestTree
-testRecentsMix = testGroup "Mixed extensions"
-  [ testCase "different file names" $
-      shortenFilepaths ["some/path/deck1.txt", "some/other/path/deck2.txt", "some/new/path/deck3.md"]
-      @?=
-      ["deck1.txt", "deck2.txt", "deck3.md"]
-
-  , testCase "recents same file name, same extension" $
-      shortenFilepaths ["/path/to/deck.txt", "/path/to/another/deck.txt", "other/path/normal.md"]
-      @?=
-      ["to/deck.txt", "another/deck.txt", "normal.md"]
-
-  , testCase "recents same file name, different extension" $
-      shortenFilepaths ["/path/to/deck.md", "/path/to/another/deck.txt", "other/path/normal.md"]
-      @?=
-      ["deck.md", "deck.txt", "normal.md"] 
-
-  , testCase "recents same directory and file name, same extension" $
-      shortenFilepaths ["/some/directory/deck.md", "/another/directory/deck.md", "other/path/normal.txt"]
-      @?=
-      ["some/directory/deck.md", "another/directory/deck.md", "normal.txt"]
-
-  , testCase "recents same directory and file name, different extension" $
-      shortenFilepaths ["/some/directory/deck.txt", "/another/directory/deck.md", "other/path/normal.txt"]
-      @?=
-      ["deck.txt", "deck.md", "normal.txt"]
-  ]
-
-testChunking :: TestTree
-testChunking = testGroup "QuickCheck"
-  [ testProperty "concat . doChunking n == id" $
-      \xs n -> n > 0 ==> concat (splitIntoNChunks n xs) == (xs :: [Int])
+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import DeckHandling+import Parser+import States+import Recents++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [ testRecents+  , testChunking+  ]++testRecents :: TestTree+testRecents = testGroup "Shortening filepaths"+  [ testCase "empty recents" $+      shortenFilepaths [] @?= []+  , testRecentsExtension ".txt"+  , testRecentsExtension ".md"+  , testRecentsMix+  ]++testRecentsExtension :: String -> TestTree+testRecentsExtension ext = testGroup ("Extension " <> ext)+  [ testCase "different file names" $+      shortenFilepaths ["some/path/deck1" <> ext, "some/other/path/deck2" <> ext, "some/new/path/deck3" <> ext]+      @?=+      ["deck1", "deck2", "deck3"]++  , testCase "recents same file name" $+      shortenFilepaths ["/path/to/deck" <> ext, "/path/to/another/deck" <> ext, "other/path/normal" <> ext]+      @?=+      ["to/deck", "another/deck", "normal"] ++  , testCase "recents same directory and file name" $+      shortenFilepaths ["/some/directory/deck" <> ext, "/another/directory/deck" <> ext, "other/path/normal" <> ext]+      @?=+      ["some/directory/deck", "another/directory/deck", "normal"]+  ]++testRecentsMix :: TestTree+testRecentsMix = testGroup "Mixed extensions"+  [ testCase "different file names" $+      shortenFilepaths ["some/path/deck1.txt", "some/other/path/deck2.txt", "some/new/path/deck3.md"]+      @?=+      ["deck1.txt", "deck2.txt", "deck3.md"]++  , testCase "recents same file name, same extension" $+      shortenFilepaths ["/path/to/deck.txt", "/path/to/another/deck.txt", "other/path/normal.md"]+      @?=+      ["to/deck.txt", "another/deck.txt", "normal.md"]++  , testCase "recents same file name, different extension" $+      shortenFilepaths ["/path/to/deck.md", "/path/to/another/deck.txt", "other/path/normal.md"]+      @?=+      ["deck.md", "deck.txt", "normal.md"] ++  , testCase "recents same directory and file name, same extension" $+      shortenFilepaths ["/some/directory/deck.md", "/another/directory/deck.md", "other/path/normal.txt"]+      @?=+      ["some/directory/deck.md", "another/directory/deck.md", "normal.txt"]++  , testCase "recents same directory and file name, different extension" $+      shortenFilepaths ["/some/directory/deck.txt", "/another/directory/deck.md", "other/path/normal.txt"]+      @?=+      ["deck.txt", "deck.md", "normal.txt"]+  ]++testChunking :: TestTree+testChunking = testGroup "QuickCheck"+  [ testProperty "concat . doChunking n == id" $+      \xs n -> n > 0 ==> concat (splitIntoNChunks n xs) == (xs :: [Int])   ]