-- 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.File as File

import           Global


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

decode :: Serialize a => ByteString -> Either String a
decode :: forall a. Serialize a => ByteString -> Either String a
decode = Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
Serialize.runGet Get a
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
[Magic a] -> ShowS
Magic a -> String
(Int -> Magic a -> ShowS)
-> (Magic a -> String) -> ([Magic a] -> ShowS) -> Show (Magic a)
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 'File.writeGz'.
serialize :: forall a. Serialize a => Magic a -> String -> a -> IO Bool
serialize = Int -> Magic a -> String -> a -> IO Bool
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
FilePath.takeDirectory String
fname
    Int -> String -> ByteString -> IO Bool
File.writeGz Int
rotations String
fname (ByteString -> IO Bool) -> ByteString -> IO Bool
forall a b. (a -> b) -> a -> b
$ Magic a -> ByteString
forall {k} (a :: k). Magic a -> ByteString
magicBytes Magic a
magic ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> a -> ByteString
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
(Int -> UnserializeError -> ShowS)
-> (UnserializeError -> String)
-> ([UnserializeError] -> ShowS)
-> Show UnserializeError
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 = IO (Either UnserializeError a) -> IO (Either UnserializeError a)
forall {b}.
IO (Either UnserializeError b) -> IO (Either UnserializeError b)
catch (IO (Either UnserializeError a) -> IO (Either UnserializeError a))
-> IO (Either UnserializeError a) -> IO (Either UnserializeError a)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bytes <- (String -> IO ByteString)
-> (ByteString -> IO ByteString)
-> Either String ByteString
-> IO ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOError -> IO ByteString
forall a e. Exception e => e -> a
Exception.throw (IOError -> IO ByteString)
-> (String -> IOError) -> String -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
IO.Error.userError) ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return
        (Either String ByteString -> IO ByteString)
-> IO (Either String ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Either String ByteString)
File.readGz String
fname
    let (ByteString
file_magic, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Int
magicLength ByteString
bytes
    if ByteString
file_magic ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Magic a -> ByteString
forall {k} (a :: k). Magic a -> ByteString
magicBytes Magic a
magic
        then Either UnserializeError a -> IO (Either UnserializeError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either UnserializeError a -> IO (Either UnserializeError a))
-> Either UnserializeError a -> IO (Either UnserializeError a)
forall a b. (a -> b) -> a -> b
$ UnserializeError -> Either UnserializeError a
forall a b. a -> Either a b
Left (UnserializeError -> Either UnserializeError a)
-> UnserializeError -> Either UnserializeError a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> UnserializeError
BadMagic (Magic a -> ByteString
forall {k} (a :: k). Magic a -> ByteString
magicBytes Magic a
magic) ByteString
file_magic
        else (String -> UnserializeError)
-> Either String a -> Either UnserializeError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> UnserializeError
UnserializeError (Either String a -> Either UnserializeError a)
-> IO (Either String a) -> IO (Either UnserializeError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String a -> IO (Either String a)
forall a. a -> IO a
Exception.evaluate (ByteString -> Either String a
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 = (Either IOError (Either UnserializeError b)
 -> Either UnserializeError b)
-> IO (Either IOError (Either UnserializeError b))
-> IO (Either UnserializeError b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IOError -> Either UnserializeError b)
-> (Either UnserializeError b -> Either UnserializeError b)
-> Either IOError (Either UnserializeError b)
-> Either UnserializeError b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (UnserializeError -> Either UnserializeError b
forall a b. a -> Either a b
Left (UnserializeError -> Either UnserializeError b)
-> (IOError -> UnserializeError)
-> IOError
-> Either UnserializeError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> UnserializeError
IOError) Either UnserializeError b -> Either UnserializeError b
forall a. a -> a
id) (IO (Either IOError (Either UnserializeError b))
 -> IO (Either UnserializeError b))
-> (IO (Either UnserializeError b)
    -> IO (Either IOError (Either UnserializeError b)))
-> IO (Either UnserializeError b)
-> IO (Either UnserializeError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either UnserializeError b)
-> IO (Either IOError (Either UnserializeError b))
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a. Show a => a -> Text
showt ByteString
expected
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a. Show a => a -> Text
showt ByteString
got
        IOError IOError
exc -> Text
"io error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOError -> Text
forall a. Show a => a -> Text
showt IOError
exc
        UnserializeError String
err -> Text
"unserialize error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
txt String
err

-- * numeric

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

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

instance Serialize Int.Int64 where
    put :: Putter Int64
put Int64
i = Putter Word64
forall a. Serialize a => Putter a
put (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i :: Word.Word64)
    get :: Get Int64
get = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Get Word64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word64
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 = Putter Word64
forall a. Serialize a => Putter a
put Putter Word64 -> (Double -> Word64) -> Putter Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
Float.castDoubleToWord64
    get :: Get Double
get = Word64 -> Double
Float.castWord64ToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
forall a. Serialize a => Get a
get

instance Serialize Float where
    put :: Putter Float
put = Putter Word32
forall a. Serialize a => Putter a
put Putter Word32 -> (Float -> Word32) -> Putter Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
Float.castFloatToWord32
    get :: Get Float
get = Word32 -> Float
Float.castWord32ToFloat (Word32 -> Float) -> Get Word32 -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
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 = String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a) -> String -> Get a
forall a b. (a -> b) -> a -> b
$ String
"unknown tag for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
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 = Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get a) -> Get a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n ->
    Get a -> (a -> Get a) -> Maybe a -> Get a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a) -> String -> Get a
forall a b. (a -> b) -> a -> b
$ String
"enum value out of range: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe a
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 = Putter Int
forall a. Serialize a => Putter a
put Putter Int -> (a -> Int) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
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
    | a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound :: a) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound :: a) =
        a -> Maybe a
forall a. a -> Maybe a
Just (Int -> a
forall a. Enum a => Int -> a
toEnum Int
n)
    | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

get_enum :: Serialize.Get Word.Word8
get_enum :: Get Word8
get_enum = Get Word8
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 = Putter Word8
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 = String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a) -> String -> Get a
forall a b. (a -> b) -> a -> b
$ String
"unknown enum val for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
val

-- * basic types

instance Serialize () where
    put :: Putter ()
put () = Putter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    get :: 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 = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (Word8 -> Bool) -> Get Word8 -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
get_tag

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

instance Serialize Time.UTCTime where
    put :: Putter UTCTime
put UTCTime
time = Putter String
forall a. Serialize a => Putter a
put (UTCTime -> String
forall a. Show a => a -> String
show UTCTime
time)
    get :: Get UTCTime
get = Get String
forall a. Serialize a => Get a
get Get String -> (String -> Get UTCTime) -> Get UTCTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UTCTime -> Get UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Get UTCTime)
-> (String -> UTCTime) -> String -> Get UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UTCTime
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 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
forall a. Serialize a => Putter a
put a
a
    put (Right b
b) = Putter Word8
put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter b
forall a. Serialize a => Putter a
put b
b
    get :: Get (Either a b)
get = Get Word8
get_tag Get Word8 -> (Word8 -> Get (Either a b)) -> Get (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Get a -> Get (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall a. Serialize a => Get a
get
        Word8
1 -> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Get b -> Get (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get b
forall a. Serialize a => Get a
get
        Word8
tag -> String -> Word8 -> Get (Either a b)
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 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
forall a. Serialize a => Putter a
put a
a
    get :: Get (Maybe a)
get = Get Word8
get_tag Get Word8 -> (Word8 -> Get (Maybe a)) -> Get (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> Maybe a -> Get (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        Word8
1 -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Get a -> Get (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall a. Serialize a => Get a
get
        Word8
tag -> String -> Word8 -> Get (Maybe a)
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) = Putter a
forall a. Serialize a => Putter a
put a
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter b
forall a. Serialize a => Putter a
put b
b
    get :: Get (a, b)
get = (,) (a -> b -> (a, b)) -> Get a -> Get (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall a. Serialize a => Get a
get Get (b -> (a, b)) -> Get b -> Get (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get 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) = Putter a
forall a. Serialize a => Putter a
put a
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter b
forall a. Serialize a => Putter a
put b
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter c
forall a. Serialize a => Putter a
put c
c
    get :: Get (a, b, c)
get = (,,) (a -> b -> c -> (a, b, c)) -> Get a -> Get (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall a. Serialize a => Get a
get Get (b -> c -> (a, b, c)) -> Get b -> Get (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get b
forall a. Serialize a => Get a
get Get (c -> (a, b, c)) -> Get c -> Get (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get c
forall a. Serialize a => Get a
get

-- * containers

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

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

instance (Ord a, Serialize a) => Serialize (Set a) where
    put :: Putter (Set a)
put = Putter [a]
forall a. Serialize a => Putter a
put Putter [a] -> (Set a -> [a]) -> Putter (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toAscList
    get :: Get (Set a)
get = [a] -> Set a
forall a. Eq a => [a] -> Set a
Set.fromAscList ([a] -> Set a) -> Get [a] -> Get (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [a]
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 = Putter [(k, v)]
forall a. Serialize a => Putter a
put Putter [(k, v)] -> (Map k v -> [(k, v)]) -> Putter (Map k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
    get :: Get (Map k v)
get = [(k, v)] -> Map k v
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(k, v)] -> Map k v) -> Get [(k, v)] -> Get (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [(k, v)]
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 = Putter i -> Putter e -> Putter (Array i e)
forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
Putter i -> Putter e -> Putter (a i e)
Serialize.putIArrayOf Putter i
forall a. Serialize a => Putter a
put Putter e
forall a. Serialize a => Putter a
put
    get :: Get (Array i e)
get = Get i -> Get e -> Get (Array i e)
forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
Get i -> Get e -> Get (a i e)
Serialize.getIArrayOf Get i
forall a. Serialize a => Get a
get Get e
forall a. Serialize a => Get a
get

instance Serialize ByteString where
    put :: Putter ByteString
put ByteString
bs = do
        Putter Int
forall a. Serialize a => Putter a
put Putter Int -> Putter Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
ByteString.length ByteString
bs
        Putter ByteString
Serialize.putByteString ByteString
bs
    get :: Get ByteString
get = Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get ByteString) -> Get ByteString
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 = Putter ByteString
forall a. Serialize a => Putter a
put Putter ByteString -> (Text -> ByteString) -> Putter Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.Encoding.encodeUtf8
    get :: Get Text
get = ByteString -> Text
Text.Encoding.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
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
        Putter Int
forall a. Serialize a => Putter a
put (Vector a -> Int
forall a. Unbox a => Vector a -> Int
Unboxed.length Vector a
v)
        (a -> Put) -> Putter (Vector a)
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
(a -> m b) -> Vector a -> m ()
Unboxed.mapM_ a -> Put
forall a. Serialize a => Putter a
put Vector a
v
    get :: Get (Vector a)
get = do
        Int
len :: Int <- Get Int
forall a. Serialize a => Get a
get
        Int -> Get a -> Get (Vector a)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
Unboxed.replicateM Int
len Get a
forall a. Serialize a => Get a
get

instance Serialize a => Serialize (Vector.Vector a) where
    put :: Putter (Vector a)
put Vector a
v = do
        Putter Int
forall a. Serialize a => Putter a
put (Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
v)
        (a -> Put) -> Putter (Vector a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
Vector.mapM_ a -> Put
forall a. Serialize a => Putter a
put Vector a
v
    get :: Get (Vector a)
get = do
        Int
len :: Int <- Get Int
forall a. Serialize a => Get a
get
        Int -> Get a -> Get (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
Vector.replicateM Int
len Get a
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
        Putter Int
forall a. Serialize a => Putter a
put (Vector a -> Int
forall a. Storable a => Vector a -> Int
Vector.Storable.length Vector a
v)
        (a -> Put) -> Putter (Vector a)
forall (m :: * -> *) a b.
(Monad m, Storable a) =>
(a -> m b) -> Vector a -> m ()
Vector.Storable.mapM_ a -> Put
forall a. Serialize a => Putter a
put Vector a
v
    get :: Get (Vector a)
get = do
        Int
len :: Int <- Get Int
forall a. Serialize a => Get a
get
        Int -> Get a -> Get (Vector a)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
Vector.Storable.replicateM Int
len Get a
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 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter String
forall a. Serialize a => Putter a
put String
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
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 Get Word8 -> (Word8 -> Get Caller) -> Get Caller
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> String -> Int -> Caller
CallStack.Caller (String -> Int -> Caller) -> Get String -> Get (Int -> Caller)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall a. Serialize a => Get a
get Get (Int -> Caller) -> Get Int -> Get Caller
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall a. Serialize a => Get a
get
        Word8
1 -> Caller -> Get Caller
forall (m :: * -> *) a. Monad m => a -> m a
return Caller
CallStack.NoCaller
        Word8
tag -> String -> Word8 -> Get Caller
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 = Text -> a
forall a. Stack => Text -> a
errorStack (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$
    Text
"unknown version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
forall a. Show a => a -> Text
showt Word8
ver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
showt String
typ