{-# LANGUAGE FlexibleContexts #-}
module Runners where
import Brick.Widgets.FileBrowser
import Brick.Forms
import Control.Monad.IO.Class
import Control.Monad.State.Class
import DeckHandling
import Data.Maybe (fromMaybe)
import Recents
import Lens.Micro.Platform
import Parameters
import Settings
import States
import System.FilePath (takeDirectory)
import Types
import qualified Brick.Widgets.List as L
import qualified Data.Vector as Vec
import qualified Stack as S

cardSelectorState :: IO State
cardSelectorState :: IO State
cardSelectorState = do
  Stack FilePath
rs <- IO (Stack FilePath)
getRecents
  Int
maxRs <- IO Int
getMaxRecents
  let prettyRecents :: [FilePath]
prettyRecents = [FilePath] -> [FilePath]
shortenFilepaths (Stack FilePath -> [FilePath]
forall a. OSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
S.toList Stack FilePath
rs)
      options :: Vector FilePath
options = [FilePath] -> Vector FilePath
forall a. [a] -> Vector a
Vec.fromList ([FilePath]
prettyRecents [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"Select file from system"])
      initialState :: CSS
initialState = CSS
        { _list :: List Name FilePath
_list = Name -> Vector FilePath -> Int -> List Name FilePath
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list Name
RecentsList Vector FilePath
options Int
1
        , _exception :: Maybe FilePath
_exception = Maybe FilePath
forall a. Maybe a
Nothing
        , _recents :: Stack FilePath
_recents = Stack FilePath
rs
        , _maxRecentsToShow :: Int
_maxRecentsToShow = Int
maxRs }
  State -> IO State
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> IO State) -> State -> IO State
forall a b. (a -> b) -> a -> b
$ CSS -> State
CardSelectorState CSS
initialState

mainMenuState :: State
mainMenuState :: State
mainMenuState = 
  let options :: Vector FilePath
options = [FilePath] -> Vector FilePath
forall a. [a] -> Vector a
Vec.fromList 
                  [ FilePath
"Select"
                  , FilePath
"Info"
                  , FilePath
"Settings"
                  , FilePath
"Quit" ]

      initialState :: MMS
initialState = List Name FilePath -> MMS
MMS (Name -> Vector FilePath -> Int -> List Name FilePath
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list Name
MainMenuList Vector FilePath
options Int
1) in
  MMS -> State
MainMenuState MMS
initialState

safeHead :: [a] -> Maybe a
safeHead :: forall a. [a] -> Maybe a
safeHead [] = Maybe a
forall a. Maybe a
Nothing
safeHead (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

cardsState :: Bool -> FilePath -> [Card] -> [Card] -> [Int] -> IO State
cardsState :: Bool -> FilePath -> [Card] -> [Card] -> [Int] -> IO State
cardsState Bool
doReview FilePath
fp [Card]
originalDeck [Card]
shuffledDeck [Int]
ixs = do
  Bool
hints    <- IO Bool
getShowHints
  Bool
controls <- IO Bool
getShowControls
  Bool
caseSensitive <- IO Bool
getCaseSensitive

  let mFirstCard :: Maybe Card
mFirstCard = [Card] -> Maybe Card
forall a. [a] -> Maybe a
safeHead [Card]
shuffledDeck
      firstCard :: Card
firstCard = Card -> Maybe Card -> Card
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Maybe External -> FilePath -> Card
Definition FilePath
"Empty deck" Maybe External
forall a. Maybe a
Nothing FilePath
"Click enter to go back.") Maybe Card
mFirstCard
      deck' :: [Card]
deck' = [Card] -> (Card -> [Card]) -> Maybe Card -> [Card]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Card
firstCard] ([Card] -> Card -> [Card]
forall a b. a -> b -> a
const [Card]
shuffledDeck) Maybe Card
mFirstCard

      initialState :: CS
initialState = 
        CS { _originalCards :: [Card]
_originalCards = [Card]
originalDeck
           , _shownCards :: [Card]
_shownCards = [Card]
deck'
           , _indexMapping :: [Int]
_indexMapping = [Int]
ixs
           , _index :: Int
_index = Int
0
           , _currentCard :: Card
_currentCard = Card
firstCard
           , _cardState :: CardState
_cardState = Card -> CardState
defaultCardState Card
firstCard
           , _nCards :: Int
_nCards = [Card] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
deck'
           , _showHints :: Bool
_showHints = Bool
hints
           , _showControls :: Bool
_showControls = Bool
controls
           , _isCaseSensitive :: Bool
_isCaseSensitive = Bool
caseSensitive
           , _reviewMode :: Bool
_reviewMode = Bool -> (Card -> Bool) -> Maybe Card -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Card -> Bool
forall a b. a -> b -> a
const Bool
doReview) Maybe Card
mFirstCard
           , _correctCards :: [Int]
_correctCards = []
           , _popup :: Maybe (Popup GlobalState CS)
_popup = Maybe (Popup GlobalState CS)
forall a. Maybe a
Nothing
           , _pathToFile :: FilePath
_pathToFile = FilePath
fp }
 
  FilePath -> Card -> IO ()
openCardExternal (FilePath -> FilePath
takeDirectory FilePath
fp) Card
firstCard
  State -> IO State
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> IO State) -> State -> IO State
forall a b. (a -> b) -> a -> b
$ CS -> State
CardsState CS
initialState

cardsWithOptionsStateM :: (MonadState GlobalState m, MonadIO m) => FilePath -> [Card] -> m State
cardsWithOptionsStateM :: forall (m :: * -> *).
(MonadState GlobalState m, MonadIO m) =>
FilePath -> [Card] -> m State
cardsWithOptionsStateM FilePath
fp [Card]
cards = do
  GlobalState
gs <- m GlobalState
forall s (m :: * -> *). MonadState s m => m s
get
  IO State -> m State
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO State -> m State) -> IO State -> m State
forall a b. (a -> b) -> a -> b
$ GlobalState -> FilePath -> [Card] -> IO State
cardsWithOptionsState GlobalState
gs FilePath
fp [Card]
cards

cardsWithOptionsState :: GlobalState -> FilePath -> [Card] -> IO State
cardsWithOptionsState :: GlobalState -> FilePath -> [Card] -> IO State
cardsWithOptionsState GlobalState
gs FilePath
fp [Card]
cards =
  let chunked :: [Card]
chunked = Chunk -> [Card] -> [Card]
forall a. Chunk -> [a] -> [a]
doChunking (GlobalState
gsGlobalState -> Getting Chunk GlobalState Chunk -> Chunk
forall s a. s -> Getting a s a -> a
^.(Parameters -> Const Chunk Parameters)
-> GlobalState -> Const Chunk GlobalState
Lens' GlobalState Parameters
parameters((Parameters -> Const Chunk Parameters)
 -> GlobalState -> Const Chunk GlobalState)
-> ((Chunk -> Const Chunk Chunk)
    -> Parameters -> Const Chunk Parameters)
-> Getting Chunk GlobalState Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Chunk -> Const Chunk Chunk)
-> Parameters -> Const Chunk Parameters
Lens' Parameters Chunk
pChunk) [Card]
cards
      trimmed :: [Card]
trimmed = ([Card] -> [Card])
-> (Int -> [Card] -> [Card]) -> Maybe Int -> [Card] -> [Card]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Card] -> [Card]
forall a. a -> a
id Int -> [Card] -> [Card]
forall a. Int -> [a] -> [a]
take (GlobalState
gsGlobalState
-> Getting (Maybe Int) GlobalState (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.(Parameters -> Const (Maybe Int) Parameters)
-> GlobalState -> Const (Maybe Int) GlobalState
Lens' GlobalState Parameters
parameters((Parameters -> Const (Maybe Int) Parameters)
 -> GlobalState -> Const (Maybe Int) GlobalState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> Parameters -> Const (Maybe Int) Parameters)
-> Getting (Maybe Int) GlobalState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> Parameters -> Const (Maybe Int) Parameters
Lens' Parameters (Maybe Int)
pSubset) [Card]
chunked
  in do
    Bool
shuffleAnswers <- IO Bool
getShuffleAnswers
    ([Int]
ixs, [Card]
shuffledCards) <- GlobalState -> Bool -> [Card] -> IO ([Int], [Card])
doRandomization GlobalState
gs Bool
shuffleAnswers [Card]
trimmed
    Bool -> FilePath -> [Card] -> [Card] -> [Int] -> IO State
cardsState (GlobalState
gsGlobalState -> Getting Bool GlobalState Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(Parameters -> Const Bool Parameters)
-> GlobalState -> Const Bool GlobalState
Lens' GlobalState Parameters
parameters((Parameters -> Const Bool Parameters)
 -> GlobalState -> Const Bool GlobalState)
-> ((Bool -> Const Bool Bool)
    -> Parameters -> Const Bool Parameters)
-> Getting Bool GlobalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Parameters -> Const Bool Parameters
Lens' Parameters Bool
pReviewMode) FilePath
fp [Card]
trimmed [Card]
shuffledCards [Int]
ixs

infoState :: State
infoState :: State
infoState = () -> State
InfoState ()

fileBrowserState :: IO State
fileBrowserState :: IO State
fileBrowserState = do
  FileBrowser Name
browser <- (FileInfo -> Bool)
-> Name -> Maybe FilePath -> IO (FileBrowser Name)
forall n.
(FileInfo -> Bool) -> n -> Maybe FilePath -> IO (FileBrowser n)
newFileBrowser FileInfo -> Bool
selectNonDirectories Name
FileBrowserList Maybe FilePath
forall a. Maybe a
Nothing
  let filteredBrowser :: FileBrowser Name
filteredBrowser = Maybe (FileInfo -> Bool) -> FileBrowser Name -> FileBrowser Name
forall n.
Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
setFileBrowserEntryFilter ((FileInfo -> Bool) -> Maybe (FileInfo -> Bool)
forall a. a -> Maybe a
Just (Bool -> FileInfo -> Bool
entryFilter Bool
False)) FileBrowser Name
browser
  State -> IO State
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> IO State) -> State -> IO State
forall a b. (a -> b) -> a -> b
$ FBS -> State
FileBrowserState (FileBrowser Name
-> Maybe FilePath -> [Card] -> Maybe FilePath -> Bool -> FBS
FBS FileBrowser Name
filteredBrowser Maybe FilePath
forall a. Maybe a
Nothing [] Maybe FilePath
forall a. Maybe a
Nothing Bool
False)

entryFilter :: Bool -> FileInfo -> Bool
entryFilter :: Bool -> FileInfo -> Bool
entryFilter Bool
acceptHidden FileInfo
info = (FilePath -> FileInfo -> Bool
fileExtensionMatch FilePath
"txt" FileInfo
info Bool -> Bool -> Bool
|| FilePath -> FileInfo -> Bool
fileExtensionMatch FilePath
"md" FileInfo
info) Bool -> Bool -> Bool
&& (Bool
acceptHidden Bool -> Bool -> Bool
|| 
  case FileInfo -> FilePath
fileInfoFilename FileInfo
info of
    FilePath
".."    -> Bool
True
    Char
'.' : FilePath
_ -> Bool
False
    FilePath
_       -> Bool
True)

parameterState :: Parameters -> FilePath -> [Card] -> State
parameterState :: Parameters -> FilePath -> [Card] -> State
parameterState Parameters
ps FilePath
fp [Card]
cards = PS -> State
ParameterState ([Card] -> FilePath -> Form Parameters () Name -> PS
PS [Card]
cards FilePath
fp (Int -> Parameters -> Form Parameters () Name
forall e. Int -> Parameters -> Form Parameters e Name
mkParameterForm ([Card] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
cards) Parameters
ps))