module Codec.Borsh.Internal.Util.ByteString (
    peekByteString
  , splitAtEnd
  , lengthStrict
  , lengthLazy
  ) where

import Foreign
import System.IO.Unsafe (unsafePerformIO)

import qualified Data.ByteString          as S
import qualified Data.ByteString.Internal as S.Internal
import qualified Data.ByteString.Lazy     as L

import Codec.Borsh.Internal.Util.ByteSwap

-- | Peek at the start of the bytestring
--
-- If the bytestring is long enough, returns the value, the size of that value,
-- and the remaining bytes.
--
-- Implementation note: this could be simplified using @bytestring >= 0.11@, as
-- the @offset@ argument has been removed. As it stands, this implementation is
-- backwards compatible.
peekByteString :: forall a.
     ByteSwap a
  => S.ByteString
  -> Maybe (a, Word32, S.ByteString)
peekByteString :: forall a. ByteSwap a => ByteString -> Maybe (a, Word32, ByteString)
peekByteString ByteString
bs
  | Int
sizeA forall a. Ord a => a -> a -> Bool
> Int
len = forall a. Maybe a
Nothing
  | Bool
otherwise   = forall a. a -> Maybe a
Just (
        forall a. ByteSwap a => LE a -> a
fromLE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> LE a
LE forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fPtr Int
offset) (forall a. Storable a => Ptr a -> IO a
peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Ptr a
cast)
      , forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeA
      , Int -> ByteString -> ByteString
S.drop Int
sizeA ByteString
bs
      )
  where
    sizeA :: Int
    sizeA :: Int
sizeA = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)

    fPtr :: ForeignPtr Word8
    offset, len :: Int
    (ForeignPtr Word8
fPtr, Int
offset, Int
len) = ByteString -> (ForeignPtr Word8, Int, Int)
S.Internal.toForeignPtr ByteString
bs

    cast :: Ptr Word8 -> Ptr a
    cast :: Ptr Word8 -> Ptr a
cast = forall a b. Ptr a -> Ptr b
castPtr

-- | /O(1)/ @splitAtEnd n xs@ is equivalent to @(takeEnd n xs, dropEnd n xs)@
--
-- > splitAtEnd 0 "abcde" == ("abcde", "")
-- > splitAtEnd 1 "abcde" == ("abcd", "e")
-- > splitAtEnd 5 "abcde" == ("", "abcde")
--
-- Edge cases, similar to behaviour of 'splitAt':

-- > splitAtEnd (-1) "abcde" == ("abcde", "") -- split before start
-- > splitAtEnd 6    "abcde" == ("", "abcde") -- split after end
splitAtEnd ::
     Int
  -> S.ByteString
  -> (S.ByteString, S.ByteString)
splitAtEnd :: Int -> ByteString -> (ByteString, ByteString)
splitAtEnd Int
n ByteString
bs = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
n' ByteString
bs
  where
    -- This may drop below zero if @n > length bs@. This will give us the
    -- correct behaviour from 'splitAt'
    n' :: Int
    n' :: Int
n' = ByteString -> Int
S.length ByteString
bs forall a. Num a => a -> a -> a
- Int
n

-- | Wrapper around 'S.length' with more sane return type
lengthStrict :: S.ByteString -> Word32
lengthStrict :: ByteString -> Word32
lengthStrict = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
S.length

-- | Wrapper around 'L.length' with more sane return type
lengthLazy :: L.ByteString -> Word32
lengthLazy :: ByteString -> Word32
lengthLazy = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
L.length