-- |
-- Module      :  Text.Inflections.Parametrize
-- Copyright   :  © 2016 Justin Leitgeb
-- License     :  MIT
--
-- Maintainer  :  Justin Leitgeb <justin@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Parametrization for strings, useful for transliteration.

{-# 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

-- | Replace special characters in a string so that it may be used as part
-- of a 'pretty' URL. Uses the 'defaultTransliterations'.
parameterize :: Text -> Text
parameterize :: Text -> Text
parameterize = Transliterations -> Text -> Text
parameterizeCustom Transliterations
defaultTransliterations
{-# INLINE parameterize #-}

-- | Transliterate 'Text' with a custom transliteration table.
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))