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

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# OPTIONS_GHC -Wno-orphans #-}
#if MIN_VERSION_base(4,16,0)
#define HAS_TYPELITCHAR
#endif

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

#include "HsVersions.h"

import GHC.Prelude

import GHC.Utils.Binary

import GHC.Exts (TYPE, RuntimeRep(..), VecCount(..), VecElem(..))
#if __GLASGOW_HASKELL__ >= 901
import GHC.Exts (Levity(Lifted, Unlifted))
#endif
import GHC.Serialized

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


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

getSomeTypeRep :: BinHandle -> IO SomeTypeRep
getSomeTypeRep :: BinHandle -> IO SomeTypeRep
getSomeTypeRep BinHandle
bh = do
    Word8
tag <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO Word8
    case Word8
tag of
        Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (forall {k} (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep Type)
        Word8
1 -> do TyCon
con <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO TyCon
                [SomeTypeRep]
ks <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO [SomeTypeRep]
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep forall a b. (a -> b) -> a -> b
$ forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
mkTrCon TyCon
con [SomeTypeRep]
ks

        Word8
2 -> do SomeTypeRep TypeRep a
f <- BinHandle -> IO SomeTypeRep
getSomeTypeRep BinHandle
bh
                SomeTypeRep TypeRep a
x <- BinHandle -> IO SomeTypeRep
getSomeTypeRep BinHandle
bh
                case forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
f of
                  Fun TypeRep arg
arg TypeRep res
res ->
                      case TypeRep arg
arg forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
x of
                        Just arg :~~: k
HRefl ->
                            case forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep res
res forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` (forall {k} (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep Type) of
                              Just TYPE r2 :~~: *
HRefl -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep forall a b. (a -> b) -> a -> b
$ forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrApp TypeRep a
f TypeRep a
x
                              Maybe (TYPE r2 :~~: *)
_ -> forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Kind mismatch in type application" []
                        Maybe (arg :~~: k)
_ -> forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Kind mismatch in type application"
                             [ String
"    Found argument of kind: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
x)
                             , String
"    Where the constructor:  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep a
f
                             , String
"    Expects kind:           " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep arg
arg
                             ]
                  TypeRep k
_ -> forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Applied non-arrow"
                       [ String
"    Applied type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep a
f
                       , String
"    To argument:  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep a
x
                       ]
        Word8
3 -> do SomeTypeRep TypeRep a
arg <- BinHandle -> IO SomeTypeRep
getSomeTypeRep BinHandle
bh
                SomeTypeRep TypeRep a
res <- BinHandle -> IO SomeTypeRep
getSomeTypeRep BinHandle
bh
                if
                  | App TypeRep a
argkcon TypeRep b
_ <- forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
arg
                  , App TypeRep a
reskcon TypeRep b
_ <- forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
res
                  , Just a :~~: TYPE
HRefl <- TypeRep a
argkcon forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep TYPE
tYPErep
                  , Just a :~~: TYPE
HRefl <- TypeRep a
reskcon forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep TYPE
tYPErep
                  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep forall a b. (a -> b) -> a -> b
$ forall k (fun :: k) arg res.
(k ~ *, fun ~~ (arg -> res)) =>
TypeRep arg -> TypeRep res -> TypeRep fun
Fun TypeRep a
arg TypeRep a
res
                  | Bool
otherwise -> forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Kind mismatch" []
        Word8
_ -> forall {m :: * -> *} {a}. MonadFail m => String -> [String] -> m a
failure String
"Invalid SomeTypeRep" []
  where
    tYPErep :: TypeRep TYPE
    tYPErep :: TypeRep TYPE
tYPErep = forall {k} (a :: k). Typeable a => TypeRep a
typeRep

    failure :: String -> [String] -> m a
failure String
description [String]
info =
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ [ String
"Binary.getSomeTypeRep: "forall a. [a] -> [a] -> [a]
++String
description ]
                      forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String
"    "forall a. [a] -> [a] -> [a]
++) [String]
info

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

instance Typeable a => Binary (TypeRep (a :: k)) where
    put_ :: BinHandle -> TypeRep a -> IO ()
put_ = forall {k} (a :: k). BinHandle -> TypeRep a -> IO ()
putTypeRep
    get :: BinHandle -> IO (TypeRep a)
get BinHandle
bh = do
        SomeTypeRep TypeRep a
rep <- BinHandle -> IO SomeTypeRep
getSomeTypeRep BinHandle
bh
        case TypeRep a
rep forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
expected of
            Just a :~~: a
HRefl -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeRep a
rep
            Maybe (a :~~: a)
Nothing    -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                               [ String
"Binary: Type mismatch"
                               , String
"    Deserialized type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep a
rep
                               , String
"    Expected type:     " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep a
expected
                               ]
     where expected :: TypeRep a
expected = forall {k} (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep a


instance Binary VecCount where
    put_ :: BinHandle -> VecCount -> IO ()
put_ BinHandle
bh = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
    get :: BinHandle -> IO VecCount
get BinHandle
bh = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Word8
getByte BinHandle
bh

instance Binary VecElem where
    put_ :: BinHandle -> VecElem -> IO ()
put_ BinHandle
bh = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
    get :: BinHandle -> IO VecElem
get BinHandle
bh = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Word8
getByte BinHandle
bh

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

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

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

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

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

putTypeRep :: BinHandle -> TypeRep a -> IO ()
-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind
-- relations.
-- See Note [Mutually recursive representations of primitive types]
putTypeRep :: forall {k} (a :: k). BinHandle -> TypeRep a -> IO ()
putTypeRep BinHandle
bh TypeRep a
rep
  | Just a :~~: *
HRefl <- TypeRep a
rep forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` (forall {k} (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep Type)
  = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Word8
0 :: Word8)
putTypeRep BinHandle
bh (Con' TyCon
con [SomeTypeRep]
ks) = do
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Word8
1 :: Word8)
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TyCon
con
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [SomeTypeRep]
ks
putTypeRep BinHandle
bh (App TypeRep a
f TypeRep b
x) = do
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Word8
2 :: Word8)
    forall {k} (a :: k). BinHandle -> TypeRep a -> IO ()
putTypeRep BinHandle
bh TypeRep a
f
    forall {k} (a :: k). BinHandle -> TypeRep a -> IO ()
putTypeRep BinHandle
bh TypeRep b
x
putTypeRep BinHandle
bh (Fun TypeRep arg
arg TypeRep res
res) = do
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Word8
3 :: Word8)
    forall {k} (a :: k). BinHandle -> TypeRep a -> IO ()
putTypeRep BinHandle
bh TypeRep arg
arg
    forall {k} (a :: k). BinHandle -> TypeRep a -> IO ()
putTypeRep BinHandle
bh TypeRep res
res

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