module Codec.Borsh.Incremental.Located (
    -- * Values along with an input location
    ByteOffset
  , Located(..)
  , LocatedChunk
    -- * Located chunks
  , LocatedChunks
  , toLocatedChunks
  , fromLocatedChunks
  , addChunk
  , splitChunks
  ) where

import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Word

import qualified Data.ByteString      as S
import qualified Data.ByteString.Lazy as L
import qualified Data.List.NonEmpty   as NE

import Codec.Borsh.Internal.Util.ByteString

{-------------------------------------------------------------------------------
 Values along with an input location
-------------------------------------------------------------------------------}

-- | Offset in bytes within the input
type ByteOffset = Word32

-- | Value at a particular point in the input
data Located a = L !a {-# UNPACK #-} !ByteOffset

-- | The most common case: chunk of the input at a particular point
type LocatedChunk = Located S.ByteString

{-------------------------------------------------------------------------------
  Simple application of 'Located' to a bunch of chunks
-------------------------------------------------------------------------------}

-- | Bunch of chunks, starting at a particular point
--
-- The chunks are stored in reverse order, and we cache their total length.
type LocatedChunks = Located (NonEmpty S.ByteString, Word32)

toLocatedChunks :: LocatedChunk -> LocatedChunks
toLocatedChunks :: LocatedChunk -> LocatedChunks
toLocatedChunks (L ByteString
bs Word32
off) = forall a. a -> Word32 -> Located a
L (ByteString
bs forall a. a -> [a] -> NonEmpty a
:| [], ByteString -> Word32
lengthStrict ByteString
bs) Word32
off

-- | Concatenate all chunks together
--
-- NOTE: This is expensive, and should be used only in exception circumstances.
fromLocatedChunks :: LocatedChunks -> LocatedChunk
fromLocatedChunks :: LocatedChunks -> LocatedChunk
fromLocatedChunks (L (NonEmpty ByteString
bss, Word32
_) Word32
off) = forall a. a -> Word32 -> Located a
L ([ByteString] -> ByteString
S.concat (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ByteString
bss)) Word32
off

-- | Add chunk
--
-- This does not affect the offset, since the chunk is (logically) at the /end/
-- of the already-known chunks
addChunk :: S.ByteString -> LocatedChunks -> LocatedChunks
addChunk :: ByteString -> LocatedChunks -> LocatedChunks
addChunk ByteString
bs (L (NonEmpty ByteString
bss, Word32
len) Word32
off) = forall a. a -> Word32 -> Located a
L (forall a. a -> NonEmpty a -> NonEmpty a
NE.cons ByteString
bs NonEmpty ByteString
bss, Word32
len forall a. Num a => a -> a -> a
+ ByteString -> Word32
lengthStrict ByteString
bs) Word32
off

-- | Split chunks at the required length, if sufficient chunks are available
--
-- Precondition: if the accumulated length exceeds the required length, we must
-- be able to split the mostly added chunk to make up for the difference.
splitChunks :: Word32 -> LocatedChunks -> Maybe (L.ByteString, LocatedChunk)
splitChunks :: Word32 -> LocatedChunks -> Maybe (ByteString, LocatedChunk)
splitChunks Word32
reqLen (L (ByteString
mostRecent :| [ByteString]
older, Word32
len) Word32
off)
  | Word32
reqLen forall a. Ord a => a -> a -> Bool
> Word32
len = forall a. Maybe a
Nothing
  | Bool
otherwise    = forall a. a -> Maybe a
Just (ByteString
large, forall a. a -> Word32 -> Located a
L ByteString
rest (Word32
off forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
L.length ByteString
large)))
  where
    excess :: Word32
    excess :: Word32
excess = Word32
len forall a. Num a => a -> a -> a
- Word32
reqLen

    req, rest :: S.ByteString
    (ByteString
req, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
splitAtEnd (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
excess) ByteString
mostRecent

    large :: L.ByteString
    large :: ByteString
large = [ByteString] -> ByteString
L.fromChunks forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse (ByteString
req forall a. a -> [a] -> [a]
: [ByteString]
older)