{-# LANGUAGE FlexibleContexts #-}
module UI.Cards (Card, State(..), drawUI, handleEvent, theMap) where

import Brick
import Control.Monad
import Control.Monad.Extra (whenM, notM, unlessM)
import Control.Monad.IO.Class
import Control.Monad.State.Class
import Lens.Micro.Platform
import Types
import States
import StateManagement
import Data.Char (isSpace, toLower)
import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.Maybe
import Data.List.Split
import Debug
import Text.Wrap
import Data.Text (pack)
import UI.Attributes
import UI.BrickHelpers
import System.FilePath
import Data.List (intercalate)
import qualified Brick.Types as BT
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Border.Style as BS
import qualified Brick.Widgets.Center as C
import qualified Graphics.Vty as V

---------------------------------------------------
--------------------- DRAWING ---------------------
---------------------------------------------------

drawUI :: CS -> [Widget Name]
drawUI :: CS -> [Widget Name]
drawUI CS
s =  [Widget Name
-> (Popup GlobalState CS -> Widget Name)
-> Maybe (Popup GlobalState CS)
-> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall n. Widget n
emptyWidget (Popup GlobalState CS -> CS -> Widget Name
forall s d. Popup s d -> d -> Widget Name
`drawPopup` CS
s) (CS
sCS
-> Getting
     (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
-> Maybe (Popup GlobalState CS)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
Lens' CS (Maybe (Popup GlobalState 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"
    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 a. [a] -> 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 GlobalState CS -> Bool)
-> Maybe (Popup GlobalState CS)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (PopupState -> Bool
isFinalPopup (PopupState -> Bool)
-> (Popup GlobalState CS -> PopupState)
-> Popup GlobalState CS
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting PopupState (Popup GlobalState CS) PopupState
-> Popup GlobalState CS -> PopupState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PopupState (Popup GlobalState CS) PopupState
forall s d (f :: * -> *).
Functor f =>
(PopupState -> f PopupState) -> Popup s d -> f (Popup s d)
popupState) (CS
sCS
-> Getting
     (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
-> Maybe (Popup GlobalState CS)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
Lens' CS (Maybe (Popup GlobalState CS))
popup)

drawCardUI :: CS -> Widget Name
drawCardUI :: CS -> Widget Name
drawCardUI 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]
shownCards) [Card] -> Int -> Card
forall a. HasCallStack => [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
  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
$ 
  Card -> Widget Name
drawHeader Card
card
  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 -> Name -> Widget Name -> Widget Name
scrollableViewportPercent Int
60 (Int -> Name
CardViewport (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))
  (CS -> Card -> Widget Name
drawContent CS
s Card
card)
  Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
  String -> Widget Name
forall n. String -> Widget n
str String
" "
  Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
  CS -> Widget Name
drawFooter CS
s

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

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

drawTitle :: String -> Widget n
drawTitle :: forall n. String -> Widget n
drawTitle String
title = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr (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
padLeftRight Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   String -> Widget n
forall n. String -> Widget n
hCenteredStrWrap String
title

wrapSettings :: WrapSettings
wrapSettings :: WrapSettings
wrapSettings = WrapSettings
defaultWrapSettings {preserveIndentation=False, breakLongWords=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 Name
c <- RenderM Name (Context Name)
forall n. RenderM n (Context n)
getContext
      let w :: Int
w = Context Name
cContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 -> Widget Name
forall n. Widget n -> Widget n
visibility (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ 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
                                            visibility :: Widget n -> Widget n
visibility = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
chosen then Widget n -> Widget n
forall n. Widget n -> Widget n
visible else Widget n -> Widget n
forall a. a -> a
id
                                            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. HasCallStack => [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
visibility (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
"[") 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
                    visibility :: Widget n -> Widget n
visibility = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted then Widget n -> Widget n
forall n. Widget n -> Widget n
visible 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 Name
c <- RenderM Name (Context Name)
forall n. RenderM n (Context n)
getContext
  let w :: Int
w = Context Name
cContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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
            stored :: String
stored = 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
            gap :: String
gap = if String
stored String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
"░" else String
stored
            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

            visibility :: Widget n -> Widget n
visibility = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted then Widget n -> Widget n
forall n. Widget n -> Widget n
visible else Widget n -> Widget n
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
forall n. Widget n -> Widget n
visibility (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
Traversal' [Widget Name] (Widget Name)
_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
Traversal' [Widget Name] (Widget Name)
_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 a. [a] -> 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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [a] -> a
last String
s
        prefix :: Text
prefix = if String -> Char
forall a. HasCallStack => [a] -> a
head String
s Char -> String -> Bool
forall a. Eq a => a -> [a] -> 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 Int
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
Traversal' [Text] Text
_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. HasCallStack => [a] -> a
last [Text]
ts') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if [Text] -> Int
forall a. [a] -> 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. HasCallStack => [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
Traversal' [Text] Text
_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. HasCallStack => [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

          visibility :: Widget n -> Widget n
visibility = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
submitted then Widget n -> Widget n
forall n. Widget n -> Widget n
visible else 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 -> Widget Name
forall n. Widget n -> Widget n
visibility (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ 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' :: EventM n GlobalState ()
halt' :: forall n. EventM n GlobalState ()
halt' = EventM n GlobalState () -> Mode -> EventM n GlobalState ()
forall n.
EventM n GlobalState () -> Mode -> EventM n GlobalState ()
removeToModeOrQuit' EventM n GlobalState ()
beforeMoving Mode
CardSelector
  where beforeMoving :: EventM n GlobalState ()
beforeMoving = LensLike' (Zoomed (EventM n CSS) ()) GlobalState CSS
-> EventM n CSS () -> EventM n GlobalState ()
forall c.
LensLike' (Zoomed (EventM n CSS) c) GlobalState CSS
-> EventM n CSS c -> EventM n GlobalState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (EventM n CSS) ()) GlobalState CSS
Lens' GlobalState CSS
css EventM n CSS ()
forall (m :: * -> *). (MonadState CSS m, MonadIO m) => m ()
refreshRecents

scroll :: CS -> Int -> EventM Name s ()
scroll :: forall s. CS -> Int -> EventM Name s ()
scroll CS
s = Int -> Int -> EventM Name s ()
forall s. Int -> Int -> EventM Name s ()
scroll' (Int -> Int -> EventM Name s ()) -> Int -> Int -> EventM Name s ()
forall a b. (a -> b) -> a -> b
$ 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

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

handleEvent :: BrickEvent Name Event -> EventM Name GlobalState ()
handleEvent :: BrickEvent Name () -> EventM Name GlobalState ()
handleEvent (VtyEvent Event
e) =
  -- let update = updateCS gs
  --     continue' = continue . update in
  case Event
e of
    V.EvKey Key
V.KEsc []          -> EventM Name GlobalState ()
forall n. EventM n GlobalState ()
popStateOrQuit
    V.EvKey Key
V.KRight [Modifier
V.MCtrl] -> (EventM Name GlobalState Bool
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM(EventM Name GlobalState Bool
 -> EventM Name GlobalState () -> EventM Name GlobalState ())
-> (Getting Bool GlobalState Bool -> EventM Name GlobalState Bool)
-> Getting Bool GlobalState Bool
-> EventM Name GlobalState ()
-> EventM Name GlobalState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EventM Name GlobalState Bool -> EventM Name GlobalState Bool
forall (m :: * -> *). Functor m => m Bool -> m Bool
notM(EventM Name GlobalState Bool -> EventM Name GlobalState Bool)
-> (Getting Bool GlobalState Bool -> EventM Name GlobalState Bool)
-> Getting Bool GlobalState Bool
-> EventM Name GlobalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Bool GlobalState Bool -> EventM Name GlobalState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool GlobalState Bool
 -> EventM Name GlobalState () -> EventM Name GlobalState ())
-> Getting Bool GlobalState Bool
-> EventM Name GlobalState ()
-> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Const Bool CS) -> GlobalState -> Const Bool GlobalState
Lens' GlobalState CS
cs((CS -> Const Bool CS) -> GlobalState -> Const Bool GlobalState)
-> Getting Bool CS Bool -> Getting Bool GlobalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Bool CS Bool
Lens' CS Bool
reviewMode) EventM Name GlobalState ()
next
    V.EvKey Key
V.KLeft  [Modifier
V.MCtrl] -> (EventM Name GlobalState Bool
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM(EventM Name GlobalState Bool
 -> EventM Name GlobalState () -> EventM Name GlobalState ())
-> (Getting Bool GlobalState Bool -> EventM Name GlobalState Bool)
-> Getting Bool GlobalState Bool
-> EventM Name GlobalState ()
-> EventM Name GlobalState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EventM Name GlobalState Bool -> EventM Name GlobalState Bool
forall (m :: * -> *). Functor m => m Bool -> m Bool
notM(EventM Name GlobalState Bool -> EventM Name GlobalState Bool)
-> (Getting Bool GlobalState Bool -> EventM Name GlobalState Bool)
-> Getting Bool GlobalState Bool
-> EventM Name GlobalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Bool GlobalState Bool -> EventM Name GlobalState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool GlobalState Bool
 -> EventM Name GlobalState () -> EventM Name GlobalState ())
-> Getting Bool GlobalState Bool
-> EventM Name GlobalState ()
-> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Const Bool CS) -> GlobalState -> Const Bool GlobalState
Lens' GlobalState CS
cs((CS -> Const Bool CS) -> GlobalState -> Const Bool GlobalState)
-> Getting Bool CS Bool -> Getting Bool GlobalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Bool CS Bool
Lens' CS Bool
reviewMode) EventM Name GlobalState ()
previous

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

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

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

              V.EvKey Key
V.KEnter [] ->
                  if Bool
frozen
                    then do Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
correctlyAnswered (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> Identity [Int])
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> GlobalState -> Identity GlobalState)
-> ([Int] -> [Int]) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (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]
:)
                            EventM Name GlobalState ()
next
                    else (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Map Int Bool -> Identity (Map Int Bool)) -> CS -> Identity CS)
-> (Map Int Bool -> Identity (Map Int Bool))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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))
 -> GlobalState -> Identity GlobalState)
-> (Map Int Bool -> Map Int Bool) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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
_ -> () -> EventM Name GlobalState ()
forall a. a -> EventM Name GlobalState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            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 :: EventM Name GlobalState ()
down = if Bool -> Bool
not Bool
frozen 
                         then Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> CS -> Identity CS)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                         else CS -> Int -> EventM Name GlobalState ()
forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1

                  up :: EventM Name GlobalState ()
up = if Bool -> Bool
not Bool
frozen 
                       then Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> CS -> Identity CS)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
                       else CS -> Int -> EventM Name GlobalState ()
forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1)

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

              V.EvKey (V.KChar Char
'c') [] -> (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Bool -> Identity Bool) -> CS -> Identity CS)
-> (Bool -> Identity Bool)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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) -> GlobalState -> Identity GlobalState)
-> Bool -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

              V.EvKey Key
V.KEnter [] ->
                  if Bool
frozen
                    then do Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
correctlyAnswered (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> Identity [Int])
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> GlobalState -> Identity GlobalState)
-> ([Int] -> [Int]) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (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]
:)
                            EventM Name GlobalState ()
next
                    else (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Map Int Bool -> Identity (Map Int Bool)) -> CS -> Identity CS)
-> (Map Int Bool -> Identity (Map Int Bool))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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))
 -> GlobalState -> Identity GlobalState)
-> (Map Int Bool -> Map Int Bool) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (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 do Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
correctlyAnswered (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> Identity [Int])
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> GlobalState -> Identity GlobalState)
-> ([Int] -> [Int]) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (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]
:)
                            EventM Name GlobalState ()
next
                    else (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Map Int Bool -> Identity (Map Int Bool)) -> CS -> Identity CS)
-> (Map Int Bool -> Identity (Map Int Bool))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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))
 -> GlobalState -> Identity GlobalState)
-> (Map Int Bool -> Map Int Bool) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (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
_ -> () -> EventM Name GlobalState ()
forall a. a -> EventM Name GlobalState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


            where frozen :: Bool
frozen = Bool
submitted

                  down :: EventM Name GlobalState ()
down = if Bool -> Bool
not Bool
frozen 
                         then Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> CS -> Identity CS)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                         else CS -> Int -> EventM Name GlobalState ()
forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1

                  up :: EventM Name GlobalState ()
up = if Bool -> Bool
not Bool
frozen 
                       then Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> CS -> Identity CS)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
                       else CS -> Int -> EventM Name GlobalState ()
forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1)

                  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, _previousInput :: CardState -> Map Int String
_previousInput = Map Int String
pkvs}, 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
                down :: EventM Name s ()
down = CS -> Int -> EventM Name s ()
forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1
                up :: EventM Name s ()
up = CS -> Int -> EventM Name s ()
forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1) in
            case Event
ev of
              V.EvKey (V.KChar Char
'\t') [] -> LensLike' (Zoomed (EventM Name CardState) ()) GlobalState CardState
-> EventM Name CardState () -> EventM Name GlobalState ()
forall c.
LensLike' (Zoomed (EventM Name CardState) c) GlobalState CardState
-> EventM Name CardState c -> EventM Name GlobalState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((CS -> Zoomed (EventM Name CardState) () CS)
-> GlobalState -> Zoomed (EventM Name CardState) () GlobalState
Lens' GlobalState CS
cs((CS -> Zoomed (EventM Name CardState) () CS)
 -> GlobalState -> Zoomed (EventM Name CardState) () GlobalState)
-> ((CardState -> Zoomed (EventM Name CardState) () CardState)
    -> CS -> Zoomed (EventM Name CardState) () CS)
-> LensLike'
     (Zoomed (EventM Name CardState) ()) GlobalState CardState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CardState -> Zoomed (EventM Name CardState) () CardState)
-> CS -> Zoomed (EventM Name CardState) () CS
Lens' CS CardState
cardState) (EventM Name CardState () -> EventM Name GlobalState ())
-> EventM Name CardState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ do
                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 (Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted ((Int -> Identity Int) -> CardState -> Identity CardState)
-> Int -> EventM Name CardState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                  else (Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted ((Int -> Identity Int) -> CardState -> Identity CardState)
-> Int -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0

              V.EvKey Key
V.KRight [] -> 
                Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$
                  (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> CS -> Identity CS)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1

              V.EvKey Key
V.KLeft [] ->
                Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
frozen) (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$
                  (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> CS -> Identity CS)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1

              -- C-w deletes a word back (eg. "test test" -> "test")
              V.EvKey (V.KChar Char
'w') [Modifier
V.MCtrl] -> LensLike' (Zoomed (EventM Name CardState) ()) GlobalState CardState
-> EventM Name CardState () -> EventM Name GlobalState ()
forall c.
LensLike' (Zoomed (EventM Name CardState) c) GlobalState CardState
-> EventM Name CardState c -> EventM Name GlobalState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((CS -> Zoomed (EventM Name CardState) () CS)
-> GlobalState -> Zoomed (EventM Name CardState) () GlobalState
Lens' GlobalState CS
cs((CS -> Zoomed (EventM Name CardState) () CS)
 -> GlobalState -> Zoomed (EventM Name CardState) () GlobalState)
-> ((CardState -> Zoomed (EventM Name CardState) () CardState)
    -> CS -> Zoomed (EventM Name CardState) () CS)
-> LensLike'
     (Zoomed (EventM Name CardState) ()) GlobalState CardState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CardState -> Zoomed (EventM Name CardState) () CardState)
-> CS -> Zoomed (EventM Name CardState) () CS
Lens' CS CardState
cardState) (EventM Name CardState () -> EventM Name GlobalState ())
-> EventM Name CardState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ do
                  Bool -> EventM Name CardState () -> EventM Name CardState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
frozen (EventM Name CardState () -> EventM Name CardState ())
-> EventM Name CardState () -> EventM Name CardState ()
forall a b. (a -> b) -> a -> b
$ (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) -> CardState -> Identity CardState)
-> (String -> String) -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= String -> String
backword
                where backword :: String -> String
backword String
"" = String
""
                      backword String
xs = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. HasCallStack => [a] -> [a]
init ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
xs

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

              V.EvKey (V.KChar Char
c) [] -> LensLike' (Zoomed (EventM Name CardState) ()) GlobalState CardState
-> EventM Name CardState () -> EventM Name GlobalState ()
forall c.
LensLike' (Zoomed (EventM Name CardState) c) GlobalState CardState
-> EventM Name CardState c -> EventM Name GlobalState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((CS -> Focusing (StateT (EventState Name) IO) () CS)
-> GlobalState
-> Focusing (StateT (EventState Name) IO) () GlobalState
Lens' GlobalState CS
cs((CS -> Focusing (StateT (EventState Name) IO) () CS)
 -> GlobalState
 -> Focusing (StateT (EventState Name) IO) () GlobalState)
-> ((CardState
     -> Focusing (StateT (EventState Name) IO) () CardState)
    -> CS -> Focusing (StateT (EventState Name) IO) () CS)
-> (CardState
    -> Focusing (StateT (EventState Name) IO) () CardState)
-> GlobalState
-> Focusing (StateT (EventState Name) IO) () GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CardState -> Focusing (StateT (EventState Name) IO) () CardState)
-> CS -> Focusing (StateT (EventState Name) IO) () CS
Lens' CS CardState
cardState) (EventM Name CardState () -> EventM Name GlobalState ())
-> EventM Name CardState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ do
                  Bool -> EventM Name CardState () -> EventM Name CardState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
frozen (EventM Name CardState () -> EventM Name CardState ())
-> EventM Name CardState () -> EventM Name CardState ()
forall a b. (a -> b) -> a -> b
$ (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) -> CardState -> Identity CardState)
-> (String -> String) -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
c])
                  Bool -> EventM Name CardState () -> EventM Name CardState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
frozen (EventM Name CardState () -> EventM Name CardState ())
-> EventM Name CardState () -> EventM Name CardState ()
forall a b. (a -> b) -> a -> b
$ case Char
c of
                    Char
'k' -> EventM Name CardState ()
forall {s}. EventM Name s ()
up
                    Char
'j' -> EventM Name CardState ()
forall {s}. EventM Name s ()
down
                    Char
_ -> () -> EventM Name CardState ()
forall a. a -> EventM Name CardState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

                      wordIsCorrect :: String -> NonEmpty String -> Bool
                      wordIsCorrect :: String -> NonEmpty String -> Bool
wordIsCorrect = if CS
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 a. Eq a => a -> NonEmpty a -> 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 a. Eq a => a -> NonEmpty a -> 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)

                      allEmpty :: Bool
allEmpty = (String -> Bool) -> Map Int String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Int String
kvs
                      sameAsPrevious :: Bool
sameAsPrevious = Map Int String
kvs Map Int String -> Map Int String -> Bool
forall a. Eq a => a -> a -> Bool
== Map Int String
pkvs

                  (Map Int Bool -> Identity (Map Int Bool))
-> CardState -> Identity CardState
Traversal' CardState (Map Int Bool)
correctGaps ((Map Int Bool -> Identity (Map Int Bool))
 -> CardState -> Identity CardState)
-> (Map Int Bool -> Map Int Bool) -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (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. HasCallStack => [a] -> Int -> a
!! Int
j))
                  (Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
entered ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> Bool -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

                  Bool
allCorrect <- (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 -> Bool)
-> EventM Name CardState (Map Int Bool)
-> EventM Name CardState Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Map Int Bool) CardState (Map Int Bool)
-> EventM Name CardState (Map Int Bool)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Map Int Bool) CardState (Map Int Bool)
Traversal' CardState (Map Int Bool)
correctGaps

                  Bool -> EventM Name CardState () -> EventM Name CardState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
allEmpty Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
allCorrect Bool -> Bool -> Bool
|| Bool
sameAsPrevious) (EventM Name CardState () -> EventM Name CardState ())
-> EventM Name CardState () -> EventM Name CardState ()
forall a b. (a -> b) -> a -> b
$ do
                    let 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))
                    (Map Int Bool -> Identity (Map Int Bool))
-> CardState -> Identity CardState
Traversal' CardState (Map Int Bool)
correctGaps ((Map Int Bool -> Identity (Map Int Bool))
 -> CardState -> Identity CardState)
-> Map Int Bool -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(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]]
                    (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)
-> Map Int String -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map Int String
correctAnswers

                  Bool -> EventM Name CardState () -> EventM Name CardState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allCorrect (EventM Name CardState () -> EventM Name CardState ())
-> EventM Name CardState () -> EventM Name CardState ()
forall a b. (a -> b) -> a -> b
$
                    (Bool -> Identity Bool) -> CardState -> Identity CardState
Traversal' CardState Bool
failed ((Bool -> Identity Bool) -> CardState -> Identity CardState)
-> Bool -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

                  (Map Int String -> Identity (Map Int String))
-> CardState -> Identity CardState
Traversal' CardState (Map Int String)
previousInput ((Map Int String -> Identity (Map Int String))
 -> CardState -> Identity CardState)
-> Map Int String -> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map Int String
kvs

                (Bool
_, Bool
True) -> EventM Name GlobalState ()
next
                (Bool
_, Bool
False) -> do
                  (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> Identity [Int])
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> GlobalState -> Identity GlobalState)
-> ([Int] -> [Int]) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (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]
:)
                  EventM Name GlobalState ()
next

              V.EvKey Key
V.KBS [] -> Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
frozen (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$
                  (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((String -> Identity String) -> CS -> Identity CS)
-> (String -> Identity String)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(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)
 -> GlobalState -> Identity GlobalState)
-> (String -> String) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= String -> String
backspace
                where backspace :: String -> String
backspace String
"" = String
""
                      backspace String
xs = String -> String
forall a. HasCallStack => [a] -> [a]
init String
xs

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

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

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


            where frozen :: Bool
frozen = Bool
submitted

                  down :: EventM Name GlobalState ()
down = LensLike' (Zoomed (EventM Name CardState) ()) GlobalState CardState
-> EventM Name CardState () -> EventM Name GlobalState ()
forall c.
LensLike' (Zoomed (EventM Name CardState) c) GlobalState CardState
-> EventM Name CardState c -> EventM Name GlobalState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((CS -> Focusing (StateT (EventState Name) IO) () CS)
-> GlobalState
-> Focusing (StateT (EventState Name) IO) () GlobalState
Lens' GlobalState CS
cs((CS -> Focusing (StateT (EventState Name) IO) () CS)
 -> GlobalState
 -> Focusing (StateT (EventState Name) IO) () GlobalState)
-> ((CardState
     -> Focusing (StateT (EventState Name) IO) () CardState)
    -> CS -> Focusing (StateT (EventState Name) IO) () CS)
-> (CardState
    -> Focusing (StateT (EventState Name) IO) () CardState)
-> GlobalState
-> Focusing (StateT (EventState Name) IO) () GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CardState -> Focusing (StateT (EventState Name) IO) () CardState)
-> CS -> Focusing (StateT (EventState Name) IO) () CS
Lens' CS CardState
cardState) (EventM Name CardState () -> EventM Name GlobalState ())
-> EventM Name CardState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$
                    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 -> Int -> EventM Name CardState ()
forall s. CS -> Int -> EventM Name s ()
scroll CS
s Int
1
                      (Bool
_, Bool
False, Bool
_) -> () -> EventM Name CardState ()
forall a. a -> EventM Name CardState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      (Bool
_, Bool
_, Bool
False) -> (Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted ((Int -> Identity Int) -> CardState -> Identity CardState)
-> Int -> EventM Name CardState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                      (Bool
_, Bool
_, Bool
True)  -> do (Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted ((Int -> Identity Int) -> CardState -> Identity CardState)
-> Int -> EventM Name CardState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
+= Int
1
                                          (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)))
 -> CardState -> Identity CardState)
-> (Map Int (Int, String) -> Map Int (Int, String))
-> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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 :: EventM Name GlobalState ()
up = LensLike' (Zoomed (EventM Name CardState) ()) GlobalState CardState
-> EventM Name CardState () -> EventM Name GlobalState ()
forall c.
LensLike' (Zoomed (EventM Name CardState) c) GlobalState CardState
-> EventM Name CardState c -> EventM Name GlobalState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((CS -> Focusing (StateT (EventState Name) IO) () CS)
-> GlobalState
-> Focusing (StateT (EventState Name) IO) () GlobalState
Lens' GlobalState CS
cs((CS -> Focusing (StateT (EventState Name) IO) () CS)
 -> GlobalState
 -> Focusing (StateT (EventState Name) IO) () GlobalState)
-> ((CardState
     -> Focusing (StateT (EventState Name) IO) () CardState)
    -> CS -> Focusing (StateT (EventState Name) IO) () CS)
-> (CardState
    -> Focusing (StateT (EventState Name) IO) () CardState)
-> GlobalState
-> Focusing (StateT (EventState Name) IO) () GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CardState -> Focusing (StateT (EventState Name) IO) () CardState)
-> CS -> Focusing (StateT (EventState Name) IO) () CS
Lens' CS CardState
cardState) (EventM Name CardState () -> EventM Name GlobalState ())
-> EventM Name CardState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$
                    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 -> Int -> EventM Name CardState ()
forall s. CS -> Int -> EventM Name s ()
scroll CS
s (-Int
1)
                      (Bool
_, Bool
False, Bool
_) -> () -> EventM Name CardState ()
forall a. a -> EventM Name CardState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      (Bool
_, Bool
_, Bool
False) -> (Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted ((Int -> Identity Int) -> CardState -> Identity CardState)
-> Int -> EventM Name CardState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
                      (Bool
_, Bool
_, Bool
True)  -> do (Int -> Identity Int) -> CardState -> Identity CardState
Traversal' CardState Int
highlighted ((Int -> Identity Int) -> CardState -> Identity CardState)
-> Int -> EventM Name CardState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter s s a a -> a -> m ()
-= Int
1
                                          (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)))
 -> CardState -> Identity CardState)
-> (Map Int (Int, String) -> Map Int (Int, String))
-> EventM Name CardState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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 GlobalState ()
forall a. HasCallStack => String -> a
error String
"impossible"
handleEvent (BT.MouseDown (SBClick ClickableScrollbarElement
el (CardViewport Int
i)) Button
_ [Modifier]
_ Location
_) = (Int -> EventM Name GlobalState ())
-> ClickableScrollbarElement -> EventM Name GlobalState ()
forall n s.
(Int -> EventM n s ())
-> ClickableScrollbarElement -> EventM n s ()
handleClickScroll (Int -> Int -> EventM Name GlobalState ()
forall s. Int -> Int -> EventM Name s ()
scroll' Int
i) ClickableScrollbarElement
el
handleEvent BrickEvent Name ()
_ = () -> EventM Name GlobalState ()
forall a. a -> EventM Name GlobalState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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

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

interchange :: (Ord a) => a -> a -> Map a b -> Map a b
interchange :: forall a b. Ord a => a -> a -> Map a b -> Map a b
interchange a
i a
j Map a b
kvs =
  let vali :: b
vali = Map a b
kvs 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 GlobalState CS
correctPopup :: Popup GlobalState CS
correctPopup = (CS -> Widget Name)
-> (Event -> EventM Name GlobalState ())
-> PopupState
-> Popup GlobalState CS
forall s d.
(d -> Widget Name)
-> (Event -> EventM Name s ()) -> PopupState -> Popup s d
Popup CS -> Widget Name
forall {n}. CS -> Widget n
drawer Event -> EventM Name GlobalState ()
eventHandler PopupState
initialState
  where drawer :: CS -> Widget n
drawer CS
s =
          let selected :: Int
selected = Int
-> (Popup GlobalState CS -> Int)
-> Maybe (Popup GlobalState CS)
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Popup GlobalState CS
-> Getting (Endo Int) (Popup GlobalState CS) Int -> Int
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (PopupState -> Const (Endo Int) PopupState)
-> Popup GlobalState CS -> Const (Endo Int) (Popup GlobalState CS)
forall s d (f :: * -> *).
Functor f =>
(PopupState -> f PopupState) -> Popup s d -> f (Popup s d)
popupState((PopupState -> Const (Endo Int) PopupState)
 -> Popup GlobalState CS -> Const (Endo Int) (Popup GlobalState CS))
-> ((Int -> Const (Endo Int) Int)
    -> PopupState -> Const (Endo Int) PopupState)
-> Getting (Endo Int) (Popup GlobalState 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 GlobalState CS)) CS (Maybe (Popup GlobalState CS))
-> Maybe (Popup GlobalState CS)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
Lens' CS (Maybe (Popup GlobalState 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 :: Event -> EventM Name GlobalState ()
eventHandler Event
ev = do
          Popup GlobalState CS
p <- Maybe (Popup GlobalState CS) -> Popup GlobalState CS
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Popup GlobalState CS) -> Popup GlobalState CS)
-> EventM Name GlobalState (Maybe (Popup GlobalState CS))
-> EventM Name GlobalState (Popup GlobalState CS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Maybe (Popup GlobalState CS))
  GlobalState
  (Maybe (Popup GlobalState CS))
-> EventM Name GlobalState (Maybe (Popup GlobalState CS))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((CS -> Const (Maybe (Popup GlobalState CS)) CS)
-> GlobalState -> Const (Maybe (Popup GlobalState CS)) GlobalState
Lens' GlobalState CS
cs((CS -> Const (Maybe (Popup GlobalState CS)) CS)
 -> GlobalState -> Const (Maybe (Popup GlobalState CS)) GlobalState)
-> Getting
     (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
-> Getting
     (Maybe (Popup GlobalState CS))
     GlobalState
     (Maybe (Popup GlobalState CS))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting
  (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
Lens' CS (Maybe (Popup GlobalState CS))
popup)
          let ps :: (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
ps = (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((PopupState -> Identity PopupState) -> CS -> Identity CS)
-> (PopupState -> Identity PopupState)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Popup GlobalState CS)
 -> Identity (Maybe (Popup GlobalState CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup GlobalState CS))
popup((Maybe (Popup GlobalState CS)
  -> Identity (Maybe (Popup GlobalState CS)))
 -> CS -> Identity CS)
-> ((PopupState -> Identity PopupState)
    -> Maybe (Popup GlobalState CS)
    -> Identity (Maybe (Popup GlobalState CS)))
-> (PopupState -> Identity PopupState)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Popup GlobalState CS -> Identity (Popup GlobalState CS))
-> Maybe (Popup GlobalState CS)
-> Identity (Maybe (Popup GlobalState CS))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just((Popup GlobalState CS -> Identity (Popup GlobalState CS))
 -> Maybe (Popup GlobalState CS)
 -> Identity (Maybe (Popup GlobalState CS)))
-> ((PopupState -> Identity PopupState)
    -> Popup GlobalState CS -> Identity (Popup GlobalState CS))
-> (PopupState -> Identity PopupState)
-> Maybe (Popup GlobalState CS)
-> Identity (Maybe (Popup GlobalState CS))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PopupState -> Identity PopupState)
-> Popup GlobalState CS -> Identity (Popup GlobalState CS)
forall s d (f :: * -> *).
Functor f =>
(PopupState -> f PopupState) -> Popup s d -> f (Popup s d)
popupState
          case Event
ev of
            V.EvKey Key
V.KLeft  [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
ps((PopupState -> Identity PopupState)
 -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
            V.EvKey Key
V.KRight [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
ps((PopupState -> Identity PopupState)
 -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
1
            -- Adding vim shortcuts here
            V.EvKey (V.KChar Char
'h') [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
ps((PopupState -> Identity PopupState)
 -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
            V.EvKey (V.KChar Char
'l') [] -> (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
ps((PopupState -> Identity PopupState)
 -> GlobalState -> Identity GlobalState)
-> ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> (Int -> Identity Int)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> PopupState -> Identity PopupState
Traversal' PopupState Int
popupSelected ((Int -> Identity Int) -> GlobalState -> Identity GlobalState)
-> Int -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
1

            V.EvKey Key
V.KEnter [] -> do
               (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((Maybe (Popup GlobalState CS)
     -> Identity (Maybe (Popup GlobalState CS)))
    -> CS -> Identity CS)
-> (Maybe (Popup GlobalState CS)
    -> Identity (Maybe (Popup GlobalState CS)))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Popup GlobalState CS)
 -> Identity (Maybe (Popup GlobalState CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup GlobalState CS))
popup ((Maybe (Popup GlobalState CS)
  -> Identity (Maybe (Popup GlobalState CS)))
 -> GlobalState -> Identity GlobalState)
-> Maybe (Popup GlobalState CS) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Popup GlobalState CS)
forall a. Maybe a
Nothing
               Bool -> EventM Name GlobalState () -> EventM Name GlobalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Popup GlobalState CS
p Popup GlobalState CS
-> Getting (Endo Int) (Popup GlobalState CS) Int -> Int
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (PopupState -> Const (Endo Int) PopupState)
-> Popup GlobalState CS -> Const (Endo Int) (Popup GlobalState CS)
forall s d (f :: * -> *).
Functor f =>
(PopupState -> f PopupState) -> Popup s d -> f (Popup s d)
popupState((PopupState -> Const (Endo Int) PopupState)
 -> Popup GlobalState CS -> Const (Endo Int) (Popup GlobalState CS))
-> ((Int -> Const (Endo Int) Int)
    -> PopupState -> Const (Endo Int) PopupState)
-> Getting (Endo Int) (Popup GlobalState 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) (EventM Name GlobalState () -> EventM Name GlobalState ())
-> EventM Name GlobalState () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$
                 do Int
i <- Getting Int GlobalState Int -> EventM Name GlobalState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Int GlobalState Int -> EventM Name GlobalState Int)
-> Getting Int GlobalState Int -> EventM Name GlobalState Int
forall a b. (a -> b) -> a -> b
$ (CS -> Const Int CS) -> GlobalState -> Const Int GlobalState
Lens' GlobalState CS
cs((CS -> Const Int CS) -> GlobalState -> Const Int GlobalState)
-> Getting Int CS Int -> Getting Int GlobalState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int CS Int
Lens' CS Int
index
                    (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> (([Int] -> Identity [Int]) -> CS -> Identity CS)
-> ([Int] -> Identity [Int])
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Int] -> Identity [Int]) -> CS -> Identity CS
Lens' CS [Int]
correctCards (([Int] -> Identity [Int]) -> GlobalState -> Identity GlobalState)
-> ([Int] -> [Int]) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) 
               EventM Name GlobalState ()
next
            Event
_ -> () -> EventM Name GlobalState ()
forall a. a -> EventM Name GlobalState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

finalPopup :: Popup GlobalState CS
finalPopup :: Popup GlobalState CS
finalPopup = (CS -> Widget Name)
-> (Event -> EventM Name GlobalState ())
-> PopupState
-> Popup GlobalState CS
forall s d.
(d -> Widget Name)
-> (Event -> EventM Name s ()) -> PopupState -> Popup s d
Popup CS -> Widget Name
forall {n}. CS -> Widget n
drawer Event -> EventM Name GlobalState ()
forall {n}. Event -> EventM n 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 a. [a] -> 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 :: Event -> EventM n GlobalState ()
eventHandler (V.EvKey Key
V.KEnter []) = EventM n GlobalState ()
forall n. EventM n GlobalState ()
halt'
        eventHandler Event
_ = () -> EventM n GlobalState ()
forall a. a -> EventM n GlobalState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

deckMakerPopup :: Popup GlobalState CS
deckMakerPopup :: Popup GlobalState CS
deckMakerPopup = (CS -> Widget Name)
-> (Event -> EventM Name GlobalState ())
-> PopupState
-> Popup GlobalState CS
forall s d.
(d -> Widget Name)
-> (Event -> EventM Name s ()) -> PopupState -> Popup s d
Popup CS -> Widget Name
forall {n}. CS -> Widget n
drawer Event -> EventM Name GlobalState ()
forall {n}. Event -> EventM n GlobalState ()
eventHandler PopupState
initialState
  where drawer :: CS -> Widget n
drawer CS
s =
          let state :: PopupState
state    = PopupState
-> (Popup GlobalState CS -> PopupState)
-> Maybe (Popup GlobalState CS)
-> PopupState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PopupState
initialState (Getting PopupState (Popup GlobalState CS) PopupState
-> Popup GlobalState CS -> PopupState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PopupState (Popup GlobalState CS) PopupState
forall s d (f :: * -> *).
Functor f =>
(PopupState -> f PopupState) -> Popup s d -> f (Popup s d)
popupState) (CS
sCS
-> Getting
     (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
-> Maybe (Popup GlobalState CS)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
Lens' CS (Maybe (Popup GlobalState 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 a. [a] -> 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 :: Event -> EventM n GlobalState ()
eventHandler Event
ev = do
          [Int]
im <- Getting [Int] GlobalState [Int] -> EventM n GlobalState [Int]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting [Int] GlobalState [Int] -> EventM n GlobalState [Int])
-> Getting [Int] GlobalState [Int] -> EventM n GlobalState [Int]
forall a b. (a -> b) -> a -> b
$ (CS -> Const [Int] CS) -> GlobalState -> Const [Int] GlobalState
Lens' GlobalState CS
cs((CS -> Const [Int] CS) -> GlobalState -> Const [Int] GlobalState)
-> Getting [Int] CS [Int] -> Getting [Int] GlobalState [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting [Int] CS [Int]
Lens' CS [Int]
indexMapping
          [Int]
ccs <- Getting [Int] GlobalState [Int] -> EventM n GlobalState [Int]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting [Int] GlobalState [Int] -> EventM n GlobalState [Int])
-> Getting [Int] GlobalState [Int] -> EventM n GlobalState [Int]
forall a b. (a -> b) -> a -> b
$ (CS -> Const [Int] CS) -> GlobalState -> Const [Int] GlobalState
Lens' GlobalState CS
cs((CS -> Const [Int] CS) -> GlobalState -> Const [Int] GlobalState)
-> Getting [Int] CS [Int] -> Getting [Int] GlobalState [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting [Int] CS [Int]
Lens' CS [Int]
correctCards
          let originalCorrects :: [Int]
originalCorrects = 
                (Int -> Int) -> [Int] -> [Int]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Int -> Int
forall a. Num a => a -> a
negate ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int]
im [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!!) [Int]
ccs)
          Popup GlobalState CS
p <- Maybe (Popup GlobalState CS) -> Popup GlobalState CS
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Popup GlobalState CS) -> Popup GlobalState CS)
-> EventM n GlobalState (Maybe (Popup GlobalState CS))
-> EventM n GlobalState (Popup GlobalState CS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Maybe (Popup GlobalState CS))
  GlobalState
  (Maybe (Popup GlobalState CS))
-> EventM n GlobalState (Maybe (Popup GlobalState CS))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((CS -> Const (Maybe (Popup GlobalState CS)) CS)
-> GlobalState -> Const (Maybe (Popup GlobalState CS)) GlobalState
Lens' GlobalState CS
cs((CS -> Const (Maybe (Popup GlobalState CS)) CS)
 -> GlobalState -> Const (Maybe (Popup GlobalState CS)) GlobalState)
-> Getting
     (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
-> Getting
     (Maybe (Popup GlobalState CS))
     GlobalState
     (Maybe (Popup GlobalState CS))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting
  (Maybe (Popup GlobalState CS)) CS (Maybe (Popup GlobalState CS))
Lens' CS (Maybe (Popup GlobalState CS))
popup)
          let ps :: (PopupState -> Identity PopupState)
-> GlobalState -> Identity GlobalState
ps = (CS -> Identity CS) -> GlobalState -> Identity GlobalState
Lens' GlobalState CS
cs((CS -> Identity CS) -> GlobalState -> Identity GlobalState)
-> ((PopupState -> Identity PopupState) -> CS -> Identity CS)
-> (PopupState -> Identity PopupState)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Popup GlobalState CS)
 -> Identity (Maybe (Popup GlobalState CS)))
-> CS -> Identity CS
Lens' CS (Maybe (Popup GlobalState CS))
popup((Maybe (Popup GlobalState CS)
  -> Identity (Maybe (Popup GlobalState CS)))
 -> CS -> Identity CS)
-> ((PopupState -> Identity PopupState)
    -> Maybe (Popup GlobalState CS)
    -> Identity (Maybe (Popup GlobalState CS)))
-> (PopupState -> Identity PopupState)
-> CS
-> Identity CS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Popup GlobalState CS -> Identity (Popup GlobalState CS))
-> Maybe (Popup GlobalState CS)
-> Identity (Maybe (Popup GlobalState CS))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just((Popup GlobalState CS -> Identity (Popup GlobalState CS))
 -> Maybe (Popup GlobalState CS)
 -> Identity (Maybe (Popup GlobalState CS)))
-> ((PopupState -> Identity PopupState)
    -> Popup GlobalState CS -> Identity (Popup GlobalState CS))
-> (PopupState -> Identity PopupState)
-> Maybe (Popup GlobalState CS)
-> Identity (Maybe (Popup GlobalState CS))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PopupState -> Identity PopupState)
-> Popup GlobalState CS -> Identity (Popup GlobalState CS)
forall s d (f :: * -> *).
Functor f =>
(PopupState -> f PopupState) -> Popup s d -> f (Popup s d)
popupState
          let state :: PopupState
state = Popup GlobalState CS
p Popup GlobalState CS
-> Getting PopupState (Popup GlobalState CS) PopupState
-> PopupState
forall s a. s -> Getting a s a -> a
^. Getting PopupState (Popup GlobalState CS) PopupState
forall s d (f :: * -> *).
Functor f =>
(PopupState -> f PopupState) -> Popup s d -> f (Popup s d)
popupState

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

generateDecks :: FilePath -> [Card] -> [Int] -> Bool -> Bool -> IO ()
generateDecks :: String -> [Card] -> [Int] -> Bool -> Bool -> IO ()
generateDecks String
fp [Card]
cards [Int]
corrects Bool
makeCorrect Bool
makeIncorrect =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
makeCorrect Bool -> Bool -> Bool
|| Bool
makeIncorrect) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    do let ([Card]
correct, [Card]
incorrect) = [Card] -> [Int] -> ([Card], [Card])
splitCorrectIncorrect [Card]
cards [Int]
corrects
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
makeCorrect   (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
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 () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
makeIncorrect (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
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 in decreasing order; 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)