inflections (empty) → 0.1.0.0

raw patch · 5 files changed

+223/−0 lines, 5 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, containers, inflections, parsec, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

LICENSE +22/−0
Setup.hs +2/−0
Text/Inflections.hs +156/−0
inflections.cabal +35/−0
test/Suite.hs +8/−0

+ LICENSE view

@@ -0,0 +1,22 @@+Copyright (c) 2014 Justin Leitgeb++MIT License++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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ Text/Inflections.hs view

@@ -0,0 +1,156 @@+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}++module Text.Inflections+    ( dasherize+    , parameterize+    , defaultTransliterations+    ) where++import Data.Char (toLower, isAsciiLower, isAsciiUpper, isAscii, isDigit)+import qualified Text.Parsec as P+import Control.Applicative+import qualified Text.ParserCombinators.Parsec.Char as C+import Data.List (group)+import Data.Maybe (mapMaybe)+import qualified Data.Map as Map++type Transliterations = Map.Map Char String++data PChar =   UCase Char+             -- Since some of the transliterating approximations expand from+             -- one Unicode to two ASCII chars (eg., œ to oe), we represent+             -- this as a String.+             | Acceptable String+             | Separator+             | Underscore+             | OtherAscii Char+             | NonAscii Char+             deriving (Eq, Show)++-- |Replaces special characters in a string so that it may be used as part of a+-- 'pretty' URL.+parameterize :: Transliterations -> String -> String+parameterize ts s =+    case parsed of+      Right ast -> (concatMap pCharToC . squeezeSeparators .+                    trimUnwanted wanted . mapMaybe (parameterizeChar ts))+                   ast++      -- Note that this should never fail, since we accommodate all Unicode+      -- characters as valid input.+      Left err -> fail $ "Parse failed, please report a bug! Error: " +++                         show err++    where parsed = P.parse parameterizableString  "" s+          wanted :: [PChar] -- All valid URL chars - we shouldn't trim these.+          wanted = Underscore :+                   map (Acceptable . (: [])) (['a'..'z'] ++ ['0'..'9'])++-- |Replaces underscores with dashes in the string.+dasherize :: String -> String+dasherize = map (\c -> if c == ' ' then '-' else c)+++-- Private functions++-- |Matches 'acceptable' characters for parameterization purposes.+acceptableParser :: P.Stream s m Char => P.ParsecT s u m PChar+acceptableParser = do+  c <- C.satisfy isValidParamChar+  return $ Acceptable [c]++parameterizableString :: P.Stream s m Char => P.ParsecT s u m [PChar]+parameterizableString = P.many $ P.choice [+           acceptableParser+         , UCase      <$> C.satisfy isAsciiUpper+         , C.char '-' >> return Separator+         , C.char '_' >> return Underscore+         , OtherAscii <$> C.satisfy isAscii+         , NonAscii   <$> C.satisfy (not . isAscii)+         ]++-- |Look up character in transliteration list.+transliterate :: Transliterations -> Char -> Maybe PChar+transliterate ts c =+    case Map.lookup c ts of+      Just v  -> -- We may have expanded into multiple characters during+                 -- transliteration, so check validity of all characters in+                 -- result.+                 if all isValidParamChar v then+                     Just $ Acceptable v+                 else+                     Nothing++      Nothing -> Nothing++isValidParamChar :: Char -> Bool+isValidParamChar c = isAsciiLower c || isDigit c++-- |Given a Transliteration table and a PChar, returns Maybe PChar indicating+-- how this character should appear in a URL.+parameterizeChar :: Transliterations -> PChar -> Maybe PChar+parameterizeChar _  (UCase c)      = Just $ Acceptable [toLower c]+parameterizeChar _  (Acceptable c) = Just $ Acceptable c+parameterizeChar _  Separator      = Just Separator+parameterizeChar _  Underscore     = Just Underscore+parameterizeChar _  (OtherAscii _) = Just Separator+parameterizeChar ts (NonAscii c)   = transliterate ts c++-- |Turns PChar tokens into their String representation.+pCharToC :: PChar -> String+pCharToC (UCase c)        = [c]+pCharToC (Acceptable str) = str+pCharToC Separator        = "-"+pCharToC Underscore       = "_"+pCharToC (OtherAscii c)   = [c]+pCharToC (NonAscii c)     = [c]++-- |These default transliterations stolen from the Ruby i18n library -+-- https://github.com/svenfuchs/i18n/blob/master/lib/i18n/backend/transliterator.rb#L41:L69+defaultTransliterations :: Map.Map Char String+defaultTransliterations = Map.fromList [+  ('À', "A"), ('Á', "A"), ('Â', "A"), ('Ã', "A"), ('Ä', "A"), ('Å', "A"),+  ('Æ', "AE"), ('Ç', "C"), ('È', "E"), ('É', "E"), ('Ê', "E"), ('Ë', "E"),+  ('Ì', "I"), ('Í', "I"), ('Î', "I"), ('Ï', "I"), ('Ð', "D"), ('Ñ', "N"),+  ('Ò', "O"), ('Ó', "O"), ('Ô', "O"), ('Õ', "O"), ('Ö', "O"), ('×', "x"),+  ('Ø', "O"), ('Ù', "U"), ('Ú', "U"), ('Û', "U"), ('Ü', "U"), ('Ý', "Y"),+  ('Þ', "Th"), ('ß', "ss"), ('à', "a"), ('á', "a"), ('â', "a"), ('ã', "a"),+  ('ä', "a"), ('å', "a"), ('æ', "ae"), ('ç', "c"), ('è', "e"), ('é', "e"),+  ('ê', "e"), ('ë', "e"), ('ì', "i"), ('í', "i"), ('î', "i"), ('ï', "i"),+  ('ð', "d"), ('ñ', "n"), ('ò', "o"), ('ó', "o"), ('ô', "o"), ('õ', "o"),+  ('ö', "o"), ('ø', "o"), ('ù', "u"), ('ú', "u"), ('û', "u"), ('ü', "u"),+  ('ý', "y"), ('þ', "th"), ('ÿ', "y"), ('Ā', "A"), ('ā', "a"), ('Ă', "A"),+  ('ă', "a"), ('Ą', "A"), ('ą', "a"), ('Ć', "C"), ('ć', "c"), ('Ĉ', "C"),+  ('ĉ', "c"), ('Ċ', "C"), ('ċ', "c"), ('Č', "C"), ('č', "c"), ('Ď', "D"),+  ('ď', "d"), ('Đ', "D"), ('đ', "d"), ('Ē', "E"), ('ē', "e"), ('Ĕ', "E"),+  ('ĕ', "e"), ('Ė', "E"), ('ė', "e"), ('Ę', "E"), ('ę', "e"), ('Ě', "E"),+  ('ě', "e"), ('Ĝ', "G"), ('ĝ', "g"), ('Ğ', "G"), ('ğ', "g"), ('Ġ', "G"),+  ('ġ', "g"), ('Ģ', "G"), ('ģ', "g"), ('Ĥ', "H"), ('ĥ', "h"), ('Ħ', "H"),+  ('ħ', "h"), ('Ĩ', "I"), ('ĩ', "i"), ('Ī', "I"), ('ī', "i"), ('Ĭ', "I"),+  ('ĭ', "i"), ('Į', "I"), ('į', "i"), ('İ', "I"), ('ı', "i"), ('Ĳ', "IJ"),+  ('ĳ', "ij"), ('Ĵ', "J"), ('ĵ', "j"), ('Ķ', "K"), ('ķ', "k"), ('ĸ', "k"),+  ('Ĺ', "L"), ('ĺ', "l"), ('Ļ', "L"), ('ļ', "l"), ('Ľ', "L"), ('ľ', "l"),+  ('Ŀ', "L"), ('ŀ', "l"), ('Ł', "L"), ('ł', "l"), ('Ń', "N"), ('ń', "n"),+  ('Ņ', "N"), ('ņ', "n"), ('Ň', "N"), ('ň', "n"), ('ŉ', "'n"), ('Ŋ', "NG"),+  ('ŋ', "ng"), ('Ō', "O"), ('ō', "o"), ('Ŏ', "O"), ('ŏ', "o"), ('Ő', "O"),+  ('ő', "o"), ('Œ', "OE"), ('œ', "oe"), ('Ŕ', "R"), ('ŕ', "r"), ('Ŗ', "R"),+  ('ŗ', "r"), ('Ř', "R"), ('ř', "r"), ('Ś', "S"), ('ś', "s"), ('Ŝ', "S"),+  ('ŝ', "s"), ('Ş', "S"), ('ş', "s"), ('Š', "S"), ('š', "s"), ('Ţ', "T"),+  ('ţ', "t"), ('Ť', "T"), ('ť', "t"), ('Ŧ', "T"), ('ŧ', "t"), ('Ũ', "U"),+  ('ũ', "u"), ('Ū', "U"), ('ū', "u"), ('Ŭ', "U"), ('ŭ', "u"), ('Ů', "U"),+  ('ů', "u"), ('Ű', "U"), ('ű', "u"), ('Ų', "U"), ('ų', "u"), ('Ŵ', "W"),+  ('ŵ', "w"), ('Ŷ', "Y"), ('ŷ', "y"), ('Ÿ', "Y"), ('Ź', "Z"), ('ź', "z"),+  ('Ż', "Z"), ('ż', "z"), ('Ž', "Z"), ('ž', "z")]++-- |Reduce sequences of separators down to only one separator.+squeezeSeparators :: [PChar] -> [PChar]+squeezeSeparators ps = concatMap squashSeparatorGroup $ group ps+    where squashSeparatorGroup g = case head g of+                                     Separator -> [Separator] -- only take head+                                     _         -> g           -- don't change++-- |Trim non-wanted elements from the beginning and end of list.+trimUnwanted :: Eq a => [a] -> [a] -> [a]+trimUnwanted wanted xs = dropWhile notWanted $ reverse $ dropWhile notWanted $+                         reverse xs+  where notWanted elt = elt `notElem` wanted

+ inflections.cabal view

@@ -0,0 +1,35 @@+name:                inflections+version:             0.1.0.0+synopsis:            Inflections library for Haskell+description:+  Inflections provides methods for singularization, pluralization, dasherizing, etc. The library is based on Rails' inflections library.+license:             MIT+license-file:        LICENSE+author:              Justin Leitgeb+maintainer:          justin@stackbuilders.com+copyright:           2014 Justin Leitgeb+category:            Text+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  exposed-modules:     Text.Inflections+  ghc-options:         -Wall+  build-depends:       base >=4.6 && <4.7, parsec, containers+  default-language:    Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Suite.hs+  build-depends:+      inflections+      , base >=4.6 && <4.7+      , test-framework+      , HUnit+      , QuickCheck+      , test-framework-hunit+      , test-framework-quickcheck2+      , containers+  default-language:    Haskell2010

+ test/Suite.hs view

@@ -0,0 +1,8 @@+module Main where++import  Test.Framework (defaultMain)++import qualified Text.Inflections.Tests++main :: IO ()+main = defaultMain Text.Inflections.Tests.tests