memo.txt

Haskellでは厳しそう...

対象の文字列全体の集合の部分集合、射はその間の関数
`string -> bool` と `forall (x y : string -> bool) (s : string), x s = true -> exists t : string, y t = true`

Templの定義面倒くさそう

templ.hs

-- http://d.hatena.ne.jp/m-hiyama/20070125/1169702291
import Data.Maybe
import Control.Applicative
import Control.Monad.State

q1 = go 0
  where
    go 0 [] = True
    go _ [] = False
    go i ('\\':'{':s) = go i s
    go i ('\\':'}':s) = go i s
    go i ('{':s) = go (i+1) s
    go i ('}':s)
      | i <= 0 = False
      | otherwise = go (i-1) s
    go i (_:s) = go i s

q2 s = if q1 s then Just (go s) else Nothing
  where
    go [] = []
    go ('\\':c:s) = c : go s
    go ('{':s) = go s
    go ('}':s) = go s
    go (c:s) = c : go s

defaultContext = [("お客様名","坂東トン吉"),("来店日","1月21日")]
q3test s = q3 s defaultContext
q3 s context = go $ '}' : s
  where
    go  [] = Nothing
    go  (_:s) = let (s1,s2) = break ('{'==) s in
      (++) <$> pure s1        <*> go' s2
    go' [] = Just ""
    go' (_:s) = let (s1,s2) = break ('}'==) s in
      (++) <$> lookup s1 context <*> go  s2

data Tree = Leaf Char | Node [Tree]
  deriving Show

char = get >>= go
  where
    go [] = empty
    go ('\\':c:s) = c <$ put s
    go ('{':s) = empty
    go ('}':s) = empty
    go (c:s) = c <$ put s
braces p = do
  '{':s <- get
  put s
  x <- p
  '}':s <- get
  put s
  return x
eof = get >>= (\s -> if null s then return () else empty)
parse' = do
  s <- Leaf <$> char <|> Node <$> braces parse'
  (s :) <$> parse' <|> pure [s]

parse :: String -> Maybe [Tree]
parse s = evalStateT (parse' <* eof) s

getLeaf (Leaf c) = return c
getLeaf _ = empty

terms ts = concat $ mapMaybe go' ts
  where
    go' (Leaf _) = empty
    go' (Node ts) = Just $ maybe (terms ts) (:[]) $ mapM getLeaf ts

q4 s = terms <$> parse s

q5' ts
  | isTerm ts = '{' : foldr (\t acc -> fromLeaf t : acc) "}" ts
  | otherwise = concatMap showOther ts
  where
    showOther (Leaf c) = [c]
    showOther (Node ts) = q5' ts
    isLeaf (Leaf _) = True
    isLeaf (Node _) = False
    isTerm ts = all isLeaf ts
    fromLeaf (Leaf c) = c
    fromLeaf _ = error "not a terminal"

q5 s = q5' <$> parse s

q6 = go 0 0
  where
    go 0 m [] = m
    go _ m [] = error "invalid"
    go i m ('\\':'{':s) = go i (max m i) s
    go i m ('\\':'}':s) = go i (max m i) s
    go i m ('{':s) = let i' = i + 1 in go i' (max m i') s
    go i m ('}':s)
      | i <= 0 = error "invalid"
      | otherwise = let i' = i - 1 in go i' (max m i') s
    go i m (_:s) = go i (max m i) s

processTemplate t con = go $ '}' : t
  where
    go  [] = Nothing
    go  (_:s) = let (s1,s2) = break ('{'==) s in
      (++) <$> pure s1 <*> go' s2
    go' [] = Just ""
    go' (_:s) = let (s1,s2) = break ('}'==) s in
      (++) <$> con  s1 <*> go  s2

ext con t = processTemplate t con