diff --git a/NLP/Miniutter/English.hs b/NLP/Miniutter/English.hs --- a/NLP/Miniutter/English.hs +++ b/NLP/Miniutter/English.hs @@ -1,18 +1,22 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | 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.Binary +import Data.Char (isAlphaNum, toUpper) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.String (IsString (..)) import Data.Text (Text) -import Data.String (IsString(..)) import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import GHC.Generics (Generic) 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. @@ -21,9 +25,10 @@ | 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) + | CarWs !Int !Part -- ^ plural prefixed with a cardinal, not spelled + | CardinalWs !Int !Part -- ^ plural prefixed with a cardinal, spelled | Ordinal !Int -- ^ ordinal number, spelled in full up to 10 - | NthW !Int !Part -- ^ phrase prefixed by an ordinal (not spelled) + | Ord !Int -- ^ ordinal number, not spelled | AW !Part -- ^ phrase with indefinite article | WWandW ![Part] -- ^ enumeration | WWxW !Part ![Part] -- ^ collection @@ -37,8 +42,10 @@ -- with a default person (pronouns override it) | SubjectVerbSg !Part !Part -- ^ a shorthand for Sg3rd and Yes - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Binary Part + instance Read Part where readsPrec p str = [(Text x, y) | (x, y) <- readsPrec p str] @@ -47,12 +54,20 @@ -- | Persons: singular 1st, singular 3rd and the rest. data Person = Sg1st | Sg3rd | PlEtc - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Binary Person + -- | Generalized polarity: affirmative, negative, interrogative. data Polarity = Yes | No | Why - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Binary Polarity + +instance Binary Text where + put = put . encodeUtf8 + get = decodeUtf8 `fmap` get + -- | Nouns with irregular plural form and nouns with irregular indefinite -- article. type Irregular = (Map Text Text, Map Text Text) @@ -80,10 +95,12 @@ 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) + CarWs 1 p -> mkPart (AW p) + CarWs n p -> showT n <+> onLastWord (makePlural irr) (mkPart p) + CardinalWs 1 p -> mkPart (AW p) + CardinalWs n p -> cardinal n <+> onLastWord (makePlural irr) (mkPart p) Ordinal n -> ordinal n - NthW n p -> ordinalNotSpelled n <+> mkPart p + Ord n -> ordinalNotSpelled n AW p -> onFirstWord (addIndefinite irr) (mkPart p) WWandW lp -> let i = "and" lt = makeParts irr lp @@ -313,6 +330,8 @@ , ("information", "information") ] +-- TODO: Remove the exceptions about 'u' as soon as we bump the minimorph +-- dependency to 0.1.5. -- | Default set of nouns with irregular indefinite article. defIrrIndefinite :: Map Text Text defIrrIndefinite = Map.fromList diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,6 @@ -miniutter +miniutter [![Build Status](https://secure.travis-ci.org/Mikolaj/miniutter.png)](http://travis-ci.org/Mikolaj/miniutter) ========= + This library helps in generating simple present tense English sentences from short, parametrized descriptions. diff --git a/miniutter.cabal b/miniutter.cabal --- a/miniutter.cabal +++ b/miniutter.cabal @@ -1,5 +1,5 @@ name: miniutter -version: 0.4.0 +version: 0.4.2 synopsis: Simple English clause creation from arbitrary words. description: This library helps in generating simple present tense English sentences from short, parametrized descriptions. @@ -29,15 +29,18 @@ library exposed-modules: NLP.Miniutter.English -- other-modules: - build-depends: base >= 4 && < 5, + build-depends: base >= 4 && < 5, + binary >= 0.6.3.0 && < 1, + ghc-prim >= 0.2, text >= 0.11.2.3 && < 1, - containers >= 0.4.1 && < 1, - minimorph >= 0.1.4 && < 1 + containers >= 0.4.1 && < 1, + minimorph >= 0.1.4 && < 1 default-language: Haskell2010 - default-extensions: MonoLocalBinds, + default-extensions: MonoLocalBinds, ScopedTypeVariables, BangPatterns, RecordWildCards, NamedFieldPuns - other-extensions: OverloadedStrings, ExtendedDefaultRules + other-extensions: OverloadedStrings +--, DeriveGeneric 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 @@ -47,17 +50,17 @@ main-is: test-miniutter.hs hs-source-dirs: test build-depends: miniutter, - base >= 4 && < 5, + 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 + 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, + default-extensions: MonoLocalBinds, ScopedTypeVariables, BangPatterns, RecordWildCards, NamedFieldPuns - other-extensions: OverloadedStrings, ExtendedDefaultRules + other-extensions: OverloadedStrings 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 diff --git a/test/test-miniutter.hs b/test/test-miniutter.hs --- a/test/test-miniutter.hs +++ b/test/test-miniutter.hs @@ -133,8 +133,8 @@ , 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.CarWs 1 "man")] "a men" + , tp [MU.Ws (MU.Ord 1)] "1sts" , tp [MU.Ws (MU.AW "elf")] "an elves" , tp [MU.Ws (MU.WWandW ["dog", "eagle", "parrot"])] "dog, eagle and parrots" @@ -162,34 +162,33 @@ , 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" + , tp [MU.CarWs 1 "blue dog"] "a blue dog" + , tp [MU.CarWs 2 "blue elf"] "2 blue elves" + , tp [MU.CardinalWs 2 " dog "] "two dog " + , tp [MU.CarWs 3 "leaf"] "3 leaves" + , tp [MU.CardinalWs 4 "sheep"] "four sheep" + , tp [MU.CarWs (-1) "dog"] "-1 dogs" + , tp [MU.CardinalWs (-3) "dog"] "-3 dogs" + , tp [MU.CardinalWs 12 ""] "12" + , tp [MU.CarWs 5 (MU.Cardinal 1)] "5 ones" + , tp [MU.CardinalWs 4 (MU.Ordinal 2)] "four seconds" + , tp [MU.Ord 2] "2nd" + , tp [MU.Ord 3] "3rd" + , tp [MU.Ord 4] "4th" + , tp [MU.Ord (-3)] "-3rd" + , tp [MU.Ord 12] "12th" + , tp [MU.Ord 51] "51st" + , tp [MU.Ord 52] "52nd" + , tp [MU.Ord 951] "951st" + , tp [MU.Ord 952] "952nd" + , tp [MU.Ord 112] "112th" + , tp [MU.Ord 712] "712th" + , tp [MU.Ord 5 MU.:> MU.Cardinal 1] "5thone" + , tp [MU.Ord 4 MU.:> MU.Ordinal 2] "4thsecond" + , tp [MU.Ord 4 MU.:> MU.Ord 7] "4th7th" + , tp [MU.Ord 4 MU.:> MU.CarWs 7 "dog"] "4th7 dogs" + , tp [MU.CardinalWs 4 (MU.CarWs 7 "dog")] "four 7 dogses" + , tp [MU.CarWs 4 (MU.Ord 7 MU.:> "elf")] "4 7thelves" ] testMakePhraseIndefinite :: Test @@ -206,12 +205,12 @@ , 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.CarWs 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.Ord 3)] "a 3rd" , tp [MU.AW (MU.AW "dog")] "an a dog" , tp [MU.AW (MU.WWandW ["dog", "eagle", "parrot"])] "a dog, eagle and parrot" @@ -276,9 +275,9 @@ , 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.CarWs 6 "")] "6's" + , tp [MU.Wown (MU.Ord 1)] "1st's" + , tp [MU.Wown (MU.Ws (MU.CardinalWs 6 ""))] "sixes'" , 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" @@ -356,13 +355,13 @@ , "Haskell Alvin" ] "You displace Haskell Alvin." , tc [ MU.SubjectVerbSg "you" "drop" - , MU.NWs 3 "royal blue vial" ] - "You drop 3 royal blue vials." + , MU.CardinalWs 3 "royal blue vial" ] + "You drop three 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" ] + , MU.CarWs 1 "royal blue vial" ] "Haskell Alvin drops a royal blue vial." , tc [ MU.SubjectVerbSg "Haskell Alvin" "gulp down" , MU.AW "royal blue vial" ] @@ -370,13 +369,13 @@ , 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)" ] + , MU.CarWs 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" ] + , MU.CarWs 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" ] @@ -385,10 +384,10 @@ , "you" ] "Deranged household robot hits you." , tc [ MU.SubjectVerbSg "deranged household robot" "pick up" - , MU.NWs 2 "sharpened pipe", "(3d1) (+1)" ] + , MU.CarWs 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)" ] + , MU.Text"you with", MU.CardinalWs 1 "sharpened pipe (3d1) (+1)" ] "Deranged household robot hits you with a sharpened pipe (3d1) (+1)." , tc [ MU.SubjectVerbSg "you" "kick" , "deranged household robot" ] @@ -418,7 +417,7 @@ , 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" + , tc [ MU.SubjectVerbSg (MU.CarWs 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" ]