{-# 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 :: CS -> [Widget Name]
drawUI CS
s =  [forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n. Widget n
emptyWidget (forall s d. Popup s d -> d -> Widget Name
`drawPopup` CS
s) (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS (Maybe (Popup GlobalState CS))
popup), CS -> Widget Name
drawCardUI CS
s forall n. Widget n -> Widget n -> Widget n
<=> CS -> Widget Name
drawInfo CS
s]

drawInfo :: CS -> Widget Name
drawInfo :: CS -> Widget Name
drawInfo CS
s = if Bool -> Bool
not (CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Bool
showControls) then forall n. Widget n
emptyWidget else
  forall n. String -> Widget n
strWrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"ESC: quit" forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ case CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS CardState
cardState of
    DefinitionState {}     -> String
", ENTER: flip card / continue"
    MultipleChoiceState {} -> String
", ENTER: submit answer / continue"
    MultipleAnswerState {} -> String
", ENTER: select / continue, c: submit selection"
    OpenQuestionState {}   -> String
", LEFT/RIGHT/TAB: navigate gaps, ENTER: submit answer / continue, Ctrl+F1: show answer"
    ReorderState {}        -> String
", ENTER: grab, c: submit answer"

drawCardBox :: Widget Name -> Widget Name
drawCardBox :: Widget Name -> Widget Name
drawCardBox Widget Name
w = forall n. Widget n -> Widget n
C.center forall a b. (a -> b) -> a -> b
$
                forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
BS.unicodeRounded forall a b. (a -> b) -> a -> b
$
                forall n. Widget n -> Widget n
B.border forall a b. (a -> b) -> a -> b
$
                forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
textboxAttr forall a b. (a -> b) -> a -> b
$
                forall n. Int -> Widget n -> Widget n
hLimitPercent Int
60 Widget Name
w

drawFooter :: CS -> Widget Name
drawFooter :: CS -> Widget Name
drawFooter CS
s = if CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Bool
reviewMode
  then forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$ forall n. Widget n
wrong forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n
progress forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n
correct
  else forall n. Widget n
progress
  -- not guaranteed that progress is horizontally centered i think

  where progress :: Widget n
progress = forall n. Widget n -> Widget n
C.hCenter forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (forall a. Show a => a -> String
show (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
index forall a. Num a => a -> a -> a
+ Int
1) forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
nCards))
        wrong :: Widget n
wrong = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
wrongAttr (forall n. String -> Widget n
str (String
"✗ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
nWrong))
        correct :: Widget n
correct = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctAttr (forall n. String -> Widget n
str (String
"✓ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
nCorrect))
        nCorrect :: Int
nCorrect = forall (t :: * -> *) a. Foldable t => t a -> Int
length (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS [Int]
correctCards)
        nWrong :: Int
nWrong = CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
index forall a. Num a => a -> a -> a
- Int
nCorrect forall a. Num a => a -> a -> a
+ (if Bool
endCard then Int
1 else Int
0)
        endCard :: Bool
endCard = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (PopupState -> Bool
isFinalPopup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s d. Lens' (Popup s d) PopupState
popupState) (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS (Maybe (Popup GlobalState CS))
popup)

drawCardUI :: CS -> Widget Name
drawCardUI :: CS -> Widget Name
drawCardUI CS
s = 
  let card :: Card
card = (CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS [Card]
shownCards) forall a. [a] -> Int -> a
!! (CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Int
index)
  in
  forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$ 
  Widget Name -> Widget Name
drawCardBox forall a b. (a -> b) -> a -> b
$ 
  Card -> Widget Name
drawHeader Card
card
  forall n. Widget n -> Widget n -> Widget n
<=>
  forall n. Widget n
B.hBorder
  forall n. Widget n -> Widget n -> Widget n
<=>
  Int -> Name -> Widget Name -> Widget Name
scrollableViewportPercent Int
60 (Int -> Name
CardViewport (CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Int
index))
  (CS -> Card -> Widget Name
drawContent CS
s Card
card)
  forall n. Widget n -> Widget n -> Widget n
<=>
  forall n. String -> Widget n
str String
" "
  forall n. Widget n -> Widget n -> Widget n
<=>
  CS -> Widget Name
drawFooter CS
s

drawHeader :: Card -> Widget Name
drawHeader :: Card -> Widget Name
drawHeader (Definition String
title Maybe External
_ String
_) = forall n. String -> Widget n
drawTitle String
title
drawHeader (MultipleChoice String
question Maybe External
_ CorrectOption
_ [IncorrectOption]
_) = forall n. String -> Widget n
drawTitle String
question
drawHeader (OpenQuestion String
question Maybe External
_ Perforated
_) = forall n. String -> Widget n
drawTitle String
question
drawHeader (MultipleAnswer String
question Maybe External
_ NonEmpty Option
_) = forall n. String -> Widget n
drawTitle String
question
drawHeader (Reorder String
question Maybe External
_ NonEmpty (Int, String)
_) = forall n. String -> Widget n
drawTitle String
question

drawContent :: CS -> Card -> Widget Name
drawContent :: CS -> Card -> Widget Name
drawContent CS
s (Definition String
_ Maybe External
_ String
descr) = forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$ CS -> String -> Widget Name
drawDef CS
s String
descr
drawContent CS
s (MultipleChoice String
_ Maybe External
_ CorrectOption
correct [IncorrectOption]
others) = forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$ CS -> [String] -> Widget Name
drawChoices CS
s (CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice CorrectOption
correct [IncorrectOption]
others)
drawContent CS
s (OpenQuestion String
_ Maybe External
_ Perforated
perforated) = forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$ CS -> Perforated -> Widget Name
drawPerforated CS
s Perforated
perforated
drawContent CS
s (MultipleAnswer String
_ Maybe External
_ NonEmpty Option
options) = forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ CS -> NonEmpty Option -> Widget Name
drawOptions CS
s NonEmpty Option
options
drawContent CS
s (Reorder{}) = forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$ CS -> Widget Name
drawReorder CS
s

drawTitle :: String -> Widget n
drawTitle :: forall n. String -> Widget n
drawTitle String
title = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr forall a b. (a -> b) -> a -> b
$
                   forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$
                   forall n. String -> Widget n
hCenteredStrWrap String
title

wrapSettings :: WrapSettings
wrapSettings :: WrapSettings
wrapSettings = WrapSettings
defaultWrapSettings {preserveIndentation :: Bool
preserveIndentation=Bool
False, breakLongWords :: Bool
breakLongWords=Bool
True}

drawDescr :: String -> Widget Name
drawDescr :: String -> Widget Name
drawDescr = forall n. WrapSettings -> String -> Widget n
strWrapWith WrapSettings
wrapSettings

drawDef :: CS -> String -> Widget Name
drawDef :: CS -> String -> Widget Name
drawDef CS
s String
def = if CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Bool
showHints then CS -> String -> Widget Name
drawHintedDef CS
s String
def else CS -> String -> Widget Name
drawNormalDef CS
s String
def

drawHintedDef :: CS -> String -> Widget Name
drawHintedDef :: CS -> String -> Widget Name
drawHintedDef CS
s String
def = case CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS CardState
cardState of
  DefinitionState {_flipped :: CardState -> Bool
_flipped=Bool
f} -> if Bool
f then String -> Widget Name
drawDescr String
def else String -> Widget Name
drawDescr [if Char -> Bool
isSpace' Char
char then Char
char else Char
'_' | Char
char <- String
def]
  CardState
_ -> forall a. HasCallStack => String -> a
error String
"impossible: "

isSpace' :: Char -> Bool
isSpace' :: Char -> Bool
isSpace' Char
'\r' = Bool
True
isSpace' Char
a    = Char -> Bool
isSpace Char
a

drawNormalDef:: CS -> String -> Widget Name
drawNormalDef :: CS -> String -> Widget Name
drawNormalDef CS
s String
def = case CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS CardState
cardState of
  DefinitionState {_flipped :: CardState -> Bool
_flipped=Bool
f} -> if Bool
f
    then String -> Widget Name
drawDescr String
def
    else forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
      Context Name
c <- forall n. RenderM n (Context n)
getContext
      let w :: Int
w = Context Name
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
      forall n. Widget n -> RenderM n (Result n)
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ [forall n. String -> Widget n
str String
" " | Text
_ <- WrapSettings -> Int -> Text -> [Text]
wrapTextToLines WrapSettings
wrapSettings Int
w (String -> Text
pack String
def)]
  CardState
_ -> forall a. HasCallStack => String -> a
error String
"impossible: "

drawChoices :: CS -> [String] -> Widget Name
drawChoices :: CS -> [String] -> Widget Name
drawChoices CS
s [String]
options = case (CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS CardState
cardState, CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Card
currentCard) of
  (MultipleChoiceState {_highlighted :: CardState -> Int
_highlighted=Int
i, _tried :: CardState -> Map Int Bool
_tried=Map Int Bool
kvs}, MultipleChoice String
_ Maybe External
_ (CorrectOption Int
k String
_) [IncorrectOption]
_)  -> forall n. [Widget n] -> Widget n
vBox [Widget Name]
formattedOptions

             where formattedOptions :: [Widget Name]
                   formattedOptions :: [Widget Name]
formattedOptions = [ forall n. Widget n -> Widget n
visibility forall a b. (a -> b) -> a -> b
$ forall n. Widget n
prefix forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n -> Widget n
coloring (String -> Widget Name
drawDescr String
opt) |
                                        (Int
j, String
opt) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
options,
                                        let prefix :: Widget n
prefix = if Int
i forall a. Eq a => a -> a -> Bool
== Int
j then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightedChoiceAttr (forall n. String -> Widget n
str String
"* ") else forall n. String -> Widget n
str String
"  "
                                            chosen :: Bool
chosen = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
False Int
j Map Int Bool
kvs
                                            visibility :: Widget n -> Widget n
visibility = if Int
i forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
chosen then forall n. Widget n -> Widget n
visible else forall a. a -> a
id
                                            coloring :: Widget n -> Widget n
coloring = case (Bool
chosen, Int
jforall a. Eq a => a -> a -> Bool
==Int
k) of
                                              (Bool
False, Bool
_)    -> forall a. a -> a
id
                                              (Bool
True, Bool
False) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
incorrectChoiceAttr
                                              (Bool
True, Bool
True)  -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctChoiceAttr
                                          ]
  (CardState, Card)
_ -> forall a. HasCallStack => String -> a
error String
"impossible"

drawOptions :: CS -> NonEmpty Option -> Widget Name
drawOptions :: CS -> NonEmpty Option -> Widget Name
drawOptions CS
s = case (CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS CardState
cardState, CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Card
currentCard) of
  (MultipleAnswerState {_highlighted :: CardState -> Int
_highlighted=Int
j, _selected :: CardState -> Map Int Bool
_selected=Map Int Bool
kvs, _entered :: CardState -> Bool
_entered=Bool
submitted}, Card
_) ->
    forall n. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (Option, Int) -> Widget Name
drawOption forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
`NE.zip` forall a. [a] -> NonEmpty a
NE.fromList [Int
0..])
      where drawOption :: (Option, Int) -> Widget Name
drawOption (Option Type
kind String
text, Int
i) = forall n. Widget n -> Widget n
visibility forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
coloring (forall n. String -> Widget n
str String
"[") forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n -> Widget n
coloring (forall n. Widget n -> Widget n
highlighting (forall n. String -> Widget n
str String
symbol)) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n -> Widget n
coloring (forall n. String -> Widget n
str String
"] ") forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
drawDescr String
text
              where symbol :: String
symbol = if (Int
i forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted) Bool -> Bool -> Bool
|| Bool
enabled then String
"*" else String
" "
                    enabled :: Bool
enabled = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
False Int
i Map Int Bool
kvs
                    highlighting :: Widget n -> Widget n
highlighting = if Int
i forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightedOptAttr else forall a. a -> a
id
                    visibility :: Widget n -> Widget n
visibility = if Int
i forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted then forall n. Widget n -> Widget n
visible else forall a. a -> a
id
                    coloring :: Widget n -> Widget n
coloring = case (Bool
submitted, Bool
enabled, Type
kind) of
                                  (Bool
True, Bool
True, Type
Correct) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctOptAttr
                                  (Bool
True, Bool
False, Type
Incorrect) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctOptAttr
                                  (Bool
True, Bool
_, Type
_) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
incorrectOptAttr
                                  (Bool
False, Bool
True, Type
_) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedOptAttr
                                  (Bool, Bool, Type)
_ -> forall a. a -> a
id

  (CardState, Card)
_ -> forall a. HasCallStack => String -> a
error String
"hopefully this is never shown"


drawPerforated :: CS -> Perforated -> Widget Name
drawPerforated :: CS -> Perforated -> Widget Name
drawPerforated CS
s Perforated
p = CS -> Sentence -> Widget Name
drawSentence CS
s forall a b. (a -> b) -> a -> b
$ Perforated -> Sentence
perforatedToSentence Perforated
p

drawSentence :: CS -> Sentence -> Widget Name
drawSentence :: CS -> Sentence -> Widget Name
drawSentence CS
state Sentence
sentence = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
  Context Name
c <- forall n. RenderM n (Context n)
getContext
  let w :: Int
w = Context Name
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
  forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ Int -> CS -> Sentence -> Widget Name
makeSentenceWidget Int
w CS
state Sentence
sentence

makeSentenceWidget :: Int -> CS -> Sentence -> Widget Name
makeSentenceWidget :: Int -> CS -> Sentence -> Widget Name
makeSentenceWidget Int
w CS
state = forall n. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Sentence -> ([Widget Name], Bool)
makeSentenceWidget' Int
0 Int
0
  where
    makeSentenceWidget' :: Int -> Int -> Sentence -> ([Widget Name], Bool)
    makeSentenceWidget' :: Int -> Int -> Sentence -> ([Widget Name], Bool)
makeSentenceWidget' Int
padding Int
_ (Normal String
s) = let ([Widget Name]
ws, Int
_, Bool
fit) = Int -> Int -> String -> ([Widget Name], Int, Bool)
wrapStringWithPadding Int
padding Int
w String
s in ([Widget Name]
ws, Bool
fit)
    makeSentenceWidget' Int
padding Int
i (Perforated String
pre NonEmpty String
_ Sentence
post) = case CS
state forall s a. s -> Getting a s a -> a
^. Lens' CS CardState
cardState of
      OpenQuestionState {_gapInput :: CardState -> Map Int String
_gapInput = Map Int String
kvs, _highlighted :: CardState -> Int
_highlighted=Int
j, _entered :: CardState -> Bool
_entered=Bool
submitted, _correctGaps :: CardState -> Map Int Bool
_correctGaps=Map Int Bool
cgs} ->
        let ([Widget Name]
ws, Int
n, Bool
fit') = Int -> Int -> String -> ([Widget Name], Int, Bool)
wrapStringWithPadding Int
padding Int
w String
pre
            stored :: String
stored = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault String
"" Int
i Map Int String
kvs
            gap :: String
gap = if String
stored forall a. Eq a => a -> a -> Bool
== String
"" then String
"░" else String
stored
            n' :: Int
n' =  Int
w forall a. Num a => a -> a -> a
- Int
n forall a. Num a => a -> a -> a
- forall a. TextWidth a => a -> Int
textWidth String
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 :: Widget Name -> Widget Name
cursor = if Int
i forall a. Eq a => a -> a -> Bool
== Int
j then forall n. n -> Location -> Widget n -> Widget n
showCursor Name
Ordinary ((Int, Int) -> Location
Location (forall a. TextWidth a => a -> Int
textWidth String
gap, Int
0)) else forall a. a -> a
id

            visibility :: Widget n -> Widget n
visibility = if Int
i forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted then forall n. Widget n -> Widget n
visible else forall a. a -> a
id
            correct :: Bool
correct = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
False Int
i Map Int Bool
cgs
            coloring :: Widget n -> Widget n
coloring = case (Bool
submitted, Bool
correct) of
              (Bool
False, Bool
_) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
gapAttr
              (Bool
True, Bool
False) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
incorrectGapAttr
              (Bool
True, Bool
True) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctGapAttr

            gapWidget :: Widget Name
gapWidget = forall n. Widget n -> Widget n
visibility forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
cursor forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
coloring (forall n. String -> Widget n
str String
gap) in

              if Int
n' forall a. Ord a => a -> a -> Bool
>= Int
0
                then let (ws1 :: [Widget Name]
ws1@(Widget Name
w':[Widget Name]
ws'), Bool
fit) = Int -> Int -> Sentence -> ([Widget Name], Bool)
makeSentenceWidget' (Int
wforall a. Num a => a -> a -> a
-Int
n') (Int
iforall a. Num a => a -> a -> a
+Int
1) Sentence
post in
                  if Bool
fit then (([Widget Name]
ws forall a b. a -> (a -> b) -> b
& forall s a. Snoc s s a a => Traversal' s a
_last forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall n. Widget n -> Widget n -> Widget n
<+> (Widget Name
gapWidget forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
w'))) forall a. [a] -> [a] -> [a]
++ [Widget Name]
ws', Bool
fit')
                  else (([Widget Name]
ws forall a b. a -> (a -> b) -> b
& forall s a. Snoc s s a a => Traversal' s a
_last forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
gapWidget)) forall a. [a] -> [a] -> [a]
++ [Widget Name]
ws1, Bool
fit')
              else let (ws1 :: [Widget Name]
ws1@(Widget Name
w':[Widget Name]
ws'), Bool
fit) = Int -> Int -> Sentence -> ([Widget Name], Bool)
makeSentenceWidget' (forall a. TextWidth a => a -> Int
textWidth String
gap) (Int
iforall a. Num a => a -> a -> a
+Int
1) Sentence
post in
                if Bool
fit then ([Widget Name]
ws forall a. [a] -> [a] -> [a]
++ [Widget Name
gapWidget forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
w'] forall a. [a] -> [a] -> [a]
++ [Widget Name]
ws', Bool
fit')
                else ([Widget Name]
ws forall a. [a] -> [a] -> [a]
++ [Widget Name
gapWidget] forall a. [a] -> [a] -> [a]
++ [Widget Name]
ws1, Bool
fit')
      CardState
_ -> forall a. HasCallStack => String -> a
error String
"PANIC!"

wrapStringWithPadding :: Int -> Int -> String -> ([Widget Name], Int, Bool)
wrapStringWithPadding :: Int -> Int -> String -> ([Widget Name], Int, Bool)
wrapStringWithPadding Int
padding Int
w String
s
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> [String]
words String
s) = ([forall n. String -> Widget n
str String
""], Int
padding, Bool
True)
  | Bool
otherwise = if forall a. TextWidth a => a -> Int
textWidth (forall a. [a] -> a
head (String -> [String]
words String
s)) forall a. Ord a => a -> a -> Bool
< Int
w forall a. Num a => a -> a -> a
- Int
padding then
    let startsWithSpace :: Bool
startsWithSpace = forall a. [a] -> a
head String
s forall a. Eq a => a -> a -> Bool
== Char
' '
        s' :: String
s' = if Bool
startsWithSpace then String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
padding Char
'X' forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [a]
tail String
s else forall a. Int -> a -> [a]
replicate Int
padding Char
'X' forall a. [a] -> [a] -> [a]
++ String
s
        lastLetter :: Char
lastLetter = forall a. [a] -> a
last String
s
        prefix :: Text
prefix = if forall a. [a] -> a
head String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\n', Char
'\r'] then String -> Text
T.pack String
" " else Text
T.empty
        postfix :: Text
postfix = if Char
lastLetter forall a. Eq a => a -> a -> Bool
== Char
' ' then String -> Text
T.pack [Char
lastLetter] else Text
T.empty
        ts :: [Text]
ts = WrapSettings -> Int -> Text -> [Text]
wrapTextToLines WrapSettings
wrapSettings Int
w (String -> Text
pack String
s') forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (if Bool
startsWithSpace then (String -> Text
T.pack String
" " Text -> Text -> Text
`T.append`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop (Int
padding forall a. Num a => a -> a -> a
+ Int
1) else Int -> Text -> Text
T.drop Int
padding)
        ts' :: [Text]
ts' = Text
prefix forall a. a -> [a] -> [a]
: ([Text]
ts forall a b. a -> (a -> b) -> b
& forall s a. Snoc s s a a => Traversal' s a
_last forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Text -> Text
`T.append` Text
postfix))
        padding' :: Int
padding' = forall a. TextWidth a => a -> Int
textWidth (forall a. [a] -> a
last [Text]
ts') forall a. Num a => a -> a -> a
+ (if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ts' forall a. Eq a => a -> a -> Bool
== Int
1 then Int
1 else Int
0) forall a. Num a => a -> a -> a
* Int
padding in
          (forall a b. (a -> b) -> [a] -> [b]
map forall n. Text -> Widget n
txt (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
T.empty) [Text]
ts'), Int
padding', Bool
True)
  else
    let lastLetter :: Char
lastLetter = forall a. [a] -> a
last String
s
        (Char
x: String
xs) = String
s
        s' :: String
s' = if Char
x forall a. Eq a => a -> a -> Bool
== Char
' ' then String
xs else String
s
        postfix :: Text
postfix = if Char
lastLetter forall a. Eq a => a -> a -> Bool
== Char
' ' then String -> Text
T.pack [Char
lastLetter] else Text
T.empty
        ts :: [Text]
ts = WrapSettings -> Int -> Text -> [Text]
wrapTextToLines WrapSettings
wrapSettings Int
w (String -> Text
pack String
s')
        ts' :: [Text]
ts' = [Text]
ts forall a b. a -> (a -> b) -> b
& forall s a. Snoc s s a a => Traversal' s a
_last forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Text -> Text
`T.append` Text
postfix) in
    (forall a b. (a -> b) -> [a] -> [b]
map forall n. Text -> Widget n
txt (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
T.empty) [Text]
ts'), forall a. TextWidth a => a -> Int
textWidth (forall a. [a] -> a
last [Text]
ts'), Bool
False)

drawReorder :: CS -> Widget Name
drawReorder :: CS -> Widget Name
drawReorder CS
s = case (CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS CardState
cardState, CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Card
currentCard) of
  (ReorderState {_highlighted :: CardState -> Int
_highlighted=Int
j, _grabbed :: CardState -> Bool
_grabbed=Bool
g, _order :: CardState -> Map Int (Int, String)
_order=Map Int (Int, String)
kvs, _number :: CardState -> Int
_number=Int
n, _entered :: CardState -> Bool
_entered=Bool
submitted}, Reorder{}) ->
    forall n. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Int
i, Map Int (Int, String)
kvs forall k a. Ord k => Map k a -> k -> a
M.! Int
i)) [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1]) forall a b. (a -> b) -> a -> b
$
    \(Int
i, (Int
k, String
text)) ->
      let color :: Widget n -> Widget n
color = case (Int
i forall a. Eq a => a -> a -> Bool
== Int
j,  Bool
g) of
                  (Bool
True, Bool
True ) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
grabbedElementAttr
                  (Bool
True, Bool
False) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightedElementAttr
                  (Bool, Bool)
_             -> forall a. a -> a
id

          visibility :: Widget n -> Widget n
visibility = if Int
i forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted then forall n. Widget n -> Widget n
visible else forall a. a -> a
id

          number :: Widget n
number =
            case (Bool
submitted, Int
iforall a. Num a => a -> a -> a
+Int
1 forall a. Eq a => a -> a -> Bool
== Int
k) of
              (Bool
False, Bool
_)    -> forall n. String -> Widget n
str (forall a. Show a => a -> String
show (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a. Semigroup a => a -> a -> a
<> String
". ")
              (Bool
True, Bool
False) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
incorrectElementAttr (forall n. String -> Widget n
str (forall a. Show a => a -> String
show Int
k forall a. Semigroup a => a -> a -> a
<> String
". "))
              (Bool
True, Bool
True ) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctElementAttr (forall n. String -> Widget n
str (forall a. Show a => a -> String
show Int
k forall a. Semigroup a => a -> a -> a
<> String
". "))
      in forall n. Widget n -> Widget n
visibility forall a b. (a -> b) -> a -> b
$ forall n. Widget n
number forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n -> Widget n
color (String -> Widget Name
drawDescr String
text)

  (CardState, Card)
_ -> forall a. HasCallStack => String -> a
error String
"cardstate mismatch"

----------------------------------------------------

---------------------- Events ----------------------

----------------------------------------------------

halt' :: EventM n GlobalState ()
halt' :: forall n. EventM n GlobalState ()
halt' = forall n.
EventM n GlobalState () -> Mode -> EventM n GlobalState ()
removeToModeOrQuit' EventM n GlobalState ()
beforeMoving Mode
CardSelector
  where beforeMoving :: EventM n GlobalState ()
beforeMoving = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' GlobalState CSS
css forall (m :: * -> *). (MonadState CSS m, MonadIO m) => m ()
refreshRecents

scroll :: CS -> Int -> EventM Name s ()
scroll :: forall s. CS -> Int -> EventM Name s ()
scroll CS
s = forall s. Int -> Int -> EventM Name s ()
scroll' forall a b. (a -> b) -> a -> b
$ CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Int
index

scroll' :: Int -> Int -> EventM Name s ()
scroll' :: forall s. Int -> Int -> EventM Name s ()
scroll' Int
i = forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy forall a b. (a -> b) -> a -> b
$ forall n. n -> ViewportScroll n
viewportScroll forall a b. (a -> b) -> a -> b
$ Int -> Name
CardViewport Int
i

handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
handleEvent :: BrickEvent Name () -> EventM Name GlobalState ()
handleEvent (VtyEvent Event
e) =
  -- let update = updateCS gs

  --     continue' = continue . update in

  case Event
e of
    V.EvKey Key
V.KEsc []          -> forall n. EventM n GlobalState ()
popStateOrQuit
    V.EvKey Key
V.KRight [Modifier
V.MCtrl] -> (forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenMforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (m :: * -> *). Functor m => m Bool -> m Bool
notMforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS Bool
reviewMode) EventM Name GlobalState ()
next
    V.EvKey Key
V.KLeft  [Modifier
V.MCtrl] -> (forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenMforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (m :: * -> *). Functor m => m Bool -> m Bool
notMforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS Bool
reviewMode) EventM Name GlobalState ()
previous

    Event
ev -> do
      Maybe (Popup GlobalState CS)
pUp <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS (Maybe (Popup GlobalState CS))
popup
      CS
s <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState CS
cs
      forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` (forall s d. Popup s d -> Event -> EventM Name s ()
`handlePopupEvent` Event
ev)) Maybe (Popup GlobalState CS)
pUp forall a b. (a -> b) -> a -> b
$
        case (CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS CardState
cardState, CS
s forall s a. s -> Getting a s a -> a
^. Lens' CS Card
currentCard) of
          (DefinitionState{_flipped :: CardState -> Bool
_flipped = Bool
f}, Definition {definition :: Card -> String
definition = String
d}) ->
            case Event
ev of
              V.EvKey Key
V.KEnter []  ->
                if Bool
f Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
d 
                  then if Bool -> Bool
not (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Bool
reviewMode) then EventM Name GlobalState ()
next
                    else Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS (Maybe (Popup GlobalState CS))
popup forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Popup GlobalState CS
correctPopup
                  else Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Bool
flipped forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
              V.EvKey Key
V.KUp [] -> forall {s}. EventM Name s ()
up
              V.EvKey (V.KChar Char
'k') [] -> forall {s}. EventM Name s ()
up
              V.EvKey Key
V.KDown [] -> forall {s}. EventM Name s ()
down
              V.EvKey (V.KChar Char
'j') [] -> forall {s}. EventM Name s ()
down
              Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

              where up :: EventM Name s ()
up = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
f forall a b. (a -> b) -> a -> b
$ forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1)
                    down :: EventM Name s ()
down = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
f forall a b. (a -> b) -> a -> b
$ forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1

          (MultipleChoiceState {_highlighted :: CardState -> Int
_highlighted = Int
i, _number :: CardState -> Int
_number = Int
n, _tried :: CardState -> Map Int Bool
_tried = Map Int Bool
kvs}, MultipleChoice String
_ Maybe External
_ (CorrectOption Int
j String
_) [IncorrectOption]
_) ->
            case Event
ev of
              V.EvKey Key
V.KUp [] -> EventM Name GlobalState ()
up
              V.EvKey (V.KChar Char
'k') [] -> EventM Name GlobalState ()
up
              V.EvKey Key
V.KDown [] -> EventM Name GlobalState ()
down
              V.EvKey (V.KChar Char
'j') [] -> EventM Name GlobalState ()
down

              V.EvKey Key
V.KEnter [] ->
                  if Bool
frozen
                    then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
correctlyAnswered forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Int]
correctCards forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
indexforall a. a -> [a] -> [a]
:)
                            EventM Name GlobalState ()
next
                    else Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState (Map Int Bool)
tried forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
i Bool
True
              Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

            where frozen :: Bool
frozen = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
False Int
j Map Int Bool
kvs

                  down :: EventM Name GlobalState ()
down = if Bool -> Bool
not Bool
frozen 
                         then forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
nforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                         else forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1

                  up :: EventM Name GlobalState ()
up = if Bool -> Bool
not Bool
frozen 
                       then forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
                       else forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1)

                  correctlyAnswered :: Bool
correctlyAnswered = Int
i forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& forall k a. Map k a -> Int
M.size (forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter forall a. a -> a
id Map Int Bool
kvs) forall a. Eq a => a -> a -> Bool
== Int
1

          (MultipleAnswerState {_highlighted :: CardState -> Int
_highlighted = Int
i, _number :: CardState -> Int
_number = Int
n, _entered :: CardState -> Bool
_entered = Bool
submitted, _selected :: CardState -> Map Int Bool
_selected = Map Int Bool
kvs}, MultipleAnswer String
_ Maybe External
_ NonEmpty Option
opts) ->
            case Event
ev of
              V.EvKey Key
V.KUp [] -> EventM Name GlobalState ()
up
              V.EvKey (V.KChar Char
'k') [] -> EventM Name GlobalState ()
up
              V.EvKey Key
V.KDown [] -> EventM Name GlobalState ()
down
              V.EvKey (V.KChar Char
'j') [] -> EventM Name GlobalState ()
down

              V.EvKey (V.KChar Char
'c') [] -> Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Bool
entered forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

              V.EvKey Key
V.KEnter [] ->
                  if Bool
frozen
                    then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
correctlyAnswered forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Int]
correctCards forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
indexforall a. a -> [a] -> [a]
:)
                            EventM Name GlobalState ()
next
                    else Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState (Map Int Bool)
selected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust Bool -> Bool
not Int
i
              V.EvKey (V.KChar Char
'\t') [] ->
                  if Bool
frozen
                    then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
correctlyAnswered forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Int]
correctCards forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
indexforall a. a -> [a] -> [a]
:)
                            EventM Name GlobalState ()
next
                    else Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState (Map Int Bool)
selected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust Bool -> Bool
not Int
i


              Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()


            where frozen :: Bool
frozen = Bool
submitted

                  down :: EventM Name GlobalState ()
down = if Bool -> Bool
not Bool
frozen 
                         then forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
nforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                         else forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1

                  up :: EventM Name GlobalState ()
up = if Bool -> Bool
not Bool
frozen 
                       then forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
                       else forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1)

                  correctlyAnswered :: Bool
correctlyAnswered = forall a. NonEmpty a -> [a]
NE.toList (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map Option -> Bool
isOptionCorrect NonEmpty Option
opts) forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall k a. Map k a -> [(k, a)]
M.toAscList Map Int Bool
kvs)

          (OpenQuestionState {_highlighted :: CardState -> Int
_highlighted = Int
i, _number :: CardState -> Int
_number = Int
n, _gapInput :: CardState -> Map Int String
_gapInput = Map Int String
kvs, _correctGaps :: CardState -> Map Int Bool
_correctGaps = Map Int Bool
cGaps, _failed :: CardState -> Bool
_failed=Bool
fail}, OpenQuestion String
_ Maybe External
_ Perforated
perforated) ->
            case Event
ev of
              V.EvKey (V.KFun Int
1) [Modifier
V.MCtrl] -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardState) forall a b. (a -> b) -> a -> b
$ do
                Traversal' CardState (Map Int String)
gapInput forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map Int String
correctAnswers
                Traversal' CardState Bool
entered forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                Traversal' CardState Bool
failed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                Traversal' CardState (Map Int Bool)
correctGaps forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(Int
i, Bool
True) | Int
i <- [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1]]
                      where correctAnswers :: Map Int String
correctAnswers = forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. NonEmpty a -> a
NE.head (Sentence -> [NonEmpty String]
sentenceToGaps (Perforated -> Sentence
perforatedToSentence Perforated
perforated))

              V.EvKey (V.KChar Char
'\t') [] -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardState) forall a b. (a -> b) -> a -> b
$ do
                if Int
i forall a. Ord a => a -> a -> Bool
< Int
n forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen
                  then Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                  else Traversal' CardState Int
highlighted forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0

              V.EvKey Key
V.KRight [] -> 
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
n forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen) forall a b. (a -> b) -> a -> b
$
                  Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1

              V.EvKey Key
V.KLeft [] ->
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen) forall a b. (a -> b) -> a -> b
$
                  Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1

              -- C-w deletes a word back (eg. "test test" -> "test")

              V.EvKey (V.KChar Char
'w') [Modifier
V.MCtrl] -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardState) forall a b. (a -> b) -> a -> b
$ do
                  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
frozen forall a b. (a -> b) -> a -> b
$ Traversal' CardState (Map Int String)
gapInputforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= String -> String
backword
                where backword :: String -> String
backword String
"" = String
""
                      backword String
xs = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
xs

              V.EvKey Key
V.KUp [] -> forall {s}. EventM Name s ()
up
              V.EvKey Key
V.KDown [] -> forall {s}. EventM Name s ()
down

              V.EvKey (V.KChar Char
c) [] -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardState) forall a b. (a -> b) -> a -> b
$ do
                  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
frozen forall a b. (a -> b) -> a -> b
$ Traversal' CardState (Map Int String)
gapInputforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
iforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Eq a => a -> Lens' (Maybe a) a
non String
"" forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. [a] -> [a] -> [a]
++[Char
c])
                  case Char
c of
                    Char
'k' -> forall {s}. EventM Name s ()
up
                    Char
'j' -> forall {s}. EventM Name s ()
down
                    Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

              V.EvKey Key
V.KEnter [] -> case (Bool
frozen, Bool
fail) of
                (Bool
False, Bool
_) -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' GlobalState CS
cs forall a b. (a -> b) -> a -> b
$ do
                  let sentence :: Sentence
sentence = Perforated -> Sentence
perforatedToSentence Perforated
perforated
                      gaps :: [NonEmpty String]
gaps = Sentence -> [NonEmpty String]
sentenceToGaps Sentence
sentence

                      wordIsCorrect :: String -> NonEmpty String -> Bool
                      wordIsCorrect :: String -> NonEmpty String -> Bool
wordIsCorrect = if CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Bool
isCaseSensitive
                        then forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
                        else (\String
word NonEmpty String
possibilites -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
word forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) NonEmpty String
possibilites)

                  Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState (Map Int Bool)
correctGaps forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\Int
j Bool
_ -> forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault String
"" Int
j Map Int String
kvs String -> NonEmpty String -> Bool
`wordIsCorrect` ([NonEmpty String]
gaps forall a. [a] -> Int -> a
!! Int
j))
                  Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Bool
entered forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

                  forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr Bool -> Bool -> Bool
(&&) Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState (Map Int Bool)
correctGaps)) forall a b. (a -> b) -> a -> b
$
                    Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Bool
failed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

                (Bool
_, Bool
True) -> EventM Name GlobalState ()
next
                (Bool
_, Bool
False) -> do
                  Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Int]
correctCards forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
indexforall a. a -> [a] -> [a]
:)
                  EventM Name GlobalState ()
next

              V.EvKey Key
V.KBS [] -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
frozen forall a b. (a -> b) -> a -> b
$
                  Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState (Map Int String)
gapInputforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= String -> String
backspace
                where backspace :: String -> String
backspace String
"" = String
""
                      backspace String
xs = forall a. [a] -> [a]
init String
xs

              Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

              where frozen :: Bool
frozen = forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr Bool -> Bool -> Bool
(&&) Bool
True Map Int Bool
cGaps
                    down :: EventM Name s ()
down = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
frozen forall a b. (a -> b) -> a -> b
$ forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1
                    up :: EventM Name s ()
up = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
frozen forall a b. (a -> b) -> a -> b
$ forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1)

          (ReorderState {_highlighted :: CardState -> Int
_highlighted = Int
i, _entered :: CardState -> Bool
_entered = Bool
submitted, _grabbed :: CardState -> Bool
_grabbed=Bool
dragging, _number :: CardState -> Int
_number = Int
n, _order :: CardState -> Map Int (Int, String)
_order = Map Int (Int, String)
kvs }, Reorder String
_ Maybe External
_ NonEmpty (Int, String)
elts) ->
            case Event
ev of
              V.EvKey Key
V.KUp [] -> EventM Name GlobalState ()
up
              V.EvKey (V.KChar Char
'k') [] -> EventM Name GlobalState ()
up
              V.EvKey Key
V.KDown [] -> EventM Name GlobalState ()
down
              V.EvKey (V.KChar Char
'j') [] -> EventM Name GlobalState ()
down
              V.EvKey (V.KChar Char
'c') [] -> Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Bool
entered forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
              V.EvKey Key
V.KEnter [] ->
                  if Bool
frozen
                    then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
correct forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Int]
correctCards forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
indexforall a. a -> [a] -> [a]
:)
                            EventM Name GlobalState ()
next
                    else Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' CardState Bool
grabbed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not

              Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()


            where frozen :: Bool
frozen = Bool
submitted

                  down :: EventM Name GlobalState ()
down = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardState) forall a b. (a -> b) -> a -> b
$
                    case (Bool
frozen, Int
i forall a. Ord a => a -> a -> Bool
< Int
n forall a. Num a => a -> a -> a
- Int
1, Bool
dragging) of
                      (Bool
True, Bool
_, Bool
_)  -> forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1
                      (Bool
_, Bool
False, Bool
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      (Bool
_, Bool
_, Bool
False) -> Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                      (Bool
_, Bool
_, Bool
True)  -> do Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                                          Traversal' CardState (Map Int (Int, String))
order forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a b. Ord a => a -> a -> Map a b -> Map a b
interchange Int
i (Int
iforall a. Num a => a -> a -> a
+Int
1)

                  up :: EventM Name GlobalState ()
up = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS CardState
cardState) forall a b. (a -> b) -> a -> b
$
                    case (Bool
frozen, Int
i forall a. Ord a => a -> a -> Bool
> Int
0, Bool
dragging) of
                      (Bool
True, Bool
_, Bool
_)  -> forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1)
                      (Bool
_, Bool
False, Bool
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      (Bool
_, Bool
_, Bool
False) -> Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
                      (Bool
_, Bool
_, Bool
True)  -> do Traversal' CardState Int
highlighted forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
                                          Traversal' CardState (Map Int (Int, String))
order forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a b. Ord a => a -> a -> Map a b -> Map a b
interchange Int
i (Int
iforall a. Num a => a -> a -> a
-Int
1)

                  correct :: Bool
correct = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
i -> (Int
iforall a. Num a => a -> a -> a
+Int
1, forall a b. (a, b) -> a
fst (Map Int (Int, String)
kvs forall k a. Ord k => Map k a -> k -> a
M.! Int
i)))) [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1]

          (CardState, Card)
_ -> forall a. HasCallStack => String -> a
error String
"impossible"
handleEvent (BT.MouseDown (SBClick ClickableScrollbarElement
el (CardViewport Int
i)) Button
_ [Modifier]
_ Location
_) = forall n s.
(Int -> EventM n s ())
-> ClickableScrollbarElement -> EventM n s ()
handleClickScroll (forall s. Int -> Int -> EventM Name s ()
scroll' Int
i) ClickableScrollbarElement
el
handleEvent BrickEvent Name ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

next :: EventM Name GlobalState ()
next :: EventM Name GlobalState ()
next = do
  Int
i <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS Int
index
  [Card]
sc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Card]
shownCards
  Bool
rm <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS Bool
reviewMode
  case (Int
i forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
sc, Bool
rm) of
    (Bool
True, Bool
_) -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' GlobalState CS
cs forall a b. (a -> b) -> a -> b
$ do
      String
fp <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CS String
pathToFile
      [Card]
sc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CS [Card]
shownCards
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Card -> IO ()
openCardExternal (String -> String
takeDirectory String
fp) ([Card]
sc forall a. [a] -> Int -> a
!! (Int
i forall a. Num a => a -> a -> a
+ Int
1))) 
      Lens' CS Int
index forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
      forall (m :: * -> *). MonadState CS m => m ()
straightenState
    (Bool
_, Bool
True) -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' GlobalState CS
cs forall a b. (a -> b) -> a -> b
$ do
      [Int]
cc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CS [Int]
correctCards
      let thePopup :: Popup GlobalState CS
thePopup = 
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
cc Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
cc forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
sc
              then Popup GlobalState CS
finalPopup
              else Popup GlobalState CS
deckMakerPopup
      Lens' CS (Maybe (Popup GlobalState CS))
popup forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Popup GlobalState CS
thePopup
    (Bool, Bool)
_ -> forall n. EventM n GlobalState ()
halt'

previous :: EventM Name GlobalState ()
previous :: EventM Name GlobalState ()
previous = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' GlobalState CS
cs forall a b. (a -> b) -> a -> b
$ do
  Int
i <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CS Int
index
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
    String
fp <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CS String
pathToFile
    [Card]
sc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CS [Card]
shownCards
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Card -> IO ()
openCardExternal (String -> String
takeDirectory String
fp) ([Card]
sc forall a. [a] -> Int -> a
!! (Int
i forall a. Num a => a -> a -> a
- Int
1))) 
    Lens' CS Int
index forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
    forall (m :: * -> *). MonadState CS m => m ()
straightenState

straightenState :: MonadState CS m => m ()
straightenState :: forall (m :: * -> *). MonadState CS m => m ()
straightenState = do
  [Card]
sc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CS [Card]
shownCards
  Int
i <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CS Int
index
  let card :: Card
card = [Card]
sc forall a. [a] -> Int -> a
!! Int
i
  Lens' CS Card
currentCard forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Card
card
  Lens' CS CardState
cardState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Card -> CardState
defaultCardState Card
card

interchange :: (Ord a) => a -> a -> Map a b -> Map a b
interchange :: forall a b. Ord a => a -> a -> Map a b -> Map a b
interchange a
i a
j Map a b
kvs =
  let vali :: b
vali = Map a b
kvs forall k a. Ord k => Map k a -> k -> a
M.! a
i
      valj :: b
valj = Map a b
kvs forall k a. Ord k => Map k a -> k -> a
M.! a
j in
  forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
j b
vali (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
i b
valj Map a b
kvs)

----------------------------------------------------

---------------------- Popups ----------------------

----------------------------------------------------


isFinalPopup :: PopupState -> Bool
isFinalPopup :: PopupState -> Bool
isFinalPopup PopupState
FinalPopup       = Bool
True
isFinalPopup DeckMakerPopup{} = Bool
True
isFinalPopup PopupState
_                = Bool
False

correctPopup :: Popup GlobalState CS
correctPopup :: Popup GlobalState CS
correctPopup = forall s d.
(d -> Widget Name)
-> (Event -> EventM Name s ()) -> PopupState -> Popup s d
Popup forall {n}. CS -> Widget n
drawer Event -> EventM Name GlobalState ()
eventHandler PopupState
initialState
  where drawer :: CS -> Widget n
drawer CS
s =
          let selected :: Int
selected = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall s d. Lens' (Popup s d) PopupState
popupStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected) (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS (Maybe (Popup GlobalState CS))
popup)
              colorNo :: AttrName
colorNo  = if Int
selected forall a. Eq a => a -> a -> Bool
== Int
0 then AttrName
selectedNoButtonAttr else AttrName
noButtonAttr
              colorYes :: AttrName
colorYes = if Int
selected forall a. Eq a => a -> a -> Bool
== Int
1 then AttrName
selectedYesButtonAttr else AttrName
yesButtonAttr
              no :: Widget n
no = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
colorNo forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"No"
              yes :: Widget n
yes = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
colorYes forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Yes" in
                forall n. Widget n -> Widget n
centerPopup forall a b. (a -> b) -> a -> b
$
                forall n. Widget n -> Widget n -> Widget n
B.borderWithLabel (forall n. String -> Widget n
str String
"Correct?") forall a b. (a -> b) -> a -> b
$
                forall n. Int -> Widget n -> Widget n
hLimit Int
20 forall a b. (a -> b) -> a -> b
$
                forall n. String -> Widget n
str String
" " forall n. Widget n -> Widget n -> Widget n
<=>
                forall n. String -> Widget n
str String
" " forall n. Widget n -> Widget n -> Widget n
<=>
                (forall n. Char -> Widget n
hFill Char
' ' forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n
no forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ' forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n
yes forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ')

        initialState :: PopupState
initialState = Int -> PopupState
CorrectPopup Int
0

        eventHandler :: Event -> EventM Name GlobalState ()
eventHandler Event
ev = do
          Popup GlobalState CS
p <- forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS (Maybe (Popup GlobalState CS))
popup)
          let ps :: (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
ps = Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS (Maybe (Popup GlobalState CS))
popupforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s d. Lens' (Popup s d) PopupState
popupState
          case Event
ev of
            V.EvKey Key
V.KLeft  [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
            V.EvKey Key
V.KRight [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
1
            -- Adding vim shortcuts here

            V.EvKey (V.KChar Char
'h') [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
            V.EvKey (V.KChar Char
'l') [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
1

            V.EvKey Key
V.KEnter [] -> do
               Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS (Maybe (Popup GlobalState CS))
popup forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
               forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Popup GlobalState CS
p forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall s d. Lens' (Popup s d) PopupState
popupStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall a. Eq a => a -> a -> Bool
== Int
1) forall a b. (a -> b) -> a -> b
$
                 do Int
i <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS Int
index
                    Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Int]
correctCards forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int
iforall a. a -> [a] -> [a]
:) 
               EventM Name GlobalState ()
next
            Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

finalPopup :: Popup GlobalState CS
finalPopup :: Popup GlobalState CS
finalPopup = forall s d.
(d -> Widget Name)
-> (Event -> EventM Name s ()) -> PopupState -> Popup s d
Popup forall {n}. CS -> Widget n
drawer forall {n}. Event -> EventM n GlobalState ()
eventHandler PopupState
initialState
  where drawer :: CS -> Widget n
drawer CS
s =
          let wrong :: Widget n
wrong    = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
wrongAttr   (forall n. String -> Widget n
str (String
" Incorrect: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
nWrong)   forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ')
              correct :: Widget n
correct  = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctAttr (forall n. String -> Widget n
str (String
" Correct:   " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
nCorrect) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ')
              nCorrect :: Int
nCorrect = forall (t :: * -> *) a. Foldable t => t a -> Int
length (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS [Int]
correctCards)
              nWrong :: Int
nWrong   = CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
index forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
nCorrect in
                forall n. Widget n -> Widget n
centerPopup forall a b. (a -> b) -> a -> b
$
                forall n. Widget n -> Widget n -> Widget n
B.borderWithLabel (forall n. String -> Widget n
str String
"Finished") forall a b. (a -> b) -> a -> b
$
                forall n. Int -> Widget n -> Widget n
hLimit Int
20 forall a b. (a -> b) -> a -> b
$
                forall n. String -> Widget n
str String
" " forall n. Widget n -> Widget n -> Widget n
<=>
                forall n. Widget n
wrong forall n. Widget n -> Widget n -> Widget n
<=>
                forall n. Widget n
correct

        initialState :: PopupState
initialState = PopupState
FinalPopup

        eventHandler :: Event -> EventM n GlobalState ()
eventHandler (V.EvKey Key
V.KEnter []) = forall n. EventM n GlobalState ()
halt'
        eventHandler Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

deckMakerPopup :: Popup GlobalState CS
deckMakerPopup :: Popup GlobalState CS
deckMakerPopup = forall s d.
(d -> Widget Name)
-> (Event -> EventM Name s ()) -> PopupState -> Popup s d
Popup forall {n}. CS -> Widget n
drawer forall {n}. Event -> EventM n GlobalState ()
eventHandler PopupState
initialState
  where drawer :: CS -> Widget n
drawer CS
s =
          let state :: PopupState
state    = forall b a. b -> (a -> b) -> Maybe a -> b
maybe PopupState
initialState (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s d. Lens' (Popup s d) PopupState
popupState) (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS (Maybe (Popup GlobalState CS))
popup)
              j :: Int
j = PopupState
state forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Traversal' PopupState Int
popupSelected

              makeSym :: Getting (Endo Bool) PopupState Bool -> Int -> Widget n
makeSym Getting (Endo Bool) PopupState Bool
lens Int
i = case (PopupState
state forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Bool) PopupState Bool
lens, Int
i forall a. Eq a => a -> a -> Bool
== Int
j) of
                (Bool
_, Bool
True) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightedOptAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"*"
                (Bool
True, Bool
_) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedOptAttr    forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"*"
                (Bool, Bool)
_         -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedOptAttr    forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
" "

              makeBox :: Getting (Endo Bool) PopupState Bool -> Int -> Widget n
makeBox Getting (Endo Bool) PopupState Bool
lens Int
i =
                (if PopupState
state forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Bool) PopupState Bool
lens then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedOptAttr else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
                  forall n. String -> Widget n
str String
"[" forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Getting (Endo Bool) PopupState Bool -> Int -> Widget n
makeSym Getting (Endo Bool) PopupState Bool
lens Int
i forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str String
"]"

              wBox :: Widget n
wBox = forall {n}. Getting (Endo Bool) PopupState Bool -> Int -> Widget n
makeBox Traversal' PopupState Bool
makeDeckIncorrect Int
0
              cBox :: Widget n
cBox = forall {n}. Getting (Endo Bool) PopupState Bool -> Int -> Widget n
makeBox Traversal' PopupState Bool
makeDeckCorrect Int
1

              wrong :: Widget n
wrong    = forall n. Widget n
wBox forall n. Widget n -> Widget n -> Widget n
<+> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
wrongAttr   (forall n. String -> Widget n
str (String
" Incorrect: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
nWrong)   forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ')
              correct :: Widget n
correct  = forall n. Widget n
cBox forall n. Widget n -> Widget n -> Widget n
<+> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctAttr (forall n. String -> Widget n
str (String
" Correct:   " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
nCorrect) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ')
              nCorrect :: Int
nCorrect = forall (t :: * -> *) a. Foldable t => t a -> Int
length (CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS [Int]
correctCards)
              nWrong :: Int
nWrong   = CS
sforall s a. s -> Getting a s a -> a
^.Lens' CS Int
index forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
nCorrect in
                forall n. Widget n -> Widget n
centerPopup forall a b. (a -> b) -> a -> b
$
                forall n. Widget n -> Widget n -> Widget n
B.borderWithLabel (forall n. String -> Widget n
str String
"Generate decks") forall a b. (a -> b) -> a -> b
$
                forall n. Int -> Widget n -> Widget n
hLimit Int
20 forall a b. (a -> b) -> a -> b
$
                forall n. String -> Widget n
str String
" " forall n. Widget n -> Widget n -> Widget n
<=>
                forall n. Widget n
wrong forall n. Widget n -> Widget n -> Widget n
<=>
                forall n. Widget n
correct forall n. Widget n -> Widget n -> Widget n
<=>
                forall n. String -> Widget n
str String
" " forall n. Widget n -> Widget n -> Widget n
<=>
                forall n. Widget n -> Widget n
C.hCenter ((if Int
j forall a. Eq a => a -> a -> Bool
== Int
2 then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedAttr else forall a. a -> a
id) (forall n. String -> Widget n
str String
"Ok"))

        initialState :: PopupState
initialState = Int -> Bool -> Bool -> PopupState
DeckMakerPopup Int
0 Bool
False Bool
False

        eventHandler :: Event -> EventM n GlobalState ()
eventHandler Event
ev = do
          [Int]
im <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Int]
indexMapping
          [Int]
ccs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Int]
correctCards
          let originalCorrects :: [Int]
originalCorrects = 
                forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a. Num a => a -> a
negate (forall a b. (a -> b) -> [a] -> [b]
map ([Int]
im forall a. [a] -> Int -> a
!!) [Int]
ccs)
          Popup GlobalState CS
p <- forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS (Maybe (Popup GlobalState CS))
popup)
          let ps :: (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
ps = Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS (Maybe (Popup GlobalState CS))
popupforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s d. Lens' (Popup s d) PopupState
popupState
          let state :: PopupState
state = Popup GlobalState CS
p forall s a. s -> Getting a s a -> a
^. forall s d. Lens' (Popup s d) PopupState
popupState

          case PopupState
state forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Traversal' PopupState Int
popupSelected of
            Int
0 -> case Event
ev of
              V.EvKey Key
V.KEnter []      -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Bool
makeDeckIncorrect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
              V.EvKey Key
V.KDown  []      -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
              V.EvKey (V.KChar Char
'j') [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
              Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Int
1 -> case Event
ev of
              V.EvKey Key
V.KEnter []      -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Bool
makeDeckCorrect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
              V.EvKey Key
V.KDown  []      -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
              V.EvKey (V.KChar Char
'j') [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
              V.EvKey Key
V.KUp  []        -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
              V.EvKey (V.KChar Char
'k') [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
              Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Int
2 -> case Event
ev of
              V.EvKey Key
V.KEnter []      -> do
                String
fp <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS String
pathToFile
                [Card]
ocs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GlobalState CS
csforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' CS [Card]
originalCards
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> [Card] -> [Int] -> Bool -> Bool -> IO ()
generateDecks String
fp [Card]
ocs [Int]
originalCorrects (PopupState
state forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Traversal' PopupState Bool
makeDeckCorrect) (PopupState
state forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Traversal' PopupState Bool
makeDeckIncorrect)
                forall n. EventM n GlobalState ()
halt'
              V.EvKey Key
V.KUp  []        -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
              V.EvKey (V.KChar Char
'k') [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
psforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' PopupState Int
popupSelected forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
              Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

generateDecks :: FilePath -> [Card] -> [Int] -> Bool -> Bool -> IO ()
generateDecks :: String -> [Card] -> [Int] -> Bool -> Bool -> IO ()
generateDecks String
fp [Card]
cards [Int]
corrects Bool
makeCorrect Bool
makeIncorrect =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
makeCorrect Bool -> Bool -> Bool
|| Bool
makeIncorrect) forall a b. (a -> b) -> a -> b
$
    do let ([Card]
correct, [Card]
incorrect) = [Card] -> [Int] -> ([Card], [Card])
splitCorrectIncorrect [Card]
cards [Int]
corrects
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
makeCorrect   forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile (String -> String -> String
replaceBaseName String
fp (String -> String
takeBaseName String
fp forall a. Semigroup a => a -> a -> a
<> String
"+")) ([Card] -> String
cardsToString [Card]
correct)
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
makeIncorrect forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile (String -> String -> String
replaceBaseName String
fp (String -> String
takeBaseName String
fp forall a. Semigroup a => a -> a -> a
<> String
"-")) ([Card] -> String
cardsToString [Card]
incorrect)

-- gets list of cards, list of indices of correct cards in decreasing order; returns (correct, incorrect)

splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])
splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])
splitCorrectIncorrect [Card]
cards [Int]
indices = forall {a} {a}. Eq a => [a] -> [a] -> [(a, a)] -> [a] -> ([a], [a])
doSplit [] [] (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Card]
cards) (forall a. [a] -> [a]
reverse [Int]
indices)
  where doSplit :: [a] -> [a] -> [(a, a)] -> [a] -> ([a], [a])
doSplit [a]
cs [a]
ws [] [a]
_  = (forall a. [a] -> [a]
reverse [a]
cs, forall a. [a] -> [a]
reverse [a]
ws)
        doSplit [a]
cs [a]
ws ((a
_, a
x):[(a, a)]
xs) [] = [a] -> [a] -> [(a, a)] -> [a] -> ([a], [a])
doSplit [a]
cs (a
xforall a. a -> [a] -> [a]
:[a]
ws) [(a, a)]
xs []
        doSplit [a]
cs [a]
ws ((a
j, a
x):[(a, a)]
xs) (a
i:[a]
is) =
          if a
i forall a. Eq a => a -> a -> Bool
== a
j
            then [a] -> [a] -> [(a, a)] -> [a] -> ([a], [a])
doSplit (a
xforall a. a -> [a] -> [a]
:[a]
cs) [a]
ws [(a, a)]
xs [a]
is
            else [a] -> [a] -> [(a, a)] -> [a] -> ([a], [a])
doSplit [a]
cs (a
xforall a. a -> [a] -> [a]
:[a]
ws) [(a, a)]
xs (a
iforall a. a -> [a] -> [a]
:[a]
is)