{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

--
-- (c) The University of Glasgow 2002-2006
--
-- Serialized values

module GHC.Serialized (
    -- * Main Serialized data type
    Serialized(..),

    -- * Going into and out of 'Serialized'
    toSerialized, fromSerialized,

    -- * Handy serialization functions
    serializeWithData, deserializeWithData,
  ) where

import Prelude -- See note [Why do we import Prelude here?]
import Data.Bits
import Data.Word        ( Word8 )
import Data.Data


-- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types
data Serialized = Serialized TypeRep [Word8]

-- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later
toSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized
toSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized
toSerialized a -> [Word8]
serialize a
what = TypeRep -> [Word8] -> Serialized
Serialized (forall a. Typeable a => a -> TypeRep
typeOf a
what) (a -> [Word8]
serialize a
what)

-- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that.
-- Otherwise return @Nothing@.
fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a
fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a
fromSerialized [Word8] -> a
deserialize (Serialized TypeRep
the_type [Word8]
bytes)
  | TypeRep
the_type forall a. Eq a => a -> a -> Bool
== TypeRep
rep = forall a. a -> Maybe a
Just ([Word8] -> a
deserialize [Word8]
bytes)
  | Bool
otherwise       = forall a. Maybe a
Nothing
  where rep :: TypeRep
rep = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

-- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData'
serializeWithData :: Data a => a -> [Word8]
serializeWithData :: forall a. Data a => a -> [Word8]
serializeWithData a
what = forall a. Data a => a -> [Word8] -> [Word8]
serializeWithData' a
what []

serializeWithData' :: Data a => a -> [Word8] -> [Word8]
serializeWithData' :: forall a. Data a => a -> [Word8] -> [Word8]
serializeWithData' a
what = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl (\([Word8] -> [Word8]
before, d -> b
a_to_b) d
a -> ([Word8] -> [Word8]
before forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> [Word8] -> [Word8]
serializeWithData' d
a, d -> b
a_to_b d
a))
                                       (\g
x -> (ConstrRep -> [Word8] -> [Word8]
serializeConstr (Constr -> ConstrRep
constrRep (forall a. Data a => a -> Constr
toConstr a
what)), g
x))
                                       a
what

-- | Use a 'Data' instance to implement a deserialization scheme dual to that of 'serializeWithData'
deserializeWithData :: Data a => [Word8] -> a
deserializeWithData :: forall a. Data a => [Word8] -> a
deserializeWithData = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => [Word8] -> ([Word8], a)
deserializeWithData'

deserializeWithData' :: forall a. Data a => [Word8] -> ([Word8], a)
deserializeWithData' :: forall a. Data a => [Word8] -> ([Word8], a)
deserializeWithData' [Word8]
bytes = forall a. [Word8] -> (ConstrRep -> [Word8] -> a) -> a
deserializeConstr [Word8]
bytes forall a b. (a -> b) -> a -> b
$ \ConstrRep
constr_rep [Word8]
bytes ->
                             forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a
gunfold (\([Word8]
bytes, b -> r
b_to_r) -> let ([Word8]
bytes', b
b) = forall a. Data a => [Word8] -> ([Word8], a)
deserializeWithData' [Word8]
bytes in ([Word8]
bytes', b -> r
b_to_r b
b))
                                     (\r
x -> ([Word8]
bytes, r
x))
                                     (DataType -> ConstrRep -> Constr
repConstr (forall a. Data a => a -> DataType
dataTypeOf (forall a. HasCallStack => a
undefined :: a)) ConstrRep
constr_rep)


serializeConstr :: ConstrRep -> [Word8] -> [Word8]
serializeConstr :: ConstrRep -> [Word8] -> [Word8]
serializeConstr (AlgConstr Int
ix)   = Word8 -> [Word8] -> [Word8]
serializeWord8 Word8
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
serializeInt Int
ix
serializeConstr (IntConstr Integer
i)    = Word8 -> [Word8] -> [Word8]
serializeWord8 Word8
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Word8] -> [Word8]
serializeInteger Integer
i
serializeConstr (FloatConstr Rational
r)  = Word8 -> [Word8] -> [Word8]
serializeWord8 Word8
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> [Word8] -> [Word8]
serializeRational Rational
r
serializeConstr (CharConstr Char
c)   = Word8 -> [Word8] -> [Word8]
serializeWord8 Word8
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Word8] -> [Word8]
serializeChar Char
c


deserializeConstr :: [Word8] -> (ConstrRep -> [Word8] -> a) -> a
deserializeConstr :: forall a. [Word8] -> (ConstrRep -> [Word8] -> a) -> a
deserializeConstr [Word8]
bytes ConstrRep -> [Word8] -> a
k = forall a. [Word8] -> (Word8 -> [Word8] -> a) -> a
deserializeWord8 [Word8]
bytes forall a b. (a -> b) -> a -> b
$ \Word8
constr_ix [Word8]
bytes ->
                            case Word8
constr_ix of
                                Word8
1 -> forall a. [Word8] -> (Int -> [Word8] -> a) -> a
deserializeInt      [Word8]
bytes forall a b. (a -> b) -> a -> b
$ \Int
ix -> ConstrRep -> [Word8] -> a
k (Int -> ConstrRep
AlgConstr Int
ix)
                                Word8
2 -> forall a. [Word8] -> (Integer -> [Word8] -> a) -> a
deserializeInteger  [Word8]
bytes forall a b. (a -> b) -> a -> b
$ \Integer
i  -> ConstrRep -> [Word8] -> a
k (Integer -> ConstrRep
IntConstr Integer
i)
                                Word8
3 -> forall a b. Fractional a => [Word8] -> (a -> [Word8] -> b) -> b
deserializeRational [Word8]
bytes forall a b. (a -> b) -> a -> b
$ \Rational
r  -> ConstrRep -> [Word8] -> a
k (Rational -> ConstrRep
FloatConstr Rational
r)
                                Word8
4 -> forall a. [Word8] -> (Char -> [Word8] -> a) -> a
deserializeChar     [Word8]
bytes forall a b. (a -> b) -> a -> b
$ \Char
c  -> ConstrRep -> [Word8] -> a
k (Char -> ConstrRep
CharConstr Char
c)
                                Word8
x -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"deserializeConstr: unrecognised serialized constructor type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
x forall a. [a] -> [a] -> [a]
++ [Char]
" in context " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Word8]
bytes


serializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]
serializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]
serializeFixedWidthNum a
what = Int -> a -> [Word8] -> [Word8]
go (forall b. FiniteBits b => b -> Int
finiteBitSize a
what) a
what
  where
    go :: Int -> a -> [Word8] -> [Word8]
    go :: Int -> a -> [Word8] -> [Word8]
go Int
size a
current [Word8]
rest
      | Int
size forall a. Ord a => a -> a -> Bool
<= Int
0 = [Word8]
rest
      | Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
current forall a. Bits a => a -> a -> a
.&. a
255) forall a. a -> [a] -> [a]
: Int -> a -> [Word8] -> [Word8]
go (Int
size forall a. Num a => a -> a -> a
- Int
8) (a
current forall a. Bits a => a -> Int -> a
`shiftR` Int
8) [Word8]
rest

deserializeFixedWidthNum :: forall a b. (Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b
deserializeFixedWidthNum :: forall a b.
(Integral a, FiniteBits a) =>
[Word8] -> (a -> [Word8] -> b) -> b
deserializeFixedWidthNum [Word8]
bytes a -> [Word8] -> b
k = Int -> [Word8] -> (a -> [Word8] -> b) -> b
go (forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: a)) [Word8]
bytes a -> [Word8] -> b
k
  where
    go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b
    go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b
go Int
size [Word8]
bytes a -> [Word8] -> b
k
      | Int
size forall a. Ord a => a -> a -> Bool
<= Int
0 = a -> [Word8] -> b
k a
0 [Word8]
bytes
      | Bool
otherwise = case [Word8]
bytes of
                        (Word8
byte:[Word8]
bytes) -> Int -> [Word8] -> (a -> [Word8] -> b) -> b
go (Int
size forall a. Num a => a -> a -> a
- Int
8) [Word8]
bytes (\a
x -> a -> [Word8] -> b
k ((a
x forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte))
                        []           -> forall a. HasCallStack => [Char] -> a
error [Char]
"deserializeFixedWidthNum: unexpected end of stream"


serializeEnum :: (Enum a) => a -> [Word8] -> [Word8]
serializeEnum :: forall a. Enum a => a -> [Word8] -> [Word8]
serializeEnum = Int -> [Word8] -> [Word8]
serializeInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

deserializeEnum :: Enum a => [Word8] -> (a -> [Word8] -> b) -> b
deserializeEnum :: forall a b. Enum a => [Word8] -> (a -> [Word8] -> b) -> b
deserializeEnum [Word8]
bytes a -> [Word8] -> b
k = forall a. [Word8] -> (Int -> [Word8] -> a) -> a
deserializeInt [Word8]
bytes (a -> [Word8] -> b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum)


serializeWord8 :: Word8 -> [Word8] -> [Word8]
serializeWord8 :: Word8 -> [Word8] -> [Word8]
serializeWord8 Word8
x = (Word8
xforall a. a -> [a] -> [a]
:)

deserializeWord8 :: [Word8] -> (Word8 -> [Word8] -> a) -> a
deserializeWord8 :: forall a. [Word8] -> (Word8 -> [Word8] -> a) -> a
deserializeWord8 (Word8
byte:[Word8]
bytes) Word8 -> [Word8] -> a
k = Word8 -> [Word8] -> a
k Word8
byte [Word8]
bytes
deserializeWord8 []           Word8 -> [Word8] -> a
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"deserializeWord8: unexpected end of stream"


serializeInt :: Int -> [Word8] -> [Word8]
serializeInt :: Int -> [Word8] -> [Word8]
serializeInt = forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]
serializeFixedWidthNum

deserializeInt :: [Word8] -> (Int -> [Word8] -> a) -> a
deserializeInt :: forall a. [Word8] -> (Int -> [Word8] -> a) -> a
deserializeInt = forall a b.
(Integral a, FiniteBits a) =>
[Word8] -> (a -> [Word8] -> b) -> b
deserializeFixedWidthNum


serializeRational :: (Real a) => a -> [Word8] -> [Word8]
serializeRational :: forall a. Real a => a -> [Word8] -> [Word8]
serializeRational = [Char] -> [Word8] -> [Word8]
serializeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational

deserializeRational :: (Fractional a) => [Word8] -> (a -> [Word8] -> b) -> b
deserializeRational :: forall a b. Fractional a => [Word8] -> (a -> [Word8] -> b) -> b
deserializeRational [Word8]
bytes a -> [Word8] -> b
k = forall a. [Word8] -> ([Char] -> [Word8] -> a) -> a
deserializeString [Word8]
bytes (a -> [Word8] -> b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> a
read)


serializeInteger :: Integer -> [Word8] -> [Word8]
serializeInteger :: Integer -> [Word8] -> [Word8]
serializeInteger = [Char] -> [Word8] -> [Word8]
serializeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

deserializeInteger :: [Word8] -> (Integer -> [Word8] -> a) -> a
deserializeInteger :: forall a. [Word8] -> (Integer -> [Word8] -> a) -> a
deserializeInteger [Word8]
bytes Integer -> [Word8] -> a
k = forall a. [Word8] -> ([Char] -> [Word8] -> a) -> a
deserializeString [Word8]
bytes (Integer -> [Word8] -> a
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> a
read)


serializeChar :: Char -> [Word8] -> [Word8]
serializeChar :: Char -> [Word8] -> [Word8]
serializeChar = [Char] -> [Word8] -> [Word8]
serializeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

deserializeChar :: [Word8] -> (Char -> [Word8] -> a) -> a
deserializeChar :: forall a. [Word8] -> (Char -> [Word8] -> a) -> a
deserializeChar [Word8]
bytes Char -> [Word8] -> a
k = forall a. [Word8] -> ([Char] -> [Word8] -> a) -> a
deserializeString [Word8]
bytes (Char -> [Word8] -> a
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> a
read)


serializeString :: String -> [Word8] -> [Word8]
serializeString :: [Char] -> [Word8] -> [Word8]
serializeString = forall a. (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]
serializeList forall a. Enum a => a -> [Word8] -> [Word8]
serializeEnum

deserializeString :: [Word8] -> (String -> [Word8] -> a) -> a
deserializeString :: forall a. [Word8] -> ([Char] -> [Word8] -> a) -> a
deserializeString = forall a b.
(forall c. [Word8] -> (a -> [Word8] -> c) -> c)
-> [Word8] -> ([a] -> [Word8] -> b) -> b
deserializeList forall a b. Enum a => [Word8] -> (a -> [Word8] -> b) -> b
deserializeEnum


serializeList :: (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]
serializeList :: forall a. (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]
serializeList a -> [Word8] -> [Word8]
serialize_element [a]
xs = Int -> [Word8] -> [Word8]
serializeInt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map a -> [Word8] -> [Word8]
serialize_element [a]
xs)

deserializeList :: forall a b. (forall c. [Word8] -> (a -> [Word8] -> c) -> c)
                -> [Word8] -> ([a] -> [Word8] -> b) -> b
deserializeList :: forall a b.
(forall c. [Word8] -> (a -> [Word8] -> c) -> c)
-> [Word8] -> ([a] -> [Word8] -> b) -> b
deserializeList forall c. [Word8] -> (a -> [Word8] -> c) -> c
deserialize_element [Word8]
bytes [a] -> [Word8] -> b
k = forall a. [Word8] -> (Int -> [Word8] -> a) -> a
deserializeInt [Word8]
bytes forall a b. (a -> b) -> a -> b
$ \Int
len [Word8]
bytes -> Int -> [Word8] -> ([a] -> [Word8] -> b) -> b
go Int
len [Word8]
bytes [a] -> [Word8] -> b
k
  where
    go :: Int -> [Word8] -> ([a] -> [Word8] -> b) -> b
    go :: Int -> [Word8] -> ([a] -> [Word8] -> b) -> b
go Int
len [Word8]
bytes [a] -> [Word8] -> b
k
      | Int
len forall a. Ord a => a -> a -> Bool
<= Int
0  = [a] -> [Word8] -> b
k [] [Word8]
bytes
      | Bool
otherwise = forall c. [Word8] -> (a -> [Word8] -> c) -> c
deserialize_element [Word8]
bytes (\a
elt [Word8]
bytes -> Int -> [Word8] -> ([a] -> [Word8] -> b) -> b
go (Int
len forall a. Num a => a -> a -> a
- Int
1) [Word8]
bytes ([a] -> [Word8] -> b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
eltforall a. a -> [a] -> [a]
:)))