module UI.Cards (Card, State(..), drawUI, handleEvent, theMap) where

import Brick
import Control.Monad
import Control.Monad.IO.Class
import Lens.Micro.Platform
import Types
import States
import StateManagement
import Data.Char (isSpace, toLower)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.Maybe
import Data.List.Split
import Text.Wrap
import Data.Text (pack)
import UI.Attributes
import UI.BrickHelpers
import System.FilePath
import Data.List (intercalate)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Map.Strict as M
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 =  [Widget Name
-> (Popup CS -> Widget Name) -> Maybe (Popup CS) -> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall n. Widget n
emptyWidget (Popup CS -> CS -> Widget Name
forall s. Popup s -> s -> Widget Name
`drawPopup` CS
s) (CS
sCS
-> Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
-> Maybe (Popup CS)
forall s a. s -> Getting a s a -> a
^.Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
Lens' CS (Maybe (Popup CS))
popup), CS -> Widget Name
drawCardUI CS
s Widget Name -> Widget Name -> Widget Name
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 CS -> Getting Bool CS Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool CS Bool
Lens' CS Bool
showControls) then Widget Name
forall n. Widget n
emptyWidget else
  String -> Widget Name
forall n. String -> Widget n
strWrap (String -> Widget Name)
-> (String -> String) -> String -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"ESC: quit" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ case CS
s CS -> Getting CardState CS CardState -> CardState
forall s a. s -> Getting a s a -> a
^. Getting CardState CS CardState
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, F1: show answer"
    ReorderState {}        -> String
", ENTER: grab, c: submit answer"

drawCardBox :: Widget Name -> Widget Name
drawCardBox :: Widget Name -> Widget Name
drawCardBox Widget Name
w = Widget Name -> Widget Name
forall n. Widget n -> Widget n
C.center (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                BorderStyle -> Widget Name -> Widget Name
forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
BS.unicodeRounded (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                Widget Name -> Widget Name
forall n. Widget n -> Widget n
B.border (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
textboxAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                Int -> Widget Name -> Widget Name
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
sCS -> Getting Bool CS Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool CS Bool
Lens' CS Bool
reviewMode
  then Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name
forall n. Widget n
wrong Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall n. Widget n
progress Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall n. Widget n
correct
  else Widget Name
forall n. Widget n
progress
  -- not guaranteed that progress is horizontally centered i think
  where progress :: Widget n
progress = Widget n -> Widget n
forall n. Widget n -> Widget n
C.hCenter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
nCards))
        wrong :: Widget n
wrong = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
wrongAttr (String -> Widget n
forall n. String -> Widget n
str (String
"✗ " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
nWrong))
        correct :: Widget n
correct = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctAttr (String -> Widget n
forall n. String -> Widget n
str (String
"✓ " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
nCorrect))
        nCorrect :: Int
nCorrect = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CS
sCS -> Getting [Int] CS [Int] -> [Int]
forall s a. s -> Getting a s a -> a
^.Getting [Int] CS [Int]
Lens' CS [Int]
correctCards)
        nWrong :: Int
nWrong = CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nCorrect Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
endCard then Int
1 else Int
0)
        endCard :: Bool
endCard = Bool -> (Popup CS -> Bool) -> Maybe (Popup CS) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (PopupState -> Bool
isFinalPopup (PopupState -> Bool)
-> (Popup CS -> PopupState) -> Popup CS -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting PopupState (Popup CS) PopupState -> Popup CS -> PopupState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PopupState (Popup CS) PopupState
forall s. Lens' (Popup s) PopupState
popupState) (CS
sCS
-> Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
-> Maybe (Popup CS)
forall s a. s -> Getting a s a -> a
^.Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
Lens' CS (Maybe (Popup CS))
popup)

drawCardUI :: CS -> Widget Name
drawCardUI :: CS -> Widget Name
drawCardUI CS
s = let p :: Int
p = Int
1 in
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
joinBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
drawCardBox (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> CS -> Widget Name
drawFooter CS
s) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  case (CS
s CS -> Getting [Card] CS [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^. Getting [Card] CS [Card]
Lens' CS [Card]
cards) [Card] -> Int -> Card
forall a. [a] -> Int -> a
!! (CS
s CS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int CS Int
Lens' CS Int
index) of
    Definition String
title Maybe External
_ String
descr -> String -> Widget Name
drawHeader String
title
                          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
B.hBorder
                          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
p (CS -> String -> Widget Name
drawDef CS
s String
descr Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
str String
" ")

    MultipleChoice String
question Maybe External
_ CorrectOption
correct [IncorrectOption]
others -> String -> Widget Name
drawHeader String
question
                                          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
B.hBorder
                                          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
p (CS -> [String] -> Widget Name
drawChoices CS
s (CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice CorrectOption
correct [IncorrectOption]
others) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
str String
" ")

    OpenQuestion String
title Maybe External
_ Perforated
perforated -> String -> Widget Name
drawHeader String
title
                                 Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
B.hBorder
                                 Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
p (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
atLeastV Int
1 (CS -> Perforated -> Widget Name
drawPerforated CS
s Perforated
perforated) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
str String
" ")

    MultipleAnswer String
question Maybe External
_ NonEmpty Option
options -> String -> Widget Name
drawHeader String
question
                                   Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
B.hBorder
                                   Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
p) (CS -> NonEmpty Option -> Widget Name
drawOptions CS
s NonEmpty Option
options Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
str String
" ")

    Reorder String
question Maybe External
_ NonEmpty (Int, String)
_ -> String -> Widget Name
drawHeader String
question
                      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
B.hBorder
                      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
p (CS -> Widget Name
drawReorder CS
s Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
str String
" ")

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

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

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

             where formattedOptions :: [Widget Name]
                   formattedOptions :: [Widget Name]
formattedOptions = [ Widget Name
forall n. Widget n
prefix Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name -> Widget Name
forall n. Widget n -> Widget n
coloring (String -> Widget Name
drawDescr String
opt) |
                                        (Int
j, String
opt) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
options,
                                        let prefix :: Widget n
prefix = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightedChoiceAttr (String -> Widget n
forall n. String -> Widget n
str String
"* ") else String -> Widget n
forall n. String -> Widget n
str String
"  "
                                            chosen :: Bool
chosen = Bool -> Int -> Map Int Bool -> Bool
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
False Int
j Map Int Bool
kvs
                                            coloring :: Widget n -> Widget n
coloring = case (Bool
chosen, Int
jInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
k) of
                                              (Bool
False, Bool
_)    -> Widget n -> Widget n
forall a. a -> a
id
                                              (Bool
True, Bool
False) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
incorrectChoiceAttr
                                              (Bool
True, Bool
True)  -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctChoiceAttr
                                          ]
  (CardState, Card)
_ -> String -> Widget Name
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 CS -> Getting CardState CS CardState -> CardState
forall s a. s -> Getting a s a -> a
^. Getting CardState CS CardState
Lens' CS CardState
cardState, CS
s CS -> Getting Card CS Card -> Card
forall s a. s -> Getting a s a -> a
^. Getting Card CS Card
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
_) ->
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> (NonEmpty Option -> [Widget Name])
-> NonEmpty Option
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Widget Name) -> [Widget Name]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Widget Name) -> [Widget Name])
-> (NonEmpty Option -> NonEmpty (Widget Name))
-> NonEmpty Option
-> [Widget Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ((Option, Int) -> Widget Name)
-> NonEmpty (Option, Int) -> NonEmpty (Widget Name)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (Option, Int) -> Widget Name
drawOption (NonEmpty (Option, Int) -> NonEmpty (Widget Name))
-> (NonEmpty Option -> NonEmpty (Option, Int))
-> NonEmpty Option
-> NonEmpty (Widget Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Option -> NonEmpty Int -> NonEmpty (Option, Int)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
`NE.zip` [Int] -> NonEmpty Int
forall a. [a] -> NonEmpty a
NE.fromList [Int
0..])
      where drawOption :: (Option, Int) -> Widget Name
drawOption (Option Type
kind String
text, Int
i) = Widget Name -> Widget Name
forall n. Widget n -> Widget n
coloring (String -> Widget Name
forall n. String -> Widget n
str String
"[") Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name -> Widget Name
forall n. Widget n -> Widget n
coloring (Widget Name -> Widget Name
forall n. Widget n -> Widget n
highlighting (String -> Widget Name
forall n. String -> Widget n
str String
symbol)) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name -> Widget Name
forall n. Widget n -> Widget n
coloring (String -> Widget Name
forall n. String -> Widget n
str String
"] ") Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
drawDescr String
text
              where symbol :: String
symbol = if (Int
i Int -> Int -> Bool
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 = Bool -> Int -> Map Int Bool -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightedOptAttr else Widget n -> Widget n
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) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctOptAttr
                                  (Bool
True, Bool
False, Type
Incorrect) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctOptAttr
                                  (Bool
True, Bool
_, Type
_) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
incorrectOptAttr
                                  (Bool
False, Bool
True, Type
_) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedOptAttr
                                  (Bool, Bool, Type)
_ -> Widget n -> Widget n
forall a. a -> a
id

  (CardState, Card)
_ -> String -> NonEmpty Option -> Widget Name
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 (Sentence -> Widget Name) -> Sentence -> Widget Name
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 = Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
  Context
c <- RenderM Name Context
forall n. RenderM n Context
getContext
  let w :: Int
w = Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL
  Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
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 = [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> (Sentence -> [Widget Name]) -> Sentence -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Widget Name], Bool) -> [Widget Name]
forall a b. (a, b) -> a
fst (([Widget Name], Bool) -> [Widget Name])
-> (Sentence -> ([Widget Name], Bool)) -> Sentence -> [Widget Name]
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 CS -> Getting CardState CS CardState -> CardState
forall s a. s -> Getting a s a -> a
^. Getting CardState CS CardState
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
            gap :: String
gap = String -> Int -> Map Int String -> String
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault String
"" Int
i Map Int String
kvs
            n' :: Int
n' =  Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then Name -> Location -> Widget Name -> Widget Name
forall n. n -> Location -> Widget n -> Widget n
showCursor Name
Ordinary ((Int, Int) -> Location
Location (String -> Int
forall a. TextWidth a => a -> Int
textWidth String
gap, Int
0)) else Widget Name -> Widget Name
forall a. a -> a
id

            correct :: Bool
correct = Bool -> Int -> Map Int Bool -> Bool
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
_) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
gapAttr
              (Bool
True, Bool
False) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
incorrectGapAttr
              (Bool
True, Bool
True) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
correctGapAttr

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

              if Int
n' Int -> Int -> Bool
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
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n') (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Sentence
post in
                  if Bool
fit then (([Widget Name]
ws [Widget Name] -> ([Widget Name] -> [Widget Name]) -> [Widget Name]
forall a b. a -> (a -> b) -> b
& (Widget Name -> Identity (Widget Name))
-> [Widget Name] -> Identity [Widget Name]
forall s a. Snoc s s a a => Traversal' s a
_last ((Widget Name -> Identity (Widget Name))
 -> [Widget Name] -> Identity [Widget Name])
-> (Widget Name -> Widget Name) -> [Widget Name] -> [Widget Name]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> (Widget Name
gapWidget Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
w'))) [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name]
ws', Bool
fit')
                  else (([Widget Name]
ws [Widget Name] -> ([Widget Name] -> [Widget Name]) -> [Widget Name]
forall a b. a -> (a -> b) -> b
& (Widget Name -> Identity (Widget Name))
-> [Widget Name] -> Identity [Widget Name]
forall s a. Snoc s s a a => Traversal' s a
_last ((Widget Name -> Identity (Widget Name))
 -> [Widget Name] -> Identity [Widget Name])
-> (Widget Name -> Widget Name) -> [Widget Name] -> [Widget Name]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
gapWidget)) [Widget Name] -> [Widget Name] -> [Widget Name]
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' (String -> Int
forall a. TextWidth a => a -> Int
textWidth String
gap) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Sentence
post in
                if Bool
fit then ([Widget Name]
ws [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name
gapWidget Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
w'] [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name]
ws', Bool
fit')
                else ([Widget Name]
ws [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name
gapWidget] [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name]
ws1, Bool
fit')
      CardState
_ -> String -> ([Widget Name], Bool)
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
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> [String]
words String
s) = ([String -> Widget Name
forall n. String -> Widget n
str String
""], Int
padding, Bool
True)
  | Bool
otherwise = if String -> Int
forall a. TextWidth a => a -> Int
textWidth ([String] -> String
forall a. [a] -> a
head (String -> [String]
words String
s)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
padding then
    let startsWithSpace :: Bool
startsWithSpace = String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
        s' :: String
s' = if Bool
startsWithSpace then String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padding Char
'X' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. [a] -> [a]
tail String
s else Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padding Char
'X' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
        lastLetter :: Char
lastLetter = String -> Char
forall a. [a] -> a
last String
s
        prefix :: Text
prefix = if String -> Char
forall a. [a] -> a
head String
s Char -> String -> Bool
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 Char -> Char -> Bool
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') [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Index [Text] -> Traversal' [Text] (IxValue [Text])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [Text]
0 ((Text -> Identity Text) -> [Text] -> Identity [Text])
-> (Text -> Text) -> [Text] -> [Text]
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`) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop (Int
padding Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) else Int -> Text -> Text
T.drop Int
padding)
        ts' :: [Text]
ts' = Text
prefix Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ([Text]
ts [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> [Text] -> Identity [Text]
forall s a. Snoc s s a a => Traversal' s a
_last ((Text -> Identity Text) -> [Text] -> Identity [Text])
-> (Text -> Text) -> [Text] -> [Text]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Text -> Text
`T.append` Text
postfix))
        padding' :: Int
padding' = Text -> Int
forall a. TextWidth a => a -> Int
textWidth ([Text] -> Text
forall a. [a] -> a
last [Text]
ts') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ts' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Int
1 else Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
padding in
          ((Text -> Widget Name) -> [Text] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget Name
forall n. Text -> Widget n
txt ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
T.empty) [Text]
ts'), Int
padding', Bool
True)
  else
    let lastLetter :: Char
lastLetter = String -> Char
forall a. [a] -> a
last String
s
        (Char
x: String
xs) = String
s
        s' :: String
s' = if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then String
xs else String
s
        postfix :: Text
postfix = if Char
lastLetter Char -> Char -> Bool
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 [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> [Text] -> Identity [Text]
forall s a. Snoc s s a a => Traversal' s a
_last ((Text -> Identity Text) -> [Text] -> Identity [Text])
-> (Text -> Text) -> [Text] -> [Text]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Text -> Text
`T.append` Text
postfix) in
    ((Text -> Widget Name) -> [Text] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget Name
forall n. Text -> Widget n
txt ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
T.empty) [Text]
ts'), Text -> Int
forall a. TextWidth a => a -> Int
textWidth ([Text] -> Text
forall a. [a] -> a
last [Text]
ts'), Bool
False)

drawReorder :: CS -> Widget Name
drawReorder :: CS -> Widget Name
drawReorder CS
s = case (CS
s CS -> Getting CardState CS CardState -> CardState
forall s a. s -> Getting a s a -> a
^. Getting CardState CS CardState
Lens' CS CardState
cardState, CS
s CS -> Getting Card CS Card -> Card
forall s a. s -> Getting a s a -> a
^. Getting Card CS Card
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{}) ->
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> (((Int, (Int, String)) -> Widget Name) -> [Widget Name])
-> ((Int, (Int, String)) -> Widget Name)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int, (Int, String)) -> Widget Name)
 -> [(Int, (Int, String))] -> [Widget Name])
-> [(Int, (Int, String))]
-> ((Int, (Int, String)) -> Widget Name)
-> [Widget Name]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, (Int, String)) -> Widget Name)
-> [(Int, (Int, String))] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> (Int, (Int, String))) -> [Int] -> [(Int, (Int, String))]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Int
i, Map Int (Int, String)
kvs Map Int (Int, String) -> Int -> (Int, String)
forall k a. Ord k => Map k a -> k -> a
M.! Int
i)) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) (((Int, (Int, String)) -> Widget Name) -> Widget Name)
-> ((Int, (Int, String)) -> Widget Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$
    \(Int
i, (Int
k, String
text)) ->
      let color :: Widget n -> Widget n
color = case (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j,  Bool
g) of
                  (Bool
True, Bool
True ) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
grabbedElementAttr
                  (Bool
True, Bool
False) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightedElementAttr
                  (Bool, Bool)
_             -> Widget n -> Widget n
forall a. a -> a
id

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

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

----------------------------------------------------
---------------------- Events ----------------------
----------------------------------------------------
halt' :: GlobalState -> EventM n (Next GlobalState)
halt' :: GlobalState -> EventM n (Next GlobalState)
halt' = (GlobalState -> Mode -> EventM n (Next GlobalState))
-> Mode -> GlobalState -> EventM n (Next GlobalState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((State -> IO State)
-> GlobalState -> Mode -> EventM n (Next GlobalState)
forall n.
(State -> IO State)
-> GlobalState -> Mode -> EventM n (Next GlobalState)
removeToModeOrQuit' (\(CardSelectorState CSS
s) -> CSS -> State
CardSelectorState (CSS -> State) -> IO CSS -> IO State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSS -> IO CSS
refreshRecents CSS
s)) Mode
CardSelector

handleEvent :: GlobalState -> CS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent :: GlobalState
-> CS -> BrickEvent Name Event -> EventM Name (Next GlobalState)
handleEvent GlobalState
gs CS
s (VtyEvent Event
e) =
  let update :: CS -> GlobalState
update = GlobalState -> CS -> GlobalState
updateCS GlobalState
gs
      continue' :: CS -> EventM n (Next GlobalState)
continue' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (CS -> GlobalState) -> CS -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CS -> GlobalState
update in
    case Event
e of
      V.EvKey Key
V.KEsc []                -> GlobalState -> EventM Name (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
popStateOrQuit GlobalState
gs
      V.EvKey Key
V.KRight [Modifier
V.MCtrl]       -> if Bool -> Bool
not (CS
sCS -> Getting Bool CS Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool CS Bool
Lens' CS Bool
reviewMode) then GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs CS
s else GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs
      V.EvKey Key
V.KLeft  [Modifier
V.MCtrl]       -> if Bool -> Bool
not (CS
sCS -> Getting Bool CS Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool CS Bool
Lens' CS Bool
reviewMode) then GlobalState -> CS -> EventM Name (Next GlobalState)
previous GlobalState
gs CS
s else GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs

      Event
ev ->
        (EventM Name (Next GlobalState)
 -> Maybe (Popup CS) -> EventM Name (Next GlobalState))
-> Maybe (Popup CS)
-> EventM Name (Next GlobalState)
-> EventM Name (Next GlobalState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (EventM Name (Next GlobalState)
-> (Popup CS -> EventM Name (Next GlobalState))
-> Maybe (Popup CS)
-> EventM Name (Next GlobalState)
forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` (\Popup CS
p -> Popup CS
-> GlobalState -> CS -> Event -> EventM Name (Next GlobalState)
forall s.
Popup s
-> GlobalState -> s -> Event -> EventM Name (Next GlobalState)
handlePopupEvent Popup CS
p GlobalState
gs CS
s Event
ev)) (CS
s CS
-> Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
-> Maybe (Popup CS)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
Lens' CS (Maybe (Popup CS))
popup) (EventM Name (Next GlobalState) -> EventM Name (Next GlobalState))
-> EventM Name (Next GlobalState) -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$
          case (CS
s CS -> Getting CardState CS CardState -> CardState
forall s a. s -> Getting a s a -> a
^. Getting CardState CS CardState
Lens' CS CardState
cardState, CS
s CS -> Getting Card CS Card -> Card
forall s a. s -> Getting a s a -> a
^. Getting Card CS Card
Lens' CS Card
currentCard) of
            (DefinitionState{_flipped :: CardState -> Bool
_flipped = Bool
f}, Card
_) ->
              case Event
ev of
                V.EvKey Key
V.KEnter []  ->
                  if Bool
f
                    then if Bool -> Bool
not (CS
sCS -> Getting Bool CS Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool CS Bool
Lens' CS Bool
reviewMode) then GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs CS
s
                      else CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Popup CS
correctPopup)
                    else CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> (Bool -> Identity Bool)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
flipped ((Bool -> Identity Bool) -> CS -> Identity CS)
-> (Bool -> Bool) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not
                Event
_ -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s

            (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 [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
up
                V.EvKey (V.KChar Char
'k') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
up
                V.EvKey Key
V.KDown [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
down
                V.EvKey (V.KChar Char
'j') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
down

                V.EvKey Key
V.KEnter [] ->
                    if Bool
frozen
                      then GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& if Bool
correctlyAnswered then ([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> [Int]) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
indexInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) else CS -> CS
forall a. a -> a
id
                      else CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Map Int Bool -> Identity (Map Int Bool))
    -> CardState -> Identity CardState)
-> (Map Int Bool -> Identity (Map Int Bool))
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int Bool -> Identity (Map Int Bool))
-> CardState -> Identity CardState
Traversal' CardState (Map Int Bool)
tried ((Map Int Bool -> Identity (Map Int Bool)) -> CS -> Identity CS)
-> (Map Int Bool -> Map Int Bool) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Bool -> Map Int Bool -> Map Int Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
i Bool
True
                Event
_ -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s

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

                    down :: CS
down = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen
                            then CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1
                            else CS
s

                    up :: CS
up = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen
                          then CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1
                          else CS
s

                    correctlyAnswered :: Bool
correctlyAnswered = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Map Int Bool -> Int
forall k a. Map k a -> Int
M.size ((Bool -> Bool) -> Map Int Bool -> Map Int Bool
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
True) Map Int Bool
kvs) Int -> Int -> Bool
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 [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
up
                V.EvKey (V.KChar Char
'k') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
up
                V.EvKey Key
V.KDown [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
down
                V.EvKey (V.KChar Char
'j') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
down

                V.EvKey (V.KChar Char
'c') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> (Bool -> Identity Bool)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
entered) ((Bool -> Identity Bool) -> CS -> Identity CS) -> Bool -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

                V.EvKey Key
V.KEnter [] ->
                    if Bool
frozen
                      then GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& if Bool
correctlyAnswered then ([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> [Int]) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
indexInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) else CS -> CS
forall a. a -> a
id
                      else CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Map Int Bool -> Identity (Map Int Bool))
    -> CardState -> Identity CardState)
-> (Map Int Bool -> Identity (Map Int Bool))
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int Bool -> Identity (Map Int Bool))
-> CardState -> Identity CardState
Traversal' CardState (Map Int Bool)
selected ((Map Int Bool -> Identity (Map Int Bool)) -> CS -> Identity CS)
-> (Map Int Bool -> Map Int Bool) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Bool -> Bool) -> Int -> Map Int Bool -> Map Int Bool
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 GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& if Bool
correctlyAnswered then ([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> [Int]) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
indexInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) else CS -> CS
forall a. a -> a
id
                      else CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Map Int Bool -> Identity (Map Int Bool))
    -> CardState -> Identity CardState)
-> (Map Int Bool -> Identity (Map Int Bool))
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int Bool -> Identity (Map Int Bool))
-> CardState -> Identity CardState
Traversal' CardState (Map Int Bool)
selected ((Map Int Bool -> Identity (Map Int Bool)) -> CS -> Identity CS)
-> (Map Int Bool -> Map Int Bool) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Bool -> Bool) -> Int -> Map Int Bool -> Map Int Bool
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust Bool -> Bool
not Int
i


                Event
_ -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s


              where frozen :: Bool
frozen = Bool
submitted

                    down :: CS
down = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen
                            then CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1
                            else CS
s

                    up :: CS
up = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen
                          then CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1
                          else CS
s

                    correctlyAnswered :: Bool
correctlyAnswered = NonEmpty Bool -> [Bool]
forall a. NonEmpty a -> [a]
NE.toList ((Option -> Bool) -> NonEmpty Option -> NonEmpty Bool
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map Option -> Bool
isOptionCorrect NonEmpty Option
opts) [Bool] -> [Bool] -> Bool
forall a. Eq a => a -> a -> Bool
== ((Int, Bool) -> Bool) -> [(Int, Bool)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd (Map Int Bool -> [(Int, Bool)]
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) ->
              let frozen :: Bool
frozen = (Bool -> Bool -> Bool) -> Bool -> Map Int Bool -> Bool
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr Bool -> Bool -> Bool
(&&) Bool
True Map Int Bool
cGaps in
                case Event
ev of
                  V.EvKey (V.KFun Int
1) [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$
                    CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Map Int String -> Identity (Map Int String))
    -> CardState -> Identity CardState)
-> (Map Int String -> Identity (Map Int String))
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int String -> Identity (Map Int String))
-> CardState -> Identity CardState
Traversal' CardState (Map Int String)
gapInput ((Map Int String -> Identity (Map Int String))
 -> CS -> Identity CS)
-> Map Int String -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Int String
correctAnswers
                      CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> (Bool -> Identity Bool)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
entered ((Bool -> Identity Bool) -> CS -> Identity CS) -> Bool -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
                      CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> (Bool -> Identity Bool)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
failed ((Bool -> Identity Bool) -> CS -> Identity CS) -> Bool -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
                      CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Map Int Bool -> Identity (Map Int Bool))
    -> CardState -> Identity CardState)
-> (Map Int Bool -> Identity (Map Int Bool))
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int Bool -> Identity (Map Int Bool))
-> CardState -> Identity CardState
Traversal' CardState (Map Int Bool)
correctGaps ((Map Int Bool -> Identity (Map Int Bool)) -> CS -> Identity CS)
-> Map Int Bool -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Int, Bool)] -> Map Int Bool
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(Int
i, Bool
True) | Int
i <- [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
                          where correctAnswers :: Map Int String
correctAnswers = [(Int, String)] -> Map Int String
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList ([(Int, String)] -> Map Int String)
-> [(Int, String)] -> Map Int String
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([String] -> [(Int, String)]) -> [String] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ (NonEmpty String -> String) -> [NonEmpty String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty String -> String
forall a. NonEmpty a -> a
NE.head (Sentence -> [NonEmpty String]
sentenceToGaps (Perforated -> Sentence
perforatedToSentence Perforated
perforated))

                  V.EvKey (V.KChar Char
'\t') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$
                    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen
                      then CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1
                      else CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0

                  V.EvKey Key
V.KRight [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$
                    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen
                      then CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1
                      else CS
s

                  V.EvKey Key
V.KLeft [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$
                    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen
                      then CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1
                      else CS
s

                  -- C-w deletes a word back (eg. "test test" -> "test")
                  V.EvKey (V.KChar Char
'w') [Modifier
V.MCtrl] ->  CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$
                      if Bool
frozen then CS
s else CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((String -> Identity String) -> CardState -> Identity CardState)
-> (String -> Identity String)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int String -> Identity (Map Int String))
-> CardState -> Identity CardState
Traversal' CardState (Map Int String)
gapInput((Map Int String -> Identity (Map Int String))
 -> CardState -> Identity CardState)
-> ((String -> Identity String)
    -> Map Int String -> Identity (Map Int String))
-> (String -> Identity String)
-> CardState
-> Identity CardState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (Map Int String)
-> Traversal' (Map Int String) (IxValue (Map Int String))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Map Int String)
i ((String -> Identity String) -> CS -> Identity CS)
-> (String -> String) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> String
backword
                    where backword :: String -> String
backword String
"" = String
""
                          backword String
xs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
init ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
xs

                  V.EvKey (V.KChar Char
c) [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$
                    if Bool
frozen then CS
s else CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((String -> Identity String) -> CardState -> Identity CardState)
-> (String -> Identity String)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int String -> Identity (Map Int String))
-> CardState -> Identity CardState
Traversal' CardState (Map Int String)
gapInput((Map Int String -> Identity (Map Int String))
 -> CardState -> Identity CardState)
-> ((String -> Identity String)
    -> Map Int String -> Identity (Map Int String))
-> (String -> Identity String)
-> CardState
-> Identity CardState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (Map Int String)
-> Lens' (Map Int String) (Maybe (IxValue (Map Int String)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index (Map Int String)
i((Maybe String -> Identity (Maybe String))
 -> Map Int String -> Identity (Map Int String))
-> ((String -> Identity String)
    -> Maybe String -> Identity (Maybe String))
-> (String -> Identity String)
-> Map Int String
-> Identity (Map Int String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Lens' (Maybe String) String
forall a. Eq a => a -> Lens' (Maybe a) a
non String
"" ((String -> Identity String) -> CS -> Identity CS)
-> (String -> String) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
c])

                  V.EvKey Key
V.KEnter [] -> if Bool
frozen
                    then if Bool
fail
                      then GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs CS
s
                      else GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs (CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> [Int]) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
indexInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:))
                    else CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s''
                      where 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
sCS -> Getting Bool CS Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool CS Bool
Lens' CS Bool
isCaseSensitive
                              then String -> NonEmpty String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
                              else (\String
word NonEmpty String
possibilites -> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
word String -> NonEmpty String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String -> String) -> NonEmpty String -> NonEmpty String
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) NonEmpty String
possibilites)

                            s' :: CS
s' = CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Map Int Bool -> Identity (Map Int Bool))
    -> CardState -> Identity CardState)
-> (Map Int Bool -> Identity (Map Int Bool))
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int Bool -> Identity (Map Int Bool))
-> CardState -> Identity CardState
Traversal' CardState (Map Int Bool)
correctGaps) ((Map Int Bool -> Identity (Map Int Bool)) -> CS -> Identity CS)
-> (Map Int Bool -> Map Int Bool) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Bool -> Bool) -> Map Int Bool -> Map Int Bool
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\Int
j Bool
_ -> String -> Int -> Map Int String -> String
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 [NonEmpty String] -> Int -> NonEmpty String
forall a. [a] -> Int -> a
!! Int
j))
                                  CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> (Bool -> Identity Bool)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
entered) ((Bool -> Identity Bool) -> CS -> Identity CS) -> Bool -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

                            s'' :: CS
s'' = if (Bool -> Bool -> Bool) -> Bool -> Map Int Bool -> Bool
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr Bool -> Bool -> Bool
(&&) Bool
True (CS
s' CS -> Getting (Map Int Bool) CS (Map Int Bool) -> Map Int Bool
forall s a. s -> Getting a s a -> a
^. (CardState -> Const (Map Int Bool) CardState)
-> CS -> Const (Map Int Bool) CS
Lens' CS CardState
cardState((CardState -> Const (Map Int Bool) CardState)
 -> CS -> Const (Map Int Bool) CS)
-> ((Map Int Bool -> Const (Map Int Bool) (Map Int Bool))
    -> CardState -> Const (Map Int Bool) CardState)
-> Getting (Map Int Bool) CS (Map Int Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int Bool -> Const (Map Int Bool) (Map Int Bool))
-> CardState -> Const (Map Int Bool) CardState
Traversal' CardState (Map Int Bool)
correctGaps)
                                    then CS
s'
                                    else CS
s' CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> (Bool -> Identity Bool)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
failed ((Bool -> Identity Bool) -> CS -> Identity CS) -> Bool -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True


                  V.EvKey Key
V.KBS [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$
                      if Bool
frozen then CS
s else CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((String -> Identity String) -> CardState -> Identity CardState)
-> (String -> Identity String)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int String -> Identity (Map Int String))
-> CardState -> Identity CardState
Traversal' CardState (Map Int String)
gapInput((Map Int String -> Identity (Map Int String))
 -> CardState -> Identity CardState)
-> ((String -> Identity String)
    -> Map Int String -> Identity (Map Int String))
-> (String -> Identity String)
-> CardState
-> Identity CardState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (Map Int String)
-> Traversal' (Map Int String) (IxValue (Map Int String))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Map Int String)
i ((String -> Identity String) -> CS -> Identity CS)
-> (String -> String) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> String
backspace
                    where backspace :: String -> String
backspace String
"" = String
""
                          backspace String
xs = String -> String
forall a. [a] -> [a]
init String
xs
                  Event
_ -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s

            (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 [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
up
                V.EvKey (V.KChar Char
'k') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
up
                V.EvKey Key
V.KDown [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
down
                V.EvKey (V.KChar Char
'j') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
down

                V.EvKey (V.KChar Char
'c') [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> (Bool -> Identity Bool)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
entered) ((Bool -> Identity Bool) -> CS -> Identity CS) -> Bool -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

                V.EvKey Key
V.KEnter [] ->
                    if Bool
frozen
                      then GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& if Bool
correct then ([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> [Int]) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
indexInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) else CS -> CS
forall a. a -> a
id
                      else CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> (Bool -> Identity Bool)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
grabbed ((Bool -> Identity Bool) -> CS -> Identity CS)
-> (Bool -> Bool) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not

                Event
_ -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s


              where frozen :: Bool
frozen = Bool
submitted

                    down :: CS
down =
                      case (Bool
frozen, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Bool
dragging) of
                        (Bool
True, Bool
_, Bool
_)  -> CS
s
                        (Bool
_, Bool
False, Bool
_) -> CS
s
                        (Bool
_, Bool
_, Bool
False) -> CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1
                        (Bool
_, Bool
_, Bool
True)  -> CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1
                                          CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Map Int (Int, String) -> Identity (Map Int (Int, String)))
    -> CardState -> Identity CardState)
-> (Map Int (Int, String) -> Identity (Map Int (Int, String)))
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int (Int, String) -> Identity (Map Int (Int, String)))
-> CardState -> Identity CardState
Traversal' CardState (Map Int (Int, String))
order) ((Map Int (Int, String) -> Identity (Map Int (Int, String)))
 -> CS -> Identity CS)
-> (Map Int (Int, String) -> Map Int (Int, String)) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int -> Map Int (Int, String) -> Map Int (Int, String)
forall a b. Ord a => a -> a -> Map a b -> Map a b
interchange Int
i (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

                    up :: CS
up =
                      case (Bool
frozen, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0, Bool
dragging) of
                        (Bool
True, Bool
_, Bool
_)  -> CS
s
                        (Bool
_, Bool
False, Bool
_) -> CS
s
                        (Bool
_, Bool
_, Bool
False) -> CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1
                        (Bool
_, Bool
_, Bool
True)  -> CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Int -> Identity Int) -> CardState -> Identity CardState)
-> (Int -> Identity Int)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted) ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1
                                          CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& ((CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState((CardState -> Identity CardState) -> CS -> Identity CS)
-> ((Map Int (Int, String) -> Identity (Map Int (Int, String)))
    -> CardState -> Identity CardState)
-> (Map Int (Int, String) -> Identity (Map Int (Int, String)))
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Int (Int, String) -> Identity (Map Int (Int, String)))
-> CardState -> Identity CardState
Traversal' CardState (Map Int (Int, String))
order) ((Map Int (Int, String) -> Identity (Map Int (Int, String)))
 -> CS -> Identity CS)
-> (Map Int (Int, String) -> Map Int (Int, String)) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int -> Map Int (Int, String) -> Map Int (Int, String)
forall a b. Ord a => a -> a -> Map a b -> Map a b
interchange Int
i (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

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

            (CardState, Card)
_ -> String -> EventM Name (Next GlobalState)
forall a. HasCallStack => String -> a
error String
"impossible"
handleEvent GlobalState
gs CS
_ BrickEvent Name Event
_ = GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs

next :: GlobalState -> CS -> EventM Name (Next GlobalState)
next :: GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs CS
s
  | CS
s CS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int CS Int
Lens' CS Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CS
s CS -> Getting [Card] CS [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^. Getting [Card] CS [Card]
Lens' CS [Card]
cards) = IO Event -> EventM Name Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Card -> IO Event
openCardExternal (String -> String
takeDirectory (CS
sCS -> Getting String CS String -> String
forall s a. s -> Getting a s a -> a
^.Getting String CS String
Lens' CS String
pathToFile)) ((CS
sCS -> Getting [Card] CS [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^.Getting [Card] CS [Card]
Lens' CS [Card]
cards) [Card] -> Int -> Card
forall a. [a] -> Int -> a
!! (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) EventM Name Event
-> EventM Name (Next GlobalState) -> EventM Name (Next GlobalState)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM Name (Next GlobalState))
-> (CS -> GlobalState) -> CS -> EventM Name (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> CS -> GlobalState
updateCS GlobalState
gs (CS -> GlobalState) -> (CS -> CS) -> CS -> GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CS -> CS
straightenState (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> CS -> Identity CS
Lens' CS Int
index ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1)
  | CS
s CS -> Getting Bool CS Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool CS Bool
Lens' CS Bool
reviewMode                      =
      let thePopup :: Popup CS
thePopup =
            if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CS
sCS -> Getting [Int] CS [Int] -> [Int]
forall s a. s -> Getting a s a -> a
^.Getting [Int] CS [Int]
Lens' CS [Int]
correctCards) Bool -> Bool -> Bool
|| [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CS
sCS -> Getting [Int] CS [Int] -> [Int]
forall s a. s -> Getting a s a -> a
^. Getting [Int] CS [Int]
Lens' CS [Int]
correctCards) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Card] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CS
sCS -> Getting [Card] CS [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^.Getting [Card] CS [Card]
Lens' CS [Card]
cards)
              then Popup CS
finalPopup
              else Popup CS
deckMakerPopup
      in GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM Name (Next GlobalState))
-> (CS -> GlobalState) -> CS -> EventM Name (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> CS -> GlobalState
updateCS GlobalState
gs (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Popup CS
thePopup
  | Bool
otherwise                            = GlobalState -> EventM Name (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
gs

previous :: GlobalState -> CS -> EventM Name (Next GlobalState)
previous :: GlobalState -> CS -> EventM Name (Next GlobalState)
previous GlobalState
gs CS
s | CS
s CS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int CS Int
Lens' CS Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = IO Event -> EventM Name Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Card -> IO Event
openCardExternal (String -> String
takeDirectory (CS
sCS -> Getting String CS String -> String
forall s a. s -> Getting a s a -> a
^.Getting String CS String
Lens' CS String
pathToFile)) ((CS
sCS -> Getting [Card] CS [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^.Getting [Card] CS [Card]
Lens' CS [Card]
cards) [Card] -> Int -> Card
forall a. [a] -> Int -> a
!! (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) EventM Name Event
-> EventM Name (Next GlobalState) -> EventM Name (Next GlobalState)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM Name (Next GlobalState))
-> (CS -> GlobalState) -> CS -> EventM Name (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> CS -> GlobalState
updateCS GlobalState
gs (CS -> GlobalState) -> (CS -> CS) -> CS -> GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CS -> CS
straightenState (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> CS -> Identity CS
Lens' CS Int
index ((Int -> Identity Int) -> CS -> Identity CS) -> Int -> CS -> CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1)
              | Bool
otherwise      = GlobalState -> EventM Name (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs

straightenState :: CS -> CS
straightenState :: CS -> CS
straightenState CS
s =
  let card :: Card
card = (CS
s CS -> Getting [Card] CS [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^. Getting [Card] CS [Card]
Lens' CS [Card]
cards) [Card] -> Int -> Card
forall a. [a] -> Int -> a
!! (CS
s CS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int CS Int
Lens' CS Int
index) in CS
s
    CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Card -> Identity Card) -> CS -> Identity CS
Lens' CS Card
currentCard ((Card -> Identity Card) -> CS -> Identity CS) -> Card -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Card
card
    CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (CardState -> Identity CardState) -> CS -> Identity CS
Lens' CS CardState
cardState ((CardState -> Identity CardState) -> CS -> Identity CS)
-> CardState -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Card -> CardState
defaultCardState Card
card

interchange :: (Ord a) => a -> a -> Map a b -> Map a b
interchange :: 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 Map a b -> a -> b
forall k a. Ord k => Map k a -> k -> a
M.! a
i
      valj :: b
valj = Map a b
kvs Map a b -> a -> b
forall k a. Ord k => Map k a -> k -> a
M.! a
j in
  a -> b -> Map a b -> Map a b
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
j b
vali (a -> b -> Map a b -> Map a b
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 CS
correctPopup :: Popup CS
correctPopup = (CS -> Widget Name)
-> (GlobalState -> CS -> Event -> EventM Name (Next GlobalState))
-> PopupState
-> Popup CS
forall s.
(s -> Widget Name)
-> (GlobalState -> s -> Event -> EventM Name (Next GlobalState))
-> PopupState
-> Popup s
Popup CS -> Widget Name
forall n. CS -> Widget n
drawer GlobalState -> CS -> Event -> EventM Name (Next GlobalState)
eventHandler PopupState
initialState
  where drawer :: CS -> Widget n
drawer CS
s =
          let selected :: Int
selected = Int -> (Popup CS -> Int) -> Maybe (Popup CS) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Popup CS -> Getting (Endo Int) (Popup CS) Int -> Int
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (PopupState -> Const (Endo Int) PopupState)
-> Popup CS -> Const (Endo Int) (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Const (Endo Int) PopupState)
 -> Popup CS -> Const (Endo Int) (Popup CS))
-> ((Int -> Const (Endo Int) Int)
    -> PopupState -> Const (Endo Int) PopupState)
-> Getting (Endo Int) (Popup CS) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const (Endo Int) Int)
-> PopupState -> Const (Endo Int) PopupState
Traversal' PopupState Int
popupSelected) (CS
sCS
-> Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
-> Maybe (Popup CS)
forall s a. s -> Getting a s a -> a
^.Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
Lens' CS (Maybe (Popup CS))
popup)
              colorNo :: AttrName
colorNo  = if Int
selected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then AttrName
selectedNoButtonAttr else AttrName
noButtonAttr
              colorYes :: AttrName
colorYes = if Int
selected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then AttrName
selectedYesButtonAttr else AttrName
yesButtonAttr
              no :: Widget n
no = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
colorNo (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"No"
              yes :: Widget n
yes = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
colorYes (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"Yes" in
                Widget n -> Widget n
forall n. Widget n -> Widget n
centerPopup (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
B.borderWithLabel (String -> Widget n
forall n. String -> Widget n
str String
"Correct?") (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
20 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                String -> Widget n
forall n. String -> Widget n
str String
" " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=>
                String -> Widget n
forall n. String -> Widget n
str String
" " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=>
                (Char -> Widget n
forall n. Char -> Widget n
hFill Char
' ' Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
no Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
hFill Char
' ' Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
yes Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
hFill Char
' ')

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

        eventHandler :: GlobalState -> CS -> Event -> EventM Name (Next GlobalState)
eventHandler GlobalState
gs CS
s Event
ev =
          let update :: CS -> GlobalState
update = GlobalState -> CS -> GlobalState
updateCS GlobalState
gs
              continue' :: CS -> EventM n (Next GlobalState)
continue' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (CS -> GlobalState) -> CS -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CS -> GlobalState
update
              p :: Popup CS
p = Maybe (Popup CS) -> Popup CS
forall a. HasCallStack => Maybe a -> a
fromJust (CS
s CS
-> Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
-> Maybe (Popup CS)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
Lens' CS (Maybe (Popup CS))
popup)
            in case Event
ev of
              V.EvKey Key
V.KLeft  [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0)
              V.EvKey Key
V.KRight [] -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
1)
              -- Adding vim shortcuts here
              V.EvKey (V.KChar Char
'h') []-> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0)
              V.EvKey (V.KChar Char
'l') []-> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
1)
              -- V.EvKey V.KRight [] -> s & popup .~ popupState.popupSelected .~ Just 1
              V.EvKey Key
V.KEnter [] -> GlobalState -> CS -> EventM Name (Next GlobalState)
next GlobalState
gs (CS -> EventM Name (Next GlobalState))
-> CS -> EventM Name (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Maybe (Popup CS) -> CS -> CS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Popup CS)
forall a. Maybe a
Nothing
                                                 CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& if Popup CS
p Popup CS -> Getting (Endo Int) (Popup CS) Int -> Int
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (PopupState -> Const (Endo Int) PopupState)
-> Popup CS -> Const (Endo Int) (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Const (Endo Int) PopupState)
 -> Popup CS -> Const (Endo Int) (Popup CS))
-> ((Int -> Const (Endo Int) Int)
    -> PopupState -> Const (Endo Int) PopupState)
-> Getting (Endo Int) (Popup CS) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const (Endo Int) Int)
-> PopupState -> Const (Endo Int) PopupState
Traversal' PopupState Int
popupSelected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then ([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> [Int]) -> CS -> CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CS
sCS -> Getting Int CS Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int CS Int
Lens' CS Int
indexInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) else CS -> CS
forall a. a -> a
id
              Event
_ -> CS -> EventM Name (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s

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

        initialState :: PopupState
initialState = PopupState
FinalPopup

        eventHandler :: GlobalState -> p -> Event -> EventM n (Next GlobalState)
eventHandler GlobalState
gs p
s (V.EvKey Key
V.KEnter []) = GlobalState -> EventM n (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
gs
        eventHandler GlobalState
gs p
_ Event
_ = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs

deckMakerPopup :: Popup CS
deckMakerPopup :: Popup CS
deckMakerPopup = (CS -> Widget Name)
-> (GlobalState -> CS -> Event -> EventM Name (Next GlobalState))
-> PopupState
-> Popup CS
forall s.
(s -> Widget Name)
-> (GlobalState -> s -> Event -> EventM Name (Next GlobalState))
-> PopupState
-> Popup s
Popup CS -> Widget Name
forall n. CS -> Widget n
drawer GlobalState -> CS -> Event -> EventM Name (Next GlobalState)
forall n. GlobalState -> CS -> Event -> EventM n (Next GlobalState)
eventHandler PopupState
initialState
  where drawer :: CS -> Widget n
drawer CS
s =
          let state :: PopupState
state    = PopupState -> Maybe PopupState -> PopupState
forall a. a -> Maybe a -> a
fromMaybe PopupState
initialState (Maybe PopupState -> PopupState) -> Maybe PopupState -> PopupState
forall a b. (a -> b) -> a -> b
$ Getting PopupState (Popup CS) PopupState -> Popup CS -> PopupState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PopupState (Popup CS) PopupState
forall s. Lens' (Popup s) PopupState
popupState (Popup CS -> PopupState) -> Maybe (Popup CS) -> Maybe PopupState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CS
sCS
-> Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
-> Maybe (Popup CS)
forall s a. s -> Getting a s a -> a
^.Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
Lens' CS (Maybe (Popup CS))
popup
              j :: Int
j = PopupState
state PopupState
-> ((Int -> Const (Endo Int) Int)
    -> PopupState -> Const (Endo Int) PopupState)
-> Int
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Int -> Const (Endo Int) Int)
-> PopupState -> Const (Endo Int) PopupState
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 PopupState -> Getting (Endo Bool) PopupState Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Bool) PopupState Bool
lens, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j) of
                (Bool
_, Bool
True) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightedOptAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"*"
                (Bool
True, Bool
_) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedOptAttr    (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"*"
                (Bool, Bool)
_         -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedOptAttr    (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
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 PopupState -> Getting (Endo Bool) PopupState Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Bool) PopupState Bool
lens then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedOptAttr else Widget n -> Widget n
forall a. a -> a
id) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                  String -> Widget n
forall n. String -> Widget n
str String
"[" Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Getting (Endo Bool) PopupState Bool -> Int -> Widget n
forall n. Getting (Endo Bool) PopupState Bool -> Int -> Widget n
makeSym Getting (Endo Bool) PopupState Bool
lens Int
i Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
"]"

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

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

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

        eventHandler :: GlobalState -> CS -> Event -> EventM n (Next GlobalState)
eventHandler GlobalState
gs CS
s Event
ev =
          let update :: CS -> GlobalState
update = GlobalState -> CS -> GlobalState
updateCS GlobalState
gs
              continue' :: CS -> EventM n (Next GlobalState)
continue' = GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (CS -> GlobalState) -> CS -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CS -> GlobalState
update
              p :: Popup CS
p = Maybe (Popup CS) -> Popup CS
forall a. HasCallStack => Maybe a -> a
fromJust (CS
s CS
-> Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
-> Maybe (Popup CS)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Popup CS)) CS (Maybe (Popup CS))
Lens' CS (Maybe (Popup CS))
popup)
              state :: PopupState
state = Popup CS
p Popup CS -> Getting PopupState (Popup CS) PopupState -> PopupState
forall s a. s -> Getting a s a -> a
^. Getting PopupState (Popup CS) PopupState
forall s. Lens' (Popup s) PopupState
popupState
          in case PopupState
state PopupState
-> ((Int -> Const (Endo Int) Int)
    -> PopupState -> Const (Endo Int) PopupState)
-> Int
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Int -> Const (Endo Int) Int)
-> PopupState -> Const (Endo Int) PopupState
Traversal' PopupState Int
popupSelected of
            Int
0 -> case Event
ev of
              V.EvKey Key
V.KEnter []      -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Bool -> Identity Bool) -> PopupState -> Identity PopupState)
-> (Bool -> Identity Bool)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> PopupState -> Identity PopupState
Traversal' PopupState Bool
makeDeckIncorrect ((Bool -> Identity Bool) -> Popup CS -> Identity (Popup CS))
-> (Bool -> Bool) -> Popup CS -> Popup CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not)
              V.EvKey Key
V.KDown  []      -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1)
              V.EvKey (V.KChar Char
'j') [] -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1)
              Event
_ -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s
            Int
1 -> case Event
ev of
              V.EvKey Key
V.KEnter []      -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Bool -> Identity Bool) -> PopupState -> Identity PopupState)
-> (Bool -> Identity Bool)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> PopupState -> Identity PopupState
Traversal' PopupState Bool
makeDeckCorrect ((Bool -> Identity Bool) -> Popup CS -> Identity (Popup CS))
-> (Bool -> Bool) -> Popup CS -> Popup CS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not)
              V.EvKey Key
V.KDown  []      -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1)
              V.EvKey (V.KChar Char
'j') [] -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1)
              V.EvKey Key
V.KUp  []        -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1)
              V.EvKey (V.KChar Char
'k') [] -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1)
              Event
_ -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s
            Int
2 -> case Event
ev of
              V.EvKey Key
V.KEnter []      -> IO Event -> EventM n Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> [Card] -> [Int] -> Bool -> Bool -> IO Event
generateDecks (CS
s CS -> Getting String CS String -> String
forall s a. s -> Getting a s a -> a
^. Getting String CS String
Lens' CS String
pathToFile) (CS
s CS -> Getting [Card] CS [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^. Getting [Card] CS [Card]
Lens' CS [Card]
cards) (CS
s CS -> Getting [Int] CS [Int] -> [Int]
forall s a. s -> Getting a s a -> a
^. Getting [Int] CS [Int]
Lens' CS [Int]
correctCards) (PopupState
state PopupState -> Getting (Endo Bool) PopupState Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Bool) PopupState Bool
Traversal' PopupState Bool
makeDeckCorrect) (PopupState
state PopupState -> Getting (Endo Bool) PopupState Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Bool) PopupState Bool
Traversal' PopupState Bool
makeDeckIncorrect))
                                       EventM n Event
-> EventM n (Next GlobalState) -> EventM n (Next GlobalState)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GlobalState -> EventM n (Next GlobalState)
forall n. GlobalState -> EventM n (Next GlobalState)
halt' GlobalState
gs
              V.EvKey Key
V.KUp  []        -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1)
              V.EvKey (V.KChar Char
'k') [] -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' (CS -> EventM n (Next GlobalState))
-> CS -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ CS
s CS -> (CS -> CS) -> CS
forall a b. a -> (a -> b) -> b
& (Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup CS))
popup ((Maybe (Popup CS) -> Identity (Maybe (Popup CS)))
 -> CS -> Identity CS)
-> Popup CS -> CS -> CS
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Popup CS
p Popup CS -> (Popup CS -> Popup CS) -> Popup CS
forall a b. a -> (a -> b) -> b
& (PopupState -> Identity PopupState)
-> Popup CS -> Identity (Popup CS)
forall s. Lens' (Popup s) PopupState
popupState((PopupState -> Identity PopupState)
 -> Popup CS -> Identity (Popup CS))
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> Popup CS
-> Identity (Popup CS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> Popup CS -> Identity (Popup CS))
-> Int -> Popup CS -> Popup CS
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1)
              Event
_ -> CS -> EventM n (Next GlobalState)
forall n. CS -> EventM n (Next GlobalState)
continue' CS
s

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

-- gets list of cards, list of indices of correct cards; returns (correct, incorrect)
splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])
splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])
splitCorrectIncorrect [Card]
cards [Int]
indices = [Card] -> [Card] -> [(Int, Card)] -> [Int] -> ([Card], [Card])
forall a a. Eq a => [a] -> [a] -> [(a, a)] -> [a] -> ([a], [a])
doSplit [] [] ([Int] -> [Card] -> [(Int, Card)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Card]
cards) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
indices)
  where doSplit :: [a] -> [a] -> [(a, a)] -> [a] -> ([a], [a])
doSplit [a]
cs [a]
ws [] [a]
_  = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
cs, [a] -> [a]
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
xa -> [a] -> [a]
forall 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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j
            then [a] -> [a] -> [(a, a)] -> [a] -> ([a], [a])
doSplit (a
xa -> [a] -> [a]
forall 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
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ws) [(a, a)]
xs (a
ia -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
is)