{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
module Modelling.CdOd.Phrasing.English (
phraseChange,
phraseRelationship,
numberWords,
) where
import Modelling.Types (
Change (..),
)
import Modelling.CdOd.Auxiliary.Util (oneAndOther)
import Modelling.CdOd.Phrasing.Common (phraseChangeWith, PhrasingStrings (..))
import Modelling.CdOd.Types (
AnyRelationship,
DefaultedLimitedLinking (..),
InvalidRelationship (..),
LimitedLinking (..),
NonInheritancePhrasing (..),
OmittedDefaultMultiplicities (..),
PhrasingKind (..),
Relationship (..),
defaultedLimitedLinking,
sortLimits,
toPhrasing,
)
import Control.OutputCapable.Blocks (ArticleToUse (..))
import Data.String.Interpolate (iii)
import Data.Tuple.Extra (curry3)
import Data.Map (Map)
import qualified Data.Map as M (fromList)
numberWords :: Map Int String
numberWords :: Map Int String
numberWords = [(Int, String)] -> Map Int String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
(Int
2, String
"two"),
(Int
3, String
"three"),
(Int
4, String
"four"),
(Int
5, String
"five"),
(Int
6, String
"six"),
(Int
7, String
"seven"),
(Int
8, String
"eight"),
(Int
9, String
"nine"),
(Int
10, String
"ten")
]
phraseChange
:: OmittedDefaultMultiplicities
-> ArticleToUse
-> Bool
-> Bool
-> Change (AnyRelationship String String)
-> String
phraseChange :: OmittedDefaultMultiplicities
-> ArticleToUse
-> Bool
-> Bool
-> Change (AnyRelationship String String)
-> String
phraseChange = PhrasingStrings
-> OmittedDefaultMultiplicities
-> ArticleToUse
-> Bool
-> Bool
-> Change (AnyRelationship String String)
-> String
phraseChangeWith PhrasingStrings
englishStrings
englishStrings :: PhrasingStrings
englishStrings :: PhrasingStrings
englishStrings = PhrasingStrings
{ changeNothing :: String
changeNothing = String
"change nothing"
, addPrefix :: String
addPrefix = String
"add "
, removePrefix :: String
removePrefix = String
"remove "
, replacePrefix :: String
replacePrefix = String
"replace "
, byInfix :: String
byInfix = String
" by "
, postProcess :: String -> String
postProcess = String -> String
forall a. a -> a
id
, phraseRelationWith :: OmittedDefaultMultiplicities
-> ArticleToUse
-> PhrasingKind
-> NonInheritancePhrasing
-> AnyRelationship String String
-> String
phraseRelationWith = OmittedDefaultMultiplicities
-> ArticleToUse
-> PhrasingKind
-> NonInheritancePhrasing
-> AnyRelationship String String
-> String
phraseRelation
}
consonantArticle :: ArticleToUse -> String
consonantArticle :: ArticleToUse -> String
consonantArticle = \case
ArticleToUse
DefiniteArticle -> String
"the"
ArticleToUse
IndefiniteArticle -> String
"a"
vowelArticle :: ArticleToUse -> String
vowelArticle :: ArticleToUse -> String
vowelArticle = \case
ArticleToUse
DefiniteArticle -> String
"the"
ArticleToUse
IndefiniteArticle -> String
"an"
phraseRelationship
:: OmittedDefaultMultiplicities
-> ArticleToUse
-> PhrasingKind
-> Bool
-> Bool
-> AnyRelationship String String
-> String
phraseRelationship :: OmittedDefaultMultiplicities
-> ArticleToUse
-> PhrasingKind
-> Bool
-> Bool
-> AnyRelationship String String
-> String
phraseRelationship OmittedDefaultMultiplicities
defaultMultiplicities ArticleToUse
article PhrasingKind
kind Bool
byName Bool
withDir =
OmittedDefaultMultiplicities
-> ArticleToUse
-> PhrasingKind
-> NonInheritancePhrasing
-> AnyRelationship String String
-> String
phraseRelation OmittedDefaultMultiplicities
defaultMultiplicities ArticleToUse
article PhrasingKind
kind NonInheritancePhrasing
phrasing
where
phrasing :: NonInheritancePhrasing
phrasing = Bool -> Bool -> NonInheritancePhrasing
toPhrasing Bool
byName Bool
withDir
phraseRelation
:: OmittedDefaultMultiplicities
-> ArticleToUse
-> PhrasingKind
-> NonInheritancePhrasing
-> AnyRelationship String String
-> String
phraseRelation :: OmittedDefaultMultiplicities
-> ArticleToUse
-> PhrasingKind
-> NonInheritancePhrasing
-> AnyRelationship String String
-> String
phraseRelation OmittedDefaultMultiplicities {Maybe (Int, Maybe Int)
aggregationWholeOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity :: OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity :: OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
aggregationWholeOmittedDefaultMultiplicity :: OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
..} ArticleToUse
article = ((PhrasingKind, NonInheritancePhrasing,
AnyRelationship String String)
-> String)
-> PhrasingKind
-> NonInheritancePhrasing
-> AnyRelationship String String
-> String
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((PhrasingKind, NonInheritancePhrasing,
AnyRelationship String String)
-> String)
-> PhrasingKind
-> NonInheritancePhrasing
-> AnyRelationship String String
-> String)
-> ((PhrasingKind, NonInheritancePhrasing,
AnyRelationship String String)
-> String)
-> PhrasingKind
-> NonInheritancePhrasing
-> AnyRelationship String String
-> String
forall a b. (a -> b) -> a -> b
$ \case
(PhrasingKind
kind,NonInheritancePhrasing
_, Left InvalidInheritance {LimitedLinking String
invalidSubClass :: LimitedLinking String
invalidSuperClass :: LimitedLinking String
invalidSuperClass :: forall className relationshipName.
InvalidRelationship className relationshipName
-> LimitedLinking className
invalidSubClass :: forall className relationshipName.
InvalidRelationship className relationshipName
-> LimitedLinking className
..}) -> [iii|
#{vowelArticle article} inheritance
where #{linking invalidSubClass} inherits from #{linking invalidSuperClass}
and #{phraseParticipations
kind
(defaultedInheritance invalidSubClass)
(defaultedInheritance invalidSuperClass)
}
|]
(PhrasingKind
_, NonInheritancePhrasing
_, Right Inheritance {String
subClass :: String
superClass :: String
superClass :: forall className relationshipName.
Relationship className relationshipName -> className
subClass :: forall className relationshipName.
Relationship className relationshipName -> className
..}) -> [iii|
#{vowelArticle article} inheritance
where #{subClass} inherits from #{superClass}
|]
(PhrasingKind
_, NonInheritancePhrasing
ByName, Right Association {String
LimitedLinking String
associationName :: String
associationFrom :: LimitedLinking String
associationTo :: LimitedLinking String
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
..}) -> String
"association " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
associationName
(PhrasingKind
_, NonInheritancePhrasing
ByName, Right Aggregation {String
LimitedLinking String
aggregationName :: String
aggregationPart :: LimitedLinking String
aggregationWhole :: LimitedLinking String
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
..}) -> String
"aggregation " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
aggregationName
(PhrasingKind
_, NonInheritancePhrasing
ByName, Right Composition {String
LimitedLinking String
compositionName :: String
compositionPart :: LimitedLinking String
compositionWhole :: LimitedLinking String
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
..}) -> String
"composition " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
compositionName
(PhrasingKind
kind, NonInheritancePhrasing
how, Right Association {String
LimitedLinking String
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationName :: String
associationFrom :: LimitedLinking String
associationTo :: LimitedLinking String
..})
| DefaultedLimitedLinking
from <- LimitedLinking String -> DefaultedLimitedLinking
defaultedAssociation LimitedLinking String
associationFrom
, DefaultedLimitedLinking
to <- LimitedLinking String -> DefaultedLimitedLinking
defaultedAssociation LimitedLinking String
associationTo
-> case (NonInheritancePhrasing
how, PhrasingKind
kind, LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
associationFrom String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
associationTo) of
(NonInheritancePhrasing
Lengthy, PhrasingKind
Participations, Bool
True)
| DefaultedLimitedLinking
fromIt <- DefaultedLimitedLinking
from {defaultedLinking = "it"}
-> [iii|
#{consonantArticle article} self-association
for #{linking associationFrom}
where #{participates fromIt} at one end
and #{phraseLimitDefault $ defaultedLimits to} at the other end
|]
(NonInheritancePhrasing
Lengthy, PhrasingKind
Denoted, Bool
True)
| String
denoted <- (DefaultedLimitedLinking -> DefaultedLimitedLinking -> String)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
denotions
((DefaultedLimitedLinking, DefaultedLimitedLinking) -> String)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking) -> String
forall a b. (a -> b) -> a -> b
$ String
-> String
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
oneAndOther String
"one end" String
"the other end"
((DefaultedLimitedLinking, DefaultedLimitedLinking)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking))
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
forall a b. (a -> b) -> a -> b
$ DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
sortLimits DefaultedLimitedLinking
from DefaultedLimitedLinking
to
-> [iii|
#{consonantArticle article} self-association
for #{linking associationFrom} #{denoted}
|]
(NonInheritancePhrasing
Lengthy, PhrasingKind
_, Bool
False) -> [iii|
#{vowelArticle article} association
#{phraseParticipations kind from to}
|]
(NonInheritancePhrasing
ByDirection, PhrasingKind
Participations, Bool
True)
| DefaultedLimitedLinking
fromIt <- DefaultedLimitedLinking
from {defaultedLinking = "it"}
-> [iii|
#{consonantArticle article} self-association
for #{linking associationFrom}
where #{participates fromIt} at its beginning
and #{phraseLimitDefault $ defaultedLimits to} at its arrow end
|]
(NonInheritancePhrasing
ByDirection, PhrasingKind
Denoted, Bool
True)
| String
denoted <- (DefaultedLimitedLinking -> DefaultedLimitedLinking -> String)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
denotions
((DefaultedLimitedLinking, DefaultedLimitedLinking) -> String)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking) -> String
forall a b. (a -> b) -> a -> b
$ (DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> (DefaultedLimitedLinking, DefaultedLimitedLinking))
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
sortLimits
((DefaultedLimitedLinking, DefaultedLimitedLinking)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking))
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
forall a b. (a -> b) -> a -> b
$ String
-> String
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
oneAndOther String
"its beginning" String
"its arrow end" (DefaultedLimitedLinking
from, DefaultedLimitedLinking
to)
-> [iii|
#{consonantArticle article} self-association
for #{linking associationFrom} #{denoted}
|]
(NonInheritancePhrasing
ByDirection, PhrasingKind
_, Bool
False) -> [iii|
#{vowelArticle article} association from #{linking associationFrom}
to #{linking associationTo}
#{phraseParticipations kind from to}
|]
(PhrasingKind
kind, NonInheritancePhrasing
_, Right Aggregation {String
LimitedLinking String
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationName :: String
aggregationPart :: LimitedLinking String
aggregationWhole :: LimitedLinking String
..})
| DefaultedLimitedLinking
part <- LimitedLinking String -> DefaultedLimitedLinking
defaultedAssociation LimitedLinking String
aggregationPart
, DefaultedLimitedLinking
whole <- LimitedLinking String -> DefaultedLimitedLinking
defaultedAssociation LimitedLinking String
aggregationWhole
->
if LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
aggregationPart String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
aggregationWhole
then [iii|
#{consonantArticle article} self-aggregation
#{selfParticipatesPartWhole kind part whole}
|]
else [iii|
#{consonantArticle article} relationship
that makes #{linking aggregationWhole}
an aggregation of #{linking aggregationPart}s
#{phraseParticipations kind whole part}
|]
(PhrasingKind
kind, NonInheritancePhrasing
_, Right Composition {String
LimitedLinking String
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionName :: String
compositionPart :: LimitedLinking String
compositionWhole :: LimitedLinking String
..})
| DefaultedLimitedLinking
part <- LimitedLinking String -> DefaultedLimitedLinking
defaultedAssociation LimitedLinking String
compositionPart
, DefaultedLimitedLinking
whole <- LimitedLinking String -> DefaultedLimitedLinking
defaultedCompositionWhole LimitedLinking String
compositionWhole
->
if LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
compositionPart String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
compositionWhole
then [iii|
#{consonantArticle article} self-composition
#{selfParticipatesPartWhole kind part whole}
|]
else [iii|
#{consonantArticle article} relationship
that makes #{linking compositionWhole}
a composition of #{linking compositionPart}s
#{phraseParticipations kind whole part}
|]
where
defaultedCompositionWhole :: LimitedLinking String -> DefaultedLimitedLinking
defaultedCompositionWhole =
Maybe (Int, Maybe Int)
-> LimitedLinking String -> DefaultedLimitedLinking
defaultedLimitedLinking Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity
defaultedAssociation :: LimitedLinking String -> DefaultedLimitedLinking
defaultedAssociation =
Maybe (Int, Maybe Int)
-> LimitedLinking String -> DefaultedLimitedLinking
defaultedLimitedLinking Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity
defaultedInheritance :: LimitedLinking String -> DefaultedLimitedLinking
defaultedInheritance = Maybe (Int, Maybe Int)
-> LimitedLinking String -> DefaultedLimitedLinking
defaultedLimitedLinking Maybe (Int, Maybe Int)
forall a. Maybe a
Nothing
selfParticipatesPartWhole
:: PhrasingKind
-> DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> String
selfParticipatesPartWhole :: PhrasingKind
-> DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
selfParticipatesPartWhole PhrasingKind
Denoted DefaultedLimitedLinking
part DefaultedLimitedLinking
whole = [iii|
for #{defaultedLinking part}
#{which}
|]
where
which :: String
which = (DefaultedLimitedLinking -> DefaultedLimitedLinking -> String)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
denotions ((DefaultedLimitedLinking, DefaultedLimitedLinking) -> String)
-> (DefaultedLimitedLinking, DefaultedLimitedLinking) -> String
forall a b. (a -> b) -> a -> b
$ DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
sortLimits
DefaultedLimitedLinking
part {defaultedLinking = "its part end"}
DefaultedLimitedLinking
whole {defaultedLinking = "its whole end"}
selfParticipatesPartWhole PhrasingKind
Participations DefaultedLimitedLinking
part DefaultedLimitedLinking
whole = [iii|
for #{defaultedLinking part}
where #{participates partIt} as part
and #{phraseLimitDefault $ defaultedLimits whole} as whole
|]
where
partIt :: DefaultedLimitedLinking
partIt = DefaultedLimitedLinking
part {defaultedLinking = "it"}
phraseParticipations
:: PhrasingKind
-> DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> String
phraseParticipations :: PhrasingKind
-> DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
phraseParticipations = \case
PhrasingKind
Denoted -> DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
denotions
PhrasingKind
Participations -> DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
participations
denotions
:: DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> String
denotions :: DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
denotions DefaultedLimitedLinking
one DefaultedLimitedLinking
other = case (DefaultedLimitedLinking -> Maybe String
defaultedRange DefaultedLimitedLinking
one, DefaultedLimitedLinking -> Maybe String
defaultedRange DefaultedLimitedLinking
other) of
(Maybe String
Nothing, Maybe String
Nothing) -> [iii|which has not denoted multiplicities at all|]
(Maybe String
Nothing, Just String
otherRange) -> [iii|
which has no multiplicity denoted near #{defaultedLinking one}
and #{otherRange} near #{defaultedLinking other}
|]
(Just String
oneRange, Maybe String
Nothing) -> [iii|
which has no multiplicity denoted near #{defaultedLinking other}
and #{oneRange} near #{defaultedLinking one}
|]
(Just String
oneRange, Just String
otherRange) -> [iii|
which has denoted the multiplicity
#{oneRange} near #{defaultedLinking one}
and #{otherRange} near #{defaultedLinking other}
|]
participations
:: DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> String
participations :: DefaultedLimitedLinking -> DefaultedLimitedLinking -> String
participations DefaultedLimitedLinking
one DefaultedLimitedLinking
other = [iii|
where #{participates one}
and #{participates other}
|]
participates :: DefaultedLimitedLinking -> String
participates :: DefaultedLimitedLinking -> String
participates DefaultedLimitedLinking {String
Maybe String
Maybe (Int, Maybe Int)
defaultedLinking :: DefaultedLimitedLinking -> String
defaultedLimits :: DefaultedLimitedLinking -> Maybe (Int, Maybe Int)
defaultedRange :: DefaultedLimitedLinking -> Maybe String
defaultedLimits :: Maybe (Int, Maybe Int)
defaultedRange :: Maybe String
defaultedLinking :: String
..}
= String
defaultedLinking String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" participates "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe (Int, Maybe Int) -> String
phraseLimitDefault Maybe (Int, Maybe Int)
defaultedLimits
phraseLimitDefault :: Maybe (Int, Maybe Int) -> String
phraseLimitDefault :: Maybe (Int, Maybe Int) -> String
phraseLimitDefault = String
-> ((Int, Maybe Int) -> String) -> Maybe (Int, Maybe Int) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"with the default multiplicity" (Int, Maybe Int) -> String
phraseLimit
phraseLimit :: (Int, Maybe Int) -> String
phraseLimit :: (Int, Maybe Int) -> String
phraseLimit (Int
0, Just Int
0) = String
"not at all"
phraseLimit (Int
1, Just Int
1) = String
"exactly once"
phraseLimit (Int
2, Just Int
2) = String
"exactly twice"
phraseLimit (-1, Just Int
n) = String
"*.." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" times"
phraseLimit (Int
m, Maybe Int
Nothing) = Int -> String
forall a. Show a => a -> String
show Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..* times"
phraseLimit (Int
m, Just Int
n) = Int -> String
forall a. Show a => a -> String
show Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" times"