{-# LINE 1 "Data/Text/ICU/Translit/ICUHelper.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, MultiWayIf #-}
module Data.Text.ICU.Translit.ICUHelper
    (
      ICUError(..)
    , UChar
    , UErrorCode
    , isFailure
    , errorName
    , handleError
    , handleFilledOverflowError
    , throwOnError
    ) where


-- Many functions in this module are straight from the
-- Data.Text.ICU.Error.Internal (text-icu).
-- 
-- XXX TODO:
--   ⋆ export this and similar functionality somewhere;
-- or
--   ⋆ merge text-icu-* into text-icu?


import Control.Exception (Exception, throwIO)
import Data.Typeable (Typeable)
import Foreign.C.Types (CInt(..))
import Foreign.C.String (CString, peekCString)
import qualified System.IO.Unsafe as IO (unsafePerformIO)
import Foreign 

type UErrorCode = CInt
type UChar = Word16

newtype ICUError = ICUError {
      ICUError -> UErrorCode
fromErrorCode :: UErrorCode
    } deriving (ICUError -> ICUError -> Bool
(ICUError -> ICUError -> Bool)
-> (ICUError -> ICUError -> Bool) -> Eq ICUError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ICUError -> ICUError -> Bool
== :: ICUError -> ICUError -> Bool
$c/= :: ICUError -> ICUError -> Bool
/= :: ICUError -> ICUError -> Bool
Eq, Typeable)

instance Show ICUError where
    show :: ICUError -> String
show ICUError
code = String
"ICUError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ICUError -> String
errorName ICUError
code

instance Exception ICUError





-- | Indicate whether the given error code is a failure.
isFailure :: ICUError -> Bool
{-# INLINE isFailure #-}
isFailure :: ICUError -> Bool
isFailure = (UErrorCode -> UErrorCode -> Bool
forall a. Ord a => a -> a -> Bool
> UErrorCode
0) (UErrorCode -> Bool)
-> (ICUError -> UErrorCode) -> ICUError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ICUError -> UErrorCode
fromErrorCode


-- | Throw an exception if the given code is actually an error.
throwOnError :: UErrorCode -> IO ()
{-# INLINE throwOnError #-}
throwOnError :: UErrorCode -> IO ()
throwOnError UErrorCode
code = do
  let err :: ICUError
err = (UErrorCode -> ICUError
ICUError UErrorCode
code)
  if ICUError -> Bool
isFailure ICUError
err
    then ICUError -> IO ()
forall e a. Exception e => e -> IO a
throwIO ICUError
err
    else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()



handleError :: (Ptr UErrorCode -> IO a) -> IO a
{-# INLINE handleError #-}
handleError :: forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError Ptr UErrorCode -> IO a
action = UErrorCode -> (Ptr UErrorCode -> IO a) -> IO a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
0 ((Ptr UErrorCode -> IO a) -> IO a)
-> (Ptr UErrorCode -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr UErrorCode
errPtr -> do
                       a
ret <- Ptr UErrorCode -> IO a
action Ptr UErrorCode
errPtr
                       UErrorCode -> IO ()
throwOnError (UErrorCode -> IO ()) -> IO UErrorCode -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
errPtr
                       a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ret



-- | Deal with ICU functions that report a buffer overflow error if we
-- give them an insufficiently large buffer.  The difference between
-- this function and
-- 'Data.Text.ICU.Error.Internal.handleOverflowError' is that this one
-- doesn't change the contents of the provided buffer, while the
-- latter assumes buffers to be write-only.
handleFilledOverflowError :: (Storable a) =>
                             Ptr a
                          -- ^ Initial buffer.
                          -> Int
                          -- ^ Initial buffer size.
                          -> (Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32)
                          -- ^ Function that retrieves data.
                          -> (Ptr a -> Int -> IO b)
                          -- ^ Function that fills destination buffer if no
                          -- overflow occurred.
                          -> IO b
handleFilledOverflowError :: forall a b.
Storable a =>
Ptr a
-> Int
-> (Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleFilledOverflowError Ptr a
text Int
len0 Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32
fill Ptr a -> Int -> IO b
retrieve =
    do Ptr a
buf0 <- Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
len0
       Ptr a -> Ptr a -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
buf0 Ptr a
text Int
len0
       Ptr a -> Int -> IO b
forall {t}. Integral t => Ptr a -> t -> IO b
go Ptr a
buf0 Int
len0
    where
      go :: Ptr a -> t -> IO b
go Ptr a
buf t
len = (Ptr UErrorCode -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr UErrorCode -> IO b) -> IO b)
-> (Ptr UErrorCode -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr UErrorCode
errPtr -> do
                     Ptr UErrorCode -> UErrorCode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr UErrorCode
errPtr UErrorCode
0
                     Int32
len' <- Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32
fill Ptr a
buf (t -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
len) Ptr UErrorCode
errPtr
                     UErrorCode
err <- Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
errPtr
                     if | UErrorCode
err UErrorCode -> UErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== (UErrorCode
15)
{-# LINE 100 "Data/Text/ICU/Translit/ICUHelper.hsc" #-}
                            -> do Ptr a
buf' <- Ptr a -> Int -> IO (Ptr a)
forall a. Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray Ptr a
buf (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len')
                                  Ptr a -> Ptr a -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
buf' Ptr a
text Int
len0
                                  Ptr a -> t -> IO b
go Ptr a
buf' (Int32 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len')
                        | UErrorCode
err UErrorCode -> UErrorCode -> Bool
forall a. Ord a => a -> a -> Bool
> UErrorCode
0
                            -> ICUError -> IO b
forall e a. Exception e => e -> IO a
throwIO (UErrorCode -> ICUError
ICUError UErrorCode
err)
                        | Bool
otherwise
                            -> Ptr a -> Int -> IO b
retrieve Ptr a
buf (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len')








-- | Return a string representing the name of the given error code.
errorName :: ICUError -> String
errorName :: ICUError -> String
errorName ICUError
code = IO String -> String
forall a. IO a -> a
IO.unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$
                 CString -> IO String
peekCString (UErrorCode -> CString
u_errorName (ICUError -> UErrorCode
fromErrorCode ICUError
code))

foreign import ccall unsafe "trans.h __hs_translit_u_errorName" u_errorName
    :: UErrorCode -> CString