As you linked above, there is an MonadReader
instance for Free
:
instance (Functor m, MonadReader e m) => MonadReader e (Free m) where
what this says is that given that m
is a Functor
and that there is a MonadReader e
instance for m
, we can also make use of the MonadReader
instance inside of Free
. But this requires that there already is a MonadReader
instance for m
which in your case is your DSL Functor. This is normally not what you want because this drastically limits the available choices for your DSL functor, given that it is no longer enough to be a functor and it also has to be a monad.
I would therefore suggest instead of using Free (ReaderT r DSL) a
you could just layer it the other way around, i.e. ReaderT r (Free DSL) a
, which has the benefit that DSL
only has to be a functor. To make this more concrete, and given that you did not state how your DSL looks like, let's use the Teletype
DSL example:
data TeletypeF a = GetChar (Char -> a) | PutChar Char a deriving Functor
type Teletype a = Free TeletypeF a
getChar :: Teletype Char
getChar = liftF (GetChar id)
putChar :: Char -> Teletype ()
putChar c = liftF (PutChar c ())
putStrLn :: String -> Teletype ()
putStrLn str = traverse putChar str >> putChar '\n'
runTeletype :: Teletype a -> IO a
runTeletype = foldFree go
where go (GetChar k) = k <$> IO.getChar
go (PutChar c k) = IO.putChar c >> return k
putStrLn
is a program derived from the DSL primitive PutChar
. We can interpret programs by using the IO
monad. Now we want to use the ReaderT
monad transformer to be able to defer the choice of end-of-line separator in putStrLn
. So we proceed as follows:
type TeletypeReader a = ReaderT Char (Free TeletypeF) a
getChar' :: TeletypeReader Char
getChar' = lift getChar
putChar' :: Char -> TeletypeReader ()
putChar' c = lift (putChar c)
putStrLn' :: String -> TeletypeReader ()
putStrLn' str = do
traverse_ putChar' str
sep <- ask
putChar' sep
runTeletypeReader :: Char -> TeletypeReader a -> IO a
runTeletypeReader sep = runTeletype . flip runReaderT sep
And now we can do:
λ> runTeletypeReader '\n' (putStrLn' "Hello" >> putStrLn' "World")
Hello
World
λ> runTeletypeReader ':' (putStrLn' "Hello" >> putStrLn' "World")
Hello:World: