module StateManagement where
import Brick
import Control.Monad.IO.Class
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 :: GlobalState -> State
getState :: GlobalState -> State
getState = Maybe State -> State
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe State -> State)
-> (GlobalState -> Maybe State) -> GlobalState -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> Maybe State
safeGetState

updateState :: GlobalState -> State -> GlobalState
updateState :: GlobalState -> State -> GlobalState
updateState GlobalState
gs State
s = GlobalState
gs GlobalState -> (GlobalState -> GlobalState) -> GlobalState
forall a b. a -> (a -> b) -> b
& (Map Mode State -> Identity (Map Mode State))
-> GlobalState -> Identity GlobalState
Lens' GlobalState (Map Mode State)
states ((Map Mode State -> Identity (Map Mode State))
 -> GlobalState -> Identity GlobalState)
-> (Map Mode State -> Map Mode State) -> GlobalState -> GlobalState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Mode -> State -> Map Mode State -> Map Mode State
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (State -> Mode
getMode State
s) State
s

updateMMS :: GlobalState -> MMS -> GlobalState
updateMMS :: GlobalState -> MMS -> GlobalState
updateMMS GlobalState
gs MMS
s = GlobalState -> State -> GlobalState
updateState GlobalState
gs (MMS -> State
MainMenuState MMS
s)

updateSS :: GlobalState -> SS -> GlobalState
updateSS :: GlobalState -> SS -> GlobalState
updateSS GlobalState
gs SS
s = GlobalState -> State -> GlobalState
updateState GlobalState
gs (SS -> State
SettingsState SS
s)

updateIS :: GlobalState -> IS -> GlobalState
updateIS :: GlobalState -> IS -> GlobalState
updateIS GlobalState
gs IS
s = GlobalState -> State -> GlobalState
updateState GlobalState
gs (IS -> State
InfoState IS
s)

updateCS :: GlobalState -> CS -> GlobalState
updateCS :: GlobalState -> CS -> GlobalState
updateCS GlobalState
gs CS
s = GlobalState -> State -> GlobalState
updateState GlobalState
gs (CS -> State
CardsState CS
s)

updateCSS :: GlobalState -> CSS -> GlobalState
updateCSS :: GlobalState -> CSS -> GlobalState
updateCSS GlobalState
gs CSS
s = GlobalState -> State -> GlobalState
updateState GlobalState
gs (CSS -> State
CardSelectorState CSS
s)

updateInfo :: GlobalState -> IS -> GlobalState
updateInfo :: GlobalState -> IS -> GlobalState
updateInfo GlobalState
gs IS
s = GlobalState -> State -> GlobalState
updateState GlobalState
gs (IS -> State
InfoState IS
s)

updateFBS :: GlobalState -> FBS -> GlobalState
updateFBS :: GlobalState -> FBS -> GlobalState
updateFBS GlobalState
gs FBS
s = GlobalState -> State -> GlobalState
updateState GlobalState
gs (FBS -> State
FileBrowserState FBS
s)

updatePS :: GlobalState -> PS -> GlobalState
updatePS :: GlobalState -> PS -> GlobalState
updatePS GlobalState
gs PS
s = GlobalState -> State -> GlobalState
updateState GlobalState
gs (PS -> State
ParameterState PS
s)

goToState :: GlobalState -> State -> GlobalState
goToState :: GlobalState -> State -> GlobalState
goToState GlobalState
gs State
s = GlobalState
gs GlobalState -> (GlobalState -> GlobalState) -> GlobalState
forall a b. a -> (a -> b) -> b
& (Map Mode State -> Identity (Map Mode State))
-> GlobalState -> Identity GlobalState
Lens' GlobalState (Map Mode State)
states ((Map Mode State -> Identity (Map Mode State))
 -> GlobalState -> Identity GlobalState)
-> (Map Mode State -> Map Mode State) -> GlobalState -> GlobalState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Mode -> State -> Map Mode State -> Map Mode State
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (State -> Mode
getMode State
s) State
s
                    GlobalState -> (GlobalState -> GlobalState) -> GlobalState
forall a b. a -> (a -> b) -> b
& (Stack Mode -> Identity (Stack Mode))
-> GlobalState -> Identity GlobalState
Lens' GlobalState (Stack Mode)
stack  ((Stack Mode -> Identity (Stack Mode))
 -> GlobalState -> Identity GlobalState)
-> (Stack Mode -> Stack Mode) -> GlobalState -> GlobalState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Mode -> Stack Mode -> Stack Mode
forall a. Ord a => a -> Stack a -> Stack a
insert (State -> Mode
getMode State
s)

moveToState :: GlobalState -> State -> GlobalState 
moveToState :: GlobalState -> State -> GlobalState
moveToState GlobalState
gs = GlobalState -> State -> GlobalState
goToState (GlobalState -> GlobalState
popState GlobalState
gs)

-- popState until at mode of state s.
removeToState :: GlobalState -> State -> GlobalState
removeToState :: GlobalState -> State -> GlobalState
removeToState GlobalState
gs State
s = GlobalState -> GlobalState
go (GlobalState -> GlobalState
popState GlobalState
gs)
  where go :: GlobalState -> GlobalState
go GlobalState
global = 
          let current :: Mode
current = Stack Mode -> Mode
forall a. Stack a -> a
Stack.head (GlobalState
global GlobalState
-> Getting (Stack Mode) GlobalState (Stack Mode) -> Stack Mode
forall s a. s -> Getting a s a -> a
^. Getting (Stack Mode) GlobalState (Stack Mode)
Lens' GlobalState (Stack Mode)
stack)
          in if Mode
current Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== State -> Mode
getMode State
s then GlobalState -> State -> GlobalState
moveToState GlobalState
global State
s
          else GlobalState -> GlobalState
go (GlobalState -> GlobalState
popState GlobalState
global)

popState :: GlobalState -> GlobalState
popState :: GlobalState -> GlobalState
popState GlobalState
gs = let
  s :: Stack Mode
s    = GlobalState
gs GlobalState
-> Getting (Stack Mode) GlobalState (Stack Mode) -> Stack Mode
forall s a. s -> Getting a s a -> a
^. Getting (Stack Mode) GlobalState (Stack Mode)
Lens' GlobalState (Stack Mode)
stack
  top :: Mode
top  = Stack Mode -> Mode
forall a. Stack a -> a
Stack.head Stack Mode
s
  s' :: Stack Mode
s'   = Stack Mode -> Stack Mode
forall a. Ord a => Stack a -> Stack a
Stack.pop Stack Mode
s in
    GlobalState
gs GlobalState -> (GlobalState -> GlobalState) -> GlobalState
forall a b. a -> (a -> b) -> b
& (Map Mode State -> Identity (Map Mode State))
-> GlobalState -> Identity GlobalState
Lens' GlobalState (Map Mode State)
states ((Map Mode State -> Identity (Map Mode State))
 -> GlobalState -> Identity GlobalState)
-> (Map Mode State -> Map Mode State) -> GlobalState -> GlobalState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Mode -> Map Mode State -> Map Mode State
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Mode
top
       GlobalState -> (GlobalState -> GlobalState) -> GlobalState
forall a b. a -> (a -> b) -> b
& (Stack Mode -> Identity (Stack Mode))
-> GlobalState -> Identity GlobalState
Lens' GlobalState (Stack Mode)
stack  ((Stack Mode -> Identity (Stack Mode))
 -> GlobalState -> Identity GlobalState)
-> Stack Mode -> GlobalState -> GlobalState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Stack Mode
s'

popStateOrQuit :: GlobalState -> EventM n (Next GlobalState)
popStateOrQuit :: GlobalState -> EventM n (Next GlobalState)
popStateOrQuit GlobalState
gs = let gs' :: GlobalState
gs' = GlobalState -> GlobalState
popState GlobalState
gs in
  if Stack Mode -> Int
forall a. Stack a -> Int
Stack.size (GlobalState
gs' GlobalState
-> Getting (Stack Mode) GlobalState (Stack Mode) -> Stack Mode
forall s a. s -> Getting a s a -> a
^. Getting (Stack Mode) GlobalState (Stack Mode)
Lens' GlobalState (Stack Mode)
stack) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
   then GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
halt GlobalState
gs'
   else GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue GlobalState
gs'

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

goToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState)
goToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState)
goToModeOrQuit GlobalState
gs Mode
mode = 
  EventM n (Next GlobalState)
-> (State -> EventM n (Next GlobalState))
-> Maybe State
-> EventM n (Next GlobalState)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
halt GlobalState
gs) (GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (State -> GlobalState) -> State -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> State -> GlobalState
goToState GlobalState
gs) (Maybe State -> EventM n (Next GlobalState))
-> Maybe State -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ Mode -> Map Mode State -> Maybe State
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
mode (GlobalState
gs GlobalState
-> Getting (Map Mode State) GlobalState (Map Mode State)
-> Map Mode State
forall s a. s -> Getting a s a -> a
^. Getting (Map Mode State) GlobalState (Map Mode State)
Lens' GlobalState (Map Mode State)
states) 

moveToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState)
moveToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState)
moveToModeOrQuit = (State -> IO State)
-> GlobalState -> Mode -> EventM n (Next GlobalState)
forall n.
(State -> IO State)
-> GlobalState -> Mode -> EventM n (Next GlobalState)
moveToModeOrQuit' State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return

moveToModeOrQuit' :: (State -> IO State) -> GlobalState -> Mode -> EventM n (Next GlobalState)
moveToModeOrQuit' :: (State -> IO State)
-> GlobalState -> Mode -> EventM n (Next GlobalState)
moveToModeOrQuit' State -> IO State
f GlobalState
gs Mode
mode = 
  EventM n (Next GlobalState)
-> (State -> EventM n (Next GlobalState))
-> Maybe State
-> EventM n (Next GlobalState)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
halt GlobalState
gs) (\State
s -> GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (State -> GlobalState) -> State -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> State -> GlobalState
moveToState GlobalState
gs (State -> EventM n (Next GlobalState))
-> EventM n State -> EventM n (Next GlobalState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO State -> EventM n State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (State -> IO State
f State
s)) (Maybe State -> EventM n (Next GlobalState))
-> Maybe State -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ Mode -> Map Mode State -> Maybe State
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
mode (GlobalState
gs GlobalState
-> Getting (Map Mode State) GlobalState (Map Mode State)
-> Map Mode State
forall s a. s -> Getting a s a -> a
^. Getting (Map Mode State) GlobalState (Map Mode State)
Lens' GlobalState (Map Mode State)
states) 

removeToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState)
removeToModeOrQuit :: GlobalState -> Mode -> EventM n (Next GlobalState)
removeToModeOrQuit = (State -> IO State)
-> GlobalState -> Mode -> EventM n (Next GlobalState)
forall n.
(State -> IO State)
-> GlobalState -> Mode -> EventM n (Next GlobalState)
removeToModeOrQuit' State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return

removeToModeOrQuit' :: (State -> IO State) -> GlobalState -> Mode -> EventM n (Next GlobalState)
removeToModeOrQuit' :: (State -> IO State)
-> GlobalState -> Mode -> EventM n (Next GlobalState)
removeToModeOrQuit' State -> IO State
f GlobalState
gs Mode
mode = 
  EventM n (Next GlobalState)
-> (State -> EventM n (Next GlobalState))
-> Maybe State
-> EventM n (Next GlobalState)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
halt GlobalState
gs) (\State
s -> GlobalState -> EventM n (Next GlobalState)
forall s n. s -> EventM n (Next s)
continue (GlobalState -> EventM n (Next GlobalState))
-> (State -> GlobalState) -> State -> EventM n (Next GlobalState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> State -> GlobalState
removeToState GlobalState
gs (State -> EventM n (Next GlobalState))
-> EventM n State -> EventM n (Next GlobalState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO State -> EventM n State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (State -> IO State
f State
s)) (Maybe State -> EventM n (Next GlobalState))
-> Maybe State -> EventM n (Next GlobalState)
forall a b. (a -> b) -> a -> b
$ Mode -> Map Mode State -> Maybe State
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
mode (GlobalState
gs GlobalState
-> Getting (Map Mode State) GlobalState (Map Mode State)
-> Map Mode State
forall s a. s -> Getting a s a -> a
^. Getting (Map Mode State) GlobalState (Map Mode State)
Lens' GlobalState (Map Mode State)
states) 

refreshRecents :: CSS -> IO CSS
refreshRecents :: CSS -> IO CSS
refreshRecents CSS
s = do
  Stack FilePath
rs <- IO (Stack FilePath)
getRecents
  let prettyRecents :: [FilePath]
prettyRecents = [FilePath] -> [FilePath]
shortenFilepaths (Stack FilePath -> [FilePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
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"])
  CSS -> IO CSS
forall (m :: * -> *) a. Monad m => a -> m a
return (CSS -> IO CSS) -> CSS -> IO CSS
forall a b. (a -> b) -> a -> b
$ CSS
s CSS -> (CSS -> CSS) -> CSS
forall a b. a -> (a -> b) -> b
& (Stack FilePath -> Identity (Stack FilePath))
-> CSS -> Identity CSS
Lens' CSS (Stack FilePath)
recents ((Stack FilePath -> Identity (Stack FilePath))
 -> CSS -> Identity CSS)
-> Stack FilePath -> CSS -> CSS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Stack FilePath
rs
             CSS -> (CSS -> CSS) -> CSS
forall a b. a -> (a -> b) -> b
& (List Name FilePath -> Identity (List Name FilePath))
-> CSS -> Identity CSS
Lens' CSS (List Name FilePath)
list    ((List Name FilePath -> Identity (List Name FilePath))
 -> CSS -> Identity CSS)
-> List Name FilePath -> CSS -> CSS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Name -> Vector FilePath -> Int -> List Name FilePath
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list Name
Ordinary Vector FilePath
options Int
1

refreshRecents' :: GlobalState -> IO GlobalState
refreshRecents' :: GlobalState -> IO GlobalState
refreshRecents' GlobalState
gs = IO GlobalState
-> (CSS -> IO GlobalState) -> Maybe CSS -> IO GlobalState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GlobalState -> IO GlobalState
forall (m :: * -> *) a. Monad m => a -> m a
return GlobalState
gs) ((GlobalState -> CSS -> GlobalState
updateCSS GlobalState
gs (CSS -> GlobalState) -> IO CSS -> IO GlobalState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO CSS -> IO GlobalState)
-> (CSS -> IO CSS) -> CSS -> IO GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSS -> IO CSS
refreshRecents) ((\(CardSelectorState CSS
s) -> CSS
s) (State -> CSS) -> Maybe State -> Maybe CSS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mode -> Map Mode State -> Maybe State
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mode
CardSelector (GlobalState
gsGlobalState
-> Getting (Map Mode State) GlobalState (Map Mode State)
-> Map Mode State
forall s a. s -> Getting a s a -> a
^.Getting (Map Mode State) GlobalState (Map Mode State)
Lens' GlobalState (Map Mode State)
states))