module Dahdit.Iface
  ( BinaryTarget (..)
  , getTarget
  , putTarget
  , decode
  , decodeFile
  , encode
  , encodeFile
  )
where

import Dahdit.Binary (Binary (..))
import Dahdit.Free (Get, Put)
import Dahdit.Mem (allocArrayMem, allocPtrMem, freezeBSMem, freezeSBSMem, freezeVecMem, viewBSMem, viewSBSMem, viewVecMem)
import Dahdit.Run (GetError, runCount, runGetInternal, runPutInternal)
import Dahdit.Sizes (ByteCount (..), ByteSized (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as BSS
import Data.Coerce (coerce)
import Data.Vector.Storable (Vector)
import qualified Data.Vector.Storable as VS
import Data.Word (Word8)

-- | Abstracts over the sources we can read from / sinks we can render to.
class BinaryTarget z where
  -- | Put an action to the sink with the given capacity.
  -- Prefer 'putTarget' to safely count capacity, or use 'encode' to use byte size.
  putTargetUnsafe :: Put -> ByteCount -> z

  -- | Get a value from the source given a starting offset, returning a result and final offset.
  -- On error, the offset will indicate where in the source the error occurred.
  getTargetOffset :: ByteCount -> Get a -> z -> (Either GetError a, ByteCount)

-- | Get a value from the source, returning a result and final offset.
getTarget :: BinaryTarget z => Get a -> z -> (Either GetError a, ByteCount)
getTarget :: forall z a.
BinaryTarget z =>
Get a -> z -> (Either GetError a, ByteCount)
getTarget = forall z a.
BinaryTarget z =>
ByteCount -> Get a -> z -> (Either GetError a, ByteCount)
getTargetOffset ByteCount
0

-- | Put an action to the sink with calculated capacity.
putTarget :: BinaryTarget z => Put -> z
putTarget :: forall z. BinaryTarget z => Put -> z
putTarget Put
p = forall z. BinaryTarget z => Put -> ByteCount -> z
putTargetUnsafe Put
p (Put -> ByteCount
runCount Put
p)

instance BinaryTarget ShortByteString where
  getTargetOffset :: forall a.
ByteCount
-> Get a -> ShortByteString -> (Either GetError a, ByteCount)
getTargetOffset = forall a.
ByteCount
-> Get a -> ShortByteString -> (Either GetError a, ByteCount)
runGetSBS
  putTargetUnsafe :: Put -> ByteCount -> ShortByteString
putTargetUnsafe = Put -> ByteCount -> ShortByteString
runPutSBS

instance BinaryTarget ByteString where
  getTargetOffset :: forall a.
ByteCount -> Get a -> ByteString -> (Either GetError a, ByteCount)
getTargetOffset = forall a.
ByteCount -> Get a -> ByteString -> (Either GetError a, ByteCount)
runGetBS
  putTargetUnsafe :: Put -> ByteCount -> ByteString
putTargetUnsafe = Put -> ByteCount -> ByteString
runPutBS

instance BinaryTarget (Vector Word8) where
  getTargetOffset :: forall a.
ByteCount
-> Get a -> Vector Word8 -> (Either GetError a, ByteCount)
getTargetOffset = forall a.
ByteCount
-> Get a -> Vector Word8 -> (Either GetError a, ByteCount)
runGetVec
  putTargetUnsafe :: Put -> ByteCount -> Vector Word8
putTargetUnsafe = Put -> ByteCount -> Vector Word8
runPutVec

-- | Decode a value from a source returning a result and consumed byte count.
decode :: (Binary a, BinaryTarget z) => z -> (Either GetError a, ByteCount)
decode :: forall a z.
(Binary a, BinaryTarget z) =>
z -> (Either GetError a, ByteCount)
decode = forall z a.
BinaryTarget z =>
Get a -> z -> (Either GetError a, ByteCount)
getTarget forall a. Binary a => Get a
get

-- | Decode a value from a file.
decodeFile :: Binary a => FilePath -> IO (Either GetError a, ByteCount)
decodeFile :: forall a. Binary a => FilePath -> IO (Either GetError a, ByteCount)
decodeFile = forall a. Get a -> FilePath -> IO (Either GetError a, ByteCount)
runGetFile forall a. Binary a => Get a
get

-- | Encode a value to a sink.
encode :: (Binary a, ByteSized a, BinaryTarget z) => a -> z
encode :: forall a z. (Binary a, ByteSized a, BinaryTarget z) => a -> z
encode a
a = forall z. BinaryTarget z => Put -> ByteCount -> z
putTargetUnsafe (forall a. Binary a => a -> Put
put a
a) (forall a. ByteSized a => a -> ByteCount
byteSize a
a)

-- | Encode a value to a file.
encodeFile :: (Binary a, ByteSized a) => a -> FilePath -> IO ()
encodeFile :: forall a. (Binary a, ByteSized a) => a -> FilePath -> IO ()
encodeFile a
a = Put -> ByteCount -> FilePath -> IO ()
runPutFile (forall a. Binary a => a -> Put
put a
a) (forall a. ByteSized a => a -> ByteCount
byteSize a
a)

runGetSBS :: ByteCount -> Get a -> ShortByteString -> (Either GetError a, ByteCount)
runGetSBS :: forall a.
ByteCount
-> Get a -> ShortByteString -> (Either GetError a, ByteCount)
runGetSBS ByteCount
off Get a
act ShortByteString
sbs = forall r a.
ReadMem r =>
ByteCount
-> Get a -> ByteCount -> r -> (Either GetError a, ByteCount)
runGetInternal ByteCount
off Get a
act (coerce :: forall a b. Coercible a b => a -> b
coerce (ShortByteString -> Int
BSS.length ShortByteString
sbs)) (ShortByteString -> ByteArray
viewSBSMem ShortByteString
sbs)

runGetBS :: ByteCount -> Get a -> ByteString -> (Either GetError a, ByteCount)
runGetBS :: forall a.
ByteCount -> Get a -> ByteString -> (Either GetError a, ByteCount)
runGetBS ByteCount
off Get a
act ByteString
bs = forall r a.
ReadMem r =>
ByteCount
-> Get a -> ByteCount -> r -> (Either GetError a, ByteCount)
runGetInternal ByteCount
off Get a
act (coerce :: forall a b. Coercible a b => a -> b
coerce (ByteString -> Int
BS.length ByteString
bs)) (ByteString -> Ptr Word8
viewBSMem ByteString
bs)

runGetVec :: ByteCount -> Get a -> Vector Word8 -> (Either GetError a, ByteCount)
runGetVec :: forall a.
ByteCount
-> Get a -> Vector Word8 -> (Either GetError a, ByteCount)
runGetVec ByteCount
off Get a
act Vector Word8
vec = forall r a.
ReadMem r =>
ByteCount
-> Get a -> ByteCount -> r -> (Either GetError a, ByteCount)
runGetInternal ByteCount
off Get a
act (coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Storable a => Vector a -> Int
VS.length Vector Word8
vec)) (Vector Word8 -> Ptr Word8
viewVecMem Vector Word8
vec)

runGetFile :: Get a -> FilePath -> IO (Either GetError a, ByteCount)
runGetFile :: forall a. Get a -> FilePath -> IO (Either GetError a, ByteCount)
runGetFile Get a
act FilePath
fp = do
  ByteString
bs <- FilePath -> IO ByteString
BS.readFile FilePath
fp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
ByteCount -> Get a -> ByteString -> (Either GetError a, ByteCount)
runGetBS ByteCount
0 Get a
act ByteString
bs)

runPutSBS :: Put -> ByteCount -> ShortByteString
runPutSBS :: Put -> ByteCount -> ShortByteString
runPutSBS Put
act ByteCount
cap = forall (q :: * -> *) z.
WriteMem q =>
Put
-> ByteCount
-> (forall s. ByteCount -> ST s (q s))
-> (forall s. q s -> ByteCount -> ByteCount -> ST s z)
-> z
runPutInternal Put
act ByteCount
cap forall s. ByteCount -> ST s (MutableByteArray s)
allocArrayMem forall s.
MutableByteArray s
-> ByteCount -> ByteCount -> ST s ShortByteString
freezeSBSMem

runPutBS :: Put -> ByteCount -> ByteString
runPutBS :: Put -> ByteCount -> ByteString
runPutBS Put
act ByteCount
cap = forall (q :: * -> *) z.
WriteMem q =>
Put
-> ByteCount
-> (forall s. ByteCount -> ST s (q s))
-> (forall s. q s -> ByteCount -> ByteCount -> ST s z)
-> z
runPutInternal Put
act ByteCount
cap forall s. ByteCount -> ST s (IxPtr s)
allocPtrMem forall s. IxPtr s -> ByteCount -> ByteCount -> ST s ByteString
freezeBSMem

runPutVec :: Put -> ByteCount -> Vector Word8
runPutVec :: Put -> ByteCount -> Vector Word8
runPutVec Put
act ByteCount
cap = forall (q :: * -> *) z.
WriteMem q =>
Put
-> ByteCount
-> (forall s. ByteCount -> ST s (q s))
-> (forall s. q s -> ByteCount -> ByteCount -> ST s z)
-> z
runPutInternal Put
act ByteCount
cap forall s. ByteCount -> ST s (IxPtr s)
allocPtrMem forall s. IxPtr s -> ByteCount -> ByteCount -> ST s (Vector Word8)
freezeVecMem

runPutFile :: Put -> ByteCount -> FilePath -> IO ()
runPutFile :: Put -> ByteCount -> FilePath -> IO ()
runPutFile Put
act ByteCount
cap FilePath
fp =
  let bs :: ByteString
bs = Put -> ByteCount -> ByteString
runPutBS Put
act ByteCount
cap
  in  FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fp ByteString
bs