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 n :: String
n _) = String -> PluralForm
S String
n
phraseNP (CommonNoun n :: String
n _ _) = String -> PluralForm
S String
n
phraseNP (Phrase n :: PluralForm
n _ _ _) = PluralForm
n
pluralNP :: NP -> PluralForm
pluralNP n :: NP
n@(ProperNoun _ p :: PluralRule
p) = PluralForm -> PluralRule -> PluralForm
sPlur (NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
n) PluralRule
p
pluralNP n :: NP
n@(CommonNoun _ p :: PluralRule
p _) = PluralForm -> PluralRule -> PluralForm
sPlur (NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
n) PluralRule
p
pluralNP (Phrase _ p :: PluralForm
p _ _) = PluralForm
p
sentenceCase :: NP -> (NP -> PluralForm) -> PluralForm
sentenceCase n :: NP
n@ProperNoun {} _ = NP -> PluralForm
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
n
sentenceCase n :: NP
n@(CommonNoun _ _ r :: CapitalizationRule
r) f :: NP -> PluralForm
f = PluralForm -> CapitalizationRule -> PluralForm
cap (NP -> PluralForm
f NP
n) CapitalizationRule
r
sentenceCase n :: NP
n@(Phrase _ _ r :: CapitalizationRule
r _) f :: 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
forall n. NounPhrase n => n -> PluralForm
phraseNP NP
n
titleCase n :: NP
n@CommonNoun {} f :: NP -> PluralForm
f = PluralForm -> CapitalizationRule -> PluralForm
cap (NP -> PluralForm
f NP
n) CapitalizationRule
CapWords
titleCase n :: NP
n@(Phrase _ _ _ r :: CapitalizationRule
r) f :: NP -> PluralForm
f = PluralForm -> CapitalizationRule -> PluralForm
cap (NP -> PluralForm
f NP
n) CapitalizationRule
r
pn, pn', pn'', pn''' :: String -> NP
pn :: String -> NP
pn n :: String
n = String -> PluralRule -> NP
ProperNoun String
n PluralRule
SelfPlur
pn' :: String -> NP
pn' n :: String
n = String -> PluralRule -> NP
ProperNoun String
n PluralRule
AddS
pn'' :: String -> NP
pn'' n :: String
n = String -> PluralRule -> NP
ProperNoun String
n PluralRule
AddE
pn''' :: String -> NP
pn''' n :: 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 n :: String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
SelfPlur CapitalizationRule
CapFirst
cn' :: String -> NP
cn' n :: String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
AddS CapitalizationRule
CapFirst
cn'' :: String -> NP
cn'' n :: String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
AddE CapitalizationRule
CapFirst
cn''' :: String -> NP
cn''' n :: String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n PluralRule
AddES CapitalizationRule
CapFirst
cnIES :: String -> NP
cnIES :: String -> NP
cnIES n :: String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\x :: String
x -> String -> String
forall a. [a] -> [a]
init String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "ies")) CapitalizationRule
CapFirst
cnICES :: String -> NP
cnICES :: String -> NP
cnICES n :: String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\x :: String
x -> String -> String
forall a. [a] -> [a]
init (String -> String
forall a. [a] -> [a]
init String
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "ices")) CapitalizationRule
CapFirst
cnIS :: String -> NP
cnIS :: String -> NP
cnIS n :: String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\x :: String
x -> String -> String
forall a. [a] -> [a]
init (String -> String
forall a. [a] -> [a]
init String
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "es")) CapitalizationRule
CapFirst
cnUM :: String -> NP
cnUM :: String -> NP
cnUM n :: String
n = String -> PluralRule -> CapitalizationRule -> NP
CommonNoun String
n ((String -> String) -> PluralRule
IrregPlur (\x :: String
x -> String -> String
forall a. [a] -> [a]
init (String -> String
forall a. [a] -> [a]
init String
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "a")) CapitalizationRule
CapFirst
cnIP :: String -> PluralRule -> NP
cnIP :: String -> PluralRule -> NP
cnIP n :: String
n p :: 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 s :: String
s p :: 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' s :: String
s p :: String
p c :: 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 s :: 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 s :: 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 :: a -> b -> NP
compoundPhrase t1 :: a
t1 t2 :: 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' t1 :: NP
t1 t2 :: 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'' f1 :: NP -> PluralForm
f1 f2 :: NP -> PluralForm
f2 t1 :: NP
t1 t2 :: 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''' f1 :: NP -> PluralForm
f1 t1 :: NP
t1 t2 :: 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 :: n -> PluralForm
atStartNP n :: 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' :: n -> PluralForm
atStartNP' n :: 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 :: n -> PluralForm
titleizeNP n :: 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' :: n -> PluralForm
titleizeNP' n :: 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 s :: String
s) AddS = String -> PluralForm
S (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "s")
sPlur (S s :: String
s) AddE = String -> PluralForm
S (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "e")
sPlur s :: PluralForm
s@(S _) AddES = PluralForm -> PluralRule -> PluralForm
sPlur (PluralForm -> PluralRule -> PluralForm
sPlur PluralForm
s PluralRule
AddE) PluralRule
AddS
sPlur s :: PluralForm
s@(S _) SelfPlur = PluralForm
s
sPlur (S sts :: String
sts) (IrregPlur f :: String -> String
f) = String -> PluralForm
S (String -> PluralForm) -> String -> PluralForm
forall a b. (a -> b) -> a -> b
$ String -> String
f String
sts
sPlur (a :: PluralForm
a :+: b :: PluralForm
b) pt :: PluralRule
pt = PluralForm
a PluralForm -> PluralForm -> PluralForm
:+: PluralForm -> PluralRule -> PluralForm
sPlur PluralForm
b PluralRule
pt
sPlur a :: PluralForm
a _ = String -> PluralForm
S "MISSING PLURAL FOR:" PluralForm -> PluralForm -> PluralForm
+:+ PluralForm
a
cap :: Sentence -> CapitalizationRule -> Sentence
cap :: PluralForm -> CapitalizationRule -> PluralForm
cap _ (Replace s :: PluralForm
s) = PluralForm
s
cap (S (s :: Char
s:ss :: String
ss)) CapFirst = String -> PluralForm
S (Char -> Char
toUpper Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String
ss)
cap (S s :: String
s) CapWords = String -> (String -> String) -> (String -> String) -> PluralForm
capString String
s String -> String
capFirstWord String -> String
capWords
cap (P symb :: Symbol
symb :+: x :: PluralForm
x) CapFirst = Symbol -> PluralForm
P Symbol
symb PluralForm -> PluralForm -> PluralForm
:+: PluralForm
x
cap (P symb :: Symbol
symb :+: x :: PluralForm
x) CapWords = Symbol -> PluralForm
P Symbol
symb PluralForm -> PluralForm -> PluralForm
:+: PluralForm
x
cap (Ch style :: SentenceStyle
style _ s :: UID
s) CapFirst = SentenceStyle -> TermCapitalization -> UID -> PluralForm
Ch SentenceStyle
style TermCapitalization
CapF UID
s
cap (Ch style :: SentenceStyle
style _ s :: UID
s) CapWords = SentenceStyle -> TermCapitalization -> UID -> PluralForm
Ch SentenceStyle
style TermCapitalization
CapW UID
s
cap (S s1 :: String
s1 :+: S s2 :: String
s2 :+: x :: PluralForm
x) r :: 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 (s1 :: PluralForm
s1 :+: s2 :: PluralForm
s2) CapWords = PluralForm -> CapitalizationRule -> PluralForm
cap PluralForm
s1 CapitalizationRule
CapWords PluralForm -> PluralForm -> PluralForm
+:+ PluralForm -> PluralForm
capTail PluralForm
s2
cap (s1 :: PluralForm
s1 :+: s2 :: PluralForm
s2) CapFirst = PluralForm -> CapitalizationRule -> PluralForm
cap PluralForm
s1 CapitalizationRule
CapFirst PluralForm -> PluralForm -> PluralForm
:+: PluralForm
s2
cap a :: PluralForm
a _ = PluralForm
a
capTail :: Sentence -> Sentence
capTail :: PluralForm -> PluralForm
capTail (S s :: String
s) = String -> (String -> String) -> (String -> String) -> PluralForm
capString String
s String -> String
capWords String -> String
capWords
capTail (Ch style :: SentenceStyle
style _ s :: UID
s) = SentenceStyle -> TermCapitalization -> UID -> PluralForm
Ch SentenceStyle
style TermCapitalization
CapW UID
s
capTail (a :: PluralForm
a :+: b :: PluralForm
b) = PluralForm -> PluralForm
capTail PluralForm
a PluralForm -> PluralForm -> PluralForm
:+: PluralForm -> PluralForm
capTail PluralForm
b
capTail x :: PluralForm
x = PluralForm
x
capString :: String -> (String -> String) -> (String -> String) -> Sentence
capString :: String -> (String -> String) -> (String -> String) -> PluralForm
capString s :: String
s f :: String -> String
f g :: 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 (x :: String
x:xs :: [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 _ "" = ""
findHyph _ [x :: Char
x] = [Char
x]
findHyph f :: String -> String
f (x :: Char
x:xs :: String
xs)
| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' = '-' 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 "" = ""
capFirstWord w :: String
w@(c :: Char
c:cs :: 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 "" = ""
capWords w :: String
w@(c :: Char
c:cs :: 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 (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 = ["a", "an", "the", "at", "by", "for", "in", "of",
"on", "to", "up", "and", "as", "but", "or", "nor"]