Use ParseErrorPos for position reporting

Author: harendra-kumar

benchmark/Streamly/Benchmark/Data/Parser.hs

@@ -708,7 +708,7 @@ moduleName = "Data.Parser"
 
 instance NFData ParseError where
     {-# INLINE rnf #-}
-    rnf (ParseError i x) = rnf i `seq` rnf x
+    rnf (ParseError x) = rnf x
 
 o_1_space_serial :: Int -> [Benchmark]
 o_1_space_serial value =

benchmark/Streamly/Benchmark/Data/ParserK.hs

@@ -374,7 +374,7 @@ moduleName = MODULE_NAME
 
 instance NFData ParseError where
     {-# INLINE rnf #-}
-    rnf (ParseError i x) = rnf i `seq` rnf x
+    rnf (ParseError x) = rnf x
 
 o_1_space_serial :: Int -> [Benchmark]
 o_1_space_serial value =

benchmark/Streamly/Benchmark/Unicode/Parser.hs

@@ -72,7 +72,7 @@ moduleName = "Unicode.Parser"
 
 instance NFData ParseError where
     {-# INLINE rnf #-}
-    rnf (ParseError i x) = rnf i `seq` rnf x
+    rnf (ParseError x) = rnf x
 
 o_n_heap_serial :: Int -> [Benchmark]
 o_n_heap_serial value =

core/src/DocTestDataParser.hs

@@ -17,5 +17,4 @@ For APIs that have not been released yet.
 
 >>> import qualified Streamly.Internal.Data.Fold as Fold
 >>> import qualified Streamly.Internal.Data.Parser as Parser
->>> import qualified Streamly.Internal.Data.Stream as Stream (parsePos)
 -}

core/src/Streamly/Data/Parser.hs

@@ -188,6 +188,7 @@ module Streamly.Data.Parser
     -- * Parser Type
       Parser
     , ParseError(..)
+    , ParseErrorPos(..)
 
     -- -- * Downgrade to Fold
     -- , toFold

core/src/Streamly/Internal/Data/Array.hs

@@ -130,7 +130,7 @@ import Prelude hiding (length, null, last, map, (!!), read, concat)
 import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..), MutByteArray)
 import Streamly.Internal.Data.Serialize.Type (Serialize)
 import Streamly.Internal.Data.Fold.Type (Fold(..))
-import Streamly.Internal.Data.Parser (ParseError(..))
+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))
 import Streamly.Internal.Data.ParserK.Type
     (ParserK, ParseResult(..), Input(..), Step(..))
 import Streamly.Internal.Data.Stream (Stream(..))
@@ -1034,7 +1034,7 @@ parseBreakPos
     :: (Monad m, Unbox a)
     => ParserK (Array a) m b
     -> StreamK m (Array a)
-    -> m (Either ParseError b, StreamK m (Array a))
+    -> m (Either ParseErrorPos b, StreamK m (Array a))
 parseBreakPos = Drivers.parseBreakChunksPos
 
 {-# INLINE parse #-}
@@ -1047,7 +1047,7 @@ parse f = fmap fst . parseBreak f
 --
 {-# INLINE parsePos #-}
 parsePos :: (Monad m, Unbox a) =>
-    ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)
+    ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b)
 parsePos f = fmap fst . parseBreakPos f
 
 -------------------------------------------------------------------------------

core/src/Streamly/Internal/Data/Array/Generic.hs

@@ -18,7 +18,7 @@ module Streamly.Internal.Data.Array.Generic
     )
 where
 
-import Streamly.Internal.Data.Parser (ParseError(..))
+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))
 import Streamly.Internal.Data.StreamK.Type (StreamK)
 
 import qualified Streamly.Internal.Data.ParserDrivers as Drivers
@@ -47,7 +47,7 @@ parseBreakPos
     :: forall m a b. Monad m
     => ParserK.ParserK (Array a) m b
     -> StreamK m (Array a)
-    -> m (Either ParseError b, StreamK m (Array a))
+    -> m (Either ParseErrorPos b, StreamK m (Array a))
 parseBreakPos = Drivers.parseBreakChunksGenericPos
 
 {-# INLINE parse #-}
@@ -63,5 +63,5 @@ parsePos ::
        (Monad m)
     => ParserK.ParserK (Array a) m b
     -> StreamK m (Array a)
-    -> m (Either ParseError b)
+    -> m (Either ParseErrorPos b)
 parsePos f = fmap fst . parseBreakPos f

core/src/Streamly/Internal/Data/Array/Stream.hs

@@ -321,7 +321,7 @@ runArrayParserDBreak
     case res of
         PRD.IPartial s -> go SPEC state (List []) s
         PRD.IDone b -> return (Right b, stream)
-        PRD.IError err -> return (Left (ParseError (-1) err), stream)
+        PRD.IError err -> return (Left (ParseError err), stream)
 
     where
 
@@ -374,7 +374,7 @@ runArrayParserDBreak
                 let src0 = x:getList backBuf
                     src = Prelude.reverse src0 ++ x:xs
                     strm = D.append (D.fromList src) (D.Stream step s)
-                return (Left (ParseError (-1) err), strm)
+                return (Left (ParseError err), strm)
 
     -- This is a simplified gobuf
     goExtract _ [] backBuf !pst = goStop backBuf pst
@@ -411,7 +411,7 @@ runArrayParserDBreak
             PR.SError err -> do
                 let src0 = getList backBuf
                     src = Prelude.reverse src0 ++ x:xs
-                return (Left (ParseError (-1) err), D.fromList src)
+                return (Left (ParseError err), D.fromList src)
 
     -- This is a simplified goExtract
     {-# INLINE goStop #-}
@@ -438,7 +438,7 @@ runArrayParserDBreak
             PR.FError err -> do
                 let src0 = getList backBuf
                     src = Prelude.reverse src0
-                return (Left (ParseError (-1) err), D.fromList src)
+                return (Left (ParseError err), D.fromList src)
 
 {-
 -- | Parse an array stream using the supplied 'Parser'.  Returns the parse
@@ -516,7 +516,7 @@ runArrayFoldManyD
                         let next = ParseChunksInitLeftOver []
                         return
                             $ D.Skip
-                            $ ParseChunksYield (Left (ParseError (-1) err)) next
+                            $ ParseChunksYield (Left (ParseError err)) next
             D.Skip s -> return $ D.Skip $ ParseChunksInit [] s
             D.Stop   -> return D.Stop
 
@@ -533,7 +533,7 @@ runArrayFoldManyD
                 let next = ParseChunksInitLeftOver []
                 return
                     $ D.Skip
-                    $ ParseChunksYield (Left (ParseError (-1) err)) next
+                    $ ParseChunksYield (Left (ParseError err)) next
 
     -- This is a simplified ParseChunksInit
     stepOuter _ (ParseChunksInitBuf src) = do
@@ -548,7 +548,7 @@ runArrayFoldManyD
                 let next = ParseChunksInitLeftOver []
                 return
                     $ D.Skip
-                    $ ParseChunksYield (Left (ParseError (-1) err)) next
+                    $ ParseChunksYield (Left (ParseError err)) next
 
     -- XXX we just discard any leftover input at the end
     stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop
@@ -595,7 +595,7 @@ runArrayFoldManyD
                         let next = ParseChunksInitLeftOver []
                         return
                             $ D.Skip
-                            $ ParseChunksYield (Left (ParseError (-1) err)) next
+                            $ ParseChunksYield (Left (ParseError err)) next
 
             D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst
             D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst
@@ -637,7 +637,7 @@ runArrayFoldManyD
                 let next = ParseChunksInitLeftOver []
                 return
                     $ D.Skip
-                    $ ParseChunksYield (Left (ParseError (-1) err)) next
+                    $ ParseChunksYield (Left (ParseError err)) next
 
     -- This is a simplified ParseChunksBuf
     stepOuter _ (ParseChunksExtract [] buf pst) =
@@ -675,7 +675,7 @@ runArrayFoldManyD
                 let next = ParseChunksInitLeftOver []
                 return
                     $ D.Skip
-                    $ ParseChunksYield (Left (ParseError (-1) err)) next
+                    $ ParseChunksYield (Left (ParseError err)) next
 
 
     -- This is a simplified ParseChunksExtract
@@ -704,7 +704,7 @@ runArrayFoldManyD
                 let next = ParseChunksInitLeftOver []
                 return
                     $ D.Skip
-                    $ ParseChunksYield (Left (ParseError (-1) err)) next
+                    $ ParseChunksYield (Left (ParseError err)) next
 
     stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next
 

core/src/Streamly/Internal/Data/Parser.hs

@@ -19,12 +19,6 @@ module Streamly.Internal.Data.Parser
       module Streamly.Internal.Data.Parser.Type
     --, module Streamly.Internal.Data.Parser.Tee
 
-    -- * Types
-    , Parser (..)
-    , ParseError (..)
-    , Step (..)
-    , Initial (..)
-
     -- * Downgrade to Fold
     , toFold
 
@@ -618,7 +612,7 @@ data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
 -- Right [1,2]
 --
 -- >>> takeBetween' 2 4 [1]
--- Left (ParseError 1 "takeBetween: Expecting alteast 2 elements, got 1")
+-- Left (ParseErrorPos 1 "takeBetween: Expecting alteast 2 elements, got 1")
 --
 -- >>> takeBetween' 0 0 [1, 2]
 -- Right []
@@ -724,7 +718,7 @@ takeBetween low high (Fold fstep finitial _ ffinal) =
 -- Right [1,0]
 --
 -- >>> Stream.parsePos (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]
--- Left (ParseError 3 "takeEQ: Expecting exactly 4 elements, input terminated on 3")
+-- Left (ParseErrorPos 3 "takeEQ: Expecting exactly 4 elements, input terminated on 3")
 --
 {-# INLINE takeEQ #-}
 takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b
@@ -785,7 +779,7 @@ data TakeGEState s =
 --           elements.
 --
 -- >>> Stream.parsePos (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]
--- Left (ParseError 3 "takeGE: Expecting at least 4 elements, input terminated on 3")
+-- Left (ParseErrorPos 3 "takeGE: Expecting at least 4 elements, input terminated on 3")
 --
 -- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]
 -- Right [1,0,1,0,1]
@@ -1325,7 +1319,7 @@ takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond
 -- >>> p = Parser.takeBeginBy (== ',') Fold.toList
 -- >>> leadingComma = Stream.parsePos p . Stream.fromList
 -- >>> leadingComma "a,b"
--- Left (ParseError 1 "takeBeginBy: missing frame start")
+-- Left (ParseErrorPos 1 "takeBeginBy: missing frame start")
 -- ...
 -- >>> leadingComma ",,"
 -- Right ","
@@ -1403,7 +1397,7 @@ RENAME(takeStartBy_,takeBeginBy_)
 -- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"
 -- Right "hello {world"
 -- >>> Stream.parsePos p $ Stream.fromList "{hello {world}"
--- Left (ParseError 14 "takeFramedByEsc_: missing frame end")
+-- Left (ParseErrorPos 14 "takeFramedByEsc_: missing frame end")
 --
 -- /Pre-release/
 {-# INLINE takeFramedByEsc_ #-}
@@ -2146,7 +2140,7 @@ groupByRollingEither
 -- Right "string"
 --
 -- >>> Stream.parsePos (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"
--- Left (ParseError 2 "streamEqBy: mismtach occurred")
+-- Left (ParseErrorPos 2 "streamEqBy: mismtach occurred")
 --
 {-# INLINE listEqBy #-}
 listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]
@@ -2437,7 +2431,7 @@ spanByRolling eq f1 f2 =
 -- Right [1,2]
 --
 -- >>> Stream.parsePos (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
--- Left (ParseError 4 "takeEQ: Expecting exactly 5 elements, input terminated on 4")
+-- Left (ParseErrorPos 4 "takeEQ: Expecting exactly 5 elements, input terminated on 4")
 --
 -- /Internal/
 {-# INLINE takeP #-}
@@ -2591,7 +2585,7 @@ data DeintercalateAllState fs sp ss =
 -- >>> Stream.parse p $ Stream.fromList "1"
 -- Right [Left "1"]
 -- >>> Stream.parsePos p $ Stream.fromList "1+"
--- Left (ParseError 2 "takeWhile1: end of input")
+-- Left (ParseErrorPos 2 "takeWhile1: end of input")
 -- >>> Stream.parse p $ Stream.fromList "1+2+3"
 -- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
 --
@@ -2867,7 +2861,7 @@ data Deintercalate1State b fs sp ss =
 -- >>> p2 = Parser.satisfy (== '+')
 -- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
 -- >>> Stream.parsePos p $ Stream.fromList ""
--- Left (ParseError 0 "takeWhile1: end of input")
+-- Left (ParseErrorPos 0 "takeWhile1: end of input")
 -- >>> Stream.parse p $ Stream.fromList "1"
 -- Right [Left "1"]
 -- >>> Stream.parse p $ Stream.fromList "1+"
@@ -3160,7 +3154,7 @@ sepBy1 p sep sink = do
 -- >>> p2 = Parser.satisfy (== '+')
 -- >>> p = Parser.sepBy1 p1 p2 Fold.toList
 -- >>> Stream.parsePos p $ Stream.fromList ""
--- Left (ParseError 0 "takeWhile1: end of input")
+-- Left (ParseErrorPos 0 "takeWhile1: end of input")
 -- >>> Stream.parse p $ Stream.fromList "1"
 -- Right ["1"]
 -- >>> Stream.parse p $ Stream.fromList "1+"

core/src/Streamly/Internal/Data/Parser/Type.hs

@@ -188,6 +188,7 @@ module Streamly.Internal.Data.Parser.Type
     , bimapMorphOverrideCount
     , Parser (..)
     , ParseError (..)
+    , ParseErrorPos (..)
     , rmapM
 
     -- * Constructors
@@ -517,16 +518,23 @@ data Parser a m b =
         (s -> m (Final s b))
 
 -- | This exception is used when a parser ultimately fails, the user of the
--- parser is intimated via this exception. The @Int@ is the position in the
--- stream where the error ocurred. Note that the position is reported only when
--- a position reporting parser driver is used, otherwise it will be reported as
--- 0.
+-- parser is intimated via this exception.
 --
-data ParseError = ParseError Int String
+newtype ParseError = ParseError String
     deriving (Eq, Show)
 
 instance Exception ParseError where
-    displayException (ParseError pos err) = concat ["At ", show pos, ":", err]
+    displayException (ParseError err) = err
+
+-- | Like 'ParseError' but reports the stream position where the error ocurred.
+-- The @Int@ is the position in the stream where the error ocurred. This
+-- exception is used by position reporting parser drivers.
+data ParseErrorPos = ParseErrorPos Int String
+    deriving (Eq, Show)
+
+instance Exception ParseErrorPos where
+    displayException (ParseErrorPos pos err) =
+        concat ["At ", show pos, ":", err]
 
 -- | Map a function on the result i.e. on @b@ in @Parser a m b@.
 instance Functor m => Functor (Parser a m) where