module PhraseParser where

import Monad
import Data.Tree
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Token
import Text.ParserCombinators.Parsec.Language (emptyDef)

lexer = makeTokenParser emptyDef
(?) p = option (Node "" []) (try p)

rule r xs = (liftM (Node r) (sequence xs)) <?> r
term t ws = (liftM (Node t) leaf) <?> t
    where sym = choice . (map (try . (symbol lexer)))
          leaf = do w <- sym ws ; return [Node w []]

s   = rule "S" [np, vp, end]
vp  = rule "VP" [v, (?) np, (?) pp]
np  = rule "NP" [det, (?) adp, n, (?) pp]
pp  = rule "PP" [prep, np]
adp = rule "AP" [(?) adv, adj]

v    = term "V" [ "eats", "runs", "cooks", "gives", "carries" ]
n    = term "N" [ "dog", "cat", "dave", "mary", "present", "school",
                 "donuts", "busdriver", "bus", "thursday" ]
adj  = term "Adj" [ "big", "scary", "pretty" ]
adv  = term "Adv" [ "really", "very" ]
prep = term "Prep" [ "to", "for", "on" ]
det  = term "Det" [ "the", "a", "her", "your" ]
end  = term "end of sentence" ["."]