{-# LANGUAGE CPP #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# OPTIONS_GHC -Wno-orphans -Wincomplete-patterns #-}

-- | Orphan Binary instances for Data.Typeable stuff
module GHC.Utils.Binary.Typeable
   ( getSomeTypeRep
   )
where

import GHC.Prelude

import GHC.Utils.Binary

import GHC.Exts (RuntimeRep(..), VecCount(..), VecElem(..))
import GHC.Exts (Levity(Lifted, Unlifted))
import GHC.Serialized

import Foreign
import Type.Reflection
import Type.Reflection.Unsafe
import Data.Kind (Type)


instance Binary TyCon where
    put_ :: WriteBinHandle -> TyCon -> IO ()
put_ WriteBinHandle
bh TyCon
tc = do
        WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (TyCon -> String
tyConPackage TyCon
tc)
        WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (TyCon -> String
tyConModule TyCon
tc)
        WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (TyCon -> String
tyConName TyCon
tc)
        WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (TyCon -> Int
tyConKindArgs TyCon
tc)
        WriteBinHandle -> KindRep -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (TyCon -> KindRep
tyConKindRep TyCon
tc)
    get :: ReadBinHandle -> IO TyCon
get ReadBinHandle
bh =
        String -> String -> String -> Int -> KindRep -> TyCon
mkTyCon (String -> String -> String -> Int -> KindRep -> TyCon)
-> IO String -> IO (String -> String -> Int -> KindRep -> TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (String -> String -> Int -> KindRep -> TyCon)
-> IO String -> IO (String -> Int -> KindRep -> TyCon)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (String -> Int -> KindRep -> TyCon)
-> IO String -> IO (Int -> KindRep -> TyCon)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (Int -> KindRep -> TyCon) -> IO Int -> IO (KindRep -> TyCon)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (KindRep -> TyCon) -> IO KindRep -> IO TyCon
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO KindRep
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh

getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep
getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep
getSomeTypeRep ReadBinHandle
bh = do
    tag <- ReadBinHandle -> IO Word8
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh :: IO Word8
    case tag of
        Word8
0 -> SomeTypeRep -> IO SomeTypeRep
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> IO SomeTypeRep) -> SomeTypeRep -> IO 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)
        Word8
1 -> do con <- ReadBinHandle -> IO TyCon
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh :: IO TyCon
                ks <- get bh :: IO [SomeTypeRep]
                return $ SomeTypeRep $ mkTrCon con ks
        Word8
2 -> do SomeTypeRep f <- ReadBinHandle -> IO SomeTypeRep
getSomeTypeRep ReadBinHandle
bh
                SomeTypeRep x <- getSomeTypeRep bh
                case typeRepKind f of
                  Fun TypeRep arg
arg 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 arg :~~: k
HRefl ->
                            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 TYPE r2 :~~: *
HRefl -> SomeTypeRep -> IO SomeTypeRep
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTypeRep -> IO SomeTypeRep) -> SomeTypeRep -> IO 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
                              Maybe (TYPE r2 :~~: *)
_ -> String -> [String] -> IO SomeTypeRep
forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Kind mismatch in type application" []
                        Maybe (arg :~~: k)
_ -> String -> [String] -> IO SomeTypeRep
forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Kind mismatch in type application"
                             [ String
"    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)
                             , String
"    Where the constructor:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
f
                             , String
"    Expects kind:           " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep arg -> String
forall a. Show a => a -> String
show TypeRep arg
arg
                             ]
                  TypeRep k
_ -> String -> [String] -> IO SomeTypeRep
forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Applied non-arrow"
                       [ String
"    Applied type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
f
                       , String
"    To argument:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
x
                       ]
        Word8
_ -> String -> [String] -> IO SomeTypeRep
forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Invalid SomeTypeRep" []
  where
    failure :: String -> [String] -> m a
failure String
description [String]
info =
        String -> m a
forall a. 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
$ [ String
"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 -> String
forall a. [a] -> [a] -> [a]
++) [String]
info

instance Binary SomeTypeRep where
    put_ :: WriteBinHandle -> SomeTypeRep -> IO ()
put_ WriteBinHandle
bh (SomeTypeRep TypeRep a
rep) = WriteBinHandle -> TypeRep a -> IO ()
forall {k} (a :: k). WriteBinHandle -> TypeRep a -> IO ()
putTypeRep WriteBinHandle
bh TypeRep a
rep
    get :: ReadBinHandle -> IO SomeTypeRep
get = ReadBinHandle -> IO SomeTypeRep
getSomeTypeRep

instance Typeable a => Binary (TypeRep (a :: k)) where
    put_ :: WriteBinHandle -> TypeRep a -> IO ()
put_ = WriteBinHandle -> TypeRep a -> IO ()
forall {k} (a :: k). WriteBinHandle -> TypeRep a -> IO ()
putTypeRep
    get :: ReadBinHandle -> IO (TypeRep a)
get ReadBinHandle
bh = do
        SomeTypeRep rep <- ReadBinHandle -> IO SomeTypeRep
getSomeTypeRep ReadBinHandle
bh
        case rep `eqTypeRep` expected of
            Just a :~~: a
HRefl -> TypeRep a -> IO (TypeRep a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeRep a
TypeRep a
rep
            Maybe (a :~~: a)
Nothing    -> String -> IO (TypeRep a)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (TypeRep a)) -> String -> IO (TypeRep a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                               [ String
"Binary: Type mismatch"
                               , String
"    Deserialized type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show TypeRep a
rep
                               , String
"    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 VecCount where
    put_ :: WriteBinHandle -> VecCount -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh (Word8 -> IO ()) -> (VecCount -> Word8) -> VecCount -> IO ()
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 :: ReadBinHandle -> IO VecCount
get ReadBinHandle
bh = 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) -> IO Word8 -> IO VecCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh

instance Binary VecElem where
    put_ :: WriteBinHandle -> VecElem -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh (Word8 -> IO ()) -> (VecElem -> Word8) -> VecElem -> IO ()
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 :: ReadBinHandle -> IO VecElem
get ReadBinHandle
bh = 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) -> IO Word8 -> IO VecElem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh

instance Binary RuntimeRep where
    put_ :: WriteBinHandle -> RuntimeRep -> IO ()
put_ WriteBinHandle
bh (VecRep VecCount
a VecElem
b)    = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> VecCount -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh VecCount
a IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> VecElem -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh VecElem
b
    put_ WriteBinHandle
bh (TupleRep [RuntimeRep]
reps) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> [RuntimeRep] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [RuntimeRep]
reps
    put_ WriteBinHandle
bh (SumRep [RuntimeRep]
reps)   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> [RuntimeRep] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [RuntimeRep]
reps
    put_ WriteBinHandle
bh (BoxedRep Levity
Lifted)   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
    put_ WriteBinHandle
bh (BoxedRep Levity
Unlifted) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4
    put_ WriteBinHandle
bh RuntimeRep
IntRep          = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
5
    put_ WriteBinHandle
bh RuntimeRep
WordRep         = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
6
    put_ WriteBinHandle
bh RuntimeRep
Int64Rep        = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
7
    put_ WriteBinHandle
bh RuntimeRep
Word64Rep       = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
8
    put_ WriteBinHandle
bh RuntimeRep
AddrRep         = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
9
    put_ WriteBinHandle
bh RuntimeRep
FloatRep        = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
10
    put_ WriteBinHandle
bh RuntimeRep
DoubleRep       = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
11
    put_ WriteBinHandle
bh RuntimeRep
Int8Rep         = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
12
    put_ WriteBinHandle
bh RuntimeRep
Word8Rep        = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
13
    put_ WriteBinHandle
bh RuntimeRep
Int16Rep        = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
14
    put_ WriteBinHandle
bh RuntimeRep
Word16Rep       = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
15
    put_ WriteBinHandle
bh RuntimeRep
Int32Rep        = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
16
    put_ WriteBinHandle
bh RuntimeRep
Word32Rep       = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
17

    get :: ReadBinHandle -> IO RuntimeRep
get ReadBinHandle
bh = do
        tag <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
        case tag of
          Word8
0  -> VecCount -> VecElem -> RuntimeRep
VecRep (VecCount -> VecElem -> RuntimeRep)
-> IO VecCount -> IO (VecElem -> RuntimeRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO VecCount
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (VecElem -> RuntimeRep) -> IO VecElem -> IO RuntimeRep
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO VecElem
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
1  -> [RuntimeRep] -> RuntimeRep
TupleRep ([RuntimeRep] -> RuntimeRep) -> IO [RuntimeRep] -> IO RuntimeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO [RuntimeRep]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
2  -> [RuntimeRep] -> RuntimeRep
SumRep ([RuntimeRep] -> RuntimeRep) -> IO [RuntimeRep] -> IO RuntimeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO [RuntimeRep]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
3  -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Levity -> RuntimeRep
BoxedRep Levity
Lifted)
          Word8
4  -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Levity -> RuntimeRep
BoxedRep Levity
Unlifted)
          Word8
5  -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
IntRep
          Word8
6  -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
WordRep
          Word8
7  -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int64Rep
          Word8
8  -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word64Rep
          Word8
9  -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
AddrRep
          Word8
10 -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
FloatRep
          Word8
11 -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
DoubleRep
          Word8
12 -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int8Rep
          Word8
13 -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word8Rep
          Word8
14 -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int16Rep
          Word8
15 -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word16Rep
          Word8
16 -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Int32Rep
          Word8
17 -> RuntimeRep -> IO RuntimeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRep
Word32Rep
          Word8
_  -> String -> IO RuntimeRep
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Binary.putRuntimeRep: invalid tag"

instance Binary KindRep where
    put_ :: WriteBinHandle -> KindRep -> IO ()
put_ WriteBinHandle
bh (KindRepTyConApp TyCon
tc [KindRep]
k) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> TyCon -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh TyCon
tc IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> [KindRep] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [KindRep]
k
    put_ WriteBinHandle
bh (KindRepVar Int
bndr) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
bndr
    put_ WriteBinHandle
bh (KindRepApp KindRep
a KindRep
b) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> KindRep -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh KindRep
a IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> KindRep -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh KindRep
b
    put_ WriteBinHandle
bh (KindRepFun KindRep
a KindRep
b) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> KindRep -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh KindRep
a IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> KindRep -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh KindRep
b
    put_ WriteBinHandle
bh (KindRepTYPE RuntimeRep
r) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> RuntimeRep -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh RuntimeRep
r
    put_ WriteBinHandle
bh (KindRepTypeLit TypeLitSort
sort String
r) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> TypeLitSort -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh TypeLitSort
sort IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
r

    get :: ReadBinHandle -> IO KindRep
get ReadBinHandle
bh = do
        tag <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
        case tag of
          Word8
0 -> TyCon -> [KindRep] -> KindRep
KindRepTyConApp (TyCon -> [KindRep] -> KindRep)
-> IO TyCon -> IO ([KindRep] -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO TyCon
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO ([KindRep] -> KindRep) -> IO [KindRep] -> IO KindRep
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO [KindRep]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
1 -> Int -> KindRep
KindRepVar (Int -> KindRep) -> IO Int -> IO KindRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
2 -> KindRep -> KindRep -> KindRep
KindRepApp (KindRep -> KindRep -> KindRep)
-> IO KindRep -> IO (KindRep -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO KindRep
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (KindRep -> KindRep) -> IO KindRep -> IO KindRep
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO KindRep
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
3 -> KindRep -> KindRep -> KindRep
KindRepFun (KindRep -> KindRep -> KindRep)
-> IO KindRep -> IO (KindRep -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO KindRep
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (KindRep -> KindRep) -> IO KindRep -> IO KindRep
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO KindRep
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
4 -> RuntimeRep -> KindRep
KindRepTYPE (RuntimeRep -> KindRep) -> IO RuntimeRep -> IO KindRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO RuntimeRep
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
5 -> TypeLitSort -> String -> KindRep
KindRepTypeLit (TypeLitSort -> String -> KindRep)
-> IO TypeLitSort -> IO (String -> KindRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO TypeLitSort
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (String -> KindRep) -> IO String -> IO KindRep
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          Word8
_ -> String -> IO KindRep
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Binary.putKindRep: invalid tag"

instance Binary TypeLitSort where
    put_ :: WriteBinHandle -> TypeLitSort -> IO ()
put_ WriteBinHandle
bh TypeLitSort
TypeLitSymbol = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh TypeLitSort
TypeLitNat = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    put_ WriteBinHandle
bh TypeLitSort
TypeLitChar = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    get :: ReadBinHandle -> IO TypeLitSort
get ReadBinHandle
bh = do
        tag <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
        case tag of
          Word8
0 -> TypeLitSort -> IO TypeLitSort
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLitSort
TypeLitSymbol
          Word8
1 -> TypeLitSort -> IO TypeLitSort
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLitSort
TypeLitNat
          Word8
2 -> TypeLitSort -> IO TypeLitSort
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLitSort
TypeLitChar
          Word8
_ -> String -> IO TypeLitSort
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Binary.putTypeLitSort: invalid tag"

putTypeRep :: WriteBinHandle -> TypeRep a -> IO ()
putTypeRep :: forall {k} (a :: k). WriteBinHandle -> TypeRep a -> IO ()
putTypeRep WriteBinHandle
bh TypeRep a
rep -- Handle Type specially since it's so common
  | Just a :~~: *
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)
  = WriteBinHandle -> Word8 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Word8
0 :: Word8)
putTypeRep WriteBinHandle
bh (Con' TyCon
con [SomeTypeRep]
ks) = do
    WriteBinHandle -> Word8 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Word8
1 :: Word8)
    WriteBinHandle -> TyCon -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh TyCon
con
    WriteBinHandle -> [SomeTypeRep] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [SomeTypeRep]
ks
putTypeRep WriteBinHandle
bh (App TypeRep a
f TypeRep b
x) = do
    WriteBinHandle -> Word8 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Word8
2 :: Word8)
    WriteBinHandle -> TypeRep a -> IO ()
forall {k} (a :: k). WriteBinHandle -> TypeRep a -> IO ()
putTypeRep WriteBinHandle
bh TypeRep a
f
    WriteBinHandle -> TypeRep b -> IO ()
forall {k} (a :: k). WriteBinHandle -> TypeRep a -> IO ()
putTypeRep WriteBinHandle
bh TypeRep b
x

instance Binary Serialized where
    put_ :: WriteBinHandle -> Serialized -> IO ()
put_ WriteBinHandle
bh (Serialized SomeTypeRep
the_type [Word8]
bytes) = do
        WriteBinHandle -> SomeTypeRep -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SomeTypeRep
the_type
        WriteBinHandle -> [Word8] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [Word8]
bytes
    get :: ReadBinHandle -> IO Serialized
get ReadBinHandle
bh = do
        the_type <- ReadBinHandle -> IO SomeTypeRep
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        bytes <- get bh
        return (Serialized the_type bytes)