{-# LANGUAGE ForeignFunctionInterface #-}
module Data.Text.ICU.Convert
(
Converter
, open
, fromUnicode
, toUnicode
, getName
, usesFallback
, isAmbiguous
, getDefaultName
, setDefaultName
, compareNames
, aliases
, converterNames
, standardNames
) where
import Data.ByteString.Internal (ByteString, createAndTrim)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.Int (Int32)
import Data.Text (Text)
import Data.Text.Foreign (fromPtr, lengthWord16, useAsPtr)
import Data.Text.ICU.Convert.Internal
import Data.Text.ICU.Error.Internal (UErrorCode, handleError)
import Data.Word (Word16)
import Foreign.C.String (CString, peekCString, withCString)
import Foreign.C.Types (CInt(..))
import Foreign.ForeignPtr (newForeignPtr)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Ptr (FunPtr, Ptr, castPtr)
import System.IO.Unsafe (unsafePerformIO)
import Data.Text.ICU.Internal (UBool, UChar, asBool, asOrdering, withName)
compareNames :: String -> String -> Ordering
compareNames :: String -> String -> Ordering
compareNames String
a String
b =
IO Ordering -> Ordering
forall a. IO a -> a
unsafePerformIO (IO Ordering -> Ordering)
-> ((CString -> IO Ordering) -> IO Ordering)
-> (CString -> IO Ordering)
-> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO Ordering) -> IO Ordering
forall a. String -> (CString -> IO a) -> IO a
withCString String
a ((CString -> IO Ordering) -> Ordering)
-> (CString -> IO Ordering) -> Ordering
forall a b. (a -> b) -> a -> b
$ \CString
aptr ->
(CInt -> Ordering) -> IO CInt -> IO Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Ordering
forall a. Integral a => a -> Ordering
asOrdering (IO CInt -> IO Ordering)
-> ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt)
-> IO Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
b ((CString -> IO CInt) -> IO Ordering)
-> (CString -> IO CInt) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ CString -> CString -> IO CInt
ucnv_compareNames CString
aptr
open :: String
-> Maybe Bool
-> IO Converter
open :: String -> Maybe Bool -> IO Converter
open String
name Maybe Bool
mf = do
Converter
c <- (ForeignPtr UConverter -> Converter)
-> IO (ForeignPtr UConverter) -> IO Converter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr UConverter -> Converter
Converter (IO (ForeignPtr UConverter) -> IO Converter)
-> (Ptr UConverter -> IO (ForeignPtr UConverter))
-> Ptr UConverter
-> IO Converter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr UConverter
-> Ptr UConverter -> IO (ForeignPtr UConverter)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr UConverter
ucnv_close (Ptr UConverter -> IO Converter)
-> IO (Ptr UConverter) -> IO Converter
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> (CString -> IO (Ptr UConverter)) -> IO (Ptr UConverter)
forall a. String -> (CString -> IO a) -> IO a
withName String
name ((Ptr CInt -> IO (Ptr UConverter)) -> IO (Ptr UConverter)
forall a. (Ptr CInt -> IO a) -> IO a
handleError ((Ptr CInt -> IO (Ptr UConverter)) -> IO (Ptr UConverter))
-> (CString -> Ptr CInt -> IO (Ptr UConverter))
-> CString
-> IO (Ptr UConverter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Ptr CInt -> IO (Ptr UConverter)
ucnv_open)
case Maybe Bool
mf of
Just Bool
f -> Converter -> (Ptr UConverter -> IO ()) -> IO ()
forall a. Converter -> (Ptr UConverter -> IO a) -> IO a
withConverter Converter
c ((Ptr UConverter -> IO ()) -> IO ())
-> (Ptr UConverter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr UConverter
p -> Ptr UConverter -> UBool -> IO ()
ucnv_setFallback Ptr UConverter
p (UBool -> IO ()) -> (Bool -> UBool) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UBool
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UBool) -> (Bool -> Int) -> Bool -> UBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
f
Maybe Bool
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Converter -> IO Converter
forall (m :: * -> *) a. Monad m => a -> m a
return Converter
c
fromUnicode :: Converter -> Text -> ByteString
fromUnicode :: Converter -> Text -> ByteString
fromUnicode Converter
cnv Text
t =
IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString)
-> ((Ptr Word16 -> I16 -> IO ByteString) -> IO ByteString)
-> (Ptr Word16 -> I16 -> IO ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Ptr Word16 -> I16 -> IO ByteString) -> IO ByteString
forall a. Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
useAsPtr Text
t ((Ptr Word16 -> I16 -> IO ByteString) -> ByteString)
-> (Ptr Word16 -> I16 -> IO ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
tptr I16
tlen ->
Converter -> (Ptr UConverter -> IO ByteString) -> IO ByteString
forall a. Converter -> (Ptr UConverter -> IO a) -> IO a
withConverter Converter
cnv ((Ptr UConverter -> IO ByteString) -> IO ByteString)
-> (Ptr UConverter -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr UConverter
cptr -> do
let capacity :: Int32
capacity = CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int32) -> (Int -> CInt) -> Int -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr UConverter -> CInt -> CInt
max_bytes_for_string Ptr UConverter
cptr (CInt -> CInt) -> (Int -> CInt) -> Int -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$
Text -> Int
lengthWord16 Text
t
Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
capacity) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
(Int32 -> Int) -> IO Int32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Int32 -> IO Int)
-> ((Ptr CInt -> IO Int32) -> IO Int32)
-> (Ptr CInt -> IO Int32)
-> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CInt -> IO Int32) -> IO Int32
forall a. (Ptr CInt -> IO a) -> IO a
handleError ((Ptr CInt -> IO Int32) -> IO Int)
-> (Ptr CInt -> IO Int32) -> IO Int
forall a b. (a -> b) -> a -> b
$
Ptr UConverter
-> CString -> Int32 -> Ptr Word16 -> Int32 -> Ptr CInt -> IO Int32
ucnv_fromUChars Ptr UConverter
cptr (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
sptr) Int32
capacity Ptr Word16
tptr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
tlen)
toUnicode :: Converter -> ByteString -> Text
toUnicode :: Converter -> ByteString -> Text
toUnicode Converter
cnv ByteString
bs =
IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text)
-> ((CStringLen -> IO Text) -> IO Text)
-> (CStringLen -> IO Text)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CStringLen -> IO Text) -> IO Text
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO Text) -> Text)
-> (CStringLen -> IO Text) -> Text
forall a b. (a -> b) -> a -> b
$ \(CString
sptr, Int
slen) ->
Converter -> (Ptr UConverter -> IO Text) -> IO Text
forall a. Converter -> (Ptr UConverter -> IO a) -> IO a
withConverter Converter
cnv ((Ptr UConverter -> IO Text) -> IO Text)
-> (Ptr UConverter -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UConverter
cptr -> do
let capacity :: Int
capacity = Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
Int -> (Ptr Word16 -> IO Text) -> IO Text
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
capacity ((Ptr Word16 -> IO Text) -> IO Text)
-> (Ptr Word16 -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
tptr ->
Ptr Word16 -> I16 -> IO Text
fromPtr Ptr Word16
tptr (I16 -> IO Text) -> IO I16 -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((Int32 -> I16) -> IO Int32 -> IO I16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Int32 -> IO I16)
-> ((Ptr CInt -> IO Int32) -> IO Int32)
-> (Ptr CInt -> IO Int32)
-> IO I16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CInt -> IO Int32) -> IO Int32
forall a. (Ptr CInt -> IO a) -> IO a
handleError ((Ptr CInt -> IO Int32) -> IO I16)
-> (Ptr CInt -> IO Int32) -> IO I16
forall a b. (a -> b) -> a -> b
$
Ptr UConverter
-> Ptr Word16 -> Int32 -> CString -> Int32 -> Ptr CInt -> IO Int32
ucnv_toUChars Ptr UConverter
cptr Ptr Word16
tptr (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
capacity) CString
sptr
(Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slen))
usesFallback :: Converter -> Bool
usesFallback :: Converter -> Bool
usesFallback Converter
cnv = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
UBool -> Bool
forall a. Integral a => a -> Bool
asBool (UBool -> Bool) -> IO UBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Converter -> (Ptr UConverter -> IO UBool) -> IO UBool
forall a. Converter -> (Ptr UConverter -> IO a) -> IO a
withConverter Converter
cnv Ptr UConverter -> IO UBool
ucnv_usesFallback
getDefaultName :: IO String
getDefaultName :: IO String
getDefaultName = CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CString
ucnv_getDefaultName
isAmbiguous :: Converter -> Bool
isAmbiguous :: Converter -> Bool
isAmbiguous Converter
cnv = UBool -> Bool
forall a. Integral a => a -> Bool
asBool (UBool -> Bool) -> (IO UBool -> UBool) -> IO UBool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO UBool -> UBool
forall a. IO a -> a
unsafePerformIO (IO UBool -> Bool) -> IO UBool -> Bool
forall a b. (a -> b) -> a -> b
$ Converter -> (Ptr UConverter -> IO UBool) -> IO UBool
forall a. Converter -> (Ptr UConverter -> IO a) -> IO a
withConverter Converter
cnv Ptr UConverter -> IO UBool
ucnv_isAmbiguous
setDefaultName :: String -> IO ()
setDefaultName :: String -> IO ()
setDefaultName String
s = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
s ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CString -> IO ()
ucnv_setDefaultName
converterNames :: [String]
{-# NOINLINE converterNames #-}
converterNames :: [String]
converterNames = IO [String] -> [String]
forall a. IO a -> a
unsafePerformIO (IO [String] -> [String]) -> IO [String] -> [String]
forall a b. (a -> b) -> a -> b
$
(Int32 -> IO String) -> [Int32] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO CString -> IO String)
-> (Int32 -> IO CString) -> Int32 -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IO CString
ucnv_getAvailableName) [Int32
0..Int32
ucnv_countAvailableInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
1]
standardNames :: [String]
{-# NOINLINE standardNames #-}
standardNames :: [String]
standardNames = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> (IO [String] -> [String]) -> IO [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [String] -> [String]
forall a. IO a -> a
unsafePerformIO (IO [String] -> [String]) -> IO [String] -> [String]
forall a b. (a -> b) -> a -> b
$
(Word16 -> IO String) -> [Word16] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO CString -> IO String)
-> (Word16 -> IO CString) -> Word16 -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CInt -> IO CString) -> IO CString
forall a. (Ptr CInt -> IO a) -> IO a
handleError ((Ptr CInt -> IO CString) -> IO CString)
-> (Word16 -> Ptr CInt -> IO CString) -> Word16 -> IO CString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Ptr CInt -> IO CString
ucnv_getStandard) [Word16
0..Word16
ucnv_countStandardsWord16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
-Word16
1]
aliases :: String -> [String]
aliases :: String -> [String]
aliases String
name = IO [String] -> [String]
forall a. IO a -> a
unsafePerformIO (IO [String] -> [String])
-> ((CString -> IO [String]) -> IO [String])
-> (CString -> IO [String])
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO [String]) -> IO [String]
forall a. String -> (CString -> IO a) -> IO a
withCString String
name ((CString -> IO [String]) -> [String])
-> (CString -> IO [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \CString
ptr -> do
Word16
count <- (Ptr CInt -> IO Word16) -> IO Word16
forall a. (Ptr CInt -> IO a) -> IO a
handleError ((Ptr CInt -> IO Word16) -> IO Word16)
-> (Ptr CInt -> IO Word16) -> IO Word16
forall a b. (a -> b) -> a -> b
$ CString -> Ptr CInt -> IO Word16
ucnv_countAliases CString
ptr
if Word16
count Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
then [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else (Word16 -> IO String) -> [Word16] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO CString -> IO String)
-> (Word16 -> IO CString) -> Word16 -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CInt -> IO CString) -> IO CString
forall a. (Ptr CInt -> IO a) -> IO a
handleError ((Ptr CInt -> IO CString) -> IO CString)
-> (Word16 -> Ptr CInt -> IO CString) -> Word16 -> IO CString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Word16 -> Ptr CInt -> IO CString
ucnv_getAlias CString
ptr) [Word16
0..Word16
countWord16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
-Word16
1]
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_open" ucnv_open
:: CString -> Ptr UErrorCode -> IO (Ptr UConverter)
foreign import ccall unsafe "hs_text_icu.h &__hs_ucnv_close" ucnv_close
:: FunPtr (Ptr UConverter -> IO ())
foreign import ccall unsafe "__get_max_bytes_for_string" max_bytes_for_string
:: Ptr UConverter -> CInt -> CInt
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_toUChars" ucnv_toUChars
:: Ptr UConverter -> Ptr UChar -> Int32 -> CString -> Int32
-> Ptr UErrorCode -> IO Int32
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_fromUChars" ucnv_fromUChars
:: Ptr UConverter -> CString -> Int32 -> Ptr UChar -> Int32
-> Ptr UErrorCode -> IO Int32
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_compareNames" ucnv_compareNames
:: CString -> CString -> IO CInt
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_getDefaultName" ucnv_getDefaultName
:: IO CString
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_setDefaultName" ucnv_setDefaultName
:: CString -> IO ()
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_countAvailable" ucnv_countAvailable
:: Int32
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_getAvailableName" ucnv_getAvailableName
:: Int32 -> IO CString
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_countAliases" ucnv_countAliases
:: CString -> Ptr UErrorCode -> IO Word16
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_getAlias" ucnv_getAlias
:: CString -> Word16 -> Ptr UErrorCode -> IO CString
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_countStandards" ucnv_countStandards
:: Word16
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_getStandard" ucnv_getStandard
:: Word16 -> Ptr UErrorCode -> IO CString
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_usesFallback" ucnv_usesFallback
:: Ptr UConverter -> IO UBool
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_setFallback" ucnv_setFallback
:: Ptr UConverter -> UBool -> IO ()
foreign import ccall unsafe "hs_text_icu.h __hs_ucnv_isAmbiguous" ucnv_isAmbiguous
:: Ptr UConverter -> IO UBool