{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples       #-}
{-# LANGUAGE PolyKinds           #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Binary.Orphans () where

import Data.Binary

import Control.Monad (replicateM)

#if MIN_VERSION_base(4,18,0)
import Data.Tuple (Solo (MkSolo))
#elif MIN_VERSION_base(4,16,0)
import Data.Tuple (Solo (Solo))
#define MkSolo Solo
#else
import Data.Tuple.Solo (Solo (MkSolo))
#endif

import Data.Array.Byte (ByteArray (..), MutableByteArray (..))
import GHC.Exts
       (Int (..), indexWord8Array#, newByteArray#, sizeofByteArray#,
       unsafeFreezeByteArray#, writeWord8Array#)
import GHC.ST          (ST (..), runST)
import GHC.Word        (Word8 (..))

-------------------------------------------------------------------------------
-- future-binary
-------------------------------------------------------------------------------

-- | @since 1.0.2
instance Binary a => Binary (Solo a) where
  put :: Solo a -> Put
put (MkSolo a
x) = a -> Put
forall t. Binary t => t -> Put
put a
x
  get :: Get (Solo a)
get = (a -> Solo a) -> Get a -> Get (Solo a)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Solo a
forall a. a -> Solo a
MkSolo Get a
forall t. Binary t => Get t
get

-- | @since 1.0.3
instance Binary ByteArray where
  put :: ByteArray -> Put
put ByteArray
ba = Int -> Put
forall t. Binary t => t -> Put
put Int
maxI Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
go Int
0
    where
      maxI :: Int
      maxI :: Int
maxI = ByteArray -> Int
sizeofByteArray ByteArray
ba

      go :: Int -> Put
      go :: Int -> Put
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxI  = Word8 -> Put
forall t. Binary t => t -> Put
put (ByteArray -> Int -> Word8
indexByteArray ByteArray
ba Int
i) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
           | Bool
otherwise = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  get :: Get ByteArray
get = do
    Int
len <- Get Int
forall t. Binary t => Get t
get
    [Word8]
xs  <- Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Get Word8
forall t. Binary t => Get t
get
    ByteArray -> Get ByteArray
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [Word8] -> ByteArray
byteArrayFromListN Int
len [Word8]
xs)

{-# INLINE sizeofByteArray #-}
sizeofByteArray :: ByteArray -> Int
sizeofByteArray :: ByteArray -> Int
sizeofByteArray (ByteArray ByteArray#
ba) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba)

{-# INLINE indexByteArray #-}
indexByteArray :: ByteArray -> Int -> Word8
indexByteArray :: ByteArray -> Int -> Word8
indexByteArray (ByteArray ByteArray#
ba) (I# Int#
i) = Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba Int#
i)

{-# INLINE byteArrayFromListN #-}
byteArrayFromListN :: Int -> [Word8] -> ByteArray
byteArrayFromListN :: Int -> [Word8] -> ByteArray
byteArrayFromListN Int
len [Word8]
xs = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
mba <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
len
    MutableByteArray s -> Int -> [Word8] -> ST s ()
forall s. MutableByteArray s -> Int -> [Word8] -> ST s ()
go MutableByteArray s
mba Int
0 [Word8]
xs
    MutableByteArray s -> ST s ByteArray
forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray MutableByteArray s
mba
  where
    go :: MutableByteArray s -> Int -> [Word8] -> ST s ()
    go :: forall s. MutableByteArray s -> Int -> [Word8] -> ST s ()
go MutableByteArray s
mba Int
i [Word8]
ys
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = case [Word8]
ys of
            []   -> MutableByteArray s -> Int -> Word8 -> ST s ()
forall s. MutableByteArray s -> Int -> Word8 -> ST s ()
writeWord8Array MutableByteArray s
mba Int
i Word8
0 ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableByteArray s -> Int -> [Word8] -> ST s ()
forall s. MutableByteArray s -> Int -> [Word8] -> ST s ()
go MutableByteArray s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word8]
ys
            Word8
z:[Word8]
zs -> MutableByteArray s -> Int -> Word8 -> ST s ()
forall s. MutableByteArray s -> Int -> Word8 -> ST s ()
writeWord8Array MutableByteArray s
mba Int
i Word8
z ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableByteArray s -> Int -> [Word8] -> ST s ()
forall s. MutableByteArray s -> Int -> [Word8] -> ST s ()
go MutableByteArray s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word8]
zs

        | Bool
otherwise = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE newByteArray #-}
newByteArray :: Int -> ST s (MutableByteArray s)
newByteArray :: forall s. Int -> ST s (MutableByteArray s)
newByteArray (I# Int#
len) = STRep s (MutableByteArray s) -> ST s (MutableByteArray s)
forall s a. STRep s a -> ST s a
ST (STRep s (MutableByteArray s) -> ST s (MutableByteArray s))
-> STRep s (MutableByteArray s) -> ST s (MutableByteArray s)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len State# s
s of
    (# State# s
s', MutableByteArray# s
mba #) -> (# State# s
s', MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
mba #)

{-# INLINE unsafeFreezeByteArray #-}
unsafeFreezeByteArray :: MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray :: forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray (MutableByteArray MutableByteArray# s
mba) = STRep s ByteArray -> ST s ByteArray
forall s a. STRep s a -> ST s a
ST (STRep s ByteArray -> ST s ByteArray)
-> STRep s ByteArray -> ST s ByteArray
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s of
    (# State# s
s', ByteArray#
ba #) -> (# State# s
s', ByteArray# -> ByteArray
ByteArray ByteArray#
ba #)

{-# INLINE writeWord8Array #-}
writeWord8Array :: MutableByteArray s -> Int -> Word8 -> ST s ()
writeWord8Array :: forall s. MutableByteArray s -> Int -> Word8 -> ST s ()
writeWord8Array (MutableByteArray MutableByteArray# s
mba) (I# Int#
i) (W8# Word8#
w) = STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba Int#
i Word8#
w State# s
s of
    State# s
s' -> (# State# s
s', () #)