Merge pull request #186 from sheaf/wip/typerep-changes

Adapt to changes in TypeRep complete patterns

Author: bgamari

src/Data/Binary/Class.hs

@@ -994,9 +994,6 @@ instance Binary TypeLitSort where
           _ -> fail "GHCi.TH.Binary.putTypeLitSort: invalid tag"
 
 putTypeRep :: TypeRep a -> Put
--- Special handling for TYPE, (->), and RuntimeRep due to recursive kind
--- relations.
--- See Note [Mutually recursive representations of primitive types]
 putTypeRep rep  -- Handle Type specially since it's so common
   | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type)
   = put (0 :: Word8)
@@ -1008,10 +1005,17 @@ putTypeRep (App f x) = do
     put (2 :: Word8)
     putTypeRep f
     putTypeRep x
+#if __GLASGOW_HASKELL__ < 903
+-- N.B. This pattern never matches,
+-- even on versions of GHC older than 9.3:
+-- a `Fun` typerep will match with the `App` pattern.
+-- This match is kept solely for pattern-match warnings,
+-- which are incorrect on GHC prior to 9.3.
 putTypeRep (Fun arg res) = do
     put (3 :: Word8)
     putTypeRep arg
     putTypeRep res
+#endif
 
 getSomeTypeRep :: Get SomeTypeRep
 getSomeTypeRep = do
@@ -1039,14 +1043,6 @@ getSomeTypeRep = do
                        [ "Applied type: " ++ show f
                        , "To argument:  " ++ show x
                        ]
-        3 -> do SomeTypeRep arg <- getSomeTypeRep
-                SomeTypeRep res <- getSomeTypeRep
-                case typeRepKind arg `eqTypeRep` (typeRep :: TypeRep Type) of
-                  Just HRefl ->
-                      case typeRepKind res `eqTypeRep` (typeRep :: TypeRep Type) of
-                        Just HRefl -> return $ SomeTypeRep $ Fun arg res
-                        Nothing -> failure "Kind mismatch" []
-                  Nothing -> failure "Kind mismatch" []
         _ -> failure "Invalid SomeTypeRep" []
   where
     failure description info =