miniutter 0.5.0.0 → 0.5.1.0
raw patch · 3 files changed
+64/−49 lines, 3 filesdep ~basedep ~containersdep ~textPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, containers, text
API changes (from Hackage documentation)
Files
- NLP/Miniutter/English.hs +32/−23
- miniutter.cabal +14/−12
- test/test-miniutter.hs +18/−14
NLP/Miniutter/English.hs view
@@ -6,17 +6,21 @@ ) where import Data.Binary-import Data.Char (isAlphaNum, toUpper)+import Data.Char (isAlphaNum, isSpace, toUpper) import Data.Map (Map) import qualified Data.Map as Map-import Data.Semigroup as Sem 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 hiding ((<>))+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 =@@ -32,9 +36,9 @@ -- ^ 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;- -- no prefix at all for 1+ | 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@@ -65,7 +69,7 @@ instance IsString Part where fromString = Text . T.pack -instance Sem.Semigroup Part where+instance Semigroup Part where (<>) = Append instance Monoid Part where@@ -178,15 +182,23 @@ onLastWord :: (Text -> Text) -> Text -> Text onLastWord f t =- let (spanPrefix, spanRest) = T.span isWordLetter $ T.reverse 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 (wordPrefix, nonWordSuffix) =+ let (wordP, nonWordP) = T.span (\c -> isWordLetter c || isSpace c) t+ (wordSpaceR, wordRestR) = T.span isSpace $ T.reverse wordP+ in (T.reverse wordRestR, T.reverse wordSpaceR <> nonWordP)+ (spanPrefix, spanRest) = T.span isWordLetter $ T.reverse wordPrefix (ending, restRaw) = (T.reverse spanPrefix, T.reverse spanRest) rest = T.dropWhile (not . isWordLetter) restRaw fending = f ending- in if T.null ending- then t- else if T.null fending- then rest- else restRaw <> f ending+ onLast = if T.null ending+ then wordPrefix+ else if T.null fending+ then rest+ else restRaw <> f ending+ in onLast <> nonWordSuffix onFirstWordPair :: (Text -> (Text, Text)) -> Text -> (Text, Text) onFirstWordPair f t =@@ -360,28 +372,22 @@ -- 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+defIrrPlural = Map.fromList $ concatMap generateCapitalized $ [ ("bro", "bros")- , ("Bro", "Bros") , ("canto", "cantos") , ("homo", "homos") , ("photo", "photos")- , ("Photo", "Photos") , ("zero", "zeros") , ("piano", "pianos")- , ("Piano", "Pianos") , ("portico", "porticos") , ("pro", "pros") , ("quarto", "quartos") , ("kimono", "kimonos") , ("knife", "knives")- , ("Knife", "Knives") , ("life", "lives")- , ("Life", "Lives") , ("dwarf", "dwarfs") -- not for ME dwarves though , ("proof", "proofs") , ("roof", "roofs")- , ("Roof", "Roofs") , ("turf", "turfs") , ("child", "children") , ("foot", "feet")@@ -401,16 +407,19 @@ , ("trout", "trout") , ("swine", "swine") , ("aircraft", "aircraft")- , ("Aircraft", "Aircraft") , ("watercraft", "watercraft") , ("spacecraft", "spacecraft")- , ("Spacecraft", "Spacecraft") , ("hovercraft", "hovercraft") , ("information", "information")- , ("Information", "Information") , ("whiff", "whiffs") , ("graffiti", "graffiti") ]++generateCapitalized :: (Text, Text) -> [(Text, Text)]+generateCapitalized (t1, t2) =+ let t1C = capitalize t1+ t2C = capitalize t2+ in if t1 == t1C then [(t1, t2)] else [(t1, t2), (t1C, t2C)] -- | Default set of nouns with irregular indefinite article. defIrrIndefinite :: Map Text Text
miniutter.cabal view
@@ -5,7 +5,7 @@ -- PVP summary:+-+------- breaking API changes -- | | +----- minor or non-breaking API additions -- | | | +--- code changes with no API change-version: 0.5.0.0+version: 0.5.1.0 synopsis: Simple English clause creation from arbitrary words description: This library helps in generating simple present tense English sentences from short, parametrized descriptions.@@ -20,7 +20,7 @@ bug-reports: https://github.com/Mikolaj/miniutter/issues license: BSD3 license-file: LICENSE-tested-with: GHC >= 7.4 && <= 8.6+tested-with: GHC >= 7.8 && <= 8.6 data-files: LICENSE, README.md author: Mikolaj Konarski maintainer: Mikolaj Konarski <mikolaj.konarski@funktory.com>@@ -34,7 +34,7 @@ library exposed-modules: NLP.Miniutter.English- build-depends: base >= 4 && < 5,+ build-depends: base >= 4.7 && < 5, binary >= 0.6.3.0 && < 1, text >= 0.11.2.3 && < 2, containers >= 0.4.1 && < 1,@@ -48,10 +48,11 @@ default-extensions: MonoLocalBinds, ScopedTypeVariables, OverloadedStrings BangPatterns, RecordWildCards, NamedFieldPuns, MultiWayIf, LambdaCase, DefaultSignatures, InstanceSigs,- MonadFailDesugaring, StrictData, CPP- ghc-options: -Wall -Wcompat -Worphans -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-home-modules -Widentities -Wredundant-constraints+ PatternSynonyms, StrictData, CPP+ other-extensions: DeriveGeneric+ ghc-options: -Wall -Wcompat -Worphans -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-home-modules -Widentities -Wredundant-constraints -Wpartial-fields ghc-options: -Wall-missed-specialisations- ghc-options: -fno-ignore-asserts -fexpose-all-unfoldings -fspecialise-aggressively+ ghc-options: -fno-ignore-asserts -fexpose-all-unfoldings -fspecialise-aggressively -fsimpl-tick-factor=200 } else { default-extensions: CPP, OverloadedStrings, NamedFieldPuns }@@ -61,9 +62,9 @@ main-is: test-miniutter.hs hs-source-dirs: test build-depends: miniutter,- base >= 4 && < 5,- text >= 0.11.2.3 && < 2,- containers >= 0.4.1 && < 1,+ base,+ text,+ containers, test-framework >= 0.6 && < 1, test-framework-hunit >= 0.2 && < 1, HUnit >= 1.2 && < 2@@ -76,10 +77,11 @@ default-extensions: MonoLocalBinds, ScopedTypeVariables, OverloadedStrings BangPatterns, RecordWildCards, NamedFieldPuns, MultiWayIf, LambdaCase, DefaultSignatures, InstanceSigs,- MonadFailDesugaring, StrictData, CPP- ghc-options: -Wall -Wcompat -Worphans -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-home-modules -Widentities -Wredundant-constraints+ PatternSynonyms, StrictData, CPP+ ghc-options: -Wall -Wcompat -Worphans -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-home-modules -Widentities -Wredundant-constraints -Wpartial-fields ghc-options: -Wall-missed-specialisations- ghc-options: -fno-ignore-asserts -fexpose-all-unfoldings -fspecialise-aggressively+ ghc-options: -fno-ignore-asserts -fexpose-all-unfoldings -fspecialise-aggressively -fsimpl-tick-factor=200+ ghc-options: -threaded -rtsopts } else { default-extensions: CPP, OverloadedStrings, NamedFieldPuns }
test/test-miniutter.hs view
@@ -1,12 +1,16 @@ module Main where -import Data.Monoid import qualified Data.Text as T import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (assertEqual) +#if !(MIN_VERSION_base(4,11,0))+ -- this is redundant starting with base-4.11 / GHC 8.4+import Data.Semigroup+#endif+ import qualified NLP.Miniutter.English as MU main :: IO ()@@ -80,9 +84,9 @@ [ 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 "blue dog "] "blue dogs "+ , tp [MU.Ws "blue dog."] "blue dogs."+ , tp [MU.Ws "blue dog%"] "blue dogs%" , tp [MU.Ws "bitch"] "bitches" , tp [MU.Ws "the fish"] "the fishes" , tp [MU.Ws "miss"] "misses"@@ -109,14 +113,14 @@ , 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 "staff"] "staves" -- though 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 "Tooth"] "Teeth" , tp [MU.Ws "woman"] "women" , tp [MU.Ws "buffalo"] "buffalo" , tp [MU.Ws "deer"] "deer"@@ -125,11 +129,11 @@ , tp [MU.Ws "bison"] "bison" , tp [MU.Ws "salmon"] "salmon" , tp [MU.Ws "pike"] "pike"- , tp [MU.Ws "trout"] "trout"+ , 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 "Spacecraft"] "Spacecraft" , tp [MU.Ws "hovercraft"] "hovercraft" , tp [MU.Ws "information"] "information" , tp [MU.Ws (MU.String "dog blue")] "dog blues"@@ -139,9 +143,9 @@ , 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"+ "dogs, eagle and parrot" , tp [MU.Ws (MU.WWxW "and also" ["dog", "eagle", "parrot"])]- "dog, eagle and also parrots"+ "dogs, eagle and also parrot" , 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"@@ -170,7 +174,7 @@ , tp [MU.Car1Ws 1 "blue dog"] "blue dog" , tp [MU.CarWs 1 "blue dog"] "1 blue dog" , tp [MU.Car1Ws 2 "blue elf"] "2 blue elves"- , tp [MU.CardinalWs 2 " dog "] "two dog "+ , tp [MU.CardinalWs 2 " dog "] "two dogs " , tp [MU.CarAWs 3 "leaf"] "3 leaves" , tp [MU.CardinalAWs 0 "sheep"] "no sheep" , tp [MU.CardinalAWs 1 "sheep"] "a sheep"@@ -252,7 +256,7 @@ 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 (MU.String " uncle ")] " uncle's " , tp [MU.Wown ""] "" , tp [MU.Wown " "] " " , tp [MU.Wown "miss"] "miss'"@@ -268,7 +272,7 @@ , 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 " uncle " "dog"] " uncle's dog" , tp [MU.WownW "I" ""] "my" , tp [MU.WownW "" "dog"] "dog" , tp [MU.WownW "" ""] ""@@ -295,7 +299,7 @@ , 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 "+ , tp [MU.Wown " do I "] " do mine " ] testMakePhraseSubjectVerb :: Test