TmuxApi.hs

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 (..))
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

interpretTmuxApi ::
  ∀ command i o err r .
  Members [TmuxClient i o, Codec command i o !! err] r =>
  InterpreterFor (TmuxApi command !! err) r
interpretTmuxApi =
  interpretResumable \case
    Send cmd -> do
      restop @_ @(Codec _ _ _) $ withCodec cmd \ encoded -> do
        TmuxClient.send encoded
    Schedule cmd -> do
      encoded <- restop (encode cmd)
      TmuxClient.schedule encoded
    ReceiveNotification ->
      TmuxClient.receiveNotification

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 =
    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 =
      interpretApis @commands @err . 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 =
    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 =
      restopApis @commands @err @i @o .
      interpretTmuxApi @command @i @o .
      restop @err @(TmuxApi command) .
      raiseUnder

type RestopApisNative commands r =
  RestopApis commands CodecError TmuxRequest TmuxResponse r