{-# LANGUAGE OverloadedStrings #-}
module Text.IDNA (acePrefix, toASCII, toUnicode)
where
import Text.StringPrep
import Text.StringPrep.Profiles
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.Text.Punycode as Puny
import Data.Text.Encoding as E
acePrefix :: Text
acePrefix :: Text
acePrefix = "xn--"
toASCII :: Bool
-> Bool
-> Text
-> Maybe Text
toASCII :: Bool -> Bool -> Text -> Maybe Text
toASCII allowUnassigned :: Bool
allowUnassigned useSTD3ASCIIRules :: Bool
useSTD3ASCIIRules t :: Text
t = do
Text
step2 <- if (Char -> Bool) -> Text -> Bool
Text.any (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>'\x7f') Text
t
then StringPrepProfile -> Text -> Maybe Text
runStringPrep (Bool -> StringPrepProfile
namePrepProfile Bool
allowUnassigned) Text
t
else Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
Text
step3 <- if (Bool
useSTD3ASCIIRules Bool -> Bool -> Bool
&& ((Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
isLDHascii Text
step2 Bool -> Bool -> Bool
|| Text -> Char
Text.head Text
step2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Text -> Char
Text.last Text
step2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-'))
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
step2
Text
step7 <- if ((Char -> Bool) -> Text -> Bool
Text.any (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>'\x7f') Text
step2)
then if Text
acePrefix Text -> Text -> Bool
`Text.isPrefixOf` Text
step3
then Maybe Text
forall a. Maybe a
Nothing
else case ByteString -> Either Any ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ByteString
Puny.encode Text
step3) of
Left _ -> Maybe Text
forall a. Maybe a
Nothing
Right t' :: ByteString
t' -> Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
acePrefix Text -> Text -> Text
`Text.append` ByteString -> Text
E.decodeUtf8 ByteString
t'
else Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
step3
if Text -> Int
Text.length Text
step7 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 63
then Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
step7
else Maybe Text
forall a. Maybe a
Nothing
isLDHascii :: Char -> Bool
isLDHascii :: Char -> Bool
isLDHascii c :: Char
c =
'\x0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x2c' Bool -> Bool -> Bool
||
'\x2e' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x2f' Bool -> Bool -> Bool
||
'\x3a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x40' Bool -> Bool -> Bool
||
'\x5b' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x60' Bool -> Bool -> Bool
||
'\x7b' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x7f'
toUnicode :: Bool
-> Bool
-> Text
-> Text
toUnicode :: Bool -> Bool -> Text -> Text
toUnicode allowUnassigned :: Bool
allowUnassigned useSTD3ASCIIRules :: Bool
useSTD3ASCIIRules t :: Text
t = Either Text Text -> Text
forall a. Either a a -> a
mergeEither (Either Text Text -> Text) -> Either Text Text -> Text
forall a b. (a -> b) -> a -> b
$ do
Text
step2 <- if (Char -> Bool) -> Text -> Bool
Text.any (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>'\x7f') Text
t
then case StringPrepProfile -> Text -> Maybe Text
runStringPrep (Bool -> StringPrepProfile
namePrepProfile Bool
allowUnassigned) Text
t of
Nothing -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
t
Just t' :: Text
t' -> Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t'
else Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
Text
step3 <- if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
acePrefix Text -> Text -> Bool
`Text.isPrefixOf` Text
step2
then Text -> Either Text Text
forall a b. a -> Either a b
Left Text
step2
else Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
step2
let step4 :: Text
step4 = Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
acePrefix) Text
step3
Text
step5 <- case ByteString -> Either PunycodeDecodeException Text
Puny.decode (ByteString -> Either PunycodeDecodeException Text)
-> ByteString -> Either PunycodeDecodeException Text
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
step4 of
Left _ -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
step3
Right s :: Text
s -> Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
case Bool -> Bool -> Text -> Maybe Text
toASCII Bool
allowUnassigned Bool
useSTD3ASCIIRules Text
step5 of
Nothing -> Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
step3
Just t' :: Text
t' -> if Text
t' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
step3
then Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
step5
else Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
step3
mergeEither :: Either a a -> a
mergeEither :: Either a a -> a
mergeEither (Left x :: a
x) = a
x
mergeEither (Right y :: a
y) = a
y
tests :: [Text]
tests :: [Text]
tests = ["Bücher","tūdaliņ"]