diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2015 brady.ouren + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,66 @@ +# Countable Inflections + +[![License MIT](https://img.shields.io/badge/license-MIT-brightgreen.svg)](http://opensource.org/licenses/MIT) +[![Hackage](https://img.shields.io/hackage/v/countable-inflections.svg)](http://hackage.haskell.org/package/countable-inflections) +[![Stackage LTS](http://stackage.org/package/countable-inflections/badge/lts)](http://stackage.org/lts/package/countable-inflections) +[![Build Status](https://circleci.com/gh/tippenein/countable-inflections.svg?style=shield&circle-token=)](https://circleci.com/gh/tippenein/countable-inflections) + +This library implements pluralization and singularization in a similar way to the [rails inflectors](http://api.rubyonrails.org/classes/ActiveSupport/Inflector.html) + +It uses regexes to define the non-standard transformations and therefore +doesn't provide much safety. If you need to provide the same pluralization and +singularization which rails does out of the box, this will work the same. If +you want _more_ you should be using +[inflections-hs](https://github.com/stackbuilders/inflections-hs) which uses +megaparsec to give you more guarantees + +## Usage + +```haskell +λ: pluralize "person" +"people" + +λ: singularize "branches" +"branch" +``` + +These can also be given custom inflection matchers + +``` +λ: :t singularizeWith +[Inflection] -> Text -> Text +``` + +There are 3 different types of transformations: + +Match (takes a PCRE regex and a replacement string) + +``` +λ: :t makeMatchMapping +[(RegexPattern, RegexReplace)] -> [Inflection] + +λ: let mapping = makeMatchMapping [("(octop)us", "\1i")] +λ: pluralizeWith mapping "octopus" +"octopi" +``` + +Irregular (from singular to plural with no greater pattern) + +``` +λ: :t makeIrregularMapping +[(Singular, Plural)] -> [Inflection] + +λ: let mapping = makeIrregularMapping [("zombie","zombies")] +λ: pluralizeWith mapping "zombie" +"zombies" +``` + +Uncountable (doesn't have a mapping, word stays the same) so it has the type: +``` +[Text] -> [Inflection] +``` + + +## License + +MIT - see [the LICENSE file](LICENSE.md). diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Text/Countable.hs b/Text/Countable.hs new file mode 100644 --- /dev/null +++ b/Text/Countable.hs @@ -0,0 +1,141 @@ +-- | +-- Module : Text.Countable +-- Copyright : © 2016 Brady Ouren +-- License : MIT +-- +-- Maintainer : Brady Ouren +-- Stability : experimental +-- Portability : portable +-- +-- pluralization and singularization transformations + +{-# LANGUAGE OverloadedStrings #-} + +module Text.Countable + ( pluralize + , pluralizeWith + , singularize + , singularizeWith + , makeMatchMapping + , makeIrregularMapping + , makeUncountableMapping + ) +where + +import Data.Maybe (catMaybes, fromMaybe) +import Data.Monoid ((<>)) +import Data.Text as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Text.Countable.Data +import Text.Regex.PCRE.Light + +type RegexPattern = T.Text +type RegexReplace = T.Text +type Singular = T.Text +type Plural = T.Text + +data Inflection + = Simple (Singular, Plural) + | Match (Maybe Regex, RegexReplace) + +-- | pluralize a word given a default mapping +pluralize :: T.Text -> T.Text +pluralize = pluralizeWith mapping + where + mapping = defaultIrregulars ++ defaultUncountables ++ defaultPlurals + +-- | singularize a word given a default mapping +singularize :: T.Text -> T.Text +singularize = singularizeWith mapping + where + mapping = defaultIrregulars ++ defaultUncountables ++ defaultSingulars + +-- | pluralize a word given a custom mapping. +-- Build the [Inflection] with a combination of +-- `makeUncountableMapping` `makeIrregularMapping` `makeMatchMapping` +pluralizeWith :: [Inflection] -> T.Text -> T.Text +pluralizeWith mapping t = fromMaybe t $ headMaybe matches + where + matches = catMaybes $ fmap (pluralLookup t) (Prelude.reverse mapping) + +-- | singularize a word given a custom mapping. +-- Build the [Inflection] with a combination of +-- `makeUncountableMapping` `makeIrregularMapping` `makeMatchMapping` +singularizeWith :: [Inflection] -> T.Text -> T.Text +singularizeWith mapping t = fromMaybe t $ headMaybe matches + where + matches = catMaybes $ fmap (singularLookup t) (Prelude.reverse mapping) + +-- | Makes a simple list of mappings from singular to plural, e.g [("person", "people")] +-- the output of [Inflection] should be consumed by `singularizeWith` or `pluralizeWith` +makeMatchMapping :: [(RegexPattern, RegexReplace)] -> [Inflection] +makeMatchMapping = fmap (\(pattern, rep) -> Match (regexPattern pattern, rep)) + +-- | Makes a simple list of mappings from singular to plural, e.g [("person", "people")] +-- the output of [Inflection] should be consumed by `singularizeWith` or `pluralizeWith` +makeIrregularMapping :: [(Singular, Plural)] -> [Inflection] +makeIrregularMapping = fmap Simple + +-- | Makes a simple list of uncountables which don't have +-- singular plural versions, e.g ["fish", "money"] +-- the output of [Inflection] should be consumed by `singularizeWith` or `pluralizeWith` +makeUncountableMapping :: [T.Text] -> [Inflection] +makeUncountableMapping = fmap (\a -> (Simple (a,a))) + + +defaultPlurals :: [Inflection] +defaultPlurals = makeMatchMapping defaultPlurals' + +defaultSingulars :: [Inflection] +defaultSingulars = makeMatchMapping defaultSingulars' + +defaultIrregulars :: [Inflection] +defaultIrregulars = makeIrregularMapping defaultIrregulars' + +defaultUncountables :: [Inflection] +defaultUncountables = makeUncountableMapping defaultUncountables' + +pluralLookup :: T.Text -> Inflection -> Maybe T.Text +pluralLookup t (Match (r1,r2)) = runSub (r1,r2) t +pluralLookup t (Simple (a,b)) = if t == a then (Just b) else Nothing + +singularLookup :: T.Text -> Inflection -> Maybe T.Text +singularLookup t (Match (r1,r2)) = runSub (r1,r2) t +singularLookup t (Simple (a,b)) = if t == b then (Just a) else Nothing + +runSub :: (Maybe Regex, RegexReplace) -> T.Text -> Maybe T.Text +runSub (Nothing, _) _ = Nothing +runSub (Just reg, rep) t = matchWithReplace (reg, rep) t + +matchWithReplace :: (Regex, RegexReplace) -> T.Text -> Maybe T.Text +matchWithReplace (reg, rep) t = do + matched : grouping <- regexMatch t reg + return $ (t `without` matched) <> groupReplace grouping rep + where + without t1 t2 = if t2 == "" then t1 else T.replace t2 "" t1 + +groupReplace :: [T.Text] -> T.Text -> T.Text +groupReplace g rep = + case g of + [] -> rep + (g':_) -> g' <> additions + where + rep' = tailMaybe $ T.split ((==) '\1') rep + additions = T.concat $ fromMaybe [] rep' + +regexMatch :: T.Text -> Regex -> Maybe [T.Text] +regexMatch t r = do + bs <- match r (encodeUtf8 t) [] + return $ fmap decodeUtf8 bs + +regexPattern :: T.Text -> Maybe Regex +regexPattern pat = toMaybe $ compileM (encodeUtf8 pat) [caseless] + where toMaybe = either (const Nothing) Just + +headMaybe :: [a] -> Maybe a +headMaybe [] = Nothing +headMaybe (x:_) = Just x + +tailMaybe :: [a] -> Maybe [a] +tailMaybe [] = Nothing +tailMaybe (_:xs) = Just xs diff --git a/Text/Countable/Data.hs b/Text/Countable/Data.hs new file mode 100644 --- /dev/null +++ b/Text/Countable/Data.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Text.Countable +-- Copyright : © 2016 Brady Ouren +-- License : MIT +-- +-- Maintainer : Brady Ouren +-- Stability : experimental +-- Portability : portable +-- +-- default seed data for transformations + +module Text.Countable.Data where + +import Data.Text (Text) + +-- |These default inflections stolen from the Ruby inflection library - see +-- https://github.com/rails/rails/blob/master/activesupport/lib/active_support/inflections.rb +defaultPlurals' :: [(Text, Text)] +defaultPlurals' = + [ ("$", "s") + , ("s$", "s") + , ("^(ax|test)is$", "\1es") + , ("(octop|vir)us$", "\1i") + , ("(octop|vir)i$", "\1i") + , ("(alias|status)$", "\1es") + , ("(bu)s$", "\1ses") + , ("(buffal|tomat)o$", "\1oes") + , ("([ti])um$", "\1a") + , ("([ti])a$", "\1a") + , ("sis$", "ses") + , ("(?:([^f])fe|([lr])f)$", "\1\2ves") + , ("(hive)$", "\1s") + , ("([^aeiouy]|qu)y$", "\1ies") + , ("(x|ch|ss|sh)$", "\1es") + , ("(matr|vert|ind)(?:ix|ex)$", "\1ices") + , ("^(m|l)ouse$", "\1ice") + , ("^(m|l)ice$", "\1ice") + , ("^(ox)$", "\1en") + , ("^(oxen)$", "\1") + , ("(quiz)$", "\1zes") + ] + +-- |These default inflections stolen from the Ruby inflection library - see +-- https://github.com/rails/rails/blob/master/activesupport/lib/active_support/inflections.rb +defaultSingulars' :: [(Text, Text)] +defaultSingulars' = + [ ("s$", "") + , ("(ss)$", "\1") + , ("(n)ews$", "\1ews") + , ("([ti])a$", "\1um") + , ("((a)naly|(b)a|(d)iagno|(p)arenthe|(p)rogno|(s)ynop|(t)he)(sis|ses)$", "\1sis") + , ("(^analy)(sis|ses)$", "\1sis") + , ("([^f])ves$", "\1fe") + , ("(hive)s$", "\1") + , ("(tive)s$", "\1") + , ("([lr])ves$", "\1f") + , ("([^aeiouy]|qu)ies$", "\1y") + , ("(s)eries$", "\1eries") + , ("(m)ovies$", "\1ovie") + , ("(x|ch|ss|sh)es$", "\1") + , ("^(m|l)ice$", "\1ouse") + , ("(bus)(es)?$", "\1") + , ("(o)es$", "\1") + , ("(shoe)s$", "\1") + , ("(cris|test)(is|es)$", "\1is") + , ("^(a)x[ie]s$", "\1xis") + , ("(octop|vir)(us|i)$", "\1us") + , ("(alias|status)(es)?$", "\1") + , ("^(ox)en", "\1") + , ("(vert|ind)ices$", "\1ex") + , ("(matr)ices$", "\1ix") + , ("(quiz)zes$", "\1") + , ("(database)s$", "\1") + ] + +-- |These default irregular inflections stolen from the Ruby inflection library - see +-- https://github.com/rails/rails/blob/master/activesupport/lib/active_support/inflections.rb +defaultIrregulars' :: [(Text, Text)] +defaultIrregulars' = + -- from singular to plural + [ ("person", "people") + , ("man", "men") + , ("child", "children") + , ("sex", "sexes") + , ("move", "moves") + , ("zombie", "zombies") + ] + +-- |These default uncountable inflections stolen from the Ruby inflection library - see +-- https://github.com/rails/rails/blob/master/activesupport/lib/active_support/inflections.rb +defaultUncountables' :: [Text] +defaultUncountables' = + [ "equipment" + , "information" + , "rice" + , "money" + , "species" + , "series" + , "fish" + , "sheep" + , "jeans" + , "police" + ] diff --git a/countable-inflections.cabal b/countable-inflections.cabal new file mode 100644 --- /dev/null +++ b/countable-inflections.cabal @@ -0,0 +1,54 @@ +name: countable-inflections +version: 0.0.1 +synopsis: Countable Text Inflections +description: + Provides methods for singularizing and pluralizing text. + The library is based on Rails' inflections. + +license: MIT +license-file: LICENSE.md +author: Brady Ouren +homepage: https://github.com/tippenein/countable-inflections +bug-reports: https://github.com/tippenein/countable-inflections/issues +maintainer: Brady Ouren +copyright: 2016 Brady Ouren +category: Text +build-type: Simple +cabal-version: >=1.10 +extra-source-files: CHANGELOG.md + , README.md + +source-repository head + type: git + location: https://github.com/tippenein/countable-inflections.git + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + exposed-modules: Text.Countable + other-modules: Text.Countable.Data + ghc-options: -Wall + build-depends: + base >= 4.6 && < 4.10 + , exceptions >= 0.6 && < 0.9 + , text >= 0.2 && < 1.3 + , pcre-light + , bytestring + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: + countable-inflections + , QuickCheck >= 2.7.6 && < 3.0 + , base >= 4.2 && < 4.10 + , hspec >= 2.0 && < 3.0 + , text >= 0.2 && < 1.3 + ghc-options: -Wall + default-language: Haskell2010 + other-modules: Text.CountableSpec diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Text/CountableSpec.hs b/test/Text/CountableSpec.hs new file mode 100644 --- /dev/null +++ b/test/Text/CountableSpec.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Text.CountableSpec (spec) where + +import Test.Hspec + +import Text.Countable + +spec :: Spec +spec = do + irregularCases + matchingCases + +matchingCases :: Spec +matchingCases = do + describe "laws" $ do + let equality1 a = a `shouldBe` (singularize . pluralize) a + let equality2 a = a `shouldBe` (pluralize . singularize) a + + it "returns itself when applied to (singularize . pluralize)" $ + mapM_ equality1 ["thing", "branch", "ox"] + + it "returns itself when applied to (pluralize . singularize)" $ + mapM_ equality2 ["things", "branches", "oxen"] + + describe "pluralize" $ do + it "handles the normal case" $ do + pluralize "thing" `shouldBe` "things" + + it "pluralizes regex cases" $ do + pluralize "ox" `shouldBe` "oxen" + pluralize "vertex" `shouldBe` "vertices" + + describe "singularize" $ do + it "singularizes regex cases" $ do + singularize "mice" `shouldBe` "mouse" + singularize "oxen" `shouldBe` "ox" + singularize "branches" `shouldBe` "branch" + + +irregularCases :: Spec +irregularCases = + it "can singularize irregulars" $ + singularize "people" `shouldBe` "person"