[commit: ghc] wip/ttypeable: Binary: More explicit pattern matching (1c0a5fd)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/1c0a5fde1399f3d3c00aed58558fb6729d3fa02a/ghc

>---------------------------------------------------------------

commit 1c0a5fde1399f3d3c00aed58558fb6729d3fa02a
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Mar 16 09:40:54 2016 +0100

    Binary: More explicit pattern matching


>---------------------------------------------------------------

1c0a5fde1399f3d3c00aed58558fb6729d3fa02a
 compiler/utils/Binary.hs         | 9 ++++++---
 libraries/ghci/GHCi/TH/Binary.hs | 9 ++++++---
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index dadca68..1fbe19a 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -612,9 +612,12 @@ getTypeRepX bh = do
         1 -> do TypeRepX f <- getTypeRepX bh
                 TypeRepX x <- getTypeRepX bh
                 case typeRepKind f of
-                    TRFun arg _ | Just HRefl <- arg `eqTypeRep` x ->
-                      pure $ TypeRepX $ mkTrApp f x
-                    _ -> fail "getTypeRepX: Kind mismatch"
+                    TRFun arg _ ->
+                        case arg `eqTypeRep` x of
+                            Just HRefl ->
+                                pure $ TypeRepX $ mkTrApp f x
+                            _ -> fail "getTypeRepX: Kind mismatch"
+                    _ -> fail "getTypeRepX: Applied non-arrow type"
         _ -> fail "Binary: Invalid TypeRepX"
 
 instance Typeable a => Binary (TypeRep (a :: k)) where
diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs
index 9a4d314..7ecc746 100644
--- a/libraries/ghci/GHCi/TH/Binary.hs
+++ b/libraries/ghci/GHCi/TH/Binary.hs
@@ -105,9 +105,12 @@ getTypeRepX = do
         1 -> do TypeRepX f <- getTypeRepX
                 TypeRepX x <- getTypeRepX
                 case typeRepKind f of
-                    TRFun arg _ | Just HRefl <- arg `eqTypeRep` x ->
-                      pure $ TypeRepX $ mkTrApp f x
-                    _ -> fail "getTypeRepX: Kind mismatch"
+                    TRFun arg _ ->
+                        case arg `eqTypeRep` x of
+                            Just HRefl ->
+                                pure $ TypeRepX $ mkTrApp f x
+                            _ -> fail "getTypeRepX: Kind mismatch"
+                    _ -> fail "getTypeRepX: Applied non-arrow type"
         _ -> fail "getTypeRepX: Invalid TypeRepX"
 
 instance Typeable a => Binary (TypeRep (a :: k)) where