    {-# LANGUAGE DeriveGeneric #-}
    -- | Simple English clause creation parameterized by individual words.
    -- See the tests for example texts generated.
    module NLP.Miniutter.English
      ( Part(..), Person(..), Polarity(..), Irregular(..)
      , makeSentence, makePhrase, defIrregular, (<+>)
      ) where

    import           Data.Binary
    import           Data.Char (isAlphaNum, isSpace, toUpper)
    import           Data.Map (Map)
    import qualified Data.Map as Map
    import           Data.String (IsString (..))
    import           Data.Text (Text)
    import qualified Data.Text as T
    import           GHC.Generics (Generic)
    import           NLP.Minimorph.English
    import           NLP.Minimorph.Util

    #if !(MIN_VERSION_base(4,11,0))
      -- this is redundant starting with base-4.11 / GHC 8.4
    import Data.Semigroup
    #endif

    -- | Various basic and compound parts of English simple present tense clauses.
    -- Many of the possible nestings do not make sense. We don't care.
    data Part =
        String !String      -- ^ handle for a @String@ parameter
      | Text !Text          -- ^ handle for a @Text@ parameter
      | Cardinal !Int       -- ^ cardinal number, spelled in full up to 10
      | Car !Int            -- ^ cardinal number, not spelled
      | Ws !Part            -- ^ plural form of a phrase
      | CardinalAWs !Int !Part
                            -- ^ plural prefixed with a cardinal, spelled,
                            --   with \"a\" for 1 and \"no\" for 0
      | CardinalWs !Int !Part
                            -- ^ plural prefixed with a cardinal, spelled
      | CarAWs !Int !Part   -- ^ plural prefixed with a cardinal, not spelled,
                            --   with \"a\" for 1 and \"no\" for 0
      | CarWs !Int !Part    -- ^ plural prefixed with a cardinal, not spelled
      | Car1Ws !Int !Part   -- ^ plural prefixed with a cardinal, not spelled,
                            --   with no prefix at all for 1
      | Ordinal !Int        -- ^ ordinal number, spelled in full up to 10
      | Ord !Int            -- ^ ordinal number, not spelled
      | AW !Part            -- ^ phrase with indefinite article
      | WWandW ![Part]      -- ^ enumeration
      | WWxW !Part ![Part]  -- ^ collection
      | Wown !Part          -- ^ non-premodifying possesive
      | WownW !Part !Part   -- ^ attributive possesive
      | Append !Part !Part  -- ^ no space in between; one can also just use @<>@
      | Phrase ![Part]      -- ^ space-separated sequence
      | Capitalize !Part    -- ^ make the first letter into a capital letter
      | SubjectVerb !Person !Polarity !Part !Part
                            -- ^ conjugation according to polarity,
                            --   with a default person (pronouns override it)
      | SubjectVerbSg !Part !Part
                            -- ^ a shorthand for @Sg3rd@ and @Yes@
      | SubjectVVxV !Part !Person !Polarity !Part ![Part]
                            -- ^ conjugation of all verbs according to polarity,
                            --   with a default person (pronouns override it)
      | SubjectVVandVSg !Part ![Part]
                            -- ^ a shorthand for \"and\", @Sg3rd@ and @Yes@
      deriving (Int -> Part -> ShowS
    [Part] -> ShowS
    Part -> String
    (Int -> Part -> ShowS)
    -> (Part -> String) -> ([Part] -> ShowS) -> Show Part
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Part -> ShowS
    showsPrec :: Int -> Part -> ShowS
    $cshow :: Part -> String
    show :: Part -> String
    $cshowList :: [Part] -> ShowS
    showList :: [Part] -> ShowS
    Show, Part -> Part -> Bool
    (Part -> Part -> Bool) -> (Part -> Part -> Bool) -> Eq Part
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Part -> Part -> Bool
    == :: Part -> Part -> Bool
    $c/= :: Part -> Part -> Bool
    /= :: Part -> Part -> Bool
    Eq, Eq Part
    Eq Part =>
    (Part -> Part -> Ordering)
    -> (Part -> Part -> Bool)
    -> (Part -> Part -> Bool)
    -> (Part -> Part -> Bool)
    -> (Part -> Part -> Bool)
    -> (Part -> Part -> Part)
    -> (Part -> Part -> Part)
    -> Ord Part
    Part -> Part -> Bool
    Part -> Part -> Ordering
    Part -> Part -> Part
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Part -> Part -> Ordering
    compare :: Part -> Part -> Ordering
    $c< :: Part -> Part -> Bool
    < :: Part -> Part -> Bool
    $c<= :: Part -> Part -> Bool
    <= :: Part -> Part -> Bool
    $c> :: Part -> Part -> Bool
    > :: Part -> Part -> Bool
    $c>= :: Part -> Part -> Bool
    >= :: Part -> Part -> Bool
    $cmax :: Part -> Part -> Part
    max :: Part -> Part -> Part
    $cmin :: Part -> Part -> Part
    min :: Part -> Part -> Part
    Ord, (forall x. Part -> Rep Part x)
    -> (forall x. Rep Part x -> Part) -> Generic Part
    forall x. Rep Part x -> Part
    forall x. Part -> Rep Part x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Part -> Rep Part x
    from :: forall x. Part -> Rep Part x
    $cto :: forall x. Rep Part x -> Part
    to :: forall x. Rep Part x -> Part
    Generic)

    instance Binary Part

    instance Read Part where
      readsPrec :: Int -> ReadS Part
    readsPrec Int
    p String
    str = [(Text -> Part
    Text Text
    x, String
    y) | (Text
    x, String
    y) <- Int -> ReadS Text
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    p String
    str]

    instance IsString Part where
      fromString :: String -> Part
    fromString = Text -> Part
    Text (Text -> Part) -> (String -> Text) -> String -> Part
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack

    instance Semigroup Part where
      <> :: Part -> Part -> Part
    (<>) = Part -> Part -> Part
    Append

    instance Monoid Part where
      mempty :: Part
    mempty = Text -> Part
    Text Text
    ""

    #if !(MIN_VERSION_base(4,11,0))
      -- this is redundant starting with base-4.11 / GHC 8.4
      mappend = (<>)
    #endif

    -- | Persons: singular 1st, singular 3rd and the rest.
    data Person = Sg1st | Sg3rd | PlEtc
      deriving (Int -> Person -> ShowS
    [Person] -> ShowS
    Person -> String
    (Int -> Person -> ShowS)
    -> (Person -> String) -> ([Person] -> ShowS) -> Show Person
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Person -> ShowS
    showsPrec :: Int -> Person -> ShowS
    $cshow :: Person -> String
    show :: Person -> String
    $cshowList :: [Person] -> ShowS
    showList :: [Person] -> ShowS
    Show, Person -> Person -> Bool
    (Person -> Person -> Bool)
    -> (Person -> Person -> Bool) -> Eq Person
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Person -> Person -> Bool
    == :: Person -> Person -> Bool
    $c/= :: Person -> Person -> Bool
    /= :: Person -> Person -> Bool
    Eq, Eq Person
    Eq Person =>
    (Person -> Person -> Ordering)
    -> (Person -> Person -> Bool)
    -> (Person -> Person -> Bool)
    -> (Person -> Person -> Bool)
    -> (Person -> Person -> Bool)
    -> (Person -> Person -> Person)
    -> (Person -> Person -> Person)
    -> Ord Person
    Person -> Person -> Bool
    Person -> Person -> Ordering
    Person -> Person -> Person
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Person -> Person -> Ordering
    compare :: Person -> Person -> Ordering
    $c< :: Person -> Person -> Bool
    < :: Person -> Person -> Bool
    $c<= :: Person -> Person -> Bool
    <= :: Person -> Person -> Bool
    $c> :: Person -> Person -> Bool
    > :: Person -> Person -> Bool
    $c>= :: Person -> Person -> Bool
    >= :: Person -> Person -> Bool
    $cmax :: Person -> Person -> Person
    max :: Person -> Person -> Person
    $cmin :: Person -> Person -> Person
    min :: Person -> Person -> Person
    Ord, (forall x. Person -> Rep Person x)
    -> (forall x. Rep Person x -> Person) -> Generic Person
    forall x. Rep Person x -> Person
    forall x. Person -> Rep Person x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Person -> Rep Person x
    from :: forall x. Person -> Rep Person x
    $cto :: forall x. Rep Person x -> Person
    to :: forall x. Rep Person x -> Person
    Generic)

    instance Binary Person

    -- | Generalized polarity: affirmative, negative, interrogative.
    data Polarity = Yes | No | Why
      deriving (Int -> Polarity -> ShowS
    [Polarity] -> ShowS
    Polarity -> String
    (Int -> Polarity -> ShowS)
    -> (Polarity -> String) -> ([Polarity] -> ShowS) -> Show Polarity
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Polarity -> ShowS
    showsPrec :: Int -> Polarity -> ShowS
    $cshow :: Polarity -> String
    show :: Polarity -> String
    $cshowList :: [Polarity] -> ShowS
    showList :: [Polarity] -> ShowS
    Show, Polarity -> Polarity -> Bool
    (Polarity -> Polarity -> Bool)
    -> (Polarity -> Polarity -> Bool) -> Eq Polarity
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Polarity -> Polarity -> Bool
    == :: Polarity -> Polarity -> Bool
    $c/= :: Polarity -> Polarity -> Bool
    /= :: Polarity -> Polarity -> Bool
    Eq, Eq Polarity
    Eq Polarity =>
    (Polarity -> Polarity -> Ordering)
    -> (Polarity -> Polarity -> Bool)
    -> (Polarity -> Polarity -> Bool)
    -> (Polarity -> Polarity -> Bool)
    -> (Polarity -> Polarity -> Bool)
    -> (Polarity -> Polarity -> Polarity)
    -> (Polarity -> Polarity -> Polarity)
    -> Ord Polarity
    Polarity -> Polarity -> Bool
    Polarity -> Polarity -> Ordering
    Polarity -> Polarity -> Polarity
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Polarity -> Polarity -> Ordering
    compare :: Polarity -> Polarity -> Ordering
    $c< :: Polarity -> Polarity -> Bool
    < :: Polarity -> Polarity -> Bool
    $c<= :: Polarity -> Polarity -> Bool
    <= :: Polarity -> Polarity -> Bool
    $c> :: Polarity -> Polarity -> Bool
    > :: Polarity -> Polarity -> Bool
    $c>= :: Polarity -> Polarity -> Bool
    >= :: Polarity -> Polarity -> Bool
    $cmax :: Polarity -> Polarity -> Polarity
    max :: Polarity -> Polarity -> Polarity
    $cmin :: Polarity -> Polarity -> Polarity
    min :: Polarity -> Polarity -> Polarity
    Ord, (forall x. Polarity -> Rep Polarity x)
    -> (forall x. Rep Polarity x -> Polarity) -> Generic Polarity
    forall x. Rep Polarity x -> Polarity
    forall x. Polarity -> Rep Polarity x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Polarity -> Rep Polarity x
    from :: forall x. Polarity -> Rep Polarity x
    $cto :: forall x. Rep Polarity x -> Polarity
    to :: forall x. Rep Polarity x -> Polarity
    Generic)

    instance Binary Polarity

    -- | Nouns with irregular plural form and nouns with irregular indefinite
    -- article.
    data Irregular = Irregular
      { Irregular -> Map Text Text
    irrPlural     :: Map Text Text
      , Irregular -> Map Text Text
    irrIndefinite :: Map Text Text
      }

    -- | Default set of words with irregular forms.
    defIrregular :: Irregular
    defIrregular :: Irregular
    defIrregular =
      Irregular {irrPlural :: Map Text Text
    irrPlural = Map Text Text
    defIrrPlural, irrIndefinite :: Map Text Text
    irrIndefinite = Map Text Text
    defIrrIndefinite}

    -- | Realise a complete sentence, capitalized, ending with a dot.
    makeSentence :: Irregular -> [Part] -> Text
    makeSentence :: Irregular -> [Part] -> Text
    makeSentence Irregular
    irr [Part]
    l = Text -> Text
    capitalize (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Irregular -> [Part] -> Text
    makePhrase Irregular
    irr [Part]
    l Text -> Char -> Text
    `T.snoc` Char
    '.'

    -- | Realise a phrase. The spacing between parts resembles
    -- the semantics of @(\<\+\>)@, that is, it ignores empty words.
    makePhrase :: Irregular -> [Part] -> Text
    makePhrase :: Irregular -> [Part] -> Text
    makePhrase Irregular
    irr = Text -> [Text] -> Text
    T.intercalate (Char -> Text
    T.singleton Char
    ' ') ([Text] -> Text) -> ([Part] -> [Text]) -> [Part] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Irregular -> [Part] -> [Text]
    makeParts Irregular
    irr

    makeParts :: Irregular -> [Part] -> [Text]
    makeParts :: Irregular -> [Part] -> [Text]
    makeParts Irregular
    irr = (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Bool
    T.null) ([Text] -> [Text]) -> ([Part] -> [Text]) -> [Part] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Part -> Text) -> [Part] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Irregular -> Part -> Text
    makePart Irregular
    irr)

    -- The semantics of the operations is compositional.
    makePart :: Irregular -> Part -> Text
    makePart :: Irregular -> Part -> Text
    makePart Irregular
    irr Part
    part = case Part
    part of
      String String
    t -> String -> Text
    T.pack String
    t
      Text Text
    t -> Text
    t
      Cardinal Int
    n -> Int -> Text
    cardinal Int
    n
      Car Int
    n -> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n
      Ws Part
    p -> (Text -> Text) -> Text -> Text
    onLastWord (Irregular -> Text -> Text
    makePlural Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      CardinalAWs Int
    0 Part
    p -> Text
    "no" Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onLastWord (Irregular -> Text -> Text
    makePlural Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      CardinalAWs Int
    1 Part
    p -> Part -> Text
    mkPart (Part -> Part
    AW Part
    p)
      CardinalAWs Int
    n Part
    p -> Int -> Text
    cardinal Int
    n Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onLastWord (Irregular -> Text -> Text
    makePlural Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      CardinalWs Int
    1 Part
    p -> Int -> Text
    cardinal Int
    1 Text -> Text -> Text
    <+> Part -> Text
    mkPart Part
    p  -- spelled number
      CardinalWs Int
    n Part
    p -> Int -> Text
    cardinal Int
    n Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onLastWord (Irregular -> Text -> Text
    makePlural Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      CarAWs Int
    0 Part
    p -> Text
    "no" Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onLastWord (Irregular -> Text -> Text
    makePlural Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      CarAWs Int
    1 Part
    p -> Part -> Text
    mkPart (Part -> Part
    AW Part
    p)
      CarAWs Int
    n Part
    p -> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onLastWord (Irregular -> Text -> Text
    makePlural Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      CarWs Int
    1 Part
    p -> Text
    "1" Text -> Text -> Text
    <+> Part -> Text
    mkPart Part
    p
      CarWs Int
    n Part
    p -> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onLastWord (Irregular -> Text -> Text
    makePlural Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      Car1Ws Int
    1 Part
    p -> Part -> Text
    mkPart Part
    p  -- no number, article, anything; useful
      Car1Ws Int
    n Part
    p -> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onLastWord (Irregular -> Text -> Text
    makePlural Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      Ordinal Int
    n -> Int -> Text
    ordinal Int
    n
      Ord Int
    n -> Int -> Text
    ordinalNotSpelled Int
    n
      AW Part
    p -> (Text -> Text) -> Text -> Text
    onFirstWord (Irregular -> Text -> Text
    addIndefinite Irregular
    irr) (Part -> Text
    mkPart Part
    p)
      WWandW [Part]
    lp -> let i :: Text
    i = Text
    "and" :: Text
                       lt :: [Text]
    lt = Irregular -> [Part] -> [Text]
    makeParts Irregular
    irr [Part]
    lp
                   in Text -> [Text] -> Text
    commas Text
    i [Text]
    lt
      WWxW Part
    x [Part]
    lp -> let i :: Text
    i = Part -> Text
    mkPart Part
    x
                       lt :: [Text]
    lt = Irregular -> [Part] -> [Text]
    makeParts Irregular
    irr [Part]
    lp
                   in Text -> [Text] -> Text
    commas Text
    i [Text]
    lt
      Wown Part
    p -> (Text -> Text) -> Text -> Text
    onLastWord Text -> Text
    nonPremodifying (Part -> Text
    mkPart Part
    p)
      WownW Part
    p1 Part
    p2 -> (Text -> Text) -> Text -> Text
    onLastWord Text -> Text
    attributive (Part -> Text
    mkPart Part
    p1) Text -> Text -> Text
    <+> Part -> Text
    mkPart Part
    p2
      Phrase [Part]
    lp -> Irregular -> [Part] -> Text
    makePhrase Irregular
    irr [Part]
    lp
      Append Part
    p1 Part
    p2 -> Part -> Text
    mkPart Part
    p1 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Part -> Text
    mkPart Part
    p2
      Capitalize Part
    p -> Text -> Text
    capitalize (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Part -> Text
    mkPart Part
    p
      SubjectVerb Person
    defaultPerson Polarity
    Yes Part
    s Part
    v ->
        Person -> Text -> Text -> Text
    subjectVerb Person
    defaultPerson (Part -> Text
    mkPart Part
    s) (Part -> Text
    mkPart Part
    v)
      SubjectVerb Person
    defaultPerson Polarity
    No Part
    s Part
    v ->
        Person -> Text -> Text -> Text
    notSubjectVerb Person
    defaultPerson (Part -> Text
    mkPart Part
    s) (Part -> Text
    mkPart Part
    v)
      SubjectVerb Person
    defaultPerson Polarity
    Why Part
    s Part
    v ->
        Person -> Text -> Text -> Text
    qSubjectVerb Person
    defaultPerson (Part -> Text
    mkPart Part
    s) (Part -> Text
    mkPart Part
    v)
      SubjectVerbSg Part
    s Part
    v ->
        Person -> Text -> Text -> Text
    subjectVerb Person
    Sg3rd (Part -> Text
    mkPart Part
    s) (Part -> Text
    mkPart Part
    v)
      SubjectVVxV Part
    x Person
    defaultPerson Polarity
    Yes Part
    s [Part]
    vs ->
        Text -> Person -> Text -> [Text] -> Text
    subjectVVxV (Part -> Text
    mkPart Part
    x) Person
    defaultPerson (Part -> Text
    mkPart Part
    s) (Irregular -> [Part] -> [Text]
    makeParts Irregular
    irr [Part]
    vs)
      SubjectVVxV Part
    x Person
    defaultPerson Polarity
    No Part
    s [Part]
    vs ->
        Text -> Person -> Text -> [Text] -> Text
    notSubjectVVxV (Part -> Text
    mkPart Part
    x) Person
    defaultPerson (Part -> Text
    mkPart Part
    s) (Irregular -> [Part] -> [Text]
    makeParts Irregular
    irr [Part]
    vs)
      SubjectVVxV Part
    x Person
    defaultPerson Polarity
    Why Part
    s [Part]
    vs ->
        Text -> Person -> Text -> [Text] -> Text
    qSubjectVVxV (Part -> Text
    mkPart Part
    x) Person
    defaultPerson (Part -> Text
    mkPart Part
    s) (Irregular -> [Part] -> [Text]
    makeParts Irregular
    irr [Part]
    vs)
      SubjectVVandVSg Part
    s [Part]
    vs ->
        Text -> Person -> Text -> [Text] -> Text
    subjectVVxV Text
    "and" Person
    Sg3rd (Part -> Text
    mkPart Part
    s) (Irregular -> [Part] -> [Text]
    makeParts Irregular
    irr [Part]
    vs)
     where
      mkPart :: Part -> Text
    mkPart = Irregular -> Part -> Text
    makePart Irregular
    irr

    onFirstWord :: (Text -> Text) -> Text -> Text
    onFirstWord :: (Text -> Text) -> Text -> Text
    onFirstWord Text -> Text
    f Text
    t =
      let (Text
    starting, Text
    restRaw) = (Char -> Bool) -> Text -> (Text, Text)
    T.span Char -> Bool
    isWordLetter Text
    t
          rest :: Text
    rest = (Char -> Bool) -> Text -> Text
    T.dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isWordLetter) Text
    restRaw
          fstarting :: Text
    fstarting = Text -> Text
    f Text
    starting
      in if Text -> Bool
    T.null Text
    starting
         then Text
    t
         else if Text -> Bool
    T.null Text
    fstarting
              then Text
    rest
              else Text -> Text
    f Text
    starting Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    restRaw

    onLastWord :: (Text -> Text) -> Text -> Text
    onLastWord :: (Text -> Text) -> Text -> Text
    onLastWord Text -> Text
    f Text
    t =
      -- First ignore (and append afterwards) a suffix composed not of possible
      -- word letters and also of any trailing whitespace. We don't want
      -- to pluralise whitespace nor symbols, but neither to lose them.
      let (Text
    wordPrefix, Text
    nonWordSuffix) =
            let (Text
    wordP, Text
    nonWordP) = (Char -> Bool) -> Text -> (Text, Text)
    T.span (\Char
    c -> Char -> Bool
    isWordLetter Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isSpace Char
    c) Text
    t
                (Text
    wordSpaceR, Text
    wordRestR) = (Char -> Bool) -> Text -> (Text, Text)
    T.span Char -> Bool
    isSpace (Text -> (Text, Text)) -> Text -> (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.reverse Text
    wordP
            in (Text -> Text
    T.reverse Text
    wordRestR, Text -> Text
    T.reverse Text
    wordSpaceR Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    nonWordP)
          (Text
    spanPrefix, Text
    spanRest) = (Char -> Bool) -> Text -> (Text, Text)
    T.span Char -> Bool
    isWordLetter (Text -> (Text, Text)) -> Text -> (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.reverse Text
    wordPrefix
          (Text
    ending, Text
    restRaw) = (Text -> Text
    T.reverse Text
    spanPrefix, Text -> Text
    T.reverse Text
    spanRest)
          rest :: Text
    rest = (Char -> Bool) -> Text -> Text
    T.dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isWordLetter) Text
    restRaw
          fending :: Text
    fending = Text -> Text
    f Text
    ending
          onLast :: Text
    onLast = if Text -> Bool
    T.null Text
    ending
                   then Text
    wordPrefix
                   else if Text -> Bool
    T.null Text
    fending
                        then Text
    rest
                        else Text
    restRaw Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    f Text
    ending
      in Text
    onLast Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    nonWordSuffix

    onFirstWordPair :: (Text -> (Text, Text)) -> Text -> (Text, Text)
    onFirstWordPair :: (Text -> (Text, Text)) -> Text -> (Text, Text)
    onFirstWordPair Text -> (Text, Text)
    f Text
    t =
      let (Text
    starting, Text
    restRaw) = (Char -> Bool) -> Text -> (Text, Text)
    T.span Char -> Bool
    isWordLetter Text
    t
          rest :: Text
    rest = (Char -> Bool) -> Text -> Text
    T.dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isWordLetter) Text
    restRaw
          (Text
    t1, Text
    t2) = Text -> (Text, Text)
    f Text
    starting
      in if Text -> Bool
    T.null Text
    starting
         then (Text
    t, Text
    "")
         else if Text -> Bool
    T.null Text
    t2
              then (Text
    t1, Text
    rest)
              else (Text
    t1, Text
    t2 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    restRaw)

    isWordLetter :: Char -> Bool
    isWordLetter :: Char -> Bool
    isWordLetter Char
    c = Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\'' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-'

    capitalize :: Text -> Text
    capitalize :: Text -> Text
    capitalize Text
    t = case Text -> Maybe (Char, Text)
    T.uncons Text
    t of
      Maybe (Char, Text)
    Nothing        -> Text
    T.empty
      Just (Char
    c, Text
    rest) -> Char -> Text -> Text
    T.cons (Char -> Char
    toUpper Char
    c) Text
    rest

    makePlural :: Irregular -> Text -> Text
    makePlural :: Irregular -> Text -> Text
    makePlural Irregular{Map Text Text
    irrPlural :: Irregular -> Map Text Text
    irrPlural :: Map Text Text
    irrPlural} Text
    t =
      case Text -> Map Text Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    t Map Text Text
    irrPlural of
        Just Text
    u  -> Text
    u
        Maybe Text
    Nothing -> Text -> Text
    defaultNounPlural Text
    t

    addIndefinite :: Irregular -> Text -> Text
    addIndefinite :: Irregular -> Text -> Text
    addIndefinite Irregular{Map Text Text
    irrIndefinite :: Irregular -> Map Text Text
    irrIndefinite :: Map Text Text
    irrIndefinite} Text
    t =
      case Text -> Map Text Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    t Map Text Text
    irrIndefinite of
        Just Text
    u  -> Text
    u Text -> Text -> Text
    <+> Text
    t
        Maybe Text
    Nothing -> Text -> Text
    indefiniteDet Text
    t Text -> Text -> Text
    <+> Text
    t

    guessPerson :: Person -> Text -> Person
    guessPerson :: Person -> Text -> Person
    guessPerson Person
    defaultPerson Text
    "i" = Person
    defaultPerson  -- letter 'i', not person 'I'
    guessPerson Person
    defaultPerson Text
    word =
      case Text -> Text
    T.toLower Text
    word of
        Text
    "i"    -> Person
    Sg1st
        Text
    "he"   -> Person
    Sg3rd
        Text
    "she"  -> Person
    Sg3rd
        Text
    "it"   -> Person
    Sg3rd
        Text
    "we"   -> Person
    PlEtc
        Text
    "you"  -> Person
    PlEtc
        Text
    "they" -> Person
    PlEtc
        Text
    _      -> Person
    defaultPerson -- we don't try guessing beyond pronouns

    personVerb :: Person -> Text -> Text
    personVerb :: Person -> Text -> Text
    personVerb Person
    Sg1st Text
    "be" = Text
    "am"
    personVerb Person
    PlEtc Text
    "be" = Text
    "are"
    personVerb Person
    Sg3rd Text
    "be" = Text
    "is"
    personVerb Person
    _ Text
    "can"    = Text
    "can"
    personVerb Person
    _ Text
    "could"  = Text
    "could"
    personVerb Person
    _ Text
    "must"   = Text
    "must"
    personVerb Person
    _ Text
    "will"   = Text
    "will"
    personVerb Person
    _ Text
    "would"  = Text
    "would"
    personVerb Person
    _ Text
    "shall"  = Text
    "shall"
    personVerb Person
    _ Text
    "should" = Text
    "should"
    personVerb Person
    _ Text
    "ought"  = Text
    "ought"
    personVerb Person
    _ Text
    "may"    = Text
    "may"
    personVerb Person
    _ Text
    "might"  = Text
    "might"
    personVerb Person
    _ Text
    "had"    = Text
    "had"
    personVerb Person
    Sg1st Text
    v = Text
    v
    personVerb Person
    PlEtc Text
    v = Text
    v
    personVerb Person
    Sg3rd Text
    "have" = Text
    "has"
    personVerb Person
    Sg3rd Text
    v = (Text, Text) -> Text
    forall a b. (a, b) -> a
    fst (Text -> (Text, Text)
    defaultVerbStuff Text
    v)

    subjectVerb :: Person -> Text -> Text -> Text
    subjectVerb :: Person -> Text -> Text -> Text
    subjectVerb Person
    defaultPerson Text
    s Text
    v =
      Text
    s Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onFirstWord (Person -> Text -> Text
    personVerb (Person -> Text -> Text) -> Person -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Person -> Text -> Person
    guessPerson Person
    defaultPerson Text
    s) Text
    v

    subjectVVxV :: Text -> Person -> Text -> [Text] -> Text
    subjectVVxV :: Text -> Person -> Text -> [Text] -> Text
    subjectVVxV Text
    x Person
    defaultPerson Text
    s [Text]
    vs =
      let conjugate :: Text -> Text
    conjugate = (Text -> Text) -> Text -> Text
    onFirstWord (Person -> Text -> Text
    personVerb (Person -> Text -> Text) -> Person -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Person -> Text -> Person
    guessPerson Person
    defaultPerson Text
    s)
      in Text
    s Text -> Text -> Text
    <+> Text -> [Text] -> Text
    commas Text
    x ((Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    conjugate [Text]
    vs)

    notPersonVerb :: Person -> Text -> Text
    notPersonVerb :: Person -> Text -> Text
    notPersonVerb Person
    Sg1st Text
    "be" = Text
    "am not"
    notPersonVerb Person
    PlEtc Text
    "be" = Text
    "aren't"
    notPersonVerb Person
    Sg3rd Text
    "be" = Text
    "isn't"
    notPersonVerb Person
    _ Text
    "can"    = Text
    "can't"
    notPersonVerb Person
    _ Text
    "could"  = Text
    "couldn't"
    notPersonVerb Person
    _ Text
    "must"   = Text
    "mustn't"
    notPersonVerb Person
    _ Text
    "will"   = Text
    "won't"
    notPersonVerb Person
    _ Text
    "would"  = Text
    "wouldn't"
    notPersonVerb Person
    _ Text
    "shall"  = Text
    "shan't"
    notPersonVerb Person
    _ Text
    "should" = Text
    "shouldn't"
    notPersonVerb Person
    _ Text
    "ought"  = Text
    "oughtn't"
    notPersonVerb Person
    _ Text
    "may"    = Text
    "may not"
    notPersonVerb Person
    _ Text
    "might"  = Text
    "might not"
    notPersonVerb Person
    _ Text
    "had"    = Text
    "hadn't"
    notPersonVerb Person
    Sg1st Text
    v = Text
    "don't" Text -> Text -> Text
    <+> Text
    v
    notPersonVerb Person
    PlEtc Text
    v = Text
    "don't" Text -> Text -> Text
    <+> Text
    v
    notPersonVerb Person
    Sg3rd Text
    v = Text
    "doesn't" Text -> Text -> Text
    <+> Text
    v

    notSubjectVerb :: Person -> Text -> Text -> Text
    notSubjectVerb :: Person -> Text -> Text -> Text
    notSubjectVerb Person
    defaultPerson Text
    s Text
    v =
      Text
    s Text -> Text -> Text
    <+> (Text -> Text) -> Text -> Text
    onFirstWord (Person -> Text -> Text
    notPersonVerb (Person -> Text -> Text) -> Person -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Person -> Text -> Person
    guessPerson Person
    defaultPerson Text
    s) Text
    v

    notSubjectVVxV :: Text -> Person -> Text -> [Text] -> Text
    notSubjectVVxV :: Text -> Person -> Text -> [Text] -> Text
    notSubjectVVxV Text
    _ Person
    _ Text
    s [] = Text
    s
    notSubjectVVxV Text
    x Person
    defaultPerson Text
    s (Text
    v : [Text]
    vs) =
      let vNot :: Text
    vNot = (Text -> Text) -> Text -> Text
    onFirstWord (Person -> Text -> Text
    notPersonVerb (Person -> Text -> Text) -> Person -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Person -> Text -> Person
    guessPerson Person
    defaultPerson Text
    s) Text
    v
      in Text
    s Text -> Text -> Text
    <+> Text -> [Text] -> Text
    commas Text
    x (Text
    vNot Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    vs)

    qPersonVerb :: Person -> Text -> (Text, Text)
    qPersonVerb :: Person -> Text -> (Text, Text)
    qPersonVerb Person
    Sg1st Text
    "be" = (Text
    "am", Text
    "")
    qPersonVerb Person
    PlEtc Text
    "be" = (Text
    "are", Text
    "")
    qPersonVerb Person
    Sg3rd Text
    "be" = (Text
    "is", Text
    "")
    qPersonVerb Person
    _ Text
    "can"    = (Text
    "can", Text
    "")
    qPersonVerb Person
    _ Text
    "could"  = (Text
    "could", Text
    "")
    qPersonVerb Person
    _ Text
    "must"   = (Text
    "must", Text
    "")
    qPersonVerb Person
    _ Text
    "will"   = (Text
    "will", Text
    "")
    qPersonVerb Person
    _ Text
    "would"  = (Text
    "would", Text
    "")
    qPersonVerb Person
    _ Text
    "shall"  = (Text
    "shall", Text
    "")
    qPersonVerb Person
    _ Text
    "should" = (Text
    "should", Text
    "")
    qPersonVerb Person
    _ Text
    "ought"  = (Text
    "ought", Text
    "")
    qPersonVerb Person
    _ Text
    "may"    = (Text
    "may", Text
    "")
    qPersonVerb Person
    _ Text
    "might"  = (Text
    "might", Text
    "")
    qPersonVerb Person
    _ Text
    "had"    = (Text
    "had", Text
    "")
    qPersonVerb Person
    Sg1st Text
    v = (Text
    "do", Text
    v)
    qPersonVerb Person
    PlEtc Text
    v = (Text
    "do", Text
    v)
    qPersonVerb Person
    Sg3rd Text
    v = (Text
    "does", Text
    v)

    qSubjectVerb :: Person -> Text -> Text -> Text
    qSubjectVerb :: Person -> Text -> Text -> Text
    qSubjectVerb Person
    defaultPerson Text
    s Text
    v =
      let (Text
    v1, Text
    v2) = (Text -> (Text, Text)) -> Text -> (Text, Text)
    onFirstWordPair (Person -> Text -> (Text, Text)
    qPersonVerb (Person -> Text -> (Text, Text)) -> Person -> Text -> (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ Person -> Text -> Person
    guessPerson Person
    defaultPerson Text
    s) Text
    v
      in Text
    v1 Text -> Text -> Text
    <+> Text
    s Text -> Text -> Text
    <+> Text
    v2

    qSubjectVVxV :: Text -> Person -> Text -> [Text] -> Text
    qSubjectVVxV :: Text -> Person -> Text -> [Text] -> Text
    qSubjectVVxV Text
    _ Person
    _ Text
    s [] = Text
    s
    qSubjectVVxV Text
    x Person
    defaultPerson Text
    s (Text
    v : [Text]
    vs) =
      let (Text
    v1, Text
    v2) = (Text -> (Text, Text)) -> Text -> (Text, Text)
    onFirstWordPair (Person -> Text -> (Text, Text)
    qPersonVerb (Person -> Text -> (Text, Text)) -> Person -> Text -> (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ Person -> Text -> Person
    guessPerson Person
    defaultPerson Text
    s) Text
    v
          glue :: Text -> Text -> Text
    glue = if Text -> Bool
    T.null Text
    v2 then Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    (<>) else Text -> Text -> Text
    (<+>)
      in Text
    v1 Text -> Text -> Text
    <+> Text
    s Text -> Text -> Text
    `glue` Text -> [Text] -> Text
    commas Text
    x (Text
    v2 Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    vs)

    nonPremodifying :: Text -> Text
    nonPremodifying :: Text -> Text
    nonPremodifying Text
    "who"  = Text
    "whose"
    nonPremodifying Text
    "Who"  = Text
    "Whose"
    nonPremodifying Text
    "I"    = Text
    "mine"
    nonPremodifying Text
    "you"  = Text
    "yours"
    nonPremodifying Text
    "You"  = Text
    "Yours"
    nonPremodifying Text
    "he"   = Text
    "his"
    nonPremodifying Text
    "He"   = Text
    "His"
    nonPremodifying Text
    "she"  = Text
    "her"
    nonPremodifying Text
    "She"  = Text
    "Her"
    nonPremodifying Text
    "it"   = Text
    "its"
    nonPremodifying Text
    "It"   = Text
    "Its"
    nonPremodifying Text
    "we"   = Text
    "ours"
    nonPremodifying Text
    "We"   = Text
    "Ours"
    nonPremodifying Text
    "they" = Text
    "theirs"
    nonPremodifying Text
    "They" = Text
    "Theirs"
    nonPremodifying Text
    t = Text -> Text
    defaultPossesive Text
    t

    attributive :: Text -> Text
    attributive :: Text -> Text
    attributive Text
    "who"  = Text
    "whose"
    attributive Text
    "Who"  = Text
    "Whose"
    attributive Text
    "I"    = Text
    "my"
    attributive Text
    "you"  = Text
    "your"
    attributive Text
    "You"  = Text
    "Your"
    attributive Text
    "he"   = Text
    "his"
    attributive Text
    "He"   = Text
    "His"
    attributive Text
    "she"  = Text
    "her"
    attributive Text
    "She"  = Text
    "Her"
    attributive Text
    "it"   = Text
    "its"
    attributive Text
    "It"   = Text
    "Its"
    attributive Text
    "we"   = Text
    "our"
    attributive Text
    "We"   = Text
    "Our"
    attributive Text
    "they" = Text
    "their"
    attributive Text
    "They" = Text
    "Their"
    attributive Text
    t = Text -> Text
    defaultPossesive Text
    t

    -- TODO: use a suffix tree, to catch ableman, seaman, etc.?
    -- | Default set of nouns with irregular plural form.
    defIrrPlural :: Map Text Text
    defIrrPlural :: Map Text Text
    defIrrPlural = [(Text, Text)] -> Map Text Text
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Text, Text)] -> Map Text Text)
    -> [(Text, Text)] -> Map Text Text
    forall a b. (a -> b) -> a -> b
    $ ((Text, Text) -> [(Text, Text)])
    -> [(Text, Text)] -> [(Text, Text)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Text, Text) -> [(Text, Text)]
    generateCapitalized ([(Text, Text)] -> [(Text, Text)])
    -> [(Text, Text)] -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $
      [ (Text
    "bro",         Text
    "bros")
      , (Text
    "canto",       Text
    "cantos")
      , (Text
    "homo",        Text
    "homos")
      , (Text
    "photo",       Text
    "photos")
      , (Text
    "zero",        Text
    "zeros")
      , (Text
    "piano",       Text
    "pianos")
      , (Text
    "portico",     Text
    "porticos")
      , (Text
    "pro",         Text
    "pros")
      , (Text
    "quarto",      Text
    "quartos")
      , (Text
    "kimono",      Text
    "kimonos")
      , (Text
    "knife",       Text
    "knives")
      , (Text
    "life",        Text
    "lives")
      , (Text
    "dwarf",       Text
    "dwarfs")  -- not for ME dwarves though
      , (Text
    "proof",       Text
    "proofs")
      , (Text
    "roof",        Text
    "roofs")
      , (Text
    "turf",        Text
    "turfs")
      , (Text
    "child",       Text
    "children")
      , (Text
    "foot",        Text
    "feet")
      , (Text
    "goose",       Text
    "geese")
      , (Text
    "louse",       Text
    "lice")
      , (Text
    "man",         Text
    "men")
      , (Text
    "mouse",       Text
    "mice")
      , (Text
    "tooth",       Text
    "teeth")
      , (Text
    "woman",       Text
    "women")
      , (Text
    "buffalo",     Text
    "buffalo")
      , (Text
    "deer",        Text
    "deer")
      , (Text
    "moose",       Text
    "moose")
      , (Text
    "sheep",       Text
    "sheep")
      , (Text
    "bison",       Text
    "bison")
      , (Text
    "salmon",      Text
    "salmon")
      , (Text
    "pike",        Text
    "pike")
      , (Text
    "trout",       Text
    "trout")
      , (Text
    "swine",       Text
    "swine")
      , (Text
    "aircraft",    Text
    "aircraft")
      , (Text
    "watercraft",  Text
    "watercraft")
      , (Text
    "spacecraft",  Text
    "spacecraft")
      , (Text
    "hovercraft",  Text
    "hovercraft")
      , (Text
    "information", Text
    "information")
      , (Text
    "whiff",       Text
    "whiffs")
      , (Text
    "graffiti",    Text
    "graffiti")
      , (Text
    "stomach",     Text
    "stomachs")
      ]

    generateCapitalized :: (Text, Text) -> [(Text, Text)]
    generateCapitalized :: (Text, Text) -> [(Text, Text)]
    generateCapitalized (Text
    t1, Text
    t2) =
      let t1C :: Text
    t1C = Text -> Text
    capitalize Text
    t1
          t2C :: Text
    t2C = Text -> Text
    capitalize Text
    t2
      in if Text
    t1 Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    t1C then [(Text
    t1, Text
    t2)] else [(Text
    t1, Text
    t2), (Text
    t1C, Text
    t2C)]

    -- | Default set of nouns with irregular indefinite article.
    defIrrIndefinite :: Map Text Text
    defIrrIndefinite :: Map Text Text
    defIrrIndefinite = [(Text, Text)] -> Map Text Text
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
      [ (Text
    "SCUBA",        Text
    "a")
      , (Text
    "HEPA",         Text
    "a")
      , (Text
    "hour",         Text
    "an")
      , (Text
    "heir",         Text
    "an")
      , (Text
    "honour",       Text
    "an")
      , (Text
    "honor",        Text
    "an")
      ]