version 0.3.50.3.5

6 files changed, 88 insertions, 17 deletions

diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
index 67a448b..c620e8d 100644
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,6 @@
+	0.3.5
+	* Improve error handling (#24 #26, mgajda)
+
 	0.3.4
 	* Fixed #14 and add test for #15
 	* Fixed typos in the examples (unhammer)
diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md
index 05d0743..7794583 100644
--- a/CONTRIBUTORS.md
+++ b/CONTRIBUTORS.md
@@ -12,4 +12,4 @@ Kirill Zaborsky ( qrilka )
 
 Kevin Brubeck Unhammer ( unhammer )
 
-
+Michal Gajda (mgajda)
\ No newline at end of file
diff --git a/src/Xeno/Errors.hs b/src/Xeno/Errors.hs
new file mode 100644
index 0000000..0920eb2
--- /dev/null
+++ b/src/Xeno/Errors.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Strict            #-}
+{-# LANGUAGE ViewPatterns      #-}
+-- | Simplifies raising and presenting localized exceptions to the user.
+module Xeno.Errors(printExceptions
+                  ,displayException
+                  ,getStartIndex
+                  ,failHere
+                  ) where
+
+import           Data.Semigroup((<>))
+import qualified Data.ByteString.Char8 as BS hiding (elem)
+import           Data.ByteString.Internal(ByteString(..))
+import           System.IO(stderr)
+
+import           Xeno.Types
+
+{-# NOINLINE failHere #-}
+failHere :: BS.ByteString -> BS.ByteString -> Either XenoException a
+failHere msg here = Left $ XenoParseError (getStartIndex here) msg
+
+-- | Print schema errors with excerpts
+printExceptions :: BS.ByteString -> [XenoException] -> IO ()
+printExceptions i s = (BS.hPutStrLn stderr . displayException i) `mapM_` s
+
+-- | Find line number of the error from ByteString index.
+lineNo :: Int -> BS.ByteString -> Int
+lineNo index bs = BS.count '\n'
+                $ BS.take index bs
+
+-- | Show for ByteStrings
+bshow :: Show a => a -> BS.ByteString
+bshow = BS.pack . show
+
+{-# INLINE CONLIKE getStartIndex #-}
+getStartIndex :: BS.ByteString -> Int
+getStartIndex (PS _ from _) = from
+
+displayException :: BS.ByteString -> XenoException -> BS.ByteString
+displayException input (XenoParseError i msg) =
+               "Parse error in line " <> bshow (lineNo i input) <> ": "
+            <> msg
+            <> " at:\n"
+            <> lineContentBeforeError
+            <> lineContentAfterError
+            <> "\n" <> pointer
+  where
+    lineContentBeforeError = snd $ BS.spanEnd   eoln $ revTake 40 $ BS.take i input
+    lineContentAfterError  =       BS.takeWhile eoln $ BS.take 40 $ BS.drop i input
+    pointer                = BS.replicate (BS.length lineContentBeforeError) ' ' <> "^"
+    eoln ch                = ch /= '\n' && ch /= '\r'
+displayException _      err                        = bshow err
+
+-- | Take n last bytes.
+revTake :: Int -> BS.ByteString -> BS.ByteString
+revTake i (PS ptr from to) = PS ptr (end-len) len
+  where
+    end = from + to
+    len = min to i
+
diff --git a/src/Xeno/SAX.hs b/src/Xeno/SAX.hs
index f61b46d..9580766 100644
--- a/src/Xeno/SAX.hs
+++ b/src/Xeno/SAX.hs
@@ -20,7 +20,6 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Unsafe as SU
 import           Data.Functor.Identity
-import           Data.Monoid
 import           Data.Word
 import           Xeno.Types
 
@@ -148,7 +147,7 @@ process openF attrF endOpenF textF closeF cdataF str = findLT 0
         this = S.drop index str
     findCommentEnd index =
       case elemIndexFrom commentChar str index of
-        Nothing -> throw (XenoParseError "Couldn't find the closing comment dash.")
+        Nothing -> throw $ XenoParseError index "Couldn't find the closing comment dash."
         Just fromDash ->
           if s_index this 0 == commentChar && s_index this 1 == closeTagChar
             then findLT (fromDash + 2)
@@ -156,7 +155,7 @@ process openF attrF endOpenF textF closeF cdataF str = findLT 0
           where this = S.drop index str
     findCDataEnd cdata_start index =
       case elemIndexFrom closeAngleBracketChar str index of
-        Nothing -> throw (XenoParseError "Couldn't find closing angle bracket for CDATA.")
+        Nothing -> throw $ XenoParseError index "Couldn't find closing angle bracket for CDATA."
         Just fromCloseAngleBracket ->
           if s_index str (fromCloseAngleBracket + 1) == closeAngleBracketChar
              then do
@@ -169,7 +168,7 @@ process openF attrF endOpenF textF closeF cdataF str = findLT 0
       let spaceOrCloseTag = parseName str index
       in if | s_index str index0 == questionChar ->
               case elemIndexFrom closeTagChar str spaceOrCloseTag of
-                Nothing -> throw (XenoParseError "Couldn't find the end of the tag.")
+                Nothing -> throw $ XenoParseError index "Couldn't find the end of the tag."
                 Just fromGt -> do
                   findLT (fromGt + 1)
             | s_index str spaceOrCloseTag == closeTagChar ->
@@ -212,7 +211,8 @@ process openF attrF endOpenF textF closeF cdataF str = findLT 0
                                                str
                                                (quoteIndex + 1) of
                                           Nothing ->
-                                            throw (XenoParseError "Couldn't find the matching quote character.")
+                                            throw
+                                              (XenoParseError index "Couldn't find the matching quote character.")
                                           Just endQuoteIndex -> do
                                             attrF
                                               (substring str index afterAttrName)
@@ -221,8 +221,9 @@ process openF attrF endOpenF textF closeF cdataF str = findLT 0
                                                  (quoteIndex + 1)
                                                  (endQuoteIndex))
                                             findAttributes (endQuoteIndex + 1)
-                                   else throw (XenoParseError ("Expected ' or \", got: " <> S.singleton usedChar))
-                         else throw (XenoParseError ("Expected =, got: " <> S.singleton (s_index str afterAttrName) <> " at character index: " <> (S8.pack . show) afterAttrName))
+                                   else throw
+                                         (XenoParseError index("Expected ' or \", got: " <> S.singleton usedChar))
+                         else throw (XenoParseError index ("Expected =, got: " <> S.singleton (s_index str afterAttrName) <> " at character index: " <> (S8.pack . show) afterAttrName))
       where
         index = skipSpaces str index0
 {-# INLINE process #-}
@@ -249,8 +250,8 @@ process openF attrF endOpenF textF closeF cdataF str = findLT 0
 -- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0.
 s_index :: ByteString -> Int -> Word8
 s_index ps n
-    | n < 0          = throw XenoStringIndexProblem
-    | n >= S.length ps = throw XenoStringIndexProblem
+    | n < 0            = throw (XenoStringIndexProblem n ps)
+    | n >= S.length ps = throw (XenoStringIndexProblem n ps)
     | otherwise      = ps `SU.unsafeIndex` n
 {-# INLINE s_index #-}
 
diff --git a/src/Xeno/Types.hs b/src/Xeno/Types.hs
index 231aade..eab1d49 100644
--- a/src/Xeno/Types.hs
+++ b/src/Xeno/Types.hs
@@ -12,8 +12,10 @@ import Data.Typeable
 import GHC.Generics
 
 data XenoException
-  = XenoStringIndexProblem
-  | XenoParseError ByteString
+  = XenoStringIndexProblem { stringIndex :: Int, inputString :: ByteString }
+  | XenoParseError         { inputIndex  :: Int, message     :: ByteString }
   | XenoExpectRootNode
   deriving (Show, Typeable, NFData, Generic)
+
 instance Exception XenoException where displayException = show
+
diff --git a/xeno.cabal b/xeno.cabal
index e9658f1..83aff48 100644
--- a/xeno.cabal
+++ b/xeno.cabal
@@ -1,5 +1,5 @@
 name: xeno
-version: 0.3.4
+version: 0.3.5
 synopsis: A fast event-based XML parser in pure Haskell
 description: A fast, low-memory use, event-based XML parser in pure Haskell.  
 build-type: Simple
@@ -9,8 +9,8 @@ homepage: https://github.com/ocramz/xeno
 license: BSD3
 license-file: LICENSE
 author: Christopher Done
-maintainer: Marco Zocca (zocca.marco gmail)
-tested-with:         GHC == 8.0.1, GHC == 8.2.2, GHC == 8.4.2
+maintainer: Marco Zocca (ocramz fripost org)
+tested-with:         GHC == 8.0.1, GHC == 8.2.2, GHC == 8.4.2, GHC == 8.4.4
 extra-source-files:  README.md
                      CHANGELOG.markdown
                      CONTRIBUTORS.md                             
@@ -26,10 +26,15 @@ flag libxml2
 library
   hs-source-dirs: src
   ghc-options: -Wall -O2
-  exposed-modules: Xeno.SAX, Xeno.DOM, Xeno.Types
+  exposed-modules: Xeno.SAX, Xeno.DOM, Xeno.Types, Xeno.Errors 
   other-modules: Control.Spork
   build-depends: base >= 4.7 && < 5
-               , bytestring, vector, deepseq, array, mutable-containers, mtl
+               , bytestring
+               , vector
+               , deepseq
+               , array
+               , mutable-containers
+               , mtl
                -- , exceptions
                -- | DEBUG 
                , hspec