{-# 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 (forall (t :: * -> *) a. Foldable t => t a -> [a]
S.toList Stack FilePath
rs)
      options :: Vector FilePath
options = forall a. [a] -> Vector a
Vec.fromList ([FilePath]
prettyRecents forall a. [a] -> [a] -> [a]
++ [FilePath
"Select file from system"])
      initialState :: CSS
initialState = CSS
        { _list :: List Name FilePath
_list = 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 = forall a. Maybe a
Nothing
        , _recents :: Stack FilePath
_recents = Stack FilePath
rs
        , _maxRecentsToShow :: Int
_maxRecentsToShow = Int
maxRs }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CSS -> State
CardSelectorState CSS
initialState

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

      initialState :: MMS
initialState = List Name FilePath -> MMS
MMS (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 [] = forall a. Maybe a
Nothing
safeHead (a
x:[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 = forall a. [a] -> Maybe a
safeHead [Card]
shuffledDeck
      firstCard :: Card
firstCard = forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Maybe External -> FilePath -> Card
Definition FilePath
"Empty deck" forall a. Maybe a
Nothing FilePath
"Click enter to go back.") Maybe Card
mFirstCard
      deck' :: [Card]
deck' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Card
firstCard] (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 = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a b. a -> b -> a
const Bool
doReview) Maybe Card
mFirstCard
           , _correctCards :: [Int]
_correctCards = []
           , _popup :: Maybe (Popup GlobalState CS)
_popup = forall a. Maybe a
Nothing
           , _pathToFile :: FilePath
_pathToFile = FilePath
fp }
 
  FilePath -> Card -> IO ()
openCardExternal (FilePath -> FilePath
takeDirectory FilePath
fp) Card
firstCard
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 = forall a. Chunk -> [a] -> [a]
doChunking (GlobalState
gsforall s a. s -> Getting a s a -> a
^.Lens' GlobalState Parameters
parametersforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Parameters Chunk
pChunk) [Card]
cards
      trimmed :: [Card]
trimmed = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Int -> [a] -> [a]
take (GlobalState
gsforall s a. s -> Getting a s a -> a
^.Lens' GlobalState Parameters
parametersforall b c a. (b -> c) -> (a -> b) -> a -> c
.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
gsforall s a. s -> Getting a s a -> a
^.Lens' GlobalState Parameters
parametersforall b c a. (b -> c) -> (a -> b) -> a -> c
.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 <- forall n.
(FileInfo -> Bool) -> n -> Maybe FilePath -> IO (FileBrowser n)
newFileBrowser FileInfo -> Bool
selectNonDirectories Name
FileBrowserList forall a. Maybe a
Nothing
  let filteredBrowser :: FileBrowser Name
filteredBrowser = forall n.
Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
setFileBrowserEntryFilter (forall a. a -> Maybe a
Just (Bool -> FileInfo -> Bool
entryFilter Bool
False)) FileBrowser Name
browser
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FBS -> State
FileBrowserState (FileBrowser Name
-> Maybe FilePath -> [Card] -> Maybe FilePath -> Bool -> FBS
FBS FileBrowser Name
filteredBrowser forall a. Maybe a
Nothing [] 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 (forall e. Int -> Parameters -> Form Parameters e Name
mkParameterForm (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
cards) Parameters
ps))