{-# LANGUAGE CPP, FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if MIN_VERSION_base(4,8,0)
#define HAS_NATURAL
#define HAS_VOID
#endif
#if MIN_VERSION_base(4,7,0)
#define HAS_FIXED_CONSTRUCTOR
#endif
module Data.Binary.Class (
Binary(..)
, GBinaryGet(..)
, GBinaryPut(..)
) where
import Data.Word
import Data.Bits
import Data.Int
import Data.Complex (Complex(..))
#ifdef HAS_VOID
import Data.Void
#endif
import Data.Binary.Put
import Data.Binary.Get
#if ! MIN_VERSION_base(4,8,0)
import Control.Applicative
import Data.Monoid (mempty)
#endif
import qualified Data.Monoid as Monoid
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity (..))
#endif
#if MIN_VERSION_base(4,9,0)
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as Semigroup
#endif
import Control.Monad
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Builder.Prim as Prim
import Data.List (unfoldr, foldl')
#if MIN_VERSION_base(4,10,0)
import Type.Reflection
import Type.Reflection.Unsafe
import Data.Kind (Type)
import GHC.Exts (RuntimeRep(..), VecCount, VecElem)
#endif
import qualified Data.ByteString as B
#if MIN_VERSION_bytestring(0,10,4)
import qualified Data.ByteString.Short as BS
#endif
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Ratio as R
import qualified Data.Tree as T
import Data.Array.Unboxed
import GHC.Generics
#ifdef HAS_NATURAL
import Numeric.Natural
#endif
import qualified Data.Fixed as Fixed
import qualified Data.Sequence as Seq
import qualified Data.Foldable as Fold
import GHC.Fingerprint
import Data.Version (Version(..))
class GBinaryPut f where
gput :: f t -> Put
class GBinaryGet f where
gget :: Get (f t)
class Binary t where
put :: t -> Put
get :: Get t
putList :: [t] -> Put
putList = [t] -> Put
forall a. Binary a => [a] -> Put
defaultPutList
default put :: (Generic t, GBinaryPut (Rep t)) => t -> Put
put = Rep t Any -> Put
forall k (f :: k -> *) (t :: k). GBinaryPut f => f t -> Put
gput (Rep t Any -> Put) -> (t -> Rep t Any) -> t -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Rep t Any
forall a x. Generic a => a -> Rep a x
from
default get :: (Generic t, GBinaryGet (Rep t)) => Get t
get = Rep t Any -> t
forall a x. Generic a => Rep a x -> a
to (Rep t Any -> t) -> Get (Rep t Any) -> Get t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get (Rep t Any)
forall k (f :: k -> *) (t :: k). GBinaryGet f => Get (f t)
gget
{-# INLINE defaultPutList #-}
defaultPutList :: Binary a => [a] -> Put
defaultPutList :: [a] -> Put
defaultPutList xs :: [a]
xs = Int -> Put
forall t. Binary t => t -> Put
put ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> (a -> Put) -> [a] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Put
forall t. Binary t => t -> Put
put [a]
xs
#ifdef HAS_VOID
instance Binary Void where
put :: Void -> Put
put = Void -> Put
forall a. Void -> a
absurd
get :: Get Void
get = Get Void
forall (m :: * -> *) a. MonadPlus m => m a
mzero
#endif
instance Binary () where
put :: () -> Put
put () = Put
forall a. Monoid a => a
mempty
get :: Get ()
get = () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Binary Bool where
put :: Bool -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (Bool -> Word8) -> Bool -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Bool -> Int) -> Bool -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum
get :: Get Bool
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Bool) -> Get Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Bool
forall a (m :: * -> *).
(Eq a, Num a, MonadFail m, Show a) =>
a -> m Bool
toBool
where
toBool :: a -> m Bool
toBool 0 = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
toBool 1 = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
toBool c :: a
c = String -> m Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Could not map value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " to Bool")
instance Binary Ordering where
put :: Ordering -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (Ordering -> Word8) -> Ordering -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Ordering -> Int) -> Ordering -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Int
forall a. Enum a => a -> Int
fromEnum
get :: Get Ordering
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Ordering) -> Get Ordering
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Ordering
forall a (m :: * -> *).
(Eq a, Num a, MonadFail m, Show a) =>
a -> m Ordering
toOrd
where
toOrd :: a -> m Ordering
toOrd 0 = Ordering -> m Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
LT
toOrd 1 = Ordering -> m Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ
toOrd 2 = Ordering -> m Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
GT
toOrd c :: a
c = String -> m Ordering
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Could not map value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " to Ordering")
instance Binary Word8 where
put :: Word8 -> Put
put = Word8 -> Put
putWord8
{-# INLINE putList #-}
putList :: [Word8] -> Put
putList xs :: [Word8]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Word8 -> [Word8] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Word8
Prim.word8 [Word8]
xs)
get :: Get Word8
get = Get Word8
getWord8
instance Binary Word16 where
put :: Word16 -> Put
put = Word16 -> Put
putWord16be
{-# INLINE putList #-}
putList :: [Word16] -> Put
putList xs :: [Word16]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Word16] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word16]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Word16 -> [Word16] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Word16
Prim.word16BE [Word16]
xs)
get :: Get Word16
get = Get Word16
getWord16be
instance Binary Word32 where
put :: Word32 -> Put
put = Word32 -> Put
putWord32be
{-# INLINE putList #-}
putList :: [Word32] -> Put
putList xs :: [Word32]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Word32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word32]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Word32 -> [Word32] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Word32
Prim.word32BE [Word32]
xs)
get :: Get Word32
get = Get Word32
getWord32be
instance Binary Word64 where
put :: Word64 -> Put
put = Word64 -> Put
putWord64be
{-# INLINE putList #-}
putList :: [Word64] -> Put
putList xs :: [Word64]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Word64] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word64]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Word64 -> [Word64] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Word64
Prim.word64BE [Word64]
xs)
get :: Get Word64
get = Get Word64
getWord64be
instance Binary Int8 where
put :: Int8 -> Put
put = Int8 -> Put
putInt8
{-# INLINE putList #-}
putList :: [Int8] -> Put
putList xs :: [Int8]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Int8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int8]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Int8 -> [Int8] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Int8
Prim.int8 [Int8]
xs)
get :: Get Int8
get = Get Int8
getInt8
instance Binary Int16 where
put :: Int16 -> Put
put = Int16 -> Put
putInt16be
{-# INLINE putList #-}
putList :: [Int16] -> Put
putList xs :: [Int16]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Int16] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int16]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Int16 -> [Int16] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Int16
Prim.int16BE [Int16]
xs)
get :: Get Int16
get = Get Int16
getInt16be
instance Binary Int32 where
put :: Int32 -> Put
put = Int32 -> Put
putInt32be
{-# INLINE putList #-}
putList :: [Int32] -> Put
putList xs :: [Int32]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Int32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int32]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Int32 -> [Int32] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Int32
Prim.int32BE [Int32]
xs)
get :: Get Int32
get = Get Int32
getInt32be
instance Binary Int64 where
put :: Int64 -> Put
put = Int64 -> Put
putInt64be
{-# INLINE putList #-}
putList :: [Int64] -> Put
putList xs :: [Int64]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Int64] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Int64 -> [Int64] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Int64
Prim.int64BE [Int64]
xs)
get :: Get Int64
get = Get Int64
getInt64be
instance Binary Word where
put :: Word -> Put
put = Word64 -> Put
putWord64be (Word64 -> Put) -> (Word -> Word64) -> Word -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE putList #-}
putList :: [Word] -> Put
putList xs :: [Word]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Word] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Word64 -> [Word64] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Word64
Prim.word64BE ((Word -> Word64) -> [Word] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word]
xs))
get :: Get Word
get = (Word64 -> Word) -> Get Word64 -> Get Word
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word64
getWord64be
instance Binary Int where
put :: Int -> Put
put = Int64 -> Put
putInt64be (Int64 -> Put) -> (Int -> Int64) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE putList #-}
putList :: [Int] -> Put
putList xs :: [Int]
xs =
Int -> Put
forall t. Binary t => t -> Put
put ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Builder -> Put
putBuilder (FixedPrim Int64 -> [Int64] -> Builder
forall a. FixedPrim a -> [a] -> Builder
Prim.primMapListFixed FixedPrim Int64
Prim.int64BE ((Int -> Int64) -> [Int] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
xs))
get :: Get Int
get = (Int64 -> Int) -> Get Int64 -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int64
getInt64be
type SmallInt = Int32
instance Binary Integer where
{-# INLINE put #-}
put :: Integer -> Put
put n :: Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
lo Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
hi =
Builder -> Put
putBuilder (FixedPrim (Word8, Int32) -> (Word8, Int32) -> Builder
forall a. FixedPrim a -> a -> Builder
Prim.primFixed (FixedPrim Word8
Prim.word8 FixedPrim Word8 -> FixedPrim Int32 -> FixedPrim (Word8, Int32)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
Prim.>*< FixedPrim Int32
Prim.int32BE) (0, Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n))
where
lo :: Integer
lo = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
minBound :: SmallInt) :: Integer
hi :: Integer
hi = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
maxBound :: SmallInt) :: Integer
put n :: Integer
n =
Word8 -> Put
putWord8 1
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word8 -> Put
forall t. Binary t => t -> Put
put Word8
sign
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> [Word8] -> Put
forall t. Binary t => t -> Put
put (Integer -> [Word8]
forall a. (Integral a, Bits a) => a -> [Word8]
unroll (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n))
where
sign :: Word8
sign = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Integer
forall a. Num a => a -> a
signum Integer
n) :: Word8
{-# INLINE get #-}
get :: Get Integer
get = do
Word8
tag <- Get Word8
forall t. Binary t => Get t
get :: Get Word8
case Word8
tag of
0 -> (Int32 -> Integer) -> Get Int32 -> Get Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Int32
forall t. Binary t => Get t
get :: Get SmallInt)
_ -> do Word8
sign <- Get Word8
forall t. Binary t => Get t
get
[Word8]
bytes <- Get [Word8]
forall t. Binary t => Get t
get
let v :: Integer
v = [Word8] -> Integer
forall a. (Integral a, Bits a) => [Word8] -> a
roll [Word8]
bytes
Integer -> Get Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Get Integer) -> Integer -> Get Integer
forall a b. (a -> b) -> a -> b
$! if Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== (1 :: Word8) then Integer
v else - Integer
v
#ifdef HAS_FIXED_CONSTRUCTOR
instance Binary (Fixed.Fixed a) where
put :: Fixed a -> Put
put (Fixed.MkFixed a :: Integer
a) = Integer -> Put
forall t. Binary t => t -> Put
put Integer
a
get :: Get (Fixed a)
get = Integer -> Fixed a
forall a. Integer -> Fixed a
Fixed.MkFixed (Integer -> Fixed a) -> Get Integer -> Get (Fixed a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Get Integer
forall t. Binary t => Get t
get
#else
instance forall a. Fixed.HasResolution a => Binary (Fixed.Fixed a) where
put x = put (truncate (x * fromInteger (Fixed.resolution (undefined :: Maybe a))) :: Integer)
get = (\x -> fromInteger x / fromInteger (Fixed.resolution (undefined :: Maybe a))) `liftM` get
#endif
unroll :: (Integral a, Bits a) => a -> [Word8]
unroll :: a -> [Word8]
unroll = (a -> Maybe (Word8, a)) -> a -> [Word8]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr a -> Maybe (Word8, a)
forall b a. (Integral b, Num a, Bits b) => b -> Maybe (a, b)
step
where
step :: b -> Maybe (a, b)
step 0 = Maybe (a, b)
forall a. Maybe a
Nothing
step i :: b
i = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
i, b
i b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` 8)
roll :: (Integral a, Bits a) => [Word8] -> a
roll :: [Word8] -> a
roll = (a -> Word8 -> a) -> a -> [Word8] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Word8 -> a
forall a a. (Bits a, Integral a, Num a) => a -> a -> a
unstep 0 ([Word8] -> a) -> ([Word8] -> [Word8]) -> [Word8] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
forall a. [a] -> [a]
reverse
where
unstep :: a -> a -> a
unstep a :: a
a b :: a
b = a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` 8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b
#ifdef HAS_NATURAL
type NaturalWord = Word64
instance Binary Natural where
{-# INLINE put #-}
put :: Natural -> Put
put n :: Natural
n | Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
hi =
Word8 -> Put
putWord8 0
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word64 -> Put
forall t. Binary t => t -> Put
put (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n :: NaturalWord)
where
hi :: Natural
hi = Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: NaturalWord) :: Natural
put n :: Natural
n =
Word8 -> Put
putWord8 1
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> [Word8] -> Put
forall t. Binary t => t -> Put
put (Natural -> [Word8]
forall a. (Integral a, Bits a) => a -> [Word8]
unroll (Natural -> Natural
forall a. Num a => a -> a
abs Natural
n))
{-# INLINE get #-}
get :: Get Natural
get = do
Word8
tag <- Get Word8
forall t. Binary t => Get t
get :: Get Word8
case Word8
tag of
0 -> (Word64 -> Natural) -> Get Word64 -> Get Natural
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word64
forall t. Binary t => Get t
get :: Get NaturalWord)
_ -> do [Word8]
bytes <- Get [Word8]
forall t. Binary t => Get t
get
Natural -> Get Natural
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Get Natural) -> Natural -> Get Natural
forall a b. (a -> b) -> a -> b
$! [Word8] -> Natural
forall a. (Integral a, Bits a) => [Word8] -> a
roll [Word8]
bytes
#endif
instance (Binary a,Integral a) => Binary (R.Ratio a) where
put :: Ratio a -> Put
put r :: Ratio a
r = a -> Put
forall t. Binary t => t -> Put
put (Ratio a -> a
forall a. Ratio a -> a
R.numerator Ratio a
r) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> a -> Put
forall t. Binary t => t -> Put
put (Ratio a -> a
forall a. Ratio a -> a
R.denominator Ratio a
r)
get :: Get (Ratio a)
get = (a -> a -> Ratio a) -> Get a -> Get a -> Get (Ratio a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
(R.%) Get a
forall t. Binary t => Get t
get Get a
forall t. Binary t => Get t
get
instance Binary a => Binary (Complex a) where
{-# INLINE put #-}
put :: Complex a -> Put
put (r :: a
r :+ i :: a
i) = (a, a) -> Put
forall t. Binary t => t -> Put
put (a
r, a
i)
{-# INLINE get #-}
get :: Get (Complex a)
get = (\(r :: a
r,i :: a
i) -> a
r a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
i) ((a, a) -> Complex a) -> Get (a, a) -> Get (Complex a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (a, a)
forall t. Binary t => Get t
get
instance Binary Char where
put :: Char -> Put
put = Char -> Put
putCharUtf8
putList :: String -> Put
putList str :: String
str = Int -> Put
forall t. Binary t => t -> Put
put (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> String -> Put
putStringUtf8 String
str
get :: Get Char
get = do
let getByte :: Get Int
getByte = (Word8 -> Int) -> Get Word8 -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Int) Get Word8
forall t. Binary t => Get t
get
shiftL6 :: Int -> Int
shiftL6 = (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 6 :: Int -> Int
Int
w <- Get Int
getByte
Int
r <- case () of
_ | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0x80 -> Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
w
| Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0xe0 -> do
Int
x <- (Int -> Int) -> Get Int -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0x80) Get Int
getByte
Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6 (Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0xc0 Int
w))
| Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0xf0 -> do
Int
x <- (Int -> Int) -> Get Int -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0x80) Get Int
getByte
Int
y <- (Int -> Int) -> Get Int -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0x80) Get Int
getByte
Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6 (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6
(Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0xe0 Int
w)))
| Bool
otherwise -> do
Int
x <- (Int -> Int) -> Get Int -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0x80) Get Int
getByte
Int
y <- (Int -> Int) -> Get Int -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0x80) Get Int
getByte
Int
z <- (Int -> Int) -> Get Int -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0x80) Get Int
getByte
Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
z Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6 (Int
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6
(Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6 (Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor 0xf0 Int
w))))
Int -> Get Char
forall a (m :: * -> *) a.
(Ord a, Num a, Enum a, Enum a, MonadFail m) =>
a -> m a
getChr Int
r
where
getChr :: a -> m a
getChr w :: a
w
| a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x10ffff = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
w
| Bool
otherwise = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Not a valid Unicode code point!"
instance (Binary a, Binary b) => Binary (a,b) where
{-# INLINE put #-}
put :: (a, b) -> Put
put (a :: a
a,b :: b
b) = a -> Put
forall t. Binary t => t -> Put
put a
a Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> b -> Put
forall t. Binary t => t -> Put
put b
b
{-# INLINE get #-}
get :: Get (a, b)
get = (a -> b -> (a, b)) -> Get a -> Get b -> Get (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Get a
forall t. Binary t => Get t
get Get b
forall t. Binary t => Get t
get
instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
{-# INLINE put #-}
put :: (a, b, c) -> Put
put (a :: a
a,b :: b
b,c :: c
c) = a -> Put
forall t. Binary t => t -> Put
put a
a Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> b -> Put
forall t. Binary t => t -> Put
put b
b Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> c -> Put
forall t. Binary t => t -> Put
put c
c
{-# INLINE get #-}
get :: Get (a, b, c)
get = (a -> b -> c -> (a, b, c))
-> Get a -> Get b -> Get c -> Get (a, b, c)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) Get a
forall t. Binary t => Get t
get Get b
forall t. Binary t => Get t
get Get c
forall t. Binary t => Get t
get
instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
{-# INLINE put #-}
put :: (a, b, c, d) -> Put
put (a :: a
a,b :: b
b,c :: c
c,d :: d
d) = a -> Put
forall t. Binary t => t -> Put
put a
a Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> b -> Put
forall t. Binary t => t -> Put
put b
b Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> c -> Put
forall t. Binary t => t -> Put
put c
c Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> d -> Put
forall t. Binary t => t -> Put
put d
d
{-# INLINE get #-}
get :: Get (a, b, c, d)
get = (a -> b -> c -> d -> (a, b, c, d))
-> Get a -> Get b -> Get c -> Get d -> Get (a, b, c, d)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) Get a
forall t. Binary t => Get t
get Get b
forall t. Binary t => Get t
get Get c
forall t. Binary t => Get t
get Get d
forall t. Binary t => Get t
get
instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d,e) where
{-# INLINE put #-}
put :: (a, b, c, d, e) -> Put
put (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e) = a -> Put
forall t. Binary t => t -> Put
put a
a Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> b -> Put
forall t. Binary t => t -> Put
put b
b Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> c -> Put
forall t. Binary t => t -> Put
put c
c Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> d -> Put
forall t. Binary t => t -> Put
put d
d Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> e -> Put
forall t. Binary t => t -> Put
put e
e
{-# INLINE get #-}
get :: Get (a, b, c, d, e)
get = (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Get a -> Get b -> Get c -> Get d -> Get e -> Get (a, b, c, d, e)
forall (m :: * -> *) a1 a2 a3 a4 a5 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> a5 -> r)
-> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
liftM5 (,,,,) Get a
forall t. Binary t => Get t
get Get b
forall t. Binary t => Get t
get Get c
forall t. Binary t => Get t
get Get d
forall t. Binary t => Get t
get Get e
forall t. Binary t => Get t
get
instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f)
=> Binary (a,b,c,d,e,f) where
{-# INLINE put #-}
put :: (a, b, c, d, e, f) -> Put
put (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f) = (a, (b, c, d, e, f)) -> Put
forall t. Binary t => t -> Put
put (a
a,(b
b,c
c,d
d,e
e,f
f))
{-# INLINE get #-}
get :: Get (a, b, c, d, e, f)
get = do (a :: a
a,(b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f)) <- Get (a, (b, c, d, e, f))
forall t. Binary t => Get t
get ; (a, b, c, d, e, f) -> Get (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)
instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g)
=> Binary (a,b,c,d,e,f,g) where
{-# INLINE put #-}
put :: (a, b, c, d, e, f, g) -> Put
put (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f,g :: g
g) = (a, (b, c, d, e, f, g)) -> Put
forall t. Binary t => t -> Put
put (a
a,(b
b,c
c,d
d,e
e,f
f,g
g))
{-# INLINE get #-}
get :: Get (a, b, c, d, e, f, g)
get = do (a :: a
a,(b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f,g :: g
g)) <- Get (a, (b, c, d, e, f, g))
forall t. Binary t => Get t
get ; (a, b, c, d, e, f, g) -> Get (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)
instance (Binary a, Binary b, Binary c, Binary d, Binary e,
Binary f, Binary g, Binary h)
=> Binary (a,b,c,d,e,f,g,h) where
{-# INLINE put #-}
put :: (a, b, c, d, e, f, g, h) -> Put
put (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f,g :: g
g,h :: h
h) = (a, (b, c, d, e, f, g, h)) -> Put
forall t. Binary t => t -> Put
put (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h))
{-# INLINE get #-}
get :: Get (a, b, c, d, e, f, g, h)
get = do (a :: a
a,(b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f,g :: g
g,h :: h
h)) <- Get (a, (b, c, d, e, f, g, h))
forall t. Binary t => Get t
get ; (a, b, c, d, e, f, g, h) -> Get (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)
instance (Binary a, Binary b, Binary c, Binary d, Binary e,
Binary f, Binary g, Binary h, Binary i)
=> Binary (a,b,c,d,e,f,g,h,i) where
{-# INLINE put #-}
put :: (a, b, c, d, e, f, g, h, i) -> Put
put (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) = (a, (b, c, d, e, f, g, h, i)) -> Put
forall t. Binary t => t -> Put
put (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i))
{-# INLINE get #-}
get :: Get (a, b, c, d, e, f, g, h, i)
get = do (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)) <- Get (a, (b, c, d, e, f, g, h, i))
forall t. Binary t => Get t
get ; (a, b, c, d, e, f, g, h, i) -> Get (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)
instance (Binary a, Binary b, Binary c, Binary d, Binary e,
Binary f, Binary g, Binary h, Binary i, Binary j)
=> Binary (a,b,c,d,e,f,g,h,i,j) where
{-# INLINE put #-}
put :: (a, b, c, d, e, f, g, h, i, j) -> Put
put (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,j :: j
j) = (a, (b, c, d, e, f, g, h, i, j)) -> Put
forall t. Binary t => t -> Put
put (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j))
{-# INLINE get #-}
get :: Get (a, b, c, d, e, f, g, h, i, j)
get = do (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,j :: j
j)) <- Get (a, (b, c, d, e, f, g, h, i, j))
forall t. Binary t => Get t
get ; (a, b, c, d, e, f, g, h, i, j)
-> Get (a, b, c, d, e, f, g, h, i, j)
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,j
j)
#if MIN_VERSION_base(4,8,0)
instance Binary a => Binary (Identity a) where
put :: Identity a -> Put
put (Identity x :: a
x) = a -> Put
forall t. Binary t => t -> Put
put a
x
get :: Get (Identity a)
get = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Get a -> Get (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get
#endif
instance Binary a => Binary [a] where
put :: [a] -> Put
put = [a] -> Put
forall a. Binary a => [a] -> Put
putList
get :: Get [a]
get = do Int
n <- Get Int
forall t. Binary t => Get t
get :: Get Int
Int -> Get [a]
forall a. Binary a => Int -> Get [a]
getMany Int
n
getMany :: Binary a => Int -> Get [a]
getMany :: Int -> Get [a]
getMany n :: Int
n = [a] -> Int -> Get [a]
forall t a. (Eq t, Num t, Binary a) => [a] -> t -> Get [a]
go [] Int
n
where
go :: [a] -> t -> Get [a]
go xs :: [a]
xs 0 = [a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Get [a]) -> [a] -> Get [a]
forall a b. (a -> b) -> a -> b
$! [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs
go xs :: [a]
xs i :: t
i = do a
x <- Get a
forall t. Binary t => Get t
get
a
x a -> Get [a] -> Get [a]
forall a b. a -> b -> b
`seq` [a] -> t -> Get [a]
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) (t
it -> t -> t
forall a. Num a => a -> a -> a
-1)
{-# INLINE getMany #-}
instance (Binary a) => Binary (Maybe a) where
put :: Maybe a -> Put
put Nothing = Word8 -> Put
putWord8 0
put (Just x :: a
x) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> a -> Put
forall t. Binary t => t -> Put
put a
x
get :: Get (Maybe a)
get = do
Word8
w <- Get Word8
getWord8
case Word8
w of
0 -> Maybe a -> Get (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
_ -> (a -> Maybe a) -> Get a -> Get (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just Get a
forall t. Binary t => Get t
get
instance (Binary a, Binary b) => Binary (Either a b) where
put :: Either a b -> Put
put (Left a :: a
a) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> a -> Put
forall t. Binary t => t -> Put
put a
a
put (Right b :: b
b) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> b -> Put
forall t. Binary t => t -> Put
put b
b
get :: Get (Either a b)
get = do
Word8
w <- Get Word8
getWord8
case Word8
w of
0 -> (a -> Either a b) -> Get a -> Get (Either a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either a b
forall a b. a -> Either a b
Left Get a
forall t. Binary t => Get t
get
_ -> (b -> Either a b) -> Get b -> Get (Either a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Either a b
forall a b. b -> Either a b
Right Get b
forall t. Binary t => Get t
get
instance Binary B.ByteString where
put :: ByteString -> Put
put bs :: ByteString
bs = Int -> Put
forall t. Binary t => t -> Put
put (ByteString -> Int
B.length ByteString
bs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> ByteString -> Put
putByteString ByteString
bs
get :: Get ByteString
get = Get Int
forall t. Binary t => Get t
get Get Int -> (Int -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString
instance Binary ByteString where
put :: ByteString -> Put
put bs :: ByteString
bs = Int -> Put
forall t. Binary t => t -> Put
put (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
L.length ByteString
bs) :: Int)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> ByteString -> Put
putLazyByteString ByteString
bs
get :: Get ByteString
get = Get Int64
forall t. Binary t => Get t
get Get Int64 -> (Int64 -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64 -> Get ByteString
getLazyByteString
#if MIN_VERSION_bytestring(0,10,4)
instance Binary BS.ShortByteString where
put :: ShortByteString -> Put
put bs :: ShortByteString
bs = Int -> Put
forall t. Binary t => t -> Put
put (ShortByteString -> Int
BS.length ShortByteString
bs)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Put
putShortByteString ShortByteString
bs
get :: Get ShortByteString
get = Get Int
forall t. Binary t => Get t
get Get Int -> (Int -> Get ShortByteString) -> Get ShortByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> ShortByteString)
-> Get ByteString -> Get ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ShortByteString
BS.toShort (Get ByteString -> Get ShortByteString)
-> (Int -> Get ByteString) -> Int -> Get ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get ByteString
getByteString
#endif
instance (Binary a) => Binary (Set.Set a) where
put :: Set a -> Put
put s :: Set a
s = Int -> Put
forall t. Binary t => t -> Put
put (Set a -> Int
forall a. Set a -> Int
Set.size Set a
s) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> (a -> Put) -> [a] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Put
forall t. Binary t => t -> Put
put (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
s)
get :: Get (Set a)
get = ([a] -> Set a) -> Get [a] -> Get (Set a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [a] -> Set a
forall a. [a] -> Set a
Set.fromDistinctAscList Get [a]
forall t. Binary t => Get t
get
instance (Binary k, Binary e) => Binary (Map.Map k e) where
put :: Map k e -> Put
put m :: Map k e
m = Int -> Put
forall t. Binary t => t -> Put
put (Map k e -> Int
forall k a. Map k a -> Int
Map.size Map k e
m) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> ((k, e) -> Put) -> [(k, e)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (k, e) -> Put
forall t. Binary t => t -> Put
put (Map k e -> [(k, e)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map k e
m)
get :: Get (Map k e)
get = ([(k, e)] -> Map k e) -> Get [(k, e)] -> Get (Map k e)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(k, e)] -> Map k e
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList Get [(k, e)]
forall t. Binary t => Get t
get
instance Binary IntSet.IntSet where
put :: IntSet -> Put
put s :: IntSet
s = Int -> Put
forall t. Binary t => t -> Put
put (IntSet -> Int
IntSet.size IntSet
s) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> (Int -> Put) -> [Int] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> Put
forall t. Binary t => t -> Put
put (IntSet -> [Int]
IntSet.toAscList IntSet
s)
get :: Get IntSet
get = ([Int] -> IntSet) -> Get [Int] -> Get IntSet
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Int] -> IntSet
IntSet.fromDistinctAscList Get [Int]
forall t. Binary t => Get t
get
instance (Binary e) => Binary (IntMap.IntMap e) where
put :: IntMap e -> Put
put m :: IntMap e
m = Int -> Put
forall t. Binary t => t -> Put
put (IntMap e -> Int
forall a. IntMap a -> Int
IntMap.size IntMap e
m) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> ((Int, e) -> Put) -> [(Int, e)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, e) -> Put
forall t. Binary t => t -> Put
put (IntMap e -> [(Int, e)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap e
m)
get :: Get (IntMap e)
get = ([(Int, e)] -> IntMap e) -> Get [(Int, e)] -> Get (IntMap e)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(Int, e)] -> IntMap e
forall a. [(Int, a)] -> IntMap a
IntMap.fromDistinctAscList Get [(Int, e)]
forall t. Binary t => Get t
get
instance (Binary e) => Binary (Seq.Seq e) where
put :: Seq e -> Put
put s :: Seq e
s = Int -> Put
forall t. Binary t => t -> Put
put (Seq e -> Int
forall a. Seq a -> Int
Seq.length Seq e
s) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> (e -> Put) -> Seq e -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Fold.mapM_ e -> Put
forall t. Binary t => t -> Put
put Seq e
s
get :: Get (Seq e)
get = do Int
n <- Get Int
forall t. Binary t => Get t
get :: Get Int
Seq e -> Int -> Get e -> Get (Seq e)
forall t (m :: * -> *) a.
(Eq t, Num t, Monad m) =>
Seq a -> t -> m a -> m (Seq a)
rep Seq e
forall a. Seq a
Seq.empty Int
n Get e
forall t. Binary t => Get t
get
where rep :: Seq a -> t -> m a -> m (Seq a)
rep xs :: Seq a
xs 0 _ = Seq a -> m (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a -> m (Seq a)) -> Seq a -> m (Seq a)
forall a b. (a -> b) -> a -> b
$! Seq a
xs
rep xs :: Seq a
xs n :: t
n g :: m a
g = Seq a
xs Seq a -> m (Seq a) -> m (Seq a)
forall a b. a -> b -> b
`seq` t
n t -> m (Seq a) -> m (Seq a)
forall a b. a -> b -> b
`seq` do
a
x <- m a
g
Seq a -> t -> m a -> m (Seq a)
rep (Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
x) (t
nt -> t -> t
forall a. Num a => a -> a -> a
-1) m a
g
instance Binary Double where
put :: Double -> Put
put d :: Double
d = (Integer, Int) -> Put
forall t. Binary t => t -> Put
put (Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
d)
get :: Get Double
get = do
Integer
x <- Get Integer
forall t. Binary t => Get t
get
Int
y <- Get Int
forall t. Binary t => Get t
get
Double -> Get Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Get Double) -> Double -> Get Double
forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
x Int
y
instance Binary Float where
put :: Float -> Put
put f :: Float
f = (Integer, Int) -> Put
forall t. Binary t => t -> Put
put (Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
f)
get :: Get Float
get = do
Integer
x <- Get Integer
forall t. Binary t => Get t
get
Int
y <- Get Int
forall t. Binary t => Get t
get
Float -> Get Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> Get Float) -> Float -> Get Float
forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
x Int
y
instance (Binary e) => Binary (T.Tree e) where
put :: Tree e -> Put
put (T.Node r :: e
r s :: [Tree e]
s) = e -> Put
forall t. Binary t => t -> Put
put e
r Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> [Tree e] -> Put
forall t. Binary t => t -> Put
put [Tree e]
s
get :: Get (Tree e)
get = (e -> [Tree e] -> Tree e) -> Get e -> Get [Tree e] -> Get (Tree e)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 e -> [Tree e] -> Tree e
forall a. a -> Forest a -> Tree a
T.Node Get e
forall t. Binary t => Get t
get Get [Tree e]
forall t. Binary t => Get t
get
instance (Binary i, Ix i, Binary e) => Binary (Array i e) where
put :: Array i e -> Put
put a :: Array i e
a =
(i, i) -> Put
forall t. Binary t => t -> Put
put (Array i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array i e
a)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Int -> Put
forall t. Binary t => t -> Put
put ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize ((i, i) -> Int) -> (i, i) -> Int
forall a b. (a -> b) -> a -> b
$ Array i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array i e
a)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> (e -> Put) -> [e] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ e -> Put
forall t. Binary t => t -> Put
put (Array i e -> [e]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems Array i e
a)
get :: Get (Array i e)
get = do
(i, i)
bs <- Get (i, i)
forall t. Binary t => Get t
get
Int
n <- Get Int
forall t. Binary t => Get t
get
[e]
xs <- Int -> Get [e]
forall a. Binary a => Int -> Get [a]
getMany Int
n
Array i e -> Get (Array i e)
forall (m :: * -> *) a. Monad m => a -> m a
return ((i, i) -> [e] -> Array i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
bs [e]
xs)
instance (Binary i, Ix i, Binary e, IArray UArray e) => Binary (UArray i e) where
put :: UArray i e -> Put
put a :: UArray i e
a =
(i, i) -> Put
forall t. Binary t => t -> Put
put (UArray i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray i e
a)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Int -> Put
forall t. Binary t => t -> Put
put ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize ((i, i) -> Int) -> (i, i) -> Int
forall a b. (a -> b) -> a -> b
$ UArray i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray i e
a)
Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> (e -> Put) -> [e] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ e -> Put
forall t. Binary t => t -> Put
put (UArray i e -> [e]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray i e
a)
get :: Get (UArray i e)
get = do
(i, i)
bs <- Get (i, i)
forall t. Binary t => Get t
get
Int
n <- Get Int
forall t. Binary t => Get t
get
[e]
xs <- Int -> Get [e]
forall a. Binary a => Int -> Get [a]
getMany Int
n
UArray i e -> Get (UArray i e)
forall (m :: * -> *) a. Monad m => a -> m a
return ((i, i) -> [e] -> UArray i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
bs [e]
xs)
instance Binary Fingerprint where
put :: Fingerprint -> Put
put (Fingerprint x1 :: Word64
x1 x2 :: Word64
x2) = Word64 -> Put
forall t. Binary t => t -> Put
put Word64
x1 Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word64 -> Put
forall t. Binary t => t -> Put
put Word64
x2
get :: Get Fingerprint
get = do
Word64
x1 <- Get Word64
forall t. Binary t => Get t
get
Word64
x2 <- Get Word64
forall t. Binary t => Get t
get
Fingerprint -> Get Fingerprint
forall (m :: * -> *) a. Monad m => a -> m a
return (Fingerprint -> Get Fingerprint) -> Fingerprint -> Get Fingerprint
forall a b. (a -> b) -> a -> b
$! Word64 -> Word64 -> Fingerprint
Fingerprint Word64
x1 Word64
x2
instance Binary Version where
put :: Version -> Put
put (Version br :: [Int]
br tags :: [String]
tags) = [Int] -> Put
forall t. Binary t => t -> Put
put [Int]
br Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> [String] -> Put
forall t. Binary t => t -> Put
put [String]
tags
get :: Get Version
get = [Int] -> [String] -> Version
Version ([Int] -> [String] -> Version)
-> Get [Int] -> Get ([String] -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Int]
forall t. Binary t => Get t
get Get ([String] -> Version) -> Get [String] -> Get Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [String]
forall t. Binary t => Get t
get
instance Binary a => Binary (Monoid.Dual a) where
get :: Get (Dual a)
get = (a -> Dual a) -> Get a -> Get (Dual a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Dual a
forall a. a -> Dual a
Monoid.Dual Get a
forall t. Binary t => Get t
get
put :: Dual a -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> (Dual a -> a) -> Dual a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual a -> a
forall a. Dual a -> a
Monoid.getDual
instance Binary Monoid.All where
get :: Get All
get = (Bool -> All) -> Get Bool -> Get All
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> All
Monoid.All Get Bool
forall t. Binary t => Get t
get
put :: All -> Put
put = Bool -> Put
forall t. Binary t => t -> Put
put (Bool -> Put) -> (All -> Bool) -> All -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. All -> Bool
Monoid.getAll
instance Binary Monoid.Any where
get :: Get Any
get = (Bool -> Any) -> Get Bool -> Get Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Any
Monoid.Any Get Bool
forall t. Binary t => Get t
get
put :: Any -> Put
put = Bool -> Put
forall t. Binary t => t -> Put
put (Bool -> Put) -> (Any -> Bool) -> Any -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Bool
Monoid.getAny
instance Binary a => Binary (Monoid.Sum a) where
get :: Get (Sum a)
get = (a -> Sum a) -> Get a -> Get (Sum a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Sum a
forall a. a -> Sum a
Monoid.Sum Get a
forall t. Binary t => Get t
get
put :: Sum a -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> (Sum a -> a) -> Sum a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum a -> a
forall a. Sum a -> a
Monoid.getSum
instance Binary a => Binary (Monoid.Product a) where
get :: Get (Product a)
get = (a -> Product a) -> Get a -> Get (Product a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Product a
forall a. a -> Product a
Monoid.Product Get a
forall t. Binary t => Get t
get
put :: Product a -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> (Product a -> a) -> Product a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product a -> a
forall a. Product a -> a
Monoid.getProduct
instance Binary a => Binary (Monoid.First a) where
get :: Get (First a)
get = (Maybe a -> First a) -> Get (Maybe a) -> Get (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> First a
forall a. Maybe a -> First a
Monoid.First Get (Maybe a)
forall t. Binary t => Get t
get
put :: First a -> Put
put = Maybe a -> Put
forall t. Binary t => t -> Put
put (Maybe a -> Put) -> (First a -> Maybe a) -> First a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First a -> Maybe a
forall a. First a -> Maybe a
Monoid.getFirst
instance Binary a => Binary (Monoid.Last a) where
get :: Get (Last a)
get = (Maybe a -> Last a) -> Get (Maybe a) -> Get (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Last a
forall a. Maybe a -> Last a
Monoid.Last Get (Maybe a)
forall t. Binary t => Get t
get
put :: Last a -> Put
put = Maybe a -> Put
forall t. Binary t => t -> Put
put (Maybe a -> Put) -> (Last a -> Maybe a) -> Last a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last a -> Maybe a
forall a. Last a -> Maybe a
Monoid.getLast
#if MIN_VERSION_base(4,8,0)
instance Binary (f a) => Binary (Monoid.Alt f a) where
get :: Get (Alt f a)
get = (f a -> Alt f a) -> Get (f a) -> Get (Alt f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Alt f a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Monoid.Alt Get (f a)
forall t. Binary t => Get t
get
put :: Alt f a -> Put
put = f a -> Put
forall t. Binary t => t -> Put
put (f a -> Put) -> (Alt f a -> f a) -> Alt f a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alt f a -> f a
forall k (f :: k -> *) (a :: k). Alt f a -> f a
Monoid.getAlt
#endif
#if MIN_VERSION_base(4,9,0)
instance Binary a => Binary (Semigroup.Min a) where
get :: Get (Min a)
get = (a -> Min a) -> Get a -> Get (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 Get a
forall t. Binary t => Get t
get
put :: Min a -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> (Min a -> a) -> Min a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Min a -> a
forall a. Min a -> a
Semigroup.getMin
instance Binary a => Binary (Semigroup.Max a) where
get :: Get (Max a)
get = (a -> Max a) -> Get a -> Get (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 Get a
forall t. Binary t => Get t
get
put :: Max a -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> (Max a -> a) -> Max a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Max a -> a
forall a. Max a -> a
Semigroup.getMax
instance Binary a => Binary (Semigroup.First a) where
get :: Get (First a)
get = (a -> First a) -> Get a -> Get (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 Get a
forall t. Binary t => Get t
get
put :: First a -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> (First a -> a) -> First a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First a -> a
forall a. First a -> a
Semigroup.getFirst
instance Binary a => Binary (Semigroup.Last a) where
get :: Get (Last a)
get = (a -> Last a) -> Get a -> Get (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 Get a
forall t. Binary t => Get t
get
put :: Last a -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> (Last a -> a) -> Last a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last a -> a
forall a. Last a -> a
Semigroup.getLast
instance Binary a => Binary (Semigroup.Option a) where
get :: Get (Option a)
get = (Maybe a -> Option a) -> Get (Maybe a) -> Get (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 Get (Maybe a)
forall t. Binary t => Get t
get
put :: Option a -> Put
put = Maybe a -> Put
forall t. Binary t => t -> Put
put (Maybe a -> Put) -> (Option a -> Maybe a) -> Option a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> Maybe a
forall a. Option a -> Maybe a
Semigroup.getOption
instance Binary m => Binary (Semigroup.WrappedMonoid m) where
get :: Get (WrappedMonoid m)
get = (m -> WrappedMonoid m) -> Get m -> Get (WrappedMonoid m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m -> WrappedMonoid m
forall m. m -> WrappedMonoid m
Semigroup.WrapMonoid Get m
forall t. Binary t => Get t
get
put :: WrappedMonoid m -> Put
put = m -> Put
forall t. Binary t => t -> Put
put (m -> Put) -> (WrappedMonoid m -> m) -> WrappedMonoid m -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMonoid m -> m
forall m. WrappedMonoid m -> m
Semigroup.unwrapMonoid
instance (Binary a, Binary b) => Binary (Semigroup.Arg a b) where
get :: Get (Arg a b)
get = (a -> b -> Arg a b) -> Get a -> Get b -> Get (Arg a b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> b -> Arg a b
forall a b. a -> b -> Arg a b
Semigroup.Arg Get a
forall t. Binary t => Get t
get Get b
forall t. Binary t => Get t
get
put :: Arg a b -> Put
put (Semigroup.Arg a :: a
a b :: b
b) = a -> Put
forall t. Binary t => t -> Put
put a
a Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> b -> Put
forall t. Binary t => t -> Put
put b
b
instance Binary a => Binary (NE.NonEmpty a) where
get :: Get (NonEmpty a)
get = do
[a]
list <- Get [a]
forall t. Binary t => Get t
get
case [a]
list of
[] -> String -> Get (NonEmpty a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "NonEmpty is empty!"
x :: a
x:xs :: [a]
xs -> NonEmpty a -> Get (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
NE.:| [a]
xs)
put :: NonEmpty a -> Put
put = [a] -> Put
forall t. Binary t => t -> Put
put ([a] -> Put) -> (NonEmpty a -> [a]) -> NonEmpty a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList
#endif
#if MIN_VERSION_base(4,10,0)
instance Binary VecCount where
put :: VecCount -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (VecCount -> Word8) -> VecCount -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (VecCount -> Int) -> VecCount -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VecCount -> Int
forall a. Enum a => a -> Int
fromEnum
get :: Get VecCount
get = Int -> VecCount
forall a. Enum a => Int -> a
toEnum (Int -> VecCount) -> (Word8 -> Int) -> Word8 -> VecCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> VecCount) -> Get Word8 -> Get VecCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
instance Binary VecElem where
put :: VecElem -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (VecElem -> Word8) -> VecElem -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (VecElem -> Int) -> VecElem -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VecElem -> Int
forall a. Enum a => a -> Int
fromEnum
get :: Get VecElem
get = Int -> VecElem
forall a. Enum a => Int -> a
toEnum (Int -> VecElem) -> (Word8 -> Int) -> Word8 -> VecElem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> VecElem) -> Get Word8 -> Get VecElem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
instance Binary RuntimeRep where
put :: RuntimeRep -> Put
put (VecRep a :: VecCount
a b :: VecElem
b) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VecCount -> Put
forall t. Binary t => t -> Put
put VecCount
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VecElem -> Put
forall t. Binary t => t -> Put
put VecElem
b
put (TupleRep reps :: [RuntimeRep]
reps) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [RuntimeRep] -> Put
forall t. Binary t => t -> Put
put [RuntimeRep]
reps
put (SumRep reps :: [RuntimeRep]
reps) = Word8 -> Put
putWord8 2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [RuntimeRep] -> Put
forall t. Binary t => t -> Put
put [RuntimeRep]
reps
put LiftedRep = Word8 -> Put
putWord8 3
put UnliftedRep = Word8 -> Put
putWord8 4
put IntRep = Word8 -> Put
putWord8 5
put WordRep = Word8 -> Put
putWord8 6
put Int64Rep = Word8 -> Put
putWord8 7
put Word64Rep = Word8 -> Put
putWord8 8
put AddrRep = Word8 -> Put
putWord8 9
put FloatRep = Word8 -> Put
putWord8 10
put DoubleRep = Word8 -> Put
putWord8 11
#if __GLASGOW_HASKELL__ >= 807
put Int8Rep = Word8 -> Put
putWord8 12
put Word8Rep = Word8 -> Put
putWord8 13
put Int16Rep = Word8 -> Put
putWord8 14
put Word16Rep = Word8 -> Put
putWord8 15
#endif
get :: Get RuntimeRep
get = do
Word8
tag <- Get Word8
getWord8
case Word8
tag of
0 -> VecCount -> VecElem -> RuntimeRep
VecRep (VecCount -> VecElem -> RuntimeRep)
-> Get VecCount -> Get (VecElem -> RuntimeRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get VecCount
forall t. Binary t => Get t
get Get (VecElem -> RuntimeRep) -> Get VecElem -> Get RuntimeRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get VecElem
forall t. Binary t => Get t
get
1 -> [RuntimeRep] -> RuntimeRep
TupleRep ([RuntimeRep] -> RuntimeRep) -> Get [RuntimeRep] -> Get RuntimeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [RuntimeRep]
forall t. Binary t => Get t
get
2 -> [RuntimeRep] -> RuntimeRep
SumRep ([RuntimeRep] -> RuntimeRep) -> Get [RuntimeRep] -> Get RuntimeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [RuntimeRep]
forall t. Binary t => Get t
get
3 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
LiftedRep
4 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
UnliftedRep
5 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
IntRep
6 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
WordRep
7 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int64Rep
8 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word64Rep
9 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
AddrRep
10 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
FloatRep
11 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
DoubleRep
#if __GLASGOW_HASKELL__ >= 807
12 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int8Rep
13 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word8Rep
14 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int16Rep
15 -> RuntimeRep -> Get RuntimeRep
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word16Rep
#endif
_ -> String -> Get RuntimeRep
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GHCi.TH.Binary.putRuntimeRep: invalid tag"
instance Binary TyCon where
put :: TyCon -> Put
put tc :: TyCon
tc = do
String -> Put
forall t. Binary t => t -> Put
put (TyCon -> String
tyConPackage TyCon
tc)
String -> Put
forall t. Binary t => t -> Put
put (TyCon -> String
tyConModule TyCon
tc)
String -> Put
forall t. Binary t => t -> Put
put (TyCon -> String
tyConName TyCon
tc)
Int -> Put
forall t. Binary t => t -> Put
put (TyCon -> Int
tyConKindArgs TyCon
tc)
KindRep -> Put
forall t. Binary t => t -> Put
put (TyCon -> KindRep
tyConKindRep TyCon
tc)
get :: Get TyCon
get = String -> String -> String -> Int -> KindRep -> TyCon
mkTyCon (String -> String -> String -> Int -> KindRep -> TyCon)
-> Get String -> Get (String -> String -> Int -> KindRep -> TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get (String -> String -> Int -> KindRep -> TyCon)
-> Get String -> Get (String -> Int -> KindRep -> TyCon)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get Get (String -> Int -> KindRep -> TyCon)
-> Get String -> Get (Int -> KindRep -> TyCon)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get Get (Int -> KindRep -> TyCon) -> Get Int -> Get (KindRep -> TyCon)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (KindRep -> TyCon) -> Get KindRep -> Get TyCon
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get KindRep
forall t. Binary t => Get t
get
instance Binary KindRep where
put :: KindRep -> Put
put (KindRepTyConApp tc :: TyCon
tc k :: [KindRep]
k) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TyCon -> Put
forall t. Binary t => t -> Put
put TyCon
tc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [KindRep] -> Put
forall t. Binary t => t -> Put
put [KindRep]
k
put (KindRepVar bndr :: Int
bndr) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
bndr
put (KindRepApp a :: KindRep
a b :: KindRep
b) = Word8 -> Put
putWord8 2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KindRep -> Put
forall t. Binary t => t -> Put
put KindRep
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KindRep -> Put
forall t. Binary t => t -> Put
put KindRep
b
put (KindRepFun a :: KindRep
a b :: KindRep
b) = Word8 -> Put
putWord8 3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KindRep -> Put
forall t. Binary t => t -> Put
put KindRep
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KindRep -> Put
forall t. Binary t => t -> Put
put KindRep
b
put (KindRepTYPE r :: RuntimeRep
r) = Word8 -> Put
putWord8 4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RuntimeRep -> Put
forall t. Binary t => t -> Put
put RuntimeRep
r
put (KindRepTypeLit sort :: TypeLitSort
sort r :: String
r) = Word8 -> Put
putWord8 5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeLitSort -> Put
forall t. Binary t => t -> Put
put TypeLitSort
sort Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
r
get :: Get KindRep
get = do
Word8
tag <- Get Word8
getWord8
case Word8
tag of
0 -> TyCon -> [KindRep] -> KindRep
KindRepTyConApp (TyCon -> [KindRep] -> KindRep)
-> Get TyCon -> Get ([KindRep] -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TyCon
forall t. Binary t => Get t
get Get ([KindRep] -> KindRep) -> Get [KindRep] -> Get KindRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [KindRep]
forall t. Binary t => Get t
get
1 -> Int -> KindRep
KindRepVar (Int -> KindRep) -> Get Int -> Get KindRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get
2 -> KindRep -> KindRep -> KindRep
KindRepApp (KindRep -> KindRep -> KindRep)
-> Get KindRep -> Get (KindRep -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get KindRep
forall t. Binary t => Get t
get Get (KindRep -> KindRep) -> Get KindRep -> Get KindRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get KindRep
forall t. Binary t => Get t
get
3 -> KindRep -> KindRep -> KindRep
KindRepFun (KindRep -> KindRep -> KindRep)
-> Get KindRep -> Get (KindRep -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get KindRep
forall t. Binary t => Get t
get Get (KindRep -> KindRep) -> Get KindRep -> Get KindRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get KindRep
forall t. Binary t => Get t
get
4 -> RuntimeRep -> KindRep
KindRepTYPE (RuntimeRep -> KindRep) -> Get RuntimeRep -> Get KindRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get RuntimeRep
forall t. Binary t => Get t
get
5 -> TypeLitSort -> String -> KindRep
KindRepTypeLit (TypeLitSort -> String -> KindRep)
-> Get TypeLitSort -> Get (String -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeLitSort
forall t. Binary t => Get t
get Get (String -> KindRep) -> Get String -> Get KindRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get
_ -> String -> Get KindRep
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GHCi.TH.Binary.putKindRep: invalid tag"
instance Binary TypeLitSort where
put :: TypeLitSort -> Put
put TypeLitSymbol = Word8 -> Put
putWord8 0
put TypeLitNat = Word8 -> Put
putWord8 1
get :: Get TypeLitSort
get = do
Word8
tag <- Get Word8
getWord8
case Word8
tag of
0 -> TypeLitSort -> Get TypeLitSort
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLitSort
TypeLitSymbol
1 -> TypeLitSort -> Get TypeLitSort
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLitSort
TypeLitNat
_ -> String -> Get TypeLitSort
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GHCi.TH.Binary.putTypeLitSort: invalid tag"
putTypeRep :: TypeRep a -> Put
putTypeRep :: TypeRep a -> Put
putTypeRep rep :: TypeRep a
rep
| 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)
= Word8 -> Put
forall t. Binary t => t -> Put
put (0 :: Word8)
putTypeRep (Con' con :: TyCon
con ks :: [SomeTypeRep]
ks) = do
Word8 -> Put
forall t. Binary t => t -> Put
put (1 :: Word8)
TyCon -> Put
forall t. Binary t => t -> Put
put TyCon
con
[SomeTypeRep] -> Put
forall t. Binary t => t -> Put
put [SomeTypeRep]
ks
putTypeRep (App f :: TypeRep a
f x :: TypeRep b
x) = do
Word8 -> Put
forall t. Binary t => t -> Put
put (2 :: Word8)
TypeRep a -> Put
forall k (a :: k). TypeRep a -> Put
putTypeRep TypeRep a
f
TypeRep b -> Put
forall k (a :: k). TypeRep a -> Put
putTypeRep TypeRep b
x
putTypeRep (Fun arg :: TypeRep arg
arg res :: TypeRep res
res) = do
Word8 -> Put
forall t. Binary t => t -> Put
put (3 :: Word8)
TypeRep arg -> Put
forall k (a :: k). TypeRep a -> Put
putTypeRep TypeRep arg
arg
TypeRep res -> Put
forall k (a :: k). TypeRep a -> Put
putTypeRep TypeRep res
res
putTypeRep _ = String -> Put
forall a. HasCallStack => String -> a
error "GHCi.TH.Binary.putTypeRep: Impossible"
getSomeTypeRep :: Get SomeTypeRep
getSomeTypeRep :: Get SomeTypeRep
getSomeTypeRep = do
Word8
tag <- Get Word8
forall t. Binary t => Get t
get :: Get Word8
case Word8
tag of
0 -> SomeTypeRep -> Get SomeTypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> Get SomeTypeRep) -> SomeTypeRep -> Get 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 -> do TyCon
con <- Get TyCon
forall t. Binary t => Get t
get :: Get TyCon
[SomeTypeRep]
ks <- Get [SomeTypeRep]
forall t. Binary t => Get t
get :: Get [SomeTypeRep]
SomeTypeRep -> Get SomeTypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> Get SomeTypeRep) -> SomeTypeRep -> Get 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 -> do SomeTypeRep f :: TypeRep a
f <- Get SomeTypeRep
getSomeTypeRep
SomeTypeRep x :: TypeRep a
x <- Get SomeTypeRep
getSomeTypeRep
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 -> Get SomeTypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> Get SomeTypeRep) -> SomeTypeRep -> Get 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 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] -> Get SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Kind mismatch" []
_ -> String -> [String] -> Get 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] -> Get 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 -> do SomeTypeRep arg :: TypeRep a
arg <- Get SomeTypeRep
getSomeTypeRep
SomeTypeRep res :: TypeRep a
res <- Get SomeTypeRep
getSomeTypeRep
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 -> Get SomeTypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> Get SomeTypeRep) -> SomeTypeRep -> Get 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] -> Get SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Kind mismatch" []
Nothing -> String -> [String] -> Get SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Kind mismatch" []
_ -> String -> [String] -> Get SomeTypeRep
forall (m :: * -> *) a. MonadFail m => String -> [String] -> m a
failure "Invalid SomeTypeRep" []
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
$ [ "GHCi.TH.Binary.getSomeTypeRep: "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
instance Typeable a => Binary (TypeRep (a :: k)) where
put :: TypeRep a -> Put
put = TypeRep a -> Put
forall k (a :: k). TypeRep a -> Put
putTypeRep
get :: Get (TypeRep a)
get = do
SomeTypeRep rep :: TypeRep a
rep <- Get SomeTypeRep
getSomeTypeRep
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 -> Get (TypeRep a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeRep a
rep
Nothing -> String -> Get (TypeRep a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (TypeRep a)) -> String -> Get (TypeRep a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ "GHCi.TH.Binary: Type mismatch"
, " Deserialized 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
instance Binary SomeTypeRep where
put :: SomeTypeRep -> Put
put (SomeTypeRep rep :: TypeRep a
rep) = TypeRep a -> Put
forall k (a :: k). TypeRep a -> Put
putTypeRep TypeRep a
rep
get :: Get SomeTypeRep
get = Get SomeTypeRep
getSomeTypeRep
#endif