{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}

-- |
-- Module      : Codec.Serialise.Class
-- Copyright   : (c) Duncan Coutts 2015-2017
-- License     : BSD3-style (see LICENSE.txt)
--
-- Maintainer  : duncan@community.haskell.org
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- The @'Serialise'@ class allows you to encode a given type into a
-- CBOR object, or decode a CBOR object into the user-specified type.
--
module Codec.Serialise.Class
 ( -- * The Serialise class
   Serialise(..)
 , GSerialiseEncode(..)
 , GSerialiseDecode(..)
 , GSerialiseProd(..)
 , GSerialiseSum(..)
 , encodeVector
 , decodeVector
 , encodeContainerSkel
 , encodeMapSkel
 , decodeMapSkel
 ) where

import           Control.Applicative

import           Control.Monad
import           Data.Char
import           Data.Hashable
import           Data.Int
import           Data.Monoid
import           Data.Proxy
import           Data.Version
import           Data.Word
import           Data.Complex
import           Data.Fixed
import           Data.Ratio
import           Data.Ord

#if MIN_VERSION_base(4,8,0)
import           Numeric.Natural
import           Data.Functor.Identity
#endif

#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup                      as Semigroup
import qualified Data.List.NonEmpty                  as NonEmpty
#endif

import qualified Data.Foldable                       as Foldable
import qualified Data.ByteString                     as BS
import qualified Data.ByteString.Short.Internal      as BSS
import qualified Data.Text                           as Text

-- TODO FIXME: more instances
--import qualified Data.Array                          as Array
--import qualified Data.Array.Unboxed                  as UArray
import qualified Data.ByteString.Lazy                as BS.Lazy
import qualified Data.Map                            as Map
import qualified Data.Sequence                       as Sequence
import qualified Data.Set                            as Set
import qualified Data.IntSet                         as IntSet
import qualified Data.IntMap                         as IntMap
import qualified Data.HashSet                        as HashSet
import qualified Data.HashMap.Strict                 as HashMap
import qualified Data.Tree                           as Tree
import qualified Data.Primitive.ByteArray            as Prim
import qualified Data.Vector                         as Vector
import qualified Data.Vector.Unboxed                 as Vector.Unboxed
import qualified Data.Vector.Storable                as Vector.Storable
import qualified Data.Vector.Primitive               as Vector.Primitive
import qualified Data.Vector.Generic                 as Vector.Generic
import qualified Data.Text.Lazy                      as Text.Lazy
import           Foreign.C.Types
import qualified Numeric.Half                        as Half

import           Data.Time                           (UTCTime (..), addUTCTime)
import           Data.Time.Calendar                  (fromGregorian)
import           Data.Time.Clock.POSIX               (POSIXTime, utcTimeToPOSIXSeconds,
                                                      posixSecondsToUTCTime)
#if MIN_VERSION_time(1,5,0)
import           Data.Time.Format                    (defaultTimeLocale, parseTimeM)
#else
import           Data.Time.Format                    (parseTime)
import           System.Locale                       (defaultTimeLocale)
#endif
import           System.Exit                         (ExitCode(..))

import           Prelude hiding (decodeFloat, encodeFloat, foldr)
import qualified Prelude
#if MIN_VERSION_base(4,10,0)
import           Type.Reflection
import           Type.Reflection.Unsafe
import           GHC.Fingerprint
import           GHC.Exts (VecCount(..), VecElem(..), RuntimeRep(..))
import           Data.Kind (Type)
#else
import           Data.Typeable.Internal
#endif
import           GHC.Generics

import           Codec.CBOR.Decoding
import           Codec.CBOR.Encoding
import           Codec.CBOR.Term
import           Codec.Serialise.Internal.GeneralisedUTF8
import qualified Codec.CBOR.ByteArray                as BA
import qualified Codec.CBOR.ByteArray.Sliced         as BAS


--------------------------------------------------------------------------------
-- The Serialise class

-- | Types that are instances of the @'Serialise'@ class allow values
-- to be quickly encoded or decoded directly to a CBOR representation,
-- for object transmission or storage.
--
-- @since 0.2.0.0
class Serialise a where
    -- | Definition for encoding a given type into a binary
    -- representation, using the @'Encoding'@ @'Monoid'@.
    --
    -- @since 0.2.0.0
    encode  :: a -> Encoding
    default encode :: (Generic a, GSerialiseEncode (Rep a)) => a -> Encoding
    encode = Rep a Any -> Encoding
forall k (f :: k -> *) (a :: k).
GSerialiseEncode f =>
f a -> Encoding
gencode (Rep a Any -> Encoding) -> (a -> Rep a Any) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

    -- | Definition of a given @'Decoder'@ for a type.
    --
    -- @since 0.2.0.0
    decode  :: Decoder s a
    default decode :: (Generic a, GSerialiseDecode (Rep a)) => Decoder s a
    decode = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Decoder s (Rep a Any) -> Decoder s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Rep a Any)
forall k (f :: k -> *) s (a :: k).
GSerialiseDecode f =>
Decoder s (f a)
gdecode

    -- | Utility to support specialised encoding for some list type -
    -- used for @'Char'@/@'String'@ instances in this package.
    --
    -- @since 0.2.0.0
    encodeList :: [a] -> Encoding
    encodeList = [a] -> Encoding
forall a. Serialise a => [a] -> Encoding
defaultEncodeList

    -- | Utility to support specialised decoding for some list type -
    -- used for @'Char'@/@'String'@ instances in this package.
    --
    -- @since 0.2.0.0
    decodeList :: Decoder s [a]
    decodeList = Decoder s [a]
forall a s. Serialise a => Decoder s [a]
defaultDecodeList

-- | @since 0.2.0.0
instance Serialise Term where
  encode :: Term -> Encoding
encode = Term -> Encoding
encodeTerm
  decode :: Decoder s Term
decode = Decoder s Term
forall s. Decoder s Term
decodeTerm

--------------------------------------------------------------------------------
-- Special list business

-- | @since 0.2.0.0
instance Serialise a => Serialise [a] where
    encode :: [a] -> Encoding
encode = [a] -> Encoding
forall a. Serialise a => [a] -> Encoding
encodeList
    decode :: Decoder s [a]
decode = Decoder s [a]
forall a s. Serialise a => Decoder s [a]
decodeList

-- | Default @'Encoding'@ for list types.
--
-- @since 0.2.0.0
defaultEncodeList :: Serialise a => [a] -> Encoding
defaultEncodeList :: [a] -> Encoding
defaultEncodeList [] = Word -> Encoding
encodeListLen 0
defaultEncodeList xs :: [a]
xs = Encoding
encodeListLenIndef
                    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (a -> Encoding -> Encoding) -> Encoding -> [a] -> Encoding
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (\x :: a
x r :: Encoding
r -> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
encodeBreak [a]
xs

-- | Default @'Decoder'@ for list types.
--
-- @since 0.2.0.0
defaultDecodeList :: Serialise a => Decoder s [a]
defaultDecodeList :: Decoder s [a]
defaultDecodeList = do
    Maybe Int
mn <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
    case Maybe Int
mn of
      Nothing -> ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
decodeSequenceLenIndef ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse   Decoder s a
forall a s. Serialise a => Decoder s a
decode
      Just n :: Int
n  -> ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Int -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r)
-> r -> (r -> r') -> Int -> Decoder s a -> Decoder s r'
decodeSequenceLenN     ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse Int
n Decoder s a
forall a s. Serialise a => Decoder s a
decode

--------------------------------------------------------------------------------
-- Another case: NonEmpty lists

#if MIN_VERSION_base(4,9,0)
-- | @since 0.2.0.0
instance Serialise a => Serialise (NonEmpty.NonEmpty a) where
  encode :: NonEmpty a -> Encoding
encode = [a] -> Encoding
forall a. Serialise a => [a] -> Encoding
defaultEncodeList ([a] -> Encoding) -> (NonEmpty a -> [a]) -> NonEmpty a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList
  decode :: Decoder s (NonEmpty a)
decode = do
    [a]
l <- Decoder s [a]
forall a s. Serialise a => Decoder s [a]
defaultDecodeList
    case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
l of
      Nothing -> String -> Decoder s (NonEmpty a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected a NonEmpty list, but an empty list was found!"
      Just xs :: NonEmpty a
xs -> NonEmpty a -> Decoder s (NonEmpty a)
forall (m :: * -> *) a. Monad m => a -> m a
return NonEmpty a
xs
#endif

--------------------------------------------------------------------------------
-- Primitive and integral instances

-- | @since 0.2.0.0
instance Serialise () where
    encode :: () -> Encoding
encode = Encoding -> () -> Encoding
forall a b. a -> b -> a
const Encoding
encodeNull
    decode :: Decoder s ()
decode = Decoder s ()
forall s. Decoder s ()
decodeNull

-- | @since 0.2.0.0
instance Serialise Bool where
    encode :: Bool -> Encoding
encode = Bool -> Encoding
encodeBool
    decode :: Decoder s Bool
decode = Decoder s Bool
forall s. Decoder s Bool
decodeBool

-- | @since 0.2.0.0
instance Serialise Int where
    encode :: Int -> Encoding
encode = Int -> Encoding
encodeInt
    decode :: Decoder s Int
decode = Decoder s Int
forall s. Decoder s Int
decodeInt

-- | @since 0.2.0.0
instance Serialise Int8 where
    encode :: Int8 -> Encoding
encode = Int8 -> Encoding
encodeInt8
    decode :: Decoder s Int8
decode = Decoder s Int8
forall s. Decoder s Int8
decodeInt8

-- | @since 0.2.0.0
instance Serialise Int16 where
    encode :: Int16 -> Encoding
encode = Int16 -> Encoding
encodeInt16
    decode :: Decoder s Int16
decode = Decoder s Int16
forall s. Decoder s Int16
decodeInt16

-- | @since 0.2.0.0
instance Serialise Int32 where
    encode :: Int32 -> Encoding
encode = Int32 -> Encoding
encodeInt32
    decode :: Decoder s Int32
decode = Decoder s Int32
forall s. Decoder s Int32
decodeInt32

-- | @since 0.2.0.0
instance Serialise Int64 where
    encode :: Int64 -> Encoding
encode = Int64 -> Encoding
encodeInt64
    decode :: Decoder s Int64
decode = Decoder s Int64
forall s. Decoder s Int64
decodeInt64

-- | @since 0.2.0.0
instance Serialise Word where
    encode :: Word -> Encoding
encode = Word -> Encoding
encodeWord
    decode :: Decoder s Word
decode = Decoder s Word
forall s. Decoder s Word
decodeWord

-- | @since 0.2.0.0
instance Serialise Word8 where
    encode :: Word8 -> Encoding
encode = Word8 -> Encoding
encodeWord8
    decode :: Decoder s Word8
decode = Decoder s Word8
forall s. Decoder s Word8
decodeWord8

-- | @since 0.2.0.0
instance Serialise Word16 where
    encode :: Word16 -> Encoding
encode = Word16 -> Encoding
encodeWord16
    decode :: Decoder s Word16
decode = Decoder s Word16
forall s. Decoder s Word16
decodeWord16

-- | @since 0.2.0.0
instance Serialise Word32 where
    encode :: Word32 -> Encoding
encode = Word32 -> Encoding
encodeWord32
    decode :: Decoder s Word32
decode = Decoder s Word32
forall s. Decoder s Word32
decodeWord32

-- | @since 0.2.0.0
instance Serialise Word64 where
    encode :: Word64 -> Encoding
encode = Word64 -> Encoding
encodeWord64
    decode :: Decoder s Word64
decode = Decoder s Word64
forall s. Decoder s Word64
decodeWord64

-- | @since 0.2.0.0
instance Serialise Integer where
    encode :: Integer -> Encoding
encode = Integer -> Encoding
encodeInteger
    decode :: Decoder s Integer
decode = Decoder s Integer
forall s. Decoder s Integer
decodeInteger

#if MIN_VERSION_base(4,8,0)
-- | @since 0.2.0.0
instance Serialise Natural where
    encode :: Natural -> Encoding
encode = Integer -> Encoding
encodeInteger (Integer -> Encoding)
-> (Natural -> Integer) -> Natural -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
    decode :: Decoder s Natural
decode = do
      Integer
n <- Decoder s Integer
forall s. Decoder s Integer
decodeInteger
      if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
        then Natural -> Decoder s Natural
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
n)
        else String -> Decoder s Natural
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected non-negative Natural; but got a negative number"
#endif

-- | @since 0.2.0.0
instance Serialise Float where
    encode :: Float -> Encoding
encode = Float -> Encoding
encodeFloat
    decode :: Decoder s Float
decode = Decoder s Float
forall s. Decoder s Float
decodeFloat

-- | @since 0.2.0.0
instance Serialise Double where
    encode :: Double -> Encoding
encode = Double -> Encoding
encodeDouble
    decode :: Decoder s Double
decode = Decoder s Double
forall s. Decoder s Double
decodeDouble

-- | @since 0.2.0.0
instance Serialise Half.Half where
    encode :: Half -> Encoding
encode = Float -> Encoding
encodeFloat16 (Float -> Encoding) -> (Half -> Float) -> Half -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
Half.fromHalf
    decode :: Decoder s Half
decode = (Float -> Half) -> Decoder s Float -> Decoder s Half
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Half
Half.toHalf Decoder s Float
forall s. Decoder s Float
decodeFloat

--------------------------------------------------------------------------------
-- Core types

#if MIN_VERSION_base(4,7,0)
-- | Values are serialised in units of least precision represented as
--   @Integer@.
--
-- @since 0.2.0.0
instance Serialise (Fixed e) where
    encode :: Fixed e -> Encoding
encode (MkFixed i :: Integer
i) = Integer -> Encoding
forall a. Serialise a => a -> Encoding
encode Integer
i
    decode :: Decoder s (Fixed e)
decode = Integer -> Fixed e
forall a. Integer -> Fixed a
MkFixed (Integer -> Fixed e) -> Decoder s Integer -> Decoder s (Fixed e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise (Proxy a) where
    encode :: Proxy a -> Encoding
encode _ = Encoding
encodeNull
    decode :: Decoder s (Proxy a)
decode   = Proxy a
forall k (t :: k). Proxy t
Proxy Proxy a -> Decoder s () -> Decoder s (Proxy a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Decoder s ()
forall s. Decoder s ()
decodeNull
#endif

-- | @since 0.2.0.0
instance Serialise Char where
    -- Here we've taken great pains to ensure that surrogate characters, which
    -- are not representable in UTF-8 yet still admitted by Char,
    -- round-trip properly. We scan the encoded characters during encoding
    -- looking for surrogates; if we find any we encode the string as a
    -- a list of code-points encoded as words. This is slow, but should be rare.
    encode :: Char -> Encoding
encode c :: Char
c
      | Char -> Bool
isSurrogate Char
c = Word -> Encoding
encodeWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c)
      | Bool
otherwise     = Text -> Encoding
encodeString (Char -> Text
Text.singleton Char
c)
    decode :: Decoder s Char
decode = do TokenType
ty <- Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType
                case TokenType
ty of
                  TypeUInt -> Int -> Char
chr (Int -> Char) -> (Word -> Int) -> Word -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Char) -> Decoder s Word -> Decoder s Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word
forall s. Decoder s Word
decodeWord
                  TypeString -> do
                    Text
t <- Decoder s Text
forall s. Decoder s Text
decodeString
                    if Text -> Int
Text.length Text
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                      then Char -> Decoder s Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Decoder s Char) -> Char -> Decoder s Char
forall a b. (a -> b) -> a -> b
$! Text -> Char
Text.head Text
t
                      else String -> Decoder s Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected a single char, found a string"
                  _ -> String -> Decoder s Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected a word or string"

    -- For [Char]/String we have a special encoding
    encodeList :: String -> Encoding
encodeList cs :: String
cs =
        case String -> (SlicedByteArray, UTF8Encoding)
encodeGenUTF8 String
cs of
          (ba :: SlicedByteArray
ba, ConformantUTF8)  -> SlicedByteArray -> Encoding
encodeUtf8ByteArray SlicedByteArray
ba
          (ba :: SlicedByteArray
ba, GeneralisedUTF8) -> SlicedByteArray -> Encoding
encodeByteArray SlicedByteArray
ba
    decodeList :: Decoder s String
decodeList    = do
        TokenType
ty <- Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType
        case TokenType
ty of
          TypeBytes  -> ByteArray -> String
decodeGenUTF8 (ByteArray -> String)
-> (ByteArray -> ByteArray) -> ByteArray -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> ByteArray
BA.unBA (ByteArray -> String) -> Decoder s ByteArray -> Decoder s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteArray
forall s. Decoder s ByteArray
decodeByteArray
          TypeString -> do
              Text
txt <- Decoder s Text
forall s. Decoder s Text
decodeString
              String -> Decoder s String
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> String
Text.unpack Text
txt) -- unpack lazily
          _          -> String -> Decoder s String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected a list or string"

-- | @since 0.2.0.0
instance Serialise Text.Text where
    encode :: Text -> Encoding
encode = Text -> Encoding
encodeString
    decode :: Decoder s Text
decode = Decoder s Text
forall s. Decoder s Text
decodeString

-- | @since 0.2.0.0
instance Serialise BS.ByteString where
    encode :: ByteString -> Encoding
encode = ByteString -> Encoding
encodeBytes
    decode :: Decoder s ByteString
decode = Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes

-- | @since 0.2.0.0
instance Serialise BSS.ShortByteString where
    encode :: ShortByteString -> Encoding
encode sbs :: ShortByteString
sbs@(BSS.SBS ba :: ByteArray#
ba) =
        SlicedByteArray -> Encoding
encodeByteArray (SlicedByteArray -> Encoding) -> SlicedByteArray -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> SlicedByteArray
BAS.SBA (ByteArray# -> ByteArray
Prim.ByteArray ByteArray#
ba) 0 (ShortByteString -> Int
BSS.length ShortByteString
sbs)
    decode :: Decoder s ShortByteString
decode = do
        BA.BA (Prim.ByteArray ba :: ByteArray#
ba) <- Decoder s ByteArray
forall s. Decoder s ByteArray
decodeByteArray
        ShortByteString -> Decoder s ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString -> Decoder s ShortByteString)
-> ShortByteString -> Decoder s ShortByteString
forall a b. (a -> b) -> a -> b
$ ByteArray# -> ShortByteString
BSS.SBS ByteArray#
ba

encodeChunked :: Serialise c
              => Encoding
              -> ((c -> Encoding -> Encoding) -> Encoding -> a -> Encoding)
              -> a
              -> Encoding
encodeChunked :: Encoding
-> ((c -> Encoding -> Encoding) -> Encoding -> a -> Encoding)
-> a
-> Encoding
encodeChunked encodeIndef :: Encoding
encodeIndef foldrChunks :: (c -> Encoding -> Encoding) -> Encoding -> a -> Encoding
foldrChunks a :: a
a =
    Encoding
encodeIndef
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (c -> Encoding -> Encoding) -> Encoding -> a -> Encoding
foldrChunks (\x :: c
x r :: Encoding
r -> c -> Encoding
forall a. Serialise a => a -> Encoding
encode c
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
encodeBreak a
a

decodeChunked :: Serialise c => Decoder s () -> ([c] -> a) -> Decoder s a
decodeChunked :: Decoder s () -> ([c] -> a) -> Decoder s a
decodeChunked decodeIndef :: Decoder s ()
decodeIndef fromChunks :: [c] -> a
fromChunks = do
  Decoder s ()
decodeIndef
  ([c] -> c -> [c])
-> [c] -> ([c] -> a) -> Decoder s c -> Decoder s a
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
decodeSequenceLenIndef ((c -> [c] -> [c]) -> [c] -> c -> [c]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] ([c] -> a
fromChunks ([c] -> a) -> ([c] -> [c]) -> [c] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> [c]
forall a. [a] -> [a]
reverse) Decoder s c
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise Text.Lazy.Text where
    encode :: Text -> Encoding
encode = Encoding
-> ((Text -> Encoding -> Encoding) -> Encoding -> Text -> Encoding)
-> Text
-> Encoding
forall c a.
Serialise c =>
Encoding
-> ((c -> Encoding -> Encoding) -> Encoding -> a -> Encoding)
-> a
-> Encoding
encodeChunked Encoding
encodeStringIndef (Text -> Encoding -> Encoding) -> Encoding -> Text -> Encoding
forall a. (Text -> a -> a) -> a -> Text -> a
Text.Lazy.foldrChunks
    decode :: Decoder s Text
decode = Decoder s () -> ([Text] -> Text) -> Decoder s Text
forall c s a.
Serialise c =>
Decoder s () -> ([c] -> a) -> Decoder s a
decodeChunked Decoder s ()
forall s. Decoder s ()
decodeStringIndef [Text] -> Text
Text.Lazy.fromChunks

-- | @since 0.2.0.0
instance Serialise BS.Lazy.ByteString where
    encode :: ByteString -> Encoding
encode = Encoding
-> ((ByteString -> Encoding -> Encoding)
    -> Encoding -> ByteString -> Encoding)
-> ByteString
-> Encoding
forall c a.
Serialise c =>
Encoding
-> ((c -> Encoding -> Encoding) -> Encoding -> a -> Encoding)
-> a
-> Encoding
encodeChunked Encoding
encodeBytesIndef (ByteString -> Encoding -> Encoding)
-> Encoding -> ByteString -> Encoding
forall a. (ByteString -> a -> a) -> a -> ByteString -> a
BS.Lazy.foldrChunks
    decode :: Decoder s ByteString
decode = Decoder s ()
-> ([ByteString] -> ByteString) -> Decoder s ByteString
forall c s a.
Serialise c =>
Decoder s () -> ([c] -> a) -> Decoder s a
decodeChunked Decoder s ()
forall s. Decoder s ()
decodeBytesIndef [ByteString] -> ByteString
BS.Lazy.fromChunks

-- | @since 0.2.0.0
instance Serialise a => Serialise (Const a b) where
    encode :: Const a b -> Encoding
encode (Const a :: a
a) = a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
    decode :: Decoder s (Const a b)
decode = a -> Const a b
forall k a (b :: k). a -> Const a b
Const (a -> Const a b) -> Decoder s a -> Decoder s (Const a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (ZipList a) where
    encode :: ZipList a -> Encoding
encode (ZipList xs :: [a]
xs) = [a] -> Encoding
forall a. Serialise a => a -> Encoding
encode [a]
xs
    decode :: Decoder s (ZipList a)
decode = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList ([a] -> ZipList a) -> Decoder s [a] -> Decoder s (ZipList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [a]
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance (Serialise a, Integral a) => Serialise (Ratio a) where
    encode :: Ratio a -> Encoding
encode a :: Ratio a
a = Word -> Encoding
encodeListLen 2
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
a)
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
a)
    decode :: Decoder s (Ratio a)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 2
                !a
a <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !a
b <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                Ratio a -> Decoder s (Ratio a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ratio a -> Decoder s (Ratio a)) -> Ratio a -> Decoder s (Ratio a)
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
b

-- | @since 0.2.0.0
instance Serialise a => Serialise (Complex a) where
    encode :: Complex a -> Encoding
encode (r :: a
r :+ i :: a
i) = Word -> Encoding
encodeListLen 2
                   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
r
                   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
i
    decode :: Decoder s (Complex a)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 2
                !a
r <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !a
i <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                Complex a -> Decoder s (Complex a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex a -> Decoder s (Complex a))
-> Complex a -> Decoder s (Complex a)
forall a b. (a -> b) -> a -> b
$ a
r a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
i

-- | @since 0.2.0.0
instance Serialise Ordering where
    encode :: Ordering -> Encoding
encode a :: Ordering
a = Word -> Encoding
encodeListLen 1
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord (case Ordering
a of LT -> 0
                                     EQ -> 1
                                     GT -> 2)
    decode :: Decoder s Ordering
decode = do
      Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 1
      Word
t <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
t of
        0 -> Ordering -> Decoder s Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
LT
        1 -> Ordering -> Decoder s Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ
        2 -> Ordering -> Decoder s Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
GT
        _ -> String -> Decoder s Ordering
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unexpected tag"

-- | @since 0.2.0.0
instance Serialise a => Serialise (Down a) where
    encode :: Down a -> Encoding
encode (Down a :: a
a) = a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
    decode :: Decoder s (Down a)
decode = a -> Down a
forall a. a -> Down a
Down (a -> Down a) -> Decoder s a -> Decoder s (Down a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Dual a) where
    encode :: Dual a -> Encoding
encode (Dual a :: a
a) = a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
    decode :: Decoder s (Dual a)
decode = a -> Dual a
forall a. a -> Dual a
Dual (a -> Dual a) -> Decoder s a -> Decoder s (Dual a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise All where
    encode :: All -> Encoding
encode (All b :: Bool
b) = Bool -> Encoding
forall a. Serialise a => a -> Encoding
encode Bool
b
    decode :: Decoder s All
decode = Bool -> All
All (Bool -> All) -> Decoder s Bool -> Decoder s All
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Bool
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise Any where
    encode :: Any -> Encoding
encode (Any b :: Bool
b) = Bool -> Encoding
forall a. Serialise a => a -> Encoding
encode Bool
b
    decode :: Decoder s Any
decode = Bool -> Any
Any (Bool -> Any) -> Decoder s Bool -> Decoder s Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Bool
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Sum a) where
    encode :: Sum a -> Encoding
encode (Sum b :: a
b) = a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
b
    decode :: Decoder s (Sum a)
decode = a -> Sum a
forall a. a -> Sum a
Sum (a -> Sum a) -> Decoder s a -> Decoder s (Sum a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Product a) where
    encode :: Product a -> Encoding
encode (Product b :: a
b) = a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
b
    decode :: Decoder s (Product a)
decode = a -> Product a
forall a. a -> Product a
Product (a -> Product a) -> Decoder s a -> Decoder s (Product a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (First a) where
    encode :: First a -> Encoding
encode (First b :: Maybe a
b) = Maybe a -> Encoding
forall a. Serialise a => a -> Encoding
encode Maybe a
b
    decode :: Decoder s (First a)
decode = Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> Decoder s (Maybe a) -> Decoder s (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe a)
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Last a) where
    encode :: Last a -> Encoding
encode (Last b :: Maybe a
b) = Maybe a -> Encoding
forall a. Serialise a => a -> Encoding
encode Maybe a
b
    decode :: Decoder s (Last a)
decode = Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a) -> Decoder s (Maybe a) -> Decoder s (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe a)
forall a s. Serialise a => Decoder s a
decode

#if MIN_VERSION_base(4,8,0)
-- | @since 0.2.0.0
instance Serialise (f a) => Serialise (Alt f a) where
    encode :: Alt f a -> Encoding
encode (Alt b :: f a
b) = f a -> Encoding
forall a. Serialise a => a -> Encoding
encode f a
b
    decode :: Decoder s (Alt f a)
decode = f a -> Alt f a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (f a -> Alt f a) -> Decoder s (f a) -> Decoder s (Alt f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (f a)
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Identity a) where
    encode :: Identity a -> Encoding
encode (Identity b :: a
b) = a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
b
    decode :: Decoder s (Identity a)
decode = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Decoder s a -> Decoder s (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode
#endif

-- | @since 0.2.0.0
instance Serialise ExitCode where
    encode :: ExitCode -> Encoding
encode ExitSuccess     = Word -> Encoding
encodeListLen 1
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0
    encode (ExitFailure i :: Int
i) = Word -> Encoding
encodeListLen 2
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 1
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
forall a. Serialise a => a -> Encoding
encode Int
i
    decode :: Decoder s ExitCode
decode = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      case Int
n of
        1 -> do Word
t <- Decoder s Word
forall s. Decoder s Word
decodeWord
                case Word
t of
                  0 -> ExitCode -> Decoder s ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
                  _ -> String -> Decoder s ExitCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unexpected tag"
        2 -> do Word
t <- Decoder s Word
forall s. Decoder s Word
decodeWord
                case Word
t of
                  1 -> () -> Decoder s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  _ -> String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unexpected tag"
                !Int
i <- Decoder s Int
forall a s. Serialise a => Decoder s a
decode
                ExitCode -> Decoder s ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Decoder s ExitCode) -> ExitCode -> Decoder s ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
i
        _ -> String -> Decoder s ExitCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Bad list length"

-- Semigroup instances for GHC 8.0+
#if MIN_VERSION_base(4,9,0)
-- | @since 0.2.0.0
instance Serialise a => Serialise (Semigroup.Min a) where
  encode :: Min a -> Encoding
encode = a -> Encoding
forall a. Serialise a => a -> Encoding
encode (a -> Encoding) -> (Min a -> a) -> Min a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Min a -> a
forall a. Min a -> a
Semigroup.getMin
  decode :: Decoder s (Min a)
decode = (a -> Min a) -> Decoder s a -> Decoder s (Min a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Min a
forall a. a -> Min a
Semigroup.Min Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Semigroup.Max a) where
  encode :: Max a -> Encoding
encode = a -> Encoding
forall a. Serialise a => a -> Encoding
encode (a -> Encoding) -> (Max a -> a) -> Max a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Max a -> a
forall a. Max a -> a
Semigroup.getMax
  decode :: Decoder s (Max a)
decode = (a -> Max a) -> Decoder s a -> Decoder s (Max a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Max a
forall a. a -> Max a
Semigroup.Max Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Semigroup.First a) where
  encode :: First a -> Encoding
encode = a -> Encoding
forall a. Serialise a => a -> Encoding
encode (a -> Encoding) -> (First a -> a) -> First a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First a -> a
forall a. First a -> a
Semigroup.getFirst
  decode :: Decoder s (First a)
decode = (a -> First a) -> Decoder s a -> Decoder s (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> First a
forall a. a -> First a
Semigroup.First Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Semigroup.Last a) where
  encode :: Last a -> Encoding
encode = a -> Encoding
forall a. Serialise a => a -> Encoding
encode (a -> Encoding) -> (Last a -> a) -> Last a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last a -> a
forall a. Last a -> a
Semigroup.getLast
  decode :: Decoder s (Last a)
decode = (a -> Last a) -> Decoder s a -> Decoder s (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Last a
forall a. a -> Last a
Semigroup.Last Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise a => Serialise (Semigroup.Option a) where
  encode :: Option a -> Encoding
encode = Maybe a -> Encoding
forall a. Serialise a => a -> Encoding
encode (Maybe a -> Encoding)
-> (Option a -> Maybe a) -> Option a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> Maybe a
forall a. Option a -> Maybe a
Semigroup.getOption
  decode :: Decoder s (Option a)
decode = (Maybe a -> Option a)
-> Decoder s (Maybe a) -> Decoder s (Option a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Option a
forall a. Maybe a -> Option a
Semigroup.Option Decoder s (Maybe a)
forall a s. Serialise a => Decoder s a
decode

instance Serialise a => Serialise (Semigroup.WrappedMonoid a) where
  encode :: WrappedMonoid a -> Encoding
encode = a -> Encoding
forall a. Serialise a => a -> Encoding
encode (a -> Encoding)
-> (WrappedMonoid a -> a) -> WrappedMonoid a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMonoid a -> a
forall m. WrappedMonoid m -> m
Semigroup.unwrapMonoid
  decode :: Decoder s (WrappedMonoid a)
decode = (a -> WrappedMonoid a)
-> Decoder s a -> Decoder s (WrappedMonoid a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> WrappedMonoid a
forall m. m -> WrappedMonoid m
Semigroup.WrapMonoid Decoder s a
forall a s. Serialise a => Decoder s a
decode
#endif

--------------------------------------------------------------------------------
-- Foreign types

-- | @since 0.2.0.0
instance Serialise CChar where
    encode :: CChar -> Encoding
encode (CChar x :: Int8
x) = Int8 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int8
x
    decode :: Decoder s CChar
decode = Int8 -> CChar
CChar (Int8 -> CChar) -> Decoder s Int8 -> Decoder s CChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int8
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CSChar where
    encode :: CSChar -> Encoding
encode (CSChar x :: Int8
x) = Int8 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int8
x
    decode :: Decoder s CSChar
decode = Int8 -> CSChar
CSChar (Int8 -> CSChar) -> Decoder s Int8 -> Decoder s CSChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int8
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CUChar where
    encode :: CUChar -> Encoding
encode (CUChar x :: Word8
x) = Word8 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word8
x
    decode :: Decoder s CUChar
decode = Word8 -> CUChar
CUChar (Word8 -> CUChar) -> Decoder s Word8 -> Decoder s CUChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word8
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CShort where
    encode :: CShort -> Encoding
encode (CShort x :: Int16
x) = Int16 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int16
x
    decode :: Decoder s CShort
decode = Int16 -> CShort
CShort (Int16 -> CShort) -> Decoder s Int16 -> Decoder s CShort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int16
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CUShort where
    encode :: CUShort -> Encoding
encode (CUShort x :: Word16
x) = Word16 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word16
x
    decode :: Decoder s CUShort
decode = Word16 -> CUShort
CUShort (Word16 -> CUShort) -> Decoder s Word16 -> Decoder s CUShort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word16
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CInt where
    encode :: CInt -> Encoding
encode (CInt x :: Int32
x) = Int32 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int32
x
    decode :: Decoder s CInt
decode = Int32 -> CInt
CInt (Int32 -> CInt) -> Decoder s Int32 -> Decoder s CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int32
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CUInt where
    encode :: CUInt -> Encoding
encode (CUInt x :: Word32
x) = Word32 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word32
x
    decode :: Decoder s CUInt
decode = Word32 -> CUInt
CUInt (Word32 -> CUInt) -> Decoder s Word32 -> Decoder s CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CLong where
    encode :: CLong -> Encoding
encode (CLong x :: Int64
x) = Int64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int64
x
    decode :: Decoder s CLong
decode = Int64 -> CLong
CLong (Int64 -> CLong) -> Decoder s Int64 -> Decoder s CLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CULong where
    encode :: CULong -> Encoding
encode (CULong x :: Word64
x) = Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
x
    decode :: Decoder s CULong
decode = Word64 -> CULong
CULong (Word64 -> CULong) -> Decoder s Word64 -> Decoder s CULong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CPtrdiff where
    encode :: CPtrdiff -> Encoding
encode (CPtrdiff x :: Int64
x) = Int64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int64
x
    decode :: Decoder s CPtrdiff
decode = Int64 -> CPtrdiff
CPtrdiff (Int64 -> CPtrdiff) -> Decoder s Int64 -> Decoder s CPtrdiff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CSize where
    encode :: CSize -> Encoding
encode (CSize x :: Word64
x) = Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
x
    decode :: Decoder s CSize
decode = Word64 -> CSize
CSize (Word64 -> CSize) -> Decoder s Word64 -> Decoder s CSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CWchar where
    encode :: CWchar -> Encoding
encode (CWchar x :: Int32
x) = Int32 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int32
x
    decode :: Decoder s CWchar
decode = Int32 -> CWchar
CWchar (Int32 -> CWchar) -> Decoder s Int32 -> Decoder s CWchar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int32
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CSigAtomic where
    encode :: CSigAtomic -> Encoding
encode (CSigAtomic x :: Int32
x) = Int32 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int32
x
    decode :: Decoder s CSigAtomic
decode = Int32 -> CSigAtomic
CSigAtomic (Int32 -> CSigAtomic) -> Decoder s Int32 -> Decoder s CSigAtomic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int32
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CLLong where
    encode :: CLLong -> Encoding
encode (CLLong x :: Int64
x) = Int64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int64
x
    decode :: Decoder s CLLong
decode = Int64 -> CLLong
CLLong (Int64 -> CLLong) -> Decoder s Int64 -> Decoder s CLLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CULLong where
    encode :: CULLong -> Encoding
encode (CULLong x :: Word64
x) = Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
x
    decode :: Decoder s CULLong
decode = Word64 -> CULLong
CULLong (Word64 -> CULLong) -> Decoder s Word64 -> Decoder s CULLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CIntPtr where
    encode :: CIntPtr -> Encoding
encode (CIntPtr x :: Int64
x) = Int64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int64
x
    decode :: Decoder s CIntPtr
decode = Int64 -> CIntPtr
CIntPtr (Int64 -> CIntPtr) -> Decoder s Int64 -> Decoder s CIntPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CUIntPtr where
    encode :: CUIntPtr -> Encoding
encode (CUIntPtr x :: Word64
x) = Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
x
    decode :: Decoder s CUIntPtr
decode = Word64 -> CUIntPtr
CUIntPtr (Word64 -> CUIntPtr) -> Decoder s Word64 -> Decoder s CUIntPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CIntMax where
    encode :: CIntMax -> Encoding
encode (CIntMax x :: Int64
x) = Int64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int64
x
    decode :: Decoder s CIntMax
decode = Int64 -> CIntMax
CIntMax (Int64 -> CIntMax) -> Decoder s Int64 -> Decoder s CIntMax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CUIntMax where
    encode :: CUIntMax -> Encoding
encode (CUIntMax x :: Word64
x) = Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
x
    decode :: Decoder s CUIntMax
decode = Word64 -> CUIntMax
CUIntMax (Word64 -> CUIntMax) -> Decoder s Word64 -> Decoder s CUIntMax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CClock where
    encode :: CClock -> Encoding
encode (CClock x :: Int64
x) = Int64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int64
x
    decode :: Decoder s CClock
decode = Int64 -> CClock
CClock (Int64 -> CClock) -> Decoder s Int64 -> Decoder s CClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CTime where
    encode :: CTime -> Encoding
encode (CTime x :: Int64
x) = Int64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int64
x
    decode :: Decoder s CTime
decode = Int64 -> CTime
CTime (Int64 -> CTime) -> Decoder s Int64 -> Decoder s CTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CUSeconds where
    encode :: CUSeconds -> Encoding
encode (CUSeconds x :: Word32
x) = Word32 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word32
x
    decode :: Decoder s CUSeconds
decode = Word32 -> CUSeconds
CUSeconds (Word32 -> CUSeconds) -> Decoder s Word32 -> Decoder s CUSeconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CSUSeconds where
    encode :: CSUSeconds -> Encoding
encode (CSUSeconds x :: Int64
x) = Int64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Int64
x
    decode :: Decoder s CSUSeconds
decode = Int64 -> CSUSeconds
CSUSeconds (Int64 -> CSUSeconds) -> Decoder s Int64 -> Decoder s CSUSeconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CFloat where
    encode :: CFloat -> Encoding
encode (CFloat x :: Float
x) = Float -> Encoding
forall a. Serialise a => a -> Encoding
encode Float
x
    decode :: Decoder s CFloat
decode = Float -> CFloat
CFloat (Float -> CFloat) -> Decoder s Float -> Decoder s CFloat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Float
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance Serialise CDouble where
    encode :: CDouble -> Encoding
encode (CDouble x :: Double
x) = Double -> Encoding
forall a. Serialise a => a -> Encoding
encode Double
x
    decode :: Decoder s CDouble
decode = Double -> CDouble
CDouble (Double -> CDouble) -> Decoder s Double -> Decoder s CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Double
forall a s. Serialise a => Decoder s a
decode

--------------------------------------------------------------------------------
-- Structural instances

-- | @since 0.2.0.0
instance (Serialise a, Serialise b) => Serialise (a,b) where
    encode :: (a, b) -> Encoding
encode (a :: a
a,b :: b
b) = Word -> Encoding
encodeListLen 2
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
b
    decode :: Decoder s (a, b)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 2
                !a
x <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !b
y <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                (a, b) -> Decoder s (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, b
y)

-- | @since 0.2.0.0
instance (Serialise a, Serialise b, Serialise c) => Serialise (a,b,c) where
    encode :: (a, b, c) -> Encoding
encode (a :: a
a,b :: b
b,c :: c
c) = Word -> Encoding
encodeListLen 3
                  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
                  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
b
                  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. Serialise a => a -> Encoding
encode c
c

    decode :: Decoder s (a, b, c)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 3
                !a
x <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !b
y <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                !c
z <- Decoder s c
forall a s. Serialise a => Decoder s a
decode
                (a, b, c) -> Decoder s (a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, b
y, c
z)

-- | @since 0.2.0.0
instance (Serialise a, Serialise b, Serialise c, Serialise d
         ) => Serialise (a,b,c,d) where
    encode :: (a, b, c, d) -> Encoding
encode (a :: a
a,b :: b
b,c :: c
c,d :: d
d) = Word -> Encoding
encodeListLen 4
                    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
                    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
b
                    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. Serialise a => a -> Encoding
encode c
c
                    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
forall a. Serialise a => a -> Encoding
encode d
d

    decode :: Decoder s (a, b, c, d)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 4
                !a
a <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !b
b <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                !c
c <- Decoder s c
forall a s. Serialise a => Decoder s a
decode
                !d
d <- Decoder s d
forall a s. Serialise a => Decoder s a
decode
                (a, b, c, d) -> Decoder s (a, b, c, d)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d)

-- | @since 0.2.0.0
instance (Serialise a, Serialise b, Serialise c, Serialise d, Serialise e
         ) => Serialise (a,b,c,d,e) where
    encode :: (a, b, c, d, e) -> Encoding
encode (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e) = Word -> Encoding
encodeListLen 5
                      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
                      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
b
                      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. Serialise a => a -> Encoding
encode c
c
                      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
forall a. Serialise a => a -> Encoding
encode d
d
                      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> e -> Encoding
forall a. Serialise a => a -> Encoding
encode e
e

    decode :: Decoder s (a, b, c, d, e)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 5
                !a
a <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !b
b <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                !c
c <- Decoder s c
forall a s. Serialise a => Decoder s a
decode
                !d
d <- Decoder s d
forall a s. Serialise a => Decoder s a
decode
                !e
e <- Decoder s e
forall a s. Serialise a => Decoder s a
decode
                (a, b, c, d, e) -> Decoder s (a, b, c, d, e)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e)

-- | @since 0.2.0.0
instance ( Serialise a, Serialise b, Serialise c, Serialise d, Serialise e
         , Serialise f
         ) => Serialise (a,b,c,d,e,f) where
    encode :: (a, b, c, d, e, f) -> Encoding
encode (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f) = Word -> Encoding
encodeListLen 6
                        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
                        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
b
                        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. Serialise a => a -> Encoding
encode c
c
                        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
forall a. Serialise a => a -> Encoding
encode d
d
                        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> e -> Encoding
forall a. Serialise a => a -> Encoding
encode e
e
                        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f -> Encoding
forall a. Serialise a => a -> Encoding
encode f
f

    decode :: Decoder s (a, b, c, d, e, f)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 6
                !a
a <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !b
b <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                !c
c <- Decoder s c
forall a s. Serialise a => Decoder s a
decode
                !d
d <- Decoder s d
forall a s. Serialise a => Decoder s a
decode
                !e
e <- Decoder s e
forall a s. Serialise a => Decoder s a
decode
                !f
f <- Decoder s f
forall a s. Serialise a => Decoder s a
decode
                (a, b, c, d, e, f) -> Decoder s (a, b, c, d, e, f)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e, f
f)

-- | @since 0.2.0.0
instance ( Serialise a, Serialise b, Serialise c, Serialise d, Serialise e
         , Serialise f, Serialise g
         ) => Serialise (a,b,c,d,e,f,g) where
    encode :: (a, b, c, d, e, f, g) -> Encoding
encode (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f,g :: g
g) = Word -> Encoding
encodeListLen 7
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
b
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. Serialise a => a -> Encoding
encode c
c
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
forall a. Serialise a => a -> Encoding
encode d
d
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> e -> Encoding
forall a. Serialise a => a -> Encoding
encode e
e
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f -> Encoding
forall a. Serialise a => a -> Encoding
encode f
f
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> g -> Encoding
forall a. Serialise a => a -> Encoding
encode g
g

    decode :: Decoder s (a, b, c, d, e, f, g)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 7
                !a
a <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !b
b <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                !c
c <- Decoder s c
forall a s. Serialise a => Decoder s a
decode
                !d
d <- Decoder s d
forall a s. Serialise a => Decoder s a
decode
                !e
e <- Decoder s e
forall a s. Serialise a => Decoder s a
decode
                !f
f <- Decoder s f
forall a s. Serialise a => Decoder s a
decode
                !g
g <- Decoder s g
forall a s. Serialise a => Decoder s a
decode
                (a, b, c, d, e, f, g) -> Decoder s (a, b, c, d, e, f, g)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e, f
f, g
g)

-- | @since 0.2.0.0
instance ( Serialise a, Serialise b, Serialise c, Serialise d, Serialise e
         , Serialise f, Serialise g, Serialise h
         ) => Serialise (a,b,c,d,e,f,g,h) where
    encode :: (a, b, c, d, e, f, g, h) -> Encoding
encode (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f,g :: g
g,h :: h
h) = Word -> Encoding
encodeListLen 8
                            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
                            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
b
                            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. Serialise a => a -> Encoding
encode c
c
                            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
forall a. Serialise a => a -> Encoding
encode d
d
                            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> e -> Encoding
forall a. Serialise a => a -> Encoding
encode e
e
                            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f -> Encoding
forall a. Serialise a => a -> Encoding
encode f
f
                            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> g -> Encoding
forall a. Serialise a => a -> Encoding
encode g
g
                            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> h -> Encoding
forall a. Serialise a => a -> Encoding
encode h
h

    decode :: Decoder s (a, b, c, d, e, f, g, h)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 8
                !a
a <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !b
b <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                !c
c <- Decoder s c
forall a s. Serialise a => Decoder s a
decode
                !d
d <- Decoder s d
forall a s. Serialise a => Decoder s a
decode
                !e
e <- Decoder s e
forall a s. Serialise a => Decoder s a
decode
                !f
f <- Decoder s f
forall a s. Serialise a => Decoder s a
decode
                !g
g <- Decoder s g
forall a s. Serialise a => Decoder s a
decode
                !h
h <- Decoder s h
forall a s. Serialise a => Decoder s a
decode
                (a, b, c, d, e, f, g, h) -> Decoder s (a, b, c, d, e, f, g, h)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h)

-- | @since 0.2.0.0
instance ( Serialise a, Serialise b, Serialise c, Serialise d, Serialise e
         , Serialise f, Serialise g, Serialise h, Serialise i
         ) => Serialise (a,b,c,d,e,f,g,h,i) where
    encode :: (a, b, c, d, e, f, g, h, i) -> Encoding
encode (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f,g :: g
g,h :: h
h,i :: i
i) = Word -> Encoding
encodeListLen 9
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
b
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. Serialise a => a -> Encoding
encode c
c
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
forall a. Serialise a => a -> Encoding
encode d
d
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> e -> Encoding
forall a. Serialise a => a -> Encoding
encode e
e
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f -> Encoding
forall a. Serialise a => a -> Encoding
encode f
f
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> g -> Encoding
forall a. Serialise a => a -> Encoding
encode g
g
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> h -> Encoding
forall a. Serialise a => a -> Encoding
encode h
h
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> i -> Encoding
forall a. Serialise a => a -> Encoding
encode i
i

    decode :: Decoder s (a, b, c, d, e, f, g, h, i)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 9
                !a
a <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                !b
b <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                !c
c <- Decoder s c
forall a s. Serialise a => Decoder s a
decode
                !d
d <- Decoder s d
forall a s. Serialise a => Decoder s a
decode
                !e
e <- Decoder s e
forall a s. Serialise a => Decoder s a
decode
                !f
f <- Decoder s f
forall a s. Serialise a => Decoder s a
decode
                !g
g <- Decoder s g
forall a s. Serialise a => Decoder s a
decode
                !h
h <- Decoder s h
forall a s. Serialise a => Decoder s a
decode
                !i
i <- Decoder s i
forall a s. Serialise a => Decoder s a
decode
                (a, b, c, d, e, f, g, h, i)
-> Decoder s (a, b, c, d, e, f, g, h, i)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)

-- | @since 0.2.0.0
instance Serialise a => Serialise (Maybe a) where
    encode :: Maybe a -> Encoding
encode Nothing  = Word -> Encoding
encodeListLen 0
    encode (Just x :: a
x) = Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
x

    decode :: Decoder s (Maybe a)
decode = do Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
                case Int
n of
                  0 -> Maybe a -> Decoder s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                  1 -> do !a
x <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                          Maybe a -> Decoder s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
                  _ -> String -> Decoder s (Maybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unknown tag"

-- | @since 0.2.0.0
instance (Serialise a, Serialise b) => Serialise (Either a b) where
    encode :: Either a b -> Encoding
encode (Left  x :: a
x) = Word -> Encoding
encodeListLen 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
x
    encode (Right x :: b
x) = Word -> Encoding
encodeListLen 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. Serialise a => a -> Encoding
encode b
x

    decode :: Decoder s (Either a b)
decode = do Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 2
                Word
t <- Decoder s Word
forall s. Decoder s Word
decodeWord
                case Word
t of
                  0 -> do !a
x <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
                          Either a b -> Decoder s (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either a b
forall a b. a -> Either a b
Left a
x)
                  1 -> do !b
x <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
                          Either a b -> Decoder s (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either a b
forall a b. b -> Either a b
Right b
x)
                  _ -> String -> Decoder s (Either a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unknown tag"


--------------------------------------------------------------------------------
-- Container instances

-- | @since 0.2.0.0
instance Serialise a => Serialise (Tree.Tree a) where
  encode :: Tree a -> Encoding
encode (Tree.Node r :: a
r sub :: [Tree a]
sub) = Word -> Encoding
encodeListLen 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
r Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Tree a] -> Encoding
forall a. Serialise a => a -> Encoding
encode [Tree a]
sub
  decode :: Decoder s (Tree a)
decode = Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 2 Decoder s () -> Decoder s (Tree a) -> Decoder s (Tree a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> [Tree a] -> Tree a
forall a. a -> Forest a -> Tree a
Tree.Node (a -> [Tree a] -> Tree a)
-> Decoder s a -> Decoder s ([Tree a] -> Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode Decoder s ([Tree a] -> Tree a)
-> Decoder s [Tree a] -> Decoder s (Tree a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s [Tree a]
forall a s. Serialise a => Decoder s a
decode)

-- | Patch functions together to obtain an 'Encoding' for a container.
encodeContainerSkel :: (Word -> Encoding) -- ^ encoder of the length
                    -> (container -> Int) -- ^ length
                    -> (accumFunc -> Encoding -> container -> Encoding) -- ^ foldr
                    -> accumFunc
                    -> container
                    -> Encoding
encodeContainerSkel :: (Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel encodeLen :: Word -> Encoding
encodeLen size :: container -> Int
size foldr :: accumFunc -> Encoding -> container -> Encoding
foldr f :: accumFunc
f  c :: container
c =
    Word -> Encoding
encodeLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (container -> Int
size container
c)) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> accumFunc -> Encoding -> container -> Encoding
foldr accumFunc
f Encoding
forall a. Monoid a => a
mempty container
c
{-# INLINE encodeContainerSkel #-}

decodeContainerSkelWithReplicate
  :: (Serialise a)
  => Decoder s Int
     -- ^ How to get the size of the container
  -> (Int -> Decoder s a -> Decoder s container)
     -- ^ replicateM for the container
  -> ([container] -> container)
     -- ^ concat for the container
  -> Decoder s container
decodeContainerSkelWithReplicate :: Decoder s Int
-> (Int -> Decoder s a -> Decoder s container)
-> ([container] -> container)
-> Decoder s container
decodeContainerSkelWithReplicate decodeLen :: Decoder s Int
decodeLen replicateFun :: Int -> Decoder s a -> Decoder s container
replicateFun fromList :: [container] -> container
fromList = do
    -- Look at how much data we have at the moment and use it as the limit for
    -- the size of a single call to replicateFun. We don't want to use
    -- replicateFun directly on the result of decodeLen since this might lead to
    -- DOS attack (attacker providing a huge value for length). So if it's above
    -- our limit, we'll do manual chunking and then combine the containers into
    -- one.
    Int
size <- Decoder s Int
decodeLen
    Int
limit <- Decoder s Int
forall s. Decoder s Int
peekAvailable
    if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limit
       then Int -> Decoder s a -> Decoder s container
replicateFun Int
size Decoder s a
forall a s. Serialise a => Decoder s a
decode
       else do
           -- Take the max of limit and a fixed chunk size (note: limit can be
           -- 0). This basically means that the attacker can make us allocate a
           -- container of size 128 even though there's no actual input.
           let chunkSize :: Int
chunkSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
limit 128
               (d :: Int
d, m :: Int
m) = Int
size Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
chunkSize
               buildOne :: Int -> Decoder s container
buildOne s :: Int
s = Int -> Decoder s a -> Decoder s container
replicateFun Int
s Decoder s a
forall a s. Serialise a => Decoder s a
decode
           [container]
containers <- [Decoder s container] -> Decoder s [container]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Decoder s container] -> Decoder s [container])
-> [Decoder s container] -> Decoder s [container]
forall a b. (a -> b) -> a -> b
$ Int -> Decoder s container
buildOne Int
m Decoder s container
-> [Decoder s container] -> [Decoder s container]
forall a. a -> [a] -> [a]
: Int -> Decoder s container -> [Decoder s container]
forall a. Int -> a -> [a]
replicate Int
d (Int -> Decoder s container
buildOne Int
chunkSize)
           container -> Decoder s container
forall (m :: * -> *) a. Monad m => a -> m a
return (container -> Decoder s container)
-> container -> Decoder s container
forall a b. (a -> b) -> a -> b
$! [container] -> container
fromList [container]
containers
{-# INLINE decodeContainerSkelWithReplicate #-}

-- | @since 0.2.0.0
instance (Serialise a) => Serialise (Sequence.Seq a) where
  encode :: Seq a -> Encoding
encode = (Word -> Encoding)
-> (Seq a -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> Seq a -> Encoding)
-> (a -> Encoding -> Encoding)
-> Seq a
-> Encoding
forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel
             Word -> Encoding
encodeListLen
             Seq a -> Int
forall a. Seq a -> Int
Sequence.length
             (a -> Encoding -> Encoding) -> Encoding -> Seq a -> Encoding
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr
             (\a :: a
a b :: Encoding
b -> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b)
  decode :: Decoder s (Seq a)
decode = Decoder s Int
-> (Int -> Decoder s a -> Decoder s (Seq a))
-> ([Seq a] -> Seq a)
-> Decoder s (Seq a)
forall a s container.
Serialise a =>
Decoder s Int
-> (Int -> Decoder s a -> Decoder s container)
-> ([container] -> container)
-> Decoder s container
decodeContainerSkelWithReplicate
             Decoder s Int
forall s. Decoder s Int
decodeListLen
             Int -> Decoder s a -> Decoder s (Seq a)
forall (m :: * -> *) a. Applicative m => Int -> m a -> m (Seq a)
Sequence.replicateM
             [Seq a] -> Seq a
forall a. Monoid a => [a] -> a
mconcat

-- | Generic encoder for vectors. Its intended use is to allow easy
-- definition of 'Serialise' instances for custom vector
--
-- @since 0.2.0.0
encodeVector :: (Serialise a, Vector.Generic.Vector v a)
             => v a -> Encoding
encodeVector :: v a -> Encoding
encodeVector = (Word -> Encoding)
-> (v a -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> v a -> Encoding)
-> (a -> Encoding -> Encoding)
-> v a
-> Encoding
forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel
    Word -> Encoding
encodeListLen
    v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.Generic.length
    (a -> Encoding -> Encoding) -> Encoding -> v a -> Encoding
forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
Vector.Generic.foldr
    (\a :: a
a b :: Encoding
b -> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b)
{-# INLINE encodeVector #-}

-- | Generic decoder for vectors. Its intended use is to allow easy
-- definition of 'Serialise' instances for custom vector
--
-- @since 0.2.0.0
decodeVector :: (Serialise a, Vector.Generic.Vector v a)
             => Decoder s (v a)
decodeVector :: Decoder s (v a)
decodeVector = Decoder s Int
-> (Int -> Decoder s a -> Decoder s (v a))
-> ([v a] -> v a)
-> Decoder s (v a)
forall a s container.
Serialise a =>
Decoder s Int
-> (Int -> Decoder s a -> Decoder s container)
-> ([container] -> container)
-> Decoder s container
decodeContainerSkelWithReplicate
    Decoder s Int
forall s. Decoder s Int
decodeListLen
    Int -> Decoder s a -> Decoder s (v a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
Vector.Generic.replicateM
    [v a] -> v a
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.Generic.concat
{-# INLINE decodeVector #-}

-- | @since 0.2.0.0
instance (Serialise a) => Serialise (Vector.Vector a) where
  encode :: Vector a -> Encoding
encode = Vector a -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
encodeVector
  {-# INLINE encode #-}
  decode :: Decoder s (Vector a)
decode = Decoder s (Vector a)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
decodeVector
  {-# INLINE decode #-}

-- | @since 0.2.0.0
instance (Serialise a, Vector.Unboxed.Unbox a) =>
         Serialise (Vector.Unboxed.Vector a) where
  encode :: Vector a -> Encoding
encode = Vector a -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
encodeVector
  {-# INLINE encode #-}
  decode :: Decoder s (Vector a)
decode = Decoder s (Vector a)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
decodeVector
  {-# INLINE decode #-}

-- | @since 0.2.0.0
instance (Serialise a, Vector.Storable.Storable a) => Serialise (Vector.Storable.Vector a) where
  encode :: Vector a -> Encoding
encode = Vector a -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
encodeVector
  {-# INLINE encode #-}
  decode :: Decoder s (Vector a)
decode = Decoder s (Vector a)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
decodeVector
  {-# INLINE decode #-}

-- | @since 0.2.0.0
instance (Serialise a, Vector.Primitive.Prim a) => Serialise (Vector.Primitive.Vector a) where
  encode :: Vector a -> Encoding
encode = Vector a -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
encodeVector
  {-# INLINE encode #-}
  decode :: Decoder s (Vector a)
decode = Decoder s (Vector a)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
decodeVector
  {-# INLINE decode #-}



encodeSetSkel :: Serialise a
              => (s -> Int)
              -> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
              -> s
              -> Encoding
encodeSetSkel :: (s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> s
-> Encoding
encodeSetSkel size :: s -> Int
size foldr :: (a -> Encoding -> Encoding) -> Encoding -> s -> Encoding
foldr =
    (Word -> Encoding)
-> (s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> (a -> Encoding -> Encoding)
-> s
-> Encoding
forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel Word -> Encoding
encodeListLen s -> Int
size (a -> Encoding -> Encoding) -> Encoding -> s -> Encoding
foldr (\a :: a
a b :: Encoding
b -> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b)
{-# INLINE encodeSetSkel #-}

decodeSetSkel :: Serialise a
              => ([a] -> c) -> Decoder s c
decodeSetSkel :: ([a] -> c) -> Decoder s c
decodeSetSkel fromList :: [a] -> c
fromList = do
  Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
  ([a] -> c) -> Decoder s [a] -> Decoder s c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> c
fromList (Int -> Decoder s a -> Decoder s [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Decoder s a
forall a s. Serialise a => Decoder s a
decode)
{-# INLINE decodeSetSkel #-}

-- | @since 0.2.0.0
instance (Ord a, Serialise a) => Serialise (Set.Set a) where
  encode :: Set a -> Encoding
encode = (Set a -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> Set a -> Encoding)
-> Set a
-> Encoding
forall a s.
Serialise a =>
(s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> s
-> Encoding
encodeSetSkel Set a -> Int
forall a. Set a -> Int
Set.size (a -> Encoding -> Encoding) -> Encoding -> Set a -> Encoding
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr
  decode :: Decoder s (Set a)
decode = ([a] -> Set a) -> Decoder s (Set a)
forall a c s. Serialise a => ([a] -> c) -> Decoder s c
decodeSetSkel [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList

-- | @since 0.2.0.0
instance Serialise IntSet.IntSet where
  encode :: IntSet -> Encoding
encode = (IntSet -> Int)
-> ((Int -> Encoding -> Encoding)
    -> Encoding -> IntSet -> Encoding)
-> IntSet
-> Encoding
forall a s.
Serialise a =>
(s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> s
-> Encoding
encodeSetSkel IntSet -> Int
IntSet.size (Int -> Encoding -> Encoding) -> Encoding -> IntSet -> Encoding
forall b. (Int -> b -> b) -> b -> IntSet -> b
IntSet.foldr
  decode :: Decoder s IntSet
decode = ([Int] -> IntSet) -> Decoder s IntSet
forall a c s. Serialise a => ([a] -> c) -> Decoder s c
decodeSetSkel [Int] -> IntSet
IntSet.fromList

-- | @since 0.2.0.0
instance (Serialise a, Hashable a, Eq a) => Serialise (HashSet.HashSet a) where
  encode :: HashSet a -> Encoding
encode = (HashSet a -> Int)
-> ((a -> Encoding -> Encoding)
    -> Encoding -> HashSet a -> Encoding)
-> HashSet a
-> Encoding
forall a s.
Serialise a =>
(s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> s
-> Encoding
encodeSetSkel HashSet a -> Int
forall a. HashSet a -> Int
HashSet.size (a -> Encoding -> Encoding) -> Encoding -> HashSet a -> Encoding
forall b a. (b -> a -> a) -> a -> HashSet b -> a
HashSet.foldr
  decode :: Decoder s (HashSet a)
decode = ([a] -> HashSet a) -> Decoder s (HashSet a)
forall a c s. Serialise a => ([a] -> c) -> Decoder s c
decodeSetSkel [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList

-- | A helper function for encoding maps.
encodeMapSkel :: (Serialise k, Serialise v)
              => (m -> Int) -- ^ obtain the length
              -> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
              -> m
              -> Encoding
encodeMapSkel :: (m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> m
-> Encoding
encodeMapSkel size :: m -> Int
size foldrWithKey :: (k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding
foldrWithKey =
  (Word -> Encoding)
-> (m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> (k -> v -> Encoding -> Encoding)
-> m
-> Encoding
forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel
    Word -> Encoding
encodeMapLen
    m -> Int
size
    (k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding
foldrWithKey
    (\k :: k
k v :: v
v b :: Encoding
b -> k -> Encoding
forall a. Serialise a => a -> Encoding
encode k
k Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> v -> Encoding
forall a. Serialise a => a -> Encoding
encode v
v Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b)
{-# INLINE encodeMapSkel #-}

-- | A utility function to construct a 'Decoder' for maps.
decodeMapSkel :: (Serialise k, Serialise v)
              => ([(k,v)] -> m) -- ^ fromList
              -> Decoder s m
decodeMapSkel :: ([(k, v)] -> m) -> Decoder s m
decodeMapSkel fromList :: [(k, v)] -> m
fromList = do
  Int
n <- Decoder s Int
forall s. Decoder s Int
decodeMapLen
  let decodeEntry :: Decoder s (k, v)
decodeEntry = do
        !k
k <- Decoder s k
forall a s. Serialise a => Decoder s a
decode
        !v
v <- Decoder s v
forall a s. Serialise a => Decoder s a
decode
        (k, v) -> Decoder s (k, v)
forall (m :: * -> *) a. Monad m => a -> m a
return (k
k, v
v)
  ([(k, v)] -> m) -> Decoder s [(k, v)] -> Decoder s m
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> m
fromList (Int -> Decoder s (k, v) -> Decoder s [(k, v)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Decoder s (k, v)
forall s. Decoder s (k, v)
decodeEntry)
{-# INLINE decodeMapSkel #-}

-- | @since 0.2.0.0
instance (Ord k, Serialise k, Serialise v) => Serialise (Map.Map k v) where
  encode :: Map k v -> Encoding
encode = (Map k v -> Int)
-> ((k -> v -> Encoding -> Encoding)
    -> Encoding -> Map k v -> Encoding)
-> Map k v
-> Encoding
forall k v m.
(Serialise k, Serialise v) =>
(m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> m
-> Encoding
encodeMapSkel Map k v -> Int
forall k a. Map k a -> Int
Map.size (k -> v -> Encoding -> Encoding) -> Encoding -> Map k v -> Encoding
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
  decode :: Decoder s (Map k v)
decode = ([(k, v)] -> Map k v) -> Decoder s (Map k v)
forall k v m s.
(Serialise k, Serialise v) =>
([(k, v)] -> m) -> Decoder s m
decodeMapSkel [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

-- | @since 0.2.0.0
instance (Serialise a) => Serialise (IntMap.IntMap a) where
  encode :: IntMap a -> Encoding
encode = (IntMap a -> Int)
-> ((Int -> a -> Encoding -> Encoding)
    -> Encoding -> IntMap a -> Encoding)
-> IntMap a
-> Encoding
forall k v m.
(Serialise k, Serialise v) =>
(m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> m
-> Encoding
encodeMapSkel IntMap a -> Int
forall a. IntMap a -> Int
IntMap.size (Int -> a -> Encoding -> Encoding)
-> Encoding -> IntMap a -> Encoding
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey
  decode :: Decoder s (IntMap a)
decode = ([(Int, a)] -> IntMap a) -> Decoder s (IntMap a)
forall k v m s.
(Serialise k, Serialise v) =>
([(k, v)] -> m) -> Decoder s m
decodeMapSkel [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList

-- | @since 0.2.0.0
instance (Serialise k, Hashable k, Eq k, Serialise v) =>
  Serialise (HashMap.HashMap k v) where
  encode :: HashMap k v -> Encoding
encode = (HashMap k v -> Int)
-> ((k -> v -> Encoding -> Encoding)
    -> Encoding -> HashMap k v -> Encoding)
-> HashMap k v
-> Encoding
forall k v m.
(Serialise k, Serialise v) =>
(m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> m
-> Encoding
encodeMapSkel HashMap k v -> Int
forall k v. HashMap k v -> Int
HashMap.size (k -> v -> Encoding -> Encoding)
-> Encoding -> HashMap k v -> Encoding
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey
  decode :: Decoder s (HashMap k v)
decode = ([(k, v)] -> HashMap k v) -> Decoder s (HashMap k v)
forall k v m s.
(Serialise k, Serialise v) =>
([(k, v)] -> m) -> Decoder s m
decodeMapSkel [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList


--------------------------------------------------------------------------------
-- Misc base package instances

-- | @since 0.2.0.0
instance Serialise Version where
    encode :: Version -> Encoding
encode (Version ns :: [Int]
ns ts :: [String]
ts) = Word -> Encoding
encodeListLen 3
                          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Int] -> Encoding
forall a. Serialise a => a -> Encoding
encode [Int]
ns Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [String] -> Encoding
forall a. Serialise a => a -> Encoding
encode [String]
ts
    decode :: Decoder s Version
decode = do
      Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        0 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3
          -> do ![Int]
x <- Decoder s [Int]
forall a s. Serialise a => Decoder s a
decode
                ![String]
y <- Decoder s [String]
forall a s. Serialise a => Decoder s a
decode
                Version -> Decoder s Version
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> [String] -> Version
Version [Int]
x [String]
y)
        _ -> String -> Decoder s Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unexpected tag"

-- | @since 0.2.0.0
instance Serialise Fingerprint where
    encode :: Fingerprint -> Encoding
encode (Fingerprint w1 :: Word64
w1 w2 :: Word64
w2) = Word -> Encoding
encodeListLen 3
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
w1
                              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
w2
    decode :: Decoder s Fingerprint
decode = do
      Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 3
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        0 -> do !Word64
w1 <- Decoder s Word64
forall a s. Serialise a => Decoder s a
decode
                !Word64
w2 <- Decoder s Word64
forall a s. Serialise a => Decoder s a
decode
                Fingerprint -> Decoder s Fingerprint
forall (m :: * -> *) a. Monad m => a -> m a
return (Fingerprint -> Decoder s Fingerprint)
-> Fingerprint -> Decoder s Fingerprint
forall a b. (a -> b) -> a -> b
$! Word64 -> Word64 -> Fingerprint
Fingerprint Word64
w1 Word64
w2
        _ -> String -> Decoder s Fingerprint
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unexpected tag"

-- | @since 0.2.0.0
instance Serialise TyCon where
#if MIN_VERSION_base(4,10,0)
  encode :: TyCon -> Encoding
encode tc :: TyCon
tc
    = Word -> Encoding
encodeListLen 6
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> String -> Encoding
forall a. Serialise a => a -> Encoding
encode (TyCon -> String
tyConPackage TyCon
tc)
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> String -> Encoding
forall a. Serialise a => a -> Encoding
encode (TyCon -> String
tyConModule TyCon
tc)
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> String -> Encoding
forall a. Serialise a => a -> Encoding
encode (TyCon -> String
tyConName TyCon
tc)
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
forall a. Serialise a => a -> Encoding
encode (TyCon -> Int
tyConKindArgs TyCon
tc)
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KindRep -> Encoding
forall a. Serialise a => a -> Encoding
encode (TyCon -> KindRep
tyConKindRep TyCon
tc)
  decode :: Decoder s TyCon
decode = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 6
    Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
    case Word
tag of
      0 -> String -> String -> String -> Int -> KindRep -> TyCon
mkTyCon (String -> String -> String -> Int -> KindRep -> TyCon)
-> Decoder s String
-> Decoder s (String -> String -> Int -> KindRep -> TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s String
forall a s. Serialise a => Decoder s a
decode Decoder s (String -> String -> Int -> KindRep -> TyCon)
-> Decoder s String
-> Decoder s (String -> Int -> KindRep -> TyCon)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s String
forall a s. Serialise a => Decoder s a
decode Decoder s (String -> Int -> KindRep -> TyCon)
-> Decoder s String -> Decoder s (Int -> KindRep -> TyCon)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s String
forall a s. Serialise a => Decoder s a
decode Decoder s (Int -> KindRep -> TyCon)
-> Decoder s Int -> Decoder s (KindRep -> TyCon)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Int
forall a s. Serialise a => Decoder s a
decode Decoder s (KindRep -> TyCon)
-> Decoder s KindRep -> Decoder s TyCon
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s KindRep
forall a s. Serialise a => Decoder s a
decode
      _ -> String -> Decoder s TyCon
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unexpected tag"
#elif MIN_VERSION_base(4,9,0)
  encode tycon
    = encodeListLen 4
   <> encodeWord 0
   <> encode (tyConPackage tycon)
   <> encode (tyConModule  tycon)
   <> encode (tyConName    tycon)
#else
  encode (TyCon _ pkg modname name)
    = encodeListLen 4
   <> encodeWord 0
   <> encode pkg
   <> encode modname
   <> encode name
#endif

#if !MIN_VERSION_base(4,10,0)
  decode = do
    decodeListLenOf 4
    tag <- decodeWord
    case tag of
      0 -> do !pkg     <- decode
              !modname <- decode
              !name    <- decode
              return $! mkTyCon3 pkg modname name
      _ -> fail "unexpected tag"
#endif

#if MIN_VERSION_base(4,10,0)
-- | @since 0.2.0.0
instance Serialise VecCount where
  encode :: VecCount -> Encoding
encode c :: VecCount
c = Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ VecCount -> Int
forall a. Enum a => a -> Int
fromEnum VecCount
c)
  decode :: Decoder s VecCount
decode = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 1
    Int -> VecCount
forall a. Enum a => Int -> a
toEnum (Int -> VecCount) -> (Word -> Int) -> Word -> VecCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> VecCount) -> Decoder s Word -> Decoder s VecCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word
forall s. Decoder s Word
decodeWord

-- | @since 0.2.0.0
instance Serialise VecElem where
  encode :: VecElem -> Encoding
encode e :: VecElem
e = Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ VecElem -> Int
forall a. Enum a => a -> Int
fromEnum VecElem
e)
  decode :: Decoder s VecElem
decode = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 1
    Int -> VecElem
forall a. Enum a => Int -> a
toEnum (Int -> VecElem) -> (Word -> Int) -> Word -> VecElem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> VecElem) -> Decoder s Word -> Decoder s VecElem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word
forall s. Decoder s Word
decodeWord

-- | @since 0.2.0.0
instance Serialise RuntimeRep where
  encode :: RuntimeRep -> Encoding
encode rr :: RuntimeRep
rr =
    case RuntimeRep
rr of
      VecRep a :: VecCount
a b :: VecElem
b    -> Word -> Encoding
encodeListLen 3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VecCount -> Encoding
forall a. Serialise a => a -> Encoding
encode VecCount
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VecElem -> Encoding
forall a. Serialise a => a -> Encoding
encode VecElem
b
      TupleRep reps :: [RuntimeRep]
reps -> Word -> Encoding
encodeListLen 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [RuntimeRep] -> Encoding
forall a. Serialise a => a -> Encoding
encode [RuntimeRep]
reps
      SumRep reps :: [RuntimeRep]
reps   -> Word -> Encoding
encodeListLen 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [RuntimeRep] -> Encoding
forall a. Serialise a => a -> Encoding
encode [RuntimeRep]
reps
      LiftedRep     -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 3
      UnliftedRep   -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 4
      IntRep        -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 5
      WordRep       -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 6
      Int64Rep      -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 7
      Word64Rep     -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 8
      AddrRep       -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 9
      FloatRep      -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 10
      DoubleRep     -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 11
#if MIN_VERSION_base(4,13,0)
      Int8Rep       -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 12
      Int16Rep      -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 13
      Word8Rep      -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 14
      Word16Rep     -> Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 15
#endif
#if MIN_VERSION_base(4,14,0)
      Int32Rep      -> encodeListLen 1 <> encodeWord 16
      Word32Rep     -> encodeListLen 1 <> encodeWord 17
#endif

  decode :: Decoder s RuntimeRep
decode = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
    case Word
tag of
      0  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 -> VecCount -> VecElem -> RuntimeRep
VecRep (VecCount -> VecElem -> RuntimeRep)
-> Decoder s VecCount -> Decoder s (VecElem -> RuntimeRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s VecCount
forall a s. Serialise a => Decoder s a
decode Decoder s (VecElem -> RuntimeRep)
-> Decoder s VecElem -> Decoder s RuntimeRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s VecElem
forall a s. Serialise a => Decoder s a
decode
      1  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 -> [RuntimeRep] -> RuntimeRep
TupleRep ([RuntimeRep] -> RuntimeRep)
-> Decoder s [RuntimeRep] -> Decoder s RuntimeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [RuntimeRep]
forall a s. Serialise a => Decoder s a
decode
      2  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 -> [RuntimeRep] -> RuntimeRep
SumRep ([RuntimeRep] -> RuntimeRep)
-> Decoder s [RuntimeRep] -> Decoder s RuntimeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [RuntimeRep]
forall a s. Serialise a => Decoder s a
decode
      3  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
LiftedRep
      4  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
UnliftedRep
      5  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
IntRep
      6  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
WordRep
      7  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int64Rep
      8  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word64Rep
      9  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
AddrRep
      10 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
FloatRep
      11 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
DoubleRep
#if MIN_VERSION_base(4,13,0)
      12 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int8Rep
      13 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int16Rep
      14 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word8Rep
      15 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> RuntimeRep -> Decoder s RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word16Rep
#endif
#if MIN_VERSION_base(4,14,0)
      16 | len == 1 -> pure Int32Rep
      17 | len == 1 -> pure Word32Rep
#endif
      _             -> String -> Decoder s RuntimeRep
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Data.Serialise.Binary.CBOR.getRuntimeRep: invalid tag"

-- | @since 0.2.0.0
instance Serialise KindRep where
  encode :: KindRep -> Encoding
encode rep :: KindRep
rep =
    case KindRep
rep of
      KindRepTyConApp tc :: TyCon
tc k :: [KindRep]
k  -> Word -> Encoding
encodeListLen 3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TyCon -> Encoding
forall a. Serialise a => a -> Encoding
encode TyCon
tc Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [KindRep] -> Encoding
forall a. Serialise a => a -> Encoding
encode [KindRep]
k
      KindRepVar bndr :: Int
bndr       -> Word -> Encoding
encodeListLen 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
forall a. Serialise a => a -> Encoding
encode Int
bndr
      KindRepApp a :: KindRep
a b :: KindRep
b        -> Word -> Encoding
encodeListLen 3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KindRep -> Encoding
forall a. Serialise a => a -> Encoding
encode KindRep
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KindRep -> Encoding
forall a. Serialise a => a -> Encoding
encode KindRep
b
      KindRepFun a :: KindRep
a b :: KindRep
b        -> Word -> Encoding
encodeListLen 3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KindRep -> Encoding
forall a. Serialise a => a -> Encoding
encode KindRep
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KindRep -> Encoding
forall a. Serialise a => a -> Encoding
encode KindRep
b
      KindRepTYPE r :: RuntimeRep
r         -> Word -> Encoding
encodeListLen 2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RuntimeRep -> Encoding
forall a. Serialise a => a -> Encoding
encode RuntimeRep
r
      KindRepTypeLit sort :: TypeLitSort
sort r :: String
r -> Word -> Encoding
encodeListLen 3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 5 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TypeLitSort -> Encoding
forall a. Serialise a => a -> Encoding
encode TypeLitSort
sort Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> String -> Encoding
forall a. Serialise a => a -> Encoding
encode String
r

  decode :: Decoder s KindRep
decode = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
    case Word
tag of
      0 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 -> TyCon -> [KindRep] -> KindRep
KindRepTyConApp (TyCon -> [KindRep] -> KindRep)
-> Decoder s TyCon -> Decoder s ([KindRep] -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TyCon
forall a s. Serialise a => Decoder s a
decode Decoder s ([KindRep] -> KindRep)
-> Decoder s [KindRep] -> Decoder s KindRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s [KindRep]
forall a s. Serialise a => Decoder s a
decode
      1 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 -> Int -> KindRep
KindRepVar (Int -> KindRep) -> Decoder s Int -> Decoder s KindRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall a s. Serialise a => Decoder s a
decode
      2 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 -> KindRep -> KindRep -> KindRep
KindRepApp (KindRep -> KindRep -> KindRep)
-> Decoder s KindRep -> Decoder s (KindRep -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s KindRep
forall a s. Serialise a => Decoder s a
decode Decoder s (KindRep -> KindRep)
-> Decoder s KindRep -> Decoder s KindRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s KindRep
forall a s. Serialise a => Decoder s a
decode
      3 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 -> KindRep -> KindRep -> KindRep
KindRepFun (KindRep -> KindRep -> KindRep)
-> Decoder s KindRep -> Decoder s (KindRep -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s KindRep
forall a s. Serialise a => Decoder s a
decode Decoder s (KindRep -> KindRep)
-> Decoder s KindRep -> Decoder s KindRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s KindRep
forall a s. Serialise a => Decoder s a
decode
      4 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 -> RuntimeRep -> KindRep
KindRepTYPE (RuntimeRep -> KindRep)
-> Decoder s RuntimeRep -> Decoder s KindRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s RuntimeRep
forall a s. Serialise a => Decoder s a
decode
      5 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 -> TypeLitSort -> String -> KindRep
KindRepTypeLit (TypeLitSort -> String -> KindRep)
-> Decoder s TypeLitSort -> Decoder s (String -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TypeLitSort
forall a s. Serialise a => Decoder s a
decode Decoder s (String -> KindRep)
-> Decoder s String -> Decoder s KindRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s String
forall a s. Serialise a => Decoder s a
decode
      _            -> String -> Decoder s KindRep
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Data.Serialise.Binary.CBOR.getKindRep: invalid tag"

-- | @since 0.2.0.0
instance Serialise TypeLitSort where
  encode :: TypeLitSort -> Encoding
encode n :: TypeLitSort
n
    = Word -> Encoding
encodeListLen 1
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> case TypeLitSort
n of
        TypeLitSymbol -> Word -> Encoding
encodeWord 0
        TypeLitNat    -> Word -> Encoding
encodeWord 1
  decode :: Decoder s TypeLitSort
decode = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf 1
    Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
    case Word
tag of
      0 -> TypeLitSort -> Decoder s TypeLitSort
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLitSort
TypeLitSymbol
      1 -> TypeLitSort -> Decoder s TypeLitSort
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLitSort
TypeLitNat
      _ -> String -> Decoder s TypeLitSort
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Data.Serialise.Binary.CBOR.putTypeLitSort: invalid tag"

decodeSomeTypeRep :: Decoder s SomeTypeRep
decodeSomeTypeRep :: Decoder s SomeTypeRep
decodeSomeTypeRep = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
    case Word
tag of
      0 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 ->
              SomeTypeRep -> Decoder s SomeTypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> Decoder s SomeTypeRep)
-> SomeTypeRep -> Decoder s SomeTypeRep
forall a b. (a -> b) -> a -> b
$! TypeRep * -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep *
forall k (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep Type)
      1 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 -> do
              !TyCon
con <- Decoder s TyCon
forall a s. Serialise a => Decoder s a
decode
              ![SomeTypeRep]
ks <- Decoder s [SomeTypeRep]
forall a s. Serialise a => Decoder s a
decode
              SomeTypeRep -> Decoder s SomeTypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> Decoder s SomeTypeRep)
-> SomeTypeRep -> Decoder s SomeTypeRep
forall a b. (a -> b) -> a -> b
$! TypeRep Any -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep Any -> SomeTypeRep) -> TypeRep Any -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ TyCon -> [SomeTypeRep] -> TypeRep Any
forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
mkTrCon TyCon
con [SomeTypeRep]
ks
      2 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 -> do
              SomeTypeRep f :: TypeRep a
f <- Decoder s SomeTypeRep
forall s. Decoder s SomeTypeRep
decodeSomeTypeRep
              SomeTypeRep x :: TypeRep a
x <- Decoder s SomeTypeRep
forall s. Decoder s SomeTypeRep
decodeSomeTypeRep
              case TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
f of
                Fun arg :: TypeRep arg
arg res :: TypeRep res
res ->
                    case TypeRep arg
arg TypeRep arg -> TypeRep k -> Maybe (arg :~~: k)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
x of
                      Just HRefl -> do
                          case TypeRep res -> TypeRep (TYPE r2)
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep res
res TypeRep (TYPE r2) -> TypeRep * -> Maybe (TYPE r2 :~~: *)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` (TypeRep *
forall k (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep Type) of
                            Just HRefl -> SomeTypeRep -> Decoder s SomeTypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> Decoder s SomeTypeRep)
-> SomeTypeRep -> Decoder s SomeTypeRep
forall a b. (a -> b) -> a -> b
$! TypeRep (a a) -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep a -> TypeRep a -> TypeRep (a a)
forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrApp TypeRep a
TypeRep a
f TypeRep a
x)
                            _          -> String -> [String] -> Decoder s SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Kind mismatch" []
                      _ -> String -> [String] -> Decoder s SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Kind mismatch"
                           [ "Found argument of kind:      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep k -> String
forall a. Show a => a -> String
show (TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
x)
                           , "Where the constructor:       " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
f
                           , "Expects an argument of kind: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep arg -> String
forall a. Show a => a -> String
show TypeRep arg
arg
                           ]
                _ -> String -> [String] -> Decoder s SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Applied non-arrow type"
                     [ "Applied type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
f
                     , "To argument:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
x
                     ]
      3 | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 -> do
              SomeTypeRep arg :: TypeRep a
arg <- Decoder s SomeTypeRep
forall s. Decoder s SomeTypeRep
decodeSomeTypeRep
              SomeTypeRep res :: TypeRep a
res <- Decoder s SomeTypeRep
forall s. Decoder s SomeTypeRep
decodeSomeTypeRep
              case TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
arg TypeRep k -> TypeRep * -> Maybe (k :~~: *)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` (TypeRep *
forall k (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep Type) of
                Just HRefl ->
                    case  TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
res TypeRep k -> TypeRep * -> Maybe (k :~~: *)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` (TypeRep *
forall k (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep Type) of
                      Just HRefl -> SomeTypeRep -> Decoder s SomeTypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> Decoder s SomeTypeRep)
-> SomeTypeRep -> Decoder s SomeTypeRep
forall a b. (a -> b) -> a -> b
$! TypeRep (a -> a) -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep (a -> a) -> SomeTypeRep)
-> TypeRep (a -> a) -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ TypeRep a -> TypeRep a -> TypeRep (a -> a)
forall k (fun :: k) arg res.
(k ~ *, fun ~~ (arg -> res)) =>
TypeRep arg -> TypeRep res -> TypeRep fun
Fun TypeRep a
TypeRep a
arg TypeRep a
TypeRep a
res
                      Nothing -> String -> [String] -> Decoder s SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Kind mismatch" []
                Nothing -> String -> [String] -> Decoder s SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Kind mismatch" []
      _ -> String -> [String] -> Decoder s SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "unexpected tag"
           [ "Tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
tag
           , "Len: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len ]
  where
    failure :: String -> [String] -> m a
failure description :: String
description info :: [String]
info =
        String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ "Codec.CBOR.Class.decodeSomeTypeRep: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
description ]
                         [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("    "String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
info

encodeTypeRep :: TypeRep a -> Encoding
encodeTypeRep :: TypeRep a -> Encoding
encodeTypeRep rep :: TypeRep a
rep  -- Handle Type specially since it's so common
  | Just HRefl <- TypeRep a
rep TypeRep a -> TypeRep * -> Maybe (a :~~: *)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` (TypeRep *
forall k (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep Type)
  = Word -> Encoding
encodeListLen 1
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0
encodeTypeRep (Con' con :: TyCon
con ks :: [SomeTypeRep]
ks)
  = Word -> Encoding
encodeListLen 3
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 1
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TyCon -> Encoding
forall a. Serialise a => a -> Encoding
encode TyCon
con
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [SomeTypeRep] -> Encoding
forall a. Serialise a => a -> Encoding
encode [SomeTypeRep]
ks
encodeTypeRep (App f :: TypeRep a
f x :: TypeRep b
x)
  = Word -> Encoding
encodeListLen 3
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 2
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TypeRep a -> Encoding
forall k (a :: k). TypeRep a -> Encoding
encodeTypeRep TypeRep a
f
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TypeRep b -> Encoding
forall k (a :: k). TypeRep a -> Encoding
encodeTypeRep TypeRep b
x
encodeTypeRep (Fun arg :: TypeRep arg
arg res :: TypeRep res
res)
  = Word -> Encoding
encodeListLen 3
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 3
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TypeRep arg -> Encoding
forall k (a :: k). TypeRep a -> Encoding
encodeTypeRep TypeRep arg
arg
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TypeRep res -> Encoding
forall k (a :: k). TypeRep a -> Encoding
encodeTypeRep TypeRep res
res

-- | @since 0.2.0.0
instance Typeable a => Serialise (TypeRep (a :: k)) where
  encode :: TypeRep a -> Encoding
encode = TypeRep a -> Encoding
forall k (a :: k). TypeRep a -> Encoding
encodeTypeRep
  decode :: Decoder s (TypeRep a)
decode = do
      SomeTypeRep rep :: TypeRep a
rep <- Decoder s SomeTypeRep
forall s. Decoder s SomeTypeRep
decodeSomeTypeRep
      case TypeRep a
rep TypeRep a -> TypeRep a -> Maybe (a :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
expected of
        Just HRefl -> TypeRep a -> Decoder s (TypeRep a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeRep a
rep
        Nothing    -> String -> Decoder s (TypeRep a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (TypeRep a))
-> String -> Decoder s (TypeRep a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                      [ "Codec.CBOR.Class.decode(TypeRep): Type mismatch"
                      , "    Deserialised type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
rep
                      , "    Expected type:     " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
expected
                      ]
    where expected :: TypeRep a
expected = TypeRep a
forall k (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep a

-- | @since 0.2.0.0
instance Serialise SomeTypeRep where
  encode :: SomeTypeRep -> Encoding
encode (SomeTypeRep rep :: TypeRep a
rep) = TypeRep a -> Encoding
forall k (a :: k). TypeRep a -> Encoding
encodeTypeRep TypeRep a
rep
  decode :: Decoder s SomeTypeRep
decode = Decoder s SomeTypeRep
forall s. Decoder s SomeTypeRep
decodeSomeTypeRep

#else

-- | @since 0.2.0.0
instance Serialise TypeRep where
#if MIN_VERSION_base(4,8,0)
  encode (TypeRep fp tycon kirep tyrep)
    = encodeListLen 5
   <> encodeWord 0
   <> encode fp
   <> encode tycon
   <> encode kirep
   <> encode tyrep

  decode = do
    decodeListLenOf 5
    tag <- decodeWord
    case tag of
      0 -> do !fp    <- decode
              !tycon <- decode
              !kirep <- decode
              !tyrep <- decode
              return $! TypeRep fp tycon kirep tyrep
      _ -> fail "unexpected tag"
#else
  encode (TypeRep fp tycon tyrep)
    = encodeListLen 4
   <> encodeWord 0
   <> encode fp
   <> encode tycon
   <> encode tyrep

  decode = do
    decodeListLenOf 4
    tag <- decodeWord
    case tag of
      0 -> do !fp    <- decode
              !tycon <- decode
              !tyrep <- decode
              return $! TypeRep fp tycon tyrep
      _ -> fail "unexpected tag"
#endif

#endif /* !MIN_VERBOSE_base(4,10,0) */

--------------------------------------------------------------------------------
-- Time instances
--
-- CBOR has some special encodings for times/timestamps

-- | 'UTCTime' is encoded using the extended time format which is currently in
-- Internet Draft state,
-- https://tools.ietf.org/html/draft-bormann-cbor-time-tag-00.
--
-- @since 0.2.0.0
instance Serialise UTCTime where
    encode :: UTCTime -> Encoding
encode t :: UTCTime
t =
        Word -> Encoding
encodeTag 1000
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeMapLen 2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int64 -> Encoding
encodeInt64 Int64
secs
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
encodeInt (-12) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
encodeWord64 Word64
psecs
      where
        (secs :: Int64
secs, frac :: POSIXTime
frac) = case POSIXTime -> (Int64, POSIXTime)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (POSIXTime -> (Int64, POSIXTime))
-> POSIXTime -> (Int64, POSIXTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t of
                         -- fractional part must be positive
                         (secs' :: Int64
secs', frac' :: POSIXTime
frac')
                           | POSIXTime
frac' POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
< 0  -> (Int64
secs' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- 1, POSIXTime
frac' POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ 1)
                           | Bool
otherwise -> (Int64
secs', POSIXTime
frac')
        psecs :: Word64
psecs = POSIXTime -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Word64) -> POSIXTime -> Word64
forall a b. (a -> b) -> a -> b
$ POSIXTime
frac POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* 1000000000000

    decode :: Decoder s UTCTime
decode = do
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeTag
      case Word
tag of
        0 -> do Text
str <- Decoder s Text
forall s. Decoder s Text
decodeString
                case String -> Maybe UTCTime
parseUTCrfc3339 (Text -> String
Text.unpack Text
str) of
                  Just t :: UTCTime
t  -> UTCTime -> Decoder s UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Decoder s UTCTime) -> UTCTime -> Decoder s UTCTime
forall a b. (a -> b) -> a -> b
$! UTCTime -> UTCTime
forceUTCTime UTCTime
t
                  Nothing -> String -> Decoder s UTCTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Could not parse RFC3339 date"

        1 -> do
          TokenType
tt <- Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType
          case TokenType
tt of
            TypeUInt    -> Word -> UTCTime
forall a. Integral a => a -> UTCTime
utcFromIntegral (Word -> UTCTime) -> Decoder s Word -> Decoder s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word
forall s. Decoder s Word
decodeWord
            TypeUInt64  -> Word64 -> UTCTime
forall a. Integral a => a -> UTCTime
utcFromIntegral (Word64 -> UTCTime) -> Decoder s Word64 -> Decoder s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
decodeWord64
            TypeNInt    -> Int -> UTCTime
forall a. Integral a => a -> UTCTime
utcFromIntegral (Int -> UTCTime) -> Decoder s Int -> Decoder s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeInt
            TypeNInt64  -> Int64 -> UTCTime
forall a. Integral a => a -> UTCTime
utcFromIntegral (Int64 -> UTCTime) -> Decoder s Int64 -> Decoder s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int64
forall s. Decoder s Int64
decodeInt64
            TypeInteger -> Integer -> UTCTime
forall a. Integral a => a -> UTCTime
utcFromIntegral (Integer -> UTCTime) -> Decoder s Integer -> Decoder s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
decodeInteger
            TypeFloat16 -> Float -> UTCTime
forall a. Real a => a -> UTCTime
utcFromReal (Float -> UTCTime) -> Decoder s Float -> Decoder s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Float
forall s. Decoder s Float
decodeFloat
            TypeFloat32 -> Float -> UTCTime
forall a. Real a => a -> UTCTime
utcFromReal (Float -> UTCTime) -> Decoder s Float -> Decoder s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Float
forall s. Decoder s Float
decodeFloat
            TypeFloat64 -> Double -> UTCTime
forall a. Real a => a -> UTCTime
utcFromReal (Double -> UTCTime) -> Decoder s Double -> Decoder s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Double
forall s. Decoder s Double
decodeDouble
            _ -> String -> Decoder s UTCTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected numeric type following tag 1 (epoch offset)"

        -- Extended time
        1000 -> do
          Int
len <- Decoder s Int
forall s. Decoder s Int
decodeMapLen
          Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 2) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected list of length two (UTCTime)"

          Int
k0 <- Decoder s Int
forall s. Decoder s Int
decodeInt
          Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected key 1 in extended time"
          Int64
v0 <- Decoder s Int64
forall s. Decoder s Int64
decodeInt64

          Int
k1 <- Decoder s Int
forall s. Decoder s Int
decodeInt
          Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (-12)) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected key -12 in extended time"
          Word64
v1 <- Decoder s Word64
forall s. Decoder s Word64
decodeWord64
          let psecs :: Pico
              psecs :: Pico
psecs = Word64 -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
v1 Pico -> Pico -> Pico
forall a. Fractional a => a -> a -> a
/ 1000000000000

              dt :: POSIXTime
              dt :: POSIXTime
dt = Int64 -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int64
v0 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ Pico -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
psecs
          UTCTime -> Decoder s UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Decoder s UTCTime) -> UTCTime -> Decoder s UTCTime
forall a b. (a -> b) -> a -> b
$! UTCTime -> UTCTime
forceUTCTime (POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
dt)

        _ -> String -> Decoder s UTCTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected timestamp (tag 0, 1, or 40)"

epoch :: UTCTime
epoch :: UTCTime
epoch = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian 1970 1 1) 0

{-# INLINE utcFromIntegral #-}
utcFromIntegral :: Integral a => a -> UTCTime
utcFromIntegral :: a -> UTCTime
utcFromIntegral i :: a
i = POSIXTime -> UTCTime -> UTCTime
addUTCTime (a -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i) UTCTime
epoch

{-# INLINE utcFromReal #-}
utcFromReal :: Real a => a -> UTCTime
utcFromReal :: a -> UTCTime
utcFromReal f :: a
f = POSIXTime -> UTCTime -> UTCTime
addUTCTime (Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (a -> Rational
forall a. Real a => a -> Rational
toRational a
f)) UTCTime
epoch


-- | @'UTCTime'@ parsing, from a regular @'String'@.
parseUTCrfc3339  :: String -> Maybe UTCTime
#if MIN_VERSION_time(1,5,0)
parseUTCrfc3339 :: String -> Maybe UTCTime
parseUTCrfc3339  = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Z"
#else
parseUTCrfc3339  = parseTime        defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Z"
#endif

-- | Force the unnecessarily lazy @'UTCTime'@ representation.
forceUTCTime :: UTCTime -> UTCTime
forceUTCTime :: UTCTime -> UTCTime
forceUTCTime t :: UTCTime
t@(UTCTime !Day
_day !DiffTime
_daytime) = UTCTime
t

--------------------------------------------------------------------------------
-- Generic instances

-- Factored into two classes because this makes GHC optimize the
-- instances faster. This doesn't matter for builds of binary, but it
-- matters a lot for end-users who write 'instance Binary T'. See
-- also: https://ghc.haskell.org/trac/ghc/ticket/9630

-- | @since 0.2.0.0
class GSerialiseEncode f where
    -- | @since 0.2.0.0
    gencode  :: f a -> Encoding

-- | @since 0.2.0.0
class GSerialiseDecode f where
    -- | @since 0.2.0.0
    gdecode  :: Decoder s (f a)

-- | @since 0.2.0.0
instance GSerialiseEncode V1 where
    -- Data types without constructors are still serialised as null value
    gencode :: V1 a -> Encoding
gencode _ = Encoding
encodeNull

-- | @since 0.2.0.0
instance GSerialiseDecode V1 where
    gdecode :: Decoder s (V1 a)
gdecode   = String -> V1 a
forall a. HasCallStack => String -> a
error "V1 don't have contructors" V1 a -> Decoder s () -> Decoder s (V1 a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Decoder s ()
forall s. Decoder s ()
decodeNull

-- | @since 0.2.0.0
instance GSerialiseEncode U1 where
    -- Constructors without fields are serialised as null value
    gencode :: U1 a -> Encoding
gencode _ = Word -> Encoding
encodeListLen 1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0

-- | @since 0.2.0.0
instance GSerialiseDecode U1 where
    gdecode :: Decoder s (U1 a)
gdecode   = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expect list of length 1"
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
tag Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unexpected tag. Expect 0"
      U1 a -> Decoder s (U1 a)
forall (m :: * -> *) a. Monad m => a -> m a
return U1 a
forall k (p :: k). U1 p
U1

-- | @since 0.2.0.0
instance GSerialiseEncode a => GSerialiseEncode (M1 i c a) where
    -- Metadata (constructor name, etc) is skipped
    gencode :: M1 i c a a -> Encoding
gencode = a a -> Encoding
forall k (f :: k -> *) (a :: k).
GSerialiseEncode f =>
f a -> Encoding
gencode (a a -> Encoding) -> (M1 i c a a -> a a) -> M1 i c a a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c a a -> a a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

-- | @since 0.2.0.0
instance GSerialiseDecode a => GSerialiseDecode (M1 i c a) where
    gdecode :: Decoder s (M1 i c a a)
gdecode = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> Decoder s (a a) -> Decoder s (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (a a)
forall k (f :: k -> *) s (a :: k).
GSerialiseDecode f =>
Decoder s (f a)
gdecode

-- | @since 0.2.0.0
instance Serialise a => GSerialiseEncode (K1 i a) where
    -- Constructor field (Could only appear in one-field & one-constructor
    -- data types). In all other cases we go through GSerialise{Sum,Prod}
    gencode :: K1 i a a -> Encoding
gencode (K1 a :: a
a) = Word -> Encoding
encodeListLen 2
                  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0
                  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
a

-- | @since 0.2.0.0
instance Serialise a => GSerialiseDecode (K1 i a) where
    gdecode :: Decoder s (K1 i a a)
gdecode = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 2) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expect list of length 2"
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
tag Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unexpected tag. Expects 0"
      a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> Decoder s a -> Decoder s (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance (GSerialiseProd f, GSerialiseProd g) => GSerialiseEncode (f :*: g) where
    -- Products are serialised as N-tuples with 0 constructor tag
    gencode :: (:*:) f g a -> Encoding
gencode (f :: f a
f :*: g :: g a
g)
        = Word -> Encoding
encodeListLen (Proxy (f :*: g) -> Word
forall k (f :: k -> *). GSerialiseProd f => Proxy f -> Word
nFields (Proxy (f :*: g)
forall k (t :: k). Proxy t
Proxy :: Proxy (f :*: g)) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1)
       Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord 0
       Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f a -> Encoding
forall k (f :: k -> *) (a :: k).
GSerialiseProd f =>
f a -> Encoding
encodeSeq f a
f
       Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> g a -> Encoding
forall k (f :: k -> *) (a :: k).
GSerialiseProd f =>
f a -> Encoding
encodeSeq g a
g

-- | @since 0.2.0.0
instance (GSerialiseProd f, GSerialiseProd g) => GSerialiseDecode (f :*: g) where
    gdecode :: Decoder s ((:*:) f g a)
gdecode = do
      let nF :: Word
nF = Proxy (f :*: g) -> Word
forall k (f :: k -> *). GSerialiseProd f => Proxy f -> Word
nFields (Proxy (f :*: g)
forall k (t :: k). Proxy t
Proxy :: Proxy (f :*: g))
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      -- TODO FIXME: signedness of list length
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
nF Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ "Wrong number of fields: expected="String -> String -> String
forall a. [a] -> [a] -> [a]
++Word -> String
forall a. Show a => a -> String
show (Word
nFWord -> Word -> Word
forall a. Num a => a -> a -> a
+1)String -> String -> String
forall a. [a] -> [a] -> [a]
++" got="String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
n
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
tag Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ "unexpect tag (expect 0)"
      !f a
f <- Decoder s (f a)
forall k (f :: k -> *) s (a :: k).
GSerialiseProd f =>
Decoder s (f a)
gdecodeSeq
      !g a
g <- Decoder s (g a)
forall k (f :: k -> *) s (a :: k).
GSerialiseProd f =>
Decoder s (f a)
gdecodeSeq
      (:*:) f g a -> Decoder s ((:*:) f g a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:*:) f g a -> Decoder s ((:*:) f g a))
-> (:*:) f g a -> Decoder s ((:*:) f g a)
forall a b. (a -> b) -> a -> b
$ f a
f f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
g

-- | @since 0.2.0.0
instance (GSerialiseSum f, GSerialiseSum g) => GSerialiseEncode (f :+: g) where
    -- Sum types are serialised as N-tuples and first element is
    -- constructor tag
    gencode :: (:+:) f g a -> Encoding
gencode a :: (:+:) f g a
a = Word -> Encoding
encodeListLen ((:+:) f g a -> Word
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Word
numOfFields (:+:) f g a
a Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1)
             Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
forall a. Serialise a => a -> Encoding
encode ((:+:) f g a -> Word
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Word
conNumber (:+:) f g a
a)
             Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (:+:) f g a -> Encoding
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Encoding
encodeSum (:+:) f g a
a

-- | @since 0.2.0.0
instance (GSerialiseSum f, GSerialiseSum g) => GSerialiseDecode (f :+: g) where
    gdecode :: Decoder s ((:+:) f g a)
gdecode = do
        Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
        -- TODO FIXME: Again signedness
        Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
          String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Empty list encountered for sum type"
        Word
nCon  <- Decoder s Word
forall s. Decoder s Word
decodeWord
        Word
trueN <- Proxy (f :+: g) -> Word -> Decoder s Word
forall k (f :: k -> *) s.
GSerialiseSum f =>
Proxy f -> Word -> Decoder s Word
fieldsForCon (Proxy (f :+: g)
forall k (t :: k). Proxy t
Proxy :: Proxy (f :+: g)) Word
nCon
        Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
trueN ) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
          String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ "Number of fields mismatch: expected="String -> String -> String
forall a. [a] -> [a] -> [a]
++Word -> String
forall a. Show a => a -> String
show Word
trueNString -> String -> String
forall a. [a] -> [a] -> [a]
++" got="String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
n
        Word -> Decoder s ((:+:) f g a)
forall k (f :: k -> *) s (a :: k).
GSerialiseSum f =>
Word -> Decoder s (f a)
decodeSum Word
nCon


-- | Serialization of product types
class GSerialiseProd f where
    -- | Number of fields in product type
    nFields   :: Proxy f -> Word
    -- | Encode fields sequentially without writing header
    encodeSeq :: f a -> Encoding
    -- | Decode fields sequentially without reading header
    gdecodeSeq :: Decoder s (f a)

-- | @since 0.2.0.0
instance (GSerialiseProd f, GSerialiseProd g) => GSerialiseProd (f :*: g) where
    nFields :: Proxy (f :*: g) -> Word
nFields _ = Proxy f -> Word
forall k (f :: k -> *). GSerialiseProd f => Proxy f -> Word
nFields (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Proxy g -> Word
forall k (f :: k -> *). GSerialiseProd f => Proxy f -> Word
nFields (Proxy g
forall k (t :: k). Proxy t
Proxy :: Proxy g)
    encodeSeq :: (:*:) f g a -> Encoding
encodeSeq (f :: f a
f :*: g :: g a
g) = f a -> Encoding
forall k (f :: k -> *) (a :: k).
GSerialiseProd f =>
f a -> Encoding
encodeSeq f a
f Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> g a -> Encoding
forall k (f :: k -> *) (a :: k).
GSerialiseProd f =>
f a -> Encoding
encodeSeq g a
g
    gdecodeSeq :: Decoder s ((:*:) f g a)
gdecodeSeq = do !f a
f <- Decoder s (f a)
forall k (f :: k -> *) s (a :: k).
GSerialiseProd f =>
Decoder s (f a)
gdecodeSeq
                    !g a
g <- Decoder s (g a)
forall k (f :: k -> *) s (a :: k).
GSerialiseProd f =>
Decoder s (f a)
gdecodeSeq
                    (:*:) f g a -> Decoder s ((:*:) f g a)
forall (m :: * -> *) a. Monad m => a -> m a
return (f a
f f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
g)

-- | @since 0.2.0.0
instance GSerialiseProd U1 where
    -- N.B. Could only be reached when one of constructors in sum type
    --      don't have parameters
    nFields :: Proxy U1 -> Word
nFields   _ = 0
    encodeSeq :: U1 a -> Encoding
encodeSeq _ = Encoding
forall a. Monoid a => a
mempty
    gdecodeSeq :: Decoder s (U1 a)
gdecodeSeq  = U1 a -> Decoder s (U1 a)
forall (m :: * -> *) a. Monad m => a -> m a
return U1 a
forall k (p :: k). U1 p
U1

-- | @since 0.2.0.0
instance (Serialise a) => GSerialiseProd (K1 i a) where
    -- Ordinary field
    nFields :: Proxy (K1 i a) -> Word
nFields    _     = 1
    encodeSeq :: K1 i a a -> Encoding
encodeSeq (K1 f :: a
f) = a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
f
    gdecodeSeq :: Decoder s (K1 i a a)
gdecodeSeq       = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> Decoder s a -> Decoder s (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | @since 0.2.0.0
instance (i ~ S, GSerialiseProd f) => GSerialiseProd (M1 i c f) where
    -- We skip metadata
    nFields :: Proxy (M1 i c f) -> Word
nFields     _     = 1
    encodeSeq :: M1 i c f a -> Encoding
encodeSeq  (M1 f :: f a
f) = f a -> Encoding
forall k (f :: k -> *) (a :: k).
GSerialiseProd f =>
f a -> Encoding
encodeSeq f a
f
    gdecodeSeq :: Decoder s (M1 i c f a)
gdecodeSeq        = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i c f a) -> Decoder s (f a) -> Decoder s (M1 i c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (f a)
forall k (f :: k -> *) s (a :: k).
GSerialiseProd f =>
Decoder s (f a)
gdecodeSeq

-- | Serialization of sum types
--
-- @since 0.2.0.0
class GSerialiseSum f where
    -- | Number of constructor of given value
    conNumber   :: f a -> Word
    -- | Number of fields of given value
    numOfFields :: f a -> Word
    -- | Encode field
    encodeSum   :: f a  -> Encoding

    -- | Decode field
    decodeSum     :: Word -> Decoder s (f a)
    -- | Number of constructors
    nConstructors :: Proxy f -> Word
    -- | Number of fields for given constructor number
    fieldsForCon  :: Proxy f -> Word -> Decoder s Word

-- | @since 0.2.0.0
instance (GSerialiseSum f, GSerialiseSum g) => GSerialiseSum (f :+: g) where
    conNumber :: (:+:) f g a -> Word
conNumber x :: (:+:) f g a
x = case (:+:) f g a
x of
      L1 f :: f a
f -> f a -> Word
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Word
conNumber f a
f
      R1 g :: g a
g -> g a -> Word
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Word
conNumber g a
g Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Proxy f -> Word
forall k (f :: k -> *). GSerialiseSum f => Proxy f -> Word
nConstructors (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)
    numOfFields :: (:+:) f g a -> Word
numOfFields x :: (:+:) f g a
x = case (:+:) f g a
x of
      L1 f :: f a
f -> f a -> Word
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Word
numOfFields f a
f
      R1 g :: g a
g -> g a -> Word
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Word
numOfFields g a
g
    encodeSum :: (:+:) f g a -> Encoding
encodeSum x :: (:+:) f g a
x = case (:+:) f g a
x of
      L1 f :: f a
f -> f a -> Encoding
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Encoding
encodeSum f a
f
      R1 g :: g a
g -> g a -> Encoding
forall k (f :: k -> *) (a :: k). GSerialiseSum f => f a -> Encoding
encodeSum g a
g

    nConstructors :: Proxy (f :+: g) -> Word
nConstructors _ = Proxy f -> Word
forall k (f :: k -> *). GSerialiseSum f => Proxy f -> Word
nConstructors (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)
                    Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Proxy g -> Word
forall k (f :: k -> *). GSerialiseSum f => Proxy f -> Word
nConstructors (Proxy g
forall k (t :: k). Proxy t
Proxy :: Proxy g)

    fieldsForCon :: Proxy (f :+: g) -> Word -> Decoder s Word
fieldsForCon _ n :: Word
n | Word
n Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
nL    = Proxy f -> Word -> Decoder s Word
forall k (f :: k -> *) s.
GSerialiseSum f =>
Proxy f -> Word -> Decoder s Word
fieldsForCon (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) Word
n
                     | Bool
otherwise = Proxy g -> Word -> Decoder s Word
forall k (f :: k -> *) s.
GSerialiseSum f =>
Proxy f -> Word -> Decoder s Word
fieldsForCon (Proxy g
forall k (t :: k). Proxy t
Proxy :: Proxy g) (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
nL)
      where
        nL :: Word
nL = Proxy f -> Word
forall k (f :: k -> *). GSerialiseSum f => Proxy f -> Word
nConstructors (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)

    decodeSum :: Word -> Decoder s ((:+:) f g a)
decodeSum nCon :: Word
nCon | Word
nCon Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
nL = f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> (:+:) f g a) -> Decoder s (f a) -> Decoder s ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Decoder s (f a)
forall k (f :: k -> *) s (a :: k).
GSerialiseSum f =>
Word -> Decoder s (f a)
decodeSum Word
nCon
                   | Bool
otherwise = g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> (:+:) f g a) -> Decoder s (g a) -> Decoder s ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Decoder s (g a)
forall k (f :: k -> *) s (a :: k).
GSerialiseSum f =>
Word -> Decoder s (f a)
decodeSum (Word
nCon Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
nL)
      where
        nL :: Word
nL = Proxy f -> Word
forall k (f :: k -> *). GSerialiseSum f => Proxy f -> Word
nConstructors (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)

-- | @since 0.2.0.0
instance (i ~ C, GSerialiseProd f) => GSerialiseSum (M1 i c f) where
    conNumber :: M1 i c f a -> Word
conNumber    _     = 0
    numOfFields :: M1 i c f a -> Word
numOfFields  _     = Proxy f -> Word
forall k (f :: k -> *). GSerialiseProd f => Proxy f -> Word
nFields (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)
    encodeSum :: M1 i c f a -> Encoding
encodeSum   (M1 f :: f a
f) = f a -> Encoding
forall k (f :: k -> *) (a :: k).
GSerialiseProd f =>
f a -> Encoding
encodeSeq f a
f

    nConstructors :: Proxy (M1 i c f) -> Word
nConstructors  _ = 1
    fieldsForCon :: Proxy (M1 i c f) -> Word -> Decoder s Word
fieldsForCon _ 0 = Word -> Decoder s Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Decoder s Word) -> Word -> Decoder s Word
forall a b. (a -> b) -> a -> b
$ Proxy f -> Word
forall k (f :: k -> *). GSerialiseProd f => Proxy f -> Word
nFields (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)
    fieldsForCon _ _ = String -> Decoder s Word
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Bad constructor number"
    decodeSum :: Word -> Decoder s (M1 i c f a)
decodeSum      0 = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i c f a) -> Decoder s (f a) -> Decoder s (M1 i c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (f a)
forall k (f :: k -> *) s (a :: k).
GSerialiseProd f =>
Decoder s (f a)
gdecodeSeq
    decodeSum      _ = String -> Decoder s (M1 i c f a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "bad constructor number"