module Chiasma.Monad.EvalFreeT where

import Control.Monad.Trans.Free (FreeF(..), FreeT(..))

import Chiasma.Codec.Decode (TmuxDecodeError)
import Chiasma.Data.Cmd (Cmd(..), Cmds(..))
import Chiasma.Data.TmuxError (TmuxError)
import Chiasma.Data.TmuxThunk (TmuxThunk(..))

newtype CmdBuffer = CmdBuffer [Cmd]

instance Default CmdBuffer where
  def :: CmdBuffer
def = [Cmd] -> CmdBuffer
CmdBuffer [Cmd]
forall a. Default a => a
def

type CommandExec m =
  (∀ b. (Text -> Either TmuxDecodeError b) -> Cmds -> m (Either TmuxError [b]))

evalFreeF ::
  Monad m =>
  CommandExec m ->
  CmdBuffer ->
  FreeF TmuxThunk a (FreeT TmuxThunk m a) ->
  m (Either TmuxError a)
evalFreeF :: CommandExec m
-> CmdBuffer
-> FreeF TmuxThunk a (FreeT TmuxThunk m a)
-> m (Either TmuxError a)
evalFreeF CommandExec m
_ (CmdBuffer []) (Pure a
a) =
  Either TmuxError a -> m (Either TmuxError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either TmuxError a
forall a b. b -> Either a b
Right a
a)
evalFreeF CommandExec m
exec (CmdBuffer [Cmd]
cmds) (Pure a
a) =
  a -> Either TmuxError a
forall a b. b -> Either a b
Right a
a Either TmuxError a
-> m (Either TmuxError [()]) -> m (Either TmuxError a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Either TmuxDecodeError ())
-> Cmds -> m (Either TmuxError [()])
CommandExec m
exec (Either TmuxDecodeError () -> Text -> Either TmuxDecodeError ()
forall a b. a -> b -> a
const (Either TmuxDecodeError () -> Text -> Either TmuxDecodeError ())
-> Either TmuxDecodeError () -> Text -> Either TmuxDecodeError ()
forall a b. (a -> b) -> a -> b
$ () -> Either TmuxDecodeError ()
forall a b. b -> Either a b
Right ()) ([Cmd] -> Cmds
Cmds [Cmd]
cmds)
evalFreeF CommandExec m
exec (CmdBuffer [Cmd]
cmds) (Free (Read Cmd
cmd Text -> Either TmuxDecodeError a
decode [a] -> FreeT TmuxThunk m a
next)) = do
  Either TmuxError [a]
a <- (Text -> Either TmuxDecodeError a)
-> Cmds -> m (Either TmuxError [a])
CommandExec m
exec Text -> Either TmuxDecodeError a
decode (Cmds -> m (Either TmuxError [a]))
-> Cmds -> m (Either TmuxError [a])
forall a b. (a -> b) -> a -> b
$ [Cmd] -> Cmds
Cmds (Cmd
cmd Cmd -> [Cmd] -> [Cmd]
forall a. a -> [a] -> [a]
: [Cmd]
cmds)
  case Either TmuxError [a]
a of
    Right [a]
a' -> CommandExec m
-> CmdBuffer -> FreeT TmuxThunk m a -> m (Either TmuxError a)
forall (m :: * -> *) a.
Monad m =>
CommandExec m
-> CmdBuffer -> FreeT TmuxThunk m a -> m (Either TmuxError a)
evalFreeT CommandExec m
exec CmdBuffer
forall a. Default a => a
def ([a] -> FreeT TmuxThunk m a
next [a]
a')
    Left TmuxError
err -> Either TmuxError a -> m (Either TmuxError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TmuxError -> Either TmuxError a
forall a b. a -> Either a b
Left TmuxError
err)
evalFreeF CommandExec m
exec (CmdBuffer [Cmd]
cmds) (Free (Write Cmd
cmd () -> FreeT TmuxThunk m a
next)) =
  CommandExec m
-> CmdBuffer -> FreeT TmuxThunk m a -> m (Either TmuxError a)
forall (m :: * -> *) a.
Monad m =>
CommandExec m
-> CmdBuffer -> FreeT TmuxThunk m a -> m (Either TmuxError a)
evalFreeT CommandExec m
exec ([Cmd] -> CmdBuffer
CmdBuffer (Cmd
cmd Cmd -> [Cmd] -> [Cmd]
forall a. a -> [a] -> [a]
: [Cmd]
cmds)) (() -> FreeT TmuxThunk m a
next ())
evalFreeF CommandExec m
exec (CmdBuffer [Cmd]
cmds) (Free (Flush () -> FreeT TmuxThunk m a
next)) =
  (Text -> Either TmuxDecodeError ())
-> Cmds -> m (Either TmuxError [()])
CommandExec m
exec (Either TmuxDecodeError () -> Text -> Either TmuxDecodeError ()
forall a b. a -> b -> a
const (Either TmuxDecodeError () -> Text -> Either TmuxDecodeError ())
-> Either TmuxDecodeError () -> Text -> Either TmuxDecodeError ()
forall a b. (a -> b) -> a -> b
$ () -> Either TmuxDecodeError ()
forall a b. b -> Either a b
Right ()) ([Cmd] -> Cmds
Cmds [Cmd]
cmds) m (Either TmuxError [()])
-> (Either TmuxError [()] -> m (Either TmuxError a))
-> m (Either TmuxError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right [()]
_ -> CommandExec m
-> CmdBuffer -> FreeT TmuxThunk m a -> m (Either TmuxError a)
forall (m :: * -> *) a.
Monad m =>
CommandExec m
-> CmdBuffer -> FreeT TmuxThunk m a -> m (Either TmuxError a)
evalFreeT CommandExec m
exec CmdBuffer
forall a. Default a => a
def (() -> FreeT TmuxThunk m a
next ())
    Left TmuxError
err -> Either TmuxError a -> m (Either TmuxError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TmuxError -> Either TmuxError a
forall a b. a -> Either a b
Left TmuxError
err)
evalFreeF CommandExec m
_ CmdBuffer
_ (Free (Failed TmuxError
err)) =
  Either TmuxError a -> m (Either TmuxError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TmuxError -> Either TmuxError a
forall a b. a -> Either a b
Left TmuxError
err)

evalFreeT ::
  Monad m =>
  CommandExec m ->
  CmdBuffer ->
  FreeT TmuxThunk m a ->
  m (Either TmuxError a)
evalFreeT :: CommandExec m
-> CmdBuffer -> FreeT TmuxThunk m a -> m (Either TmuxError a)
evalFreeT CommandExec m
exec CmdBuffer
s (FreeT m (FreeF TmuxThunk a (FreeT TmuxThunk m a))
ma) = do
  FreeF TmuxThunk a (FreeT TmuxThunk m a)
inner <- m (FreeF TmuxThunk a (FreeT TmuxThunk m a))
ma
  CommandExec m
-> CmdBuffer
-> FreeF TmuxThunk a (FreeT TmuxThunk m a)
-> m (Either TmuxError a)
forall (m :: * -> *) a.
Monad m =>
CommandExec m
-> CmdBuffer
-> FreeF TmuxThunk a (FreeT TmuxThunk m a)
-> m (Either TmuxError a)
evalFreeF CommandExec m
exec CmdBuffer
s FreeF TmuxThunk a (FreeT TmuxThunk m a)
inner