{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE UnboxedTuples       #-}

-- |Encoding Primitives
module Flat.Encoder.Prim
  ( eBits16F
  , eBitsF
  , eFloatF
  , eDoubleF
#if ! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION)
  , eUTF16F
#endif
  , eUTF8F
  , eCharF
  , eNaturalF
  , eIntegerF
  , eInt64F
  , eInt32F
  , eIntF
  , eInt16F
  , eInt8F
  , eWordF
  , eWord64F
  , eWord32F
  , eWord16F
  , eBytesF
  , eLazyBytesF
  , eShortBytesF
  , eWord8F
  , eFillerF
  , eBoolF
  , eTrueF
  , eFalseF
  , varWordF
  , w7l
    -- * Exported for testing only
  , eWord32BEF
  , eWord64BEF
  , eWord32E
  , eWord64E
  ) where

import           Control.Monad
import qualified Data.ByteString                as B
import qualified Data.ByteString.Lazy           as L
import qualified Data.ByteString.Lazy.Internal  as L
import qualified Data.ByteString.Short.Internal as SBS
import           Data.Char
import           Flat.Encoder.Types
import           Flat.Endian
import           Flat.Memory
import           Flat.Types
import           Data.FloatCast
import           Data.Primitive.ByteArray
import qualified Data.Text                      as T
#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION)
import qualified Data.Text.Array                as TA
import qualified Data.Text.Internal             as TI
#endif
import qualified Data.Text.Encoding             as TE
import           Data.ZigZag
import           Foreign
-- import Debug.Trace
#include "MachDeps.h"
-- traceShowId :: a -> a
-- traceShowId = id
{-# INLINE eFloatF #-}
eFloatF :: Float -> Prim
eFloatF :: Float -> Prim
eFloatF = Word32 -> Prim
eWord32BEF (Word32 -> Prim) -> (Float -> Word32) -> Float -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
floatToWord

{-# INLINE eDoubleF #-}
eDoubleF :: Double -> Prim
eDoubleF :: Double -> Prim
eDoubleF = Word64 -> Prim
eWord64BEF (Word64 -> Prim) -> (Double -> Word64) -> Double -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord

{-# INLINE eWord64BEF #-}
eWord64BEF :: Word64 -> Prim
eWord64BEF :: Word64 -> Prim
eWord64BEF = (Word64 -> Word64) -> Word64 -> Prim
eWord64E Word64 -> Word64
toBE64

{-# INLINE eWord32BEF #-}
eWord32BEF :: Word32 -> Prim
eWord32BEF :: Word32 -> Prim
eWord32BEF = (Word32 -> Word32) -> Word32 -> Prim
eWord32E Word32 -> Word32
toBE32

{-# INLINE eCharF #-}
eCharF :: Char -> Prim
eCharF :: Char -> Prim
eCharF = Word32 -> Prim
eWord32F (Word32 -> Prim) -> (Char -> Word32) -> Char -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (Char -> Int) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

{-# INLINE eWordF #-}
eWordF :: Word -> Prim
{-# INLINE eIntF #-}
eIntF :: Int -> Prim
#if WORD_SIZE_IN_BITS == 64
eWordF :: Word -> Prim
eWordF = Word64 -> Prim
eWord64F (Word64 -> Prim) -> (Word -> Word64) -> Word -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word -> Word64)

eIntF :: Int -> Prim
eIntF = Int64 -> Prim
eInt64F (Int64 -> Prim) -> (Int -> Int64) -> Int -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Int64)
#elif WORD_SIZE_IN_BITS == 32
eWordF = eWord32F . (fromIntegral :: Word -> Word32)

eIntF = eInt32F . (fromIntegral :: Int -> Int32)
#else
#error expected WORD_SIZE_IN_BITS to be 32 or 64
#endif
{-# INLINE eInt8F #-}
eInt8F :: Int8 -> Prim
eInt8F :: Int8 -> Prim
eInt8F = Word8 -> Prim
eWord8F (Word8 -> Prim) -> (Int8 -> Word8) -> Int8 -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Word8
forall signed unsigned.
ZigZag signed unsigned =>
signed -> unsigned
zigZag

{-# INLINE eInt16F #-}
eInt16F :: Int16 -> Prim
eInt16F :: Int16 -> Prim
eInt16F = Word16 -> Prim
eWord16F (Word16 -> Prim) -> (Int16 -> Word16) -> Int16 -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall signed unsigned.
ZigZag signed unsigned =>
signed -> unsigned
zigZag

{-# INLINE eInt32F #-}
eInt32F :: Int32 -> Prim
eInt32F :: Int32 -> Prim
eInt32F = Word32 -> Prim
eWord32F (Word32 -> Prim) -> (Int32 -> Word32) -> Int32 -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall signed unsigned.
ZigZag signed unsigned =>
signed -> unsigned
zigZag

{-# INLINE eInt64F #-}
eInt64F :: Int64 -> Prim
eInt64F :: Int64 -> Prim
eInt64F = Word64 -> Prim
eWord64F (Word64 -> Prim) -> (Int64 -> Word64) -> Int64 -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall signed unsigned.
ZigZag signed unsigned =>
signed -> unsigned
zigZag

{-# INLINE eIntegerF #-}
eIntegerF :: Integer -> Prim
eIntegerF :: Integer -> Prim
eIntegerF = Natural -> Prim
forall t. (Bits t, Integral t) => t -> Prim
eIntegralF (Natural -> Prim) -> (Integer -> Natural) -> Integer -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
forall signed unsigned.
ZigZag signed unsigned =>
signed -> unsigned
zigZag

{-# INLINE eNaturalF #-}
eNaturalF :: Natural -> Prim
eNaturalF :: Natural -> Prim
eNaturalF = Integer -> Prim
forall t. (Bits t, Integral t) => t -> Prim
eIntegralF (Integer -> Prim) -> (Natural -> Integer) -> Natural -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger

{-# INLINE eIntegralF #-}
eIntegralF :: (Bits t, Integral t) => t -> Prim
eIntegralF :: t -> Prim
eIntegralF t
t =
  let vs :: [Word8]
vs = t -> [Word8]
forall t. (Bits t, Integral t) => t -> [Word8]
w7l t
t
   in [Word8] -> Prim
eIntegralW [Word8]
vs

w7l :: (Bits t, Integral t) => t -> [Word8]
w7l :: t -> [Word8]
w7l t
t =
  let l :: Word8
l = t -> Word8
forall a. Integral a => a -> Word8
low7 t
t
      t' :: t
t' = t
t t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7
   in if t
t' t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
        then [Word8
l]
        else Word8 -> Word8
w7 Word8
l Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: t -> [Word8]
forall t. (Bits t, Integral t) => t -> [Word8]
w7l t
t'
  where
    {-# INLINE w7 #-}
    --lowByte :: (Bits t, Num t) => t -> Word8
    w7 :: Word8 -> Word8
    w7 :: Word8 -> Word8
w7 Word8
l = Word8
l Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80

-- | Encoded as: data NonEmptyList = Elem Word7 | Cons Word7 List
{-# INLINE eIntegralW #-}
eIntegralW :: [Word8] -> Prim
eIntegralW :: [Word8] -> Prim
eIntegralW [Word8]
vs s :: S
s@(S Ptr Word8
op Word8
_ Int
o)
  | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Ptr Word8 -> Word8 -> IO (Ptr Word8))
-> Ptr Word8 -> [Word8] -> IO (Ptr Word8)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Ptr Word8 -> Word8 -> IO (Ptr Word8)
forall a b. Storable a => Ptr a -> a -> IO (Ptr b)
pokeWord' Ptr Word8
op [Word8]
vs IO (Ptr Word8) -> (Ptr Word8 -> IO S) -> IO S
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr Word8
op' -> Prim
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S Ptr Word8
op' Word8
0 Int
0)
  | Bool
otherwise = (S -> Word8 -> IO S) -> S -> [Word8] -> IO S
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((Word8 -> Prim) -> S -> Word8 -> IO S
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> Prim
eWord8F) S
s [Word8]
vs

{-# INLINE eWord8F #-}
eWord8F :: Word8 -> Prim
eWord8F :: Word8 -> Prim
eWord8F Word8
t s :: S
s@(S Ptr Word8
op Word8
_ Int
o)
  | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op Word8
t
  | Bool
otherwise = Word8 -> Prim
pokeByteUnaligned Word8
t S
s

{-# INLINE eWord32E #-}
eWord32E :: (Word32 -> Word32) -> Word32 -> Prim
eWord32E :: (Word32 -> Word32) -> Word32 -> Prim
eWord32E Word32 -> Word32
conv Word32
t (S Ptr Word8
op Word8
w Int
o)
  | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Word32 -> Word32) -> Ptr Word8 -> Word32 -> IO ()
forall a t a1. Storable a => (t -> a) -> Ptr a1 -> t -> IO ()
pokeW Word32 -> Word32
conv Ptr Word8
op Word32
t IO () -> IO S -> IO S
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> Int -> IO S
forall (m :: * -> *) a. Monad m => Ptr a -> Int -> m S
skipBytes Ptr Word8
op Int
4
  | Bool
otherwise =
    (Word32 -> Word32) -> Ptr Word8 -> Word32 -> IO ()
forall a t a1. Storable a => (t -> a) -> Ptr a1 -> t -> IO ()
pokeW Word32 -> Word32
conv Ptr Word8
op (Word8 -> Word32
forall a. Integral a => a -> Word32
asWord32 Word8
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
t Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
o) IO () -> IO S -> IO S
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Prim
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
4) (Word32 -> Word8
forall a. Integral a => a -> Word8
asWord8 Word32
t Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o)) Int
o)

{-# INLINE eWord64E #-}
eWord64E :: (Word64 -> Word64) -> Word64 -> Prim
eWord64E :: (Word64 -> Word64) -> Word64 -> Prim
eWord64E Word64 -> Word64
conv Word64
t (S Ptr Word8
op Word8
w Int
o)
  | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Word64 -> Word64) -> Ptr Word8 -> Word64 -> IO ()
forall t a. (t -> Word64) -> Ptr a -> t -> IO ()
poke64 Word64 -> Word64
conv Ptr Word8
op Word64
t IO () -> IO S -> IO S
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> Int -> IO S
forall (m :: * -> *) a. Monad m => Ptr a -> Int -> m S
skipBytes Ptr Word8
op Int
8
  | Bool
otherwise =
    (Word64 -> Word64) -> Ptr Word8 -> Word64 -> IO ()
forall t a. (t -> Word64) -> Ptr a -> t -> IO ()
poke64 Word64 -> Word64
conv Ptr Word8
op (Word8 -> Word64
forall a. Integral a => a -> Word64
asWord64 Word8
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
56 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
t Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
o) IO () -> IO S -> IO S
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Prim
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
8) (Word64 -> Word8
forall a. Integral a => a -> Word8
asWord8 Word64
t Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o)) Int
o)

{-# INLINE eWord16F #-}
eWord16F :: Word16 -> Prim
eWord16F :: Word16 -> Prim
eWord16F = Word16 -> Prim
forall t. (Bits t, Integral t) => t -> Prim
varWordF

{-# INLINE eWord32F #-}
eWord32F :: Word32 -> Prim
eWord32F :: Word32 -> Prim
eWord32F = Word32 -> Prim
forall t. (Bits t, Integral t) => t -> Prim
varWordF

{-# INLINE eWord64F #-}
eWord64F :: Word64 -> Prim
eWord64F :: Word64 -> Prim
eWord64F = Word64 -> Prim
forall t. (Bits t, Integral t) => t -> Prim
varWordF

{-# INLINE varWordF #-}
varWordF :: (Bits t, Integral t) => t -> Prim
varWordF :: t -> Prim
varWordF t
t s :: S
s@(S Ptr Word8
_ Word8
_ Int
o)
  | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Word8 -> Prim) -> t -> Prim
forall t. (Bits t, Integral t) => (Word8 -> Prim) -> t -> Prim
varWord Word8 -> Prim
pokeByteAligned t
t S
s
  | Bool
otherwise = (Word8 -> Prim) -> t -> Prim
forall t. (Bits t, Integral t) => (Word8 -> Prim) -> t -> Prim
varWord Word8 -> Prim
pokeByteUnaligned t
t S
s

{-# INLINE varWord #-}
varWord :: (Bits t, Integral t) => (Word8 -> Prim) -> t -> Prim
varWord :: (Word8 -> Prim) -> t -> Prim
varWord Word8 -> Prim
writeByte t
t S
s
  | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
128 = Word8 -> Prim
writeByte (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
t) S
s
  | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
16384 = (Word8 -> Prim) -> t -> Prim
forall (m :: * -> *) a t t.
(Monad m, Integral a, Bits t, Bits a, Num t) =>
(t -> t -> m t) -> a -> t -> m t
varWord2_ Word8 -> Prim
writeByte t
t S
s
  | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
2097152 = (Word8 -> Prim) -> t -> Prim
forall (m :: * -> *) a t t.
(Monad m, Integral a, Bits t, Bits a, Num t) =>
(t -> t -> m t) -> a -> t -> m t
varWord3_ Word8 -> Prim
writeByte t
t S
s
  | Bool
otherwise = (Word8 -> Prim) -> t -> Prim
forall t. (Bits t, Integral t) => (Word8 -> Prim) -> t -> Prim
varWordN_ Word8 -> Prim
writeByte t
t S
s
  where
    {-# INLINE varWord2_ #-}
      -- TODO: optimise, using a single Write16?
    varWord2_ :: (t -> t -> m t) -> a -> t -> m t
varWord2_ t -> t -> m t
writeByte a
t t
s =
      t -> t -> m t
writeByte (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
t t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
0x80) t
s m t -> (t -> m t) -> m t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      t -> t -> m t
writeByte (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
t a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7) t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
0x7F)
    {-# INLINE varWord3_ #-}
    varWord3_ :: (t -> b -> m b) -> a -> b -> m b
varWord3_ t -> b -> m b
writeByte a
t b
s =
      t -> b -> m b
writeByte (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
t t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
0x80) b
s m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      t -> b -> m b
writeByte (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
t a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7) t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
0x80) m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      t -> b -> m b
writeByte (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
t a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
14) t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
0x7F)

-- {-# INLINE varWordN #-}
varWordN_ :: (Bits t, Integral t) => (Word8 -> Prim) -> t -> Prim
varWordN_ :: (Word8 -> Prim) -> t -> Prim
varWordN_ Word8 -> Prim
writeByte = t -> Prim
forall t. (Bits t, Integral t) => t -> Prim
go
  where
    go :: a -> Prim
go !a
v !S
st =
      let !l :: Word8
l = a -> Word8
forall a. Integral a => a -> Word8
low7 a
v
          !v' :: a
v' = a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7
       in if a
v' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
            then Word8 -> Prim
writeByte Word8
l S
st
            else Word8 -> Prim
writeByte (Word8
l Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80) S
st IO S -> Prim -> IO S
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Prim
go a
v'

{-# INLINE low7 #-}
low7 :: (Integral a) => a -> Word8
low7 :: a -> Word8
low7 a
t = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
t Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F

-- | Encode text as UTF8 and encode the result as an array of bytes
-- PROB: encodeUtf8 calls a C primitive, not compatible with GHCJS (fixed in latest versions of GHCJS?)
eUTF8F :: T.Text -> Prim
eUTF8F :: Text -> Prim
eUTF8F = ByteString -> Prim
eBytesF (ByteString -> Prim) -> (Text -> ByteString) -> Text -> Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

-- PROB: Not compatible with GHCJS or ETA (that is big endian and writes contents in reverse order)
-- | Encode text as UTF16 and encode the result as an array of bytes
-- Efficient, as Text is already internally encoded as UTF16.
#if ! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION)
eUTF16F :: T.Text -> Prim
eUTF16F :: Text -> Prim
eUTF16F Text
t = Prim
eFillerF Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Prim
eUTF16F_ Text
t
  where
    eUTF16F_ :: Text -> Prim
eUTF16F_ !(TI.Text (TA.Array ByteArray#
array) Int
w16Off Int
w16Len) S
s =
      ByteArray# -> Int -> Int -> Ptr Word8 -> IO S
writeArray ByteArray#
array (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w16Off) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w16Len) (S -> Ptr Word8
nextPtr S
s)
#endif

-- |Encode a Lazy ByteString
eLazyBytesF :: L.ByteString -> Prim
eLazyBytesF :: ByteString -> Prim
eLazyBytesF ByteString
bs = Prim
eFillerF Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \S
s -> ByteString -> Ptr Word8 -> IO S
write ByteString
bs (S -> Ptr Word8
nextPtr S
s)
    -- Single copy
  where
    write :: ByteString -> Ptr Word8 -> IO S
write ByteString
lbs Ptr Word8
op = do
      case ByteString
lbs of
        L.Chunk ByteString
h ByteString
t -> ByteString -> Ptr Word8 -> IO (Ptr Word8)
writeBS ByteString
h Ptr Word8
op IO (Ptr Word8) -> (Ptr Word8 -> IO S) -> IO S
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Ptr Word8 -> IO S
write ByteString
t
        ByteString
L.Empty     -> Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op Word8
0

{-# INLINE eShortBytesF #-}
eShortBytesF :: SBS.ShortByteString -> Prim
eShortBytesF :: ShortByteString -> Prim
eShortBytesF ShortByteString
bs = Prim
eFillerF Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ShortByteString -> Prim
eShortBytesF_ ShortByteString
bs

eShortBytesF_ :: SBS.ShortByteString -> Prim
eShortBytesF_ :: ShortByteString -> Prim
eShortBytesF_ bs :: ShortByteString
bs@(SBS.SBS ByteArray#
arr) =
  \(S Ptr Word8
op Word8
_ Int
0) -> ByteArray# -> Int -> Int -> Ptr Word8 -> IO S
writeArray ByteArray#
arr Int
0 (ShortByteString -> Int
SBS.length ShortByteString
bs) Ptr Word8
op

-- data Array a = Array0 | Array1 a ... | Array255 ...
writeArray :: ByteArray# -> Int -> Int -> Ptr Word8 -> IO S
writeArray :: ByteArray# -> Int -> Int -> Ptr Word8 -> IO S
writeArray ByteArray#
arr Int
soff Int
slen Ptr Word8
sop = do
  Ptr Word8
op' <- Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
go Int
soff Int
slen Ptr Word8
sop
  Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op' Word8
0
  where
    go :: Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
go !Int
off !Int
len !Ptr Word8
op
      | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
op
      | Bool
otherwise =
        let l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
255 Int
len
         in Ptr Word8 -> Word8 -> IO (Ptr Word8)
forall a b. Storable a => Ptr a -> a -> IO (Ptr b)
pokeWord' Ptr Word8
op (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) IO (Ptr Word8) -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteArray# -> Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
pokeByteArray ByteArray#
arr Int
off Int
l IO (Ptr Word8) -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)

eBytesF :: B.ByteString -> Prim
eBytesF :: ByteString -> Prim
eBytesF ByteString
bs = Prim
eFillerF Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Prim
eBytesF_
  where
    eBytesF_ :: Prim
eBytesF_ S
s = do
      Ptr Word8
op' <- ByteString -> Ptr Word8 -> IO (Ptr Word8)
writeBS ByteString
bs (S -> Ptr Word8
nextPtr S
s)
      Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op' Word8
0

-- |Encode up to 9 bits
{-# INLINE eBits16F #-}
eBits16F :: NumBits -> Word16 -> Prim
--eBits16F numBits code | numBits >8 = eBitsF (numBits-8) (fromIntegral $ code `unsafeShiftR` 8) >=> eBitsF 8 (fromIntegral code)
-- eBits16F _ _ = eFalseF
eBits16F :: Int -> Word16 -> Prim
eBits16F Int
9 Word16
code =
  Int -> Word8 -> Prim
eBitsF Int
1 (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ Word16
code Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8) Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  Int -> Word8 -> Prim
eBitsF_ Int
8 (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
code)
eBits16F Int
numBits Word16
code = Int -> Word8 -> Prim
eBitsF Int
numBits (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
code)

-- |Encode up to 8 bits.
{-# INLINE eBitsF #-}
eBitsF :: NumBits -> Word8 -> Prim
eBitsF :: Int -> Word8 -> Prim
eBitsF Int
1 Word8
0 = Prim
eFalseF
eBitsF Int
1 Word8
1 = Prim
eTrueF
eBitsF Int
2 Word8
0 = Prim
eFalseF Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Prim
eFalseF
eBitsF Int
2 Word8
1 = Prim
eFalseF Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Prim
eTrueF
eBitsF Int
2 Word8
2 = Prim
eTrueF Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Prim
eFalseF
eBitsF Int
2 Word8
3 = Prim
eTrueF Prim -> Prim -> Prim
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Prim
eTrueF
eBitsF Int
n Word8
t = Int -> Word8 -> Prim
eBitsF_ Int
n Word8
t

{-
eBits Example:
Before:
n = 6
t = 00.101011
o = 3
w = 111.00000

After:
[ptr] = w(111)t(10101)
w' = t(1)0000000
o'= 1

o'=3+6=9
f = 8-9 = -1
o'' = 1
8-o''=7

if n=8,o=3:
o'=11
f=8-11=-3
o''=3
8-o''=5
-}
-- {-# NOINLINE eBitsF_ #-}
eBitsF_ :: NumBits -> Word8 -> Prim
eBitsF_ :: Int -> Word8 -> Prim
eBitsF_ Int
n Word8
t =
  \(S Ptr Word8
op Word8
w Int
o) ->
    let o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n -- used bits
        f :: Int
f = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o' -- remaining free bits
     in if | Int
f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Prim
forall (m :: * -> *) a. Monad m => a -> m a
return Prim -> Prim
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Word8 -> Int -> S
S Ptr Word8
op (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
t Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
f)) Int
o'
           | Int
f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
t)
           | Bool
otherwise ->
             let o'' :: Int
o'' = -Int
f
              in Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
op (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
t Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
o'')) IO () -> IO S -> IO S
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                 Prim
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
1) (Word8
t Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o'')) Int
o'')

{-# INLINE eBoolF #-}
eBoolF :: Bool -> Prim
eBoolF :: Bool -> Prim
eBoolF Bool
False = Prim
eFalseF
eBoolF Bool
True  = Prim
eTrueF

{-# INLINE eTrueF #-}
eTrueF :: Prim
eTrueF :: Prim
eTrueF (S Ptr Word8
op Word8
w Int
o)
  | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
1)
  | Bool
otherwise = Prim
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S Ptr Word8
op (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
128 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
o) (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

{-# INLINE eFalseF #-}
eFalseF :: Prim
eFalseF :: Prim
eFalseF (S Ptr Word8
op Word8
w Int
o)
  | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op Word8
w
  | Bool
otherwise = Prim
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S Ptr Word8
op Word8
w (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

{-# INLINE eFillerF #-}
eFillerF :: Prim
eFillerF :: Prim
eFillerF (S Ptr Word8
op Word8
w Int
_) = Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
1)

-- {-# INLINE poke16 #-}
-- TODO TEST
-- poke16 :: Word16 -> Prim
-- poke16 t (S op w o) | o == 0 = poke op w >> skipBytes op 2
{-# INLINE pokeByteUnaligned #-}
pokeByteUnaligned :: Word8 -> Prim
pokeByteUnaligned :: Word8 -> Prim
pokeByteUnaligned Word8
t (S Ptr Word8
op Word8
w Int
o) =
  Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
op (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
t Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
o)) IO () -> IO S -> IO S
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Prim
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
1) (Word8
t Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o)) Int
o)

{-# INLINE pokeByteAligned #-}
pokeByteAligned :: Word8 -> Prim
pokeByteAligned :: Word8 -> Prim
pokeByteAligned Word8
t (S Ptr Word8
op Word8
_ Int
_) = Ptr Word8 -> Word8 -> IO S
forall a. Storable a => Ptr a -> a -> IO S
pokeWord Ptr Word8
op Word8
t

{-# INLINE pokeWord #-}
pokeWord :: Storable a => Ptr a -> a -> IO S
pokeWord :: Ptr a -> a -> IO S
pokeWord Ptr a
op a
w = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
op a
w IO () -> IO S -> IO S
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> IO S
forall (m :: * -> *) a. Monad m => Ptr a -> m S
skipByte Ptr a
op

{-# INLINE pokeWord' #-}
pokeWord' :: Storable a => Ptr a -> a -> IO (Ptr b)
pokeWord' :: Ptr a -> a -> IO (Ptr b)
pokeWord' Ptr a
op a
w = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
op a
w IO () -> IO (Ptr b) -> IO (Ptr b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
op Int
1)

{-# INLINE pokeW #-}
pokeW :: Storable a => (t -> a) -> Ptr a1 -> t -> IO ()
pokeW :: (t -> a) -> Ptr a1 -> t -> IO ()
pokeW t -> a
conv Ptr a1
op t
t = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a1 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr a1
op) (t -> a
conv t
t)

{-# INLINE poke64 #-}
poke64 :: (t -> Word64) -> Ptr a -> t -> IO ()
poke64 :: (t -> Word64) -> Ptr a -> t -> IO ()
poke64 t -> Word64
conv Ptr a
op t
t = Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr a
op) (t -> Word64
conv t
t)
-- poke64 conv op t = poke (castPtr op) (fix64 . conv $ t)

{-# INLINE skipByte #-}
skipByte :: Monad m => Ptr a -> m S
skipByte :: Ptr a -> m S
skipByte Ptr a
op = S -> m S
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S (Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
op Int
1) Word8
0 Int
0)

{-# INLINE skipBytes #-}
skipBytes :: Monad m => Ptr a -> Int -> m S
skipBytes :: Ptr a -> Int -> m S
skipBytes Ptr a
op Int
n = S -> m S
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Word8 -> Int -> S
S (Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
op Int
n) Word8
0 Int
0)

--{-# INLINE nextByteW #-}
--nextByteW op w = return (S (plusPtr op 1) 0 0)
writeBS :: B.ByteString -> Ptr Word8 -> IO (Ptr Word8)
writeBS :: ByteString -> Ptr Word8 -> IO (Ptr Word8)
writeBS ByteString
bs Ptr Word8
op -- @(BS.PS foreignPointer sourceOffset sourceLength) op
  | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
op
  | Bool
otherwise =
    let (ByteString
h, ByteString
t) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
255 ByteString
bs
     in Ptr Word8 -> Word8 -> IO (Ptr Word8)
forall a b. Storable a => Ptr a -> a -> IO (Ptr b)
pokeWord' Ptr Word8
op (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
h :: Word8) IO (Ptr Word8) -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Ptr Word8 -> IO (Ptr Word8)
pokeByteString ByteString
h IO (Ptr Word8) -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        ByteString -> Ptr Word8 -> IO (Ptr Word8)
writeBS ByteString
t
    -- 2X slower (why?)
    -- withForeignPtr foreignPointer goS
    --   where
    --     goS sourcePointer = go op (sourcePointer `plusPtr` sourceOffset) sourceLength
    --       where
    --         go !op !off !len | len == 0 = return op
    --                          | otherwise = do
    --                           let l = min 255 len
    --                           op' <- pokeWord' op (fromIntegral l)
    --                           BS.memcpy op' off l
    --                           go (op' `plusPtr` l) (off `plusPtr` l) (len-l)

{-# INLINE asWord64 #-}
asWord64 :: Integral a => a -> Word64
asWord64 :: a -> Word64
asWord64 = a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE asWord32 #-}
asWord32 :: Integral a => a -> Word32
asWord32 :: a -> Word32
asWord32 = a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE asWord8 #-}
asWord8 :: Integral a => a -> Word8
asWord8 :: a -> Word8
asWord8 = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral