{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ouroboros.Consensus.Util.CBOR (
    -- * Incremental parsing in I/O
    IDecodeIO (..)
  , deserialiseIncrementalIO
  , fromIDecode
    -- * Higher-level incremental interface
  , Decoder (..)
  , initDecoderIO
    -- * Decode as FlatTerm
  , decodeAsFlatTerm
    -- * HasFS interaction
  , ReadIncrementalErr (..)
  , readIncremental
  , withStreamIncrementalOffsets
    -- * Encoding/decoding containers
  , decodeList
  , decodeMaybe
  , decodeSeq
  , decodeWithOrigin
  , encodeList
  , encodeMaybe
  , encodeSeq
  , encodeWithOrigin
  ) where

import qualified Codec.CBOR.Decoding as CBOR.D
import qualified Codec.CBOR.Encoding as CBOR.E
import qualified Codec.CBOR.FlatTerm as CBOR.F
import qualified Codec.CBOR.Read as CBOR.R
import           Control.Exception (assert)
import           Control.Monad
import           Control.Monad.Except
import           Control.Monad.ST
import qualified Control.Monad.ST.Lazy as ST.Lazy
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Data.ByteString.Builder.Extra (defaultChunkSize)
import qualified Data.ByteString.Lazy as LBS
import           Data.Foldable (toList)
import           Data.IORef
import           Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as Seq
import           Data.Word (Word64)
import           GHC.Stack (HasCallStack)

import qualified Streaming as S
import           Streaming.Prelude (Of (..), Stream)
import qualified Streaming.Prelude as S

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Util.IOLike

import           Ouroboros.Consensus.Storage.FS.API
import           Ouroboros.Consensus.Storage.FS.API.Types

{-------------------------------------------------------------------------------
  Incremental parsing in I/O
-------------------------------------------------------------------------------}

data IDecodeIO a =
    Partial (Maybe ByteString -> IO (IDecodeIO a))
  | Done !ByteString !CBOR.R.ByteOffset a
  | Fail !ByteString !CBOR.R.ByteOffset CBOR.R.DeserialiseFailure

fromIDecode :: CBOR.R.IDecode RealWorld a -> IDecodeIO a
fromIDecode :: IDecode RealWorld a -> IDecodeIO a
fromIDecode (CBOR.R.Partial Maybe ByteString -> ST RealWorld (IDecode RealWorld a)
k)     = (Maybe ByteString -> IO (IDecodeIO a)) -> IDecodeIO a
forall a. (Maybe ByteString -> IO (IDecodeIO a)) -> IDecodeIO a
Partial ((Maybe ByteString -> IO (IDecodeIO a)) -> IDecodeIO a)
-> (Maybe ByteString -> IO (IDecodeIO a)) -> IDecodeIO a
forall a b. (a -> b) -> a -> b
$ (IDecode RealWorld a -> IDecodeIO a)
-> IO (IDecode RealWorld a) -> IO (IDecodeIO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IDecode RealWorld a -> IDecodeIO a
forall a. IDecode RealWorld a -> IDecodeIO a
fromIDecode (IO (IDecode RealWorld a) -> IO (IDecodeIO a))
-> (Maybe ByteString -> IO (IDecode RealWorld a))
-> Maybe ByteString
-> IO (IDecodeIO a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST RealWorld (IDecode RealWorld a) -> IO (IDecode RealWorld a)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (IDecode RealWorld a) -> IO (IDecode RealWorld a))
-> (Maybe ByteString -> ST RealWorld (IDecode RealWorld a))
-> Maybe ByteString
-> IO (IDecode RealWorld a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> ST RealWorld (IDecode RealWorld a)
k
fromIDecode (CBOR.R.Done ByteString
bs ByteOffset
off a
x) = ByteString -> ByteOffset -> a -> IDecodeIO a
forall a. ByteString -> ByteOffset -> a -> IDecodeIO a
Done ByteString
bs ByteOffset
off a
x
fromIDecode (CBOR.R.Fail ByteString
bs ByteOffset
off DeserialiseFailure
e) = ByteString -> ByteOffset -> DeserialiseFailure -> IDecodeIO a
forall a.
ByteString -> ByteOffset -> DeserialiseFailure -> IDecodeIO a
Fail ByteString
bs ByteOffset
off DeserialiseFailure
e

deserialiseIncrementalIO :: (forall s. CBOR.D.Decoder s a) -> IO (IDecodeIO a)
deserialiseIncrementalIO :: (forall s. Decoder s a) -> IO (IDecodeIO a)
deserialiseIncrementalIO = (IDecode RealWorld a -> IDecodeIO a)
-> IO (IDecode RealWorld a) -> IO (IDecodeIO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IDecode RealWorld a -> IDecodeIO a
forall a. IDecode RealWorld a -> IDecodeIO a
fromIDecode
                         (IO (IDecode RealWorld a) -> IO (IDecodeIO a))
-> (Decoder RealWorld a -> IO (IDecode RealWorld a))
-> Decoder RealWorld a
-> IO (IDecodeIO a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST RealWorld (IDecode RealWorld a) -> IO (IDecode RealWorld a)
forall a. ST RealWorld a -> IO a
stToIO
                         (ST RealWorld (IDecode RealWorld a) -> IO (IDecode RealWorld a))
-> (Decoder RealWorld a -> ST RealWorld (IDecode RealWorld a))
-> Decoder RealWorld a
-> IO (IDecode RealWorld a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder RealWorld a -> ST RealWorld (IDecode RealWorld a)
forall s a. Decoder s a -> ST s (IDecode s a)
CBOR.R.deserialiseIncremental

{-------------------------------------------------------------------------------
  Higher-level incremental interface
-------------------------------------------------------------------------------}

data Decoder m = Decoder {
      -- | Decode next failure
      --
      -- May throw 'CBOR.DeserialiseFailure'
      Decoder m -> forall a. (forall s. Decoder s a) -> m a
decodeNext :: forall a. (forall s. CBOR.D.Decoder s a) -> m a
    }

-- | Construct incremental decoder given a way to get chunks
--
-- Resulting decoder is not thread safe.
initDecoderIO :: IO ByteString -> IO (Decoder IO)
initDecoderIO :: IO ByteString -> IO (Decoder IO)
initDecoderIO IO ByteString
getChunk = do
    IORef ByteString
leftover <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
BS.empty
    let go :: forall a. (forall s. CBOR.D.Decoder s a) -> IO a
        go :: (forall s. Decoder s a) -> IO a
go forall s. Decoder s a
decoder = do
           IDecodeIO a
i <- (forall s. Decoder s a) -> IO (IDecodeIO a)
forall a. (forall s. Decoder s a) -> IO (IDecodeIO a)
deserialiseIncrementalIO forall s. Decoder s a
decoder
           case IDecodeIO a
i of
             Done ByteString
bs ByteOffset
_ a
a -> Bool -> IO a -> IO a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ByteString -> Bool
BS.null ByteString
bs) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
             Fail ByteString
_  ByteOffset
_ DeserialiseFailure
e -> DeserialiseFailure -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO DeserialiseFailure
e
             Partial Maybe ByteString -> IO (IDecodeIO a)
k   -> IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
leftover IO ByteString -> (ByteString -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe ByteString -> IO (IDecodeIO a)
k (Maybe ByteString -> IO (IDecodeIO a))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> IO (IDecodeIO a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> IO (IDecodeIO a))
-> (IDecodeIO a -> IO a) -> ByteString -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IDecodeIO a -> IO a
forall a. IDecodeIO a -> IO a
goWith)

        goWith :: forall a. IDecodeIO a -> IO a
        goWith :: IDecodeIO a -> IO a
goWith (Partial Maybe ByteString -> IO (IDecodeIO a)
k)   = IO (Maybe ByteString)
getChunk' IO (Maybe ByteString) -> (Maybe ByteString -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe ByteString -> IO (IDecodeIO a)
k (Maybe ByteString -> IO (IDecodeIO a))
-> (IDecodeIO a -> IO a) -> Maybe ByteString -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IDecodeIO a -> IO a
forall a. IDecodeIO a -> IO a
goWith)
        goWith (Done ByteString
bs ByteOffset
_ a
a) = IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
leftover ByteString
bs IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        goWith (Fail ByteString
_  ByteOffset
_ DeserialiseFailure
e) = DeserialiseFailure -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO DeserialiseFailure
e

    Decoder IO -> IO (Decoder IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decoder IO -> IO (Decoder IO)) -> Decoder IO -> IO (Decoder IO)
forall a b. (a -> b) -> a -> b
$ (forall a. (forall s. Decoder s a) -> IO a) -> Decoder IO
forall (m :: * -> *).
(forall a. (forall s. Decoder s a) -> m a) -> Decoder m
Decoder forall a. (forall s. Decoder s a) -> IO a
go

  where
    getChunk' :: IO (Maybe ByteString)
    getChunk' :: IO (Maybe ByteString)
getChunk' = ByteString -> Maybe ByteString
checkEmpty (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
getChunk

    checkEmpty :: ByteString -> Maybe ByteString
    checkEmpty :: ByteString -> Maybe ByteString
checkEmpty ByteString
bs | ByteString -> Bool
BS.null ByteString
bs = Maybe ByteString
forall a. Maybe a
Nothing
                  | Bool
otherwise  = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs

{-------------------------------------------------------------------------------
  Decode as FlatTerm
-------------------------------------------------------------------------------}

decodeAsFlatTerm ::
     ByteString
  -> Either CBOR.R.DeserialiseFailure CBOR.F.FlatTerm
decodeAsFlatTerm :: ByteString -> Either DeserialiseFailure FlatTerm
decodeAsFlatTerm ByteString
bs0 =
    (forall s. ST s (Either DeserialiseFailure FlatTerm))
-> Either DeserialiseFailure FlatTerm
forall a. (forall s. ST s a) -> a
ST.Lazy.runST (ExceptT DeserialiseFailure (ST s) FlatTerm
-> ST s (Either DeserialiseFailure FlatTerm)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ByteString -> ExceptT DeserialiseFailure (ST s) FlatTerm
forall s. ByteString -> ExceptT DeserialiseFailure (ST s) FlatTerm
provideInput ByteString
bs0))
  where
    provideInput ::
         ByteString
      -> ExceptT CBOR.R.DeserialiseFailure (ST.Lazy.ST s) CBOR.F.FlatTerm
    provideInput :: ByteString -> ExceptT DeserialiseFailure (ST s) FlatTerm
provideInput ByteString
bs
      | ByteString -> Bool
BS.null ByteString
bs = FlatTerm -> ExceptT DeserialiseFailure (ST s) FlatTerm
forall (m :: * -> *) a. Monad m => a -> m a
return []
      | Bool
otherwise      = do
          IDecode s TermToken
next <- ST s (IDecode s TermToken)
-> ExceptT DeserialiseFailure (ST s) (IDecode s TermToken)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s (IDecode s TermToken)
 -> ExceptT DeserialiseFailure (ST s) (IDecode s TermToken))
-> ST s (IDecode s TermToken)
-> ExceptT DeserialiseFailure (ST s) (IDecode s TermToken)
forall a b. (a -> b) -> a -> b
$ ST s (IDecode s TermToken) -> ST s (IDecode s TermToken)
forall s a. ST s a -> ST s a
ST.Lazy.strictToLazyST (ST s (IDecode s TermToken) -> ST s (IDecode s TermToken))
-> ST s (IDecode s TermToken) -> ST s (IDecode s TermToken)
forall a b. (a -> b) -> a -> b
$ do
              -- This will always be a 'Partial' here because decodeTermToken
              -- always starts by requesting initial input. Only decoders that
              -- fail or return a value without looking at their input can give
              -- a different initial result.
              CBOR.R.Partial Maybe ByteString -> ST s (IDecode s TermToken)
k <- Decoder s TermToken -> ST s (IDecode s TermToken)
forall s a. Decoder s a -> ST s (IDecode s a)
CBOR.R.deserialiseIncremental Decoder s TermToken
forall s. Decoder s TermToken
CBOR.F.decodeTermToken
              Maybe ByteString -> ST s (IDecode s TermToken)
k (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)
          IDecode s TermToken -> ExceptT DeserialiseFailure (ST s) FlatTerm
forall s.
IDecode s TermToken -> ExceptT DeserialiseFailure (ST s) FlatTerm
collectOutput IDecode s TermToken
next

    collectOutput ::
         CBOR.R.IDecode s CBOR.F.TermToken
      -> ExceptT CBOR.R.DeserialiseFailure (ST.Lazy.ST s) CBOR.F.FlatTerm
    collectOutput :: IDecode s TermToken -> ExceptT DeserialiseFailure (ST s) FlatTerm
collectOutput (CBOR.R.Fail ByteString
_ ByteOffset
_ DeserialiseFailure
err) = DeserialiseFailure -> ExceptT DeserialiseFailure (ST s) FlatTerm
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DeserialiseFailure
err
    collectOutput (CBOR.R.Partial    Maybe ByteString -> ST s (IDecode s TermToken)
k) = ST s (IDecode s TermToken)
-> ExceptT DeserialiseFailure (ST s) (IDecode s TermToken)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s (IDecode s TermToken) -> ST s (IDecode s TermToken)
forall s a. ST s a -> ST s a
ST.Lazy.strictToLazyST (Maybe ByteString -> ST s (IDecode s TermToken)
k Maybe ByteString
forall a. Maybe a
Nothing)) ExceptT DeserialiseFailure (ST s) (IDecode s TermToken)
-> (IDecode s TermToken
    -> ExceptT DeserialiseFailure (ST s) FlatTerm)
-> ExceptT DeserialiseFailure (ST s) FlatTerm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                          IDecode s TermToken -> ExceptT DeserialiseFailure (ST s) FlatTerm
forall s.
IDecode s TermToken -> ExceptT DeserialiseFailure (ST s) FlatTerm
collectOutput
    collectOutput (CBOR.R.Done ByteString
bs' ByteOffset
_ TermToken
x) = do FlatTerm
xs <- ByteString -> ExceptT DeserialiseFailure (ST s) FlatTerm
forall s. ByteString -> ExceptT DeserialiseFailure (ST s) FlatTerm
provideInput ByteString
bs'
                                             FlatTerm -> ExceptT DeserialiseFailure (ST s) FlatTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (TermToken
x TermToken -> FlatTerm -> FlatTerm
forall a. a -> [a] -> [a]
: FlatTerm
xs)

{-------------------------------------------------------------------------------
  HasFS interaction
-------------------------------------------------------------------------------}

data ReadIncrementalErr =
    -- | Could not deserialise the data
    ReadFailed CBOR.R.DeserialiseFailure

    -- | Deserialisation was successful, but there was additional data
  | TrailingBytes ByteString
  deriving (ReadIncrementalErr -> ReadIncrementalErr -> Bool
(ReadIncrementalErr -> ReadIncrementalErr -> Bool)
-> (ReadIncrementalErr -> ReadIncrementalErr -> Bool)
-> Eq ReadIncrementalErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadIncrementalErr -> ReadIncrementalErr -> Bool
$c/= :: ReadIncrementalErr -> ReadIncrementalErr -> Bool
== :: ReadIncrementalErr -> ReadIncrementalErr -> Bool
$c== :: ReadIncrementalErr -> ReadIncrementalErr -> Bool
Eq, Int -> ReadIncrementalErr -> ShowS
[ReadIncrementalErr] -> ShowS
ReadIncrementalErr -> String
(Int -> ReadIncrementalErr -> ShowS)
-> (ReadIncrementalErr -> String)
-> ([ReadIncrementalErr] -> ShowS)
-> Show ReadIncrementalErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadIncrementalErr] -> ShowS
$cshowList :: [ReadIncrementalErr] -> ShowS
show :: ReadIncrementalErr -> String
$cshow :: ReadIncrementalErr -> String
showsPrec :: Int -> ReadIncrementalErr -> ShowS
$cshowsPrec :: Int -> ReadIncrementalErr -> ShowS
Show)

-- | Read a file incrementally
--
-- NOTE: The 'MonadThrow' constraint is only needed for 'bracket'. This
-- function does not actually throw anything.
--
-- NOTE: This uses a chunk size of roughly 32k. If we use this function to read
-- small things this might not be ideal.
--
-- NOTE: This currently expects the file to contain precisely one value; see also
-- 'withStreamIncrementalOffsets'.
readIncremental :: forall m a. IOLike m
                => SomeHasFS m
                -> (forall s . CBOR.D.Decoder s a)
                -> FsPath
                -> m (Either ReadIncrementalErr a)
readIncremental :: SomeHasFS m
-> (forall s. Decoder s a)
-> FsPath
-> m (Either ReadIncrementalErr a)
readIncremental = \(SomeHasFS HasFS m h
hasFS) forall s. Decoder s a
decoder FsPath
fp -> (forall s.
 (forall a. ST s a -> m a) -> m (Either ReadIncrementalErr a))
-> m (Either ReadIncrementalErr a)
forall (m :: * -> *) b.
MonadST m =>
(forall s. (forall a. ST s a -> m a) -> b) -> b
withLiftST ((forall s.
  (forall a. ST s a -> m a) -> m (Either ReadIncrementalErr a))
 -> m (Either ReadIncrementalErr a))
-> (forall s.
    (forall a. ST s a -> m a) -> m (Either ReadIncrementalErr a))
-> m (Either ReadIncrementalErr a)
forall a b. (a -> b) -> a -> b
$ \forall a. ST s a -> m a
liftST -> do
    HasFS m h
-> FsPath
-> OpenMode
-> (Handle h -> m (Either ReadIncrementalErr a))
-> m (Either ReadIncrementalErr a)
forall (m :: * -> *) h a.
(?callStack::CallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
fp OpenMode
ReadMode ((Handle h -> m (Either ReadIncrementalErr a))
 -> m (Either ReadIncrementalErr a))
-> (Handle h -> m (Either ReadIncrementalErr a))
-> m (Either ReadIncrementalErr a)
forall a b. (a -> b) -> a -> b
$ \Handle h
h ->
      HasFS m h
-> (forall a. ST s a -> m a)
-> Handle h
-> IDecode s a
-> m (Either ReadIncrementalErr a)
forall h s.
HasFS m h
-> (forall x. ST s x -> m x)
-> Handle h
-> IDecode s a
-> m (Either ReadIncrementalErr a)
go HasFS m h
hasFS forall a. ST s a -> m a
liftST Handle h
h (IDecode s a -> m (Either ReadIncrementalErr a))
-> m (IDecode s a) -> m (Either ReadIncrementalErr a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ST s (IDecode s a) -> m (IDecode s a)
forall a. ST s a -> m a
liftST (Decoder s a -> ST s (IDecode s a)
forall s a. Decoder s a -> ST s (IDecode s a)
CBOR.R.deserialiseIncremental Decoder s a
forall s. Decoder s a
decoder)
  where
    go :: HasFS m h
       -> (forall x. ST s x -> m x)
       -> Handle h
       -> CBOR.R.IDecode s a
       -> m (Either ReadIncrementalErr a)
    go :: HasFS m h
-> (forall x. ST s x -> m x)
-> Handle h
-> IDecode s a
-> m (Either ReadIncrementalErr a)
go hasFS :: HasFS m h
hasFS@HasFS{m String
(?callStack::CallStack) => Bool -> FsPath -> m ()
(?callStack::CallStack) => Handle h -> m Bool
(?callStack::CallStack) => Handle h -> m Word64
(?callStack::CallStack) => Handle h -> m ()
(?callStack::CallStack) => Handle h -> Word64 -> m ()
(?callStack::CallStack) => Handle h -> Word64 -> m ByteString
(?callStack::CallStack) =>
Handle h -> Word64 -> AbsOffset -> m ByteString
(?callStack::CallStack) => Handle h -> ByteString -> m Word64
(?callStack::CallStack) =>
Handle h -> SeekMode -> ByteOffset -> m ()
(?callStack::CallStack) => FsPath -> m Bool
(?callStack::CallStack) => FsPath -> m ()
(?callStack::CallStack) => FsPath -> m (Set String)
(?callStack::CallStack) => FsPath -> FsPath -> m ()
(?callStack::CallStack) => FsPath -> OpenMode -> m (Handle h)
FsPath -> FsErrorPath
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
renameFile :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> FsPath -> m ()
removeFile :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m ()
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m Bool
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m Bool
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m (Set String)
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Bool -> FsPath -> m ()
createDirectory :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> Word64 -> m ()
hPutSome :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) => Handle h -> ByteString -> m Word64
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) =>
   Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) => Handle h -> Word64 -> m ByteString
hSeek :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) =>
   Handle h -> SeekMode -> ByteOffset -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> m Bool
hClose :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> m ()
hOpen :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) => FsPath -> OpenMode -> m (Handle h)
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
mkFsErrorPath :: FsPath -> FsErrorPath
renameFile :: (?callStack::CallStack) => FsPath -> FsPath -> m ()
removeFile :: (?callStack::CallStack) => FsPath -> m ()
doesFileExist :: (?callStack::CallStack) => FsPath -> m Bool
doesDirectoryExist :: (?callStack::CallStack) => FsPath -> m Bool
listDirectory :: (?callStack::CallStack) => FsPath -> m (Set String)
createDirectoryIfMissing :: (?callStack::CallStack) => Bool -> FsPath -> m ()
createDirectory :: (?callStack::CallStack) => FsPath -> m ()
hGetSize :: (?callStack::CallStack) => Handle h -> m Word64
hTruncate :: (?callStack::CallStack) => Handle h -> Word64 -> m ()
hPutSome :: (?callStack::CallStack) => Handle h -> ByteString -> m Word64
hGetSomeAt :: (?callStack::CallStack) =>
Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: (?callStack::CallStack) => Handle h -> Word64 -> m ByteString
hSeek :: (?callStack::CallStack) =>
Handle h -> SeekMode -> ByteOffset -> m ()
hIsOpen :: (?callStack::CallStack) => Handle h -> m Bool
hClose :: (?callStack::CallStack) => Handle h -> m ()
hOpen :: (?callStack::CallStack) => FsPath -> OpenMode -> m (Handle h)
dumpState :: m String
..} forall x. ST s x -> m x
liftST Handle h
h (CBOR.R.Partial Maybe ByteString -> ST s (IDecode s a)
k) = do
        ByteString
bs   <- (?callStack::CallStack) => Handle h -> Word64 -> m ByteString
Handle h -> Word64 -> m ByteString
hGetSome Handle h
h (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultChunkSize)
        IDecode s a
dec' <- ST s (IDecode s a) -> m (IDecode s a)
forall x. ST s x -> m x
liftST (ST s (IDecode s a) -> m (IDecode s a))
-> ST s (IDecode s a) -> m (IDecode s a)
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ST s (IDecode s a)
k (ByteString -> Maybe ByteString
checkEmpty ByteString
bs)
        HasFS m h
-> (forall x. ST s x -> m x)
-> Handle h
-> IDecode s a
-> m (Either ReadIncrementalErr a)
forall h s.
HasFS m h
-> (forall x. ST s x -> m x)
-> Handle h
-> IDecode s a
-> m (Either ReadIncrementalErr a)
go HasFS m h
hasFS forall x. ST s x -> m x
liftST Handle h
h IDecode s a
dec'
    go HasFS m h
_ forall x. ST s x -> m x
_ Handle h
_ (CBOR.R.Done ByteString
leftover ByteOffset
_ a
a) =
        Either ReadIncrementalErr a -> m (Either ReadIncrementalErr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ReadIncrementalErr a -> m (Either ReadIncrementalErr a))
-> Either ReadIncrementalErr a -> m (Either ReadIncrementalErr a)
forall a b. (a -> b) -> a -> b
$ if ByteString -> Bool
BS.null ByteString
leftover
                   then a -> Either ReadIncrementalErr a
forall a b. b -> Either a b
Right a
a
                   else ReadIncrementalErr -> Either ReadIncrementalErr a
forall a b. a -> Either a b
Left (ReadIncrementalErr -> Either ReadIncrementalErr a)
-> ReadIncrementalErr -> Either ReadIncrementalErr a
forall a b. (a -> b) -> a -> b
$ ByteString -> ReadIncrementalErr
TrailingBytes ByteString
leftover
    go HasFS m h
_ forall x. ST s x -> m x
_ Handle h
_ (CBOR.R.Fail ByteString
_ ByteOffset
_ DeserialiseFailure
err) =
        Either ReadIncrementalErr a -> m (Either ReadIncrementalErr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ReadIncrementalErr a -> m (Either ReadIncrementalErr a))
-> Either ReadIncrementalErr a -> m (Either ReadIncrementalErr a)
forall a b. (a -> b) -> a -> b
$ ReadIncrementalErr -> Either ReadIncrementalErr a
forall a b. a -> Either a b
Left (ReadIncrementalErr -> Either ReadIncrementalErr a)
-> ReadIncrementalErr -> Either ReadIncrementalErr a
forall a b. (a -> b) -> a -> b
$ DeserialiseFailure -> ReadIncrementalErr
ReadFailed DeserialiseFailure
err

    checkEmpty :: ByteString -> Maybe ByteString
    checkEmpty :: ByteString -> Maybe ByteString
checkEmpty ByteString
bs | ByteString -> Bool
BS.null ByteString
bs = Maybe ByteString
forall a. Maybe a
Nothing
                  | Bool
otherwise  = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs

-- | Read multiple @a@s incrementally from a file in a streaming way.
--
-- Continuation-passing style to ensure proper closure of the file.
--
-- Reads the offset ('Word64') of the start of each @a@, the size ('Word64')
-- of each @a@, and each @a@ itself. When deserialising fails, it passes all
-- already deserialised @a@s, the error, and the offset after which the
-- failure occurred.
--
-- NOTE: f we introduce user-facing streaming API also, the fact that we are
-- using @streaming@ here should not dictate that we should stick with it
-- later; rather, we should revisit this code at that point.
withStreamIncrementalOffsets
  :: forall m h a r. (IOLike m, HasCallStack)
  => HasFS m h
  -> (forall s . CBOR.D.Decoder s (LBS.ByteString -> a))
  -> FsPath
  -> (Stream (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64)) -> m r)
  -> m r
withStreamIncrementalOffsets :: HasFS m h
-> (forall s. Decoder s (ByteString -> a))
-> FsPath
-> (Stream
      (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
    -> m r)
-> m r
withStreamIncrementalOffsets hasFS :: HasFS m h
hasFS@HasFS{m String
(?callStack::CallStack) => Bool -> FsPath -> m ()
(?callStack::CallStack) => Handle h -> m Bool
(?callStack::CallStack) => Handle h -> m Word64
(?callStack::CallStack) => Handle h -> m ()
(?callStack::CallStack) => Handle h -> Word64 -> m ()
(?callStack::CallStack) => Handle h -> Word64 -> m ByteString
(?callStack::CallStack) =>
Handle h -> Word64 -> AbsOffset -> m ByteString
(?callStack::CallStack) => Handle h -> ByteString -> m Word64
(?callStack::CallStack) =>
Handle h -> SeekMode -> ByteOffset -> m ()
(?callStack::CallStack) => FsPath -> m Bool
(?callStack::CallStack) => FsPath -> m ()
(?callStack::CallStack) => FsPath -> m (Set String)
(?callStack::CallStack) => FsPath -> FsPath -> m ()
(?callStack::CallStack) => FsPath -> OpenMode -> m (Handle h)
FsPath -> FsErrorPath
mkFsErrorPath :: FsPath -> FsErrorPath
renameFile :: (?callStack::CallStack) => FsPath -> FsPath -> m ()
removeFile :: (?callStack::CallStack) => FsPath -> m ()
doesFileExist :: (?callStack::CallStack) => FsPath -> m Bool
doesDirectoryExist :: (?callStack::CallStack) => FsPath -> m Bool
listDirectory :: (?callStack::CallStack) => FsPath -> m (Set String)
createDirectoryIfMissing :: (?callStack::CallStack) => Bool -> FsPath -> m ()
createDirectory :: (?callStack::CallStack) => FsPath -> m ()
hGetSize :: (?callStack::CallStack) => Handle h -> m Word64
hTruncate :: (?callStack::CallStack) => Handle h -> Word64 -> m ()
hPutSome :: (?callStack::CallStack) => Handle h -> ByteString -> m Word64
hGetSomeAt :: (?callStack::CallStack) =>
Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: (?callStack::CallStack) => Handle h -> Word64 -> m ByteString
hSeek :: (?callStack::CallStack) =>
Handle h -> SeekMode -> ByteOffset -> m ()
hIsOpen :: (?callStack::CallStack) => Handle h -> m Bool
hClose :: (?callStack::CallStack) => Handle h -> m ()
hOpen :: (?callStack::CallStack) => FsPath -> OpenMode -> m (Handle h)
dumpState :: m String
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
renameFile :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> FsPath -> m ()
removeFile :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m ()
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m Bool
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m Bool
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m (Set String)
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Bool -> FsPath -> m ()
createDirectory :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => FsPath -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> Word64 -> m ()
hPutSome :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) => Handle h -> ByteString -> m Word64
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) =>
   Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) => Handle h -> Word64 -> m ByteString
hSeek :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) =>
   Handle h -> SeekMode -> ByteOffset -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> m Bool
hClose :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> m ()
hOpen :: forall (m :: * -> *) h.
HasFS m h
-> (?callStack::CallStack) => FsPath -> OpenMode -> m (Handle h)
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
..} forall s. Decoder s (ByteString -> a)
decoder FsPath
fp = \Stream
  (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
-> m r
k ->
    (forall s. (forall a. ST s a -> m a) -> m r) -> m r
forall (m :: * -> *) b.
MonadST m =>
(forall s. (forall a. ST s a -> m a) -> b) -> b
withLiftST ((forall s. (forall a. ST s a -> m a) -> m r) -> m r)
-> (forall s. (forall a. ST s a -> m a) -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \forall a. ST s a -> m a
liftST ->
      HasFS m h -> FsPath -> OpenMode -> (Handle h -> m r) -> m r
forall (m :: * -> *) h a.
(?callStack::CallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
fp OpenMode
ReadMode ((Handle h -> m r) -> m r) -> (Handle h -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \Handle h
h -> Stream
  (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
-> m r
k (Stream
   (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
 -> m r)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
-> m r
forall a b. (a -> b) -> a -> b
$ do
        Word64
fileSize <- m Word64 -> Stream (Of (Word64, (Word64, a))) m Word64
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
S.lift (m Word64 -> Stream (Of (Word64, (Word64, a))) m Word64)
-> m Word64 -> Stream (Of (Word64, (Word64, a))) m Word64
forall a b. (a -> b) -> a -> b
$ (?callStack::CallStack) => Handle h -> m Word64
Handle h -> m Word64
hGetSize Handle h
h
        if Word64
fileSize Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then
          -- If the file is empty, we will immediately get "end of input"
          Maybe (ReadIncrementalErr, Word64)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ReadIncrementalErr, Word64)
forall a. Maybe a
Nothing
        else
          m (IDecode s (ByteString -> a))
-> Stream
     (Of (Word64, (Word64, a))) m (IDecode s (ByteString -> a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
S.lift (ST s (IDecode s (ByteString -> a))
-> m (IDecode s (ByteString -> a))
forall a. ST s a -> m a
liftST (Decoder s (ByteString -> a) -> ST s (IDecode s (ByteString -> a))
forall s a. Decoder s a -> ST s (IDecode s a)
CBOR.R.deserialiseIncremental Decoder s (ByteString -> a)
forall s. Decoder s (ByteString -> a)
decoder)) Stream (Of (Word64, (Word64, a))) m (IDecode s (ByteString -> a))
-> (IDecode s (ByteString -> a)
    -> Stream
         (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64)))
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            (forall a. ST s a -> m a)
-> Handle h
-> Word64
-> Maybe ByteString
-> [ByteString]
-> Word64
-> IDecode s (ByteString -> a)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall s.
(forall x. ST s x -> m x)
-> Handle h
-> Word64
-> Maybe ByteString
-> [ByteString]
-> Word64
-> IDecode s (ByteString -> a)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
go forall a. ST s a -> m a
liftST Handle h
h Word64
0 Maybe ByteString
forall a. Maybe a
Nothing [] Word64
fileSize
  where
    -- TODO stream from HasFS?
    go :: (forall x. ST s x -> m x)
       -> Handle h
       -> Word64                   -- ^ Offset
       -> Maybe ByteString         -- ^ Unconsumed bytes from last time
       -> [ByteString]             -- ^ Chunks pushed for this item (rev order)
       -> Word64                   -- ^ Total file size
       -> CBOR.R.IDecode s (LBS.ByteString -> a)
       -> Stream (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
    go :: (forall x. ST s x -> m x)
-> Handle h
-> Word64
-> Maybe ByteString
-> [ByteString]
-> Word64
-> IDecode s (ByteString -> a)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
go forall x. ST s x -> m x
liftST Handle h
h Word64
offset Maybe ByteString
mbUnconsumed [ByteString]
bss Word64
fileSize IDecode s (ByteString -> a)
dec = case IDecode s (ByteString -> a)
dec of
      CBOR.R.Partial Maybe ByteString -> ST s (IDecode s (ByteString -> a))
k -> do
        -- First use the unconsumed bytes from a previous read before read
        -- some more bytes from the file.
        ByteString
bs   <- case Maybe ByteString
mbUnconsumed of
          Just ByteString
unconsumed -> ByteString -> Stream (Of (Word64, (Word64, a))) m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
unconsumed
          Maybe ByteString
Nothing         -> m ByteString -> Stream (Of (Word64, (Word64, a))) m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
S.lift (m ByteString -> Stream (Of (Word64, (Word64, a))) m ByteString)
-> m ByteString -> Stream (Of (Word64, (Word64, a))) m ByteString
forall a b. (a -> b) -> a -> b
$ (?callStack::CallStack) => Handle h -> Word64 -> m ByteString
Handle h -> Word64 -> m ByteString
hGetSome Handle h
h (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultChunkSize)
        IDecode s (ByteString -> a)
dec' <- m (IDecode s (ByteString -> a))
-> Stream
     (Of (Word64, (Word64, a))) m (IDecode s (ByteString -> a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
S.lift (m (IDecode s (ByteString -> a))
 -> Stream
      (Of (Word64, (Word64, a))) m (IDecode s (ByteString -> a)))
-> m (IDecode s (ByteString -> a))
-> Stream
     (Of (Word64, (Word64, a))) m (IDecode s (ByteString -> a))
forall a b. (a -> b) -> a -> b
$ ST s (IDecode s (ByteString -> a))
-> m (IDecode s (ByteString -> a))
forall x. ST s x -> m x
liftST (ST s (IDecode s (ByteString -> a))
 -> m (IDecode s (ByteString -> a)))
-> ST s (IDecode s (ByteString -> a))
-> m (IDecode s (ByteString -> a))
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ST s (IDecode s (ByteString -> a))
k (ByteString -> Maybe ByteString
checkEmpty ByteString
bs)
        (forall x. ST s x -> m x)
-> Handle h
-> Word64
-> Maybe ByteString
-> [ByteString]
-> Word64
-> IDecode s (ByteString -> a)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall s.
(forall x. ST s x -> m x)
-> Handle h
-> Word64
-> Maybe ByteString
-> [ByteString]
-> Word64
-> IDecode s (ByteString -> a)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
go forall x. ST s x -> m x
liftST Handle h
h Word64
offset Maybe ByteString
forall a. Maybe a
Nothing (ByteString
bsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
bss) Word64
fileSize IDecode s (ByteString -> a)
dec'

      CBOR.R.Done ByteString
leftover ByteOffset
size ByteString -> a
mkA -> do
        let nextOffset :: Word64
nextOffset = Word64
offset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ ByteOffset -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
size
            -- We've been keeping track of the bytes pushed into the decoder
            -- for this item so far in bss. Now there's some trailing data to
            -- remove and we can get the whole bytes used for this item. We
            -- supply the bytes to the final decoded value. This is to support
            -- annotating values with their original input bytes.
            aBytes :: ByteString
aBytes     = case [ByteString]
bss of
                []      -> ByteString
LBS.empty
                ByteString
bs:[ByteString]
bss' -> [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString
bs' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
bss'))
                  where
                    bs' :: ByteString
bs' = Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
leftover) ByteString
bs
            -- The bang on the @a'@ here allows the used 'Decoder' to force
            -- its computation. For example, the decoder might decode a whole
            -- block and then (maybe through a use of 'fmap') just return its
            -- hash. If we don't force the value it returned here, we're just
            -- putting a thunk that references the whole block in the list
            -- instead of merely the hash.
            !a :: a
a         = ByteString -> a
mkA ByteString
aBytes
        (Word64, (Word64, a)) -> Stream (Of (Word64, (Word64, a))) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield (Word64
offset, (ByteOffset -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
size, a
a))
        case ByteString -> Maybe ByteString
checkEmpty ByteString
leftover of
          Maybe ByteString
Nothing
            | Word64
nextOffset Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
fileSize
              -- We're at the end of the file, so stop
            -> Maybe (ReadIncrementalErr, Word64)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ReadIncrementalErr, Word64)
forall a. Maybe a
Nothing
          -- Some more bytes, so try to read the next @a@.
          Maybe ByteString
mbLeftover ->
            m (IDecode s (ByteString -> a))
-> Stream
     (Of (Word64, (Word64, a))) m (IDecode s (ByteString -> a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
S.lift (ST s (IDecode s (ByteString -> a))
-> m (IDecode s (ByteString -> a))
forall x. ST s x -> m x
liftST (Decoder s (ByteString -> a) -> ST s (IDecode s (ByteString -> a))
forall s a. Decoder s a -> ST s (IDecode s a)
CBOR.R.deserialiseIncremental Decoder s (ByteString -> a)
forall s. Decoder s (ByteString -> a)
decoder)) Stream (Of (Word64, (Word64, a))) m (IDecode s (ByteString -> a))
-> (IDecode s (ByteString -> a)
    -> Stream
         (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64)))
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            (forall x. ST s x -> m x)
-> Handle h
-> Word64
-> Maybe ByteString
-> [ByteString]
-> Word64
-> IDecode s (ByteString -> a)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall s.
(forall x. ST s x -> m x)
-> Handle h
-> Word64
-> Maybe ByteString
-> [ByteString]
-> Word64
-> IDecode s (ByteString -> a)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
go forall x. ST s x -> m x
liftST Handle h
h Word64
nextOffset Maybe ByteString
mbLeftover [] Word64
fileSize

      CBOR.R.Fail ByteString
_ ByteOffset
_ DeserialiseFailure
err -> Maybe (ReadIncrementalErr, Word64)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ReadIncrementalErr, Word64)
 -> Stream
      (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64)))
-> Maybe (ReadIncrementalErr, Word64)
-> Stream
     (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
forall a b. (a -> b) -> a -> b
$ (ReadIncrementalErr, Word64) -> Maybe (ReadIncrementalErr, Word64)
forall a. a -> Maybe a
Just (DeserialiseFailure -> ReadIncrementalErr
ReadFailed DeserialiseFailure
err, Word64
offset)

    checkEmpty :: ByteString -> Maybe ByteString
    checkEmpty :: ByteString -> Maybe ByteString
checkEmpty ByteString
bs | ByteString -> Bool
BS.null ByteString
bs = Maybe ByteString
forall a. Maybe a
Nothing
                  | Bool
otherwise  = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs

{-------------------------------------------------------------------------------
  Encoding/decoding lists
-------------------------------------------------------------------------------}

encodeList :: (a -> CBOR.E.Encoding) -> [a] -> CBOR.E.Encoding
encodeList :: (a -> Encoding) -> [a] -> Encoding
encodeList a -> Encoding
_   [] = Word -> Encoding
CBOR.E.encodeListLen Word
0
encodeList a -> Encoding
enc [a]
xs = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Encoding
CBOR.E.encodeListLenIndef
    , (a -> Encoding -> Encoding) -> Encoding -> [a] -> Encoding
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Encoding
r -> a -> Encoding
enc a
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
CBOR.E.encodeBreak [a]
xs
    ]

decodeList :: CBOR.D.Decoder s a -> CBOR.D.Decoder s [a]
decodeList :: Decoder s a -> Decoder s [a]
decodeList Decoder s a
dec = do
    Maybe Int
mn <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
CBOR.D.decodeListLenOrIndef
    case Maybe Int
mn of
      Maybe Int
Nothing -> ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.D.decodeSequenceLenIndef ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse   Decoder s a
dec
      Just Int
n  -> ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Int -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r)
-> r -> (r -> r') -> Int -> Decoder s a -> Decoder s r'
CBOR.D.decodeSequenceLenN     ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse Int
n Decoder s a
dec

encodeSeq :: (a -> CBOR.E.Encoding) -> StrictSeq a -> CBOR.E.Encoding
encodeSeq :: (a -> Encoding) -> StrictSeq a -> Encoding
encodeSeq a -> Encoding
f = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
encodeList a -> Encoding
f ([a] -> Encoding)
-> (StrictSeq a -> [a]) -> StrictSeq a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

decodeSeq :: CBOR.D.Decoder s a -> CBOR.D.Decoder s (StrictSeq a)
decodeSeq :: Decoder s a -> Decoder s (StrictSeq a)
decodeSeq Decoder s a
f = [a] -> StrictSeq a
forall a. [a] -> StrictSeq a
Seq.fromList ([a] -> StrictSeq a) -> Decoder s [a] -> Decoder s (StrictSeq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
f

encodeMaybe :: (a -> CBOR.E.Encoding) -> Maybe a -> CBOR.E.Encoding
encodeMaybe :: (a -> Encoding) -> Maybe a -> Encoding
encodeMaybe a -> Encoding
enc = \case
    Maybe a
Nothing -> Word -> Encoding
CBOR.E.encodeListLen Word
0
    Just a
x  -> Word -> Encoding
CBOR.E.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
enc a
x

decodeMaybe :: CBOR.D.Decoder s a -> CBOR.D.Decoder s (Maybe a)
decodeMaybe :: Decoder s a -> Decoder s (Maybe a)
decodeMaybe Decoder s a
dec = do
    Int
n <- Decoder s Int
forall s. Decoder s Int
CBOR.D.decodeListLen
    case Int
n of
      Int
0 -> Maybe a -> Decoder s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
      Int
1 -> do !a
x <- Decoder s a
dec
              Maybe a -> Decoder s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
      Int
_ -> String -> Decoder s (Maybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown tag"

encodeWithOrigin :: (a -> CBOR.E.Encoding) -> WithOrigin a -> CBOR.E.Encoding
encodeWithOrigin :: (a -> Encoding) -> WithOrigin a -> Encoding
encodeWithOrigin a -> Encoding
f = (a -> Encoding) -> Maybe a -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeMaybe a -> Encoding
f (Maybe a -> Encoding)
-> (WithOrigin a -> Maybe a) -> WithOrigin a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithOrigin a -> Maybe a
forall t. WithOrigin t -> Maybe t
withOriginToMaybe

decodeWithOrigin :: CBOR.D.Decoder s a -> CBOR.D.Decoder s (WithOrigin a)
decodeWithOrigin :: Decoder s a -> Decoder s (WithOrigin a)
decodeWithOrigin Decoder s a
f = Maybe a -> WithOrigin a
forall t. Maybe t -> WithOrigin t
withOriginFromMaybe (Maybe a -> WithOrigin a)
-> Decoder s (Maybe a) -> Decoder s (WithOrigin a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s (Maybe a)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeMaybe Decoder s a
f