-- |
-- Module      :  Text.Inflections.Transliterate
-- Copyright   :  © 2016 Justin Leitgeb
-- License     :  MIT
--
-- Maintainer  :  Justin Leitgeb <justin@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Support for transliteration.

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

module Text.Inflections.Transliterate
    ( transliterate
    , transliterateCustom )
where

import Data.Char (isAscii)
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

-- | Returns a 'Text' 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 :: Text -> Text
transliterate :: Text -> Text
transliterate = String -> Transliterations -> Text -> Text
transliterateCustom String
"?" Transliterations
defaultTransliterations

-- | Returns a 'Text' after default approximations for changing Unicode
-- characters to a valid ASCII range are applied.
transliterateCustom
  :: String            -- ^ The default replacement
  -> Transliterations  -- ^ The table of transliterations
  -> Text              -- ^ The input
  -> Text              -- ^ The output
transliterateCustom :: String -> Transliterations -> Text -> Text
transliterateCustom String
replacement Transliterations
m Text
txt = forall a. (a -> Maybe (Char, a)) -> a -> Text
T.unfoldr (String, Text) -> Maybe (Char, (String, Text))
f (String
"", Text
txt)
  where
    f :: (String, Text) -> Maybe (Char, (String, Text))
f (String
"", Text
t) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {b}. Char -> b -> (Char, (String, 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:String
xs, Text
t) = forall a. a -> Maybe a
Just (Char
x, (String
xs, Text
t))
    g :: Char -> b -> (Char, (String, b))
g Char
x b
xs =
      if Char -> Bool
isAscii Char
x
        then (Char
x, (String
"", b
xs))
        else
          case forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault String
replacement Char
x Transliterations
m of
            String
""     -> (Char
'?', (String
"",b
xs))
            (Char
y:String
ys) -> (Char
y,   (String
ys,b
xs))