Commits

Anonymous committed 070be19

Added position tracking

Comments (0)

Files changed (3)

Data/Attoparsec.hs

     -- ** Result conversion
     , maybeResult
     , eitherResult
+    , bytesRead
 
     -- * Combinators
     , (I.<?>)
     -- * State observation and manipulation functions
     , I.endOfInput
     , I.ensure
+    , I.getPosition
     ) where
 
 import Data.Attoparsec.Combinator
 import qualified Data.Attoparsec.Internal as I
 import qualified Data.ByteString as B
+import Data.Int (Int64)
 
 -- $parsec
 --
 -- transforms the value in a 'Done' result.
 
 -- | The result of a parse.
-data Result r = Fail !B.ByteString [String] String
+data Result r = Fail !B.ByteString Int64 [String] String
               -- ^ The parse failed.  The 'B.ByteString' is the input
               -- that had not yet been consumed when the failure
-              -- occurred.  The @[@'String'@]@ is a list of contexts
-              -- in which the error occurred.  The 'String' is the
-              -- message describing the error, if any.
+              -- occurred.  The 'Int64' is a number of successfully
+              -- consumed bytes.  The @[@'String'@]@ is a list of
+              -- contexts in which the error occurred.  The 'String'
+              -- is the message describing the error, if any.
               | Partial (B.ByteString -> Result r)
               -- ^ Supply this continuation with more input so that
               -- the parser can resume.  To indicate that no more
               -- input is available, use an 'B.empty' string.
-              | Done !B.ByteString r
+              | Done !B.ByteString Int64 r
               -- ^ The parse succeeded.  The 'B.ByteString' is the
               -- input that had not yet been consumed (if any) when
-              -- the parse succeeded.
+              -- the parse succeeded.  The 'Int64' is a number of
+              -- consumed bytes.
 
 instance Show r => Show (Result r) where
-    show (Fail bs stk msg) =
-        "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg
-    show (Partial _)       = "Partial _"
-    show (Done bs r)       = "Done " ++ show bs ++ " " ++ show r
+    show (Fail bs pos stk msg) =
+        "Fail " ++ show bs ++ " " ++ show pos ++ " " ++ show stk ++ " " ++ show msg
+    show (Partial _)           = "Partial _"
+    show (Done bs pos r)       = "Done " ++ show bs ++ " " ++ show pos ++ " " ++ show r
 
 -- | If a parser has returned a 'Partial' result, supply it with more
 -- input.
 feed :: Result r -> B.ByteString -> Result r
-feed f@(Fail _ _ _) _ = f
-feed (Partial k) d    = k d
-feed (Done bs r) d    = Done (B.append bs d) r
+feed f@(Fail _ _ _ _) _ = f
+feed (Partial k) d      = k d
+feed (Done bs pos r) d  = Done (B.append bs d) pos r
 
 fmapR :: (a -> b) -> Result a -> Result b
-fmapR _ (Fail st stk msg) = Fail st stk msg
-fmapR f (Partial k)       = Partial (fmapR f . k)
-fmapR f (Done bs r)       = Done bs (f r)
+fmapR _ (Fail st pos stk msg) = Fail st pos stk msg
+fmapR f (Partial k)           = Partial (fmapR f . k)
+fmapR f (Done bs pos r)       = Done bs pos (f r)
 
 instance Functor Result where
     fmap = fmapR
 parseTest p s = print (parse p s)
 
 translate :: I.Result a -> Result a
-translate (I.Fail st stk msg) = Fail (I.input st) stk msg
+translate (I.Fail st stk msg) = Fail (I.input st) (I.position st) stk msg
 translate (I.Partial k)       = Partial (translate . k)
-translate (I.Done st r)       = Done (I.input st) r
+translate (I.Done st r)       = Done (I.input st) (I.position st) r
 
 -- | Run a parser and return its result.
 parse :: I.Parser a -> B.ByteString -> Result a
           -- ^ Initial input for the parser.
           -> m (Result a)
 parseWith refill p s = step $ I.parse p s
-  where step (I.Fail st stk msg) = return $! Fail (I.input st) stk msg
+  where step (I.Fail st stk msg) = return $! Fail (I.input st) (I.position st) stk msg
         step (I.Partial k)       = (step . k) =<< refill
-        step (I.Done st r)       = return $! Done (I.input st) r
+        step (I.Done st r)       = return $! Done (I.input st) (I.position st) r
 
 -- | Convert a 'Result' value to a 'Maybe' value. A 'Partial' result
 -- is treated as failure.
 maybeResult :: Result r -> Maybe r
-maybeResult (Done _ r) = Just r
-maybeResult _          = Nothing
+maybeResult (Done _ _ r) = Just r
+maybeResult _            = Nothing
 
 -- | Convert a 'Result' value to an 'Either' value. A 'Partial' result
 -- is treated as failure.
 eitherResult :: Result r -> Either String r
-eitherResult (Done _ r)     = Right r
-eitherResult (Fail _ _ msg) = Left msg
-eitherResult _              = Left "Result: incomplete input"
+eitherResult (Done _ _ r)     = Right r
+eitherResult (Fail _ _ _ msg) = Left msg
+eitherResult _                = Left "Result: incomplete input"
+
+-- | Convert a 'Result' value to a number of consumed bytes.  In the
+-- 'Partial' case, the continuation receives an empty input.
+bytesRead :: Result r -> Int64
+bytesRead (Done _ pos _)   = pos
+bytesRead (Fail _ pos _ _) = pos
+bytesRead (Partial k)      = bytesRead (k B.empty)

Data/Attoparsec/Internal.hs

     -- * Parser types
       Parser
     , Result(..)
-    , S(input)
+    , S(input, position)
 
     -- * Running parsers
     , parse
     -- * State observation and manipulation functions
     , endOfInput
     , ensure
+    , getPosition
 
     -- * Utilities
     , endOfLine
 import Control.Monad (MonadPlus(..), when)
 import Data.Attoparsec.Combinator
 import Data.Attoparsec.FastSet (charClass, memberWord8)
+import Data.Int (Int64)
 import Data.Monoid (Monoid(..))
 import Data.Word (Word8)
 import Foreign.ForeignPtr (withForeignPtr)
 
 data S = S {
       input  :: !B.ByteString
-    , _added :: !B.ByteString
+    , added :: !B.ByteString
     , more  :: !More
+    , position :: !Int64
     } deriving (Show)
 
 instance Show r => Show (Result r) where
     show (Done bs r) = "Done " ++ show bs ++ " " ++ show r
 
 addS :: S -> S -> S
-addS (S s0 a0 c0) (S _s1 a1 c1) = S (s0 +++ a1) (a0 +++ a1) (mappend c0 c1)
+addS (S s0 a0 c0 i0) (S _s1 a1 c1 _i1) = S (s0 +++ a1) (a0 +++ a1) (mappend c0 c1) i0
 {-# INLINE addS #-}
 
 instance Monoid S where
-    mempty  = S B.empty B.empty Incomplete
+    mempty  = S B.empty B.empty Incomplete 0
     mappend = addS
 
 bindP :: Parser a -> (a -> Parser b) -> Parser b
     fail   = failDesc
 
 noAdds :: S -> S
-noAdds (S s0 _a0 c0) = S s0 B.empty c0
+noAdds s = s { added = B.empty }
 {-# INLINE noAdds #-}
 
 plus :: Parser a -> Parser a -> Parser a
 
 -- | Succeed only if at least @n@ bytes of input are available.
 ensure :: Int -> Parser ()
-ensure n = Parser $ \st0@(S s0 _a0 _c0) kf ks ->
+ensure n = Parser $ \st0@(S s0 _a0 _c0 _i0) kf ks ->
     if B.length s0 >= n
     then ks st0 ()
     else runParser (demandInput >> ensure n) st0 kf ks
 -- | Ask for input.  If we receive any, pass it to a success
 -- continuation, otherwise to a failure continuation.
 prompt :: S -> (S -> Result r) -> (S -> Result r) -> Result r
-prompt (S s0 a0 _c0) kf ks = Partial $ \s ->
+prompt (S s0 a0 _c0 i0) kf ks = Partial $ \s ->
     if B.null s
-    then kf $! S s0 a0 Complete
-    else ks $! S (s0 +++ s) (a0 +++ s) Incomplete
+    then kf $! S s0 a0 Complete i0
+    else ks $! S (s0 +++ s) (a0 +++ s) Incomplete i0
 
 -- | Immediately demand more input via a 'Partial' continuation
 -- result.
 -- available either immediately or on demand, and 'False' if the end
 -- of all input has been reached.
 wantInput :: Parser Bool
-wantInput = Parser $ \st0@(S s0 _a0 c0) _kf ks ->
+wantInput = Parser $ \st0@(S s0 _a0 c0 _i0) _kf ks ->
   case () of
     _ | not (B.null s0) -> ks st0 True
       | c0 == Complete  -> ks st0 False
 get :: Parser B.ByteString
 get  = Parser (\st0 _kf ks -> ks st0 (input st0))
 
-put :: B.ByteString -> Parser ()
-put s = Parser (\(S _s0 a0 c0) _kf ks -> ks (S s a0 c0) ())
+-- | Return a number of bytes consumed so far.
+getPosition :: Parser Int64
+getPosition = Parser (\st0 _kf ks -> ks st0 (position st0))
+
+-- get' :: Parser (B.ByteString, Int64)
+-- get' = Parser (\st0 _kf ks -> ks st0 (input st0, position st0))
+
+-- put :: B.ByteString -> Parser ()
+-- put s = Parser (\(S _s0 a0 c0 i0) _kf ks -> ks (S s a0 c0 i0) ())
+
+put' :: B.ByteString -> Int64 -> Parser ()
+put' s di = Parser (\(S _s0 a0 c0 i0) _kf ks -> ks (S s a0 c0 (i0 + di)) ())
 
 (+++) :: B.ByteString -> B.ByteString -> B.ByteString
 (+++) = B.append
   s <- get
   let w = B.unsafeHead s
   if p w
-    then put (B.unsafeTail s) >> return w
+    then put' (B.unsafeTail s) 1 >> return w
     else fail "satisfy"
 
 -- | The parser @skip p@ succeeds for any byte for which the predicate
   ensure 1
   s <- get
   if p (B.unsafeHead s)
-    then put (B.unsafeTail s)
+    then put' (B.unsafeTail s) 1
     else fail "skip"
 
 -- | The parser @satisfyWith f p@ transforms a byte, and succeeds if
   s <- get
   let c = f (B.unsafeHead s)
   if p c
-    then put (B.unsafeTail s) >> return c
+    then put' (B.unsafeTail s) 1 >> return c
     else fail "satisfyWith"
 
 storable :: Storable a => Parser a
   s <- get
   let (h,t) = B.splitAt n s
   if p h
-    then put t >> return h
+    then put' t (fromIntegral n) >> return h
     else failDesc "takeWith"
 
 -- | Consume exactly @n@ bytes of input.
   go = do
     input <- wantInput
     when input $ do
-      t <- B8.dropWhile p <$> get
-      put t
+      s <- get
+      let t = B8.dropWhile p s
+      put' t (fromIntegral (B.length s - B.length t))
       when (B.null t) go
 
 -- | Consume input as long as the predicate returns 'False'
     if input
       then do
         (h,t) <- B8.span p <$> get
-        put t
+        put' t (fromIntegral (B.length h))
         if B.null t
           then (h+++) `fmapP` go
           else return h
   (`when` demandInput) =<< B.null <$> get
   (h,t) <- B8.span p <$> get
   when (B.null h) $ failDesc "takeWhile1"
-  put t
+  put' t (fromIntegral (B.length h))
   if B.null t
     then (h+++) `fmapP` takeWhile p
     else return h
 
 -- | Run a parser.
 parse :: Parser a -> B.ByteString -> Result a
-parse m s = runParser m (S s B.empty Incomplete) failK successK
+parse m s = runParser m (S s B.empty Incomplete 0) failK successK
 {-# INLINE parse #-}

Data/Attoparsec/Lazy.hs

     -- ** Result conversion
     , maybeResult
     , eitherResult
+    , bytesRead
     ) where
 
 import Data.ByteString.Lazy.Internal (ByteString(..), chunk)
 import qualified Data.ByteString as B
 import qualified Data.Attoparsec as A
 import Data.Attoparsec hiding (Result(..), eitherResult, maybeResult,
-                               parse, parseWith, parseTest)
+                               bytesRead, parse, parseWith, parseTest)
+
+import Data.Int (Int64)
 
 -- | The result of a parse.
-data Result r = Fail ByteString [String] String
+data Result r = Fail ByteString Int64 [String] String
               -- ^ The parse failed.  The 'ByteString' is the input
               -- that had not yet been consumed when the failure
-              -- occurred.  The @[@'String'@]@ is a list of contexts
-              -- in which the error occurred.  The 'String' is the
-              -- message describing the error, if any.
-              | Done ByteString r
-              -- ^ The parse succeeded.  The 'ByteString' is the
-              -- input that had not yet been consumed (if any) when
-              -- the parse succeeded.
+              -- occurred.  The 'Int64' is a number of successfully
+              -- consumed bytes.  The @[@'String'@]@ is a list of
+              -- contexts in which the error occurred.  The 'String'
+              -- is the message describing the error, if any.
+              | Done ByteString Int64 r
+              -- ^ The parse succeeded.  The 'ByteString' is the input
+              -- that had not yet been consumed (if any) when the
+              -- parse succeeded.  The 'Int64' is a number of consumed
+              -- bytes.
 
 instance Show r => Show (Result r) where
-    show (Fail bs stk msg) =
-        "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg
-    show (Done bs r)       = "Done " ++ show bs ++ " " ++ show r
+    show (Fail bs pos stk msg) =
+        "Fail " ++ show bs ++ " " ++ show pos ++ " " ++ show stk ++ " " ++ show msg
+    show (Done bs pos r)       = "Done " ++ show bs ++ " " ++ show pos ++ " " ++ show r
 
 fmapR :: (a -> b) -> Result a -> Result b
-fmapR _ (Fail st stk msg) = Fail st stk msg
-fmapR f (Done bs r)       = Done bs (f r)
+fmapR _ (Fail st pos stk msg) = Fail st pos stk msg
+fmapR f (Done bs pos r)       = Done bs pos (f r)
 
 instance Functor Result where
     fmap = fmapR
               Chunk x xs -> go (A.parse p x) xs
               empty      -> go (A.parse p B.empty) empty
   where
-    go (A.Fail x stk msg) ys      = Fail (chunk x ys) stk msg
-    go (A.Done x r) ys            = Done (chunk x ys) r
+    go (A.Fail x pos stk msg) ys  = Fail (chunk x ys) pos stk msg
+    go (A.Done x pos r) ys        = Done (chunk x ys) pos r
     go (A.Partial k) (Chunk y ys) = go (k y) ys
     go (A.Partial k) empty        = go (k B.empty) empty
 
 
 -- | Convert a 'Result' value to a 'Maybe' value.
 maybeResult :: Result r -> Maybe r
-maybeResult (Done _ r) = Just r
-maybeResult _          = Nothing
+maybeResult (Done _ _ r) = Just r
+maybeResult _            = Nothing
 
 -- | Convert a 'Result' value to an 'Either' value.
 eitherResult :: Result r -> Either String r
-eitherResult (Done _ r)     = Right r
-eitherResult (Fail _ _ msg) = Left msg
+eitherResult (Done _ _ r)     = Right r
+eitherResult (Fail _ _ _ msg) = Left msg
+
+-- | Convert a 'Result' value to a number of consumed bytes.
+bytesRead :: Result r -> Int64
+bytesRead (Done _ pos _)   = pos
+bytesRead (Fail _ pos _ _) = pos
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.