diff --git a/ace.cabal b/ace.cabal --- a/ace.cabal +++ b/ace.cabal @@ -1,5 +1,5 @@ name: ace -version: 0.5 +version: 0.6 synopsis: Attempto Controlled English parser and printer description: Attempto Controlled English is a formally defined unambiguous language which is a subset of the English language. This package provides a tokenizer, @@ -30,7 +30,7 @@ ACE.Types.Pretty ACE.Pretty ACE.Html - build-depends: attoparsec >= 0.11.1.0, + build-depends: attoparsec >= 0.10.4.0, parsec >= 3.1.5, data-default >= 0.5.3, text >= 0.11.2.0, diff --git a/src/ACE/Html.hs b/src/ACE/Html.hs --- a/src/ACE/Html.hs +++ b/src/ACE/Html.hs @@ -104,9 +104,13 @@ mtoMarkup " " mrel) instance ToMarkup NP where - toMarkup (NP s n') = + toMarkup x = wrap "np" - (toMarkup s <> " " <> toMarkup n') + (case x of + NP s n' -> toMarkup s <> " " <> toMarkup n' + NPPro p -> toMarkup p + NPProper pn -> toMarkup pn + NPVar v -> toMarkup v) instance ToMarkup N where toMarkup (N t) = @@ -439,29 +443,42 @@ TheirOwn -> "their own" Whose -> "whose") + + instance ToMarkup Pronoun where toMarkup p = wrap "pronoun" (case p of - It -> "it" - HeShe -> "he/she" - Himher -> "him/her" - They -> "they" - Them -> "them" - Itself -> "itself" - HimHerSelf -> "himself/herself" - Themselves -> "themselves" - SomeoneSomebody -> "someone/somebody" - Something -> "something" - NoOneNobody -> "no-one/nobody" - NoThing -> "nothing" - EveryoneEverybody -> "everyone/everybody" - Everything -> "everything" - NotEveryoneEverybody -> "not everyone/not everybody" - NotEverything -> "not everything" - WhatWho -> "what/who" - Whom -> "whom" - WhichWho -> "which/who") + It -> "it" + He -> "he" + She -> "she" + HeShe -> "he/she" + Him -> "him" + HerP -> "her" + HimHer -> "him/her" + They -> "they" + Them -> "them" + Itself -> "itself" + Himself -> "himself" + Herself -> "herself" + HimselfHerself -> "himself/herself" + Themselves -> "themselves" + Someone -> "someone" + Somebody -> "somebody" + Something -> "something" + NoOne -> "no one" + Nobody -> "nobody" + NoThing -> "nothing" + Everyone -> "everyone" + Everybody -> "everybody" + Everything -> "everything" + NotEveryone -> "not everyone" + NotEverybody -> "not everybody" + NotEverything -> "not everything" + What -> "what" + Who -> "who" + Whom -> "whom" + WhichP -> "which") instance ToMarkup SaxonGenitiveMarker where toMarkup a = diff --git a/src/ACE/Parsers.hs b/src/ACE/Parsers.hs --- a/src/ACE/Parsers.hs +++ b/src/ACE/Parsers.hs @@ -210,8 +210,10 @@ -- | A noun phrase: a thing, some stuff, the thing. np b = - NP <$> specifier - <*> n' b + (NP <$> specifier <*> n' b) <|> + (NPPro <$> pronoun) <|> + (NPProper <$> properName) <|> + (NPVar <$> variable) -- | A coordinated noun phrase. See 'npCoordX'. npCoord = npCoordX False @@ -516,6 +518,39 @@ aux = (string "do" *> pure Do) <|> (string "does" *> pure Does) + +-- | Pronouns. +pronoun = + (string "it" *> pure It) <|> + (string "he" *> pure He) <|> + (string "she" *> pure She) <|> + (string "he/she" *> pure HeShe) <|> + (string "him" *> pure Him) <|> + (string "her" *> pure HerP) <|> + (string "him/her" *> pure HimHer) <|> + (string "they" *> pure They) <|> + (string "them" *> pure Them) <|> + (string "itself" *> pure Itself) <|> + (string "himself" *> pure Himself) <|> + (string "herself" *> pure Herself) <|> + (string "himself/herself" *> pure HimselfHerself) <|> + (string "themselves" *> pure Themselves) <|> + (string "someone" *> pure Someone) <|> + (string "somebody" *> pure Somebody) <|> + (string "something" *> pure Something) <|> + (string "no one" *> pure NoOne) <|> + (string "nobody" *> pure Nobody) <|> + (string "nothing" *> pure NoThing) <|> + (string "everyone" *> pure Everyone) <|> + (string "everybody" *> pure Everybody) <|> + (string "everything" *> pure Everything) <|> + (string "not everyone" *> pure NotEveryone) <|> + (string "not everybody" *> pure NotEverybody) <|> + (string "not everything" *> pure NotEverything) <|> + (string "what" *> pure What) <|> + (string "who" *> pure Who) <|> + (string "whom" *> pure Whom) <|> + (string "which" *> pure WhichP) -- | And/or. coord = diff --git a/src/ACE/Pretty.hs b/src/ACE/Pretty.hs --- a/src/ACE/Pretty.hs +++ b/src/ACE/Pretty.hs @@ -93,7 +93,12 @@ mpretty " " mrel instance Pretty NP where - pretty (NP s n') = pretty s <> " " <> pretty n' + pretty x = + case x of + NP s n' -> pretty s <> " " <> pretty n' + NPPro p -> pretty p + NPProper pn -> pretty pn + NPVar v -> pretty v instance Pretty N where pretty (N t) = fromText t @@ -371,25 +376,36 @@ instance Pretty Pronoun where pretty p = case p of - It -> "it" - HeShe -> "he/she" - Himher -> "him/her" - They -> "they" - Them -> "them" - Itself -> "itself" - HimHerSelf -> "himself/herself" - Themselves -> "themselves" - SomeoneSomebody -> "someone/somebody" - Something -> "something" - NoOneNobody -> "no-one/nobody" - NoThing -> "nothing" - EveryoneEverybody -> "everyone/everybody" - Everything -> "everything" - NotEveryoneEverybody -> "not everyone/not everybody" - NotEverything -> "not everything" - WhatWho -> "what/who" - Whom -> "whom" - WhichWho -> "which/who" + It -> "it" + He -> "he" + She -> "she" + HeShe -> "he/she" + Him -> "him" + HerP -> "her" + HimHer -> "him/her" + They -> "they" + Them -> "them" + Itself -> "itself" + Himself -> "himself" + Herself -> "herself" + HimselfHerself -> "himself/herself" + Themselves -> "themselves" + Someone -> "someone" + Somebody -> "somebody" + Something -> "something" + NoOne -> "no one" + Nobody -> "nobody" + NoThing -> "nothing" + Everyone -> "everyone" + Everybody -> "everybody" + Everything -> "everything" + NotEveryone -> "not everyone" + NotEverybody -> "not everybody" + NotEverything -> "not everything" + What -> "what" + Who -> "who" + Whom -> "whom" + WhichP -> "which" instance Pretty SaxonGenitiveMarker where pretty a = diff --git a/src/ACE/Types/Syntax.hs b/src/ACE/Types/Syntax.hs --- a/src/ACE/Types/Syntax.hs +++ b/src/ACE/Types/Syntax.hs @@ -115,8 +115,11 @@ deriving (Show,Eq) -- | Noun-phrase. -data NP = - NP !Specifier !N' +data NP + = NP !Specifier !N' + | NPPro !Pronoun + | NPProper !ProperName + | NPVar !Variable deriving (Show,Eq) -- | A noun. @@ -392,25 +395,36 @@ deriving (Show,Eq) data Pronoun - = It -- ^ \"it\" - | HeShe -- ^ \"he\" / \"she\" - | Himher -- ^ \"him\" / \"her\" - | They -- ^ \"they\" - | Them -- ^ \"them\" - | Itself -- ^ \"itself\" - | HimHerSelf -- ^ \"himself\" / \"herself\" - | Themselves -- ^ \"themselves\" - | SomeoneSomebody -- ^ \"someone\" / \"somebody\" - | Something -- ^ \"something\" - | NoOneNobody -- ^ \"no one\" / \"nobody\" - | NoThing -- ^ \"nothing\" - | EveryoneEverybody -- ^ \"everyone\" / \"everybody\" - | Everything -- ^ \"everything\" - | NotEveryoneEverybody -- ^ \"not everyone\" / \"not everybody\" - | NotEverything -- ^ \"not everything\" - | WhatWho -- ^ \"what\" / \"who\" - | Whom -- ^ \"whom\" - | WhichWho -- ^ \"which\" / \"who\" + = It + | He + | She + | HeShe + | Him + | HerP + | HimHer + | They + | Them + | Itself + | Himself + | Herself + | HimselfHerself + | Themselves + | Someone + | Somebody + | Something + | NoOne + | Nobody + | NoThing + | Everyone + | Everybody + | Everything + | NotEveryone + | NotEverybody + | NotEverything + | What + | Who + | Whom + | WhichP deriving (Show,Eq) -- | The Saxon genitive used for possession. diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -13,17 +13,17 @@ import ACE.Tokenizer (tokenize) import ACE.Types.Syntax import ACE.Types.Tokens -import Data.Text.Lazy.Builder (fromText,toLazyText) -import Data.Text.Lazy (toStrict) import Control.Applicative import Control.Monad hiding (ap) import Control.Monad.Identity hiding (ap) import Data.Bifunctor import Data.Text (Text) +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (fromText,toLazyText) import Test.HUnit import Test.Hspec -import Text.Parsec (Stream,ParsecT,runP,try,Parsec,ParseError) +import Text.Parsec (Stream,ParsecT,runParser,try,Parsec,ParseError) import Text.Parsec.Prim -- | Test suite entry point, returns exit failure if any test fails. @@ -216,6 +216,18 @@ (parsed pp " a " == Right (PP (Preposition "") (NPCoordUnmarked (UnmarkedNPCoord anoun Nothing)))) + it "np" + (parsed (np False) "itself" == + Right (NPPro Itself)) + it "np" + (parsed (np False) "1 " == + Right (NP (SpecifyNumberP (NumberP Nothing 1)) (N' Nothing (N "") Nothing Nothing Nothing))) + it "np" + (parsed (np False) "" == + Right (NPProper (ProperName ""))) + it "np" + (parsed (np False) "" == + Right (NPVar (Variable ""))) it "n'" (parsed (n' False) "" == Right (N' Nothing (N "") Nothing Nothing Nothing) ) it "n'" @@ -684,7 +696,7 @@ -- | Get the parsed result after tokenizing. parsed :: Parsec [Token] (ACEParser [Token] Identity) c -> Text -> Either String c -parsed p = tokenize >=> bimap show id . runP (p <* eof) defaultACEParser "" +parsed p = tokenize >=> bimap show id . runParser (p <* eof) defaultACEParser "" printed p = fmap pretty . parsed p