module Language.Drasil.NounPhrase (
NounPhrase(..), NP,
atStartNP, atStartNP', titleizeNP, titleizeNP',
cn, cn', cn'', cn''', cnICES, cnIES, cnIP, cnIS, cnIrr, cnUM,
pn, pn', pn'', pn''', pnIrr,
nounPhrase, nounPhrase', nounPhrase'', nounPhraseSP, nounPhraseSent,
compoundPhrase,
compoundPhrase', compoundPhrase'', compoundPhrase''', compoundPhraseP1,
CapitalizationRule(..), PluralRule(..)
) where
import Data.Char (isLatin1, isLetter, toLower, toUpper)
import Language.Drasil.NounPhrase.Core
import Language.Drasil.Sentence (Sentence((:+:), S, Ch, P), (+:+), TermCapitalization(..))
class NounPhrase n where
phraseNP :: n -> Sentence
pluralNP :: n -> PluralForm
sentenceCase :: n -> (NP -> Sentence) -> Capitalization
titleCase :: n -> (NP -> Sentence) -> Capitalization
type Capitalization = Sentence
type PluralString = String
instance NounPhrase NP where
phraseNP :: NP -> PluralForm
phraseNP (ProperNoun String
n PluralRule
_) = String -> PluralForm
S String
n
phraseNP (CommonNoun String
n PluralRule
_ CapitalizationRule
_) = String -> PluralForm
S String
n
phraseNP (Phrase PluralForm
n PluralForm
_ CapitalizationRule
_ CapitalizationRule
_) = PluralForm
n
pluralNP :: NP -> PluralForm
pluralNP n :: NP
n@(ProperNoun String
_ PluralRule
p) = PluralForm -> PluralRule -> PluralForm
sPlur (NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
n) PluralRule
p
pluralNP n :: NP
n@(CommonNoun String
_ PluralRule
p CapitalizationRule
_) = PluralForm -> PluralRule -> PluralForm
sPlur (NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
n) PluralRule
p
pluralNP (Phrase PluralForm
_ PluralForm
p CapitalizationRule
_ CapitalizationRule
_) = PluralForm
p
sentenceCase :: NP -> (NP -> PluralForm) -> PluralForm
sentenceCase n :: NP
n@ProperNoun {} NP -> PluralForm
_ = NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
n
sentenceCase n :: NP
n@(CommonNoun String
_ PluralRule
_ CapitalizationRule
r) NP -> PluralForm
f = PluralForm -> CapitalizationRule -> PluralForm
cap (NP -> PluralForm
f NP
n) CapitalizationRule
r
sentenceCase n :: NP
n@(Phrase PluralForm
_ PluralForm
_ CapitalizationRule
r CapitalizationRule
_) NP -> PluralForm
f = PluralForm -> CapitalizationRule -> PluralForm
cap (NP -> PluralForm
f NP
n) CapitalizationRule
r
titleCase :: NP -> (NP -> PluralForm) -> PluralForm
titleCase n :: NP
n@ProperNoun {} NP -> PluralForm
_ = NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
n
titleCase n :: NP
n@CommonNoun {} NP -> PluralForm
f = PluralForm -> CapitalizationRule -> PluralForm
cap (NP -> PluralForm
f NP
n) CapitalizationRule
CapWords
titleCase n :: NP
n@(Phrase PluralForm
_ PluralForm
_ CapitalizationRule
_ CapitalizationRule
r) NP -> PluralForm
f = PluralForm -> CapitalizationRule -> PluralForm
cap (NP -> PluralForm
f NP
n) CapitalizationRule
r
pn, pn', pn'', pn''' :: String -> NP
pn :: String -> NP
pn String
n = String -> PluralRule -> NP
ProperNoun String
n PluralRule
SelfPlur
pn' :: String -> NP
pn' String
n = String -> PluralRule -> NP
ProperNoun String
n PluralRule
AddS
pn'' :: String -> NP
pn'' String
n = String -> PluralRule -> NP
ProperNoun String
n PluralRule
AddE
pn''' :: String -> NP
pn''' String
n = String -> PluralRule -> NP
ProperNoun String
n PluralRule
AddES
pnIrr :: String -> PluralRule -> NP
pnIrr :: String -> PluralRule -> NP
pnIrr = String -> PluralRule -> NP
ProperNoun
cn, cn', cn'', cn''' :: String -> NP
cn :: String -> NP
cn String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
SelfPlur CapitalizationRule
CapFirst
cn' :: String -> NP
cn' String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
AddS CapitalizationRule
CapFirst
cn'' :: String -> NP
cn'' String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
AddE CapitalizationRule
CapFirst
cn''' :: String -> NP
cn''' String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
AddES CapitalizationRule
CapFirst
cnIES :: String -> NP
cnIES :: String -> NP
cnIES String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\String
x -> String -> String
forall a. HasCallStack => [a] -> [a]
init String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ies")) CapitalizationRule
CapFirst
cnICES :: String -> NP
cnICES :: String -> NP
cnICES String
n = String -> PluralRule -> CapitalizationRule -> NP
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. [a] -> [a] -> [a]
++ String
"ices")) CapitalizationRule
CapFirst
cnIS :: String -> NP
cnIS :: String -> NP
cnIS String
n = String -> PluralRule -> CapitalizationRule -> NP
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. [a] -> [a] -> [a]
++ String
"es")) CapitalizationRule
CapFirst
cnUM :: String -> NP
cnUM :: String -> NP
cnUM String
n = String -> PluralRule -> CapitalizationRule -> NP
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. [a] -> [a] -> [a]
++ String
"a")) CapitalizationRule
CapFirst
cnIP :: String -> PluralRule -> NP
cnIP :: String -> PluralRule -> NP
cnIP String
n PluralRule
p = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
p CapitalizationRule
CapFirst
cnIrr :: String -> PluralRule -> CapitalizationRule -> NP
cnIrr :: String -> PluralRule -> CapitalizationRule -> NP
cnIrr = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun
nounPhrase :: String -> PluralString -> NP
nounPhrase :: String -> String -> NP
nounPhrase String
s String
p = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase (String -> PluralForm
S String
s) (String -> PluralForm
S String
p) CapitalizationRule
CapFirst CapitalizationRule
CapWords
nounPhrase' :: String -> PluralString -> CapitalizationRule -> NP
nounPhrase' :: String -> String -> CapitalizationRule -> NP
nounPhrase' String
s String
p CapitalizationRule
c = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase (String -> PluralForm
S String
s) (String -> PluralForm
S String
p) CapitalizationRule
c CapitalizationRule
CapWords
nounPhrase'' :: Sentence -> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
nounPhrase'' :: PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
nounPhrase'' = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase
nounPhraseSP :: String -> NP
nounPhraseSP :: String -> NP
nounPhraseSP String
s = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase (String -> PluralForm
S String
s) (String -> PluralForm
S String
s) CapitalizationRule
CapFirst CapitalizationRule
CapWords
nounPhraseSent :: Sentence -> NP
nounPhraseSent :: PluralForm -> NP
nounPhraseSent PluralForm
s = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase PluralForm
s (PluralForm -> PluralRule -> PluralForm
sPlur PluralForm
s PluralRule
AddS) CapitalizationRule
CapFirst CapitalizationRule
CapWords
compoundPhrase :: (NounPhrase a, NounPhrase b) => a -> b -> NP
compoundPhrase :: forall a b. (NounPhrase a, NounPhrase b) => a -> b -> NP
compoundPhrase a
t1 b
t2 = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase
(a -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP a
t1 PluralForm -> PluralForm -> PluralForm
+:+ b -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP b
t2) (a -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP a
t1 PluralForm -> PluralForm -> PluralForm
+:+ b -> PluralForm
forall n. NounPhrase n => n -> PluralForm
pluralNP b
t2) CapitalizationRule
CapFirst CapitalizationRule
CapWords
compoundPhrase' :: NP -> NP -> NP
compoundPhrase' :: NP -> NP -> NP
compoundPhrase' NP
t1 NP
t2 = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase
(NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
t1 PluralForm -> PluralForm -> PluralForm
+:+ NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
t2) (NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
t1 PluralForm -> PluralForm -> PluralForm
+:+ NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
pluralNP NP
t2) CapitalizationRule
CapWords CapitalizationRule
CapWords
compoundPhrase'' :: (NP -> Sentence) -> (NP -> Sentence) -> NP -> NP -> NP
compoundPhrase'' :: (NP -> PluralForm) -> (NP -> PluralForm) -> NP -> NP -> NP
compoundPhrase'' NP -> PluralForm
f1 NP -> PluralForm
f2 NP
t1 NP
t2 = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase
(NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
t1 PluralForm -> PluralForm -> PluralForm
+:+ NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
t2) (NP -> PluralForm
f1 NP
t1 PluralForm -> PluralForm -> PluralForm
+:+ NP -> PluralForm
f2 NP
t2) CapitalizationRule
CapWords CapitalizationRule
CapWords
compoundPhrase''' :: (NP -> Sentence) -> NP -> NP -> NP
compoundPhrase''' :: (NP -> PluralForm) -> NP -> NP -> NP
compoundPhrase''' NP -> PluralForm
f1 NP
t1 NP
t2 = PluralForm
-> PluralForm -> CapitalizationRule -> CapitalizationRule -> NP
Phrase
(NP -> PluralForm
f1 NP
t1 PluralForm -> PluralForm -> PluralForm
+:+ NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
t2) (NP -> PluralForm
f1 NP
t1 PluralForm -> PluralForm -> PluralForm
+:+ NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
pluralNP NP
t2) CapitalizationRule
CapFirst CapitalizationRule
CapWords
compoundPhraseP1 :: NP -> NP -> NP
compoundPhraseP1 :: NP -> NP -> NP
compoundPhraseP1 = (NP -> PluralForm) -> NP -> NP -> NP
compoundPhrase''' NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
pluralNP
atStartNP, atStartNP' :: NounPhrase n => n -> Capitalization
atStartNP :: forall n. NounPhrase n => n -> PluralForm
atStartNP n
n = n -> (NP -> PluralForm) -> PluralForm
forall n. NounPhrase n => n -> (NP -> PluralForm) -> PluralForm
sentenceCase n
n NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP
atStartNP' :: forall n. NounPhrase n => n -> PluralForm
atStartNP' n
n = n -> (NP -> PluralForm) -> PluralForm
forall n. NounPhrase n => n -> (NP -> PluralForm) -> PluralForm
sentenceCase n
n NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
pluralNP
titleizeNP, titleizeNP' :: NounPhrase n => n -> Capitalization
titleizeNP :: forall n. NounPhrase n => n -> PluralForm
titleizeNP n
n = n -> (NP -> PluralForm) -> PluralForm
forall n. NounPhrase n => n -> (NP -> PluralForm) -> PluralForm
titleCase n
n NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP
titleizeNP' :: forall n. NounPhrase n => n -> PluralForm
titleizeNP' n
n = n -> (NP -> PluralForm) -> PluralForm
forall n. NounPhrase n => n -> (NP -> PluralForm) -> PluralForm
titleCase n
n NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
pluralNP
sPlur :: Sentence -> PluralRule -> Sentence
sPlur :: PluralForm -> PluralRule -> PluralForm
sPlur (S String
s) PluralRule
AddS = String -> PluralForm
S (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s")
sPlur (S String
s) PluralRule
AddE = String -> PluralForm
S (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"e")
sPlur s :: PluralForm
s@(S String
_) PluralRule
AddES = PluralForm -> PluralRule -> PluralForm
sPlur (PluralForm -> PluralRule -> PluralForm
sPlur PluralForm
s PluralRule
AddE) PluralRule
AddS
sPlur s :: PluralForm
s@(S String
_) PluralRule
SelfPlur = PluralForm
s
sPlur (S String
sts) (IrregPlur String -> String
f) = String -> PluralForm
S (String -> PluralForm) -> String -> PluralForm
forall a b. (a -> b) -> a -> b
$ String -> String
f String
sts
sPlur (PluralForm
a :+: PluralForm
b) PluralRule
pt = PluralForm
a PluralForm -> PluralForm -> PluralForm
:+: PluralForm -> PluralRule -> PluralForm
sPlur PluralForm
b PluralRule
pt
sPlur PluralForm
a PluralRule
_ = String -> PluralForm
S String
"MISSING PLURAL FOR:" PluralForm -> PluralForm -> PluralForm
+:+ PluralForm
a
cap :: Sentence -> CapitalizationRule -> Sentence
cap :: PluralForm -> CapitalizationRule -> PluralForm
cap PluralForm
_ (Replace PluralForm
s) = PluralForm
s
cap (S (Char
s:String
ss)) CapitalizationRule
CapFirst = String -> PluralForm
S (Char -> Char
toUpper Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String
ss)
cap (S String
s) CapitalizationRule
CapWords = String -> (String -> String) -> (String -> String) -> PluralForm
capString String
s String -> String
capFirstWord String -> String
capWords
cap (P Symbol
symb :+: PluralForm
x) CapitalizationRule
CapFirst = Symbol -> PluralForm
P Symbol
symb PluralForm -> PluralForm -> PluralForm
:+: PluralForm
x
cap (P Symbol
symb :+: PluralForm
x) CapitalizationRule
CapWords = Symbol -> PluralForm
P Symbol
symb PluralForm -> PluralForm -> PluralForm
:+: PluralForm
x
cap (Ch SentenceStyle
style TermCapitalization
_ UID
s) CapitalizationRule
CapFirst = SentenceStyle -> TermCapitalization -> UID -> PluralForm
Ch SentenceStyle
style TermCapitalization
CapF UID
s
cap (Ch SentenceStyle
style TermCapitalization
_ UID
s) CapitalizationRule
CapWords = SentenceStyle -> TermCapitalization -> UID -> PluralForm
Ch SentenceStyle
style TermCapitalization
CapW UID
s
cap (S String
s1 :+: S String
s2 :+: PluralForm
x) CapitalizationRule
r = PluralForm -> CapitalizationRule -> PluralForm
cap (String -> PluralForm
S (String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2) PluralForm -> PluralForm -> PluralForm
:+: PluralForm
x) CapitalizationRule
r
cap (PluralForm
s1 :+: PluralForm
s2) CapitalizationRule
CapWords = PluralForm -> CapitalizationRule -> PluralForm
cap PluralForm
s1 CapitalizationRule
CapWords PluralForm -> PluralForm -> PluralForm
+:+ PluralForm -> PluralForm
capTail PluralForm
s2
cap (PluralForm
s1 :+: PluralForm
s2) CapitalizationRule
CapFirst = PluralForm -> CapitalizationRule -> PluralForm
cap PluralForm
s1 CapitalizationRule
CapFirst PluralForm -> PluralForm -> PluralForm
:+: PluralForm
s2
cap PluralForm
a CapitalizationRule
_ = PluralForm
a
capTail :: Sentence -> Sentence
capTail :: PluralForm -> PluralForm
capTail (S String
s) = String -> (String -> String) -> (String -> String) -> PluralForm
capString String
s String -> String
capWords String -> String
capWords
capTail (Ch SentenceStyle
style TermCapitalization
_ UID
s) = SentenceStyle -> TermCapitalization -> UID -> PluralForm
Ch SentenceStyle
style TermCapitalization
CapW UID
s
capTail (PluralForm
a :+: PluralForm
b) = PluralForm -> PluralForm
capTail PluralForm
a PluralForm -> PluralForm -> PluralForm
:+: PluralForm -> PluralForm
capTail PluralForm
b
capTail PluralForm
x = PluralForm
x
capString :: String -> (String -> String) -> (String -> String) -> Sentence
capString :: String -> (String -> String) -> (String -> String) -> PluralForm
capString String
s String -> String
f String -> String
g = String -> PluralForm
S (String -> PluralForm)
-> ([String] -> String) -> [String] -> PluralForm
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] -> PluralForm) -> [String] -> PluralForm
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]
map String -> String
g [String]
xs
process [] = []
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
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
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
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"]