{-# LANGUAGE TypeApplications #-}
module Data.PackStream.Serializer
(
  null, bool, integer, float,
  bytes, string, list, dict, structure,
  value
) where


import Data.PackStream.Internal.Type (Structure (..), Value (..))
import Data.PackStream.Internal.Code
import Data.PackStream.Internal.Binary (Serialize(..), inDepth)

import Prelude hiding (null)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (singleton, cons, append, length, concat, empty)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Map.Strict (Map, toList)
import Data.Word (Word8)


-- |Represent '()' as 'PackStream' 'ByteString'
null :: ByteString
null :: ByteString
null = Word8 -> ByteString
BS.singleton Word8
nullCode

-- |Represent 'Bool' as 'PackStream' 'ByteString'
bool :: Bool -> ByteString
bool :: Bool -> ByteString
bool Bool
False = Word8 -> ByteString
BS.singleton Word8
falseCode
bool Bool
True  = Word8 -> ByteString
BS.singleton Word8
trueCode

-- |Represent 'Int' as 'PackStream' 'ByteString'
integer :: Int -> ByteString
integer :: Int -> ByteString
integer Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
16 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
128 = Int -> ByteString
forall a. Serialize a => a -> ByteString
serialize Int
n
          | Int -> Int -> Bool
forall a. Integral a => Int -> a -> Bool
inDepth Int
8  Int
n        = Word8
int8Code  Word8 -> ByteString -> ByteString
`BS.cons` Int -> ByteString
forall a. Serialize a => a -> ByteString
serialize Int
n
          | Int -> Int -> Bool
forall a. Integral a => Int -> a -> Bool
inDepth Int
16 Int
n        = Word8
int16Code Word8 -> ByteString -> ByteString
`BS.cons` Int -> ByteString
forall a. Serialize a => a -> ByteString
serialize Int
n
          | Int -> Int -> Bool
forall a. Integral a => Int -> a -> Bool
inDepth Int
32 Int
n        = Word8
int32Code Word8 -> ByteString -> ByteString
`BS.cons` Int -> ByteString
forall a. Serialize a => a -> ByteString
serialize Int
n
          | Int -> Int -> Bool
forall a. Integral a => Int -> a -> Bool
inDepth Int
64 Int
n        = Word8
int64Code Word8 -> ByteString -> ByteString
`BS.cons` Int -> ByteString
forall a. Serialize a => a -> ByteString
serialize Int
n
          | Bool
otherwise           = ByteString
BS.empty

-- |Represent 'Double' as 'PackStream' 'ByteString'
float :: Double -> ByteString
float :: Double -> ByteString
float Double
x = Word8
floatCode Word8 -> ByteString -> ByteString
`BS.cons` Double -> ByteString
forall a. Serialize a => a -> ByteString
serialize Double
x

-- |Represent 'ByteString' as 'PackStream' 'ByteString'
bytes :: ByteString -> ByteString
bytes :: ByteString -> ByteString
bytes ByteString
bs = Maybe ByteString -> ByteString -> ByteString
constructCollection Maybe ByteString
mstart ByteString
bs
  where
    mstart :: Maybe ByteString
    mstart :: Maybe ByteString
mstart = (Word8 -> ByteString -> ByteString
`BS.cons` Int -> ByteString
serializeLen (ByteString -> Int
BS.length ByteString
bs)) (Word8 -> ByteString) -> Maybe Word8 -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word8
firstByte
  
    firstByte :: Maybe Word8
    firstByte :: Maybe Word8
firstByte | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFF       = Word8 -> Maybe Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
bytes8Code
              | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF     = Word8 -> Maybe Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
bytes16Code
              | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFFFFFF = Word8 -> Maybe Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
bytes32Code
              | Bool
otherwise                  = Maybe Word8
forall a. Maybe a
Nothing

-- |Represent 'Text' as 'PackStream' 'ByteString'
string :: Text -> ByteString
string :: Text -> ByteString
string Text
s = Maybe ByteString -> ByteString -> ByteString
constructCollection Maybe ByteString
mstart (Text -> ByteString
forall a. Serialize a => a -> ByteString
serialize Text
s)
  where
    mstart :: Maybe ByteString
    mstart :: Maybe ByteString
mstart = Word8 -> Word8 -> Word8 -> Word8 -> Int -> Maybe ByteString
firstBytes Word8
stringTinyCode Word8
string8Code Word8
string16Code Word8
string32Code (ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
s)

-- |Represent '[Value]' as 'PackStream' 'ByteString'
list :: [Value] -> ByteString
list :: [Value] -> ByteString
list [Value]
l = Maybe ByteString -> ByteString -> ByteString
constructCollection Maybe ByteString
mstart ([ByteString] -> ByteString
BS.concat (Value -> ByteString
value (Value -> ByteString) -> [Value] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
l))
  where
    mstart :: Maybe ByteString
    mstart :: Maybe ByteString
mstart = Word8 -> Word8 -> Word8 -> Word8 -> Int -> Maybe ByteString
firstBytes Word8
listTinyCode Word8
list8Code Word8
list16Code Word8
list32Code ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
l)

-- |Represent 'Map Text Value' as 'PackStream' 'ByteString'
dict :: Map Text Value -> ByteString
dict :: Map Text Value -> ByteString
dict Map Text Value
d = Maybe ByteString -> ByteString -> ByteString
constructCollection Maybe ByteString
mstart ([ByteString] -> ByteString
BS.concat ((Text, Value) -> ByteString
kvs ((Text, Value) -> ByteString) -> [(Text, Value)] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
toList Map Text Value
d))
  where
    mstart :: Maybe ByteString
    mstart :: Maybe ByteString
mstart = Word8 -> Word8 -> Word8 -> Word8 -> Int -> Maybe ByteString
firstBytes Word8
dictTinyCode Word8
dict8Code Word8
dict16Code Word8
dict32Code (Map Text Value -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map Text Value
d)

    kvs :: (Text, Value) -> ByteString
    kvs :: (Text, Value) -> ByteString
kvs (Text
k, Value
v) = Text -> ByteString
string Text
k ByteString -> ByteString -> ByteString
`BS.append` Value -> ByteString
value Value
v

-- |Represent 'Structure' as 'PackStream' 'ByteString'
structure :: Structure -> ByteString
structure :: Structure -> ByteString
structure Structure
s | Word8
len Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
16  = Word8
structureCode Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
len Word8 -> ByteString -> ByteString
`BS.cons` Structure -> Word8
signature Structure
s Word8 -> ByteString -> ByteString
`BS.cons` [ByteString] -> ByteString
BS.concat (Value -> ByteString
value (Value -> ByteString) -> [Value] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Structure -> [Value]
fields Structure
s)
            | Bool
otherwise = ByteString
BS.empty
  where
    len :: Word8
len = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Value] -> Int) -> [Value] -> Int
forall a b. (a -> b) -> a -> b
$ Structure -> [Value]
fields Structure
s

-- |Represent 'Value' as 'PackStream' 'ByteString'
value :: Value -> ByteString
value :: Value -> ByteString
value Value
N     = ByteString
null
value (B Bool
b) = Bool -> ByteString
bool Bool
b
value (I Int
i) = Int -> ByteString
integer Int
i
value (F Double
f) = Double -> ByteString
float Double
f
value (U ByteString
u) = ByteString -> ByteString
bytes ByteString
u
value (T Text
t) = Text -> ByteString
string Text
t
value (L [Value]
l) = [Value] -> ByteString
list [Value]
l
value (D Map Text Value
d) = Map Text Value -> ByteString
dict Map Text Value
d
value (S Structure
s) = Structure -> ByteString
structure Structure
s

-- Helper functions

constructCollection :: Maybe ByteString -> ByteString -> ByteString
constructCollection :: Maybe ByteString -> ByteString -> ByteString
constructCollection Maybe ByteString
mstart ByteString
end = case Maybe ByteString
mstart of
                                   Just ByteString
start -> ByteString
start ByteString -> ByteString -> ByteString
`BS.append` ByteString
end
                                   Maybe ByteString
Nothing    -> ByteString
BS.empty

firstBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Int -> Maybe ByteString
firstBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Int -> Maybe ByteString
firstBytes Word8
bt Word8
b8 Word8
b16 Word8
b32 Int
len | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xF        = ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString
BS.singleton (Word8 -> ByteString) -> Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8
bt  Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
                             | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFF       = ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Word8
b8  Word8 -> ByteString -> ByteString
`BS.cons` Int -> ByteString
serializeLen Int
len
                             | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF     = ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Word8
b16 Word8 -> ByteString -> ByteString
`BS.cons` Int -> ByteString
serializeLen Int
len
                             | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFFFFFF = ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Word8
b32 Word8 -> ByteString -> ByteString
`BS.cons` Int -> ByteString
serializeLen Int
len
                             | Bool
otherwise         = Maybe ByteString
forall a. Maybe a
Nothing

serializeLen :: Int -> ByteString
serializeLen :: Int -> ByteString
serializeLen = Serialize Word => Word -> ByteString
forall a. Serialize a => a -> ByteString
serialize @Word (Word -> ByteString) -> (Int -> Word) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral