Commits

Bryan O'Sullivan committed d2354d7

Support parse errors.

Comments (0)

Files changed (4)

Data/Text/ICU/Error.hsc

 -- Unicode (ICU) libraries.
 --
 -- Most ICU functions can throw an 'ICUError' value as an exception.
+-- Some can additionally throw a 'ParseError', if more detailed error
+-- information is necessary.
 module Data.Text.ICU.Error
     (
      -- * Types
      ICUError,
+     ParseError(errError, errLine, errOffset),
 
      -- * Functions
      isSuccess,

Data/Text/ICU/Error/Internal.hs

-{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface #-}
-
-module Data.Text.ICU.Error.Internal
-    (
-    -- * Types
-      ICUError(..)
-    -- ** Low-level types
-    , UErrorCode
-    -- * Functions
-    , isFailure
-    , isSuccess
-    , errorName
-    , handleError
-    , throwOnError
-    , withError
-    ) where
-
-import Control.Exception (Exception, throw)
-import Foreign.Ptr (Ptr)
-import Foreign.Marshal.Utils (with)
-import Data.Typeable (Typeable)
-import Foreign.C.String (CString, peekCString)
-import Foreign.C.Types (CInt)
-import Foreign.Storable (peek)
-import System.IO.Unsafe (unsafePerformIO)
-
-type UErrorCode = CInt
-
--- | ICU error type.  This is an instance of the 'Exception' type
--- class.  A value of this type may be thrown as an exception by most
--- ICU functions.
-newtype ICUError = ICUError {
-      fromErrorCode :: UErrorCode
-    } deriving (Eq, Typeable)
-
-instance Show ICUError where
-    show code = "ICUError " ++ errorName code
-
-instance Exception ICUError
-
--- | Indicate whether the given error code is a success.
-isSuccess :: ICUError -> Bool
-{-# INLINE isSuccess #-}
-isSuccess = (<= 0) . fromErrorCode
-
--- | Indicate whether the given error code is a failure.
-isFailure :: ICUError -> Bool
-{-# INLINE isFailure #-}
-isFailure = (> 0) . fromErrorCode
-
--- | Throw an exception if the given code is actually an error.
-throwOnError :: UErrorCode -> IO ()
-{-# INLINE throwOnError #-}
-throwOnError code = do
-  let err = (ICUError code)
-  if isFailure err
-    then throw err
-    else return ()
-
-withError :: (Ptr UErrorCode -> IO a) -> IO (ICUError, a)
-{-# INLINE withError #-}
-withError action = with 0 $ \errPtr -> do
-                     ret <- action errPtr
-                     err <- peek errPtr
-                     return (ICUError err, ret)
-
-handleError :: (Ptr UErrorCode -> IO a) -> IO a
-{-# INLINE handleError #-}
-handleError action = with 0 $ \errPtr -> do
-                       ret <- action errPtr
-                       throwOnError =<< peek errPtr
-                       return ret
-
--- | Return a string representing the name of the given error code.
-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

Data/Text/ICU/Error/Internal.hsc

+{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface,
+    ScopedTypeVariables #-}
+
+module Data.Text.ICU.Error.Internal
+    (
+    -- * Types
+      ICUError(..)
+    -- ** Low-level types
+    , UErrorCode
+    , ParseError(errError, errLine, errOffset)
+    , UParseError
+    -- * Functions
+    , 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)
+
+#include <unicode/parseerr.h>
+#include <unicode/utypes.h>
+
+type UErrorCode = CInt
+    
+-- | ICU error type.  This is an instance of the 'Exception' type
+-- class.  A value of this type may be thrown as an exception by most
+-- ICU functions.
+newtype ICUError = ICUError {
+      fromErrorCode :: UErrorCode
+    } deriving (Eq, Typeable)
+
+instance Show ICUError where
+    show code = "ICUError " ++ errorName code
+
+instance Exception ICUError
+
+-- | Detailed information about parsing errors.  Used by ICU parsing
+-- engines that parse long rules, patterns, or programs, where the
+-- text being parsed is long enough that more information than an
+-- 'ICUError' is needed to localize the error.
+data ParseError = ParseError {
+      errError :: ICUError
+    , errLine :: !(Maybe Int)
+    -- ^ The line on which the error occured.  If the parser uses this
+    -- field, it sets it to the line number of the source text line on
+    -- which the error appears, which will be be a positive value.  If
+    -- the parser does not support line numbers, the value will be
+    -- 'Nothing'.
+    , errOffset :: !(Maybe Int)
+    -- ^ The character offset to the error.  If the 'errLine' field is
+    -- 'Just' some value, then this field contains the offset from the
+    -- beginning of the line that contains the error.  Otherwise, it
+    -- represents the offset from the start of the text.  If the
+    -- parser does not support this field, it will have a value of
+    -- 'Nothing'.
+    } deriving (Show, Typeable)
+
+type UParseError = ParseError
+
+instance Exception ParseError
+
+instance Storable ParseError where
+    sizeOf _    = #{size UParseError}
+    alignment _ = alignment (undefined :: CString)
+    peek ptr = do
+      (line::Int32) <- #{peek UParseError, line} ptr
+      (offset::Int32) <- #{peek UParseError, offset} ptr
+      let wrap k = if k == -1 then Nothing else Just $! fromIntegral k
+      return $! ParseError undefined (wrap line) (wrap offset)
+
+-- | Indicate whether the given error code is a success.
+isSuccess :: ICUError -> Bool
+{-# INLINE isSuccess #-}
+isSuccess = (<= 0) . fromErrorCode
+
+-- | Indicate whether the given error code is a failure.
+isFailure :: ICUError -> Bool
+{-# INLINE isFailure #-}
+isFailure = (> 0) . fromErrorCode
+
+-- | Throw an exception if the given code is actually an error.
+throwOnError :: UErrorCode -> IO ()
+{-# INLINE throwOnError #-}
+throwOnError code = do
+  let err = (ICUError code)
+  if isFailure err
+    then throw err
+    else return ()
+
+withError :: (Ptr UErrorCode -> IO a) -> IO (ICUError, a)
+{-# INLINE withError #-}
+withError action = with 0 $ \errPtr -> do
+                     ret <- action errPtr
+                     err <- peek errPtr
+                     return (ICUError err, ret)
+
+handleError :: (Ptr UErrorCode -> IO a) -> IO a
+{-# INLINE handleError #-}
+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
+
+-- | Return a string representing the name of the given error code.
+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

Data/Text/ICU/Types.hs

     (
     -- * Widely used types
       LocaleName(..)
+    , ParseError(errError, errLine, errOffset)
     ) where
 
+import Data.Text.ICU.Error.Internal (ParseError(..))
 import Data.Text.ICU.Internal (LocaleName(..))