{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}

-- |Strict Decoder
module Flat.Decoder.Strict
  ( decodeArrayWith
  , decodeListWith
  , dByteString
  , dLazyByteString
  , dShortByteString
  , dShortByteString_
#if! defined (ETA_VERSION)
  , dUTF16
#endif
  , dUTF8
  , dInteger
  , dNatural
  , dChar
  , dWord8
  , dWord16
  , dWord32
  , dWord64
  , dWord
  , dInt8
  , dInt16
  , dInt32
  , dInt64
  , dInt
  ) where

import           Data.Bits
import qualified Data.ByteString                as B
import qualified Data.ByteString.Lazy           as L
import qualified Data.ByteString.Short          as SBS
#if !MIN_VERSION_bytestring(0,11,0)
import qualified Data.ByteString.Short.Internal as SBS
#endif
import           Control.Monad                  (unless)
import qualified Data.DList                     as DL
import           Data.Int
import           Data.Primitive.ByteArray
import qualified Data.Text                      as T
import qualified Data.Text.Encoding             as T
import           Flat.Decoder.Prim
import           Flat.Decoder.Types

#if! defined (ETA_VERSION) && ! MIN_VERSION_text(2,0,0)
import qualified Data.Text.Array                as TA
import qualified Data.Text.Internal             as T
#endif

import           Data.Word
import           Data.ZigZag
import           GHC.Base                       (unsafeChr)
import           Numeric.Natural                (Natural)
#include "MachDeps.h"

{-# INLINE decodeListWith #-}
decodeListWith :: Get a -> Get [a]
decodeListWith :: forall a. Get a -> Get [a]
decodeListWith Get a
dec = Get [a]
go
  where
    go :: Get [a]
go = do
      Bool
b <- Get Bool
dBool
      if Bool
b
        then (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
dec forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [a]
go
        else forall (m :: * -> *) a. Monad m => a -> m a
return []

decodeArrayWith :: Get a -> Get [a]
decodeArrayWith :: forall a. Get a -> Get [a]
decodeArrayWith Get a
dec = forall a. DList a -> [a]
DL.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> Get (DList a)
getAsL_ Get a
dec

-- TODO: test if it would it be faster with DList.unfoldr :: (b -> Maybe (a, b)) -> b -> Data.DList.DList a
--  getAsL_ :: Flat a => Get (DL.DList a)
getAsL_ :: Get a -> Get (DL.DList a)
getAsL_ :: forall a. Get a -> Get (DList a)
getAsL_ Get a
dec = do
  Word8
tag <- Get Word8
dWord8
  case Word8
tag of
    Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. DList a
DL.empty
    Word8
_ -> do
      DList a
h <- forall {t}. (Eq t, Num t) => t -> Get (DList a)
gets Word8
tag
      DList a
t <- forall a. Get a -> Get (DList a)
getAsL_ Get a
dec
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. DList a -> DList a -> DList a
DL.append DList a
h DList a
t)
  where
    gets :: t -> Get (DList a)
gets t
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. DList a
DL.empty
    gets t
n = forall a. a -> DList a -> DList a
DL.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
dec forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> Get (DList a)
gets (t
n forall a. Num a => a -> a -> a
- t
1)

{-# INLINE dNatural #-}
dNatural :: Get Natural
dNatural :: Get Natural
dNatural = forall b. (Num b, Bits b) => Get b
dUnsigned

{-# INLINE dInteger #-}
dInteger :: Get Integer
dInteger :: Get Integer
dInteger = forall signed unsigned.
ZigZag signed unsigned =>
unsigned -> signed
zagZig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. (Num b, Bits b) => Get b
dUnsigned

{-# INLINE dWord #-}
{-# INLINE dInt #-}
dWord :: Get Word
dInt :: Get Int

#if WORD_SIZE_IN_BITS == 64
dWord :: Get Word
dWord = (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Word) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
dWord64

dInt :: Get Int
dInt = (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Int) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
dInt64
#elif WORD_SIZE_IN_BITS == 32
dWord = (fromIntegral :: Word32 -> Word) <$> dWord32

dInt = (fromIntegral :: Int32 -> Int) <$> dInt32
#else
#error expected WORD_SIZE_IN_BITS to be 32 or 64
#endif








{-# INLINE dInt8 #-}
dInt8 :: Get Int8
dInt8 :: Get Int8
dInt8 = forall signed unsigned.
ZigZag signed unsigned =>
unsigned -> signed
zagZig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
dWord8

{-# INLINE dInt16 #-}
dInt16 :: Get Int16
dInt16 :: Get Int16
dInt16 = forall signed unsigned.
ZigZag signed unsigned =>
unsigned -> signed
zagZig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
dWord16

{-# INLINE dInt32 #-}
dInt32 :: Get Int32
dInt32 :: Get Int32
dInt32 = forall signed unsigned.
ZigZag signed unsigned =>
unsigned -> signed
zagZig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
dWord32

{-# INLINE dInt64 #-}
dInt64 :: Get Int64
dInt64 :: Get Int64
dInt64 = forall signed unsigned.
ZigZag signed unsigned =>
unsigned -> signed
zagZig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
dWord64

-- {-# INLINE dWord16  #-}
dWord16 :: Get Word16
dWord16 :: Get Word16
dWord16 = forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep Int
0 (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep Int
7 (forall b. (FiniteBits b, Show b, Num b) => Int -> b -> Get b
lastStep Int
14)) Word16
0

-- {-# INLINE dWord32  #-}
dWord32 :: Get Word32
dWord32 :: Get Word32
dWord32 = forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep Int
0 (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep Int
7 (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep Int
14 (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep Int
21 (forall b. (FiniteBits b, Show b, Num b) => Int -> b -> Get b
lastStep Int
28)))) Word32
0

-- {-# INLINE dWord64  #-}
dWord64 :: Get Word64
dWord64 :: Get Word64
dWord64 =
  forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep
    Int
0
    (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep
       Int
7
       (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep
          Int
14
          (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep
             Int
21
             (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep
                Int
28
                (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep
                   Int
35
                   (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep
                      Int
42
                      (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep
                         Int
49
                         (forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep Int
56 (forall b. (FiniteBits b, Show b, Num b) => Int -> b -> Get b
lastStep Int
63)))))))))
    Word64
0

{-# INLINE dChar #-}
dChar :: Get Char
-- dChar = chr . fromIntegral <$> dWord32
-- Not really faster than the simpler version above
dChar :: Get Char
dChar = Int -> (Int -> Get Char) -> Int -> Get Char
charStep Int
0 (Int -> (Int -> Get Char) -> Int -> Get Char
charStep Int
7 (Int -> Int -> Get Char
lastCharStep Int
14)) Int
0

{-# INLINE charStep #-}
charStep :: Int -> (Int -> Get Char) -> Int -> Get Char
charStep :: Int -> (Int -> Get Char) -> Int -> Get Char
charStep !Int
shl !Int -> Get Char
cont !Int
n = do
  !Int
tw <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
dWord8
  let !w :: Int
w = Int
tw forall a. Bits a => a -> a -> a
.&. Int
127
  let !v :: Int
v = Int
n forall a. Bits a => a -> a -> a
.|. Int
w forall a. Bits a => a -> Int -> a
`shift` Int
shl
  if Int
tw forall a. Eq a => a -> a -> Bool
== Int
w
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
unsafeChr Int
v
    else Int -> Get Char
cont Int
v

{-# INLINE lastCharStep #-}
lastCharStep :: Int -> Int -> Get Char
lastCharStep :: Int -> Int -> Get Char
lastCharStep !Int
shl !Int
n = do
  !Int
tw <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
dWord8
  let !w :: Int
w = Int
tw forall a. Bits a => a -> a -> a
.&. Int
127
  let !v :: Int
v = Int
n forall a. Bits a => a -> a -> a
.|. Int
w forall a. Bits a => a -> Int -> a
`shift` Int
shl
  if Int
tw forall a. Eq a => a -> a -> Bool
== Int
w
    then if Int
v forall a. Ord a => a -> a -> Bool
> Int
0x10FFFF
           then forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
charErr Int
v
           else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
unsafeChr Int
v
    else forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
charErr Int
v
 where
  charErr :: a -> m a
charErr a
v = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unexpected extra byte or non unicode char" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v

{-# INLINE wordStep #-}
wordStep :: (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep :: forall a. (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a
wordStep Int
shl a -> Get a
k a
n = do
  a
tw <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
dWord8
  let w :: a
w = a
tw forall a. Bits a => a -> a -> a
.&. a
127
  let v :: a
v = a
n forall a. Bits a => a -> a -> a
.|. a
w forall a. Bits a => a -> Int -> a
`shift` Int
shl
  if a
tw forall a. Eq a => a -> a -> Bool
== a
w
    then forall (m :: * -> *) a. Monad m => a -> m a
return a
v
    --else oneShot k v
    else a -> Get a
k a
v

{-# INLINE lastStep #-}
lastStep :: (FiniteBits b, Show b, Num b) => Int -> b -> Get b
lastStep :: forall b. (FiniteBits b, Show b, Num b) => Int -> b -> Get b
lastStep Int
shl b
n = do
  b
tw <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
dWord8
  let w :: b
w = b
tw forall a. Bits a => a -> a -> a
.&. b
127
  let v :: b
v = b
n forall a. Bits a => a -> a -> a
.|. b
w forall a. Bits a => a -> Int -> a
`shift` Int
shl
  if b
tw forall a. Eq a => a -> a -> Bool
== b
w
    then if forall b. FiniteBits b => b -> Int
countLeadingZeros b
w forall a. Ord a => a -> a -> Bool
< Int
shl
           then forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
wordErr b
v
           else forall (m :: * -> *) a. Monad m => a -> m a
return b
v
    else forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
wordErr b
v
 where
   wordErr :: a -> m a
wordErr a
v = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unexpected extra byte in unsigned integer" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v

-- {-# INLINE dUnsigned #-}
dUnsigned :: (Num b, Bits b) => Get b
dUnsigned :: forall b. (Num b, Bits b) => Get b
dUnsigned = do
  (b
v, Int
shl) <- forall t. (Bits t, Num t) => Int -> t -> Get (t, Int)
dUnsigned_ Int
0 b
0
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall (m :: * -> *) a. Monad m => a -> m a
return b
v)
    (\Int
s ->
       if Int
shl forall a. Ord a => a -> a -> Bool
>= Int
s
         then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected extra data in unsigned integer"
         else forall (m :: * -> *) a. Monad m => a -> m a
return b
v) forall a b. (a -> b) -> a -> b
$
    forall a. Bits a => a -> Maybe Int
bitSizeMaybe b
v

-- {-# INLINE dUnsigned_ #-}
dUnsigned_ :: (Bits t, Num t) => Int -> t -> Get (t, Int)
dUnsigned_ :: forall t. (Bits t, Num t) => Int -> t -> Get (t, Int)
dUnsigned_ Int
shl t
n = do
  Word8
tw <- Get Word8
dWord8
  let w :: Word8
w = Word8
tw forall a. Bits a => a -> a -> a
.&. Word8
127
  let v :: t
v = t
n forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w forall a. Bits a => a -> Int -> a
`shift` Int
shl
  if Word8
tw forall a. Eq a => a -> a -> Bool
== Word8
w
    then forall (m :: * -> *) a. Monad m => a -> m a
return (t
v, Int
shl)
    else forall t. (Bits t, Num t) => Int -> t -> Get (t, Int)
dUnsigned_ (Int
shl forall a. Num a => a -> a -> a
+ Int
7) t
v

--encode = encode . blob UTF8Encoding . L.fromStrict . T.encodeUtf8
--decode = T.decodeUtf8 . L.toStrict . (unblob :: BLOB UTF8Encoding -> L.ByteString) <$> decode

#if ! defined (ETA_VERSION)
-- BLOB UTF16Encoding
dUTF16 :: Get T.Text
dUTF16 :: Get Text
dUTF16 = do
  ()
_ <- Get ()
dFiller
#if MIN_VERSION_text(2,0,0)
  -- Checked decoding (from UTF-8)
  T.decodeUtf16LE <$> dByteString_
#else
  -- Unchecked decoding (already UTF16)
  (ByteArray ByteArray#
array, Int
lengthInBytes) <- Get (ByteArray, Int)
dByteArray_
  forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
T.Text (ByteArray# -> Array
TA.Array ByteArray#
array) Int
0 (Int
lengthInBytes forall a. Integral a => a -> a -> a
`div` Int
2))
#endif
#endif

dUTF8 :: Get T.Text
dUTF8 :: Get Text
dUTF8 = do
  ()
_ <- Get ()
dFiller
  ByteString
bs <- Get ByteString
dByteString_
  case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
bs of
    Right Text
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
    Left UnicodeException
e  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Input contains invalid UTF-8 data" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show UnicodeException
e

dFiller :: Get ()
dFiller :: Get ()
dFiller = do
  Bool
tag <- Get Bool
dBool
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
tag Get ()
dFiller

dLazyByteString :: Get L.ByteString
dLazyByteString :: Get ByteString
dLazyByteString = Get ()
dFiller forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get ByteString
dLazyByteString_

dShortByteString :: Get SBS.ShortByteString
dShortByteString :: Get ShortByteString
dShortByteString = Get ()
dFiller forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get ShortByteString
dShortByteString_

dShortByteString_ :: Get SBS.ShortByteString
dShortByteString_ :: Get ShortByteString
dShortByteString_ = do
  (ByteArray ByteArray#
array, Int
_) <- Get (ByteArray, Int)
dByteArray_
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteArray# -> ShortByteString
SBS.SBS ByteArray#
array

dByteString :: Get B.ByteString
dByteString :: Get ByteString
dByteString = Get ()
dFiller forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get ByteString
dByteString_