{-# LANGUAGE FunctionalDependencies #-}

module Drasil.NaturalLanguage.English.NounPhrase (
  -- * Types
  NounPhrase(..),
  -- * Phrase Accessors
  atStartNP, atStartNP', titleizeNP, titleizeNP',
  -- * Constructors
  -- ** Common Noun Constructors
  cn, cn', cn'', cn''', cnICES, cnIES, cnIP, cnIS, cnIrr, cnUM,
  -- ** Proper Noun Constructors
  pn, pn', pn'', pn''', pnIrr,
  -- ** Noun Phrase Constructors
  nounPhrase, nounPhrase', nounPhrase'', nounPhraseSP, nounPhraseSent,
  -- * Combinators
  compoundPhrase,
  compoundPhrase', compoundPhrase'', compoundPhrase''', compoundPhraseP1,
  surroundNPStruct,
  -- * Re-exported Types
  CapitalizationRuleG(..), PluralRule(..), NPG, NPStructG, PluralFormG,
  -- * Re-exported Smart Constructors
  npS, npP, (.-.), (.+.)
  ) where

import Data.Char (isLatin1, isLetter, toLower, toUpper)

import Drasil.NaturalLanguage.English.NounPhrase.Core -- uses whole module

--Linguistically, nounphrase might not be the best name (yet!), but once
-- it is fleshed out and/or we do more with it, it will likely be a good fit

class NounPhrase n a | n -> a where
  -- | Retrieves singular form of term. Ex. "the quick brown fox".
  phraseNP :: n -> NPStructG a
  -- | Retrieves plural form of term. Ex. "the quick brown foxes".
  pluralNP :: n -> PluralFormG a
    --Could replace plural string with a function.
  -- | Retrieves the singular form and applies a captalization
  -- rule (usually capitalizes the first word) to produce a 'NPStructG'.
  -- Ex. "The quick brown fox".
  sentenceCase :: n -> (n -> NPStructG a) -> Capitalization a
    --Should this be replaced with a data type instead?
    --Data types should use functions to determine capitalization based
    -- on rules.
  -- | Retrieves the singular form and applies a captalization
  -- rule (usually capitalizes all words) to produce a 'NPStructG'.
  -- Ex. "The Quick Brown Fox".
  titleCase :: n -> (n -> NPStructG a) -> Capitalization a

-- | Type synonym for 'NPStructG', parameterized over the symbol type @a@.
type Capitalization a = NPStructG a
-- | Type synonym for 'String'.
type PluralString   = String

-- | Defines NP as a NounPhrase.
-- Default capitalization rules for proper and common nouns
-- are 'CapFirst' for sentence case and 'CapWords' for title case.
-- Also accepts a 'Phrase' where the capitalization case may be specified.
instance NounPhrase (NPG a) a where
  phraseNP :: NPG a -> PluralFormG a
phraseNP (ProperNoun String
n PluralRule
_)           = String -> PluralFormG a
forall a. String -> NPStructG a
SC String
n
  phraseNP (CommonNoun String
n PluralRule
_ CapitalizationRuleG a
_)         = String -> PluralFormG a
forall a. String -> NPStructG a
SC String
n
  phraseNP (Phrase PluralFormG a
n PluralFormG a
_ CapitalizationRuleG a
_ CapitalizationRuleG a
_)           = PluralFormG a
n
  pluralNP :: NPG a -> PluralFormG a
pluralNP n :: NPG a
n@(ProperNoun String
_ PluralRule
p)         = PluralFormG a -> PluralRule -> PluralFormG a
forall a. NPStructG a -> PluralRule -> NPStructG a
sPlur (NPG a -> PluralFormG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
n) PluralRule
p
  pluralNP n :: NPG a
n@(CommonNoun String
_ PluralRule
p CapitalizationRuleG a
_)       = PluralFormG a -> PluralRule -> PluralFormG a
forall a. NPStructG a -> PluralRule -> NPStructG a
sPlur (NPG a -> PluralFormG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
n) PluralRule
p
  pluralNP (Phrase PluralFormG a
_ PluralFormG a
p CapitalizationRuleG a
_ CapitalizationRuleG a
_)           = PluralFormG a
p
  sentenceCase :: NPG a -> (NPG a -> PluralFormG a) -> PluralFormG a
sentenceCase   (ProperNoun String
n PluralRule
_)   NPG a -> PluralFormG a
_ = String -> PluralFormG a
forall a. String -> NPStructG a
SC String
n
  sentenceCase n :: NPG a
n@(CommonNoun String
_ PluralRule
_ CapitalizationRuleG a
r) NPG a -> PluralFormG a
f = PluralFormG a -> CapitalizationRuleG a -> PluralFormG a
forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap (NPG a -> PluralFormG a
f NPG a
n) CapitalizationRuleG a
r
  sentenceCase n :: NPG a
n@(Phrase PluralFormG a
_ PluralFormG a
_ CapitalizationRuleG a
r CapitalizationRuleG a
_)   NPG a -> PluralFormG a
f = PluralFormG a -> CapitalizationRuleG a -> PluralFormG a
forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap (NPG a -> PluralFormG a
f NPG a
n) CapitalizationRuleG a
r
  titleCase :: NPG a -> (NPG a -> PluralFormG a) -> PluralFormG a
titleCase n :: NPG a
n@ProperNoun {}         NPG a -> PluralFormG a
_ = NPG a -> PluralFormG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
n
  titleCase n :: NPG a
n@CommonNoun {}         NPG a -> PluralFormG a
f = PluralFormG a -> CapitalizationRuleG a -> PluralFormG a
forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap (NPG a -> PluralFormG a
f NPG a
n) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords
  titleCase n :: NPG a
n@(Phrase PluralFormG a
_ PluralFormG a
_ CapitalizationRuleG a
_ CapitalizationRuleG a
r)      NPG a -> PluralFormG a
f = PluralFormG a -> CapitalizationRuleG a -> PluralFormG a
forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap (NPG a -> PluralFormG a
f NPG a
n) CapitalizationRuleG a
r

-- ===Constructors=== --
-- | Constructs a Proper Noun, it is always capitalized as written.
pn, pn', pn'', pn''' :: String -> NPG a
-- | Self plural.
pn :: forall a. String -> NPG a
pn    String
n = String -> PluralRule -> NPG a
forall a. String -> PluralRule -> NPG a
ProperNoun String
n PluralRule
SelfPlur
-- | Plural form simply adds "s" (ex. Henderson -> Hendersons).
pn' :: forall a. String -> NPG a
pn'   String
n = String -> PluralRule -> NPG a
forall a. String -> PluralRule -> NPG a
ProperNoun String
n PluralRule
AddS
-- | Plural form adds "e".
pn'' :: forall a. String -> NPG a
pn''  String
n = String -> PluralRule -> NPG a
forall a. String -> PluralRule -> NPG a
ProperNoun String
n PluralRule
AddE
-- | Plural form adds "es" (ex. Bush -> Bushes).
pn''' :: forall a. String -> NPG a
pn''' String
n = String -> PluralRule -> NPG a
forall a. String -> PluralRule -> NPG a
ProperNoun String
n PluralRule
AddES

-- | Constructs a 'ProperNoun' with a custom plural rule (using 'IrregPlur' from 'PluralRule').
-- First argument is the String representing the noun, second is the rule.
pnIrr :: String -> PluralRule -> NPG a
pnIrr :: forall a. String -> PluralRule -> NPG a
pnIrr = String -> PluralRule -> NPG a
forall a. String -> PluralRule -> NPG a
ProperNoun

-- | Constructs a common noun which capitalizes the first letter of the first word
-- at the beginning of a sentence.
cn, cn', cn'', cn''' :: String -> NPG a
-- | Self plural.
cn :: forall a. String -> NPG a
cn    String
n = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n PluralRule
SelfPlur CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst
-- | Plural form simply adds "s" (ex. dog -> dogs).
cn' :: forall a. String -> NPG a
cn'   String
n = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n PluralRule
AddS CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst
-- | Plural form adds "e" (ex. formula -> formulae).
cn'' :: forall a. String -> NPG a
cn''  String
n = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n PluralRule
AddE CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst
-- | Plural form adds "es" (ex. bush -> bushes).
cn''' :: forall a. String -> NPG a
cn''' String
n = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n PluralRule
AddES CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst

-- | Constructs a common noun that pluralizes by dropping the last letter and adding an "ies"
-- ending (ex. body -> bodies).
cnIES :: String -> NPG a
cnIES :: forall a. String -> NPG a
cnIES String
n = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\String
x -> String -> String
forall a. HasCallStack => [a] -> [a]
init String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"ies")) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst

--FIXME: Shouldn't this just be drop one and add "ces"?
-- | Construct a common noun that pluralizes by dropping the last two letters and adding an
-- "ices" ending (ex. matrix -> matrices).
cnICES :: String -> NPG a
cnICES :: forall a. String -> NPG a
cnICES String
n = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\String
x -> String -> String
forall a. HasCallStack => [a] -> [a]
init (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"ices")) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst

-- | Constructs a common noun that pluralizes by dropping the last two letters and adding
-- "es" (ex. analysis -> analyses).
cnIS :: String -> NPG a
cnIS :: forall a. String -> NPG a
cnIS String
n = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\String
x -> String -> String
forall a. HasCallStack => [a] -> [a]
init (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"es")) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst

-- | Constructs a common noun that pluralizes by dropping the last two letters and adding "a"
-- (ex. datum -> data).
cnUM :: String -> NPG a
cnUM :: forall a. String -> NPG a
cnUM String
n = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\String
x -> String -> String
forall a. HasCallStack => [a] -> [a]
init (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"a")) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst

-- | Constructs a common noun that allows you to specify the pluralization rule
-- (as in 'pnIrr').
cnIP :: String -> PluralRule -> NPG a
cnIP :: forall a. String -> PluralRule -> NPG a
cnIP String
n PluralRule
p = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun String
n PluralRule
p CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst

-- | Common noun that allows you to specify both the pluralization rule and the
-- capitalization rule for sentence case (if the noun is used at the beginning
-- of a sentence).
cnIrr :: String -> PluralRule -> CapitalizationRuleG a -> NPG a
cnIrr :: forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
cnIrr = String -> PluralRule -> CapitalizationRuleG a -> NPG a
forall a. String -> PluralRule -> CapitalizationRuleG a -> NPG a
CommonNoun

-- | Creates a 'NPG' with a given singular and plural form (as 'String's) that capitalizes the first
-- letter of the first word for sentence case.
nounPhrase :: String -> PluralString -> NPG a
nounPhrase :: forall a. String -> String -> NPG a
nounPhrase String
s String
p = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase (String -> NPStructG a
forall a. String -> NPStructG a
SC String
s) (String -> NPStructG a
forall a. String -> NPStructG a
SC String
p) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords

-- | Similar to 'nounPhrase', but takes a specified capitalization rule for the sentence case.
nounPhrase' :: String -> PluralString -> CapitalizationRuleG a -> NPG a
nounPhrase' :: forall a. String -> String -> CapitalizationRuleG a -> NPG a
nounPhrase' String
s String
p CapitalizationRuleG a
c = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase (String -> NPStructG a
forall a. String -> NPStructG a
SC String
s) (String -> NPStructG a
forall a. String -> NPStructG a
SC String
p) CapitalizationRuleG a
c CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords

-- | Custom noun phrase constructor that takes a singular form ('NPStructG'), plural form ('NPStructG'),
-- sentence case capitalization rule, and title case capitalization rule.
nounPhrase'' :: NPStructG a -> PluralFormG a -> CapitalizationRuleG a -> CapitalizationRuleG a -> NPG a
nounPhrase'' :: forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
nounPhrase'' = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase

-- | For things that should not be pluralized (or are self-plural). Works like 'nounPhrase', but with
-- only the first argument.
nounPhraseSP :: String -> NPG a
nounPhraseSP :: forall a. String -> NPG a
nounPhraseSP String
s = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase (String -> NPStructG a
forall a. String -> NPStructG a
SC String
s) (String -> NPStructG a
forall a. String -> NPStructG a
SC String
s) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords

-- | Similar to nounPhrase, except it only accepts one 'NPStructG'.
-- Plural case is just 'AddS'.
nounPhraseSent :: NPStructG a -> NPG a
nounPhraseSent :: forall a. NPStructG a -> NPG a
nounPhraseSent NPStructG a
s = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase NPStructG a
s (NPStructG a -> PluralRule -> NPStructG a
forall a. NPStructG a -> PluralRule -> NPStructG a
sPlur NPStructG a
s PluralRule
AddS) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords

-- | Combine two noun phrases. The singular form becomes 'phrase' from t1 followed
-- by 'phrase' of t2. The plural becomes 'phrase' of t1 followed by 'plural' of t2.
-- Uses standard 'CapFirst' sentence case and 'CapWords' title case.
-- For example: @compoundPhrase system constraint@ will have singular form
-- "system constraint" and plural "system constraints".
compoundPhrase :: (NounPhrase ta a, NounPhrase tb a) => ta -> tb -> NPG a
compoundPhrase :: forall ta a tb.
(NounPhrase ta a, NounPhrase tb a) =>
ta -> tb -> NPG a
compoundPhrase ta
t1 tb
t2 = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase
  (ta -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP ta
t1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: tb -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP tb
t2) (ta -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP ta
t1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: tb -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
pluralNP tb
t2) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords

-- | Similar to 'compoundPhrase', but the sentence case is the same
-- as the title case ('CapWords').
compoundPhrase' :: NPG a -> NPG a -> NPG a
compoundPhrase' :: forall a. NPG a -> NPG a -> NPG a
compoundPhrase' NPG a
t1 NPG a
t2 = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase
  (NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
t1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
t2) (NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
t1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
pluralNP NPG a
t2) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords

-- | Similar to 'compoundPhrase'', but accepts two functions that will be used to
-- construct the plural form. For example,
-- @compoundPhrase'' plural phrase system constraint@ would have the plural
-- form "systems constraint".
compoundPhrase'' :: (NPG a -> NPStructG a) -> (NPG a -> NPStructG a) -> NPG a -> NPG a -> NPG a
compoundPhrase'' :: forall a.
(NPG a -> NPStructG a)
-> (NPG a -> NPStructG a) -> NPG a -> NPG a -> NPG a
compoundPhrase'' NPG a -> NPStructG a
f1 NPG a -> NPStructG a
f2 NPG a
t1 NPG a
t2 = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase
  (NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
t1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
t2) (NPG a -> NPStructG a
f1 NPG a
t1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPG a -> NPStructG a
f2 NPG a
t2) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords

--More primes might not be wanted but fixes two issues
-- pluralization problem with software requirements specification (Documentation.hs)
-- SWHS program not being about to use a compound to create the IdeaDict
-- | Similar to 'compoundPhrase', but used when you need a special function applied
-- to the first term of both singular and pluralcases (eg. short or plural).
compoundPhrase''' :: (NPG a -> NPStructG a) -> NPG a -> NPG a -> NPG a
compoundPhrase''' :: forall a. (NPG a -> NPStructG a) -> NPG a -> NPG a -> NPG a
compoundPhrase''' NPG a -> NPStructG a
f1 NPG a
t1 NPG a
t2 = NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
forall a.
NPStructG a
-> NPStructG a
-> CapitalizationRuleG a
-> CapitalizationRuleG a
-> NPG a
Phrase
  (NPG a -> NPStructG a
f1 NPG a
t1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP NPG a
t2) (NPG a -> NPStructG a
f1 NPG a
t1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
pluralNP NPG a
t2) CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords

--For Data.Drasil.Documentation
-- | Similar to 'compoundPhrase', but pluralizes the first 'NPG' for both singular and plural cases.
compoundPhraseP1 :: NPG a -> NPG a -> NPG a
compoundPhraseP1 :: forall a. NPG a -> NPG a -> NPG a
compoundPhraseP1 = (NPG a -> NPStructG a) -> NPG a -> NPG a -> NPG a
forall a. (NPG a -> NPStructG a) -> NPG a -> NPG a -> NPG a
compoundPhrase''' NPG a -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
pluralNP

-- === Helpers ===
-- | Helper function for getting the sentence case of a noun phrase.
atStartNP, atStartNP' :: NounPhrase n a => n -> Capitalization a
-- | Singular sentence case.
atStartNP :: forall n a. NounPhrase n a => n -> NPStructG a
atStartNP  n
n = n -> (n -> NPStructG a) -> NPStructG a
forall n a.
NounPhrase n a =>
n -> (n -> NPStructG a) -> NPStructG a
sentenceCase n
n n -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP
-- | Plural sentence case.
atStartNP' :: forall n a. NounPhrase n a => n -> NPStructG a
atStartNP' n
n = n -> (n -> NPStructG a) -> NPStructG a
forall n a.
NounPhrase n a =>
n -> (n -> NPStructG a) -> NPStructG a
sentenceCase n
n n -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
pluralNP

-- | Helper function for getting the title case of a noun phrase.
titleizeNP, titleizeNP' :: NounPhrase n a => n -> Capitalization a
-- | Singular title case.
titleizeNP :: forall n a. NounPhrase n a => n -> NPStructG a
titleizeNP  n
n = n -> (n -> NPStructG a) -> NPStructG a
forall n a.
NounPhrase n a =>
n -> (n -> NPStructG a) -> NPStructG a
titleCase n
n n -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
phraseNP
-- | Plural title case.
titleizeNP' :: forall n a. NounPhrase n a => n -> NPStructG a
titleizeNP' n
n = n -> (n -> NPStructG a) -> NPStructG a
forall n a.
NounPhrase n a =>
n -> (n -> NPStructG a) -> NPStructG a
titleCase n
n n -> NPStructG a
forall n a. NounPhrase n a => n -> NPStructG a
pluralNP

-- DO NOT EXPORT --
-- | Pluralization helper function.
sPlur :: NPStructG a -> PluralRule -> NPStructG a
sPlur :: forall a. NPStructG a -> PluralRule -> NPStructG a
sPlur (SC String
s) PluralRule
AddS = String -> NPStructG a
forall a. String -> NPStructG a
SC (String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s")
sPlur (SC String
s) PluralRule
AddE = String -> NPStructG a
forall a. String -> NPStructG a
SC (String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"e")
sPlur s :: NPStructG a
s@(SC String
_) PluralRule
AddES = NPStructG a -> PluralRule -> NPStructG a
forall a. NPStructG a -> PluralRule -> NPStructG a
sPlur (NPStructG a -> PluralRule -> NPStructG a
forall a. NPStructG a -> PluralRule -> NPStructG a
sPlur NPStructG a
s PluralRule
AddE) PluralRule
AddS
sPlur s :: NPStructG a
s@(SC String
_) PluralRule
SelfPlur = NPStructG a
s
sPlur (SC String
sts) (IrregPlur String -> String
f) = String -> NPStructG a
forall a. String -> NPStructG a
SC (String -> NPStructG a) -> String -> NPStructG a
forall a b. (a -> b) -> a -> b
$ String -> String
f String
sts --Custom pluralization
sPlur (NPStructG a
a :+!: NPStructG a
b) PluralRule
pt = NPStructG a
a NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPStructG a -> PluralRule -> NPStructG a
forall a. NPStructG a -> PluralRule -> NPStructG a
sPlur NPStructG a
b PluralRule
pt
sPlur (NPStructG a
a :-!: NPStructG a
b) PluralRule
pt = NPStructG a
a NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: NPStructG a -> PluralRule -> NPStructG a
forall a. NPStructG a -> PluralRule -> NPStructG a
sPlur NPStructG a
b PluralRule
pt
sPlur NPStructG a
a PluralRule
_ = String -> NPStructG a
forall a. String -> NPStructG a
SC String
"MISSING PLURAL FOR:" NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPStructG a
a

-- | Capitalization helper function given a noun phrase.
cap :: NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap :: forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap NPStructG a
_ (Replace NPStructG a
s) = NPStructG a
s
cap NPStructG a
s CapitalizationRuleG a
CapNothing = NPStructG a
s
cap (SC [])     CapitalizationRuleG a
CapFirst = String -> NPStructG a
forall a. String -> NPStructG a
SC [] -- ignore this
cap (SC (Char
s:String
ss)) CapitalizationRuleG a
CapFirst = String -> NPStructG a
forall a. String -> NPStructG a
SC (Char -> Char
toUpper Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String
ss)
cap (SC String
s)      CapitalizationRuleG a
CapWords = String -> (String -> String) -> (String -> String) -> NPStructG a
forall a.
String -> (String -> String) -> (String -> String) -> NPStructG a
capString String
s String -> String
capFirstWord String -> String
capWords
cap (PC a
symb :+!: NPStructG a
x) CapitalizationRuleG a
CapFirst = a -> NPStructG a
forall a. a -> NPStructG a
PC a
symb NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPStructG a
x -- TODO: See why the Table of Symbols uses the CapWords case instead of CapFirst for items of the form:
cap (PC a
symb :+!: NPStructG a
x) CapitalizationRuleG a
CapWords = a -> NPStructG a
forall a. a -> NPStructG a
PC a
symb NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPStructG a
x -- "x-component". Instead, it displays as "x-Component". Using a temp fix for now by ignoring everything after a P symbol.
cap (NPStructG a
s1 :+!: NPStructG a
s2) CapitalizationRuleG a
CapWords = NPStructG a -> CapitalizationRuleG a -> NPStructG a
forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap NPStructG a
s1 CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a
capTail NPStructG a
s2
cap (NPStructG a
s1 :+!: NPStructG a
s2) CapitalizationRuleG a
CapFirst = NPStructG a -> CapitalizationRuleG a -> NPStructG a
forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap NPStructG a
s1 CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPStructG a
s2
cap (PC a
symb :-!: NPStructG a
x) CapitalizationRuleG a
CapFirst = a -> NPStructG a
forall a. a -> NPStructG a
PC a
symb NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: NPStructG a
x -- TODO: See why the Table of Symbols uses the CapWords case instead of CapFirst for items of the form:
cap (PC a
symb :-!: NPStructG a
x) CapitalizationRuleG a
CapWords = a -> NPStructG a
forall a. a -> NPStructG a
PC a
symb NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: NPStructG a
x -- "x-component". Instead, it displays as "x-Component". Using a temp fix for now by ignoring everything after a P symbol.
cap (NPStructG a
s1 :-!: NPStructG a
s2) CapitalizationRuleG a
CapWords = NPStructG a -> CapitalizationRuleG a -> NPStructG a
forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap NPStructG a
s1 CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapWords NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a
capTail NPStructG a
s2
cap (NPStructG a
s1 :-!: NPStructG a
s2) CapitalizationRuleG a
CapFirst = NPStructG a -> CapitalizationRuleG a -> NPStructG a
forall a. NPStructG a -> CapitalizationRuleG a -> NPStructG a
cap NPStructG a
s1 CapitalizationRuleG a
forall a. CapitalizationRuleG a
CapFirst NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: NPStructG a
s2
cap (PC a
p) CapitalizationRuleG a
_ = a -> NPStructG a
forall a. a -> NPStructG a
PC a
p

-- | Helper for 'cap' and for capitalizing the end of a 'NPStructG' (assumes 'CapWords').
capTail :: NPStructG a -> NPStructG a
capTail :: forall a. NPStructG a -> NPStructG a
capTail (SC String
s) = String -> (String -> String) -> (String -> String) -> NPStructG a
forall a.
String -> (String -> String) -> (String -> String) -> NPStructG a
capString String
s String -> String
capWords String -> String
capWords
capTail (PC a
symb :+!: NPStructG a
b) = a -> NPStructG a
forall a. a -> NPStructG a
PC a
symb NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPStructG a
b
capTail (NPStructG a
a :+!: NPStructG a
b) = NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a
capTail NPStructG a
a NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a
capTail NPStructG a
b
capTail (PC a
symb :-!: NPStructG a
b) = a -> NPStructG a
forall a. a -> NPStructG a
PC a
symb NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: NPStructG a
b
capTail (NPStructG a
a :-!: NPStructG a
b) = NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a
capTail NPStructG a
a NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a
capTail NPStructG a
b
capTail (PC a
p) = a -> NPStructG a
forall a. a -> NPStructG a
PC a
p

-- | Helper for capitalizing a string.
capString :: String -> (String -> String) -> (String -> String) -> NPStructG a
capString :: forall a.
String -> (String -> String) -> (String -> String) -> NPStructG a
capString String
s String -> String
f String -> String
g = String -> NPStructG a
forall a. String -> NPStructG a
SC (String -> NPStructG a)
-> ([String] -> String) -> [String] -> NPStructG a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> String
findHyph String -> String
g (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> NPStructG a) -> [String] -> NPStructG a
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
process (String -> [String]
words String
s)
  where
    process :: [String] -> [String]
process (String
x:[String]
xs) = String -> String
f String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
g [String]
xs
    process []     = []

-- | Finds hyphens in a 'String' and applies capitalization to words after a hyphen.
findHyph :: (String -> String) -> String -> String
findHyph :: (String -> String) -> String -> String
findHyph String -> String
_ String
"" = String
""
findHyph String -> String
_ [Char
x] = [Char
x]
findHyph String -> String
f (Char
x:String
xs)
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'  = Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: (String -> String) -> String -> String
findHyph String -> String
f (String -> String
f String
xs)
  | Bool
otherwise = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: (String -> String) -> String -> String
findHyph String -> String
f String
xs

-- | Capitalize first word of a 'String'. Does not ignore prepositions, articles, or conjunctions (intended for beginning of a phrase/sentence).
capFirstWord :: String -> String
capFirstWord :: String -> String
capFirstWord String
"" = String
""
capFirstWord w :: String
w@(Char
c:String
cs)
  | Bool -> Bool
not (Char -> Bool
isLetter Char
c) = String
w
  | Bool -> Bool
not (Char -> Bool
isLatin1 Char
c) = String
w
  | Bool
otherwise        = Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs

-- | Capitalize all words of a 'String' (unless they are prepositions, articles, or conjunctions).
capWords :: String -> String
capWords :: String -> String
capWords String
"" = String
""
capWords w :: String
w@(Char
c:String
cs)
  | Bool -> Bool
not (Char -> Bool
isLetter Char
c)   = String
w
  | Bool -> Bool
not (Char -> Bool
isLatin1 Char
c)   = String
w
  | String
w String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
doNotCaps = Char -> Char
toLower Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
  | Bool
otherwise          = Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs

-- | Words that should not be capitalized in a title (prepositions, articles, or conjunctions).
doNotCaps :: [String]
doNotCaps :: [String]
doNotCaps = [String
"a", String
"an", String
"the", String
"at", String
"by", String
"for", String
"in", String
"of",
  String
"on", String
"to", String
"up", String
"and", String
"as", String
"but", String
"or", String
"nor"] --Ref http://grammar.yourdictionary.com

surroundNPStruct :: String -> String -> NPStructG a -> NPStructG a
surroundNPStruct :: forall a. String -> String -> NPStructG a -> NPStructG a
surroundNPStruct String
l String
r (SC String
s)       = String -> NPStructG a
forall a. String -> NPStructG a
SC (String -> NPStructG a) -> String -> NPStructG a
forall a b. (a -> b) -> a -> b
$ String
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
r
surroundNPStruct String
l String
r (NPStructG a
s1 :+!: NPStructG a
s2) = String -> String -> NPStructG a -> NPStructG a
forall a. String -> String -> NPStructG a -> NPStructG a
surroundNPStruct String
l String
"" NPStructG a
s1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:+!: String -> String -> NPStructG a -> NPStructG a
forall a. String -> String -> NPStructG a -> NPStructG a
surroundNPStruct String
"" String
r NPStructG a
s2
surroundNPStruct String
l String
r (NPStructG a
s1 :-!: NPStructG a
s2) = String -> String -> NPStructG a -> NPStructG a
forall a. String -> String -> NPStructG a -> NPStructG a
surroundNPStruct String
l String
"" NPStructG a
s1 NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: String -> String -> NPStructG a -> NPStructG a
forall a. String -> String -> NPStructG a -> NPStructG a
surroundNPStruct String
"" String
r NPStructG a
s2
surroundNPStruct String
l String
r (PC a
p)       = String -> NPStructG a
forall a. String -> NPStructG a
SC String
l NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: a -> NPStructG a
forall a. a -> NPStructG a
PC a
p NPStructG a -> NPStructG a -> NPStructG a
forall a. NPStructG a -> NPStructG a -> NPStructG a
:-!: String -> NPStructG a
forall a. String -> NPStructG a
SC String
r