module Chiasma.Interpreter.TmuxApi where

import Fcf (Eval, Exp, Pure1, type (@@))
import Fcf.Class.Functor (FMap)
import Prelude hiding (send, type (@@))

import Chiasma.Data.CodecError (CodecError)
import Chiasma.Data.TmuxRequest (TmuxRequest)
import Chiasma.Data.TmuxResponse (TmuxResponse)
import Chiasma.Effect.Codec (Codec, encode, withCodec)
import Chiasma.Effect.TmuxApi (TmuxApi (Schedule, Send), send)
import qualified Chiasma.Effect.TmuxClient as TmuxClient
import Chiasma.Effect.TmuxClient (TmuxClient)

type family (f :: l -> k) <$> (fa :: [l]) :: [k] where
  f <$> fa =
    FMap (Pure1 f) @@ fa

flush ::
  Member (TmuxApi c) r =>
  InterpreterFor (TmuxApi c) r
flush :: forall (c :: * -> *) (r :: EffectRow).
Member (TmuxApi c) r =>
InterpreterFor (TmuxApi c) r
flush =
  (forall (rInitial :: EffectRow) x.
 TmuxApi c (Sem rInitial) x -> Sem r x)
-> Sem (TmuxApi c : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Send c x
cmd ->
      c x -> Sem r x
forall (command :: * -> *) (r :: EffectRow) a.
Member (TmuxApi command) r =>
command a -> Sem r a
send c x
cmd
    Schedule c a1
cmd ->
      Sem r a1 -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (c a1 -> Sem r a1
forall (command :: * -> *) (r :: EffectRow) a.
Member (TmuxApi command) r =>
command a -> Sem r a
send c a1
cmd)

interpretTmuxApi ::
  ∀ command i o err r .
  Members [TmuxClient i o, Codec command i o !! err] r =>
  InterpreterFor (TmuxApi command !! err) r
interpretTmuxApi :: forall (command :: * -> *) i o err (r :: EffectRow).
Members '[TmuxClient i o, Codec command i o !! err] r =>
InterpreterFor (TmuxApi command !! err) r
interpretTmuxApi =
  (forall x (r0 :: EffectRow).
 TmuxApi command (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err (TmuxApi command)) r
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Send command x
cmd -> do
      forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop @_ @(Codec _ _ _) (Sem (Codec command i o : Stop err : r) x -> Sem (Stop err : r) x)
-> Sem (Codec command i o : Stop err : r) x -> Sem (Stop err : r) x
forall a b. (a -> b) -> a -> b
$ command x
-> (i -> Sem (Codec command i o : Stop err : r) o)
-> Sem (Codec command i o : Stop err : r) x
forall (command :: * -> *) i o (r :: EffectRow) a.
Member (Codec command i o) r =>
command a -> (i -> Sem r o) -> Sem r a
withCodec command x
cmd \ i
encoded -> do
        i -> Sem (Codec command i o : Stop err : r) o
forall i o (r :: EffectRow).
Member (TmuxClient i o) r =>
i -> Sem r o
TmuxClient.send i
encoded
    Schedule command a1
cmd -> do
      i
encoded <- Sem (Codec command i o : Stop err : r) i -> Sem (Stop err : r) i
InterpreterFor (Codec command i o) (Stop err : r)
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop (command a1 -> Sem (Codec command i o : Stop err : r) i
forall (command :: * -> *) i o (r :: EffectRow) a.
Member (Codec command i o) r =>
command a -> Sem r i
encode command a1
cmd)
      i -> Sem (Stop err : r) ()
forall i o (r :: EffectRow).
Member (TmuxClient i o) r =>
i -> Sem r ()
TmuxClient.schedule i
encoded

data TmuxApiEffect :: Type -> (Type -> Type) -> Exp Effect

type instance Eval (TmuxApiEffect err command) =
  TmuxApi command !! err

type family TmuxApis (commands :: [Type -> Type]) (err :: Type) :: EffectRow where
  TmuxApis commands err =
    FMap (TmuxApiEffect err) @@ commands

class InterpretApis (commands :: [Type -> Type]) err i o r where
  interpretApis :: InterpretersFor (TmuxApis commands err) (TmuxClient i o : r)

instance InterpretApis '[] err i o r where
  interpretApis :: InterpretersFor (TmuxApis '[] err) (TmuxClient i o : r)
interpretApis =
    Sem (TmuxClient i o : r) a -> Sem (TmuxClient i o : r) a
Sem (Append (TmuxApis '[] err) (TmuxClient i o : r)) a
-> Sem (TmuxClient i o : r) a
forall a. a -> a
id

instance (
    r1 ~ (TmuxApis commands err ++ TmuxClient i o : r),
    Member (TmuxClient i o) r1,
    Member (Codec command i o !! err) r1,
    InterpretApis commands err i o r
  ) => InterpretApis (command : commands) err i o r where
    interpretApis :: InterpretersFor
  (TmuxApis (command : commands) err) (TmuxClient i o : r)
interpretApis =
      forall (commands :: [* -> *]) err i o (r :: EffectRow).
InterpretApis commands err i o r =>
InterpretersFor (TmuxApis commands err) (TmuxClient i o : r)
interpretApis @commands @err (Sem r1 a -> Sem (TmuxClient i o : r) a)
-> (Sem ((TmuxApi command !! err) : r1) a -> Sem r1 a)
-> Sem ((TmuxApi command !! err) : r1) a
-> Sem (TmuxClient i o : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem ((TmuxApi command !! err) : r1) a -> Sem r1 a
InterpreterFor (TmuxApi command !! err) r1
forall (command :: * -> *) i o err (r :: EffectRow).
Members '[TmuxClient i o, Codec command i o !! err] r =>
InterpreterFor (TmuxApi command !! err) r
interpretTmuxApi

type InterpretApisNative commands r =
  InterpretApis commands CodecError TmuxRequest TmuxResponse r

class RestopApis (commands :: [Type -> Type]) err i o r where
  restopApis :: InterpretersFor (TmuxApi <$> commands) (TmuxClient i o : r)

instance RestopApis '[] err i o r where
  restopApis :: InterpretersFor (TmuxApi <$> '[]) (TmuxClient i o : r)
restopApis =
    Sem (TmuxClient i o : r) a -> Sem (TmuxClient i o : r) a
Sem (Append (TmuxApi <$> '[]) (TmuxClient i o : r)) a
-> Sem (TmuxClient i o : r) a
forall a. a -> a
id

instance (
    r1 ~ (TmuxApi <$> commands ++ TmuxClient i o : r),
    Members [TmuxClient i o, Stop err] r1,
    Member (Codec command i o !! err) r1,
    RestopApis commands err i o r
  ) => RestopApis (command : commands) err i o r where
    restopApis :: InterpretersFor
  (TmuxApi <$> (command : commands)) (TmuxClient i o : r)
restopApis =
      forall (commands :: [* -> *]) err i o (r :: EffectRow).
RestopApis commands err i o r =>
InterpretersFor (TmuxApi <$> commands) (TmuxClient i o : r)
forall {k} (commands :: [* -> *]) (err :: k) i o (r :: EffectRow).
RestopApis commands err i o r =>
InterpretersFor (TmuxApi <$> commands) (TmuxClient i o : r)
restopApis @commands @err @i @o (Sem r1 a -> Sem (TmuxClient i o : r) a)
-> (Sem (TmuxApi command : r1) a -> Sem r1 a)
-> Sem (TmuxApi command : r1) a
-> Sem (TmuxClient i o : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall (command :: * -> *) i o err (r :: EffectRow).
Members '[TmuxClient i o, Codec command i o !! err] r =>
InterpreterFor (TmuxApi command !! err) r
interpretTmuxApi @command @i @o (Sem (Resumable err (TmuxApi command) : r1) a -> Sem r1 a)
-> (Sem (TmuxApi command : r1) a
    -> Sem (Resumable err (TmuxApi command) : r1) a)
-> Sem (TmuxApi command : r1) a
-> Sem r1 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop @err @(TmuxApi command) (Sem (TmuxApi command : Resumable err (TmuxApi command) : r1) a
 -> Sem (Resumable err (TmuxApi command) : r1) a)
-> (Sem (TmuxApi command : r1) a
    -> Sem (TmuxApi command : Resumable err (TmuxApi command) : r1) a)
-> Sem (TmuxApi command : r1) a
-> Sem (Resumable err (TmuxApi command) : r1) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Sem (TmuxApi command : r1) a
-> Sem (TmuxApi command : Resumable err (TmuxApi command) : r1) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder

type RestopApisNative commands r =
  RestopApis commands CodecError TmuxRequest TmuxResponse r