{-# LANGUAGE TemplateHaskell #-}
module States (module States, GenIO) where

import Brick (Widget, EventM)
import Brick.Forms (Form)
import Brick.Widgets.FileBrowser
import Brick.Widgets.List (List)
import Data.Char (isDigit)
import Data.Map.Strict (Map)
import Lens.Micro.Platform
import System.Random.MWC (GenIO)
import Stack hiding (head)
import Types
import qualified Brick.Types as T
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as M
import qualified Graphics.Vty as V

data Name = 
          -- Settings

            HintsField
          | ControlsField
          | CaseSensitiveField
          | ShuffleAnswersField
          | EscapeCodeField
          | MaxRecentsField

          -- Parameters

          | ChunkField1
          | ChunkField2
          | SubsetField
          | ShuffleField
          | ReviewModeField
          | ParametersOkField

          | Ordinary
          | MainMenuList
          | InfoViewport
          | SettingsViewport
          | CardViewport Int
          | RecentsList
          | FileBrowserList
          | SBClick T.ClickableScrollbarElement Name
  deriving (Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)
type Event = ()

data Mode  = MainMenu    
           | Settings    
           | Info        
           | CardSelector
           | FileBrowser 
           | Cards
           | Parameter
  deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Eq Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
Ord)

data State = MainMenuState     MMS
           | SettingsState     SS
           | InfoState         IS
           | CardSelectorState CSS
           | FileBrowserState  FBS
           | ParameterState    PS
           | CardsState        CS

data Chunk = Chunk Int Int

instance Show Chunk where
  show :: Chunk -> String
show (Chunk Int
i Int
n) = forall a. Show a => a -> String
show Int
i forall a. Semigroup a => a -> a -> a
<> String
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n

instance Read Chunk where
  readsPrec :: Int -> ReadS Chunk
readsPrec Int
_ String
input =
    let (String
i', String
rest1) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
input
        i :: Int
i = forall a. Read a => String -> a
read String
i' :: Int
        (Char
c:String
rest2) = String
rest1
        (String
n', String
rest3) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
rest2
        n :: Int
n = forall a. Read a => String -> a
read String
n' :: Int
    in [(Int -> Int -> Chunk
Chunk Int
i Int
n, String
rest3) | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'/', Char
' '] Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>= Int
i Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
>= Int
1] 

data GlobalState = GlobalState
  { GlobalState -> GenIO
_mwc        :: GenIO
  , GlobalState -> Stack Mode
_stack      :: Stack Mode
  , GlobalState -> Map Mode State
_states     :: Map Mode State
  , GlobalState -> Parameters
_parameters :: Parameters
  }

data CardState = 
    DefinitionState
  { CardState -> Bool
_flipped        :: Bool }
  | MultipleChoiceState
  { CardState -> Int
_highlighted    :: Int
  , CardState -> Int
_number         :: Int
  , CardState -> Map Int Bool
_tried          :: Map Int Bool      -- indices of tried choices

  }
  | MultipleAnswerState
  { _highlighted    :: Int
  , CardState -> Map Int Bool
_selected       :: Map Int Bool
  , _number         :: Int
  , CardState -> Bool
_entered        :: Bool
  }
  | OpenQuestionState
  { CardState -> Map Int String
_gapInput       :: Map Int String
  , _highlighted    :: Int
  , _number         :: Int
  , _entered        :: Bool
  , CardState -> Map Int Bool
_correctGaps    :: Map Int Bool
  , CardState -> Bool
_failed         :: Bool
  }
  | ReorderState
  { _highlighted    :: Int
  , CardState -> Bool
_grabbed        :: Bool 
  , CardState -> Map Int (Int, String)
_order          :: Map Int (Int, String)
  , _entered        :: Bool
  , _number         :: Int
  }

defaultCardState :: Card -> CardState
defaultCardState :: Card -> CardState
defaultCardState Definition{} = DefinitionState { _flipped :: Bool
_flipped = Bool
False }
defaultCardState MultipleChoice{incorrects :: Card -> [IncorrectOption]
incorrects = [IncorrectOption]
ics} = MultipleChoiceState 
  { _highlighted :: Int
_highlighted = Int
0
  , _number :: Int
_number = forall (t :: * -> *) a. Foldable t => t a -> Int
length [IncorrectOption]
ics forall a. Num a => a -> a -> a
+ Int
1
  , _tried :: Map Int Bool
_tried = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int
i, Bool
False) | Int
i <- [Int
0..forall (t :: * -> *) a. Foldable t => t a -> Int
length [IncorrectOption]
ics]] }
defaultCardState OpenQuestion{perforated :: Card -> Perforated
perforated=Perforated
perf} = OpenQuestionState 
  { _gapInput :: Map Int String
_gapInput = forall k a. Map k a
M.empty
  , _highlighted :: Int
_highlighted = Int
0
  , _number :: Int
_number = Perforated -> Int
nGapsInPerforated Perforated
perf
  , _entered :: Bool
_entered = Bool
False
  , _correctGaps :: Map Int Bool
_correctGaps = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int
i, Bool
False) | Int
i <- [Int
0..Perforated -> Int
nGapsInPerforated Perforated
perf forall a. Num a => a -> a -> a
- Int
1]]
  , _failed :: Bool
_failed = Bool
False }
defaultCardState MultipleAnswer{options :: Card -> NonEmpty Option
options=NonEmpty Option
opts} = MultipleAnswerState 
  { _highlighted :: Int
_highlighted = Int
0
  , _selected :: Map Int Bool
_selected = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int
i, Bool
False) | Int
i <- [Int
0..forall a. NonEmpty a -> Int
NE.length NonEmpty Option
optsforall a. Num a => a -> a -> a
-Int
1]]
  , _entered :: Bool
_entered = Bool
False
  , _number :: Int
_number = forall a. NonEmpty a -> Int
NE.length NonEmpty Option
opts }
defaultCardState Reorder{elements :: Card -> NonEmpty (Int, String)
elements=NonEmpty (Int, String)
elts} = ReorderState
  { _highlighted :: Int
_highlighted = Int
0
  , _grabbed :: Bool
_grabbed = Bool
False
  , _order :: Map Int (Int, String)
_order = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Int, String)
elts))
  , _entered :: Bool
_entered = Bool
False
  , _number :: Int
_number = forall a. NonEmpty a -> Int
NE.length NonEmpty (Int, String)
elts }

data CS = CS
  { CS -> [Card]
_originalCards       :: [Card]     -- the deck as it was parsed

  , CS -> [Card]
_shownCards          :: [Card]     -- the deck after shuffling answers and cards

  , CS -> [Int]
_indexMapping        :: [Int]      -- contains the order that shownCards has wrt originalCards

  , CS -> Int
_index               :: Int        -- current card index

  , CS -> Int
_nCards              :: Int        -- number of cards

  , CS -> Card
_currentCard         :: Card
  , CS -> CardState
_cardState           :: CardState
  , CS -> Bool
_showHints           :: Bool
  , CS -> Bool
_showControls        :: Bool
  , CS -> Bool
_isCaseSensitive     :: Bool      
  , CS -> Bool
_reviewMode          :: Bool
  , CS -> [Int]
_correctCards        :: [Int]      -- list of indices of correct cards

  , CS -> Maybe (Popup GlobalState CS)
_popup               :: Maybe (Popup GlobalState CS)
  , CS -> String
_pathToFile          :: FilePath
  }

-- -- Lens for just accessing the cards

-- cards :: Lens' CS [Card]

-- cards = lens (map snd . _cardsAndImages) (\cs cards -> cs {_cardsAndImages = zip (map fst (_cardsAndImages cs)) cards})


-- currentCard :: Lens' CS Card

-- currentCard = lens (snd . _currentCardAndImage) (\cs card -> cs {_currentCardAndImage = (fst (_currentCardAndImage cs), card)})


data Popup s d = Popup
  { forall s d. Popup s d -> d -> Widget Name
drawPopup        :: d -> Widget Name
  , forall s d. Popup s d -> Event -> EventM Name s ()
handlePopupEvent :: V.Event -> EventM Name s ()
  , forall s d. Popup s d -> PopupState
_popupState      :: PopupState
  }

data PopupState = 
    CorrectPopup
      { PopupState -> Int
_popupSelected :: Int }
  | FinalPopup
  | DeckMakerPopup
      { _popupSelected     :: Int
      , PopupState -> Bool
_makeDeckIncorrect :: Bool
      , PopupState -> Bool
_makeDeckCorrect   :: Bool }
  deriving PopupState -> PopupState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PopupState -> PopupState -> Bool
$c/= :: PopupState -> PopupState -> Bool
== :: PopupState -> PopupState -> Bool
$c== :: PopupState -> PopupState -> Bool
Eq

newtype MMS = MMS 
  { MMS -> List Name String
_l  :: List Name String }

type IS = ()

data Settings = FormState
  { Settings -> Bool
_hints           :: Bool
  , Settings -> Bool
_controls        :: Bool
  , Settings -> Bool
_caseSensitive   :: Bool
  , Settings -> Bool
_shuffleAnswers  :: Bool
  , Settings -> Bool
_escapeCode      :: Bool
  , Settings -> Int
_maxRecents      :: Int }
  deriving (ReadPrec [Settings]
ReadPrec Settings
Int -> ReadS Settings
ReadS [Settings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Settings]
$creadListPrec :: ReadPrec [Settings]
readPrec :: ReadPrec Settings
$creadPrec :: ReadPrec Settings
readList :: ReadS [Settings]
$creadList :: ReadS [Settings]
readsPrec :: Int -> ReadS Settings
$creadsPrec :: Int -> ReadS Settings
Read, Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show)

type SS = Form Settings Event Name

data CSS = CSS
  { CSS -> List Name String
_list             :: List Name String
  , CSS -> Maybe String
_exception        :: Maybe String
  , CSS -> Stack String
_recents          :: Stack FilePath
  , CSS -> Int
_maxRecentsToShow :: Int
  }

data FBS = FBS
  { FBS -> FileBrowser Name
_fb          :: FileBrowser Name
  , FBS -> Maybe String
_exception'  :: Maybe String
  , FBS -> [Card]
_parsedCards :: [Card]
  , FBS -> Maybe String
_filePath    :: Maybe FilePath
  , FBS -> Bool
_showHidden  :: Bool
  }

defaultParameters :: Parameters
defaultParameters = Parameters
  { _pShuffle :: Bool
_pShuffle    = Bool
False
  , _pSubset :: Maybe Int
_pSubset     = forall a. Maybe a
Nothing
  , _pChunk :: Chunk
_pChunk      = Int -> Int -> Chunk
Chunk Int
1 Int
1
  , _pReviewMode :: Bool
_pReviewMode = Bool
True
  , _pOk :: Bool
_pOk         = Bool
False }

data Parameters = Parameters
  { Parameters -> Bool
_pShuffle    :: Bool
  , Parameters -> Maybe Int
_pSubset     :: Maybe Int
  , Parameters -> Chunk
_pChunk      :: Chunk
  , Parameters -> Bool
_pReviewMode :: Bool
  , Parameters -> Bool
_pOk         :: Bool }

data PS = PS
  { PS -> [Card]
_psCards     :: [Card]
  , PS -> String
_psFp        :: FilePath
  , PS -> Form Parameters () Name
_psForm      :: Form Parameters Event Name
  }

makeLenses ''State
makeLenses ''MMS
makeLenses ''GlobalState
makeLenses ''CardState
makeLenses ''CS
makeLenses ''Settings
makeLenses ''CSS
makeLenses ''FBS
makeLenses ''PS
makeLenses ''Parameters
makeLenses ''Popup
makeLenses ''PopupState