Resolves #355: Support grabbing the bytes of intervals

Author: phadej

cborg/ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for cborg
 
+## 0.3.0.0
+
+* Add support for grabbing the input bytes of intervals, i.e. `getInputSpan`.
+
 ## 0.2.10.0
 
 * Return `TypeUInt64` and `TypeNInt64` from `tokenType` when appropriate, fixing [#324](https://github.com/well-typed/cborg/issues/324)

cborg/cborg.cabal

@@ -129,6 +129,7 @@ test-suite cborg-tests
     Tests.Boundary
     Tests.ATerm
     Tests.ByteOffset
+    Tests.GetInputSpan
     Tests.Canonical
     Tests.PreEncoded
     Tests.Regress

cborg/src/Codec/CBOR/Decoding.hs

@@ -76,6 +76,10 @@ module Codec.CBOR.Decoding
   , peekByteOffset       -- :: Decoder s ByteOffset
   , decodeWithByteSpan
 
+  , markInput            -- :: Decoder s ()
+  , unmarkInput          -- :: Decoder s ()
+  , getInputSpan         -- :: Decoder s LazyByteString
+
   -- ** Canonical CBOR
   -- $canonical
   , decodeWordCanonical      -- :: Decoder s Word
@@ -118,6 +122,7 @@ import           GHC.Word
 import           GHC.Int
 import           Data.Text (Text)
 import           Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LBS
 import           Control.Applicative
 import           Control.Monad.ST
 import qualified Control.Monad.Fail as Fail
@@ -193,6 +198,9 @@ data DecodeAction s a
 #else
     | PeekByteOffset (Int#      -> ST s (DecodeAction s a))
 #endif
+    | MarkInput (ST s (DecodeAction s a))
+    | UnmarkInput (ST s (DecodeAction s a))
+    | GetInputSpan (LBS.ByteString -> ST s (DecodeAction s a))
 
       -- All the canonical variants
     | ConsumeWordCanonical    (Word# -> ST s (DecodeAction s a))
@@ -990,6 +998,25 @@ peekByteOffset = Decoder (\k -> return (PeekByteOffset (\off# -> k (I64#
     ))))
 {-# INLINE peekByteOffset #-}
 
+-- |
+--
+-- @since 0.3.0.0
+markInput :: Decoder s ()
+markInput = Decoder (\k -> return (MarkInput (k ())))
+
+-- |
+--
+-- @since 0.3.0.0
+unmarkInput :: Decoder s ()
+unmarkInput = Decoder (\k -> return (UnmarkInput (k ())))
+
+-- |
+--
+-- @since 0.3.0.0
+getInputSpan :: Decoder s LBS.ByteString
+getInputSpan = Decoder (\k -> return (GetInputSpan k))
+
+
 -- | This captures the pattern of getting the byte offsets before and after
 -- decoding a subterm.
 --

cborg/src/Codec/CBOR/FlatTerm.hs

@@ -67,6 +67,7 @@ import           Data.Text (Text)
 import qualified Data.Text.Encoding as TE
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
 import           Control.Monad.ST
 import qualified Control.Monad.ST.Lazy as ST.Lazy
 
@@ -473,6 +474,9 @@ fromFlatTerm decoder ft =
 #else
     go ts        (PeekByteOffset k)= k 0# >>= go ts
 #endif
+    go ts        (MarkInput k)     = k >>= go ts
+    go ts        (UnmarkInput k)   = k >>= go ts
+    go ts        (GetInputSpan k)  = k LBS.empty >>= go ts
 
     go _  (Fail msg) = return $ Left msg
     go [] (Done x)   = return $ Right x

cborg/src/Codec/CBOR/Magic.hs

@@ -55,6 +55,7 @@ module Codec.CBOR.Magic
 
   , intToWord         -- :: Int    -> Word
   , intToInt64        -- :: Int    -> Int64
+  , int64ToInt
 
   , intToWord64       -- :: Int    -> Word64
   , int64ToWord64     -- :: Int64  -> Word64
@@ -391,6 +392,10 @@ intToInt64 :: Int -> Int64
 intToInt64 = fromIntegral
 {-# INLINE intToInt64 #-}
 
+int64ToInt :: Int64 -> Int
+int64ToInt = fromIntegral
+{-# INLINE int64ToInt #-}
+
 intToWord :: Int -> Word
 intToWord = fromIntegral
 {-# INLINE intToWord #-}