テンプレートモナドを書いてみた
こんな事を言ってましたが、週末でちょっと手が空いたのでやってみました。元ネタはココとかココとか。
「Haskellの」モナド機構を使わないバージョン（←紛らわしい…）
いきなりHaskellのモナドに翻訳しようとすると手こずったので、まずはm-hiyamaさんとこの書き方に割と忠実に、モナド機構を利用しないで書いてみました。
{- 型の定義 -} type Text = String data Template a = Templ { runTemplate :: a } {- テンプレート展開処理 -} processTemplate :: Template Text -> (Text -> Template Text) -> Template Text processTemplate (Templ t) con = Templ $ foldl1 (++) $ map (\p -> (fst p) ++ (runTemplate . con $ snd p)) $ splitNames t {- テンプレートのパージング -} splitNames :: Text -> [(Text,Text)] splitNames s = case elemIndex '{' s of Just n -> case elemIndex '}' s of Just m -> (take n s, take (m-n-1) $ drop (n+1) s) : (splitNames $ drop (m+1) s) Nothing -> [(take n s, drop n s)] Nothing -> [(s, "")] {- Template Text 型を文字列に見せるためのおまじない -} instance Show (Template Text) where show (Templ t) = show t
processTemplate は多分、オリジナルと同じもの。splitNames は processTemplate の中で使っていて、"あいうえお{かきくけこ}さしすせそ" を構文解析して [("あいうえお", "かきくけこ"), ("さしすせそ", "")] てな感じに構造化します。
あとこっそり（？）、(Template a)型の定義と一緒に定義した runTemplate :: (Template a) → a なる関数も使ってます。
これで動かしてみることは可能。以下はm-hiyamaさんとこにあったサンプルデータを翻訳したもの。
{- テスト用データ -} message :: Template Text message = Templ $ "{greeting} {body} -- {sign}" confun1, confun2 :: Text -> Template Text confun1 "greeting" = Templ "Hello, {person}." confun1 "body" = Templ "It's a {good-or-bad} News, ..." confun1 "sign" = Templ "Hanako" confun1 s = Templ s confun2 "person" = Templ "Tonkichi" confun2 "good-or-bad" = Templ "Good" confun2 s = Templ s
これで、
*Main> message
"{greeting} {body} -- {sign}"これが、
*Main> processTemplate (processTemplate message confun1) confun2 "Hello, Tonkichi. It's a Good News, ... -- Hanako"
こうなります。ついでに、
(>>>) :: Template Text -> (Text -> Template Text) -> Template Text t >>> con = processTemplate t con
processTemplate の言い換えでしかないのですが、こんなのを定義してやると
*Main> message >>> confun1 >>> confun2 "Hello, Tonkichi. It's a Good News, ... -- Hanako"
となりました。お〜モナドっぽい（笑）
モナド機構を使うバージョン
で、これをそのままHaskellのモナドに翻訳しようとしたら、どうもうまくいかなかったので*1、少しだけ方針を変更。Template型を
type Text = String data Template a = T Text | N a | C [Template a] deriving Show
こんな風に、元から構造化された形式で扱うようにしてみました。（Tの定義を修正しました。） T Text が展開されないテキスト部分、N a がテンプレートの名前（キー）に相当する箇所で、全体はこれらのリスト構造として、C [Template a] という型になるようにしました。んで、モナドの定義。
instance Monad Template where return a = N a (T t) >>= con = T t (N t) >>= con = con t (C ts) >>= con = C $ level $ map (\t -> t >>= con) ts
至ってシンプルです。これでいいのだろうか？
だめです。これだと、モナド法則のうち m >>= return == m (ext(unit)(t) = t) が成り立たないですね。うむむ。…後で考えることにして、とりあえず放置。
問題は、return にしても (>>= con)の部分にしても、適用するのは (N t) に対応する部分だけでよくて、(T t) の部分はスルーさせてもいいんだけど、現状そうなってないことのようです。でも、Haskellのモナド機構の場合、そういうスルーがうまくいかない（con :: a -> m b なので、con を通過させないと、型が m b となる値が得られず、型エラーを起こす）ような。回避方法はあるのかしらん。
そもそも、テキスト部分の型を (T a) とせず、固定の (T Text) とすれば問題ないことに気づきました。よって、Template型の定義と合わせて、モナドの定義も修正。これで問題ない…はず。
最後の行に出てくるlevelってのは、テンプレート展開したときに C [... , C [...] , ] とリストがネストしてしまうので、それを平坦化する関数です。実際はなくても動くのですが、テンプレートテキスト（「浅くネストしたテキスト」）と、多段にネストしたテキストの区別がつきにくくなるので、敢えて入れてみました。
{- C [Template a] のネストを回避 -} level [] = [] level tss@(t:ts) = case t of (C xs) -> xs ++ ts otherwise -> t:(level ts)
で、これだけだと不便なので、テンプレートテキストと、構造化したテンプレートとの間の橋渡しをする2つの関数 (parse, resolve) を入れてやります。
{- テキストからテンプレートへ -} parse :: Text -> Template Text parse s = case length ss of 0 -> T "" 1 -> head ss otherwise -> (C ss) where ss = parseToList s parseToList s = case elemIndex '{' s of Just n -> case elemIndex '}' s of Just m -> [T (take n s), N (take (m-n-1) $ drop (n+1) s)] ++ (parseToList $ drop (m+1) s) Nothing -> [T (take n s), N (drop n s)] Nothing -> [T s] {- テンプレートからテキストへ -} resolve :: Template Text -> Text resolve (T s) = s resolve (N n) = "{" ++ n ++ "}" resolve (C ss) = foldl1 (++) (map resolve ss)
なんかこの2つ、随伴くさいので、やっぱりモナドの中に入れてやれないのだろうかとか思ってしまうのですが、まいいや。今度考えます。
あと、サンプルデータを書き直し。上で作った parse 関数のおかげで、元とあんまり定義する手間は変わってません。
{- サンプルデータ -} message :: Template Text message = parse "{greeting} {body} -- {sign}" confun1, confun2 :: Text -> Template Text confun1 "greeting" = parse "Hello, {person}." confun1 "body" = parse "It's a {good-or-bad} News, ..." confun1 "sign" = parse "Hanako" confun1 s = parse s confun2 "person" = T "Tonkichi" confun2 "good-or-bad" = T "Good" confun2 s = parse s
これで動かしてみます。
*Main> resolve message
"{greeting} {body} -- {sign}"
*Main> resolve $ message >>= confun1
"Hello, {person}. It's a {good-or-bad} News, ... -- Hanako"
*Main> resolve $ message >>= confun1 >>= confun2
"Hello, Tonkichi. It's a Good News, ... -- Hanako"
*Main> resolve $ return "greeting" >>= confun1
"Hello, {person}."なんか動いてるっぽいです。おお〜（笑）
実は、上でも書いたけど、message >>= return でうまくうごかないです。（"{}{greeting}{ }{body}{ -- }{sign}{}" となる。）return の定義を考え直さないと。大丈夫になりました。
do記法というやつを使って、
foo :: Text foo = resolve $ do t1 <- message t2 <- confun1 t1 confun2 t2
こんな関数を書いても、動きます。
*Main> foo "Hello, Tonkichi. It's a Good News, ... -- Hanako"
おまけ
下記サイトに、Haskell標準のReaderモナドを使った、少し違うテンプレート処理の実装が例で書いてます。型の作り方とか、ここを参考にしました。
※ 続きを書きました→ http://d.hatena.ne.jp/bonotake/20070218/1171785790
