inflections 0.1.0.1 → 0.1.0.2
raw patch · 2 files changed
+86/−62 lines, 2 filesdep ~base
Dependency ranges changed: base
Files
- Text/Inflections.hs +83/−59
- inflections.cabal +3/−3
Text/Inflections.hs view
@@ -3,12 +3,15 @@ module Text.Inflections ( dasherize , parameterize+ , transliterate+ , transliterateCustom , defaultTransliterations ) 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)@@ -28,9 +31,12 @@ 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 =+-- 'pretty' URL. Uses the default transliterations in this library+parameterize :: String -> String+parameterize = parameterizeCustom defaultTransliterations++parameterizeCustom :: Transliterations -> String -> String+parameterizeCustom ts s = case parsed of Right ast -> (concatMap pCharToC . squeezeSeparators . trimUnwanted wanted . mapMaybe (parameterizeChar ts))@@ -50,60 +56,24 @@ 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+-- |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 --- |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]+-- |Returns a String after default approximations for changing Unicode characters+-- to a valid ASCII range are applied.+transliterateCustom :: String -> Transliterations -> String -> String+transliterateCustom replacement ts = concatMap lookupCharTransliteration+ where lookupCharTransliteration c =+ if isAscii c then -- Don't bother looking up Chars in ASCII range+ [c]+ else+ 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@@ -142,6 +112,60 @@ ('ŵ', "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@@ -151,6 +175,6 @@ -- |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+trimUnwanted wanted = dropWhile notWanted . reverse . dropWhile notWanted+ . reverse+ where notWanted = (`notElem` wanted)
inflections.cabal view
@@ -1,5 +1,5 @@ name: inflections-version: 0.1.0.1+version: 0.1.0.2 synopsis: Inflections library for Haskell description: Inflections provides methods for singularization, pluralization, dasherizing, etc. The library is based on Rails' inflections library.@@ -21,7 +21,7 @@ library exposed-modules: Text.Inflections ghc-options: -Wall- build-depends: base >=4.6 && <4.7, parsec, containers+ build-depends: base >=4.5 && <4.7, parsec, containers default-language: Haskell2010 test-suite test@@ -30,7 +30,7 @@ main-is: Suite.hs build-depends: inflections- , base >=4.6 && <4.7+ , base >=4.5 && <4.7 , test-framework , HUnit , QuickCheck