Allow TcDerivInfer to compile with GHC 8.0.1
authorBen Gamari <bgamari.foss@gmail.com>
Wed, 16 Aug 2017 23:01:59 +0000 (19:01 -0400)
committerBen Gamari <ben@smart-cactus.org>
Wed, 16 Aug 2017 23:02:28 +0000 (19:02 -0400)
As of ed7a830de6a2ea74dd6bb81f8ec55b9fe0b52f28 this module uses
MultiWayIf, the parsing behavior of which changed in 8.0.2 due
to #10807. Reformat the code so that it compiles under both 8.0.1 and
8.0.2/8.2.1.

Test Plan: Validate bootstrapping with 8.0.1

Reviewers: austin

Subscribers: rwbarton, thomie, RyanGlScott

GHC Trac Issues: #14130

Differential Revision: https://phabricator.haskell.org/D3863

compiler/typecheck/TcDerivInfer.hs

index 85ff250..81bbfd9 100644 (file)
@@ -247,34 +247,34 @@ inferConstraintsDataConArgs inst_ty inst_tys
 
        if    -- Generic constraints are easy
           |  is_generic
-          -> return ([], tvs, inst_tys)
+           -> return ([], tvs, inst_tys)
 
              -- Generic1 needs Functor
              -- See Note [Getting base classes]
           |  is_generic1
-          -> ASSERT( rep_tc_tvs `lengthExceeds` 0 )
-             -- Generic1 has a single kind variable
-             ASSERT( cls_tys `lengthIs` 1 )
-             do { functorClass <- lift $ tcLookupClass functorClassName
-                ; pure $ con_arg_constraints
-                       $ get_gen1_constraints functorClass }
+           -> ASSERT( rep_tc_tvs `lengthExceeds` 0 )
+              -- Generic1 has a single kind variable
+              ASSERT( cls_tys `lengthIs` 1 )
+              do { functorClass <- lift $ tcLookupClass functorClassName
+                 ; pure $ con_arg_constraints
+                        $ get_gen1_constraints functorClass }
 
              -- The others are a bit more complicated
           |  otherwise
-          -> -- See the comment with all_rep_tc_args for an explanation of
-             -- this assertion
-             ASSERT2( equalLength rep_tc_tvs all_rep_tc_args
-                    , ppr main_cls <+> ppr rep_tc
-                      $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args )
-               do { let (arg_constraints, tvs', inst_tys')
-                          = con_arg_constraints get_std_constrained_tys
-                  ; lift $ traceTc "inferConstraintsDataConArgs" $ vcat
-                         [ ppr main_cls <+> ppr inst_tys'
-                         , ppr arg_constraints
-                         ]
-                  ; return ( stupid_constraints ++ extra_constraints
-                                                ++ arg_constraints
-                           , tvs', inst_tys') }
+           -> -- See the comment with all_rep_tc_args for an explanation of
+              -- this assertion
+              ASSERT2( equalLength rep_tc_tvs all_rep_tc_args
+                     , ppr main_cls <+> ppr rep_tc
+                       $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args )
+                do { let (arg_constraints, tvs', inst_tys')
+                           = con_arg_constraints get_std_constrained_tys
+                   ; lift $ traceTc "inferConstraintsDataConArgs" $ vcat
+                          [ ppr main_cls <+> ppr inst_tys'
+                          , ppr arg_constraints
+                          ]
+                   ; return ( stupid_constraints ++ extra_constraints
+                                                 ++ arg_constraints
+                            , tvs', inst_tys') }
 
 typeToTypeKind :: Kind
 typeToTypeKind = liftedTypeKind `mkFunTy` liftedTypeKind