-- |

-- Module      : Data.ByteArray.Pack

-- License     : BSD-Style

-- Maintainer  : Vincent Hanquez <vincent@snarc.org>

-- Stability   : experimental

-- Portability : unknown

--

-- Simple Byte Array packer

--

-- Simple example:

--

-- > > flip pack 20 $ putWord8 0x41 >> putByteString "BCD" >> putWord8 0x20 >> putStorable (42 :: Word32)

-- > Right (ABCD *\NUL\NUL\NUL")

--

-- Original code from <https://hackage.haskell.org/package/bspack>

-- generalized and adapted to run on 'memory', and spellchecked / tweaked. (2015-05)

-- Copyright (c) 2014 Nicolas DI PRIMA

--

module Data.ByteArray.Pack

    ( Packer

    , Result(..)

    , fill

    , pack

      -- * Operations

      -- ** put

    , putWord8

    , putWord16

    , putWord32

    , putStorable

    , putBytes

    , fillList

    , fillUpWith

      -- ** skip

    , skip

    , skipStorable

    ) where

import           Data.Word

import           Foreign.Ptr

import           Foreign.Storable

import           Data.Memory.Internal.Imports ()

import           Data.Memory.Internal.Compat

import           Data.Memory.PtrMethods

import           Data.ByteArray.Pack.Internal

import           Data.ByteArray (ByteArray, ByteArrayAccess, MemView(..))

import qualified Data.ByteArray as B

-- | Fill a given sized buffer with the result of the Packer action

fill :: ByteArray byteArray => Int -> Packer a -> Either String byteArray

fill len packing = unsafeDoIO $ do

    (val, out) <- B.allocRet len $ \ptr -> runPacker_ packing (MemView ptr len)

    case val of 

        PackerMore _ (MemView _ r)

            | r == 0    -> return $ Right out

            | otherwise -> return $ Left ("remaining unpacked bytes " ++ show r ++ " at the end of buffer")

        PackerFail err  -> return $ Left err

-- | Pack the given packer into the given bytestring

pack :: ByteArray byteArray => Packer a -> Int -> Either String byteArray

pack packing len = fill len packing

{-# DEPRECATED pack "use fill instead" #-}

fillUpWithWord8' :: Word8 -> Packer ()

fillUpWithWord8' w = Packer $ \(MemView ptr size) -> do

    memSet ptr w size

    return $ PackerMore () (MemView (ptr `plusPtr` size) 0)

-- | Put a storable from the current position in the stream

putStorable :: Storable storable => storable -> Packer ()

putStorable s = actionPacker (sizeOf s) (\ptr -> poke (castPtr ptr) s)

-- | Put a Byte Array from the current position in the stream

--

-- If the ByteArray is null, then do nothing

putBytes :: ByteArrayAccess ba => ba -> Packer ()

putBytes bs

    | neededLength == 0 = return ()

    | otherwise         =

        actionPacker neededLength $ \dstPtr -> B.withByteArray bs $ \srcPtr ->

            memCopy dstPtr srcPtr neededLength

  where

    neededLength = B.length bs

-- | Skip some bytes from the current position in the stream

skip :: Int -> Packer ()

skip n = actionPacker n (\_ -> return ())

-- | Skip the size of a storable from the current position in the stream

skipStorable :: Storable storable => storable -> Packer ()

skipStorable = skip . sizeOf

-- | Fill up from the current position in the stream to the end

--

-- It is equivalent to:

--

-- > fillUpWith s == fillList (repeat s)

--

fillUpWith :: Storable storable => storable -> Packer ()

fillUpWith s = fillList $ repeat s

{-# RULES "fillUpWithWord8" forall s . fillUpWith s = fillUpWithWord8' s #-}

{-# NOINLINE fillUpWith #-}

-- | Will put the given storable list from the current position in the stream

-- to the end.

--

-- This function will fail with not enough storage if the given storable can't

-- be written (not enough space)

--

-- Example:

--

-- > > pack (fillList $ [1..] :: Word8) 9

-- > "\1\2\3\4\5\6\7\8\9"

-- > > pack (fillList $ [1..] :: Word32) 4

-- > "\1\0\0\0"

-- > > pack (fillList $ [1..] :: Word32) 64

-- > .. <..succesful..>

-- > > pack (fillList $ [1..] :: Word32) 1

-- > .. <.. not enough space ..>

-- > > pack (fillList $ [1..] :: Word32) 131

-- > .. <.. not enough space ..>

--

fillList :: Storable storable => [storable] -> Packer ()

fillList []     = return ()

fillList (x:xs) = putStorable x >> fillList xs

------------------------------------------------------------------------------

-- Common packer                                                            --

------------------------------------------------------------------------------

-- | put Word8 in the current position in the stream

putWord8 :: Word8 -> Packer ()

putWord8 = putStorable

{-# INLINE putWord8 #-}

-- | put Word16 in the current position in the stream

-- /!\ use Host Endianness

putWord16 :: Word16 -> Packer ()

putWord16 = putStorable

{-# INLINE putWord16 #-}

-- | put Word32 in the current position in the stream

-- /!\ use Host Endianness

putWord32 :: Word32 -> Packer ()

putWord32 = putStorable

{-# INLINE putWord32 #-}