Serialized.hs 6.88 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
--
-- (c) The University of Glasgow 2002-2006
--
-- Serialized values

{-# LANGUAGE ScopedTypeVariables #-}
module Serialized (
    -- * Main Serialized data type
    Serialized,
    seqSerialized,
    
    -- * Going into and out of 'Serialized'
    toSerialized, fromSerialized,
    
    -- * Handy serialization functions
    serializeWithData, deserializeWithData,
  ) where

import Binary
import Outputable
import FastString
import Util

import Data.Bits
import Data.Word        ( Word8 )

#if __GLASGOW_HASKELL__ > 609
import Data.Data
#else
import Data.Generics
#endif
import Data.Typeable


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

instance Outputable Serialized where
    ppr (Serialized the_type bytes) = int (length bytes) <+> ptext (sLit "of type") <+> text (show the_type)

instance Binary Serialized where
    put_ bh (Serialized the_type bytes) = do
        put_ bh the_type
        put_ bh bytes
    get bh = do
        the_type <- get bh
        bytes <- get bh
        return (Serialized the_type bytes)

-- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later
toSerialized :: Typeable a => (a -> [Word8]) -> a -> Serialized
toSerialized serialize what = Serialized (typeOf what) (serialize 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 deserialize (Serialized the_type bytes)
  | the_type == typeOf (undefined :: a) = Just (deserialize bytes)
  | otherwise                           = Nothing

-- | Force the contents of the Serialized value so weknow it doesn't contain any bottoms
seqSerialized :: Serialized -> ()
seqSerialized (Serialized the_type bytes) = the_type `seq` bytes `seqList` ()


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

serializeWithData' :: Data a => a -> [Word8] -> [Word8]
serializeWithData' what = fst $ gfoldl (\(before, a_to_b) a -> (before . serializeWithData' a, a_to_b a))
                                       (\x -> (serializeConstr (constrRep (toConstr what)), x))
                                       what

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

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


serializeConstr :: ConstrRep -> [Word8] -> [Word8]
serializeConstr (AlgConstr ix)   = serializeWord8 1 . serializeInt ix
serializeConstr (IntConstr i)    = serializeWord8 2 . serializeInteger i
89
serializeConstr (FloatConstr r)  = serializeWord8 3 . serializeRational r
90 91 92 93 94
serializeConstr (StringConstr s) = serializeWord8 4 . serializeString s

deserializeConstr :: [Word8] -> (ConstrRep -> [Word8] -> a) -> a
deserializeConstr bytes k = deserializeWord8 bytes $ \constr_ix bytes ->
                            case constr_ix of
95 96 97 98
                                1 -> deserializeInt      bytes $ \ix -> k (AlgConstr ix)
                                2 -> deserializeInteger  bytes $ \i  -> k (IntConstr i)
                                3 -> deserializeRational bytes $ \r  -> k (FloatConstr r)
                                4 -> deserializeString   bytes $ \s  -> k (StringConstr s)
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
                                x -> error $ "deserializeConstr: unrecognised serialized constructor type " ++ show x ++ " in context " ++ show bytes


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

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


serializeEnum :: (Enum a) => a -> [Word8] -> [Word8]
serializeEnum = serializeInt . fromEnum

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


serializeWord8 :: Word8 -> [Word8] -> [Word8]
serializeWord8 x = (x:)

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


serializeInt :: Int -> [Word8] -> [Word8]
serializeInt = serializeFixedWidthNum

deserializeInt :: [Word8] -> (Int -> [Word8] -> a) -> a
deserializeInt = deserializeFixedWidthNum


143 144
serializeRational :: (Real a) => a -> [Word8] -> [Word8]
serializeRational = serializeString . show . toRational
145

146 147
deserializeRational :: (Fractional a) => [Word8] -> (a -> [Word8] -> b) -> b
deserializeRational bytes k = deserializeString bytes (k . fromRational . read)
148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173


serializeInteger :: Integer -> [Word8] -> [Word8]
serializeInteger = serializeString . show

deserializeInteger :: [Word8] -> (Integer -> [Word8] -> a) -> a
deserializeInteger bytes k = deserializeString bytes (k . read)


serializeString :: String -> [Word8] -> [Word8]
serializeString = serializeList serializeEnum

deserializeString :: [Word8] -> (String -> [Word8] -> a) -> a
deserializeString = deserializeList deserializeEnum


serializeList :: (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]
serializeList serialize_element xs = serializeInt (length xs) . foldr (.) id (map serialize_element xs)

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