{-# LANGUAGE FlexibleContexts #-}
module StateManagement where
import Brick
import Control.Monad.IO.Class
import Control.Monad.State.Class
import Control.Monad.State.Lazy (execState)
import Control.Monad (when, (<=<))
import Data.Maybe (fromJust)
import Lens.Micro.Platform
import Recents
import States hiding (cardState)
import Stack hiding (head)
import qualified Brick.Widgets.List as L
import qualified Data.Vector as Vec
import qualified Data.Map.Strict as M
import qualified Stack

getMode :: State -> Mode
getMode :: State -> Mode
getMode (MainMenuState     MMS
_) = Mode
MainMenu
getMode (SettingsState     SS
_) = Mode
Settings
getMode (InfoState         IS
_) = Mode
Info
getMode (CardSelectorState CSS
_) = Mode
CardSelector
getMode (FileBrowserState  FBS
_) = Mode
FileBrowser
getMode (CardsState        CS
_) = Mode
Cards
getMode (ParameterState    PS
_) = Mode
Parameter

getState :: MonadState GlobalState m => m State
getState :: forall (m :: * -> *). MonadState GlobalState m => m State
getState = forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadState GlobalState m => m (Maybe State)
safeGetState

mms :: Lens' GlobalState MMS
mms :: Lens' GlobalState MMS
mms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GlobalState
gs -> State -> MMS
mmsCast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
MainMenu (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Map Mode State)
states)) (\GlobalState
gs MMS
s -> GlobalState
gs forall a b. a -> (a -> b) -> b
& Lens' GlobalState (Map Mode State)
states forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mode
MainMenu (MMS -> State
MainMenuState MMS
s))
  where mmsCast :: State -> MMS
mmsCast s :: State
s@(MainMenuState MMS
mms) = MMS
mms
        mmsCast State
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

ss :: Lens' GlobalState SS
ss :: Lens' GlobalState SS
ss = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GlobalState
gs -> State -> SS
ssCast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
Settings (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Map Mode State)
states)) (\GlobalState
gs SS
s -> GlobalState
gs forall a b. a -> (a -> b) -> b
& Lens' GlobalState (Map Mode State)
states forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mode
Settings (SS -> State
SettingsState SS
s))
  where ssCast :: State -> SS
ssCast s :: State
s@(SettingsState SS
ss) = SS
ss
        ssCast State
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

is :: Lens' GlobalState IS
is :: Lens' GlobalState IS
is = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GlobalState
gs -> State -> IS
isCast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
Info (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Map Mode State)
states)) (\GlobalState
gs IS
s -> GlobalState
gs forall a b. a -> (a -> b) -> b
& Lens' GlobalState (Map Mode State)
states forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mode
Info (IS -> State
InfoState IS
s))
  where isCast :: State -> IS
isCast s :: State
s@(InfoState IS
ss) = IS
ss
        isCast State
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

cs :: Lens' GlobalState CS
cs :: Lens' GlobalState CS
cs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GlobalState
gs -> State -> CS
csCast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
Cards (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Map Mode State)
states)) (\GlobalState
gs CS
s -> GlobalState
gs forall a b. a -> (a -> b) -> b
& Lens' GlobalState (Map Mode State)
states forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mode
Cards (CS -> State
CardsState CS
s))
  where csCast :: State -> CS
csCast s :: State
s@(CardsState CS
cs) = CS
cs
        csCast State
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

css :: Lens' GlobalState CSS
css :: Lens' GlobalState CSS
css = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GlobalState
gs -> State -> CSS
cssCast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
CardSelector (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Map Mode State)
states)) (\GlobalState
gs CSS
s -> GlobalState
gs forall a b. a -> (a -> b) -> b
& Lens' GlobalState (Map Mode State)
states forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mode
CardSelector (CSS -> State
CardSelectorState CSS
s))
  where cssCast :: State -> CSS
cssCast s :: State
s@(CardSelectorState CSS
css) = CSS
css
        cssCast State
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

fbs :: Lens' GlobalState FBS
fbs :: Lens' GlobalState FBS
fbs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GlobalState
gs -> State -> FBS
fbsCast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
FileBrowser (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Map Mode State)
states)) (\GlobalState
gs FBS
s -> GlobalState
gs forall a b. a -> (a -> b) -> b
& Lens' GlobalState (Map Mode State)
states forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mode
FileBrowser (FBS -> State
FileBrowserState FBS
s))
  where fbsCast :: State -> FBS
fbsCast s :: State
s@(FileBrowserState FBS
fbs) = FBS
fbs
        fbsCast State
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

ps :: Lens' GlobalState PS
ps :: Lens' GlobalState PS
ps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GlobalState
gs -> State -> PS
psCast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
Parameter (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Map Mode State)
states)) (\GlobalState
gs PS
s -> GlobalState
gs forall a b. a -> (a -> b) -> b
& Lens' GlobalState (Map Mode State)
states forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mode
Parameter (PS -> State
ParameterState PS
s))
  where psCast :: State -> PS
psCast s :: State
s@(ParameterState PS
ps) = PS
ps
        psCast State
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

goToState_ :: GlobalState -> State -> GlobalState
goToState_ :: GlobalState -> State -> GlobalState
goToState_ GlobalState
gs State
s = forall s a. State s a -> s -> s
execState (forall (m :: * -> *). MonadState GlobalState m => State -> m IS
goToState State
s) GlobalState
gs

goToState :: MonadState GlobalState m => State -> m ()
goToState :: forall (m :: * -> *). MonadState GlobalState m => State -> m IS
goToState State
s = do Lens' GlobalState (Map Mode State)
states forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m IS
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (State -> Mode
getMode State
s) State
s
                 Lens' GlobalState (Stack Mode)
stack  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m IS
%= forall a. Ord a => a -> Stack a -> Stack a
insert (State -> Mode
getMode State
s)

moveToState :: MonadState GlobalState m => State -> m ()
moveToState :: forall (m :: * -> *). MonadState GlobalState m => State -> m IS
moveToState State
s = do
  forall (m :: * -> *). MonadState GlobalState m => m IS
popState
  forall (m :: * -> *). MonadState GlobalState m => State -> m IS
goToState State
s

-- popState until at mode of state s.

removeToState :: MonadState GlobalState m => State -> m ()
removeToState :: forall (m :: * -> *). MonadState GlobalState m => State -> m IS
removeToState State
s = do
  forall (m :: * -> *). MonadState GlobalState m => m IS
popState
  Mode
current <- forall a. Stack a -> a
Stack.head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState (Stack Mode)
stack
  if Mode
current forall a. Eq a => a -> a -> Bool
== State -> Mode
getMode State
s 
    then forall (m :: * -> *). MonadState GlobalState m => State -> m IS
moveToState State
s
    else forall (m :: * -> *). MonadState GlobalState m => State -> m IS
removeToState State
s

popState :: MonadState GlobalState m => m ()
popState :: forall (m :: * -> *). MonadState GlobalState m => m IS
popState = do
  Stack Mode
s <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState (Stack Mode)
stack
  let top :: Mode
top = forall a. Stack a -> a
Stack.head Stack Mode
s
      s' :: Stack Mode
s'  = forall a. Ord a => Stack a -> Stack a
Stack.pop Stack Mode
s
  Lens' GlobalState (Map Mode State)
states forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m IS
%= forall k a. Ord k => k -> Map k a -> Map k a
M.delete Mode
top
  Lens' GlobalState (Stack Mode)
stack  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m IS
.= Stack Mode
s'

popStateOrQuit :: EventM n GlobalState ()
popStateOrQuit :: forall n. EventM n GlobalState IS
popStateOrQuit = 
  do forall (m :: * -> *). MonadState GlobalState m => m IS
popState
     Stack Mode
s <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState (Stack Mode)
stack
     forall (f :: * -> *). Applicative f => Bool -> f IS -> f IS
when (forall a. Stack a -> Int
Stack.size Stack Mode
s forall a. Eq a => a -> a -> Bool
== Int
0) forall n s. EventM n s IS
halt

safeGetState :: MonadState GlobalState m => m (Maybe State)
safeGetState :: forall (m :: * -> *). MonadState GlobalState m => m (Maybe State)
safeGetState = do
  GlobalState
gs <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do 
    Mode
key <- forall a. Stack a -> Maybe a
safeHead (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Stack Mode)
stack)
    forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
key (GlobalState
gs forall s a. s -> Getting a s a -> a
^. Lens' GlobalState (Map Mode State)
states)

goToModeOrQuit :: Mode -> EventM n GlobalState ()
goToModeOrQuit :: forall n. Mode -> EventM n GlobalState IS
goToModeOrQuit Mode
mode = do
  Maybe State
mMode <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
mode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState (Map Mode State)
states
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n s. EventM n s IS
halt forall (m :: * -> *). MonadState GlobalState m => State -> m IS
goToState Maybe State
mMode 

removeToMode :: MonadState GlobalState m => Mode -> m ()
removeToMode :: forall (m :: * -> *). MonadState GlobalState m => Mode -> m IS
removeToMode Mode
m = do
  forall (m :: * -> *). MonadState GlobalState m => m IS
popState
  Mode
current <- forall a. Stack a -> a
Stack.head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState (Stack Mode)
stack
  if Mode
current forall a. Eq a => a -> a -> Bool
== Mode
m
    then forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else forall (m :: * -> *). MonadState GlobalState m => Mode -> m IS
removeToMode Mode
m

removeToModeOrQuit :: Mode -> EventM n GlobalState ()
removeToModeOrQuit :: forall n. Mode -> EventM n GlobalState IS
removeToModeOrQuit = forall n.
EventM n GlobalState IS -> Mode -> EventM n GlobalState IS
removeToModeOrQuit' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

removeToModeOrQuit' :: EventM n GlobalState () -> Mode -> EventM n GlobalState ()
removeToModeOrQuit' :: forall n.
EventM n GlobalState IS -> Mode -> EventM n GlobalState IS
removeToModeOrQuit' EventM n GlobalState IS
beforeMoving Mode
mode = do
  Maybe State
mState <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
mode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' GlobalState (Map Mode State)
states
  case Maybe State
mState of
    Maybe State
Nothing -> forall n s. EventM n s IS
halt
    Just State
m -> do
      GlobalState
gs <- forall s (m :: * -> *). MonadState s m => m s
get
      EventM n GlobalState IS
beforeMoving
      forall (m :: * -> *). MonadState GlobalState m => Mode -> m IS
removeToMode Mode
mode

refreshRecents :: (MonadState CSS m, MonadIO m) => m ()
refreshRecents :: forall (m :: * -> *). (MonadState CSS m, MonadIO m) => m IS
refreshRecents = do
  Stack [Char]
rs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Stack [Char])
getRecents
  let prettyRecents :: [[Char]]
prettyRecents = [[Char]] -> [[Char]]
shortenFilepaths (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Stack [Char]
rs)
      options :: Vector [Char]
options       = forall a. [a] -> Vector a
Vec.fromList ([[Char]]
prettyRecents forall a. [a] -> [a] -> [a]
++ [[Char]
"Select file from system"])
  Lens' CSS (Stack [Char])
recents forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m IS
.= Stack [Char]
rs
  Lens' CSS (List Name [Char])
list forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m IS
.= forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list Name
RecentsList Vector [Char]
options Int
1