自由モナドの定義であるところの Control.Monad.Free.Church.foldF

圏論勉強会の資料 によれば、 と自由な構成 について、 を与えると が得られるとある。

自由モナドの文脈でこれを考えると、関手 からモナド (の構造を忘れて関手と思ったもの)への自然変換を定義すれば、自由モナド からモナド への自然変換(正確にはモナドモーフィズム)が得られるという意味となる。

free パッケージにこの対応関係に相当するものは入ってないのかなと探してみたら、 Control.Monad.Free.Church というモジュールで定義されていた。

foldF :: Monad m => (forall x. f x -> m x) -> F f a -> m a

The very definition of a free monad is that given a natural transformation you get a monad homomorphism.

https://www.stackage.org/haddock/lts-8.19/free-4.12.4/Control-Monad-Free-Church.html

あまり深く追ってないけど、このモジュールで定義されているのは内部表現が違う(チャーチエンコーディングされた)自由モナドらしい。後、モナド変換子版 FreeT ではだめでモナド Free じゃないと定義できないということもありそう。

これを使うと、 Functor を Monad としてどう解釈するかを定義するだけで、自由モナドから任意のモナドへの変換が得られる。

{-# LANGUAGE TypeApplications #-}
module Main (main) where
import qualified Control.Monad.Free.Church as F

data HelloProgram a = HPGetLine (String -> a) | HPPrint !String a

instance Functor HelloProgram where
  fmap f (HPGetLine g) = HPGetLine (f . g)
  fmap f (HPPrint s x) = HPPrint s (f x)

helloApp :: F.F HelloProgram ()
helloApp = do
  line <- hellGetLine
  hellPrint line
  where
    liftF' = F.liftF @HelloProgram @(F.F HelloProgram)
    hellGetLine = liftF' $ HPGetLine id
    hellPrint s = liftF' $ HPPrint s ()

toIO :: HelloProgram a -> IO a
toIO (HPGetLine f) = f <$> getLine
toIO (HPPrint ss x) = putStrLn ss >> return x

main :: IO ()
main = F.foldF toIO helloApp

よくある自由モナドの使い方では、変換規則は自由モナド F.F HelloProgram に対して直接用意するが、このコード例では関手 HelloProgram の自然変換のみを変換規則として定義している。この方法では自由モナドの構造が使えないので、関手側に Done のようなデータを用意してそこで処理を打ち切る、といったような解釈の仕方を定義することはできない。そのようなことが必要であれば、 MaybeT IO モナドなど、それ相応の機能を持つモナドへ変換する必要がある。