{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies       #-}
{-# OPTIONS_HADDOCK not-home #-}
{- HLINT ignore "Use unless" -}

module Database.LSMTree.Internal.BlobRef (
    BlobSpan (..)
  , RawBlobRef (..)
  , WeakBlobRef (..)
  , WeakBlobRefInvalid (..)
  , mkRawBlobRef
  , mkWeakBlobRef
  , rawToWeakBlobRef
  , readRawBlobRef
  , readWeakBlobRef
  , readWeakBlobRefs
  ) where

import           Control.Monad.Class.MonadThrow (Exception, MonadMask,
                     MonadThrow (..), bracket, throwIO)
import           Control.Monad.Primitive
import           Control.RefCount
import qualified Data.Primitive.ByteArray as P (newPinnedByteArray,
                     unsafeFreezeByteArray)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import           Database.LSMTree.Internal.BlobFile (BlobFile (..),
                     BlobSpan (..))
import qualified Database.LSMTree.Internal.BlobFile as BlobFile
import qualified Database.LSMTree.Internal.RawBytes as RB
import           Database.LSMTree.Internal.Serialise (SerialisedBlob (..))
import qualified System.FS.API as FS
import           System.FS.API (HasFS)
import qualified System.FS.BlockIO.API as FS
import           System.FS.BlockIO.API (HasBlockIO)


-- | A raw blob reference is a reference to a blob within a blob file.
--
-- The \"raw\" means that it does not maintain ownership of the 'BlobFile' to
-- keep it open. Thus these are only safe to use in the context of code that
-- already (directly or indirectly) owns the blob file that the blob ref uses
-- (such as within run merging).
--
-- Thus these cannot be handed out via the API. Use 'WeakBlobRef' for that.
--
data RawBlobRef m h = RawBlobRef {
      forall (m :: * -> *) h. RawBlobRef m h -> BlobFile m h
rawBlobRefFile :: {-# NOUNPACK #-} !(BlobFile m h)
    , forall (m :: * -> *) h. RawBlobRef m h -> BlobSpan
rawBlobRefSpan :: {-# UNPACK #-}   !BlobSpan
    }
  deriving stock (Int -> RawBlobRef m h -> ShowS
[RawBlobRef m h] -> ShowS
RawBlobRef m h -> String
(Int -> RawBlobRef m h -> ShowS)
-> (RawBlobRef m h -> String)
-> ([RawBlobRef m h] -> ShowS)
-> Show (RawBlobRef m h)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) h. Int -> RawBlobRef m h -> ShowS
forall (m :: * -> *) h. [RawBlobRef m h] -> ShowS
forall (m :: * -> *) h. RawBlobRef m h -> String
$cshowsPrec :: forall (m :: * -> *) h. Int -> RawBlobRef m h -> ShowS
showsPrec :: Int -> RawBlobRef m h -> ShowS
$cshow :: forall (m :: * -> *) h. RawBlobRef m h -> String
show :: RawBlobRef m h -> String
$cshowList :: forall (m :: * -> *) h. [RawBlobRef m h] -> ShowS
showList :: [RawBlobRef m h] -> ShowS
Show)

-- | A \"weak\" reference to a blob within a blob file. These are the ones we
-- can return in the public API and can outlive their parent table.
--
-- They are weak references in that they do not keep the file open using a
-- reference. So when we want to use our weak reference we have to dereference
-- them to obtain a normal strong reference while we do the I\/O to read the
-- blob. This ensures the file is not closed under our feet.
--
-- See 'Database.LSMTree.Common.BlobRef' for more info.
--
data WeakBlobRef m h = WeakBlobRef {
      forall (m :: * -> *) h. WeakBlobRef m h -> WeakRef (BlobFile m h)
weakBlobRefFile :: {-# NOUNPACK #-} !(WeakRef (BlobFile m h))
    , forall (m :: * -> *) h. WeakBlobRef m h -> BlobSpan
weakBlobRefSpan :: {-# UNPACK #-}   !BlobSpan
    }
  deriving stock (Int -> WeakBlobRef m h -> ShowS
[WeakBlobRef m h] -> ShowS
WeakBlobRef m h -> String
(Int -> WeakBlobRef m h -> ShowS)
-> (WeakBlobRef m h -> String)
-> ([WeakBlobRef m h] -> ShowS)
-> Show (WeakBlobRef m h)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) h. Int -> WeakBlobRef m h -> ShowS
forall (m :: * -> *) h. [WeakBlobRef m h] -> ShowS
forall (m :: * -> *) h. WeakBlobRef m h -> String
$cshowsPrec :: forall (m :: * -> *) h. Int -> WeakBlobRef m h -> ShowS
showsPrec :: Int -> WeakBlobRef m h -> ShowS
$cshow :: forall (m :: * -> *) h. WeakBlobRef m h -> String
show :: WeakBlobRef m h -> String
$cshowList :: forall (m :: * -> *) h. [WeakBlobRef m h] -> ShowS
showList :: [WeakBlobRef m h] -> ShowS
Show)

-- | A \"strong\" reference to a blob within a blob file. The blob file remains
-- open while the strong reference is live. Thus it is safe to do I\/O to
-- retrieve the blob based on the reference. Strong references must be released
-- using 'releaseBlobRef' when no longer in use (e.g. after completing I\/O).
--
data StrongBlobRef m h = StrongBlobRef {
      forall (m :: * -> *) h. StrongBlobRef m h -> Ref (BlobFile m h)
strongBlobRefFile :: {-# NOUNPACK #-} !(Ref (BlobFile m h))
    , forall (m :: * -> *) h. StrongBlobRef m h -> BlobSpan
strongBlobRefSpan :: {-# UNPACK #-}   !BlobSpan
    }
  deriving stock (Int -> StrongBlobRef m h -> ShowS
[StrongBlobRef m h] -> ShowS
StrongBlobRef m h -> String
(Int -> StrongBlobRef m h -> ShowS)
-> (StrongBlobRef m h -> String)
-> ([StrongBlobRef m h] -> ShowS)
-> Show (StrongBlobRef m h)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) h. Int -> StrongBlobRef m h -> ShowS
forall (m :: * -> *) h. [StrongBlobRef m h] -> ShowS
forall (m :: * -> *) h. StrongBlobRef m h -> String
$cshowsPrec :: forall (m :: * -> *) h. Int -> StrongBlobRef m h -> ShowS
showsPrec :: Int -> StrongBlobRef m h -> ShowS
$cshow :: forall (m :: * -> *) h. StrongBlobRef m h -> String
show :: StrongBlobRef m h -> String
$cshowList :: forall (m :: * -> *) h. [StrongBlobRef m h] -> ShowS
showList :: [StrongBlobRef m h] -> ShowS
Show)

-- | Convert a 'RawBlobRef' to a 'WeakBlobRef'.
rawToWeakBlobRef :: RawBlobRef m h -> WeakBlobRef m h
rawToWeakBlobRef :: forall (m :: * -> *) h. RawBlobRef m h -> WeakBlobRef m h
rawToWeakBlobRef RawBlobRef {BlobFile m h
rawBlobRefFile :: forall (m :: * -> *) h. RawBlobRef m h -> BlobFile m h
rawBlobRefFile :: BlobFile m h
rawBlobRefFile, BlobSpan
rawBlobRefSpan :: forall (m :: * -> *) h. RawBlobRef m h -> BlobSpan
rawBlobRefSpan :: BlobSpan
rawBlobRefSpan} =
    -- This doesn't need to really do anything, becuase the raw version
    -- does not maintain an independent ref count, and the weak one does
    -- not either.
    WeakBlobRef {
      weakBlobRefFile :: WeakRef (BlobFile m h)
weakBlobRefFile = BlobFile m h -> WeakRef (BlobFile m h)
forall obj. obj -> WeakRef obj
mkWeakRefFromRaw BlobFile m h
rawBlobRefFile,
      weakBlobRefSpan :: BlobSpan
weakBlobRefSpan = BlobSpan
rawBlobRefSpan
    }

mkRawBlobRef :: Ref (BlobFile m h) -> BlobSpan -> RawBlobRef m h
mkRawBlobRef :: forall (m :: * -> *) h.
Ref (BlobFile m h) -> BlobSpan -> RawBlobRef m h
mkRawBlobRef (DeRef BlobFile m h
blobfile) BlobSpan
blobspan =
    RawBlobRef {
      rawBlobRefFile :: BlobFile m h
rawBlobRefFile = BlobFile m h
blobfile,
      rawBlobRefSpan :: BlobSpan
rawBlobRefSpan = BlobSpan
blobspan
    }

mkWeakBlobRef :: Ref (BlobFile m h) -> BlobSpan -> WeakBlobRef m h
mkWeakBlobRef :: forall (m :: * -> *) h.
Ref (BlobFile m h) -> BlobSpan -> WeakBlobRef m h
mkWeakBlobRef Ref (BlobFile m h)
blobfile BlobSpan
blobspan =
    WeakBlobRef {
      weakBlobRefFile :: WeakRef (BlobFile m h)
weakBlobRefFile = Ref (BlobFile m h) -> WeakRef (BlobFile m h)
forall obj. Ref obj -> WeakRef obj
mkWeakRef Ref (BlobFile m h)
blobfile,
      weakBlobRefSpan :: BlobSpan
weakBlobRefSpan = BlobSpan
blobspan
    }

-- | The 'WeakBlobRef' now points to a blob that is no longer available.
newtype WeakBlobRefInvalid = WeakBlobRefInvalid Int
  deriving stock (Int -> WeakBlobRefInvalid -> ShowS
[WeakBlobRefInvalid] -> ShowS
WeakBlobRefInvalid -> String
(Int -> WeakBlobRefInvalid -> ShowS)
-> (WeakBlobRefInvalid -> String)
-> ([WeakBlobRefInvalid] -> ShowS)
-> Show WeakBlobRefInvalid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WeakBlobRefInvalid -> ShowS
showsPrec :: Int -> WeakBlobRefInvalid -> ShowS
$cshow :: WeakBlobRefInvalid -> String
show :: WeakBlobRefInvalid -> String
$cshowList :: [WeakBlobRefInvalid] -> ShowS
showList :: [WeakBlobRefInvalid] -> ShowS
Show)
  deriving anyclass (Show WeakBlobRefInvalid
Typeable WeakBlobRefInvalid
(Typeable WeakBlobRefInvalid, Show WeakBlobRefInvalid) =>
(WeakBlobRefInvalid -> SomeException)
-> (SomeException -> Maybe WeakBlobRefInvalid)
-> (WeakBlobRefInvalid -> String)
-> Exception WeakBlobRefInvalid
SomeException -> Maybe WeakBlobRefInvalid
WeakBlobRefInvalid -> String
WeakBlobRefInvalid -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: WeakBlobRefInvalid -> SomeException
toException :: WeakBlobRefInvalid -> SomeException
$cfromException :: SomeException -> Maybe WeakBlobRefInvalid
fromException :: SomeException -> Maybe WeakBlobRefInvalid
$cdisplayException :: WeakBlobRefInvalid -> String
displayException :: WeakBlobRefInvalid -> String
Exception)

{-# SPECIALISE deRefWeakBlobRef ::
     WeakBlobRef IO h
  -> IO (StrongBlobRef IO h) #-}
deRefWeakBlobRef ::
     (MonadThrow m, PrimMonad m)
  => WeakBlobRef m h
  -> m (StrongBlobRef m h)
deRefWeakBlobRef :: forall (m :: * -> *) h.
(MonadThrow m, PrimMonad m) =>
WeakBlobRef m h -> m (StrongBlobRef m h)
deRefWeakBlobRef WeakBlobRef{WeakRef (BlobFile m h)
weakBlobRefFile :: forall (m :: * -> *) h. WeakBlobRef m h -> WeakRef (BlobFile m h)
weakBlobRefFile :: WeakRef (BlobFile m h)
weakBlobRefFile, BlobSpan
weakBlobRefSpan :: forall (m :: * -> *) h. WeakBlobRef m h -> BlobSpan
weakBlobRefSpan :: BlobSpan
weakBlobRefSpan} = do
    Maybe (Ref (BlobFile m h))
mstrongBlobRefFile <- WeakRef (BlobFile m h) -> m (Maybe (Ref (BlobFile m h)))
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, HasCallStack) =>
WeakRef obj -> m (Maybe (Ref obj))
deRefWeak WeakRef (BlobFile m h)
weakBlobRefFile
    case Maybe (Ref (BlobFile m h))
mstrongBlobRefFile of
      Just Ref (BlobFile m h)
strongBlobRefFile ->
        StrongBlobRef m h -> m (StrongBlobRef m h)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return StrongBlobRef {
          Ref (BlobFile m h)
strongBlobRefFile :: Ref (BlobFile m h)
strongBlobRefFile :: Ref (BlobFile m h)
strongBlobRefFile,
          strongBlobRefSpan :: BlobSpan
strongBlobRefSpan = BlobSpan
weakBlobRefSpan
        }
      Maybe (Ref (BlobFile m h))
Nothing -> WeakBlobRefInvalid -> m (StrongBlobRef m h)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (Int -> WeakBlobRefInvalid
WeakBlobRefInvalid Int
0)

{-# SPECIALISE deRefWeakBlobRefs ::
     V.Vector (WeakBlobRef IO h)
  -> IO (V.Vector (StrongBlobRef IO h)) #-}
deRefWeakBlobRefs ::
    forall m h.
     (MonadMask m, PrimMonad m)
  => V.Vector (WeakBlobRef m h)
  -> m (V.Vector (StrongBlobRef m h))
deRefWeakBlobRefs :: forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
Vector (WeakBlobRef m h) -> m (Vector (StrongBlobRef m h))
deRefWeakBlobRefs Vector (WeakBlobRef m h)
wrefs = do
    MVector (PrimState m) (StrongBlobRef m h)
refs <- Int -> m (MVector (PrimState m) (StrongBlobRef m h))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
VM.new (Vector (WeakBlobRef m h) -> Int
forall a. Vector a -> Int
V.length Vector (WeakBlobRef m h)
wrefs)
    Vector (WeakBlobRef m h)
-> (Int -> WeakBlobRef m h -> m ()) -> m ()
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m ()
V.iforM_ Vector (WeakBlobRef m h)
wrefs ((Int -> WeakBlobRef m h -> m ()) -> m ())
-> (Int -> WeakBlobRef m h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i WeakBlobRef {WeakRef (BlobFile m h)
weakBlobRefFile :: forall (m :: * -> *) h. WeakBlobRef m h -> WeakRef (BlobFile m h)
weakBlobRefFile :: WeakRef (BlobFile m h)
weakBlobRefFile, BlobSpan
weakBlobRefSpan :: forall (m :: * -> *) h. WeakBlobRef m h -> BlobSpan
weakBlobRefSpan :: BlobSpan
weakBlobRefSpan} -> do
      Maybe (Ref (BlobFile m h))
mstrongBlobRefFile <- WeakRef (BlobFile m h) -> m (Maybe (Ref (BlobFile m h)))
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, HasCallStack) =>
WeakRef obj -> m (Maybe (Ref obj))
deRefWeak WeakRef (BlobFile m h)
weakBlobRefFile
      case Maybe (Ref (BlobFile m h))
mstrongBlobRefFile of
        Just Ref (BlobFile m h)
strongBlobRefFile ->
          MVector (PrimState m) (StrongBlobRef m h)
-> Int -> StrongBlobRef m h -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState m) (StrongBlobRef m h)
refs Int
i StrongBlobRef {
            Ref (BlobFile m h)
strongBlobRefFile :: Ref (BlobFile m h)
strongBlobRefFile :: Ref (BlobFile m h)
strongBlobRefFile,
            strongBlobRefSpan :: BlobSpan
strongBlobRefSpan = BlobSpan
weakBlobRefSpan
          }
        Maybe (Ref (BlobFile m h))
Nothing -> do
          -- drop refs on the previous ones taken successfully so far
          (StrongBlobRef m h -> m ())
-> MVector (PrimState m) (StrongBlobRef m h) -> m ()
forall (m :: * -> *) a b.
PrimMonad m =>
(a -> m b) -> MVector (PrimState m) a -> m ()
VM.mapM_ StrongBlobRef m h -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
StrongBlobRef m h -> m ()
releaseBlobRef (Int
-> MVector (PrimState m) (StrongBlobRef m h)
-> MVector (PrimState m) (StrongBlobRef m h)
forall s a. Int -> MVector s a -> MVector s a
VM.take Int
i MVector (PrimState m) (StrongBlobRef m h)
refs)
          WeakBlobRefInvalid -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (Int -> WeakBlobRefInvalid
WeakBlobRefInvalid Int
i)
    MVector (PrimState m) (StrongBlobRef m h)
-> m (Vector (StrongBlobRef m h))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector (PrimState m) (StrongBlobRef m h)
refs

{-# INLINE releaseBlobRef #-}
releaseBlobRef :: (MonadMask m, PrimMonad m) => StrongBlobRef m h -> m ()
releaseBlobRef :: forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
StrongBlobRef m h -> m ()
releaseBlobRef = Ref (BlobFile m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef (Ref (BlobFile m h) -> m ())
-> (StrongBlobRef m h -> Ref (BlobFile m h))
-> StrongBlobRef m h
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrongBlobRef m h -> Ref (BlobFile m h)
forall (m :: * -> *) h. StrongBlobRef m h -> Ref (BlobFile m h)
strongBlobRefFile

{-# INLINE readRawBlobRef #-}
readRawBlobRef ::
     (MonadThrow m, PrimMonad m)
  => HasFS m h
  -> RawBlobRef m h
  -> m SerialisedBlob
readRawBlobRef :: forall (m :: * -> *) h.
(MonadThrow m, PrimMonad m) =>
HasFS m h -> RawBlobRef m h -> m SerialisedBlob
readRawBlobRef HasFS m h
fs RawBlobRef {BlobFile m h
rawBlobRefFile :: forall (m :: * -> *) h. RawBlobRef m h -> BlobFile m h
rawBlobRefFile :: BlobFile m h
rawBlobRefFile, BlobSpan
rawBlobRefSpan :: forall (m :: * -> *) h. RawBlobRef m h -> BlobSpan
rawBlobRefSpan :: BlobSpan
rawBlobRefSpan} =
    HasFS m h -> BlobFile m h -> BlobSpan -> m SerialisedBlob
forall (m :: * -> *) h.
(MonadThrow m, PrimMonad m) =>
HasFS m h -> BlobFile m h -> BlobSpan -> m SerialisedBlob
BlobFile.readBlobRaw HasFS m h
fs BlobFile m h
rawBlobRefFile BlobSpan
rawBlobRefSpan

{-# SPECIALISE readWeakBlobRef :: HasFS IO h -> WeakBlobRef IO h -> IO SerialisedBlob #-}
readWeakBlobRef ::
     (MonadMask m, PrimMonad m)
  => HasFS m h
  -> WeakBlobRef m h
  -> m SerialisedBlob
readWeakBlobRef :: forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h -> WeakBlobRef m h -> m SerialisedBlob
readWeakBlobRef HasFS m h
fs WeakBlobRef m h
wref =
    m (StrongBlobRef m h)
-> (StrongBlobRef m h -> m ())
-> (StrongBlobRef m h -> m SerialisedBlob)
-> m SerialisedBlob
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (WeakBlobRef m h -> m (StrongBlobRef m h)
forall (m :: * -> *) h.
(MonadThrow m, PrimMonad m) =>
WeakBlobRef m h -> m (StrongBlobRef m h)
deRefWeakBlobRef WeakBlobRef m h
wref) StrongBlobRef m h -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
StrongBlobRef m h -> m ()
releaseBlobRef ((StrongBlobRef m h -> m SerialisedBlob) -> m SerialisedBlob)
-> (StrongBlobRef m h -> m SerialisedBlob) -> m SerialisedBlob
forall a b. (a -> b) -> a -> b
$
      \StrongBlobRef {Ref (BlobFile m h)
strongBlobRefFile :: forall (m :: * -> *) h. StrongBlobRef m h -> Ref (BlobFile m h)
strongBlobRefFile :: Ref (BlobFile m h)
strongBlobRefFile, BlobSpan
strongBlobRefSpan :: forall (m :: * -> *) h. StrongBlobRef m h -> BlobSpan
strongBlobRefSpan :: BlobSpan
strongBlobRefSpan} ->
        HasFS m h -> Ref (BlobFile m h) -> BlobSpan -> m SerialisedBlob
forall (m :: * -> *) h.
(MonadThrow m, PrimMonad m) =>
HasFS m h -> Ref (BlobFile m h) -> BlobSpan -> m SerialisedBlob
BlobFile.readBlob HasFS m h
fs Ref (BlobFile m h)
strongBlobRefFile BlobSpan
strongBlobRefSpan

{-# SPECIALISE readWeakBlobRefs :: HasBlockIO IO h -> V.Vector (WeakBlobRef IO h) -> IO (V.Vector SerialisedBlob) #-}
readWeakBlobRefs ::
     (MonadMask m, PrimMonad m)
  => HasBlockIO m h
  -> V.Vector (WeakBlobRef m h)
  -> m (V.Vector SerialisedBlob)
readWeakBlobRefs :: forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasBlockIO m h
-> Vector (WeakBlobRef m h) -> m (Vector SerialisedBlob)
readWeakBlobRefs HasBlockIO m h
hbio Vector (WeakBlobRef m h)
wrefs =
    m (Vector (StrongBlobRef m h))
-> (Vector (StrongBlobRef m h) -> m ())
-> (Vector (StrongBlobRef m h) -> m (Vector SerialisedBlob))
-> m (Vector SerialisedBlob)
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Vector (WeakBlobRef m h) -> m (Vector (StrongBlobRef m h))
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
Vector (WeakBlobRef m h) -> m (Vector (StrongBlobRef m h))
deRefWeakBlobRefs Vector (WeakBlobRef m h)
wrefs) ((StrongBlobRef m h -> m ()) -> Vector (StrongBlobRef m h) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ StrongBlobRef m h -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
StrongBlobRef m h -> m ()
releaseBlobRef) ((Vector (StrongBlobRef m h) -> m (Vector SerialisedBlob))
 -> m (Vector SerialisedBlob))
-> (Vector (StrongBlobRef m h) -> m (Vector SerialisedBlob))
-> m (Vector SerialisedBlob)
forall a b. (a -> b) -> a -> b
$ \Vector (StrongBlobRef m h)
refs -> do
      -- Prepare the IOOps:
      -- We use a single large memory buffer, with appropriate offsets within
      -- the buffer.
      let bufSize :: Int
          !bufSize :: Int
bufSize = Vector Int -> Int
forall a. Num a => Vector a -> a
V.sum ((StrongBlobRef m h -> Int)
-> Vector (StrongBlobRef m h) -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map StrongBlobRef m h -> Int
forall {m :: * -> *} {h}. StrongBlobRef m h -> Int
blobRefSpanSize Vector (StrongBlobRef m h)
refs)

          {-# INLINE bufOffs #-}
          bufOffs :: V.Vector Int
          bufOffs :: Vector Int
bufOffs = (Int -> Int -> Int) -> Int -> Vector Int -> Vector Int
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ((StrongBlobRef m h -> Int)
-> Vector (StrongBlobRef m h) -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map StrongBlobRef m h -> Int
forall {m :: * -> *} {h}. StrongBlobRef m h -> Int
blobRefSpanSize Vector (StrongBlobRef m h)
refs)
      MutableByteArray (PrimState m)
buf <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newPinnedByteArray Int
bufSize

      -- Submit the IOOps all in one go:
      Vector IOResult
_ <- HasBlockIO m h
-> HasCallStack =>
   Vector (IOOp (PrimState m) h) -> m (Vector IOResult)
forall (m :: * -> *) h.
HasBlockIO m h
-> HasCallStack =>
   Vector (IOOp (PrimState m) h) -> m (Vector IOResult)
FS.submitIO HasBlockIO m h
hbio (Vector (IOOp (PrimState m) h) -> m (Vector IOResult))
-> Vector (IOOp (PrimState m) h) -> m (Vector IOResult)
forall a b. (a -> b) -> a -> b
$
             (Int -> StrongBlobRef m h -> IOOp (PrimState m) h)
-> Vector Int
-> Vector (StrongBlobRef m h)
-> Vector (IOOp (PrimState m) h)
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith
               (\Int
bufoff
                 StrongBlobRef {
                   strongBlobRefFile :: forall (m :: * -> *) h. StrongBlobRef m h -> Ref (BlobFile m h)
strongBlobRefFile = DeRef BlobFile {Handle h
blobFileHandle :: Handle h
blobFileHandle :: forall (m :: * -> *) h. BlobFile m h -> Handle h
blobFileHandle},
                   strongBlobRefSpan :: forall (m :: * -> *) h. StrongBlobRef m h -> BlobSpan
strongBlobRefSpan = BlobSpan {Word64
blobSpanOffset :: Word64
blobSpanOffset :: BlobSpan -> Word64
blobSpanOffset, Word32
blobSpanSize :: Word32
blobSpanSize :: BlobSpan -> Word32
blobSpanSize}
                 } ->
                 Handle h
-> FileOffset
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> IOOp (PrimState m) h
forall s h.
Handle h
-> FileOffset
-> MutableByteArray s
-> BufferOffset
-> ByteCount
-> IOOp s h
FS.IOOpRead
                   Handle h
blobFileHandle
                   (Word64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
blobSpanOffset :: FS.FileOffset)
                   MutableByteArray (PrimState m)
buf (Int -> BufferOffset
FS.BufferOffset Int
bufoff)
                   (Word32 -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
blobSpanSize :: FS.ByteCount))
               Vector Int
bufOffs Vector (StrongBlobRef m h)
refs
      -- We do not need to inspect the results because IO errors are
      -- thrown as exceptions, and the result is just the read length
      -- which is already known. Short reads can't happen here.

      -- Construct the SerialisedBlobs results:
      -- This is just the different offsets within the shared buffer.
      ByteArray
ba <- MutableByteArray (PrimState m) -> m ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
P.unsafeFreezeByteArray MutableByteArray (PrimState m)
buf
      Vector SerialisedBlob -> m (Vector SerialisedBlob)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector SerialisedBlob -> m (Vector SerialisedBlob))
-> Vector SerialisedBlob -> m (Vector SerialisedBlob)
forall a b. (a -> b) -> a -> b
$! (Int -> Int -> SerialisedBlob)
-> Vector Int -> Vector Int -> Vector SerialisedBlob
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith
                (\Int
off Int
len -> RawBytes -> SerialisedBlob
SerialisedBlob (Int -> Int -> ByteArray -> RawBytes
RB.fromByteArray Int
off Int
len ByteArray
ba))
                Vector Int
bufOffs
                ((StrongBlobRef m h -> Int)
-> Vector (StrongBlobRef m h) -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map StrongBlobRef m h -> Int
forall {m :: * -> *} {h}. StrongBlobRef m h -> Int
blobRefSpanSize Vector (StrongBlobRef m h)
refs)
  where
    blobRefSpanSize :: StrongBlobRef m h -> Int
blobRefSpanSize = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int)
-> (StrongBlobRef m h -> Word32) -> StrongBlobRef m h -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobSpan -> Word32
blobSpanSize (BlobSpan -> Word32)
-> (StrongBlobRef m h -> BlobSpan) -> StrongBlobRef m h -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrongBlobRef m h -> BlobSpan
forall (m :: * -> *) h. StrongBlobRef m h -> BlobSpan
strongBlobRefSpan