quickCheck 入門 - 英文生成(2)

Maybe 型を使ってみた途中版。無駄なスペースが生成されるバグあり。あまり整頓された感じはしない。

module EnglishRule2 where
import Test.QuickCheck
import Control.Monad
import Data.List
import Control.Applicative 

data Sym = Sym String deriving (Eq)
instance Show Sym where
    show (Sym x) = x

data Rule = Rule [Maybe [Sym]] | Alt [String] deriving (Eq)

instance Show Rule where
    show (Rule rs) = show $ map (\r -> case r of
                                          Just x -> intercalate " + " (map show x)
                                          Nothing -> "()") rs
    show (Alt ws) = "(" ++ intercalate "," ws ++ ")"

type Grammar = [(Sym, Rule)]

generate :: Grammar -> Sym -> Gen String
generate g x = case lookup x g of
                 Just r -> rule2gen g r
                 Nothing -> error ("Unknown symbol: " ++ show x)

rule2gen g (Alt ws) = elements ws
rule2gen g (Rule rs) = oneof $ map (rule2gen' g) rs

rule2gen' g (Just (r:rs)) = do
  a <- generate g r
  rest <- rule2gen' g (Just rs)
  return (a ++ " " ++ rest)
rule2gen' g (Just []) = return ""
rule2gen' g Nothing = return ""

simpleGrammar =
    [ (Sym "noun", Alt ["man", "ball", "woman", "table"]),
      (Sym "verb", Alt ["hit", "took", "saw", "liked"]),
      (Sym "article", Alt ["the", "a"]),
      (Sym "noun-phrase", Rule [Just [Sym "article", Sym "noun"]]),
      (Sym "verb-phrase", Rule [Just [Sym "verb", Sym "noun-phrase"]]),
      (Sym "sentence", Rule [Just [Sym "noun-phrase", Sym "verb-phrase"]])
    ] :: Grammar

bigGrammar =
    [ (Sym "sentence", Rule [ Just [Sym "noun-phrase", Sym "verb-phrase"]]),
      (Sym "noun-phrase", Rule [ Just [Sym "article", Sym "adj*", Sym "noun", Sym "pp*"],
                                 Just [Sym "name"],
                                 Just [Sym "pronoun"]]),
      (Sym "verb-phrase", Rule [ Just [Sym "verb", Sym "noun-phrase", Sym "pp*"]]),
      (Sym "pp*", Rule [ Nothing , Just [Sym "pp", Sym "pp*"]]),
      (Sym "adj*", Rule [ Nothing, Just [Sym "adj", Sym "adj*"]]),
      (Sym "pp", Rule [ Just [Sym "prep", Sym "noun-phrase"]]),
      (Sym "prep", Alt ["to", "in", "by", "with", "on"]),
      (Sym "adj", Alt ["big", "little", "blue", "green", "adiabatic"]),
      (Sym "article", Alt ["the", "a"]),
      (Sym "name", Alt ["Pat", "Kim", "Lee", "Terry", "Robin"]),
      (Sym "noun", Alt ["man", "ball", "woman", "table"]),
      (Sym "verb", Alt ["hit", "took", "saw", "liked"]),
      (Sym "pronoun", Alt ["he", "she", "it", "these", "those", "that"])
    ] :: Grammar