-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE ScopedTypeVariables #-}
{- | This module implements a Serialize class and serializers for basic types.

    It duplicates a lot from the standard Serialize class, but this one at
    least is under my control.  The other one is not guaranteed to remain
    compatible.  Of course, it's unlikely to change incompatibly and I use it
    myself rather than re-implementing String and Integer encoding, but that's
    the theory anyway.

    At the least it lets me use a direct float encoding rather than hacking
    around the large and buggy default implementation.
-}
module Util.Serialize (
    encode, decode
    , Serialize(..)
    , Get, Put
    -- * magic
    , Magic(..)
    , magicBytes
    , serialize, serialize_rotate
    , UnserializeError(..)
    , unserialize
    -- * util
    , get_tag, put_tag, bad_tag
    , get_enum, put_enum, bad_enum
    , get_enum_unsafe, put_enum_unsafe
    -- * versions
    , get_version, put_version, bad_version
) where
import qualified Control.Exception as Exception
import qualified Data.Array.IArray as IArray
import qualified Data.ByteString as ByteString
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Int as Int
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Serialize as Serialize
import           Data.Serialize (getWord8, putWord8, Get, Put)
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text.Encoding
import qualified Data.Time as Time
import qualified Data.Vector as Vector
import qualified Data.Vector.Storable as Vector.Storable
import qualified Data.Vector.Unboxed as Unboxed
import qualified Data.Word as Word

import qualified Foreign
import qualified GHC.Float as Float
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath
import qualified System.IO.Error as IO.Error

import qualified Util.CallStack as CallStack
import qualified Util.Files as Files

import           Global


encode :: Serialize a => a -> ByteString
encode :: forall a. Serialize a => a -> ByteString
encode = Put -> ByteString
Serialize.runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => Putter a
put

decode :: Serialize a => ByteString -> Either String a
decode :: forall a. Serialize a => ByteString -> Either String a
decode = forall a. Get a -> ByteString -> Either String a
Serialize.runGet forall a. Serialize a => Get a
get

class Serialize a where
    put :: Serialize.Putter a
    get :: Get a

-- * magic

-- | This is a four byte prefix to identify a particular file type, tagged with
-- the serialized type.  The Chars are just for syntactic convenience only, and
-- must be ASCII.
--
-- The constructor is not exported, so all magics have to be defined here,
-- which should make it easy to avoid collisions.
data Magic a = Magic !Char !Char !Char !Char deriving (Int -> Magic a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> Magic a -> ShowS
forall k (a :: k). [Magic a] -> ShowS
forall k (a :: k). Magic a -> String
showList :: [Magic a] -> ShowS
$cshowList :: forall k (a :: k). [Magic a] -> ShowS
show :: Magic a -> String
$cshow :: forall k (a :: k). Magic a -> String
showsPrec :: Int -> Magic a -> ShowS
$cshowsPrec :: forall k (a :: k). Int -> Magic a -> ShowS
Show)

magicBytes :: Magic a -> ByteString
magicBytes :: forall {k} (a :: k). Magic a -> ByteString
magicBytes (Magic Char
c1 Char
c2 Char
c3 Char
c4) = String -> ByteString
Char8.pack [Char
c1, Char
c2, Char
c3, Char
c4]

magicLength :: Int
magicLength :: Int
magicLength = Int
4

serialize :: Serialize a => Magic a -> FilePath -> a -> IO Bool
    -- ^ result of 'Files.writeGz'.
serialize :: forall a. Serialize a => Magic a -> String -> a -> IO Bool
serialize = forall a. Serialize a => Int -> Magic a -> String -> a -> IO Bool
serialize_rotate Int
1

serialize_rotate :: Serialize a => Int -> Magic a -> FilePath -> a -> IO Bool
serialize_rotate :: forall a. Serialize a => Int -> Magic a -> String -> a -> IO Bool
serialize_rotate Int
rotations Magic a
magic String
fname a
state = do
    Bool -> String -> IO ()
Directory.createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ ShowS
FilePath.takeDirectory String
fname
    Int -> String -> ByteString -> IO Bool
Files.writeGz Int
rotations String
fname forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). Magic a -> ByteString
magicBytes Magic a
magic forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode a
state

data UnserializeError = BadMagic ByteString ByteString
    | IOError IO.Error.IOError | UnserializeError String
    deriving (Int -> UnserializeError -> ShowS
[UnserializeError] -> ShowS
UnserializeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnserializeError] -> ShowS
$cshowList :: [UnserializeError] -> ShowS
show :: UnserializeError -> String
$cshow :: UnserializeError -> String
showsPrec :: Int -> UnserializeError -> ShowS
$cshowsPrec :: Int -> UnserializeError -> ShowS
Show)

unserialize :: Serialize a => Magic a -> FilePath
    -> IO (Either UnserializeError a)
unserialize :: forall a.
Serialize a =>
Magic a -> String -> IO (Either UnserializeError a)
unserialize Magic a
magic String
fname = forall {b}.
IO (Either UnserializeError b) -> IO (Either UnserializeError b)
catch forall a b. (a -> b) -> a -> b
$ do
    ByteString
bytes <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a e. Exception e => e -> a
Exception.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
IO.Error.userError) forall (m :: * -> *) a. Monad m => a -> m a
return
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Either String ByteString)
Files.readGz String
fname
    let (ByteString
file_magic, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Int
magicLength ByteString
bytes
    if ByteString
file_magic forall a. Eq a => a -> a -> Bool
/= forall {k} (a :: k). Magic a -> ByteString
magicBytes Magic a
magic
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> UnserializeError
BadMagic (forall {k} (a :: k). Magic a -> ByteString
magicBytes Magic a
magic) ByteString
file_magic
        else forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> UnserializeError
UnserializeError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO a
Exception.evaluate (forall a. Serialize a => ByteString -> Either String a
decode ByteString
rest)
            -- Apparently decode can still throw an exception unless
            -- the contents of the Either is forced to whnf.
    where catch :: IO (Either UnserializeError b) -> IO (Either UnserializeError b)
catch = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> UnserializeError
IOError) forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
Exception.try

instance Pretty UnserializeError where
    pretty :: UnserializeError -> Text
pretty UnserializeError
e = case UnserializeError
e of
        BadMagic ByteString
expected ByteString
got -> Text
"expected file magic " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt ByteString
expected
            forall a. Semigroup a => a -> a -> a
<> Text
" but got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt ByteString
got
        IOError IOError
exc -> Text
"io error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt IOError
exc
        UnserializeError String
err -> Text
"unserialize error: " forall a. Semigroup a => a -> a -> a
<> String -> Text
txt String
err

-- * numeric

instance Serialize Integer where
    put :: Putter Integer
put = forall t. Serialize t => Putter t
Serialize.put
    get :: Get Integer
get = forall t. Serialize t => Get t
Serialize.get

instance Serialize Int where
    put :: Putter Int
put Int
i = forall a. Serialize a => Putter a
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Int.Int64)
    get :: Get Int
get = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Serialize a => Get a
get :: Get Int.Int64)

instance Serialize Int.Int64 where
    put :: Putter Int64
put Int64
i = forall a. Serialize a => Putter a
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i :: Word.Word64)
    get :: Get Int64
get = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Serialize a => Get a
get :: Get Word.Word64)

instance Serialize Word.Word8 where
    put :: Putter Word8
put = Putter Word8
putWord8
    get :: Get Word8
get = Get Word8
getWord8

instance Serialize Word.Word32 where
    put :: Putter Word32
put = Putter Word32
Serialize.putWord32le
    get :: Get Word32
get = Get Word32
Serialize.getWord32le

instance Serialize Word.Word64 where
    put :: Putter Word64
put = Putter Word64
Serialize.putWord64le
    get :: Get Word64
get = Get Word64
Serialize.getWord64le

instance Serialize Double where
    put :: Putter Double
put = forall a. Serialize a => Putter a
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
Float.castDoubleToWord64
    get :: Get Double
get = Word64 -> Double
Float.castWord64ToDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get

instance Serialize Float where
    put :: Putter Float
put = forall a. Serialize a => Putter a
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
Float.castFloatToWord32
    get :: Get Float
get = Word32 -> Float
Float.castWord32ToFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get

-- * util

get_tag :: Get Word.Word8
get_tag :: Get Word8
get_tag = Get Word8
getWord8

put_tag :: Word.Word8 -> Put
put_tag :: Putter Word8
put_tag = Putter Word8
putWord8

bad_tag :: String -> Word.Word8 -> Get a
bad_tag :: forall a. String -> Word8 -> Get a
bad_tag String
typ Word8
tag = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unknown tag for " forall a. [a] -> [a] -> [a]
++ String
typ forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
tag

-- | These are convenient but dangerous.  If they are are used in a context
-- where backward compatibility matters ("Cmd.Serialize") then it's too easy
-- to break compatibility by adding or removing an enum.
--
-- But they're fine if used in an enum that will never change, or where
-- compatibility doesn't matter.
get_enum_unsafe :: (Bounded a, Enum a) => Serialize.Get a
get_enum_unsafe :: forall a. (Bounded a, Enum a) => Get a
get_enum_unsafe = forall a. Serialize a => Get a
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n ->
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"enum value out of range: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n) forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. (Enum a, Bounded a) => Int -> Maybe a
to_enum Int
n)

put_enum_unsafe :: Enum a => a -> Serialize.Put
put_enum_unsafe :: forall a. Enum a => a -> Put
put_enum_unsafe = forall a. Serialize a => Putter a
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

-- | A safe version of 'toEnum'.
to_enum :: forall a. (Enum a, Bounded a) => Int -> Maybe a
to_enum :: forall a. (Enum a, Bounded a) => Int -> Maybe a
to_enum Int
n
    | forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: a) forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: a) =
        forall a. a -> Maybe a
Just (forall a. Enum a => Int -> a
toEnum Int
n)
    | Bool
otherwise = forall a. Maybe a
Nothing

get_enum :: Serialize.Get Word.Word8
get_enum :: Get Word8
get_enum = forall a. Serialize a => Get a
get

-- | It's just put, but make sure it's using Int.  Word8 would be more
-- suitable.
put_enum :: Word.Word8 -> Serialize.Put
put_enum :: Putter Word8
put_enum = forall a. Serialize a => Putter a
put

bad_enum :: String -> Word.Word8 -> Get a
bad_enum :: forall a. String -> Word8 -> Get a
bad_enum String
name Word8
val = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unknown enum val for " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word8
val

-- * basic types

instance Serialize () where
    put :: Putter ()
put () = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    get :: Get ()
get = forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Serialize Bool where
    put :: Putter Bool
put Bool
False = Putter Word8
put_tag Word8
0
    put Bool
True = Putter Word8
put_tag Word8
1
    get :: Get Bool
get = (forall a. Eq a => a -> a -> Bool
/= Word8
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
get_tag

instance Serialize Char where
    put :: Putter Char
put = forall t. Serialize t => Putter t
Serialize.put
    get :: Get Char
get = forall t. Serialize t => Get t
Serialize.get

instance Serialize Time.UTCTime where
    put :: Putter UTCTime
put UTCTime
time = forall a. Serialize a => Putter a
put (forall a. Show a => a -> String
show UTCTime
time)
    get :: Get UTCTime
get = forall a. Serialize a => Get a
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read

-- * sums and products

instance (Serialize a, Serialize b) => Serialize (Either a b) where
    put :: Putter (Either a b)
put (Left a
a) = Putter Word8
put_tag Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put a
a
    put (Right b
b) = Putter Word8
put_tag Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put b
b
    get :: Get (Either a b)
get = Get Word8
get_tag forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get
        Word8
1 -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get
        Word8
tag -> forall a. String -> Word8 -> Get a
bad_tag String
"Either" Word8
tag

instance Serialize a => Serialize (Maybe a) where
    put :: Putter (Maybe a)
put Maybe a
Nothing = Putter Word8
put_tag Word8
0
    put (Just a
a) = Putter Word8
put_tag Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put a
a
    get :: Get (Maybe a)
get = Get Word8
get_tag forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Word8
1 -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get
        Word8
tag -> forall a. String -> Word8 -> Get a
bad_tag String
"Maybe" Word8
tag

instance (Serialize a, Serialize b) => Serialize (a, b) where
    put :: Putter (a, b)
put (a
a, b
b) = forall a. Serialize a => Putter a
put a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put b
b
    get :: Get (a, b)
get = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get

instance (Serialize a, Serialize b, Serialize c) => Serialize (a, b, c) where
    put :: Putter (a, b, c)
put (a
a, b
b, c
c) = forall a. Serialize a => Putter a
put a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put c
c
    get :: Get (a, b, c)
get = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get

-- * containers

instance Serialize a => Serialize [a] where
    put :: Putter [a]
put = forall a. Putter a -> Putter [a]
Serialize.putListOf forall a. Serialize a => Putter a
put
    get :: Get [a]
get = forall a. Get a -> Get [a]
Serialize.getListOf forall a. Serialize a => Get a
get

instance Serialize a => Serialize (NonEmpty a) where
    put :: Putter (NonEmpty a)
put = forall a. Serialize a => Putter a
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NonEmpty.toList
    get :: Get (NonEmpty a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> NonEmpty a
NonEmpty.fromList forall a. Serialize a => Get a
get

instance (Ord a, Serialize a) => Serialize (Set a) where
    put :: Putter (Set a)
put = forall a. Serialize a => Putter a
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList
    get :: Get (Set a)
get = forall a. Eq a => [a] -> Set a
Set.fromAscList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get

instance (Ord k, Serialize k, Serialize v) => Serialize (Map k v) where
    put :: Putter (Map k v)
put = forall a. Serialize a => Putter a
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList
    get :: Get (Map k v)
get = forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get

instance (Serialize i, IArray.Ix i, Serialize e) =>
        Serialize (IArray.Array i e) where
    put :: Putter (Array i e)
put = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
Putter i -> Putter e -> Putter (a i e)
Serialize.putIArrayOf forall a. Serialize a => Putter a
put forall a. Serialize a => Putter a
put
    get :: Get (Array i e)
get = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
Get i -> Get e -> Get (a i e)
Serialize.getIArrayOf forall a. Serialize a => Get a
get forall a. Serialize a => Get a
get

instance Serialize ByteString where
    put :: Putter ByteString
put ByteString
bs = do
        forall a. Serialize a => Putter a
put forall a b. (a -> b) -> a -> b
$ ByteString -> Int
ByteString.length ByteString
bs
        Putter ByteString
Serialize.putByteString ByteString
bs
    get :: Get ByteString
get = forall a. Serialize a => Get a
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
Serialize.getByteString

instance Serialize Text.Text where
    put :: Putter Text
put = forall a. Serialize a => Putter a
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.Encoding.encodeUtf8
    get :: Get Text
get = ByteString -> Text
Text.Encoding.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get

instance (Serialize a, Unboxed.Unbox a) => Serialize (Unboxed.Vector a) where
    put :: Putter (Vector a)
put Vector a
v = do
        forall a. Serialize a => Putter a
put (forall a. Unbox a => Vector a -> Int
Unboxed.length Vector a
v)
        forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
(a -> m b) -> Vector a -> m ()
Unboxed.mapM_ forall a. Serialize a => Putter a
put Vector a
v
    get :: Get (Vector a)
get = do
        Int
len :: Int <- forall a. Serialize a => Get a
get
        forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
Unboxed.replicateM Int
len forall a. Serialize a => Get a
get

instance Serialize a => Serialize (Vector.Vector a) where
    put :: Putter (Vector a)
put Vector a
v = do
        forall a. Serialize a => Putter a
put (forall a. Vector a -> Int
Vector.length Vector a
v)
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
Vector.mapM_ forall a. Serialize a => Putter a
put Vector a
v
    get :: Get (Vector a)
get = do
        Int
len :: Int <- forall a. Serialize a => Get a
get
        forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
Vector.replicateM Int
len forall a. Serialize a => Get a
get

instance (Serialize a, Foreign.Storable a) =>
        Serialize (Vector.Storable.Vector a) where
    put :: Putter (Vector a)
put Vector a
v = do
        forall a. Serialize a => Putter a
put (forall a. Storable a => Vector a -> Int
Vector.Storable.length Vector a
v)
        forall (m :: * -> *) a b.
(Monad m, Storable a) =>
(a -> m b) -> Vector a -> m ()
Vector.Storable.mapM_ forall a. Serialize a => Putter a
put Vector a
v
    get :: Get (Vector a)
get = do
        Int
len :: Int <- forall a. Serialize a => Get a
get
        forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
Vector.Storable.replicateM Int
len forall a. Serialize a => Get a
get

-- This has to be here instead of in CallStack to avoid a circular import.
instance Serialize CallStack.Caller where
    put :: Putter Caller
put (CallStack.Caller String
a Int
b) = Putter Word8
put_tag Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put String
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Int
b
    put Caller
CallStack.NoCaller = Putter Word8
put_tag Word8
1
    get :: Get Caller
get = Get Word8
get_tag forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> String -> Int -> Caller
CallStack.Caller forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get
        Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return Caller
CallStack.NoCaller
        Word8
tag -> forall a. String -> Word8 -> Get a
bad_tag String
"Caller" Word8
tag

-- * versions

get_version :: Get Word.Word8
get_version :: Get Word8
get_version = Get Word8
getWord8

put_version :: Word.Word8 -> Put
put_version :: Putter Word8
put_version = Putter Word8
putWord8

bad_version :: CallStack.Stack => String -> Word.Word8 -> a
bad_version :: forall a. Stack => String -> Word8 -> a
bad_version String
typ Word8
ver = forall a. Stack => Text -> a
errorStack forall a b. (a -> b) -> a -> b
$
    Text
"unknown version " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Word8
ver forall a. Semigroup a => a -> a -> a
<> Text
" for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt String
typ