{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Citeproc.Unicode
  ( Lang(..),
    parseLang,
    renderLang,
    toUpper,
    toLower,
    comp
  )
where
#ifdef MIN_VERSION_text_icu
import qualified Data.Text.ICU as ICU
#else
import qualified Data.RFC5051 as RFC5051
#endif
import Data.Text (Text)
import qualified Data.Text as T
import Data.Aeson (FromJSON (..), ToJSON (..))

-- | A parsed IETF language tag, with language and optional variant.
-- For example, @Lang "en" (Just "US")@ corresponds to @en-US@.
data Lang = Lang{ Lang -> Text
langLanguage :: Text
                , Lang -> Maybe Text
langVariant  :: Maybe Text }
  deriving (Int -> Lang -> ShowS
[Lang] -> ShowS
Lang -> String
(Int -> Lang -> ShowS)
-> (Lang -> String) -> ([Lang] -> ShowS) -> Show Lang
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lang] -> ShowS
$cshowList :: [Lang] -> ShowS
show :: Lang -> String
$cshow :: Lang -> String
showsPrec :: Int -> Lang -> ShowS
$cshowsPrec :: Int -> Lang -> ShowS
Show, Lang -> Lang -> Bool
(Lang -> Lang -> Bool) -> (Lang -> Lang -> Bool) -> Eq Lang
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lang -> Lang -> Bool
$c/= :: Lang -> Lang -> Bool
== :: Lang -> Lang -> Bool
$c== :: Lang -> Lang -> Bool
Eq, Eq Lang
Eq Lang
-> (Lang -> Lang -> Ordering)
-> (Lang -> Lang -> Bool)
-> (Lang -> Lang -> Bool)
-> (Lang -> Lang -> Bool)
-> (Lang -> Lang -> Bool)
-> (Lang -> Lang -> Lang)
-> (Lang -> Lang -> Lang)
-> Ord Lang
Lang -> Lang -> Bool
Lang -> Lang -> Ordering
Lang -> Lang -> Lang
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Lang -> Lang -> Lang
$cmin :: Lang -> Lang -> Lang
max :: Lang -> Lang -> Lang
$cmax :: Lang -> Lang -> Lang
>= :: Lang -> Lang -> Bool
$c>= :: Lang -> Lang -> Bool
> :: Lang -> Lang -> Bool
$c> :: Lang -> Lang -> Bool
<= :: Lang -> Lang -> Bool
$c<= :: Lang -> Lang -> Bool
< :: Lang -> Lang -> Bool
$c< :: Lang -> Lang -> Bool
compare :: Lang -> Lang -> Ordering
$ccompare :: Lang -> Lang -> Ordering
$cp1Ord :: Eq Lang
Ord)

instance ToJSON Lang where
  toJSON :: Lang -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Lang -> Text) -> Lang -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lang -> Text
renderLang

instance FromJSON Lang where
  parseJSON :: Value -> Parser Lang
parseJSON = (Text -> Lang) -> Parser Text -> Parser Lang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Lang
parseLang (Parser Text -> Parser Lang)
-> (Value -> Parser Text) -> Value -> Parser Lang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Render a 'Lang' an an IETF language tag.
renderLang :: Lang -> Text
renderLang :: Lang -> Text
renderLang (Lang Text
l Maybe Text
Nothing)  = Text
l
renderLang (Lang Text
l (Just Text
v)) = Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v

-- | Parse an IETF language tag.
parseLang :: Text -> Lang
parseLang :: Text -> Lang
parseLang Text
t = Text -> Maybe Text -> Lang
Lang Text
l ((Char, Text) -> Text
forall a b. (a, b) -> b
snd ((Char, Text) -> Text) -> Maybe (Char, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
T.uncons Text
v)
  where
   (Text
l,Text
v) = (Char -> Bool) -> Text -> (Text, Text)
T.break (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
t

#ifdef MIN_VERSION_text_icu
toICULocale :: Maybe Lang -> ICU.LocaleName
toICULocale Nothing = ICU.Current
toICULocale (Just l) = ICU.Locale (T.unpack (renderLang l))
#endif

toUpper :: Maybe Lang -> Text -> Text
#ifdef MIN_VERSION_text_icu
toUpper mblang =
   ICU.toUpper (toICULocale mblang)
#else
toUpper :: Maybe Lang -> Text -> Text
toUpper Maybe Lang
mblang = Text -> Text
T.toUpper (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  case Maybe Lang
mblang of
    Just (Lang Text
"tr" Maybe Text
_) -> (Char -> Char) -> Text -> Text
T.map (\Char
c -> case Char
c of
                                        Char
'i' -> Char
'İ'
                                        Char
'ı' -> Char
'I'
                                        Char
_   -> Char
c)
    Maybe Lang
_                  -> Text -> Text
forall a. a -> a
id
#endif

toLower :: Maybe Lang -> Text -> Text
#ifdef MIN_VERSION_text_icu
toLower mblang =
   ICU.toLower (toICULocale mblang)
#else
toLower :: Maybe Lang -> Text -> Text
toLower Maybe Lang
mblang = Text -> Text
T.toLower (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  case Maybe Lang
mblang of
    Just (Lang Text
"tr" Maybe Text
_) -> (Char -> Char) -> Text -> Text
T.map (\Char
c -> case Char
c of
                                        Char
'İ' -> Char
'i'
                                        Char
'I' -> Char
'ı'
                                        Char
_   -> Char
c)
    Maybe Lang
_                  -> Text -> Text
forall a. a -> a
id
#endif

comp :: Maybe Lang -> Text -> Text -> Ordering
#ifdef MIN_VERSION_text_icu
comp mblang = ICU.collate (ICU.collator (toICULocale mblang))
#else
comp :: Maybe Lang -> Text -> Text -> Ordering
comp Maybe Lang
_mblang = Text -> Text -> Ordering
RFC5051.compareUnicode
#endif