miniutter (empty) → 0.4.0
raw patch · 6 files changed
+883/−0 lines, 6 filesdep +HUnitdep +basedep +containerssetup-changed
Dependencies added: HUnit, base, containers, minimorph, miniutter, test-framework, test-framework-hunit, text
Files
- LICENSE +30/−0
- NLP/Miniutter/English.hs +332/−0
- README.md +30/−0
- Setup.hs +2/−0
- miniutter.cabal +63/−0
- test/test-miniutter.hs +426/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Mikolaj Konarski++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Mikolaj Konarski nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ NLP/Miniutter/English.hs view
@@ -0,0 +1,332 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Simple English clause creation parameterized by individual words.+module NLP.Miniutter.English+ ( Part(..), Person(..), Polarity(..), Irregular+ , makeSentence, makePhrase, defIrregular, (<>), (<+>), showT+ ) where++import Data.Char (toUpper, isAlphaNum)+import Data.Text (Text)+import Data.String (IsString(..))+import qualified Data.Text as T+import NLP.Minimorph.English+import NLP.Minimorph.Util+import Data.Map (Map)+import qualified Data.Map as Map++-- | 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+ | Ws !Part -- ^ plural form of a phrase+ | NWs !Int !Part -- ^ plural prefixed with a cardinal (not spelled)+ | Ordinal !Int -- ^ ordinal number, spelled in full up to 10+ | NthW !Int !Part -- ^ phrase prefixed by an ordinal (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+ | Phrase ![Part] -- ^ space-separated sequence+ | !Part :> !Part -- ^ no space in between+ | 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+ deriving (Show, Eq, Ord)++instance Read Part where+ readsPrec p str = [(Text x, y) | (x, y) <- readsPrec p str]++instance IsString Part where+ fromString = Text . T.pack++-- | Persons: singular 1st, singular 3rd and the rest.+data Person = Sg1st | Sg3rd | PlEtc+ deriving (Show, Eq, Ord)++-- | Generalized polarity: affirmative, negative, interrogative.+data Polarity = Yes | No | Why+ deriving (Show, Eq, Ord)++-- | Nouns with irregular plural form and nouns with irregular indefinite+-- article.+type Irregular = (Map Text Text, Map Text Text)++-- | Default set of words with irregular forms.+defIrregular :: Irregular+defIrregular = (defIrrPlural, defIrrIndefinite)++-- | Realise a complete sentence, capitalized, ending with a dot.+makeSentence :: Irregular -> [Part] -> Text+makeSentence irr l = capitalize $ makePhrase irr l `T.snoc` '.'++-- | Realise a phrase. The spacing between parts resembles+-- the semantics of @(\<\+\>)@, that is, it ignores empty words.+makePhrase :: Irregular -> [Part] -> Text+makePhrase irr = T.intercalate (T.singleton ' ') . makeParts irr++makeParts :: Irregular -> [Part] -> [Text]+makeParts irr = filter (not . T.null) . map (makePart irr)++-- The semantics of the operations is compositional.+makePart :: Irregular -> Part -> Text+makePart irr part = case part of+ String t -> T.pack t+ Text t -> t+ Cardinal n -> cardinal n+ Ws p -> onLastWord (makePlural irr) (mkPart p)+ NWs 1 p -> mkPart (AW p)+ NWs n p -> showT n <+> onLastWord (makePlural irr) (mkPart p)+ Ordinal n -> ordinal n+ NthW n p -> ordinalNotSpelled n <+> mkPart p+ AW p -> onFirstWord (addIndefinite irr) (mkPart p)+ WWandW lp -> let i = "and"+ lt = makeParts irr lp+ in commas i lt+ WWxW x lp -> let i = mkPart x+ lt = makeParts irr lp+ in commas i lt+ Wown p -> onLastWord nonPremodifying (mkPart p)+ WownW p1 p2 -> onLastWord attributive (mkPart p1) <+> mkPart p2+ Phrase lp -> makePhrase irr lp+ p1 :> p2 -> mkPart p1 <> mkPart p2+ Capitalize p -> capitalize $ mkPart p+ SubjectVerb defaultPerson Yes s v ->+ subjectVerb defaultPerson (mkPart s) (mkPart v)+ SubjectVerb defaultPerson No s v ->+ notSubjectVerb defaultPerson (mkPart s) (mkPart v)+ SubjectVerb defaultPerson Why s v ->+ qSubjectVerb defaultPerson (mkPart s) (mkPart v)+ SubjectVerbSg s v ->+ subjectVerb Sg3rd (mkPart s) (mkPart v)+ where+ mkPart = makePart irr++onFirstWord :: (Text -> Text) -> Text -> Text+onFirstWord f t =+ let (starting, rest) = T.span isWordLetter t+ in if T.null starting+ then rest+ else f starting <> rest++onLastWord :: (Text -> Text) -> Text -> Text+onLastWord f t =+ let (spanPrefix, spanRest) = T.span isWordLetter $ T.reverse t+ (ending, rest) = (T.reverse spanPrefix, T.reverse spanRest)+ in if T.null ending+ then rest+ else rest <> f ending++onFirstWordPair :: (Text -> (Text, Text)) -> Text -> (Text, Text)+onFirstWordPair f t =+ let (starting, rest) = T.span isWordLetter t+ in if T.null starting+ then (rest, "")+ else let (t1, t2) = f starting+ in (t1, t2 <> rest)++isWordLetter :: Char -> Bool+isWordLetter c = isAlphaNum c || c == '\'' || c == '-'++capitalize :: Text -> Text+capitalize t = case T.uncons t of+ Nothing -> T.empty+ Just (c, rest) -> T.cons (toUpper c) rest++makePlural :: Irregular -> Text -> Text+makePlural (irrPlural, _) t =+ case Map.lookup t irrPlural of+ Just u -> u+ Nothing -> defaultNounPlural t++addIndefinite :: Irregular -> Text -> Text+addIndefinite (_, irrIndefinite) t =+ case Map.lookup t irrIndefinite of+ Just u -> u <+> t+ Nothing -> indefiniteDet t <+> t++guessPerson :: Person -> Text -> Person+guessPerson defaultPerson "i" = defaultPerson -- letter 'i', not person 'I'+guessPerson defaultPerson word =+ case T.toLower word of+ "i" -> Sg1st+ "he" -> Sg3rd+ "she" -> Sg3rd+ "it" -> Sg3rd+ "we" -> PlEtc+ "you" -> PlEtc+ "they" -> PlEtc+ _ -> defaultPerson -- we don't try guessing beyond pronouns++personVerb :: Person -> Text -> Text+personVerb Sg1st "be" = "am"+personVerb PlEtc "be" = "are"+personVerb Sg3rd "be" = "is"+personVerb _ "can" = "can"+personVerb _ "could" = "could"+personVerb _ "must" = "must"+personVerb _ "will" = "will"+personVerb _ "would" = "would"+personVerb _ "shall" = "shall"+personVerb _ "should" = "should"+personVerb _ "ought" = "ought"+personVerb _ "may" = "may"+personVerb _ "might" = "might"+personVerb _ "had" = "had"+personVerb Sg1st v = v+personVerb PlEtc v = v+personVerb Sg3rd "have" = "has"+personVerb Sg3rd v = fst (defaultVerbStuff v)++subjectVerb :: Person -> Text -> Text -> Text+subjectVerb defaultPerson s v =+ s <+> onFirstWord (personVerb $ guessPerson defaultPerson s) v++notPersonVerb :: Person -> Text -> Text+notPersonVerb Sg1st "be" = "am not"+notPersonVerb PlEtc "be" = "aren't"+notPersonVerb Sg3rd "be" = "isn't"+notPersonVerb _ "can" = "can't"+notPersonVerb _ "could" = "couldn't"+notPersonVerb _ "must" = "mustn't"+notPersonVerb _ "will" = "won't"+notPersonVerb _ "would" = "wouldn't"+notPersonVerb _ "shall" = "shan't"+notPersonVerb _ "should" = "shouldn't"+notPersonVerb _ "ought" = "oughtn't"+notPersonVerb _ "may" = "may not"+notPersonVerb _ "might" = "might not"+notPersonVerb _ "had" = "hadn't"+notPersonVerb Sg1st v = "don't" <+> v+notPersonVerb PlEtc v = "don't" <+> v+notPersonVerb Sg3rd v = "doesn't" <+> v++notSubjectVerb :: Person -> Text -> Text -> Text+notSubjectVerb defaultPerson s v =+ s <+> onFirstWord (notPersonVerb $ guessPerson defaultPerson s) v++qPersonVerb :: Person -> Text -> (Text, Text)+qPersonVerb Sg1st "be" = ("am", "")+qPersonVerb PlEtc "be" = ("are", "")+qPersonVerb Sg3rd "be" = ("is", "")+qPersonVerb _ "can" = ("can", "")+qPersonVerb _ "could" = ("could", "")+qPersonVerb _ "must" = ("must", "")+qPersonVerb _ "will" = ("will", "")+qPersonVerb _ "would" = ("would", "")+qPersonVerb _ "shall" = ("shall", "")+qPersonVerb _ "should" = ("should", "")+qPersonVerb _ "ought" = ("ought", "")+qPersonVerb _ "may" = ("may", "")+qPersonVerb _ "might" = ("might", "")+qPersonVerb _ "had" = ("had", "")+qPersonVerb Sg1st v = ("do", v)+qPersonVerb PlEtc v = ("do", v)+qPersonVerb Sg3rd v = ("does", v)++qSubjectVerb :: Person -> Text -> Text -> Text+qSubjectVerb defaultPerson s v =+ let (v1, v2) = onFirstWordPair (qPersonVerb $ guessPerson defaultPerson s) v+ in v1 <+> s <+> v2++nonPremodifying :: Text -> Text+nonPremodifying "who" = "whose"+nonPremodifying "Who" = "Whose"+nonPremodifying "I" = "mine"+nonPremodifying "you" = "yours"+nonPremodifying "You" = "Yours"+nonPremodifying "he" = "his"+nonPremodifying "He" = "His"+nonPremodifying "she" = "her"+nonPremodifying "She" = "Her"+nonPremodifying "it" = "its"+nonPremodifying "It" = "Its"+nonPremodifying "we" = "ours"+nonPremodifying "We" = "Ours"+nonPremodifying "they" = "theirs"+nonPremodifying "They" = "Theirs"+nonPremodifying t = defaultPossesive t++attributive :: Text -> Text+attributive "who" = "whose"+attributive "Who" = "Whose"+attributive "I" = "my"+attributive "you" = "your"+attributive "You" = "Your"+attributive "he" = "his"+attributive "He" = "His"+attributive "she" = "her"+attributive "She" = "Her"+attributive "it" = "its"+attributive "It" = "Its"+attributive "we" = "our"+attributive "We" = "Our"+attributive "they" = "their"+attributive "They" = "Their"+attributive t = defaultPossesive 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.fromList+ [ ("canto", "cantos")+ , ("homo", "homos")+ , ("photo", "photos")+ , ("zero", "zeros")+ , ("piano", "pianos")+ , ("portico", "porticos")+ , ("pro", "pros")+ , ("quarto", "quartos")+ , ("kimono", "kimonos")+ , ("knife", "knives")+ , ("life", "lives")+ , ("dwarf", "dwarfs") -- not for ME dwarves, though+ , ("proof", "proofs")+ , ("roof", "roofs")+ , ("turf", "turfs")+ , ("child", "children")+ , ("foot", "feet")+ , ("goose", "geese")+ , ("louse", "lice")+ , ("man", "men")+ , ("mouse", "mice")+ , ("tooth", "teeth")+ , ("woman", "women")+ , ("buffalo", "buffalo")+ , ("deer", "deer")+ , ("moose", "moose")+ , ("sheep", "sheep")+ , ("bison", "bison")+ , ("salmon", "salmon")+ , ("pike", "pike")+ , ("trout", "trout")+ , ("swine", "swine")+ , ("aircraft", "aircraft")+ , ("watercraft", "watercraft")+ , ("spacecraft", "spacecraft")+ , ("hovercraft", "hovercraft")+ , ("information", "information")+ ]++-- | Default set of nouns with irregular indefinite article.+defIrrIndefinite :: Map Text Text+defIrrIndefinite = Map.fromList+ [ ("user", "a")+ , ("university", "a")+ , ("unicorn", "a")+ , ("unicycle", "a")+ , ("usual", "a")+ , ("unique", "a")+ , ("uniform", "a")+ , ("SCUBA", "a")+ , ("HEPA", "a")+ , ("hour", "an")+ , ("heir", "an")+ , ("honour", "an")+ , ("honor", "an")+ ]
+ README.md view
@@ -0,0 +1,30 @@+miniutter+=========++This library helps in generating simple present tense+English sentences from short, parametrized descriptions.+In a typical use, the structure of a clause is fixed,+but the particular words to be used vary in arbitrary ways.+The main goal of the library is to minimize the API+complexity and the code size of programs that use it.+The library doesn't attempt to ban incorrect English sentences,+but just make the creation of the simple correct ones easy+and predictable.++The library is available from [Hackage] [1] and it's homepage+and issue tracker is on [github] [2].++Further information+-------------------++The library emerged when the needs of the [LambdaHack] [3] game engine+outgrew its rudimentary grammar code written by Andres Loeh.+The library uses [minimorph] [4] by Eric Kow to tackle English spelling.+More information about natural language processing libraries in Haskell+is gathered at the [Haskell wiki] [5].++[1]: http://hackage.haskell.org/package/miniutter+[2]: https://github.com/Mikolaj/miniutter+[3]: http://hackage.haskell.org/package/LambdaHack+[4]: http://hackage.haskell.org/package/minimorph+[5]: http://www.haskell.org/haskellwiki/Applications_and_libraries/Linguistics
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ miniutter.cabal view
@@ -0,0 +1,63 @@+name: miniutter+version: 0.4.0+synopsis: Simple English clause creation from arbitrary words.+description: This library helps in generating simple present tense+ English sentences from short, parametrized descriptions.+ In a typical use, the structure of a clause is fixed,+ but the particular words to be used vary in arbitrary ways.+ The main goal of the library is to minimize the API+ complexity and the code size of programs that use it.+ The library doesn't attempt to ban incorrect English sentences,+ but just make the creation of the simple correct ones easy+ and predictable.+homepage: https://github.com/Mikolaj/miniutter+bug-reports: https://github.com/Mikolaj/miniutter/issues+license: BSD3+license-file: LICENSE+tested-with: GHC == 7.4.2, GHC == 7.6.1+data-files: LICENSE, README.md+author: Mikolaj Konarski+maintainer: Mikolaj Konarski <mikolaj.konarski@funktory.com>+category: Natural Language Processing+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: git://github.com/Mikolaj/miniutter.git++library+ exposed-modules: NLP.Miniutter.English+-- other-modules:+ build-depends: base >= 4 && < 5,+ text >= 0.11.2.3 && < 1,+ containers >= 0.4.1 && < 1,+ minimorph >= 0.1.4 && < 1++ default-language: Haskell2010+ default-extensions: MonoLocalBinds,+ BangPatterns, RecordWildCards, NamedFieldPuns+ other-extensions: OverloadedStrings, ExtendedDefaultRules+ ghc-options: -Wall -fwarn-orphans -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unrecognised-pragmas+ ghc-options: -fno-warn-auto-orphans -fno-warn-implicit-prelude+ ghc-options: -fno-ignore-asserts -funbox-strict-fields++test-suite test-miniutter+ type: exitcode-stdio-1.0+ main-is: test-miniutter.hs+ hs-source-dirs: test+ build-depends: miniutter,+ base >= 4 && < 5,+ text >= 0.11.2.3 && < 1,+ containers >= 0.4.1 && < 1,+ test-framework >= 0.6 && < 1,+ test-framework-hunit >= 0.2 && < 1,+ HUnit >= 1.2 && < 2++ default-language: Haskell2010+ default-extensions: MonoLocalBinds,+ BangPatterns, RecordWildCards, NamedFieldPuns+ other-extensions: OverloadedStrings, ExtendedDefaultRules+ ghc-options: -Wall -fwarn-orphans -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unrecognised-pragmas+ ghc-options: -fno-warn-auto-orphans -fno-warn-implicit-prelude+ ghc-options: -fno-ignore-asserts -funbox-strict-fields
+ test/test-miniutter.hs view
@@ -0,0 +1,426 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Data.Text as T++import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (assertEqual)++import qualified NLP.Miniutter.English as MU++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests =+ [ testGroup "check results of makePhrase calls"+ [ testMakePhraseVerbatim+ , testMakePhrasePlural+ , testMakePhraseNumber+ , testMakePhraseIndefinite+ , testMakePhraseEnumeration+ , testMakePhrasePossesive+ , testMakePhraseSubjectVerb+ , testAllureOfTheStars+ ]+ ]++tp :: [MU.Part] -> T.Text -> Test+tp arg expect =+ testCase ("testPhrase " ++ show arg)+ $ let obtain = MU.makePhrase MU.defIrregular arg+ in assertEqual (T.unpack expect ++ " == " ++ T.unpack obtain) expect obtain++testMakePhraseVerbatim :: Test+testMakePhraseVerbatim = testGroup "verbatim text Part constructors"+ [ tp [MU.String "blue dog"] "blue dog"+ , tp [MU.Text "blue dog"] "blue dog"+ , tp [MU.String ""] ""+ , tp [MU.Text ""] ""+ , tp [MU.String "blue", MU.String "dog"] "blue dog"+ , tp [MU.String "blue", MU.String ""] "blue"+ , tp [MU.String "", MU.String "dog"] "dog"+ , tp [MU.String "", MU.String ""] ""+ , tp [MU.String "blue", "dog"] "blue dog"+ , tp [MU.String "blue", ""] "blue"+ , tp [MU.String "", "dog"] "dog"+ , tp [MU.String "", ""] ""+ , tp ["blue", MU.String "dog"] "blue dog"+ , tp ["blue", MU.String ""] "blue"+ , tp ["", MU.String "dog"] "dog"+ , tp ["", MU.String ""] ""+ , tp ["blue", "dog"] "blue dog"+ , tp ["blue", ""] "blue"+ , tp ["", "dog"] "dog"+ , tp ["", ""] ""+ , tp [MU.Phrase ["blue", "dog"]] "blue dog"+ , tp [MU.Phrase ["blue", ""]] "blue"+ , tp [MU.Phrase ["", "dog"]] "dog"+ , tp [MU.Phrase ["", ""]] ""+ , tp [MU.Ordinal 0 MU.:> ", but", MU.Ordinal 1] "0th, but first"+ , tp [MU.Cardinal 20 MU.:> MU.Cardinal 0] "200"+ , tp [MU.String " "] " "+ , tp [ " "] " "+ , tp [MU.String " blue ", MU.String " dog "] " blue dog "+ , tp [" blue ", " dog "] " blue dog "+ , tp [MU.Phrase [" blue ", " dog "]] " blue dog "+ , testCase "testPhrase makeSentence and Capitalize" $+ assertEqual "makeSentence == Capitalize makePhrase :> '.'"+ (MU.makePhrase MU.defIrregular+ [MU.Capitalize (MU.SubjectVerbSg "goblin" "hit") MU.:> "."])+ (MU.makeSentence MU.defIrregular+ [MU.SubjectVerbSg "goblin" "hit"])+ ]++testMakePhrasePlural :: Test+testMakePhrasePlural = testGroup "plural form Part constructors"+ [ tp [MU.Ws "dog"] "dogs"+ , tp [MU.Ws "dogs"] "dogses"+ , tp [MU.Ws "blue dog"] "blue dogs"+ , tp [MU.Ws "blue dog "] "blue dog "+ , tp [MU.Ws "blue dog."] "blue dog."+ , tp [MU.Ws "blue dog%"] "blue dog%"+ , tp [MU.Ws "bitch"] "bitches"+ , tp [MU.Ws "the fish"] "the fishes"+ , tp [MU.Ws "miss"] "misses"+ , tp [MU.Ws "buzz"] "buzzes"+ , tp [MU.Ws "box"] "boxes"+ , tp [MU.Ws "hajj"] "hajjes"+ , tp [MU.Ws "goto"] "gotoes"+ , tp [MU.Ws "igloo"] "igloos"+ , tp [MU.Ws "buy"] "buys"+ , tp [MU.Ws "try"] "tries"+ , tp [MU.Ws "canto"] "cantos"+ , tp [MU.Ws "homo"] "homos"+ , tp [MU.Ws "photo"] "photos"+ , tp [MU.Ws "nice zero"] "nice zeros"+ , tp [MU.Ws "piano"] "pianos"+ , tp [MU.Ws "portico"] "porticos"+ , tp [MU.Ws "pro"] "pros"+ , tp [MU.Ws "quarto"] "quartos"+ , tp [MU.Ws "kimono"] "kimonos"+ , tp [MU.Ws "calf"] "calves"+ , tp [MU.Ws "leaf"] "leaves"+ , tp [MU.Ws "knife"] "knives"+ , tp [MU.Ws "life"] "lives"+ , tp [MU.Ws "dwarf"] "dwarfs"+ , tp [MU.Ws "hoof"] "hooves"+ , tp [MU.Ws "elf"] "elves"+--, tp [MU.Ws "staff"] "staves" -- depends on the meaning :(+ , tp [MU.Ws "child"] "children"+ , tp [MU.Ws "foot"] "feet"+ , tp [MU.Ws "goose"] "geese"+ , tp [MU.Ws "louse"] "lice"+ , tp [MU.Ws "man"] "men"+ , tp [MU.Ws "mouse"] "mice"+ , tp [MU.Ws "tooth"] "teeth"+ , tp [MU.Ws "woman"] "women"+ , tp [MU.Ws "buffalo"] "buffalo"+ , tp [MU.Ws "deer"] "deer"+ , tp [MU.Ws "the moose"] "the moose"+ , tp [MU.Ws "sheep"] "sheep"+ , tp [MU.Ws "bison"] "bison"+ , tp [MU.Ws "salmon"] "salmon"+ , tp [MU.Ws "pike"] "pike"+ , tp [MU.Ws "trout"] "trout"+ , tp [MU.Ws "swine"] "swine"+ , tp [MU.Ws "aircraft"] "aircraft"+ , tp [MU.Ws "watercraft"] "watercraft"+ , tp [MU.Ws "spacecraft"] "spacecraft"+ , tp [MU.Ws "hovercraft"] "hovercraft"+ , tp [MU.Ws "information"] "information"+ , tp [MU.Ws (MU.String "dog blue")] "dog blues"+ , tp [MU.Ws (MU.Ordinal 1)] "firsts"+ , tp [MU.Ws (MU.Ws "do")] "doeses"+ , tp [MU.Ws (MU.NWs 1 "man")] "a men"+ , tp [MU.Ws (MU.NthW 1 "man")] "1st men"+ , tp [MU.Ws (MU.AW "elf")] "an elves"+ , tp [MU.Ws (MU.WWandW ["dog", "eagle", "parrot"])]+ "dog, eagle and parrots"+ , tp [MU.Ws (MU.WWxW "and also" ["dog", "eagle", "parrot"])]+ "dog, eagle and also parrots"+ , tp [MU.Ws (MU.Wown "uncle")] "uncle'ses"+ , tp [MU.Ws (MU.WownW "uncle" "dog")] "uncle's dogs"+ , tp [MU.Ws (MU.Phrase ["uncle", "dog"])] "uncle dogs"+ , tp [MU.Ws (MU.SubjectVerb MU.Sg3rd MU.Yes "I" "do")] "I does"+ , tp [MU.Ws (MU.SubjectVerb MU.Sg1st MU.No "Me" "do")] "Me don't does"+ , tp [MU.Ws (MU.SubjectVerb MU.Sg3rd MU.Why "woman" "do")] "does woman does"+ ]++testMakePhraseNumber :: Test+testMakePhraseNumber = testGroup "number Part constructors"+ [ tp [MU.Cardinal 3] "three"+ , tp [MU.Cardinal 1111] "1111"+ , tp [MU.Cardinal 131] "131"+ , tp [MU.Cardinal 131, MU.Ordinal 2] "131 second"+ , tp [MU.Cardinal (-3)] "-3"+ , tp [MU.Cardinal 99999999999999992] "99999999999999992"+ , tp [MU.Ordinal 3] "third"+ , tp [MU.Ordinal 1111] "1111th"+ , tp [MU.Ordinal 131] "131st"+ , tp [MU.Ordinal 131, MU.Cardinal 2] "131st two"+ , tp [MU.Ordinal (-3)] "-3rd"+ , tp [MU.Ordinal 99999999999999992] "99999999999999992nd"+ , tp [MU.NWs 1 "blue dog"] "a blue dog"+ , tp [MU.NWs 2 "blue elf"] "2 blue elves"+ , tp [MU.NWs 2 " dog "] "2 dog "+ , tp [MU.NWs 3 "leaf"] "3 leaves"+ , tp [MU.NWs 4 "sheep"] "4 sheep"+ , tp [MU.NWs (-1) "dog"] "-1 dogs"+ , tp [MU.NWs (-3) "dog"] "-3 dogs"+ , tp [MU.NWs 12 ""] "12"+ , tp [MU.NWs 5 (MU.Cardinal 1)] "5 ones"+ , tp [MU.NWs 4 (MU.Ordinal 2)] "4 seconds"+ , tp [MU.NthW 2 "blue dog"] "2nd blue dog"+ , tp [MU.NthW 2 " dog "] "2nd dog "+ , tp [MU.NthW 3 "leaf"] "3rd leaf"+ , tp [MU.NthW 4 "sheep"] "4th sheep"+ , tp [MU.NthW (-3) "dog"] "-3rd dog"+ , tp [MU.NthW 12 ""] "12th"+ , tp [MU.NthW 51 ""] "51st"+ , tp [MU.NthW 52 ""] "52nd"+ , tp [MU.NthW 951 ""] "951st"+ , tp [MU.NthW 952 ""] "952nd"+ , tp [MU.NthW 112 ""] "112th"+ , tp [MU.NthW 712 ""] "712th"+ , tp [MU.NthW 5 (MU.Cardinal 1)] "5th one"+ , tp [MU.NthW 4 (MU.Ordinal 2)] "4th second"+ , tp [MU.NthW 4 (MU.NthW 7 "dog")] "4th 7th dog"+ , tp [MU.NthW 4 (MU.NWs 7 "dog")] "4th 7 dogs"+ , tp [MU.NWs 4 (MU.NWs 7 "dog")] "4 7 dogses"+ , tp [MU.NWs 4 (MU.NthW 7 "elf")] "4 7th elves"+ ]++testMakePhraseIndefinite :: Test+testMakePhraseIndefinite = testGroup "indefinite article"+ [ tp [MU.AW "user"] "a user"+ , tp [MU.AW "usual egg"] "a usual egg"+ , tp [MU.AW "ABC"] "an ABC"+ , tp [MU.AW " ABC"] " ABC"+ , tp [MU.AW "ABC "] "an ABC "+ , tp [MU.AW "SCUBA"] "a SCUBA"+ , tp [MU.AW "SSI"] "an SSI"+ , tp [MU.AW (MU.String "yell")] "a yell"+ , tp [MU.AW (MU.Cardinal 3)] "a three"+ , tp [MU.AW (MU.Cardinal 8)] "an eight"+ , tp [MU.AW (MU.Cardinal 31)] "a 31"+ , tp [MU.AW (MU.Cardinal 83)] "an 83"+ , tp [MU.AW (MU.NWs 3 "dog")] "a 3 dogs"+ , tp [MU.AW (MU.Ordinal 3)] "a third"+ , tp [MU.AW (MU.Ordinal 8)] "an eighth"+ , tp [MU.AW (MU.Ordinal 31)] "a 31st"+ , tp [MU.AW (MU.Ordinal 83)] "an 83rd"+ , tp [MU.AW (MU.NthW 3 "dog")] "a 3rd dog"+ , tp [MU.AW (MU.AW "dog")] "an a dog"+ , tp [MU.AW (MU.WWandW ["dog", "eagle", "parrot"])]+ "a dog, eagle and parrot"+ , tp [MU.AW (MU.WWxW "or otherwise" ["hour", "eagle", "car"])]+ "an hour, eagle or otherwise car"+ , tp [MU.AW (MU.Wown "uncle")] "an uncle's"+ , tp [MU.AW (MU.WownW "uncle" "dog")] "an uncle's dog"+ , tp [MU.AW (MU.Phrase ["uncle", "dog"])] "an uncle dog"+ , tp [MU.AW (MU.SubjectVerbSg "I" "do")] "an I do"+ , tp [MU.AW (MU.SubjectVerb MU.Sg3rd MU.No "I" "do")] "an I don't do"+ , tp [MU.AW (MU.SubjectVerb MU.Sg3rd MU.Why "I" "do")] "a do I do"+ ]++testMakePhraseEnumeration :: Test+testMakePhraseEnumeration = testGroup "enumeration and collection"+ [ tp [MU.WWandW [MU.String "dog", "eagle", MU.Cardinal 7]]+ "dog, eagle and seven"+ , tp [MU.WWxW "then" [MU.Ordinal 113, MU.AW (MU.String "eagle"), "parrot"]]+ "113th, an eagle then parrot"+ , tp [MU.WWandW [ MU.String "I"+ , MU.WWandW [MU.String "I", MU.Ordinal 31, MU.Cardinal 17]+ , MU.WWandW ["I", MU.AW (MU.Ordinal 18)]+ ]]+ "I, I, 31st and 17 and I and an 18th"+ , tp [MU.WWxW " and perhaps%" [" dog ", "", "%eagle."]]+ " dog and perhaps% %eagle."+ ]++testMakePhrasePossesive :: Test+testMakePhrasePossesive = testGroup "the possesive form"+ [ tp [MU.Wown (MU.String "uncle")] "uncle's"+ , tp [MU.Wown (MU.String " uncle ")] " uncle "+ , tp [MU.Wown ""] ""+ , tp [MU.Wown " "] " "+ , tp [MU.Wown "miss"] "miss'"+ , tp [MU.Wown "YQS"] "YQS'"+ , tp [MU.Wown "buzz"] "buzz's"+ , tp [MU.Wown "box"] "box's"+ , tp [MU.Wown "Who"] "Whose"+ , tp [MU.Wown "I"] "mine"+ , tp [MU.Wown "you"] "yours"+ , tp [MU.Wown "he"] "his"+ , tp [MU.Wown "She"] "Her"+ , tp [MU.Wown "it"] "its"+ , tp [MU.Wown "We"] "Ours"+ , tp [MU.Wown "they"] "theirs"+ , tp [MU.WownW (MU.String "uncle") (MU.String "dog")] "uncle's dog"+ , tp [MU.WownW " uncle " "dog"] " uncle dog"+ , tp [MU.WownW "I" ""] "my"+ , tp [MU.WownW "" "dog"] "dog"+ , tp [MU.WownW "" ""] ""+ , tp [MU.WownW " " " "] " "+ , tp [MU.WownW "miss" "dog"] "miss' dog"+ , tp [MU.WownW "YQS" (MU.Cardinal 33)] "YQS' 33"+ , tp [MU.WownW "buzz" (MU.Ordinal 21)] "buzz's 21st"+ , tp [MU.WownW "box" ""] "box's"+ , tp [MU.WownW "who" "dog"] "whose dog"+ , tp [MU.WownW "I" "dog"] "my dog"+ , tp [MU.WownW "you" "dog"] "your dog"+ , tp [MU.WownW "He" "dog"] "His dog"+ , tp [MU.WownW "she" "dog"] "her dog"+ , tp [MU.WownW "It" "dog"] "Its dog"+ , tp [MU.WownW "we" "dog"] "our dog"+ , tp [MU.WownW "They" "dog"] "Their dog"+ , tp [MU.Wown (MU.NWs 6 "")] "6's"+ , tp [MU.Wown (MU.NthW 1 "")] "1st's"+ , tp [MU.Wown (MU.Ws (MU.NWs 6 ""))] "6s'"+ , tp [MU.Wown (MU.WWandW ["I", "you"])] "I and yours"+ , tp [MU.Wown (MU.WWandW ["you", "I"])] "you and mine"+ , tp [MU.WownW (MU.WWandW ["you", "I"]) "dog"] "you and my dog"+ , tp [MU.Wown (MU.Wown "it")] "its'"+ , tp [MU.Wown $ MU.Wown $ MU.Wown $ MU.Wown "it"] "its's'"+ , tp [MU.Wown (MU.SubjectVerb MU.Sg3rd MU.Why "I" "be")] "am mine"+ , tp [MU.Wown " do I"] " do mine"+ , tp [MU.Wown " do I "] " do I "+ ]++testMakePhraseSubjectVerb :: Test+testMakePhraseSubjectVerb = testGroup "subject and verb"+ [ tp [MU.SubjectVerbSg "species" "look"] "species looks"+ , tp [MU.SubjectVerb MU.Sg1st MU.No "species" "look"] "species don't look"+ , tp [MU.SubjectVerb MU.Sg3rd MU.Why "species" "look"] "does species look"+ , tp [MU.SubjectVerb MU.PlEtc MU.Yes "species" "look"] "species look"+ , tp [MU.SubjectVerb MU.PlEtc MU.No "species" "look"] "species don't look"+ , tp [MU.SubjectVerb MU.PlEtc MU.Why "species" "look"] "do species look"+ , tp [MU.SubjectVerbSg "I" "be"] "I am"+ , tp [MU.SubjectVerb MU.Sg3rd MU.No "you" "be"] "you aren't"+ , tp [MU.SubjectVerb MU.Sg3rd MU.Why "she" "be"] "is she"+ , tp [MU.SubjectVerb MU.PlEtc MU.Yes "we" "be"] "we are"+ , tp [MU.SubjectVerb MU.PlEtc MU.No "I" "be"] "I am not"+ , tp [MU.SubjectVerb MU.PlEtc MU.Why "they" "be"] "are they"+ , tp [MU.SubjectVerbSg "they" "be"] "they are"+ , tp [MU.SubjectVerb MU.Sg3rd MU.No "we" "be"] "we aren't"+ , tp [MU.SubjectVerb MU.Sg3rd MU.Why "it" "be"] "is it"+ , tp [MU.SubjectVerb MU.PlEtc MU.Yes "he" "be"] "he is"+ , tp [MU.SubjectVerb MU.PlEtc MU.No "She" "be"] "She isn't"+ , tp [MU.SubjectVerb MU.PlEtc MU.Why "You" "be"] "are You"+ , tp [MU.SubjectVerbSg "Tom" "have"] "Tom has"+ , tp [MU.SubjectVerb MU.Sg3rd MU.No "cat" "have"] "cat doesn't have"+ , tp [MU.SubjectVerb MU.Sg3rd MU.Why "they" "have"] "do they have"+ , tp [MU.SubjectVerb MU.PlEtc MU.Yes "he" "have"] "he has"+ , tp [MU.SubjectVerb MU.PlEtc MU.No "She" "have"] "She doesn't have"+ , tp [MU.SubjectVerb MU.PlEtc MU.Why "Foos" "have"] "do Foos have"+ , tp [MU.SubjectVerbSg "Tom" "do"] "Tom does"+ , tp [MU.SubjectVerb MU.Sg3rd MU.No "cat" "do"] "cat doesn't do"+ , tp [MU.SubjectVerb MU.Sg3rd MU.Why "they" "do"] "do they do"+ , tp [MU.SubjectVerb MU.PlEtc MU.Yes "he" "go"] "he goes"+ , tp [MU.SubjectVerb MU.PlEtc MU.No "She" "go"] "She doesn't go"+ , tp [MU.SubjectVerb MU.PlEtc MU.Why "Foos" "go"] "do Foos go"+ , tp [MU.SubjectVerbSg "Tom" "can"] "Tom can"+ , tp [MU.SubjectVerb MU.Sg3rd MU.No "cat" "could"] "cat couldn't"+ , tp [MU.SubjectVerb MU.Sg3rd MU.Why "they" "must"] "must they"+ , tp [MU.SubjectVerb MU.PlEtc MU.Yes "he" "will"] "he will"+ , tp [MU.SubjectVerb MU.PlEtc MU.No "She" "would"] "She wouldn't"+ , tp [MU.SubjectVerb MU.PlEtc MU.Why "Foos" "shall"] "shall Foos"+ , tp [MU.SubjectVerbSg "Tom" "should"] "Tom should"+ , tp [MU.SubjectVerb MU.Sg3rd MU.No "cat" "ought"] "cat oughtn't"+ , tp [MU.SubjectVerb MU.Sg3rd MU.Why "they" "may"] "may they"+ , tp [MU.SubjectVerb MU.PlEtc MU.Yes "he" "might"] "he might"+ , tp [MU.SubjectVerb MU.PlEtc MU.No "She" "had"] "She hadn't"+ , tp [MU.SubjectVerb MU.PlEtc MU.Why "it" "copy down"] "does it copy down"+ , tp [MU.SubjectVerbSg "Tom" "copy down" ] "Tom copies down"+ , tp [MU.SubjectVerbSg "Tom" "buzz"] "Tom buzzes"+ , tp [MU.SubjectVerbSg "Tom" "it it"] "Tom its it"+ , tp [MU.SubjectVerbSg "Tom" "you you"] "Tom yous you"+ , tp [MU.SubjectVerbSg "You" "you you"] "You you you"+ , tp [MU.SubjectVerbSg "She" "do read"] "She does read"+ , tp [MU.SubjectVerbSg "She" "do do"] "She does do"+ , tp [MU.SubjectVerb MU.PlEtc MU.Why "she" "do"] "does she do"+ , tp [MU.SubjectVerb MU.PlEtc MU.No "She" "had had"] "She hadn't had"+ ]++tc :: [MU.Part] -> T.Text -> Test+tc arg expect =+ testCase ("testSentence " ++ show arg)+ $ let obtain = MU.makeSentence MU.defIrregular arg+ in assertEqual (T.unpack expect ++ " == " ++ T.unpack obtain) expect obtain++testAllureOfTheStars:: Test+testAllureOfTheStars = testGroup "Allure of the Stars utterances"+ [ tc [ MU.SubjectVerbSg "you" "displace"+ , "Haskell Alvin" ]+ "You displace Haskell Alvin."+ , tc [ MU.SubjectVerbSg "you" "drop"+ , MU.NWs 3 "royal blue vial" ]+ "You drop 3 royal blue vials."+ , tc [ MU.SubjectVerbSg "Haskell Alvin" "displace"+ , "you" ]+ "Haskell Alvin displaces you."+ , tc [ MU.SubjectVerbSg "Haskell Alvin" "drop"+ , MU.NWs 1 "royal blue vial" ]+ "Haskell Alvin drops a royal blue vial."+ , tc [ MU.SubjectVerbSg "Haskell Alvin" "gulp down"+ , MU.AW "royal blue vial" ]+ "Haskell Alvin gulps down a royal blue vial."+ , tc [ MU.SubjectVerbSg "Haskell Alvin" "feel better" ]+ "Haskell Alvin feels better."+ , tc [ MU.SubjectVerbSg "the royal blue vial" "turn out to be"+ , MU.NWs 1 "vial of healing (+5)" ]+ "The royal blue vial turns out to be a vial of healing (+5)."+ , tc [ MU.SubjectVerbSg "you" "gulp down"+ , MU.AW "magenta vial" ]+ "You gulp down a magenta vial."+ , tc [ MU.SubjectVerbSg "the magenta vial" "turn out to be"+ , MU.NWs 1 "vial of rose water" ]+ "The magenta vial turns out to be a vial of rose water."+ , tc [ MU.SubjectVerbSg "deranged household robot" "trie to hit"+ MU.:> ", but you block" ]+ "Deranged household robot tries to hit, but you block."+ , tc [ MU.SubjectVerbSg "deranged household robot" "hit"+ , "you" ]+ "Deranged household robot hits you."+ , tc [ MU.SubjectVerbSg "deranged household robot" "pick up"+ , MU.NWs 2 "sharpened pipe", "(3d1) (+1)" ]+ "Deranged household robot picks up 2 sharpened pipes (3d1) (+1)."+ , tc [ MU.SubjectVerbSg "deranged household robot" "hit"+ , MU.Text"you with", MU.NWs 1 "sharpened pipe (3d1) (+1)" ]+ "Deranged household robot hits you with a sharpened pipe (3d1) (+1)."+ , tc [ MU.SubjectVerbSg "you" "kick"+ , "deranged household robot" ]+ "You kick deranged household robot."+ , tc [ MU.SubjectVerbSg "deranged household robot" "die" ]+ "Deranged household robot dies."+ , tc [ MU.SubjectVerbSg "you" "find"+ , "a way downstairs" ]+ "You find a way downstairs."+ , tc [ MU.SubjectVerbSg "Haskell Alvin" "squash"+ , "you in a staircase accident" ]+ "Haskell Alvin squashes you in a staircase accident."+ , tc [ MU.SubjectVerbSg "you" "die" ]+ "You die."+ , tc [ MU.SubjectVerbSg "Haskell Alvin" "find"+ , "a way downstairs" ]+ "Haskell Alvin finds a way downstairs."+ , tc [ MU.SubjectVerbSg "Haskell Alvin" "hit"+ , "deranged household robot" ]+ "Haskell Alvin hits deranged household robot."+ , tc [ MU.SubjectVerbSg "deranged household robot" "hit"+ , "Haskell Alvin" ]+ "Deranged household robot hits Haskell Alvin."+ , tc [ MU.SubjectVerbSg "deranged household robot" "try to hit"+ MU.:> ", but Haskell Alvin blocks" ]+ "Deranged household robot tries to hit, but Haskell Alvin blocks."+ , tc [ MU.SubjectVerbSg "deformed monkey" "hit"+ , "deranged household robot" ]+ "Deformed monkey hits deranged household robot."+ , tc [ MU.SubjectVerbSg (MU.NWs 1 "flying billiard ball (1d1)") "hit"+ , "deranged household robot" ]+ "A flying billiard ball (1d1) hits deranged household robot."+ , tc [ MU.SubjectVerbSg "deranged household robot" "hiss in pain" ]+ "Deranged household robot hisses in pain."+ ]