module Data.Text.ICU.Error.Internal
(
ICUError(..)
, UErrorCode
, ParseError(errError, errLine, errOffset)
, UParseError
, isFailure
, isSuccess
, errorName
, handleError
, handleParseError
, throwOnError
, withError
) where
import Control.Exception (Exception, throw)
import Foreign.Ptr (Ptr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (with)
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
data ParseError = ParseError {
errError :: ICUError
, errLine :: !(Maybe Int)
, errOffset :: !(Maybe Int)
} deriving (Show, Typeable)
type UParseError = ParseError
instance Exception ParseError
instance Storable ParseError where
sizeOf _ = (72)
alignment _ = alignment (undefined :: CString)
peek ptr = 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
return $! ParseError undefined (wrap line) (wrap offset)
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 throw 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
handleParseError :: (ICUError -> Bool)
-> (Ptr UParseError -> Ptr UErrorCode -> IO a) -> IO a
handleParseError isParseError action =
with 0 $ \uerrPtr ->
alloca $ \perrPtr -> do
ret <- action perrPtr uerrPtr
err <- ICUError `fmap` peek uerrPtr
if isParseError err
then do
perr <- peek perrPtr
throw perr { errError = err }
else if isFailure err
then throw err
else return ret
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