Как я могу объединить интерпретаторы эффектов при использовании такой библиотеки, как freer-simple?

Документация для Eff указывает, что

Обычно конкретный список эффектов не используется для параметризации Eff. Вместо этого ограничения Member или Members используются для выражения ограничений списка эффектов без привязки вычислений к конкретному списку эффектов.

Следовательно, для максимальной гибкости мы могли бы изменить подписи fileSystemDocInterpreter и errorDocInterpreter на:

fileSystemDocInterpreter :: Member (Writer [String]) effs => FileSystem ~> Eff effs

errorDocInterpreter :: Member (Writer [String]) effs => AppError ~> Eff effs

Нам все равно, где находится Writer [String] в списке на уровне типов и есть ли в списке еще какие-либо эффекты. Нам просто нужно, чтобы Writer [String] был там. Это изменение касается (1).

Что касается (2), мы могли бы определить executeDocumented следующим образом:

executeDocumented :: forall a. Eff '[FileSystem, AppError, Writer [String]] a 
                  -> (a, [String])
executeDocumented app = run $ runWriter
                            $ interpret errorDocInterpreter
                            $ interpret fileSystemDocInterpreter
                            $ app

Здесь мы используем в интерпретаторе гибкость, которую мы получили при определении вычислений. Мы помещаем Writer [String] в конец списка, и два interprets отправляют FileSystem и AppErrors эффекты автору. Нет необходимости иметь отдельные Writer [String] слоев! (Тем не менее, если в другом случае у нас есть два эффекта одного типа в начале списка, мы можем использовать subsume, чтобы удалить дублирование.)

Я пытался восстановить исходный код, чтобы посмотреть, как он работает.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Data.Monoid
import Data.Functor
import Data.List
import Data.String
import Control.Natural (type (~>))
import Control.Monad.Freer.Writer (Writer, tell,runWriter)
import Control.Monad.Freer
  (
    Eff
  , LastMember
  , Member
  , interpret
  , interpretM
  , send
  , run
  , runM
  )

data FileSystem r where
  ReadFile :: FilePath  -> FileSystem String
  WriteFile :: FilePath -> String -> FileSystem ()

readFile :: Member FileSystem effs => FilePath -> Eff effs String
readFile = send . ReadFile

writeFile :: Member FileSystem effs => FilePath -> String -> Eff effs ()
writeFile pth = send . WriteFile pth

data AppError r where
  Ensure :: Bool -> String -> AppError ()
  Fail :: String -> AppError ()

ensure :: Member AppError effs => Bool -> String -> Eff effs ()
ensure condition message = send $ Ensure condition message

fail :: Member AppError effs =>  String -> Eff effs ()
fail = send . Fail

data ApState = ApState {filePath::String,fileText::String} deriving Show

data TestItem = Item {
  pre :: String,
  post :: String,
  pathTI :: FilePath
}

data RunConfig = RunConfig {
  environment :: String,
  depth :: Integer,
  pathRC :: FilePath
}

type FileSys r = (Member FileSystem r)
type AppFailure r = (Member AppError r)

interactor :: TestItem -> RunConfig -> (AppFailure r, FileSys r) => Eff r ApState
interactor item runConfig = do
                              let fullFilePath = pathRC (runConfig :: RunConfig)
                              Main.writeFile fullFilePath $ pre item  <> post item
                              Main.fail "random error ~ its a glitch"
                              txt <- Main.readFile "C:\\Vids\\SystemDesign\\Wrong.txt"
                              pure $ ApState fullFilePath txt

fileSystemDocInterpreter :: Member (Writer [String]) effs => FileSystem ~> Eff effs
fileSystemDocInterpreter =
     let
        mockContents::String = "Mock File Contents"
      in
        \case
          ReadFile path -> tell ["readFile: " <> show path] $> mockContents
          WriteFile path str -> tell ["write file: " <>
                                        show path <>
                                        "\nContents:\n" <>
                                        str]

errorDocInterpreter :: Member (Writer [String]) effs => AppError ~> Eff effs
errorDocInterpreter = \case
       Ensure condition errMsg -> tell [if condition then "Ensure Check Passed" else ("Ensure Check Failed ~ " <>  errMsg) ]
       Fail errMsg -> tell ["Failure ~ " <>  errMsg]

executeDocumented :: forall a. Eff '[FileSystem, AppError, Writer [String]] a
                  -> (a, [String])
executeDocumented app = run $ runWriter
                            $ interpret errorDocInterpreter
                            $ interpret fileSystemDocInterpreter
                            $ app

main :: IO ()
main = do
   let ti = Item {pre="", post ="", pathTI =""}
   let rc = RunConfig {environment ="", depth =1, pathRC ="C:\\Vids\\SystemDesign\\VidList.txt"}
   let (apst,messages) = executeDocumented $ interactor ti rc
   putStrLn $ show apst
   mapM_ (\x->putStrLn x) messages
   putStrLn "_"