テンプレートモナド 追補

こないだ載せたテンプレートモナドの記事ですが、

型がイイカゲンな言語のほうが楽ちんに実装できますけど、本来のモナド概念は強い（ものすごく強い）型を背景とした定式化になっています。

こういうところ、あんまり厳密に書いてませんでした。
※ 個人的には、例えば {"greeting", "body", "sign"} をTextのサブセットとして定義したかったのですが。あんまり（自分の直観に従いつつ、面倒くさくない）いい方法が見つからず、ちょっと不満だったり。
一応、そこいらへんを強化して、型を厳しくした修正例を書いておきます。尚、モナドの定義はそのままで対応できます。

data DataA = Greeting | Body | Sign deriving Show
data DataB = Person | GoodOrBad deriving Show

DataAとかDataBとかは、文字列のサブセットだと脳内変換して読んでくれるとうれしいですｗ

{- テストデータ -}
message :: Template DataA
message = C [N Greeting, T " ", N Body, T " -- ", N Sign]

confun1 :: DataA -> Template DataB
confun2 :: DataB -> Template ()

confun1 Greeting =  C [T "Hello, ", N Person, T "."]
confun1 Body = C [T "It's a ", N GoodOrBad, T " News, ..."]
confun1 Sign = T "Hanako"

confun2 Person = T "Tonkichi"
confun2 GoodOrBad = T "Good"

表示用に、resolveを修正。

{- テンプレートからテキストへ -}
resolve :: Show a => Template a -> Text
resolve (T s) = s
resolve (N n) = "{" ++ (show n) ++ "}"
resolve (C ss) = foldl1 (++) (map resolve ss)

実行例。うまくいく例と、型エラーを吐く例。

*Main> resolve $ message >>= confun1
"Hello, {Person}. It's a {GoodOrBad} News, ... -- Hanako"
*Main> resolve $ message >>= confun2

<interactive>:1:22:
    Couldn't match `DataB' against `DataA'
      Expected type: DataA -> Template b
      Inferred type: DataB -> Template ()
    In the second argument of `(>>=)', namely `confun2'
    In the second argument of `($)', namely `message >>= confun2'