module Data.Text.ICU.Error.Internal
(
ICUError(..)
, UErrorCode
, ParseError(errError, errLine, errOffset)
, UParseError
, isFailure
, isSuccess
, errorName
, handleError
, handleOverflowError
, handleParseError
, throwOnError
, withError
) where
import Control.DeepSeq (NFData(..))
import Control.Exception (Exception, throwIO)
import Data.Function (fix)
import Foreign.Ptr (Ptr)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Utils (with)
import Foreign.Marshal.Array (allocaArray)
import Data.Int (Int32)
import Data.Typeable (Typeable)
import Foreign.C.String (CString, peekCString)
import Foreign.C.Types (CInt(..))
import Foreign.Storable (Storable(..))
import System.IO.Unsafe (unsafePerformIO)
type UErrorCode = CInt
newtype ICUError = ICUError {
fromErrorCode :: UErrorCode
} deriving (Eq, Typeable)
instance Show ICUError where
show code = "ICUError " ++ errorName code
instance Exception ICUError
instance NFData ICUError where
rnf !_ = ()
data ParseError = ParseError {
errError :: ICUError
, errLine :: !(Maybe Int)
, errOffset :: !(Maybe Int)
} deriving (Show, Typeable)
instance NFData ParseError where
rnf ParseError{..} = rnf errError `seq` rnf errLine `seq` rnf errOffset
type UParseError = ParseError
instance Exception ParseError
isSuccess :: ICUError -> Bool
isSuccess = (<= 0) . fromErrorCode
isFailure :: ICUError -> Bool
isFailure = (> 0) . fromErrorCode
throwOnError :: UErrorCode -> IO ()
throwOnError code = do
let err = (ICUError code)
if isFailure err
then throwIO err
else return ()
withError :: (Ptr UErrorCode -> IO a) -> IO (ICUError, a)
withError action = with 0 $ \errPtr -> do
ret <- action errPtr
err <- peek errPtr
return (ICUError err, ret)
handleError :: (Ptr UErrorCode -> IO a) -> IO a
handleError action = with 0 $ \errPtr -> do
ret <- action errPtr
throwOnError =<< peek errPtr
return ret
handleOverflowError :: (Storable a) =>
Int
-> (Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleOverflowError guess fill retrieve =
alloca $ \uerrPtr -> flip fix guess $ \loop n ->
(either (loop . fromIntegral) return =<<) . allocaArray n $ \ptr -> do
poke uerrPtr 0
ret <- fill ptr (fromIntegral n) uerrPtr
err <- peek uerrPtr
case undefined of
_| err == (15)
-> return (Left ret)
| err > 0 -> throwIO (ICUError err)
| otherwise -> Right `fmap` retrieve ptr (fromIntegral ret)
handleParseError :: (ICUError -> Bool)
-> (Ptr UParseError -> Ptr UErrorCode -> IO a) -> IO a
handleParseError isParseError action = with 0 $ \uerrPtr ->
allocaBytes ((72)) $ \perrPtr -> do
ret <- action perrPtr uerrPtr
err <- ICUError `fmap` peek uerrPtr
case undefined of
_| isParseError err -> throwParseError perrPtr err
| isFailure err -> throwIO err
| otherwise -> return ret
throwParseError :: Ptr UParseError -> ICUError -> IO a
throwParseError ptr err = do
(line::Int32) <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
(offset::Int32) <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
let wrap k = if k == 1 then Nothing else Just $! fromIntegral k
throwIO $! ParseError err (wrap line) (wrap offset)
errorName :: ICUError -> String
errorName code = unsafePerformIO $
peekCString (u_errorName (fromErrorCode code))
foreign import ccall unsafe "hs_text_icu.h __hs_u_errorName" u_errorName
:: UErrorCode -> CString