module Data.Text.ICU.Translit.IO
  ( Transliterator,
    transliterator,
    transliterate,
  )
where

import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Text (Text)
import Data.Text.Encoding qualified as T
import Data.Text.ICU.Translit.ICUHelper
  ( UChar,
    UErrorCode,
    handleError,
    handleFilledOverflowError,
  )
import Foreign

data UTransliterator

foreign import ccall "trans.h __hs_translit_open_trans"
  openTrans ::
    Ptr UChar -> Int -> Ptr UErrorCode -> IO (Ptr UTransliterator)

foreign import ccall "trans.h &__hs_translit_close_trans"
  closeTrans ::
    FunPtr (Ptr UTransliterator -> IO ())

foreign import ccall "trans.h __hs_translit_do_trans"
  doTrans ::
    Ptr UTransliterator ->
    Ptr UChar ->
    Int32 ->
    Int32 ->
    Ptr UErrorCode ->
    IO Int32

data Transliterator = Transliterator
  { Transliterator -> ForeignPtr UTransliterator
transPtr :: ForeignPtr UTransliterator,
    Transliterator -> Text
transSpec :: Text
  }

instance Show Transliterator where
  show :: Transliterator -> String
show Transliterator
tr = String
"Transliterator " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (Transliterator -> Text
transSpec Transliterator
tr)

-- we just assume little endian
transliterator :: Text -> IO Transliterator
transliterator :: Text -> IO Transliterator
transliterator Text
spec = do
  let ByteString
specStr :: ByteString = Text -> ByteString
T.encodeUtf16LE Text
spec
  ByteString
-> (CStringLen -> IO Transliterator) -> IO Transliterator
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
specStr ((CStringLen -> IO Transliterator) -> IO Transliterator)
-> (CStringLen -> IO Transliterator) -> IO Transliterator
forall a b. (a -> b) -> a -> b
$ \((forall a b. Ptr a -> Ptr b
castPtr @_ @Word16) -> Ptr Word16
ptr, (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) -> Int
len) -> do
    Ptr UTransliterator
q <- (Ptr UErrorCode -> IO (Ptr UTransliterator))
-> IO (Ptr UTransliterator)
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError ((Ptr UErrorCode -> IO (Ptr UTransliterator))
 -> IO (Ptr UTransliterator))
-> (Ptr UErrorCode -> IO (Ptr UTransliterator))
-> IO (Ptr UTransliterator)
forall a b. (a -> b) -> a -> b
$ Ptr Word16 -> Int -> Ptr UErrorCode -> IO (Ptr UTransliterator)
openTrans Ptr Word16
ptr (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    ForeignPtr UTransliterator
ref <- FinalizerPtr UTransliterator
-> Ptr UTransliterator -> IO (ForeignPtr UTransliterator)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr UTransliterator
closeTrans Ptr UTransliterator
q
    Transliterator -> IO Transliterator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Transliterator -> IO Transliterator)
-> Transliterator -> IO Transliterator
forall a b. (a -> b) -> a -> b
$ ForeignPtr UTransliterator -> Text -> Transliterator
Transliterator ForeignPtr UTransliterator
ref Text
spec

transliterate :: Transliterator -> Text -> IO Text
transliterate :: Transliterator -> Text -> IO Text
transliterate Transliterator
tr Text
txt = do
  let ByteString
txtAsBs :: ByteString = Text -> ByteString
T.encodeUtf16LE Text
txt
  ByteString -> (CStringLen -> IO Text) -> IO Text
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
txtAsBs \((forall a b. Ptr a -> Ptr b
castPtr @_ @Word16) -> Ptr Word16
ptr, (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) -> Int
len) ->
    ForeignPtr UTransliterator
-> (Ptr UTransliterator -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Transliterator -> ForeignPtr UTransliterator
transPtr Transliterator
tr) ((Ptr UTransliterator -> IO Text) -> IO Text)
-> (Ptr UTransliterator -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UTransliterator
tr_ptr -> do
      Ptr Word16
-> Int
-> (Ptr Word16 -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr Word16 -> Int -> IO Text)
-> IO Text
forall a b.
Storable a =>
Ptr a
-> Int
-> (Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleFilledOverflowError
        Ptr Word16
ptr
        Int
len
        ( \Ptr Word16
dptr Int32
dlen ->
            Ptr UTransliterator
-> Ptr Word16 -> Int32 -> Int32 -> Ptr UErrorCode -> IO Int32
doTrans Ptr UTransliterator
tr_ptr Ptr Word16
dptr (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Int32
dlen
        )
        ( \Ptr Word16
dptr Int
dlen ->
            ByteString -> Text
T.decodeUtf16LE (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
BS.packCStringLen (Ptr Word16 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
dptr, Int
dlen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
        )