packages feed

inflections 0.1.0.2 → 0.1.0.3

raw patch · 13 files changed

+373/−154 lines, 13 files

Files

Text/Inflections.hs view
@@ -1,67 +1,44 @@-{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}- module Text.Inflections-    ( dasherize+    ( camelize+    , camelizeCustom++    , dasherize+    , dasherizeCustom++    , underscore+    , underscoreCustom++    , defaultMap+     , parameterize+    , parameterizeCustom+     , transliterate     , transliterateCustom-    , defaultTransliterations-    ) where+    )+where -import Data.Char (toLower, isAsciiLower, isAsciiUpper, isAscii, isDigit)-import qualified Text.Parsec as P-import Control.Applicative-import Control.Monad (guard)-import qualified Text.ParserCombinators.Parsec.Char as C-import Data.List (group)-import Data.Maybe (mapMaybe)+import Data.Char (isAscii) 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. Uses the default transliterations in this library-parameterize :: String -> String-parameterize = parameterizeCustom defaultTransliterations+import Text.Inflections.Data (defaultMap) -parameterizeCustom :: Transliterations -> String -> String-parameterizeCustom ts s =-    case parsed of-      Right ast -> (concatMap pCharToC . squeezeSeparators .-                    trimUnwanted wanted . mapMaybe (parameterizeChar ts))-                   ast+import Text.Inflections.Parameterize ( Transliterations+                                     , parameterize+                                     , parameterizeCustom ) -      -- 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+import Text.Inflections.Underscore ( underscore, underscoreCustom ) -    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'])+import Text.Inflections.Camelize ( camelize, camelizeCustom ) --- |Replaces underscores with dashes in the string.-dasherize :: String -> String-dasherize = map (\c -> if c == ' ' then '-' else c)+import Text.Inflections.Dasherize ( dasherize, dasherizeCustom )  -- |Returns a String after default approximations for changing Unicode characters -- to a valid ASCII range are applied. If you want to supplement the default -- approximations with your own, you should use the transliterateCustom -- function instead of transliterate. transliterate :: String -> String-transliterate = transliterateCustom "?" defaultTransliterations+transliterate = transliterateCustom "?" defaultMap  -- |Returns a String after default approximations for changing Unicode characters -- to a valid ASCII range are applied.@@ -74,107 +51,3 @@             case Map.lookup c ts of               Nothing  -> replacement               Just val -> val---- |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"),-  ('ij', "ij"), ('Ĵ', "J"), ('ĵ', "j"), ('Ķ', "K"), ('ķ', "k"), ('ĸ', "k"),-  ('Ĺ', "L"), ('ĺ', "l"), ('Ļ', "L"), ('ļ', "l"), ('Ľ', "L"), ('ľ', "l"),-  ('Ŀ', "L"), ('ŀ', "l"), ('Ł', "L"), ('ł', "l"), ('Ń', "N"), ('ń', "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")]----- Private functions----- |Look up character in transliteration list. Accepts a Transliteration map--- which has Chars as keys and Strings as values for approximating common--- international Unicode characters within the ASCII range.-transliteratePCharCustom :: Transliterations -> Char -> Maybe PChar-transliteratePCharCustom ts c = do-  -- We may have expanded into multiple characters during-  -- transliteration, so check validity of all characters in-  -- result.-  v <- Map.lookup c ts-  guard (all isValidParamChar v)-  return (Acceptable v)---- |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-         , Separator  <$  C.char '-'-         , Underscore <$  C.char '_'-         , OtherAscii <$> C.satisfy isAscii-         , NonAscii   <$> C.satisfy (not . isAscii)-         ]--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)   = transliteratePCharCustom 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]---- |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 = dropWhile notWanted . reverse . dropWhile notWanted-                      . reverse-  where notWanted = (`notElem` wanted)
+ Text/Inflections/Camelize.hs view
@@ -0,0 +1,39 @@+module Text.Inflections.Camelize+  ( camelize+  , camelizeCustom )+where++import Text.Inflections.Parse.SnakeCase (Word(..), parser)+import Text.Parsec (ParseError, parse)+import Data.Char (toUpper)++-- |Turns a String in snake_case into CamelCase. Returns the CamelCase string,+-- or a ParseError if the input String is not in valid snake_case.+camelize+  :: String -- ^ The input string, in snake_case+  -> Either ParseError String+camelize s = camelizeCustom [] True s++-- |Turns an input String in snake_case into CamelCase. Returns the CamelCase+-- String, or a ParseError if the input String is not in valid snake_case.+-- Accepts arguments to control parsing and output format.+camelizeCustom+  :: [String] -- ^ A list of acronyms that will be kept whole and accepted as valid input+  -> Bool     -- ^ Whether to capitalize the first character in the output String+  -> String   -- ^ The input string, in snake_case+  -> Either ParseError String+camelizeCustom acronyms isFirstCap s =+  case parse (parser acronyms) "(unknown)" s of+    Left errs -> Left errs+    Right res -> Right $ concatMap (caseForWord isFirstCap) $ isFirstList res++caseForWord :: Bool -> (Word, Bool) -> String+caseForWord True (Word (c:cs), True) = toUpper c : cs+caseForWord False (Word s, True)     = s+caseForWord _ (Word (c:cs), _)       = toUpper c : cs+caseForWord _ (Word [], _)           = []+caseForWord _ (Acronym s, _)         = s++-- |Returns list with Bool indicating if an element is first.+isFirstList :: [a] -> [(a, Bool)]+isFirstList xs = zip xs $ True : repeat False
+ Text/Inflections/Dasherize.hs view
@@ -0,0 +1,31 @@+module Text.Inflections.Dasherize+  ( dasherize+  , dasherizeCustom )+where++import Text.Inflections.Parse.SnakeCase (Word(..), parser)+import Text.Parsec (ParseError, parse)++import Data.List (intercalate)++-- |Replaces underscores in a snake_cased string with dashes (hyphens).+dasherize+  :: String -- ^ The input string, in snake_case+  -> Either ParseError String+dasherize s = dasherizeCustom [] s++-- |Turns a snake_case string into dasherized form. Returns a ParseError if+-- the input string is not in proper snake_case.+dasherizeCustom+  :: [String] -- ^ A list of acronyms that will be kept whole and accepted as valid input+  -> String   -- ^ The input string, in snake_case+  -> Either ParseError String+dasherizeCustom acronyms s =+  case parse (parser acronyms) "(unknown)" s of+    Left errs -> Left errs+    Right res -> Right $ intercalate "-" $ map toString res+++toString :: Word -> String+toString (Acronym s) = s+toString (Word s)    = s
+ Text/Inflections/Data.hs view
@@ -0,0 +1,40 @@+module Text.Inflections.Data where++import Data.Map (Map, fromList)++-- |These default transliterations stolen from the Ruby i18n library -+-- https://github.com/svenfuchs/i18n/blob/master/lib/i18n/backend/transliterator.rb#L41:L69+defaultMap :: Map Char String+defaultMap = 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"),+  ('ij', "ij"), ('Ĵ', "J"), ('ĵ', "j"), ('Ķ', "K"), ('ķ', "k"), ('ĸ', "k"),+  ('Ĺ', "L"), ('ĺ', "l"), ('Ļ', "L"), ('ļ', "l"), ('Ľ', "L"), ('ľ', "l"),+  ('Ŀ', "L"), ('ŀ', "l"), ('Ł', "L"), ('ł', "l"), ('Ń', "N"), ('ń', "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")]
+ Text/Inflections/Parameterize.hs view
@@ -0,0 +1,89 @@+module Text.Inflections.Parameterize+  ( parameterize+  , parameterizeCustom+  , Transliterations )+where++import qualified Data.Map as Map+import Control.Monad (guard)+import Data.Maybe (mapMaybe)++import Data.Char (toLower)++import Data.List (group)+import qualified Text.Parsec as P++import Text.Inflections.Data (defaultMap)+import Text.Inflections.Parse.Parameterizable ( PChar(..)+                                              , parser+                                              , isValidParamChar )++-- |A Map containing mappings from international characters to sequences+-- approximating these characters within the ASCII range.+type Transliterations = Map.Map Char String++-- |Replaces special characters in a string so that it may be used as part of a+-- 'pretty' URL. Uses the default transliterations in this library+parameterize :: String -> String+parameterize = parameterizeCustom defaultMap++parameterizeCustom :: Transliterations -> String -> String+parameterizeCustom 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 parser  "" s+          wanted :: [PChar] -- All valid URL chars - we shouldn't trim these.+          wanted = Underscore :+                   map (Acceptable . (: [])) (['a'..'z'] ++ ['0'..'9'])++-- |Look up character in transliteration list. Accepts a Transliteration map+-- which has Chars as keys and Strings as values for approximating common+-- international Unicode characters within the ASCII range.+transliteratePCharCustom :: Transliterations -> Char -> Maybe PChar+transliteratePCharCustom ts c = do+  -- We may have expanded into multiple characters during+  -- transliteration, so check validity of all characters in+  -- result.+  v <- Map.lookup c ts+  guard (all isValidParamChar v)+  return (Acceptable v)++-- |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)   = transliteratePCharCustom 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]++-- |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 = dropWhile notWanted . reverse . dropWhile notWanted+                      . reverse+  where notWanted = (`notElem` wanted)
+ Text/Inflections/Parse/Acronym.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}++module Text.Inflections.Parse.Acronym ( acronym ) where++import qualified Text.ParserCombinators.Parsec.Char as C+import qualified Text.Parsec as P+import qualified Text.Parsec.Prim as Prim++import Text.Inflections.Parse.Types++import Control.Applicative ((<$>))++acronym :: P.Stream s m Char => [String] -> P.ParsecT s u m Word+acronym as = Acronym <$> (P.choice $ map (Prim.try . C.string) as)
+ Text/Inflections/Parse/CamelCase.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}++module Text.Inflections.Parse.CamelCase ( parser )+where++import qualified Text.ParserCombinators.Parsec.Char as C+import qualified Text.Parsec as P++import Text.Inflections.Parse.Types (Word(..))+import Text.Inflections.Parse.Acronym (acronym)++word :: P.Stream s m Char => P.ParsecT s u m Word+word = do+  firstChar <- C.upper P.<|> C.lower+  restChars <- P.many C.lower+  return $ Word $ firstChar : restChars++parser :: P.Stream s m Char => [String] -> P.ParsecT s u m [Word]+parser acronyms = do+  ws <- P.many $ P.choice [ acronym acronyms, word ]+  P.eof+  return ws
+ Text/Inflections/Parse/Parameterizable.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}++module Text.Inflections.Parse.Parameterizable+  ( parser+  , isValidParamChar+  , PChar(..) )+where++import Data.Char (isAsciiLower, isAsciiUpper, isAscii, isDigit)+import Control.Applicative+import qualified Text.Parsec as P+import qualified Text.ParserCombinators.Parsec.Char as C++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)++-- |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]++parser :: P.Stream s m Char => P.ParsecT s u m [PChar]+parser = P.many $ P.choice [+           acceptableParser+         , UCase      <$> C.satisfy isAsciiUpper+         , Separator  <$  C.char '-'+         , Underscore <$  C.char '_'+         , OtherAscii <$> C.satisfy isAscii+         , NonAscii   <$> C.satisfy (not . isAscii)+         ]++isValidParamChar :: Char -> Bool+isValidParamChar c = isAsciiLower c || isDigit c
+ Text/Inflections/Parse/SnakeCase.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}++module Text.Inflections.Parse.SnakeCase ( Word(..), parser )+where++import qualified Text.ParserCombinators.Parsec.Char as C+import qualified Text.Parsec as P+import Control.Applicative ((<$>))++import Text.Inflections.Parse.Types (Word(..))+import Text.Inflections.Parse.Acronym (acronym)++word :: P.Stream s m Char => P.ParsecT s u m Word+word = Word <$> P.many1 C.lower++parser :: P.Stream s m Char => [String] -> P.ParsecT s u m [Word]+parser acronyms = do+  ws <- (acronym acronyms P.<|> word) `P.sepBy` (C.char '_')+  P.eof+  return ws
+ Text/Inflections/Parse/Types.hs view
@@ -0,0 +1,5 @@+module Text.Inflections.Parse.Types ( Word(..) ) where++data Word = Word String+          | Acronym String deriving (Show, Eq)+
+ Text/Inflections/Underscore.hs view
@@ -0,0 +1,31 @@+module Text.Inflections.Underscore (underscore, underscoreCustom) where++import Text.Inflections.Parse.CamelCase (parser)+import Text.Inflections.Parse.Types (Word(..))++import Text.Parsec (ParseError, parse)+import Data.Char (toLower)+import Data.List (intercalate)++-- |Turns a CamelCase string into an underscore_separated String.+underscore+  :: String -- ^ A String in CamelCase+  -> Either ParseError String+underscore s = underscoreCustom [] s++-- |Changes an input String in CamelCase into a String of Words separated by+-- underscores. Accepts options for customization.+underscoreCustom+  :: [String] -- ^ A list of acronyms that will be kept whole and accepted as valid input+  -> String -- ^ A String in CamelCase+  -> Either ParseError String+underscoreCustom acronyms s =+  case parse (parser acronyms) "(unknown)" s of+    Left errs -> Left errs+    Right res -> Right $ intercalate "_" $ map toDowncasedString res+++toDowncasedString :: Word -> String+toDowncasedString (Acronym s) = map toLower s+toDowncasedString (Word s) = map toLower s+
inflections.cabal view
@@ -1,5 +1,5 @@ name:                inflections-version:             0.1.0.2+version:             0.1.0.3 synopsis:            Inflections library for Haskell description:   Inflections provides methods for singularization, pluralization, dasherizing, etc. The library is based on Rails' inflections library.@@ -19,7 +19,17 @@   location:        https://github.com/stackbuilders/inflections-hs.git  library-  exposed-modules:     Text.Inflections+  exposed-modules:       Text.Inflections+                       , Text.Inflections.Parse.CamelCase+                       , Text.Inflections.Parse.SnakeCase+                       , Text.Inflections.Parse.Parameterizable+                       , Text.Inflections.Parse.Types+  other-modules:         Text.Inflections.Data+                       , Text.Inflections.Parameterize+                       , Text.Inflections.Underscore+                       , Text.Inflections.Camelize+                       , Text.Inflections.Parse.Acronym+                       , Text.Inflections.Dasherize   ghc-options:         -Wall   build-depends:       base >=4.5 && <4.7, parsec, containers   default-language:    Haskell2010@@ -36,5 +46,6 @@       , QuickCheck       , test-framework-hunit       , test-framework-quickcheck2+      , parsec       , containers   default-language:    Haskell2010
test/Suite.hs view
@@ -3,6 +3,8 @@ import  Test.Framework (defaultMain)  import qualified Text.Inflections.Tests+import qualified Text.Inflections.Parse.CamelCaseTest  main :: IO ()-main = defaultMain Text.Inflections.Tests.tests+main = defaultMain $ Text.Inflections.Tests.tests +++                     Text.Inflections.Parse.CamelCaseTest.tests