続・圏論やモナドが、どうして文書処理やXMLと関係するのですか？」を読んでるところ

http://d.hatena.ne.jp/m-hiyama/20070125/1169702291
http://d.hatena.ne.jp/nskj77/20070318/1174204588のつづき
プログラミング課題8を解いた。モナド出来たよ!

*Main> processTemplate (Ts [T "hoge", Ph "fuga", T "piyo"]) $ con(C [("fuga", Ts [T "xxx"])])
Ts [T "hoge",T "xxx",T "piyo"]
*Main> let x = processTemplate (Ts [T "hoge", Ph "fuga", T "piyo"]) unit
*Main> x >>= con(C[("fuga", Ts [T "xxx"])])
Ts [T "hoge",T "xxx",T "piyo"]
*Main> x >>= con(C[("fuga", Ts [Ph "yyy"])])
Ts [T "hoge",Ph "yyy",T "piyo"]

{-
    ProcessTemplate2.hs
    http://d.hatena.ne.jp/m-hiyama/20070125
    nisikawa
    2007.03.21
-}
import Maybe (fromMaybe)

data Templ a    = T a | Ph a deriving Show
data Context a  = C [(a, Template a)] deriving Show
data Template a = Ts [Templ a] deriving Show

con :: (Eq a) => Context a -> a -> Template a
con (C ctx) x = fromMaybe (f x) (lookup x ctx)
  where f = Ts . flip (:) [] . T 

unit :: a -> Template a
unit = Ts . flip (:) [] . Ph
        
ext :: (a -> Template b) -> Template a -> Template b
ext f = flip processTemplate f
  
processTemplate :: Template a -> (a -> Template b) -> Template b
processTemplate (Ts x) f = Ts $ func x f
  where func [] _ = []                
        func (T x:xs) f = let (Ts ys) = f x in ys ++ func xs f
        func (Ph x:xs) f = let (Ts ys) = f x in ys ++ func xs f

instance Monad Template where 
  return  = unit
  m >>= f = ext f m