{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Database.Franz.Internal.Contents
    ( IndexVec
    , Contents(..)
    , getResponse
    , readContents
    )
    where

import Prelude hiding (length)
import Data.Serialize hiding (getInt64le)
import qualified Data.ByteString.Char8 as B
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import Database.Franz.Internal.Reader
import Database.Franz.Internal.Protocol
import Database.Franz.Internal.IO
import Data.Int

-- A vector containing file offsets and extra indices
type IndexVec = V.Vector (Int, U.Vector Int64)

data Contents = Contents
  { Contents -> Vector IndexName
indexNames :: !(V.Vector IndexName)
  , Contents -> IndexName
payloads :: !B.ByteString
  , Contents -> IndexVec
indicess :: !IndexVec
  , Contents -> Int
length :: !Int
  , Contents -> Int
payloadOffset :: !Int
  , Contents -> Int
seqnoOffset :: !Int
  }

getIndexVec :: V.Vector IndexName -> Int -> Get IndexVec
getIndexVec :: Vector IndexName -> Int -> Get IndexVec
getIndexVec Vector IndexName
names Int
len = Int -> Get (Int, Vector Int64) -> Get IndexVec
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
len
  (Get (Int, Vector Int64) -> Get IndexVec)
-> Get (Int, Vector Int64) -> Get IndexVec
forall a b. (a -> b) -> a -> b
$ (,) (Int -> Vector Int64 -> (Int, Vector Int64))
-> Get Int -> Get (Vector Int64 -> (Int, Vector Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall a. Num a => Get a
getInt64le Get (Vector Int64 -> (Int, Vector Int64))
-> Get (Vector Int64) -> Get (Int, Vector Int64)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector Int64 -> Vector Int64
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
U.convert (Vector Int64 -> Vector Int64)
-> Get (Vector Int64) -> Get (Vector Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (IndexName -> Get Int64) -> Vector IndexName -> Get (Vector Int64)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Get Int64 -> IndexName -> Get Int64
forall a b. a -> b -> a
const Get Int64
forall a. Num a => Get a
getInt64le) Vector IndexName
names

getResponse :: Get Contents
getResponse :: Get Contents
getResponse = do
  PayloadHeader Int
seqnoOffset Int
s1 Int
payloadOffset Vector IndexName
indexNames <- Get PayloadHeader
forall t. Serialize t => Get t
get
  let length :: Int
length = Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
seqnoOffset
  if Int
length Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
    then Contents -> Get Contents
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contents :: Vector IndexName
-> IndexName -> IndexVec -> Int -> Int -> Int -> Contents
Contents{ payloads :: IndexName
payloads = IndexName
B.empty, indicess :: IndexVec
indicess = IndexVec
forall a. Vector a
V.empty, Int
Vector IndexName
length :: Int
indexNames :: Vector IndexName
payloadOffset :: Int
seqnoOffset :: Int
seqnoOffset :: Int
payloadOffset :: Int
length :: Int
indexNames :: Vector IndexName
..}
    else do
      IndexVec
indicess <- Vector IndexName -> Int -> Get IndexVec
getIndexVec Vector IndexName
indexNames Int
length
      IndexName
payloads <- Int -> Get IndexName
getByteString (Int -> Get IndexName) -> Int -> Get IndexName
forall a b. (a -> b) -> a -> b
$ (Int, Vector Int64) -> Int
forall a b. (a, b) -> a
fst (IndexVec -> (Int, Vector Int64)
forall a. Vector a -> a
V.unsafeLast IndexVec
indicess) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
payloadOffset
      Contents -> Get Contents
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contents :: Vector IndexName
-> IndexName -> IndexVec -> Int -> Int -> Int -> Contents
Contents{Int
IndexName
IndexVec
Vector IndexName
payloads :: IndexName
indicess :: IndexVec
length :: Int
indexNames :: Vector IndexName
payloadOffset :: Int
seqnoOffset :: Int
seqnoOffset :: Int
payloadOffset :: Int
length :: Int
indicess :: IndexVec
payloads :: IndexName
indexNames :: Vector IndexName
..}

readContents :: Stream -> QueryResult -> IO Contents
readContents :: Stream -> QueryResult -> IO Contents
readContents Stream{Vector IndexName
indexNames :: Stream -> Vector IndexName
indexNames :: Vector IndexName
indexNames, Handle
payloadHandle :: Stream -> Handle
payloadHandle :: Handle
payloadHandle, Handle
indexHandle :: Stream -> Handle
indexHandle :: Handle
indexHandle} ((Int
seqnoOffset, Int
payloadOffset), (Int
s1, Int
p1)) = do
  let length :: Int
length = Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
seqnoOffset
  -- byte offset + number of indices
  let indexSize :: Int
indexSize = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Vector IndexName -> Int
forall a. Vector a -> Int
V.length Vector IndexName
indexNames Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  IndexName
indexBS <- Handle -> Int -> Int -> IO IndexName
hGetRange Handle
indexHandle (Int
indexSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
length) (Int
indexSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Enum a => a -> a
succ Int
seqnoOffset)
  IndexName
payloads <- Handle -> Int -> Int -> IO IndexName
hGetRange Handle
payloadHandle (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
payloadOffset) Int
payloadOffset
  let indicess :: IndexVec
indicess = ([Char] -> IndexVec)
-> (IndexVec -> IndexVec) -> Either [Char] IndexVec -> IndexVec
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IndexVec
forall a. HasCallStack => [Char] -> a
error IndexVec -> IndexVec
forall a. a -> a
id (Either [Char] IndexVec -> IndexVec)
-> Either [Char] IndexVec -> IndexVec
forall a b. (a -> b) -> a -> b
$ Get IndexVec -> IndexName -> Either [Char] IndexVec
forall a. Get a -> IndexName -> Either [Char] a
runGet (Vector IndexName -> Int -> Get IndexVec
getIndexVec Vector IndexName
indexNames Int
length) IndexName
indexBS
  Contents -> IO Contents
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contents :: Vector IndexName
-> IndexName -> IndexVec -> Int -> Int -> Int -> Contents
Contents{Int
IndexName
IndexVec
Vector IndexName
indicess :: IndexVec
payloads :: IndexName
length :: Int
payloadOffset :: Int
seqnoOffset :: Int
indexNames :: Vector IndexName
seqnoOffset :: Int
payloadOffset :: Int
length :: Int
indicess :: IndexVec
payloads :: IndexName
indexNames :: Vector IndexName
..}