Klasy penetracji stosu Monad z darmowymi / operacyjnymi transformatorami Monad?

Próbowałem nieco innego podejścia, które daje przynajmniej częściową odpowiedź. Ponieważ układanie monad może być czasami problematyczne, a wiemy, że wszystkie nasze monady są zbudowane z jakiegoś typu danych, próbowałem zamiast tego połączyć typy danych.

Czuję się bardziej komfortowo z MonadFree więc go użyłem, ale przypuszczam, że podobne podejście można również zastosować do Operational.

Zacznijmy od definicji naszych typów danych:

{-# LANGUAGE DeriveFunctor, FlexibleContexts,
             FlexibleInstances, FunctionalDependencies #-}
import Control.Monad
import Control.Monad.Free

data SLang x = ReadStr (String -> x) | WriteStr String x
  deriving Functor
data ILang x = ReadInt (Int -> x) | WriteInt Int x
  deriving Functor

Aby połączyć dwa funktory razem dla używając ich w wolnej monadzie, zdefiniujmy ich koprodukt:

data EitherF f g a = LeftF (f a) | RightF (g a)
  deriving Functor

Jeśli stworzymy darmową monadę nad EitherF f g, możemy wywołać polecenia z obu z nich. Aby uczynić ten proces transparentnym, możemy użyć MPTC , aby umożliwić konwersję z każdego functora na docelowy:

class Lift f g where
    lift :: f a -> g a
instance Lift f f where
    lift = id

instance Lift f (EitherF f g) where
    lift = LeftF
instance Lift g (EitherF f g) where
    lift = RightF

Teraz możemy po prostu wywołać lift i przekonwertować obie części do koproduktu.

Z funkcją pomocniczą

wrapLift :: (Functor g, Lift g f, MonadFree f m) => g a -> m a
wrapLift = wrap . lift . fmap return

Możemy wreszcie stworzyć ogólne funkcje, które pozwalają do wywołania komend z każdego, co możemy podnieść do functora:

readStr :: (Lift SLang f, MonadFree f m) => m String
readStr = wrapLift $ ReadStr id

writeStr :: (Lift SLang f, MonadFree f m) => String -> m ()
writeStr x = wrapLift $ WriteStr x ()

readInt :: (Lift ILang f, MonadFree f m) => m Int
readInt = wrapLift $ ReadInt id

writeInt :: (Lift ILang f, MonadFree f m) => Int -> m ()
writeInt x = wrapLift $ WriteInt x ()

Wtedy program może być wyrażony jako

myProgram :: (Lift ILang f, Lift SLang f, MonadFree f m) => m ()
myProgram = do
  str <- readStr
  writeStr "Length of that str is"
  writeInt $ length str
  n <- readInt
  writeStr "you wanna have it n times; here we go:"
  writeStr $ replicate n 'H'

Bez definiowania dalszych instancji.

Podczas gdy wszystkie powyższe działa ładnie, problem polega na tym, jak ogólnie uruchomić tak skomponowane darmowe monady. Nie wiem, czy jest w ogóle możliwe, aby mieć w pełni generyczne, kompozytowe rozwiązanie.

Jeśli mamy tylko jeden funktor bazowy, możemy go uruchomić jako

runSLang :: Free SLang x -> String -> (String, x)
runSLang = f
  where
    f (Pure x)              s  = (s, x)
    f (Free (ReadStr g))    s  = f (g s) s
    f (Free (WriteStr s' x)) _ = f x s'

Jeśli mamy dwa, musimy wątek stanu obu z nich:

runBoth :: Free (EitherF SLang ILang) a -> String -> Int -> ((String, Int), a)
runBoth = f
  where
    f (Pure x)                       s i  = ((s, i), x)
    f (Free (LeftF  (ReadStr g)))     s i = f (g s) s i
    f (Free (LeftF  (WriteStr s' x))) _ i = f x s' i
    f (Free (RightF (ReadInt g)))     s i = f (g i) s i
    f (Free (RightF (WriteInt i' x))) s _ = f x s i'

Domyślam się, że jedną z możliwości byłoby wyrażenie uruchamiania funktorów za pomocą iter :: Functor f => (f a -> a) -> Free f a -> a z free, a następnie utworzenie podobnej, łączącej funkcji

iter2 :: (Functor f, Functor g)
      => (f a -> a) -> (g a -> a) -> Free (EitherF f g) a -> a

Ale nie miałem czasu, aby go wypróbować.