{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Inflections.Parameterize
( parameterize
, parameterizeCustom )
where
import Data.Char (isAscii, isAlphaNum, isPunctuation, toLower)
import Data.Text (Text)
import Text.Inflections.Data
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
parameterize :: Text -> Text
parameterize :: Text -> Text
parameterize = Transliterations -> Text -> Text
parameterizeCustom Transliterations
defaultTransliterations
{-# INLINE parameterize #-}
parameterizeCustom :: Transliterations -> Text -> Text
parameterizeCustom :: Transliterations -> Text -> Text
parameterizeCustom Transliterations
m Text
txt = (Text -> [Text] -> Text
T.intercalate Text
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) (forall a. (a -> Maybe (Char, a)) -> a -> Text
T.unfoldr ([Char], Text) -> Maybe (Char, ([Char], Text))
f ([Char]
"", Text
txt))
where
f :: ([Char], Text) -> Maybe (Char, ([Char], Text))
f ([Char]
"", Text
t) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {b}. Char -> b -> (Char, ([Char], b))
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
T.uncons Text
t
f (Char
x:[Char]
xs, Text
t) = forall a. a -> Maybe a
Just (Char
x, ([Char]
xs, Text
t))
g :: Char -> b -> (Char, ([Char], b))
g Char
x b
xs
| (Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
x) Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'_' = (Char -> Char
toLower Char
x, ([Char]
"", b
xs))
| Char -> Bool
isPunctuation Char
x = (Char
' ', ([Char]
"", b
xs))
| Bool
otherwise =
case Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault [Char]
" " Char
x Transliterations
m of
[Char]
"" -> (Char
' ', ([Char]
"",b
xs))
(Char
y:[Char]
ys) -> (Char
y, ([Char]
ys,b
xs))