-- | Intended for qualified import:
--
-- > import Codec.Compression.SnappyC.Internal.Buffer (Buffer)
-- > import Codec.Compression.SnappyC.Internal.Buffer qualified as Buffer

module Codec.Compression.SnappyC.Internal.Buffer
  ( -- * 'Buffer' type
    Buffer -- Opaque

    -- ** Introduction
  , empty
  , append

    -- ** Elimination
  , toStrict

    -- ** Length etc.
  , length
  , null

    -- ** Splitting
  , splitExactly
  ) where

import Prelude hiding (length, null)

import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString qualified as BS.Strict
import Data.ByteString.Lazy qualified as Lazy (ByteString)
import Data.ByteString.Lazy qualified as BS.Lazy

-- | Intended for efficiency in the case of a bunch of appends followed by a
-- bunch of splits.
data Buffer =
      Forward
        Lazy.ByteString
        !Int
    | Backward
        [Strict.ByteString]
        !Int
  deriving Int -> Buffer -> ShowS
[Buffer] -> ShowS
Buffer -> String
(Int -> Buffer -> ShowS)
-> (Buffer -> String) -> ([Buffer] -> ShowS) -> Show Buffer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Buffer -> ShowS
showsPrec :: Int -> Buffer -> ShowS
$cshow :: Buffer -> String
show :: Buffer -> String
$cshowList :: [Buffer] -> ShowS
showList :: [Buffer] -> ShowS
Show

-- | Empty buffer
empty :: Buffer
empty :: Buffer
empty = [ByteString] -> Int -> Buffer
Backward [] Int
0

-- | Is the 'Buffer' empty?
--
-- /O(1)/
null :: Buffer -> Bool
null :: Buffer -> Bool
null = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (Buffer -> Int) -> Buffer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> Int
length

-- | Length
--
-- /O(1)/
length :: Buffer -> Int
length :: Buffer -> Int
length (Forward  ByteString
_ Int
l) = Int
l
length (Backward [ByteString]
_ Int
l) = Int
l

-- | Append data to the end of the 'Buffer'.
--
-- /O(n)/ if the given buffer is forwards, /O(1)/ otherwise.
append :: Buffer -> Strict.ByteString -> Buffer
append :: Buffer -> ByteString -> Buffer
append Buffer
b ByteString
bs =
    let
      !([ByteString]
chunks, Int
l) = Buffer -> ([ByteString], Int)
backwards Buffer
b
    in
      [ByteString] -> Int -> Buffer
Backward (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.Strict.length ByteString
bs)

-- | Get the buffered chunks in backwards order
--
-- /O(n)/ if the given buffer is forwards, /O(1)/ otherwise.
backwards :: Buffer -> ([Strict.ByteString], Int)
backwards :: Buffer -> ([ByteString], Int)
backwards (Forward  ByteString
bs Int
l) = ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.Lazy.toChunks ByteString
bs, Int
l)
backwards (Backward [ByteString]
bs Int
l) = ([ByteString]
bs, Int
l)

-- | Get the buffer data as a 'Lazy.ByteString' paired with its length.
--
-- /O(n)/ if the buffer is backward, /O(1)/ otherwise.
toLazy :: Buffer -> (Lazy.ByteString, Int)
toLazy :: Buffer -> (ByteString, Int)
toLazy (Forward  ByteString
bs Int
l) = (ByteString
bs, Int
l)
toLazy (Backward [ByteString]
bs Int
l) = ([ByteString] -> ByteString
BS.Lazy.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
bs, Int
l)

-- | Create a 'Buffer' from a 'Lazy.ByteString' paired with its length.
--
-- /O(1)/
fromLazy :: (Lazy.ByteString, Int) -> Buffer
fromLazy :: (ByteString, Int) -> Buffer
fromLazy (ByteString
bs, Int
l) = ByteString -> Int -> Buffer
Forward ByteString
bs Int
l

-- | Split off a chunk of exactly @n@ bytes.
--
-- If there aren't enough bytes, return how many bytes we need.
--
-- /O(1)/ if the length is insufficient, /O(n)/ otherwise.
splitExactly :: Int -> Buffer -> Either Int (Strict.ByteString, Buffer)
splitExactly :: Int -> Buffer -> Either Int (ByteString, Buffer)
splitExactly Int
n Buffer
b
    | Buffer -> Int
length Buffer
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
    = Int -> Either Int (ByteString, Buffer)
forall a b. a -> Either a b
Left (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Buffer -> Int
length Buffer
b)
    | Bool
otherwise
    = let
        !(ByteString
bs, Int
bsLength) = Buffer -> (ByteString, Int)
toLazy Buffer
b
        !(ByteString
tookBs, ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
BS.Lazy.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ByteString
bs
      in
        (ByteString, Buffer) -> Either Int (ByteString, Buffer)
forall a b. b -> Either a b
Right
          ( ByteString -> ByteString
BS.Lazy.toStrict ByteString
tookBs
          , (ByteString, Int) -> Buffer
fromLazy (ByteString
rest, Int
bsLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
          )

-- | Get the buffer data as a 'Strict.ByteString'. __Only__ call this function if
-- you are __sure__ the data in the buffer is small.
--
-- /O(n)/
--
-- TODO: We are losing size information here that we could use to our advantage
-- in the conversion, but it's a minor inefficiency.
toStrict :: Buffer -> Strict.ByteString
toStrict :: Buffer -> ByteString
toStrict (Forward  ByteString
bs Int
_) = ByteString -> ByteString
BS.Lazy.toStrict ByteString
bs
toStrict (Backward [ByteString]
bs Int
_) = [ByteString] -> ByteString
BS.Strict.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
bs