module ACE.Parsers where
import ACE.Combinators
import ACE.Types.Syntax
import ACE.Types.Tokens
import Control.Applicative
import Control.Monad hiding (ap)
import Data.Text (Text)
import Text.Parsec ()
import Text.Parsec.Prim (Stream,ParsecT,try,getState)
data ACEParser s m = ACE
{ aceIntransitiveAdjective :: ParsecT s (ACEParser s m) m Text
, aceTransitiveAdjective :: ParsecT s (ACEParser s m) m Text
, aceNoun :: ParsecT s (ACEParser s m) m Text
, acePreposition :: ParsecT s (ACEParser s m) m Text
, aceVariable :: ParsecT s (ACEParser s m) m Text
, aceProperName :: ParsecT s (ACEParser s m) m Text
, aceAdverb :: ParsecT s (ACEParser s m) m Text
, aceIntransitiveVerb :: ParsecT s (ACEParser s m) m Text
, acePhrasalTransitiveV :: ParsecT s (ACEParser s m) m Text
, acePhrasalDistransitiveV :: ParsecT s (ACEParser s m) m Text
, aceTransitiveVerb :: ParsecT s (ACEParser s m) m Text
, aceDistransitiveVerb :: ParsecT s (ACEParser s m) m Text
, acePhrasalParticle :: ParsecT s (ACEParser s m) m Text
, acePhrasalIntransitiveV :: ParsecT s (ACEParser s m) m Text
}
defaultACEParser :: Stream s m Token => ACEParser s m
defaultACEParser =
ACE { aceIntransitiveAdjective = string "<intrans-adj>"
, aceTransitiveAdjective = string "<trans-adj>"
, aceNoun = string "<noun>"
, acePreposition = string "<prep>"
, aceVariable = string "<var>"
, aceProperName = string "<proper-name>"
, aceAdverb = string "<adverb>"
, aceIntransitiveVerb = string "<intrans-verb>"
, aceDistransitiveVerb = string "<distrans-verb>"
, acePhrasalParticle = string "<pparticle>"
, acePhrasalIntransitiveV = string "<pintrans-verb>"
, acePhrasalDistransitiveV = string "<pdistrans-verb>"
, aceTransitiveVerb = string "<trans-verb>"
, acePhrasalTransitiveV = string "<ptrans-verb>"
}
specification =
Specification
<$> sentenceCoord <* period
<*> optional (try specification)
sentenceCoord =
SentenceCoord
<$> sentenceCoord_1
<*> optional (try (string "or" *> sentenceCoord))
sentenceCoord_1 =
SentenceCoord_1
<$> sentenceCoord_2
<*> optional (try (comma *> string "and" *> sentenceCoord_1))
sentenceCoord_2 =
SentenceCoord_2
<$> sentenceCoord_3
<*> optional (try (string "or" *> sentenceCoord_2))
sentenceCoord_3 =
SentenceCoord_3
<$> topicalizedSentence
<*> optional (try (string "and" *> sentenceCoord_3))
topicalizedSentence =
(TopicalizedSentenceExistential <$> existentialTopic <*> optional (try sentenceCoord)) <|>
(TopicalizedSentenceUniversal <$> universalTopic <*> sentenceCoord) <|>
(TopicalizedSentenceComposite <$> compositeSentence)
universalTopic =
UniversalTopic <$> universalGlobalQuantor
<*> n' False
compositeSentence =
compositeSentenceCond <|>
compositeSentenceNeg <|>
compositeSentence'
where compositeSentenceCond =
CompositeSentenceCond <$> conditionalSentence
compositeSentenceNeg =
CompositeSentenceNeg <$> negatedSentence
compositeSentence' =
CompositeSentence <$> sentence
negatedSentence =
NegatedSentence
<$> (strings ["it","is","not","the","case","that"] *>
sentenceCoord)
conditionalSentence =
ConditionalSentence
<$> (string "if" *> sentenceCoord)
<*> (string "then" *> sentenceCoord)
sentence =
Sentence
<$> npCoord
<*> vpCoord
existentialTopic =
ExistentialTopic
<$> existentialGlobalQuantor
<*> npCoord
specifier =
specifierDeterminer <|>
specifierPossessive <|>
specifierNumber
where specifierDeterminer =
SpecifyDeterminer <$> determiner
specifierPossessive =
SpecifyPossessive <$> possessiveNPCoord
specifierNumber =
SpecifyNumberP <$> numberP
preposition =
Preposition <$> join (fmap acePreposition getState)
genitiveTail =
(GenitiveTailSaxonTail <$> saxonGenitiveTail) <|>
(GenitiveTailCoordtail <$> genitiveCoordTail)
genitiveCoordTail =
GenitiveCoordTail <$> (try (string "and" *> genitiveNPCoord))
saxonGenitiveTail =
SaxonGenitiveTail
<$> saxonGenitiveMarker
<*> optional
(try ((,) <$> genitiveN'
<*> saxonGenitiveTail))
apposition =
(AppositionVar <$> variable) <|>
(AppositionQuote <$> quotation)
apposCoord =
ApposCoord
<$> apposition
<*> optional (try (string "and" *> apposCoord))
pp =
PP <$> preposition
<*> npCoord'
relativeClauseCoord =
RelativeClauseCoord
<$> relativeClause
<*> optional (try ((,) <$> coord
<*> relativeClauseCoord))
n' b =
N' <$> optional (try adjectiveCoord)
<*> n
<*> optional (try apposCoord)
<*> optional (try ofPP)
<*> if b
then pure Nothing
else optional (try relativeClauseCoord)
unmarkedNPCoord b =
UnmarkedNPCoord
<$> np b
<*> optional (try (string "and" *> unmarkedNPCoord b))
np b =
(NP <$> specifier <*> n' b) <|>
(NPPro <$> pronoun) <|>
(NPProper <$> properName) <|>
(NPVar <$> variable)
npCoord = npCoordX False
npCoord' = npCoordX True
relativeClause =
try (RelativeClauseThat <$> (string "that" *> vpCoord)) <|>
try (RelativeClauseNP <$> npCoord' <*> vpCoord) <|>
(RelativeClauseThatNPVP <$> (string "that" *> npCoord') <*> vpCoord) <|>
try (RelativeClauseNPVP <$> npCoord' <*> npCoord' <*> vpCoord) <|>
(RelativeClausePP <$> pp <*> npCoord' <*> vpCoord)
ofPP =
string "of" *> npCoord
npCoordX b =
distributed <|> unmarked
where distributed =
NPCoordDistributed <$> distributiveMarker <*> unmarkedNPCoord b
unmarked =
NPCoordUnmarked <$> unmarkedNPCoord b
variable =
Variable <$> join (fmap aceVariable getState)
properName =
ProperName <$> join (fmap aceProperName getState)
quotation =
Quotation <$> quoted
n =
N <$> join (fmap aceNoun getState)
vpCoord =
do vp' <- vp
(try (VPCoord'
<$> pure vp'
<*> coord
<*> vpCoord) <|>
(VPCoordVP
<$> pure vp'))
vp =
try (VP <$> v') <|>
(VPNeg <$> (copula <* string "not") <*> v')
genitiveN' =
GenitiveN'
<$> optional (try adjectiveCoord)
<*> n
<*> optional (try apposCoord)
vModifier =
vModifierVC <|> try vModifierPP <|> vModifierAVPP
where vModifierVC =
VModifierVC <$> adverbCoord
vModifierPP =
VModifierPP <$> pp
vModifierAVPP =
VModifierAVPP <$> adverbialPP
adverbialPP =
AdverbialPP
<$> preposition
<*> adverbCoord
v' =
V' <$> optional (try adverbCoord)
<*> complV
<*> many (try vModifier)
genitiveSpecifier =
(GenitiveSpecifierD <$> determiner) <|>
(GenitiveSpecifierPPC <$> possessivePronounCoord) <|>
(GenitiveSpecifierN <$> number)
possessiveNPCoord =
try (PossessiveNPCoordGen <$> genitiveNPCoord) <|>
(PossessiveNPCoordPronoun <$> possessivePronounCoord)
saxonGenitiveMarker =
fmap (\s -> if s then ApostropheS else Apostrophe)
genitive
possessivePronounCoord =
PossessivePronounCoord
<$> possessivePronoun
<*> optional (try (string "and" *> possessivePronounCoord))
genitiveNPCoord =
specifier' <|> name
where specifier' =
GenitiveNPCoord
<$> genitiveSpecifier
<*> genitiveN'
<*> genitiveTail
name =
GenitiveNPCoordName
<$> properName
<*> genitiveTail
complV =
complVIV <|>
complVPI <|>
complVTV <|>
complVPV <|>
complVPV' <|>
complVDisV <|>
complVPDV <|>
complVCopula
complVCopula =
ComplVCopula <$> copula <*> copulaCompl
complVPDV =
ComplVPDV <$> phrasalDistransitiveV <*> compl <*> phrasalParticle <*> compl
complVDisV =
ComplVDisV <$> distransitiveV <*> compl <*> compl
complVPV =
ComplVPV <$> phrasalTransitiveV <*> phrasalParticle <*> compl
complVPV' =
ComplVPV' <$> phrasalTransitiveV <*> compl <*> phrasalParticle
complVTV =
ComplVTV <$> transitiveV <*> compl
phrasalDistransitiveV =
PhrasalDistransitiveV <$> join (fmap acePhrasalDistransitiveV getState)
phrasalTransitiveV =
PhrasalTransitiveV <$> join (fmap acePhrasalTransitiveV getState)
compl =
try (ComplNP <$> npCoord) <|>
(ComplPP <$> pp)
complVIV =
ComplVIV <$> intransitiveV
complVPI =
ComplVPI <$> phrasalIntransitiveV <*> phrasalParticle
phrasalIntransitiveV =
PhrasalIntransitiveV <$> join (fmap acePhrasalIntransitiveV getState)
phrasalParticle =
PhrasalParticle <$> join (fmap acePhrasalParticle getState)
copulaCompl =
copulaComplAPC <|>
copulaComplNPC <|>
copulaComplPP
where copulaComplAPC = CopulaComplAPC <$> apCoord
copulaComplNPC = CopulaComplNPC <$> npCoord
copulaComplPP = CopulaComplPP <$> pp
apCoord = apCoordAnd <|> apCoord'
where apCoordAnd = APCoordAnd <$> try (apGrad <* string "and") <*> apCoord
apCoord' = APCoord <$> apGrad
apGrad = apGradThan <|> apGrad'
where apGradThan = APgradAPThan <$> try (ap <* string "than") <*> npCoord
apGrad' = APgradAP <$> ap
ap =
(APTrans <$> transitiveAdjective <*> pp) <|>
(APIntrans <$> intransitiveAdjective)
intransitiveV =
IntransitiveV <$> join (fmap aceIntransitiveVerb getState)
transitiveV =
TransitiveV <$> join (fmap aceTransitiveVerb getState)
distransitiveV =
DistransitiveV <$> join (fmap aceDistransitiveVerb getState)
adverbCoord =
AdverbCoord <$> adverb
<*> optional (try (string "and" *> adverbCoord))
adverb =
Adverb <$> join (fmap aceAdverb getState)
adjectiveCoord =
AdjectiveCoord
<$> intransitiveAdjective
<*> optional (try (string "and" *> adjectiveCoord))
intransitiveAdjective =
IntransitiveAdjective <$> join (fmap aceIntransitiveAdjective getState)
transitiveAdjective =
TransitiveAdjective <$> join (fmap aceTransitiveAdjective getState)
determiner =
(string "the" *> pure The) <|>
(string "an" *> pure An) <|>
(string "a" *> pure A) <|>
(string "some" *> pure Some) <|>
(strings ["not","every"] *> pure NotEvery) <|>
(strings ["not","each"] *> pure NotEach) <|>
(strings ["not","all"] *> pure NotAll) <|>
(string "no" *> pure No) <|>
(string "every" *> pure EveryEach) <|>
(string "each" *> pure EveryEach) <|>
(string "all" *> pure All) <|>
(string "which" *> pure Which)
numberP =
NumberP
<$> optional (try generalizedQuantor)
<*> number
existentialGlobalQuantor =
string "there" *>
(ExistentialGlobalQuantor <$> copula)
existentialGlobalQuestionQuantor =
(ExistentialGlobalQuestionQuantor <$> copula) <*
string "there"
aux =
(string "do" *> pure Do) <|>
(string "does" *> pure Does)
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)
coord =
(string "and" *> pure And) <|>
(string "or" *> pure Or)
copula =
(string "is" *> pure Is) <|>
(string "are" *> pure Are)
distributiveGlobalQuantor =
strings ["for","each","of"] *> pure ForEachOf
distributiveMarker =
strings ["each","of"] *> pure EachOf
generalizedQuantor =
(strings ["at","most"] *> pure AtMost) <|>
(strings ["at","least"] *> pure AtLeast) <|>
(strings ["more","than"] *> pure MoreThan) <|>
(strings ["less","than"] *> pure LessThan) <|>
(strings ["not","more","than"] *> pure NotMoreThan) <|>
(strings ["not","less","than"] *> pure NotLessThan)
possessivePronoun =
his <|> her <|> hisHer <|> its
where his = string "his" *> pure His
her = string "her" *> pure Her
hisHer =
(string "his" <|> string "her" <|> string "his/her") *>
pure HisHer
its = string "its" *> pure Its
universalGlobalQuantor =
string "for" *> (everyEach <|> forAll)
where everyEach = ((string "every" *> pure ForEvery) <|>
(string "each" *> pure ForEach))
forAll = string "all" *> pure ForAll