Break up TcRnTypes, among other modules.
[ghc.git] / compiler / typecheck / TcDeriv.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 Handles @deriving@ clauses on @data@ declarations.
7 -}
8
9 {-# LANGUAGE CPP #-}
10 {-# LANGUAGE TypeFamilies #-}
11
12 module TcDeriv ( tcDeriving, DerivInfo(..) ) where
13
14 #include "HsVersions.h"
15
16 import GhcPrelude
17
18 import GHC.Hs
19 import DynFlags
20
21 import TcRnMonad
22 import FamInst
23 import TcOrigin
24 import Predicate
25 import TcDerivInfer
26 import TcDerivUtils
27 import TcValidity( allDistinctTyVars )
28 import TcClassDcl( instDeclCtxt3, tcATDefault )
29 import TcEnv
30 import TcGenDeriv -- Deriv stuff
31 import TcValidity( checkValidInstHead )
32 import InstEnv
33 import Inst
34 import FamInstEnv
35 import TcHsType
36 import TyCoRep
37
38 import RnNames( extendGlobalRdrEnvRn )
39 import RnBinds
40 import RnEnv
41 import RnUtils ( bindLocalNamesFV )
42 import RnSource ( addTcgDUs )
43 import Avail
44
45 import Unify( tcUnifyTy )
46 import Class
47 import Type
48 import ErrUtils
49 import DataCon
50 import Maybes
51 import RdrName
52 import Name
53 import NameSet
54 import TyCon
55 import TcType
56 import Var
57 import VarEnv
58 import VarSet
59 import PrelNames
60 import SrcLoc
61 import Util
62 import Outputable
63 import FastString
64 import Bag
65 import FV (fvVarList, unionFV, mkFVs)
66 import qualified GHC.LanguageExtensions as LangExt
67
68 import Control.Monad
69 import Control.Monad.Trans.Class
70 import Control.Monad.Trans.Reader
71 import Data.List
72
73 {-
74 ************************************************************************
75 * *
76 Overview
77 * *
78 ************************************************************************
79
80 Overall plan
81 ~~~~~~~~~~~~
82 1. Convert the decls (i.e. data/newtype deriving clauses,
83 plus standalone deriving) to [EarlyDerivSpec]
84
85 2. Infer the missing contexts for the InferTheta's
86
87 3. Add the derived bindings, generating InstInfos
88 -}
89
90 data EarlyDerivSpec = InferTheta (DerivSpec [ThetaOrigin])
91 | GivenTheta (DerivSpec ThetaType)
92 -- InferTheta ds => the context for the instance should be inferred
93 -- In this case ds_theta is the list of all the sets of
94 -- constraints needed, such as (Eq [a], Eq a), together with a
95 -- suitable CtLoc to get good error messages.
96 -- The inference process is to reduce this to a
97 -- simpler form (e.g. Eq a)
98 --
99 -- GivenTheta ds => the exact context for the instance is supplied
100 -- by the programmer; it is ds_theta
101 -- See Note [Inferring the instance context] in TcDerivInfer
102
103 splitEarlyDerivSpec :: [EarlyDerivSpec]
104 -> ([DerivSpec [ThetaOrigin]], [DerivSpec ThetaType])
105 splitEarlyDerivSpec [] = ([],[])
106 splitEarlyDerivSpec (InferTheta spec : specs) =
107 case splitEarlyDerivSpec specs of (is, gs) -> (spec : is, gs)
108 splitEarlyDerivSpec (GivenTheta spec : specs) =
109 case splitEarlyDerivSpec specs of (is, gs) -> (is, spec : gs)
110
111 instance Outputable EarlyDerivSpec where
112 ppr (InferTheta spec) = ppr spec <+> text "(Infer)"
113 ppr (GivenTheta spec) = ppr spec <+> text "(Given)"
114
115 {-
116 Note [Data decl contexts]
117 ~~~~~~~~~~~~~~~~~~~~~~~~~
118 Consider
119
120 data (RealFloat a) => Complex a = !a :+ !a deriving( Read )
121
122 We will need an instance decl like:
123
124 instance (Read a, RealFloat a) => Read (Complex a) where
125 ...
126
127 The RealFloat in the context is because the read method for Complex is bound
128 to construct a Complex, and doing that requires that the argument type is
129 in RealFloat.
130
131 But this ain't true for Show, Eq, Ord, etc, since they don't construct
132 a Complex; they only take them apart.
133
134 Our approach: identify the offending classes, and add the data type
135 context to the instance decl. The "offending classes" are
136
137 Read, Enum?
138
139 FURTHER NOTE ADDED March 2002. In fact, Haskell98 now requires that
140 pattern matching against a constructor from a data type with a context
141 gives rise to the constraints for that context -- or at least the thinned
142 version. So now all classes are "offending".
143
144 Note [Newtype deriving]
145 ~~~~~~~~~~~~~~~~~~~~~~~
146 Consider this:
147 class C a b
148 instance C [a] Char
149 newtype T = T Char deriving( C [a] )
150
151 Notice the free 'a' in the deriving. We have to fill this out to
152 newtype T = T Char deriving( forall a. C [a] )
153
154 And then translate it to:
155 instance C [a] Char => C [a] T where ...
156
157 Note [Unused constructors and deriving clauses]
158 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
159 See #3221. Consider
160 data T = T1 | T2 deriving( Show )
161 Are T1 and T2 unused? Well, no: the deriving clause expands to mention
162 both of them. So we gather defs/uses from deriving just like anything else.
163
164 -}
165
166 -- | Stuff needed to process a datatype's `deriving` clauses
167 data DerivInfo = DerivInfo { di_rep_tc :: TyCon
168 -- ^ The data tycon for normal datatypes,
169 -- or the *representation* tycon for data families
170 , di_scoped_tvs :: ![(Name,TyVar)]
171 -- ^ Variables that scope over the deriving clause.
172 , di_clauses :: [LHsDerivingClause GhcRn]
173 , di_ctxt :: SDoc -- ^ error context
174 }
175
176 {-
177
178 ************************************************************************
179 * *
180 \subsection[TcDeriv-driver]{Top-level function for \tr{derivings}}
181 * *
182 ************************************************************************
183 -}
184
185 tcDeriving :: [DerivInfo] -- All `deriving` clauses
186 -> [LDerivDecl GhcRn] -- All stand-alone deriving declarations
187 -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
188 tcDeriving deriv_infos deriv_decls
189 = recoverM (do { g <- getGblEnv
190 ; return (g, emptyBag, emptyValBindsOut)}) $
191 do { -- Fish the "deriving"-related information out of the TcEnv
192 -- And make the necessary "equations".
193 early_specs <- makeDerivSpecs deriv_infos deriv_decls
194 ; traceTc "tcDeriving" (ppr early_specs)
195
196 ; let (infer_specs, given_specs) = splitEarlyDerivSpec early_specs
197 ; insts1 <- mapM genInst given_specs
198 ; insts2 <- mapM genInst infer_specs
199
200 ; dflags <- getDynFlags
201
202 ; let (_, deriv_stuff, fvs) = unzip3 (insts1 ++ insts2)
203 ; loc <- getSrcSpanM
204 ; let (binds, famInsts) = genAuxBinds dflags loc
205 (unionManyBags deriv_stuff)
206
207 ; let mk_inst_infos1 = map fstOf3 insts1
208 ; inst_infos1 <- apply_inst_infos mk_inst_infos1 given_specs
209
210 -- We must put all the derived type family instances (from both
211 -- infer_specs and given_specs) in the local instance environment
212 -- before proceeding, or else simplifyInstanceContexts might
213 -- get stuck if it has to reason about any of those family instances.
214 -- See Note [Staging of tcDeriving]
215 ; tcExtendLocalFamInstEnv (bagToList famInsts) $
216 -- NB: only call tcExtendLocalFamInstEnv once, as it performs
217 -- validity checking for all of the family instances you give it.
218 -- If the family instances have errors, calling it twice will result
219 -- in duplicate error messages!
220
221 do {
222 -- the stand-alone derived instances (@inst_infos1@) are used when
223 -- inferring the contexts for "deriving" clauses' instances
224 -- (@infer_specs@)
225 ; final_specs <- extendLocalInstEnv (map iSpec inst_infos1) $
226 simplifyInstanceContexts infer_specs
227
228 ; let mk_inst_infos2 = map fstOf3 insts2
229 ; inst_infos2 <- apply_inst_infos mk_inst_infos2 final_specs
230 ; let inst_infos = inst_infos1 ++ inst_infos2
231
232 ; (inst_info, rn_binds, rn_dus) <- renameDeriv inst_infos binds
233
234 ; unless (isEmptyBag inst_info) $
235 liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances"
236 (ddump_deriving inst_info rn_binds famInsts))
237
238 ; gbl_env <- tcExtendLocalInstEnv (map iSpec (bagToList inst_info))
239 getGblEnv
240 ; let all_dus = rn_dus `plusDU` usesOnly (NameSet.mkFVs $ concat fvs)
241 ; return (addTcgDUs gbl_env all_dus, inst_info, rn_binds) } }
242 where
243 ddump_deriving :: Bag (InstInfo GhcRn) -> HsValBinds GhcRn
244 -> Bag FamInst -- ^ Rep type family instances
245 -> SDoc
246 ddump_deriving inst_infos extra_binds repFamInsts
247 = hang (text "Derived class instances:")
248 2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") (bagToList inst_infos))
249 $$ ppr extra_binds)
250 $$ hangP "Derived type family instances:"
251 (vcat (map pprRepTy (bagToList repFamInsts)))
252
253 hangP s x = text "" $$ hang (ptext (sLit s)) 2 x
254
255 -- Apply the suspended computations given by genInst calls.
256 -- See Note [Staging of tcDeriving]
257 apply_inst_infos :: [ThetaType -> TcM (InstInfo GhcPs)]
258 -> [DerivSpec ThetaType] -> TcM [InstInfo GhcPs]
259 apply_inst_infos = zipWithM (\f ds -> f (ds_theta ds))
260
261 -- Prints the representable type family instance
262 pprRepTy :: FamInst -> SDoc
263 pprRepTy fi@(FamInst { fi_tys = lhs })
264 = text "type" <+> ppr (mkTyConApp (famInstTyCon fi) lhs) <+>
265 equals <+> ppr rhs
266 where rhs = famInstRHS fi
267
268 renameDeriv :: [InstInfo GhcPs]
269 -> Bag (LHsBind GhcPs, LSig GhcPs)
270 -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
271 renameDeriv inst_infos bagBinds
272 = discardWarnings $
273 -- Discard warnings about unused bindings etc
274 setXOptM LangExt.EmptyCase $
275 -- Derived decls (for empty types) can have
276 -- case x of {}
277 setXOptM LangExt.ScopedTypeVariables $
278 setXOptM LangExt.KindSignatures $
279 -- Derived decls (for newtype-deriving) can use ScopedTypeVariables &
280 -- KindSignatures
281 setXOptM LangExt.TypeApplications $
282 -- GND/DerivingVia uses TypeApplications in generated code
283 -- (See Note [Newtype-deriving instances] in TcGenDeriv)
284 unsetXOptM LangExt.RebindableSyntax $
285 -- See Note [Avoid RebindableSyntax when deriving]
286 setXOptM LangExt.TemplateHaskellQuotes $
287 -- DeriveLift makes uses of quotes
288 do {
289 -- Bring the extra deriving stuff into scope
290 -- before renaming the instances themselves
291 ; traceTc "rnd" (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos))
292 ; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds
293 ; let aux_val_binds = ValBinds noExtField aux_binds (bagToList aux_sigs)
294 ; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
295 ; let bndrs = collectHsValBinders rn_aux_lhs
296 ; envs <- extendGlobalRdrEnvRn (map avail bndrs) emptyFsEnv ;
297 ; setEnvs envs $
298 do { (rn_aux, dus_aux) <- rnValBindsRHS (TopSigCtxt (mkNameSet bndrs)) rn_aux_lhs
299 ; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
300 ; return (listToBag rn_inst_infos, rn_aux,
301 dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
302
303 where
304 rn_inst_info :: InstInfo GhcPs -> TcM (InstInfo GhcRn, FreeVars)
305 rn_inst_info
306 inst_info@(InstInfo { iSpec = inst
307 , iBinds = InstBindings
308 { ib_binds = binds
309 , ib_tyvars = tyvars
310 , ib_pragmas = sigs
311 , ib_extensions = exts -- Only for type-checking
312 , ib_derived = sa } })
313 = ASSERT( null sigs )
314 bindLocalNamesFV tyvars $
315 do { (rn_binds,_, fvs) <- rnMethodBinds False (is_cls_nm inst) [] binds []
316 ; let binds' = InstBindings { ib_binds = rn_binds
317 , ib_tyvars = tyvars
318 , ib_pragmas = []
319 , ib_extensions = exts
320 , ib_derived = sa }
321 ; return (inst_info { iBinds = binds' }, fvs) }
322
323 {-
324 Note [Staging of tcDeriving]
325 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
326 Here's a tricky corner case for deriving (adapted from #2721):
327
328 class C a where
329 type T a
330 foo :: a -> T a
331
332 instance C Int where
333 type T Int = Int
334 foo = id
335
336 newtype N = N Int deriving C
337
338 This will produce an instance something like this:
339
340 instance C N where
341 type T N = T Int
342 foo = coerce (foo :: Int -> T Int) :: N -> T N
343
344 We must be careful in order to typecheck this code. When determining the
345 context for the instance (in simplifyInstanceContexts), we need to determine
346 that T N and T Int have the same representation, but to do that, the T N
347 instance must be in the local family instance environment. Otherwise, GHC
348 would be unable to conclude that T Int is representationally equivalent to
349 T Int, and simplifyInstanceContexts would get stuck.
350
351 Previously, tcDeriving would defer adding any derived type family instances to
352 the instance environment until the very end, which meant that
353 simplifyInstanceContexts would get called without all the type family instances
354 it needed in the environment in order to properly simplify instance like
355 the C N instance above.
356
357 To avoid this scenario, we carefully structure the order of events in
358 tcDeriving. We first call genInst on the standalone derived instance specs and
359 the instance specs obtained from deriving clauses. Note that the return type of
360 genInst is a triple:
361
362 TcM (ThetaType -> TcM (InstInfo RdrName), BagDerivStuff, Maybe Name)
363
364 The type family instances are in the BagDerivStuff. The first field of the
365 triple is a suspended computation which, given an instance context, produces
366 the rest of the instance. The fact that it is suspended is important, because
367 right now, we don't have ThetaTypes for the instances that use deriving clauses
368 (only the standalone-derived ones).
369
370 Now we can can collect the type family instances and extend the local instance
371 environment. At this point, it is safe to run simplifyInstanceContexts on the
372 deriving-clause instance specs, which gives us the ThetaTypes for the
373 deriving-clause instances. Now we can feed all the ThetaTypes to the
374 suspended computations and obtain our InstInfos, at which point
375 tcDeriving is done.
376
377 An alternative design would be to split up genInst so that the
378 family instances are generated separately from the InstInfos. But this would
379 require carving up a lot of the GHC deriving internals to accommodate the
380 change. On the other hand, we can keep all of the InstInfo and type family
381 instance logic together in genInst simply by converting genInst to
382 continuation-returning style, so we opt for that route.
383
384 Note [Why we don't pass rep_tc into deriveTyData]
385 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
386 Down in the bowels of mkEqnHelp, we need to convert the fam_tc back into
387 the rep_tc by means of a lookup. And yet we have the rep_tc right here!
388 Why look it up again? Answer: it's just easier this way.
389 We drop some number of arguments from the end of the datatype definition
390 in deriveTyData. The arguments are dropped from the fam_tc.
391 This action may drop a *different* number of arguments
392 passed to the rep_tc, depending on how many free variables, etc., the
393 dropped patterns have.
394
395 Also, this technique carries over the kind substitution from deriveTyData
396 nicely.
397
398 Note [Avoid RebindableSyntax when deriving]
399 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
400 The RebindableSyntax extension interacts awkwardly with the derivation of
401 any stock class whose methods require the use of string literals. The Show
402 class is a simple example (see #12688):
403
404 {-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
405 newtype Text = Text String
406 fromString :: String -> Text
407 fromString = Text
408
409 data Foo = Foo deriving Show
410
411 This will generate code to the effect of:
412
413 instance Show Foo where
414 showsPrec _ Foo = showString "Foo"
415
416 But because RebindableSyntax and OverloadedStrings are enabled, the "Foo"
417 string literal is now of type Text, not String, which showString doesn't
418 accept! This causes the generated Show instance to fail to typecheck.
419
420 To avoid this kind of scenario, we simply turn off RebindableSyntax entirely
421 in derived code.
422
423 ************************************************************************
424 * *
425 From HsSyn to DerivSpec
426 * *
427 ************************************************************************
428
429 @makeDerivSpecs@ fishes around to find the info about needed derived instances.
430 -}
431
432 makeDerivSpecs :: [DerivInfo]
433 -> [LDerivDecl GhcRn]
434 -> TcM [EarlyDerivSpec]
435 makeDerivSpecs deriv_infos deriv_decls
436 = do { eqns1 <- sequenceA
437 [ deriveClause rep_tc scoped_tvs dcs preds err_ctxt
438 | DerivInfo { di_rep_tc = rep_tc
439 , di_scoped_tvs = scoped_tvs
440 , di_clauses = clauses
441 , di_ctxt = err_ctxt } <- deriv_infos
442 , L _ (HsDerivingClause { deriv_clause_strategy = dcs
443 , deriv_clause_tys = L _ preds })
444 <- clauses
445 ]
446 ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls
447 ; return $ concat eqns1 ++ catMaybes eqns2 }
448
449 ------------------------------------------------------------------
450 -- | Process the derived classes in a single @deriving@ clause.
451 deriveClause :: TyCon
452 -> [(Name, TcTyVar)] -- Scoped type variables taken from tcTyConScopedTyVars
453 -- See Note [Scoped tyvars in a TcTyCon] in types/TyCon
454 -> Maybe (LDerivStrategy GhcRn)
455 -> [LHsSigType GhcRn] -> SDoc
456 -> TcM [EarlyDerivSpec]
457 deriveClause rep_tc scoped_tvs mb_lderiv_strat deriv_preds err_ctxt
458 = addErrCtxt err_ctxt $ do
459 traceTc "deriveClause" $ vcat
460 [ text "tvs" <+> ppr tvs
461 , text "scoped_tvs" <+> ppr scoped_tvs
462 , text "tc" <+> ppr tc
463 , text "tys" <+> ppr tys
464 , text "mb_lderiv_strat" <+> ppr mb_lderiv_strat ]
465 tcExtendNameTyVarEnv scoped_tvs $ do
466 (mb_lderiv_strat', via_tvs) <- tcDerivStrategy mb_lderiv_strat
467 tcExtendTyVarEnv via_tvs $
468 -- Moreover, when using DerivingVia one can bind type variables in
469 -- the `via` type as well, so these type variables must also be
470 -- brought into scope.
471 mapMaybeM (derivePred tc tys mb_lderiv_strat' via_tvs) deriv_preds
472 -- After typechecking the `via` type once, we then typecheck all
473 -- of the classes associated with that `via` type in the
474 -- `deriving` clause.
475 -- See also Note [Don't typecheck too much in DerivingVia].
476 where
477 tvs = tyConTyVars rep_tc
478 (tc, tys) = case tyConFamInstSig_maybe rep_tc of
479 -- data family:
480 Just (fam_tc, pats, _) -> (fam_tc, pats)
481 -- NB: deriveTyData wants the *user-specified*
482 -- name. See Note [Why we don't pass rep_tc into deriveTyData]
483
484 _ -> (rep_tc, mkTyVarTys tvs) -- datatype
485
486 -- | Process a single predicate in a @deriving@ clause.
487 --
488 -- This returns a 'Maybe' because the user might try to derive 'Typeable',
489 -- which is a no-op nowadays.
490 derivePred :: TyCon -> [Type] -> Maybe (LDerivStrategy GhcTc) -> [TyVar]
491 -> LHsSigType GhcRn -> TcM (Maybe EarlyDerivSpec)
492 derivePred tc tys mb_lderiv_strat via_tvs deriv_pred =
493 -- We carefully set up uses of recoverM to minimize error message
494 -- cascades. See Note [Recovering from failures in deriving clauses].
495 recoverM (pure Nothing) $
496 setSrcSpan (getLoc (hsSigType deriv_pred)) $ do
497 traceTc "derivePred" $ vcat
498 [ text "tc" <+> ppr tc
499 , text "tys" <+> ppr tys
500 , text "deriv_pred" <+> ppr deriv_pred
501 , text "mb_lderiv_strat" <+> ppr mb_lderiv_strat
502 , text "via_tvs" <+> ppr via_tvs ]
503 (cls_tvs, cls, cls_tys, cls_arg_kinds) <- tcHsDeriv deriv_pred
504 when (cls_arg_kinds `lengthIsNot` 1) $
505 failWithTc (nonUnaryErr deriv_pred)
506 let [cls_arg_kind] = cls_arg_kinds
507 mb_deriv_strat = fmap unLoc mb_lderiv_strat
508 if (className cls == typeableClassName)
509 then do warnUselessTypeable
510 return Nothing
511 else let deriv_tvs = via_tvs ++ cls_tvs in
512 Just <$> deriveTyData tc tys mb_deriv_strat
513 deriv_tvs cls cls_tys cls_arg_kind
514
515 {-
516 Note [Don't typecheck too much in DerivingVia]
517 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
518 Consider the following example:
519
520 data D = ...
521 deriving (A1 t, ..., A20 t) via T t
522
523 GHC used to be engineered such that it would typecheck the `deriving`
524 clause like so:
525
526 1. Take the first class in the clause (`A1`).
527 2. Typecheck the `via` type (`T t`) and bring its bound type variables
528 into scope (`t`).
529 3. Typecheck the class (`A1`).
530 4. Move on to the next class (`A2`) and repeat the process until all
531 classes have been typechecked.
532
533 This algorithm gets the job done most of the time, but it has two notable
534 flaws. One flaw is that it is wasteful: it requires that `T t` be typechecked
535 20 different times, once for each class in the `deriving` clause. This is
536 unnecessary because we only need to typecheck `T t` once in order to get
537 access to its bound type variable.
538
539 The other issue with this algorithm arises when there are no classes in the
540 `deriving` clause, like in the following example:
541
542 data D2 = ...
543 deriving () via Maybe Maybe
544
545 Because there are no classes, the algorithm above will simply do nothing.
546 As a consequence, GHC will completely miss the fact that `Maybe Maybe`
547 is ill-kinded nonsense (#16923).
548
549 To address both of these problems, GHC now uses this algorithm instead:
550
551 1. Typecheck the `via` type and bring its boudn type variables into scope.
552 2. Take the first class in the `deriving` clause.
553 3. Typecheck the class.
554 4. Move on to the next class and repeat the process until all classes have been
555 typechecked.
556
557 This algorithm ensures that the `via` type is always typechecked, even if there
558 are no classes in the `deriving` clause. Moreover, it typecheck the `via` type
559 /exactly/ once and no more, even if there are multiple classes in the clause.
560
561 Note [Recovering from failures in deriving clauses]
562 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
563 Consider what happens if you run this program (from #10684) without
564 DeriveGeneric enabled:
565
566 data A = A deriving (Show, Generic)
567 data B = B A deriving (Show)
568
569 Naturally, you'd expect GHC to give an error to the effect of:
570
571 Can't make a derived instance of `Generic A':
572 You need -XDeriveGeneric to derive an instance for this class
573
574 And *only* that error, since the other two derived Show instances appear to be
575 independent of this derived Generic instance. Yet GHC also used to give this
576 additional error on the program above:
577
578 No instance for (Show A)
579 arising from the 'deriving' clause of a data type declaration
580 When deriving the instance for (Show B)
581
582 This was happening because when GHC encountered any error within a single
583 data type's set of deriving clauses, it would call recoverM and move on
584 to the next data type's deriving clauses. One unfortunate consequence of
585 this design is that if A's derived Generic instance failed, its derived
586 Show instance would be skipped entirely, leading to the "No instance for
587 (Show A)" error cascade.
588
589 The solution to this problem is to push through uses of recoverM to the
590 level of the individual derived classes in a particular data type's set of
591 deriving clauses. That is, if you have:
592
593 newtype C = C D
594 deriving (E, F, G)
595
596 Then instead of processing instances E through M under the scope of a single
597 recoverM, as in the following pseudocode:
598
599 recoverM (pure Nothing) $ mapM derivePred [E, F, G]
600
601 We instead use recoverM in each iteration of the loop:
602
603 mapM (recoverM (pure Nothing) . derivePred) [E, F, G]
604
605 And then process each class individually, under its own recoverM scope. That
606 way, failure to derive one class doesn't cancel out other classes in the
607 same set of clause-derived classes.
608 -}
609
610 ------------------------------------------------------------------
611 deriveStandalone :: LDerivDecl GhcRn -> TcM (Maybe EarlyDerivSpec)
612 -- Process a single standalone deriving declaration
613 -- e.g. deriving instance Show a => Show (T a)
614 -- Rather like tcLocalInstDecl
615 --
616 -- This returns a Maybe because the user might try to derive Typeable, which is
617 -- a no-op nowadays.
618 deriveStandalone (L loc (DerivDecl _ deriv_ty mb_lderiv_strat overlap_mode))
619 = setSrcSpan loc $
620 addErrCtxt (standaloneCtxt deriv_ty) $
621 do { traceTc "Standalone deriving decl for" (ppr deriv_ty)
622 ; let ctxt = TcOrigin.InstDeclCtxt True
623 ; traceTc "Deriving strategy (standalone deriving)" $
624 vcat [ppr mb_lderiv_strat, ppr deriv_ty]
625 ; (mb_lderiv_strat, via_tvs) <- tcDerivStrategy mb_lderiv_strat
626 ; (cls_tvs, deriv_ctxt, cls, inst_tys)
627 <- tcExtendTyVarEnv via_tvs $
628 tcStandaloneDerivInstType ctxt deriv_ty
629 ; checkTc (not (null inst_tys)) derivingNullaryErr
630 ; let mb_deriv_strat = fmap unLoc mb_lderiv_strat
631 tvs = via_tvs ++ cls_tvs
632 inst_ty = last inst_tys
633 -- See Note [Unify kinds in deriving]
634 ; (tvs', deriv_ctxt', inst_tys', mb_deriv_strat') <-
635 case mb_deriv_strat of
636 -- Perform an additional unification with the kind of the `via`
637 -- type and the result of the previous kind unification.
638 Just (ViaStrategy via_ty) -> do
639 let via_kind = tcTypeKind via_ty
640 inst_ty_kind = tcTypeKind inst_ty
641 mb_match = tcUnifyTy inst_ty_kind via_kind
642
643 checkTc (isJust mb_match)
644 (derivingViaKindErr cls inst_ty_kind
645 via_ty via_kind)
646
647 let Just kind_subst = mb_match
648 ki_subst_range = getTCvSubstRangeFVs kind_subst
649 -- See Note [Unification of two kind variables in deriving]
650 unmapped_tkvs = filter (\v -> v `notElemTCvSubst` kind_subst
651 && not (v `elemVarSet` ki_subst_range))
652 tvs
653 (subst, _) = substTyVarBndrs kind_subst unmapped_tkvs
654 (final_deriv_ctxt, final_deriv_ctxt_tys)
655 = case deriv_ctxt of
656 InferContext wc -> (InferContext wc, [])
657 SupplyContext theta ->
658 let final_theta = substTheta subst theta
659 in (SupplyContext final_theta, final_theta)
660 final_inst_tys = substTys subst inst_tys
661 final_via_ty = substTy subst via_ty
662 -- See Note [Floating `via` type variables]
663 final_tvs = tyCoVarsOfTypesWellScoped $
664 final_deriv_ctxt_tys ++ final_inst_tys
665 ++ [final_via_ty]
666 pure ( final_tvs, final_deriv_ctxt, final_inst_tys
667 , Just (ViaStrategy final_via_ty) )
668
669 _ -> pure (tvs, deriv_ctxt, inst_tys, mb_deriv_strat)
670 ; let cls_tys' = take (length inst_tys' - 1) inst_tys'
671 inst_ty' = last inst_tys'
672 ; traceTc "Standalone deriving;" $ vcat
673 [ text "tvs':" <+> ppr tvs'
674 , text "mb_deriv_strat':" <+> ppr mb_deriv_strat'
675 , text "deriv_ctxt':" <+> ppr deriv_ctxt'
676 , text "cls:" <+> ppr cls
677 , text "inst_tys':" <+> ppr inst_tys' ]
678 -- C.f. TcInstDcls.tcLocalInstDecl1
679 ; traceTc "Standalone deriving:" $ vcat
680 [ text "class:" <+> ppr cls
681 , text "class types:" <+> ppr cls_tys'
682 , text "type:" <+> ppr inst_ty' ]
683
684 ; let bale_out msg = failWithTc (derivingThingErr False cls cls_tys'
685 inst_ty' mb_deriv_strat' msg)
686
687 ; case tcSplitTyConApp_maybe inst_ty' of
688 Just (tc, tc_args)
689 | className cls == typeableClassName
690 -> do warnUselessTypeable
691 return Nothing
692
693 | otherwise
694 -> Just <$> mkEqnHelp (fmap unLoc overlap_mode)
695 tvs' cls cls_tys' tc tc_args
696 deriv_ctxt' mb_deriv_strat'
697
698 _ -> -- Complain about functions, primitive types, etc,
699 bale_out $
700 text "The last argument of the instance must be a data or newtype application"
701 }
702 deriveStandalone (L _ (XDerivDecl nec)) = noExtCon nec
703
704 -- Typecheck the type in a standalone deriving declaration.
705 --
706 -- This may appear dense, but it's mostly huffing and puffing to recognize
707 -- the special case of a type with an extra-constraints wildcard context, e.g.,
708 --
709 -- deriving instance _ => Eq (Foo a)
710 --
711 -- If there is such a wildcard, we typecheck this as if we had written
712 -- @deriving instance Eq (Foo a)@, and return @'InferContext' ('Just' loc)@,
713 -- as the 'DerivContext', where loc is the location of the wildcard used for
714 -- error reporting. This indicates that we should infer the context as if we
715 -- were deriving Eq via a deriving clause
716 -- (see Note [Inferring the instance context] in TcDerivInfer).
717 --
718 -- If there is no wildcard, then proceed as normal, and instead return
719 -- @'SupplyContext' theta@, where theta is the typechecked context.
720 --
721 -- Note that this will never return @'InferContext' 'Nothing'@, as that can
722 -- only happen with @deriving@ clauses.
723 tcStandaloneDerivInstType
724 :: UserTypeCtxt -> LHsSigWcType GhcRn
725 -> TcM ([TyVar], DerivContext, Class, [Type])
726 tcStandaloneDerivInstType ctxt
727 (HsWC { hswc_body = deriv_ty@(HsIB { hsib_ext = vars
728 , hsib_body = deriv_ty_body })})
729 | (tvs, theta, rho) <- splitLHsSigmaTy deriv_ty_body
730 , L _ [wc_pred] <- theta
731 , L wc_span (HsWildCardTy _) <- ignoreParens wc_pred
732 = do dfun_ty <- tcHsClsInstType ctxt $
733 HsIB { hsib_ext = vars
734 , hsib_body
735 = L (getLoc deriv_ty_body) $
736 HsForAllTy { hst_fvf = ForallInvis
737 , hst_bndrs = tvs
738 , hst_xforall = noExtField
739 , hst_body = rho }}
740 let (tvs, _theta, cls, inst_tys) = tcSplitDFunTy dfun_ty
741 pure (tvs, InferContext (Just wc_span), cls, inst_tys)
742 | otherwise
743 = do dfun_ty <- tcHsClsInstType ctxt deriv_ty
744 let (tvs, theta, cls, inst_tys) = tcSplitDFunTy dfun_ty
745 pure (tvs, SupplyContext theta, cls, inst_tys)
746
747 tcStandaloneDerivInstType _ (HsWC _ (XHsImplicitBndrs nec))
748 = noExtCon nec
749 tcStandaloneDerivInstType _ (XHsWildCardBndrs nec)
750 = noExtCon nec
751
752 warnUselessTypeable :: TcM ()
753 warnUselessTypeable
754 = do { warn <- woptM Opt_WarnDerivingTypeable
755 ; when warn $ addWarnTc (Reason Opt_WarnDerivingTypeable)
756 $ text "Deriving" <+> quotes (ppr typeableClassName) <+>
757 text "has no effect: all types now auto-derive Typeable" }
758
759 ------------------------------------------------------------------
760 deriveTyData :: TyCon -> [Type] -- LHS of data or data instance
761 -- Can be a data instance, hence [Type] args
762 -- and in that case the TyCon is the /family/ tycon
763 -> Maybe (DerivStrategy GhcTc) -- The optional deriving strategy
764 -> [TyVar] -- The type variables bound by the derived class
765 -> Class -- The derived class
766 -> [Type] -- The derived class's arguments
767 -> Kind -- The function argument in the derived class's kind.
768 -- (e.g., if `deriving Functor`, this would be
769 -- `Type -> Type` since
770 -- `Functor :: (Type -> Type) -> Constraint`)
771 -> TcM EarlyDerivSpec
772 -- The deriving clause of a data or newtype declaration
773 -- I.e. not standalone deriving
774 deriveTyData tc tc_args mb_deriv_strat deriv_tvs cls cls_tys cls_arg_kind
775 = do { -- Given data T a b c = ... deriving( C d ),
776 -- we want to drop type variables from T so that (C d (T a)) is well-kinded
777 let (arg_kinds, _) = splitFunTys cls_arg_kind
778 n_args_to_drop = length arg_kinds
779 n_args_to_keep = length tc_args - n_args_to_drop
780 -- See Note [tc_args and tycon arity]
781 (tc_args_to_keep, args_to_drop)
782 = splitAt n_args_to_keep tc_args
783 inst_ty_kind = tcTypeKind (mkTyConApp tc tc_args_to_keep)
784
785 -- Match up the kinds, and apply the resulting kind substitution
786 -- to the types. See Note [Unify kinds in deriving]
787 -- We are assuming the tycon tyvars and the class tyvars are distinct
788 mb_match = tcUnifyTy inst_ty_kind cls_arg_kind
789 enough_args = n_args_to_keep >= 0
790
791 -- Check that the result really is well-kinded
792 ; checkTc (enough_args && isJust mb_match)
793 (derivingKindErr tc cls cls_tys cls_arg_kind enough_args)
794
795 ; let -- Returns a singleton-element list if using ViaStrategy and an
796 -- empty list otherwise. Useful for free-variable calculations.
797 deriv_strat_tys :: Maybe (DerivStrategy GhcTc) -> [Type]
798 deriv_strat_tys = foldMap (foldDerivStrategy [] (:[]))
799
800 propagate_subst kind_subst tkvs' cls_tys' tc_args' mb_deriv_strat'
801 = (final_tkvs, final_cls_tys, final_tc_args, final_mb_deriv_strat)
802 where
803 ki_subst_range = getTCvSubstRangeFVs kind_subst
804 -- See Note [Unification of two kind variables in deriving]
805 unmapped_tkvs = filter (\v -> v `notElemTCvSubst` kind_subst
806 && not (v `elemVarSet` ki_subst_range))
807 tkvs'
808 (subst, _) = substTyVarBndrs kind_subst unmapped_tkvs
809 final_tc_args = substTys subst tc_args'
810 final_cls_tys = substTys subst cls_tys'
811 final_mb_deriv_strat = fmap (mapDerivStrategy (substTy subst))
812 mb_deriv_strat'
813 -- See Note [Floating `via` type variables]
814 final_tkvs = tyCoVarsOfTypesWellScoped $
815 final_cls_tys ++ final_tc_args
816 ++ deriv_strat_tys final_mb_deriv_strat
817
818 ; let tkvs = scopedSort $ fvVarList $
819 unionFV (tyCoFVsOfTypes tc_args_to_keep)
820 (FV.mkFVs deriv_tvs)
821 Just kind_subst = mb_match
822 (tkvs', cls_tys', tc_args', mb_deriv_strat')
823 = propagate_subst kind_subst tkvs cls_tys
824 tc_args_to_keep mb_deriv_strat
825
826 -- See Note [Unify kinds in deriving]
827 ; (final_tkvs, final_cls_tys, final_tc_args, final_mb_deriv_strat) <-
828 case mb_deriv_strat' of
829 -- Perform an additional unification with the kind of the `via`
830 -- type and the result of the previous kind unification.
831 Just (ViaStrategy via_ty) -> do
832 let via_kind = tcTypeKind via_ty
833 inst_ty_kind
834 = tcTypeKind (mkTyConApp tc tc_args')
835 via_match = tcUnifyTy inst_ty_kind via_kind
836
837 checkTc (isJust via_match)
838 (derivingViaKindErr cls inst_ty_kind via_ty via_kind)
839
840 let Just via_subst = via_match
841 pure $ propagate_subst via_subst tkvs' cls_tys'
842 tc_args' mb_deriv_strat'
843
844 _ -> pure (tkvs', cls_tys', tc_args', mb_deriv_strat')
845
846 ; traceTc "deriveTyData 1" $ vcat
847 [ ppr final_mb_deriv_strat, pprTyVars deriv_tvs, ppr tc, ppr tc_args
848 , pprTyVars (tyCoVarsOfTypesList tc_args)
849 , ppr n_args_to_keep, ppr n_args_to_drop
850 , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
851 , ppr final_tc_args, ppr final_cls_tys ]
852
853 ; traceTc "deriveTyData 2" $ vcat
854 [ ppr final_tkvs ]
855
856 ; let final_tc_app = mkTyConApp tc final_tc_args
857 ; checkTc (allDistinctTyVars (mkVarSet final_tkvs) args_to_drop) -- (a, b, c)
858 (derivingEtaErr cls final_cls_tys final_tc_app)
859 -- Check that
860 -- (a) The args to drop are all type variables; eg reject:
861 -- data instance T a Int = .... deriving( Monad )
862 -- (b) The args to drop are all *distinct* type variables; eg reject:
863 -- class C (a :: * -> * -> *) where ...
864 -- data instance T a a = ... deriving( C )
865 -- (c) The type class args, or remaining tycon args,
866 -- do not mention any of the dropped type variables
867 -- newtype T a s = ... deriving( ST s )
868 -- newtype instance K a a = ... deriving( Monad )
869 --
870 -- It is vital that the implementation of allDistinctTyVars
871 -- expand any type synonyms.
872 -- See Note [Eta-reducing type synonyms]
873
874 ; checkValidInstHead DerivClauseCtxt cls $
875 final_cls_tys ++ [final_tc_app]
876 -- Check that we aren't deriving an instance of a magical
877 -- type like (~) or Coercible (#14916).
878
879 ; spec <- mkEqnHelp Nothing final_tkvs
880 cls final_cls_tys tc final_tc_args
881 (InferContext Nothing) final_mb_deriv_strat
882 ; traceTc "deriveTyData 3" (ppr spec)
883 ; return spec }
884
885
886 {- Note [tc_args and tycon arity]
887 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
888 You might wonder if we could use (tyConArity tc) at this point, rather
889 than (length tc_args). But for data families the two can differ! The
890 tc and tc_args passed into 'deriveTyData' come from 'deriveClause' which
891 in turn gets them from 'tyConFamInstSig_maybe' which in turn gets them
892 from DataFamInstTyCon:
893
894 | DataFamInstTyCon -- See Note [Data type families]
895 (CoAxiom Unbranched)
896 TyCon -- The family TyCon
897 [Type] -- Argument types (mentions the tyConTyVars of this TyCon)
898 -- No shorter in length than the tyConTyVars of the family TyCon
899 -- How could it be longer? See [Arity of data families] in FamInstEnv
900
901 Notice that the arg tys might not be the same as the family tycon arity
902 (= length tyConTyVars).
903
904 Note [Unify kinds in deriving]
905 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
906 Consider (#8534)
907 data T a b = MkT a deriving( Functor )
908 -- where Functor :: (*->*) -> Constraint
909
910 So T :: forall k. * -> k -> *. We want to get
911 instance Functor (T * (a:*)) where ...
912 Notice the '*' argument to T.
913
914 Moreover, as well as instantiating T's kind arguments, we may need to instantiate
915 C's kind args. Consider (#8865):
916 newtype T a b = MkT (Either a b) deriving( Category )
917 where
918 Category :: forall k. (k -> k -> *) -> Constraint
919 We need to generate the instance
920 instance Category * (Either a) where ...
921 Notice the '*' argument to Category.
922
923 So we need to
924 * drop arguments from (T a b) to match the number of
925 arrows in the (last argument of the) class;
926 * and then *unify* kind of the remaining type against the
927 expected kind, to figure out how to instantiate C's and T's
928 kind arguments.
929
930 In the two examples,
931 * we unify kind-of( T k (a:k) ) ~ kind-of( Functor )
932 i.e. (k -> *) ~ (* -> *) to find k:=*.
933 yielding k:=*
934
935 * we unify kind-of( Either ) ~ kind-of( Category )
936 i.e. (* -> * -> *) ~ (k -> k -> k)
937 yielding k:=*
938
939 Now we get a kind substitution. We then need to:
940
941 1. Remove the substituted-out kind variables from the quantified kind vars
942
943 2. Apply the substitution to the kinds of quantified *type* vars
944 (and extend the substitution to reflect this change)
945
946 3. Apply that extended substitution to the non-dropped args (types and
947 kinds) of the type and class
948
949 Forgetting step (2) caused #8893:
950 data V a = V [a] deriving Functor
951 data P (x::k->*) (a:k) = P (x a) deriving Functor
952 data C (x::k->*) (a:k) = C (V (P x a)) deriving Functor
953
954 When deriving Functor for P, we unify k to *, but we then want
955 an instance $df :: forall (x:*->*). Functor x => Functor (P * (x:*->*))
956 and similarly for C. Notice the modified kind of x, both at binding
957 and occurrence sites.
958
959 This can lead to some surprising results when *visible* kind binder is
960 unified (in contrast to the above examples, in which only non-visible kind
961 binders were considered). Consider this example from #11732:
962
963 data T k (a :: k) = MkT deriving Functor
964
965 Since unification yields k:=*, this results in a generated instance of:
966
967 instance Functor (T *) where ...
968
969 which looks odd at first glance, since one might expect the instance head
970 to be of the form Functor (T k). Indeed, one could envision an alternative
971 generated instance of:
972
973 instance (k ~ *) => Functor (T k) where
974
975 But this does not typecheck by design: kind equalities are not allowed to be
976 bound in types, only terms. But in essence, the two instance declarations are
977 entirely equivalent, since even though (T k) matches any kind k, the only
978 possibly value for k is *, since anything else is ill-typed. As a result, we can
979 just as comfortably use (T *).
980
981 Another way of thinking about is: deriving clauses often infer constraints.
982 For example:
983
984 data S a = S a deriving Eq
985
986 infers an (Eq a) constraint in the derived instance. By analogy, when we
987 are deriving Functor, we might infer an equality constraint (e.g., k ~ *).
988 The only distinction is that GHC instantiates equality constraints directly
989 during the deriving process.
990
991 Another quirk of this design choice manifests when typeclasses have visible
992 kind parameters. Consider this code (also from #11732):
993
994 class Cat k (cat :: k -> k -> *) where
995 catId :: cat a a
996 catComp :: cat b c -> cat a b -> cat a c
997
998 instance Cat * (->) where
999 catId = id
1000 catComp = (.)
1001
1002 newtype Fun a b = Fun (a -> b) deriving (Cat k)
1003
1004 Even though we requested a derived instance of the form (Cat k Fun), the
1005 kind unification will actually generate (Cat * Fun) (i.e., the same thing as if
1006 the user wrote deriving (Cat *)).
1007
1008 What happens with DerivingVia, when you have yet another type? Consider:
1009
1010 newtype Foo (a :: Type) = MkFoo (Proxy a)
1011 deriving Functor via Proxy
1012
1013 As before, we unify the kind of Foo (* -> *) with the kind of the argument to
1014 Functor (* -> *). But that's not enough: the `via` type, Proxy, has the kind
1015 (k -> *), which is more general than what we want. So we must additionally
1016 unify (k -> *) with (* -> *).
1017
1018 Currently, all of this unification is implemented kludgily with the pure
1019 unifier, which is rather tiresome. #14331 lays out a plan for how this
1020 might be made cleaner.
1021
1022 Note [Unification of two kind variables in deriving]
1023 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1024 As a special case of the Note above, it is possible to derive an instance of
1025 a poly-kinded typeclass for a poly-kinded datatype. For example:
1026
1027 class Category (cat :: k -> k -> *) where
1028 newtype T (c :: k -> k -> *) a b = MkT (c a b) deriving Category
1029
1030 This case is suprisingly tricky. To see why, let's write out what instance GHC
1031 will attempt to derive (using -fprint-explicit-kinds syntax):
1032
1033 instance Category k1 (T k2 c) where ...
1034
1035 GHC will attempt to unify k1 and k2, which produces a substitution (kind_subst)
1036 that looks like [k2 :-> k1]. Importantly, we need to apply this substitution to
1037 the type variable binder for c, since its kind is (k2 -> k2 -> *).
1038
1039 We used to accomplish this by doing the following:
1040
1041 unmapped_tkvs = filter (`notElemTCvSubst` kind_subst) all_tkvs
1042 (subst, _) = substTyVarBndrs kind_subst unmapped_tkvs
1043
1044 Where all_tkvs contains all kind variables in the class and instance types (in
1045 this case, all_tkvs = [k1,k2]). But since kind_subst only has one mapping,
1046 this results in unmapped_tkvs being [k1], and as a consequence, k1 gets mapped
1047 to another kind variable in subst! That is, subst = [k2 :-> k1, k1 :-> k_new].
1048 This is bad, because applying that substitution yields the following instance:
1049
1050 instance Category k_new (T k1 c) where ...
1051
1052 In other words, keeping k1 in unmapped_tvks taints the substitution, resulting
1053 in an ill-kinded instance (this caused #11837).
1054
1055 To prevent this, we need to filter out any variable from all_tkvs which either
1056
1057 1. Appears in the domain of kind_subst. notElemTCvSubst checks this.
1058 2. Appears in the range of kind_subst. To do this, we compute the free
1059 variable set of the range of kind_subst with getTCvSubstRangeFVs, and check
1060 if a kind variable appears in that set.
1061
1062 Note [Eta-reducing type synonyms]
1063 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1064 One can instantiate a type in a data family instance with a type synonym that
1065 mentions other type variables:
1066
1067 type Const a b = a
1068 data family Fam (f :: * -> *) (a :: *)
1069 newtype instance Fam f (Const a f) = Fam (f a) deriving Functor
1070
1071 It is also possible to define kind synonyms, and they can mention other types in
1072 a datatype declaration. For example,
1073
1074 type Const a b = a
1075 newtype T f (a :: Const * f) = T (f a) deriving Functor
1076
1077 When deriving, we need to perform eta-reduction analysis to ensure that none of
1078 the eta-reduced type variables are mentioned elsewhere in the declaration. But
1079 we need to be careful, because if we don't expand through the Const type
1080 synonym, we will mistakenly believe that f is an eta-reduced type variable and
1081 fail to derive Functor, even though the code above is correct (see #11416,
1082 where this was first noticed). For this reason, we expand the type synonyms in
1083 the eta-reduced types before doing any analysis.
1084
1085 Note [Floating `via` type variables]
1086 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1087 When generating a derived instance, it will be of the form:
1088
1089 instance forall ???. C c_args (D d_args) where ...
1090
1091 To fill in ???, GHC computes the free variables of `c_args` and `d_args`.
1092 `DerivingVia` adds an extra wrinkle to this formula, since we must also
1093 include the variables bound by the `via` type when computing the binders
1094 used to fill in ???. This might seem strange, since if a `via` type binds
1095 any type variables, then in almost all scenarios it will appear free in
1096 `c_args` or `d_args`. There are certain corner cases where this does not hold,
1097 however, such as in the following example (adapted from #15831):
1098
1099 newtype Age = MkAge Int
1100 deriving Eq via Const Int a
1101
1102 In this example, the `via` type binds the type variable `a`, but `a` appears
1103 nowhere in `Eq Age`. Nevertheless, we include it in the generated instance:
1104
1105 instance forall a. Eq Age where
1106 (==) = coerce @(Const Int a -> Const Int a -> Bool)
1107 @(Age -> Age -> Bool)
1108 (==)
1109
1110 The use of `forall a` is certainly required here, since the `a` in
1111 `Const Int a` would not be in scope otherwise. This instance is somewhat
1112 strange in that nothing in the instance head `Eq Age` ever determines what `a`
1113 will be, so any code that uses this instance will invariably instantiate `a`
1114 to be `Any`. We refer to this property of `a` as being a "floating" `via`
1115 type variable. Programs with floating `via` type variables are the only known
1116 class of program in which the `via` type quantifies type variables that aren't
1117 mentioned in the instance head in the generated instance.
1118
1119 Fortunately, the choice to instantiate floating `via` type variables to `Any`
1120 is one that is completely transparent to the user (since the instance will
1121 work as expected regardless of what `a` is instantiated to), so we decide to
1122 permit them. An alternative design would make programs with floating `via`
1123 variables illegal, by requiring that every variable mentioned in the `via` type
1124 is also mentioned in the data header or the derived class. That restriction
1125 would require the user to pick a particular type (the choice does not matter);
1126 for example:
1127
1128 newtype Age = MkAge Int
1129 -- deriving Eq via Const Int a -- Floating 'a'
1130 deriving Eq via Const Int () -- Choose a=()
1131 deriving Eq via Const Int Any -- Choose a=Any
1132
1133 No expressiveness would be lost thereby, but stylistically it seems preferable
1134 to allow a type variable to indicate "it doesn't matter".
1135
1136 Note that by quantifying the `a` in `forall a. Eq Age`, we are deferring the
1137 work of instantiating `a` to `Any` at every use site of the instance. An
1138 alternative approach would be to generate an instance that directly defaulted
1139 to `Any`:
1140
1141 instance Eq Age where
1142 (==) = coerce @(Const Int Any -> Const Int Any -> Bool)
1143 @(Age -> Age -> Bool)
1144 (==)
1145
1146 We do not implement this approach since it would require a nontrivial amount
1147 of implementation effort to substitute `Any` for the floating `via` type
1148 variables, and since the end result isn't distinguishable from the former
1149 instance (at least from the user's perspective), the amount of engineering
1150 required to obtain the latter instance just isn't worth it.
1151 -}
1152
1153 mkEqnHelp :: Maybe OverlapMode
1154 -> [TyVar]
1155 -> Class -> [Type]
1156 -> TyCon -> [Type]
1157 -> DerivContext
1158 -- SupplyContext => context supplied (standalone deriving)
1159 -- InferContext => context inferred (deriving on data decl, or
1160 -- standalone deriving decl with a wildcard)
1161 -> Maybe (DerivStrategy GhcTc)
1162 -> TcRn EarlyDerivSpec
1163 -- Make the EarlyDerivSpec for an instance
1164 -- forall tvs. theta => cls (tys ++ [ty])
1165 -- where the 'theta' is optional (that's the Maybe part)
1166 -- Assumes that this declaration is well-kinded
1167
1168 mkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args deriv_ctxt deriv_strat
1169 = do { -- Find the instance of a data family
1170 -- Note [Looking up family instances for deriving]
1171 fam_envs <- tcGetFamInstEnvs
1172 ; let (rep_tc, rep_tc_args, _co) = tcLookupDataFamInst fam_envs tycon tc_args
1173 -- If it's still a data family, the lookup failed; i.e no instance exists
1174 ; when (isDataFamilyTyCon rep_tc)
1175 (bale_out (text "No family instance for" <+> quotes (pprTypeApp tycon tc_args)))
1176 ; is_boot <- tcIsHsBootOrSig
1177 ; when is_boot $
1178 bale_out (text "Cannot derive instances in hs-boot files"
1179 $+$ text "Write an instance declaration instead")
1180
1181 ; let deriv_env = DerivEnv
1182 { denv_overlap_mode = overlap_mode
1183 , denv_tvs = tvs
1184 , denv_cls = cls
1185 , denv_cls_tys = cls_tys
1186 , denv_tc = tycon
1187 , denv_tc_args = tc_args
1188 , denv_rep_tc = rep_tc
1189 , denv_rep_tc_args = rep_tc_args
1190 , denv_ctxt = deriv_ctxt
1191 , denv_strat = deriv_strat }
1192 ; flip runReaderT deriv_env $
1193 if isNewTyCon rep_tc then mkNewTypeEqn else mkDataTypeEqn }
1194 where
1195 bale_out msg = failWithTc (derivingThingErr False cls cls_tys
1196 (mkTyConApp tycon tc_args) deriv_strat msg)
1197
1198 {-
1199 Note [Looking up family instances for deriving]
1200 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1201 tcLookupFamInstExact is an auxiliary lookup wrapper which requires
1202 that looked-up family instances exist. If called with a vanilla
1203 tycon, the old type application is simply returned.
1204
1205 If we have
1206 data instance F () = ... deriving Eq
1207 data instance F () = ... deriving Eq
1208 then tcLookupFamInstExact will be confused by the two matches;
1209 but that can't happen because tcInstDecls1 doesn't call tcDeriving
1210 if there are any overlaps.
1211
1212 There are two other things that might go wrong with the lookup.
1213 First, we might see a standalone deriving clause
1214 deriving Eq (F ())
1215 when there is no data instance F () in scope.
1216
1217 Note that it's OK to have
1218 data instance F [a] = ...
1219 deriving Eq (F [(a,b)])
1220 where the match is not exact; the same holds for ordinary data types
1221 with standalone deriving declarations.
1222
1223 Note [Deriving, type families, and partial applications]
1224 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1225 When there are no type families, it's quite easy:
1226
1227 newtype S a = MkS [a]
1228 -- :CoS :: S ~ [] -- Eta-reduced
1229
1230 instance Eq [a] => Eq (S a) -- by coercion sym (Eq (:CoS a)) : Eq [a] ~ Eq (S a)
1231 instance Monad [] => Monad S -- by coercion sym (Monad :CoS) : Monad [] ~ Monad S
1232
1233 When type familes are involved it's trickier:
1234
1235 data family T a b
1236 newtype instance T Int a = MkT [a] deriving( Eq, Monad )
1237 -- :RT is the representation type for (T Int a)
1238 -- :Co:RT :: :RT ~ [] -- Eta-reduced!
1239 -- :CoF:RT a :: T Int a ~ :RT a -- Also eta-reduced!
1240
1241 instance Eq [a] => Eq (T Int a) -- easy by coercion
1242 -- d1 :: Eq [a]
1243 -- d2 :: Eq (T Int a) = d1 |> Eq (sym (:Co:RT a ; :coF:RT a))
1244
1245 instance Monad [] => Monad (T Int) -- only if we can eta reduce???
1246 -- d1 :: Monad []
1247 -- d2 :: Monad (T Int) = d1 |> Monad (sym (:Co:RT ; :coF:RT))
1248
1249 Note the need for the eta-reduced rule axioms. After all, we can
1250 write it out
1251 instance Monad [] => Monad (T Int) -- only if we can eta reduce???
1252 return x = MkT [x]
1253 ... etc ...
1254
1255 See Note [Eta reduction for data families] in FamInstEnv
1256
1257 %************************************************************************
1258 %* *
1259 Deriving data types
1260 * *
1261 ************************************************************************
1262 -}
1263
1264 -- | Derive an instance for a data type (i.e., non-newtype).
1265 mkDataTypeEqn :: DerivM EarlyDerivSpec
1266 mkDataTypeEqn
1267 = do mb_strat <- asks denv_strat
1268 case mb_strat of
1269 Just StockStrategy -> mk_eqn_stock
1270 Just AnyclassStrategy -> mk_eqn_anyclass
1271 Just (ViaStrategy ty) -> mk_eqn_via ty
1272 -- GeneralizedNewtypeDeriving makes no sense for non-newtypes
1273 Just NewtypeStrategy -> derivingThingFailWith False gndNonNewtypeErr
1274 -- Lacking a user-requested deriving strategy, we will try to pick
1275 -- between the stock or anyclass strategies
1276 Nothing -> mk_eqn_no_mechanism
1277
1278 -- Once the DerivSpecMechanism is known, we can finally produce an
1279 -- EarlyDerivSpec from it.
1280 mk_eqn_from_mechanism :: DerivSpecMechanism -> DerivM EarlyDerivSpec
1281 mk_eqn_from_mechanism mechanism
1282 = do DerivEnv { denv_overlap_mode = overlap_mode
1283 , denv_tvs = tvs
1284 , denv_tc = tc
1285 , denv_tc_args = tc_args
1286 , denv_rep_tc = rep_tc
1287 , denv_cls = cls
1288 , denv_cls_tys = cls_tys
1289 , denv_ctxt = deriv_ctxt } <- ask
1290 let inst_ty = mkTyConApp tc tc_args
1291 inst_tys = cls_tys ++ [inst_ty]
1292 doDerivInstErrorChecks1 mechanism
1293 loc <- lift getSrcSpanM
1294 dfun_name <- lift $ newDFunName cls inst_tys loc
1295 case deriv_ctxt of
1296 InferContext wildcard ->
1297 do { (inferred_constraints, tvs', inst_tys')
1298 <- inferConstraints mechanism
1299 ; return $ InferTheta $ DS
1300 { ds_loc = loc
1301 , ds_name = dfun_name, ds_tvs = tvs'
1302 , ds_cls = cls, ds_tys = inst_tys'
1303 , ds_tc = rep_tc
1304 , ds_theta = inferred_constraints
1305 , ds_overlap = overlap_mode
1306 , ds_standalone_wildcard = wildcard
1307 , ds_mechanism = mechanism } }
1308
1309 SupplyContext theta ->
1310 return $ GivenTheta $ DS
1311 { ds_loc = loc
1312 , ds_name = dfun_name, ds_tvs = tvs
1313 , ds_cls = cls, ds_tys = inst_tys
1314 , ds_tc = rep_tc
1315 , ds_theta = theta
1316 , ds_overlap = overlap_mode
1317 , ds_standalone_wildcard = Nothing
1318 , ds_mechanism = mechanism }
1319
1320 mk_eqn_stock :: DerivM EarlyDerivSpec
1321 mk_eqn_stock
1322 = do DerivEnv { denv_tc = tc
1323 , denv_rep_tc = rep_tc
1324 , denv_cls = cls
1325 , denv_cls_tys = cls_tys
1326 , denv_ctxt = deriv_ctxt } <- ask
1327 dflags <- getDynFlags
1328 case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys
1329 tc rep_tc of
1330 CanDeriveStock gen_fn -> mk_eqn_from_mechanism $ DerivSpecStock gen_fn
1331 StockClassError msg -> derivingThingFailWith False msg
1332 _ -> derivingThingFailWith False (nonStdErr cls)
1333
1334 mk_eqn_anyclass :: DerivM EarlyDerivSpec
1335 mk_eqn_anyclass
1336 = do dflags <- getDynFlags
1337 case canDeriveAnyClass dflags of
1338 IsValid -> mk_eqn_from_mechanism DerivSpecAnyClass
1339 NotValid msg -> derivingThingFailWith False msg
1340
1341 mk_eqn_newtype :: Type -- The newtype's representation type
1342 -> DerivM EarlyDerivSpec
1343 mk_eqn_newtype rep_ty = mk_eqn_from_mechanism (DerivSpecNewtype rep_ty)
1344
1345 mk_eqn_via :: Type -- The @via@ type
1346 -> DerivM EarlyDerivSpec
1347 mk_eqn_via via_ty = mk_eqn_from_mechanism (DerivSpecVia via_ty)
1348
1349 mk_eqn_no_mechanism :: DerivM EarlyDerivSpec
1350 mk_eqn_no_mechanism
1351 = do DerivEnv { denv_tc = tc
1352 , denv_rep_tc = rep_tc
1353 , denv_cls = cls
1354 , denv_cls_tys = cls_tys
1355 , denv_ctxt = deriv_ctxt } <- ask
1356 dflags <- getDynFlags
1357
1358 -- See Note [Deriving instances for classes themselves]
1359 let dac_error msg
1360 | isClassTyCon rep_tc
1361 = quotes (ppr tc) <+> text "is a type class,"
1362 <+> text "and can only have a derived instance"
1363 $+$ text "if DeriveAnyClass is enabled"
1364 | otherwise
1365 = nonStdErr cls $$ msg
1366
1367 case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys
1368 tc rep_tc of
1369 -- NB: pass the *representation* tycon to
1370 -- checkOriginativeSideConditions
1371 NonDerivableClass msg -> derivingThingFailWith False (dac_error msg)
1372 StockClassError msg -> derivingThingFailWith False msg
1373 CanDeriveStock gen_fn -> mk_eqn_from_mechanism $ DerivSpecStock gen_fn
1374 CanDeriveAnyClass -> mk_eqn_from_mechanism DerivSpecAnyClass
1375
1376 {-
1377 ************************************************************************
1378 * *
1379 GeneralizedNewtypeDeriving and DerivingVia
1380 * *
1381 ************************************************************************
1382 -}
1383
1384 -- | Derive an instance for a newtype.
1385 mkNewTypeEqn :: DerivM EarlyDerivSpec
1386 mkNewTypeEqn
1387 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
1388 = do DerivEnv { denv_tc = tycon
1389 , denv_rep_tc = rep_tycon
1390 , denv_rep_tc_args = rep_tc_args
1391 , denv_cls = cls
1392 , denv_cls_tys = cls_tys
1393 , denv_ctxt = deriv_ctxt
1394 , denv_strat = mb_strat } <- ask
1395 dflags <- getDynFlags
1396
1397 let newtype_deriving = xopt LangExt.GeneralizedNewtypeDeriving dflags
1398 deriveAnyClass = xopt LangExt.DeriveAnyClass dflags
1399
1400 bale_out = derivingThingFailWith newtype_deriving
1401
1402 non_std = nonStdErr cls
1403 suggest_gnd = text "Try GeneralizedNewtypeDeriving for GHC's"
1404 <+> text "newtype-deriving extension"
1405
1406 -- Here is the plan for newtype derivings. We see
1407 -- newtype T a1...an = MkT (t ak+1...an)
1408 -- deriving (.., C s1 .. sm, ...)
1409 -- where t is a type,
1410 -- ak+1...an is a suffix of a1..an, and are all tyvars
1411 -- ak+1...an do not occur free in t, nor in the s1..sm
1412 -- (C s1 ... sm) is a *partial applications* of class C
1413 -- with the last parameter missing
1414 -- (T a1 .. ak) matches the kind of C's last argument
1415 -- (and hence so does t)
1416 -- The latter kind-check has been done by deriveTyData already,
1417 -- and tc_args are already trimmed
1418 --
1419 -- We generate the instance
1420 -- instance forall ({a1..ak} u fvs(s1..sm)).
1421 -- C s1 .. sm t => C s1 .. sm (T a1...ak)
1422 -- where T a1...ap is the partial application of
1423 -- the LHS of the correct kind and p >= k
1424 --
1425 -- NB: the variables below are:
1426 -- tc_tvs = [a1, ..., an]
1427 -- tyvars_to_keep = [a1, ..., ak]
1428 -- rep_ty = t ak .. an
1429 -- deriv_tvs = fvs(s1..sm) \ tc_tvs
1430 -- tys = [s1, ..., sm]
1431 -- rep_fn' = t
1432 --
1433 -- Running example: newtype T s a = MkT (ST s a) deriving( Monad )
1434 -- We generate the instance
1435 -- instance Monad (ST s) => Monad (T s) where
1436
1437 nt_eta_arity = newTyConEtadArity rep_tycon
1438 -- For newtype T a b = MkT (S a a b), the TyCon
1439 -- machinery already eta-reduces the representation type, so
1440 -- we know that
1441 -- T a ~ S a a
1442 -- That's convenient here, because we may have to apply
1443 -- it to fewer than its original complement of arguments
1444
1445 -- Note [Newtype representation]
1446 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1447 -- Need newTyConRhs (*not* a recursive representation finder)
1448 -- to get the representation type. For example
1449 -- newtype B = MkB Int
1450 -- newtype A = MkA B deriving( Num )
1451 -- We want the Num instance of B, *not* the Num instance of Int,
1452 -- when making the Num instance of A!
1453 rep_inst_ty = newTyConInstRhs rep_tycon rep_tc_args
1454
1455 -------------------------------------------------------------------
1456 -- Figuring out whether we can only do this newtype-deriving thing
1457
1458 -- See Note [Determining whether newtype-deriving is appropriate]
1459 might_be_newtype_derivable
1460 = not (non_coercible_class cls)
1461 && eta_ok
1462 -- && not (isRecursiveTyCon tycon) -- Note [Recursive newtypes]
1463
1464 -- Check that eta reduction is OK
1465 eta_ok = rep_tc_args `lengthAtLeast` nt_eta_arity
1466 -- The newtype can be eta-reduced to match the number
1467 -- of type argument actually supplied
1468 -- newtype T a b = MkT (S [a] b) deriving( Monad )
1469 -- Here the 'b' must be the same in the rep type (S [a] b)
1470 -- And the [a] must not mention 'b'. That's all handled
1471 -- by nt_eta_rity.
1472
1473 cant_derive_err = ppUnless eta_ok eta_msg
1474 eta_msg = text "cannot eta-reduce the representation type enough"
1475
1476 MASSERT( cls_tys `lengthIs` (classArity cls - 1) )
1477 case mb_strat of
1478 Just StockStrategy -> mk_eqn_stock
1479 Just AnyclassStrategy -> mk_eqn_anyclass
1480 Just NewtypeStrategy ->
1481 -- Since the user explicitly asked for GeneralizedNewtypeDeriving,
1482 -- we don't need to perform all of the checks we normally would,
1483 -- such as if the class being derived is known to produce ill-roled
1484 -- coercions (e.g., Traversable), since we can just derive the
1485 -- instance and let it error if need be.
1486 -- See Note [Determining whether newtype-deriving is appropriate]
1487 if eta_ok && newtype_deriving
1488 then mk_eqn_newtype rep_inst_ty
1489 else bale_out (cant_derive_err $$
1490 if newtype_deriving then empty else suggest_gnd)
1491 Just (ViaStrategy via_ty) ->
1492 -- NB: For DerivingVia, we don't need to any eta-reduction checking,
1493 -- since the @via@ type is already "eta-reduced".
1494 mk_eqn_via via_ty
1495 Nothing
1496 | might_be_newtype_derivable
1497 && ((newtype_deriving && not deriveAnyClass)
1498 || std_class_via_coercible cls)
1499 -> mk_eqn_newtype rep_inst_ty
1500 | otherwise
1501 -> case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys
1502 tycon rep_tycon of
1503 StockClassError msg
1504 -- There's a particular corner case where
1505 --
1506 -- 1. -XGeneralizedNewtypeDeriving and -XDeriveAnyClass are
1507 -- both enabled at the same time
1508 -- 2. We're deriving a particular stock derivable class
1509 -- (such as Functor)
1510 --
1511 -- and the previous cases won't catch it. This fixes the bug
1512 -- reported in #10598.
1513 | might_be_newtype_derivable && newtype_deriving
1514 -> mk_eqn_newtype rep_inst_ty
1515 -- Otherwise, throw an error for a stock class
1516 | might_be_newtype_derivable && not newtype_deriving
1517 -> bale_out (msg $$ suggest_gnd)
1518 | otherwise
1519 -> bale_out msg
1520
1521 -- Must use newtype deriving or DeriveAnyClass
1522 NonDerivableClass _msg
1523 -- Too hard, even with newtype deriving
1524 | newtype_deriving -> bale_out cant_derive_err
1525 -- Try newtype deriving!
1526 -- Here we suggest GeneralizedNewtypeDeriving even in cases
1527 -- where it may not be applicable. See #9600.
1528 | otherwise -> bale_out (non_std $$ suggest_gnd)
1529
1530 -- DeriveAnyClass
1531 CanDeriveAnyClass -> do
1532 -- If both DeriveAnyClass and GeneralizedNewtypeDeriving are
1533 -- enabled, we take the diplomatic approach of defaulting to
1534 -- DeriveAnyClass, but emitting a warning about the choice.
1535 -- See Note [Deriving strategies]
1536 when (newtype_deriving && deriveAnyClass) $
1537 lift $ whenWOptM Opt_WarnDerivingDefaults $
1538 addWarnTc (Reason Opt_WarnDerivingDefaults) $ sep
1539 [ text "Both DeriveAnyClass and"
1540 <+> text "GeneralizedNewtypeDeriving are enabled"
1541 , text "Defaulting to the DeriveAnyClass strategy"
1542 <+> text "for instantiating" <+> ppr cls
1543 , text "Use DerivingStrategies to pick"
1544 <+> text "a different strategy"
1545 ]
1546 mk_eqn_from_mechanism DerivSpecAnyClass
1547 -- CanDeriveStock
1548 CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
1549 DerivSpecStock gen_fn
1550
1551 {-
1552 Note [Recursive newtypes]
1553 ~~~~~~~~~~~~~~~~~~~~~~~~~
1554 Newtype deriving works fine, even if the newtype is recursive.
1555 e.g. newtype S1 = S1 [T1 ()]
1556 newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad )
1557 Remember, too, that type families are currently (conservatively) given
1558 a recursive flag, so this also allows newtype deriving to work
1559 for type famillies.
1560
1561 We used to exclude recursive types, because we had a rather simple
1562 minded way of generating the instance decl:
1563 newtype A = MkA [A]
1564 instance Eq [A] => Eq A -- Makes typechecker loop!
1565 But now we require a simple context, so it's ok.
1566
1567 Note [Determining whether newtype-deriving is appropriate]
1568 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1569 When we see
1570 newtype NT = MkNT Foo
1571 deriving C
1572 we have to decide how to perform the deriving. Do we do newtype deriving,
1573 or do we do normal deriving? In general, we prefer to do newtype deriving
1574 wherever possible. So, we try newtype deriving unless there's a glaring
1575 reason not to.
1576
1577 "Glaring reasons not to" include trying to derive a class for which a
1578 coercion-based instance doesn't make sense. These classes are listed in
1579 the definition of non_coercible_class. They include Show (since it must
1580 show the name of the datatype) and Traversable (since a coercion-based
1581 Traversable instance is ill-roled).
1582
1583 However, non_coercible_class is ignored if the user explicitly requests
1584 to derive an instance with GeneralizedNewtypeDeriving using the newtype
1585 deriving strategy. In such a scenario, GHC will unquestioningly try to
1586 derive the instance via coercions (even if the final generated code is
1587 ill-roled!). See Note [Deriving strategies].
1588
1589 Note that newtype deriving might fail, even after we commit to it. This
1590 is because the derived instance uses `coerce`, which must satisfy its
1591 `Coercible` constraint. This is different than other deriving scenarios,
1592 where we're sure that the resulting instance will type-check.
1593
1594 Note [GND and associated type families]
1595 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1596 It's possible to use GeneralizedNewtypeDeriving (GND) to derive instances for
1597 classes with associated type families. A general recipe is:
1598
1599 class C x y z where
1600 type T y z x
1601 op :: x -> [y] -> z
1602
1603 newtype N a = MkN <rep-type> deriving( C )
1604
1605 =====>
1606
1607 instance C x y <rep-type> => C x y (N a) where
1608 type T y (N a) x = T y <rep-type> x
1609 op = coerce (op :: x -> [y] -> <rep-type>)
1610
1611 However, we must watch out for three things:
1612
1613 (a) The class must not contain any data families. If it did, we'd have to
1614 generate a fresh data constructor name for the derived data family
1615 instance, and it's not clear how to do this.
1616
1617 (b) Each associated type family's type variables must mention the last type
1618 variable of the class. As an example, you wouldn't be able to use GND to
1619 derive an instance of this class:
1620
1621 class C a b where
1622 type T a
1623
1624 But you would be able to derive an instance of this class:
1625
1626 class C a b where
1627 type T b
1628
1629 The difference is that in the latter T mentions the last parameter of C
1630 (i.e., it mentions b), but the former T does not. If you tried, e.g.,
1631
1632 newtype Foo x = Foo x deriving (C a)
1633
1634 with the former definition of C, you'd end up with something like this:
1635
1636 instance C a (Foo x) where
1637 type T a = T ???
1638
1639 This T family instance doesn't mention the newtype (or its representation
1640 type) at all, so we disallow such constructions with GND.
1641
1642 (c) UndecidableInstances might need to be enabled. Here's a case where it is
1643 most definitely necessary:
1644
1645 class C a where
1646 type T a
1647 newtype Loop = Loop MkLoop deriving C
1648
1649 =====>
1650
1651 instance C Loop where
1652 type T Loop = T Loop
1653
1654 Obviously, T Loop would send the typechecker into a loop. Unfortunately,
1655 you might even need UndecidableInstances even in cases where the
1656 typechecker would be guaranteed to terminate. For example:
1657
1658 instance C Int where
1659 type C Int = Int
1660 newtype MyInt = MyInt Int deriving C
1661
1662 =====>
1663
1664 instance C MyInt where
1665 type T MyInt = T Int
1666
1667 GHC's termination checker isn't sophisticated enough to conclude that the
1668 definition of T MyInt terminates, so UndecidableInstances is required.
1669
1670 (d) For the time being, we do not allow the last type variable of the class to
1671 appear in a /kind/ of an associated type family definition. For instance:
1672
1673 class C a where
1674 type T1 a -- OK
1675 type T2 (x :: a) -- Illegal: a appears in the kind of x
1676 type T3 y :: a -- Illegal: a appears in the kind of (T3 y)
1677
1678 The reason we disallow this is because our current approach to deriving
1679 associated type family instances—i.e., by unwrapping the newtype's type
1680 constructor as shown above—is ill-equipped to handle the scenario when
1681 the last type variable appears as an implicit argument. In the worst case,
1682 allowing the last variable to appear in a kind can result in improper Core
1683 being generated (see #14728).
1684
1685 There is hope for this feature being added some day, as one could
1686 conceivably take a newtype axiom (which witnesses a coercion between a
1687 newtype and its representation type) at lift that through each associated
1688 type at the Core level. See #14728, comment:3 for a sketch of how this
1689 might work. Until then, we disallow this featurette wholesale.
1690
1691 The same criteria apply to DerivingVia.
1692
1693 ************************************************************************
1694 * *
1695 \subsection[TcDeriv-normal-binds]{Bindings for the various classes}
1696 * *
1697 ************************************************************************
1698
1699 After all the trouble to figure out the required context for the
1700 derived instance declarations, all that's left is to chug along to
1701 produce them. They will then be shoved into @tcInstDecls2@, which
1702 will do all its usual business.
1703
1704 There are lots of possibilities for code to generate. Here are
1705 various general remarks.
1706
1707 PRINCIPLES:
1708 \begin{itemize}
1709 \item
1710 We want derived instances of @Eq@ and @Ord@ (both v common) to be
1711 ``you-couldn't-do-better-by-hand'' efficient.
1712
1713 \item
1714 Deriving @Show@---also pretty common--- should also be reasonable good code.
1715
1716 \item
1717 Deriving for the other classes isn't that common or that big a deal.
1718 \end{itemize}
1719
1720 PRAGMATICS:
1721
1722 \begin{itemize}
1723 \item
1724 Deriving @Ord@ is done mostly with the 1.3 @compare@ method.
1725
1726 \item
1727 Deriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.
1728
1729 \item
1730 We {\em normally} generate code only for the non-defaulted methods;
1731 there are some exceptions for @Eq@ and (especially) @Ord@...
1732
1733 \item
1734 Sometimes we use a @_con2tag_<tycon>@ function, which returns a data
1735 constructor's numeric (@Int#@) tag. These are generated by
1736 @gen_tag_n_con_binds@, and the heuristic for deciding if one of
1737 these is around is given by @hasCon2TagFun@.
1738
1739 The examples under the different sections below will make this
1740 clearer.
1741
1742 \item
1743 Much less often (really just for deriving @Ix@), we use a
1744 @_tag2con_<tycon>@ function. See the examples.
1745
1746 \item
1747 We use the renamer!!! Reason: we're supposed to be
1748 producing @LHsBinds Name@ for the methods, but that means
1749 producing correctly-uniquified code on the fly. This is entirely
1750 possible (the @TcM@ monad has a @UniqueSupply@), but it is painful.
1751 So, instead, we produce @MonoBinds RdrName@ then heave 'em through
1752 the renamer. What a great hack!
1753 \end{itemize}
1754 -}
1755
1756 -- Generate the InstInfo for the required instance paired with the
1757 -- *representation* tycon for that instance,
1758 -- plus any auxiliary bindings required
1759 --
1760 -- Representation tycons differ from the tycon in the instance signature in
1761 -- case of instances for indexed families.
1762 --
1763 genInst :: DerivSpec theta
1764 -> TcM (ThetaType -> TcM (InstInfo GhcPs), BagDerivStuff, [Name])
1765 -- We must use continuation-returning style here to get the order in which we
1766 -- typecheck family instances and derived instances right.
1767 -- See Note [Staging of tcDeriving]
1768 genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon
1769 , ds_mechanism = mechanism, ds_tys = tys
1770 , ds_cls = clas, ds_loc = loc
1771 , ds_standalone_wildcard = wildcard })
1772 = do (meth_binds, deriv_stuff, unusedNames)
1773 <- set_span_and_ctxt $
1774 genDerivStuff mechanism loc clas rep_tycon tys tvs
1775 let mk_inst_info theta = set_span_and_ctxt $ do
1776 inst_spec <- newDerivClsInst theta spec
1777 doDerivInstErrorChecks2 clas inst_spec theta wildcard mechanism
1778 traceTc "newder" (ppr inst_spec)
1779 return $ InstInfo
1780 { iSpec = inst_spec
1781 , iBinds = InstBindings
1782 { ib_binds = meth_binds
1783 , ib_tyvars = map Var.varName tvs
1784 , ib_pragmas = []
1785 , ib_extensions = extensions
1786 , ib_derived = True } }
1787 return (mk_inst_info, deriv_stuff, unusedNames)
1788 where
1789 extensions :: [LangExt.Extension]
1790 extensions
1791 | isDerivSpecNewtype mechanism || isDerivSpecVia mechanism
1792 -- Both these flags are needed for higher-rank uses of coerce
1793 -- See Note [Newtype-deriving instances] in TcGenDeriv
1794 = [LangExt.ImpredicativeTypes, LangExt.RankNTypes]
1795 | otherwise
1796 = []
1797
1798 set_span_and_ctxt :: TcM a -> TcM a
1799 set_span_and_ctxt = setSrcSpan loc . addErrCtxt (instDeclCtxt3 clas tys)
1800
1801 -- Checks:
1802 --
1803 -- * All of the data constructors for a data type are in scope for a
1804 -- standalone-derived instance (for `stock` and `newtype` deriving).
1805 --
1806 -- * All of the associated type families of a class are suitable for
1807 -- GeneralizedNewtypeDeriving or DerivingVia (for `newtype` and `via`
1808 -- deriving).
1809 doDerivInstErrorChecks1 :: DerivSpecMechanism -> DerivM ()
1810 doDerivInstErrorChecks1 mechanism =
1811 case mechanism of
1812 DerivSpecStock{} -> data_cons_in_scope_check
1813 DerivSpecNewtype{} -> do atf_coerce_based_error_checks
1814 data_cons_in_scope_check
1815 DerivSpecAnyClass{} -> pure ()
1816 DerivSpecVia{} -> atf_coerce_based_error_checks
1817 where
1818 -- When processing a standalone deriving declaration, check that all of the
1819 -- constructors for the data type are in scope. For instance:
1820 --
1821 -- import M (T)
1822 -- deriving stock instance Eq T
1823 --
1824 -- This should be rejected, as the derived Eq instance would need to refer
1825 -- to the constructors for T, which are not in scope.
1826 --
1827 -- Note that the only strategies that require this check are `stock` and
1828 -- `newtype`. Neither `anyclass` nor `via` require it as the code that they
1829 -- generate does not require using data constructors.
1830 data_cons_in_scope_check :: DerivM ()
1831 data_cons_in_scope_check = do
1832 standalone <- isStandaloneDeriv
1833 when standalone $ do
1834 DerivEnv { denv_tc = tc, denv_rep_tc = rep_tc } <- ask
1835 let bale_out msg = do err <- derivingThingErrMechanism mechanism msg
1836 lift $ failWithTc err
1837
1838 rdr_env <- lift getGlobalRdrEnv
1839 let data_con_names = map dataConName (tyConDataCons rep_tc)
1840 hidden_data_cons = not (isWiredInName (tyConName rep_tc)) &&
1841 (isAbstractTyCon rep_tc ||
1842 any not_in_scope data_con_names)
1843 not_in_scope dc = isNothing (lookupGRE_Name rdr_env dc)
1844
1845 -- Make sure to also mark the data constructors as used so that GHC won't
1846 -- mistakenly emit -Wunused-imports warnings about them.
1847 lift $ addUsedDataCons rdr_env rep_tc
1848
1849 unless (not hidden_data_cons) $
1850 bale_out $ derivingHiddenErr tc
1851
1852 -- Ensure that a class's associated type variables are suitable for
1853 -- GeneralizedNewtypeDeriving or DerivingVia. Unsurprisingly, this check is
1854 -- only required for the `newtype` and `via` strategies.
1855 --
1856 -- See Note [GND and associated type families]
1857 atf_coerce_based_error_checks :: DerivM ()
1858 atf_coerce_based_error_checks = do
1859 cls <- asks denv_cls
1860 let bale_out msg = do err <- derivingThingErrMechanism mechanism msg
1861 lift $ failWithTc err
1862
1863 cls_tyvars = classTyVars cls
1864
1865 ats_look_sensible
1866 = -- Check (a) from Note [GND and associated type families]
1867 no_adfs
1868 -- Check (b) from Note [GND and associated type families]
1869 && isNothing at_without_last_cls_tv
1870 -- Check (d) from Note [GND and associated type families]
1871 && isNothing at_last_cls_tv_in_kinds
1872
1873 (adf_tcs, atf_tcs) = partition isDataFamilyTyCon at_tcs
1874 no_adfs = null adf_tcs
1875 -- We cannot newtype-derive data family instances
1876
1877 at_without_last_cls_tv
1878 = find (\tc -> last_cls_tv `notElem` tyConTyVars tc) atf_tcs
1879 at_last_cls_tv_in_kinds
1880 = find (\tc -> any (at_last_cls_tv_in_kind . tyVarKind)
1881 (tyConTyVars tc)
1882 || at_last_cls_tv_in_kind (tyConResKind tc)) atf_tcs
1883 at_last_cls_tv_in_kind kind
1884 = last_cls_tv `elemVarSet` exactTyCoVarsOfType kind
1885 at_tcs = classATs cls
1886 last_cls_tv = ASSERT( notNull cls_tyvars )
1887 last cls_tyvars
1888
1889 cant_derive_err
1890 = vcat [ ppUnless no_adfs adfs_msg
1891 , maybe empty at_without_last_cls_tv_msg
1892 at_without_last_cls_tv
1893 , maybe empty at_last_cls_tv_in_kinds_msg
1894 at_last_cls_tv_in_kinds
1895 ]
1896 adfs_msg = text "the class has associated data types"
1897 at_without_last_cls_tv_msg at_tc = hang
1898 (text "the associated type" <+> quotes (ppr at_tc)
1899 <+> text "is not parameterized over the last type variable")
1900 2 (text "of the class" <+> quotes (ppr cls))
1901 at_last_cls_tv_in_kinds_msg at_tc = hang
1902 (text "the associated type" <+> quotes (ppr at_tc)
1903 <+> text "contains the last type variable")
1904 2 (text "of the class" <+> quotes (ppr cls)
1905 <+> text "in a kind, which is not (yet) allowed")
1906 unless ats_look_sensible $ bale_out cant_derive_err
1907
1908 doDerivInstErrorChecks2 :: Class -> ClsInst -> ThetaType -> Maybe SrcSpan
1909 -> DerivSpecMechanism -> TcM ()
1910 doDerivInstErrorChecks2 clas clas_inst theta wildcard mechanism
1911 = do { traceTc "doDerivInstErrorChecks2" (ppr clas_inst)
1912 ; dflags <- getDynFlags
1913 ; xpartial_sigs <- xoptM LangExt.PartialTypeSignatures
1914 ; wpartial_sigs <- woptM Opt_WarnPartialTypeSignatures
1915
1916 -- Error if PartialTypeSignatures isn't enabled when a user tries
1917 -- to write @deriving instance _ => Eq (Foo a)@. Or, if that
1918 -- extension is enabled, give a warning if -Wpartial-type-signatures
1919 -- is enabled.
1920 ; case wildcard of
1921 Nothing -> pure ()
1922 Just span -> setSrcSpan span $ do
1923 checkTc xpartial_sigs (hang partial_sig_msg 2 pts_suggestion)
1924 warnTc (Reason Opt_WarnPartialTypeSignatures)
1925 wpartial_sigs partial_sig_msg
1926
1927 -- Check for Generic instances that are derived with an exotic
1928 -- deriving strategy like DAC
1929 -- See Note [Deriving strategies]
1930 ; when (exotic_mechanism && className clas `elem` genericClassNames) $
1931 do { failIfTc (safeLanguageOn dflags) gen_inst_err
1932 ; when (safeInferOn dflags) (recordUnsafeInfer emptyBag) } }
1933 where
1934 exotic_mechanism = not $ isDerivSpecStock mechanism
1935
1936 partial_sig_msg = text "Found type wildcard" <+> quotes (char '_')
1937 <+> text "standing for" <+> quotes (pprTheta theta)
1938
1939 pts_suggestion
1940 = text "To use the inferred type, enable PartialTypeSignatures"
1941
1942 gen_inst_err = text "Generic instances can only be derived in"
1943 <+> text "Safe Haskell using the stock strategy."
1944
1945 derivingThingFailWith :: Bool -- If True, add a snippet about how not even
1946 -- GeneralizedNewtypeDeriving would make this
1947 -- declaration work. This only kicks in when
1948 -- an explicit deriving strategy is not given.
1949 -> SDoc -- The error message
1950 -> DerivM a
1951 derivingThingFailWith newtype_deriving msg = do
1952 err <- derivingThingErrM newtype_deriving msg
1953 lift $ failWithTc err
1954
1955 genDerivStuff :: DerivSpecMechanism -> SrcSpan -> Class
1956 -> TyCon -> [Type] -> [TyVar]
1957 -> TcM (LHsBinds GhcPs, BagDerivStuff, [Name])
1958 genDerivStuff mechanism loc clas tycon inst_tys tyvars
1959 = case mechanism of
1960 -- See Note [Bindings for Generalised Newtype Deriving]
1961 DerivSpecNewtype rhs_ty -> gen_newtype_or_via rhs_ty
1962
1963 -- Try a stock deriver
1964 DerivSpecStock gen_fn -> gen_fn loc tycon inst_tys
1965
1966 -- Try DeriveAnyClass
1967 DerivSpecAnyClass -> do
1968 let mini_env = mkVarEnv (classTyVars clas `zip` inst_tys)
1969 mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
1970 dflags <- getDynFlags
1971 tyfam_insts <-
1972 -- canDeriveAnyClass should ensure that this code can't be reached
1973 -- unless -XDeriveAnyClass is enabled.
1974 ASSERT2( isValid (canDeriveAnyClass dflags)
1975 , ppr "genDerivStuff: bad derived class" <+> ppr clas )
1976 mapM (tcATDefault loc mini_subst emptyNameSet)
1977 (classATItems clas)
1978 return ( emptyBag -- No method bindings are needed...
1979 , listToBag (map DerivFamInst (concat tyfam_insts))
1980 -- ...but we may need to generate binding for associated type
1981 -- family default instances.
1982 -- See Note [DeriveAnyClass and default family instances]
1983 , [] )
1984
1985 -- Try DerivingVia
1986 DerivSpecVia via_ty -> gen_newtype_or_via via_ty
1987 where
1988 gen_newtype_or_via ty = do
1989 (binds, faminsts) <- gen_Newtype_binds loc clas tyvars inst_tys ty
1990 return (binds, faminsts, [])
1991
1992 {-
1993 Note [Bindings for Generalised Newtype Deriving]
1994 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1995 Consider
1996 class Eq a => C a where
1997 f :: a -> a
1998 newtype N a = MkN [a] deriving( C )
1999 instance Eq (N a) where ...
2000
2001 The 'deriving C' clause generates, in effect
2002 instance (C [a], Eq a) => C (N a) where
2003 f = coerce (f :: [a] -> [a])
2004
2005 This generates a cast for each method, but allows the superclasse to
2006 be worked out in the usual way. In this case the superclass (Eq (N
2007 a)) will be solved by the explicit Eq (N a) instance. We do *not*
2008 create the superclasses by casting the superclass dictionaries for the
2009 representation type.
2010
2011 See the paper "Safe zero-cost coercions for Haskell".
2012
2013 Note [DeriveAnyClass and default family instances]
2014 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2015
2016 When a class has a associated type family with a default instance, e.g.:
2017
2018 class C a where
2019 type T a
2020 type T a = Char
2021
2022 then there are a couple of scenarios in which a user would expect T a to
2023 default to Char. One is when an instance declaration for C is given without
2024 an implementation for T:
2025
2026 instance C Int
2027
2028 Another scenario in which this can occur is when the -XDeriveAnyClass extension
2029 is used:
2030
2031 data Example = Example deriving (C, Generic)
2032
2033 In the latter case, we must take care to check if C has any associated type
2034 families with default instances, because -XDeriveAnyClass will never provide
2035 an implementation for them. We "fill in" the default instances using the
2036 tcATDefault function from TcClassDcl (which is also used in TcInstDcls to
2037 handle the empty instance declaration case).
2038
2039 Note [Deriving strategies]
2040 ~~~~~~~~~~~~~~~~~~~~~~~~~~
2041 GHC has a notion of deriving strategies, which allow the user to explicitly
2042 request which approach to use when deriving an instance (enabled with the
2043 -XDerivingStrategies language extension). For more information, refer to the
2044 original issue (#10598) or the associated wiki page:
2045 https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/deriving-strategies
2046
2047 A deriving strategy can be specified in a deriving clause:
2048
2049 newtype Foo = MkFoo Bar
2050 deriving newtype C
2051
2052 Or in a standalone deriving declaration:
2053
2054 deriving anyclass instance C Foo
2055
2056 -XDerivingStrategies also allows the use of multiple deriving clauses per data
2057 declaration so that a user can derive some instance with one deriving strategy
2058 and other instances with another deriving strategy. For example:
2059
2060 newtype Baz = Baz Quux
2061 deriving (Eq, Ord)
2062 deriving stock (Read, Show)
2063 deriving newtype (Num, Floating)
2064 deriving anyclass C
2065
2066 Currently, the deriving strategies are:
2067
2068 * stock: Have GHC implement a "standard" instance for a data type, if possible
2069 (e.g., Eq, Ord, Generic, Data, Functor, etc.)
2070
2071 * anyclass: Use -XDeriveAnyClass
2072
2073 * newtype: Use -XGeneralizedNewtypeDeriving
2074
2075 * via: Use -XDerivingVia
2076
2077 The latter two strategies (newtype and via) are referred to as the
2078 "coerce-based" strategies, since they generate code that relies on the `coerce`
2079 function. See, for instance, TcDerivInfer.inferConstraintsCoerceBased.
2080
2081 The former two strategies (stock and anyclass), in contrast, are
2082 referred to as the "originative" strategies, since they create "original"
2083 instances instead of "reusing" old instances (by way of `coerce`).
2084 See, for instance, TcDerivUtils.checkOriginativeSideConditions.
2085
2086 If an explicit deriving strategy is not given, GHC has an algorithm it uses to
2087 determine which strategy it will actually use. The algorithm is quite long,
2088 so it lives in the Haskell wiki at
2089 https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/deriving-strategies
2090 ("The deriving strategy resolution algorithm" section).
2091
2092 Internally, GHC uses the DerivStrategy datatype to denote a user-requested
2093 deriving strategy, and it uses the DerivSpecMechanism datatype to denote what
2094 GHC will use to derive the instance after taking the above steps. In other
2095 words, GHC will always settle on a DerivSpecMechnism, even if the user did not
2096 ask for a particular DerivStrategy (using the algorithm linked to above).
2097
2098 Note [Deriving instances for classes themselves]
2099 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2100 Much of the code in TcDeriv assumes that deriving only works on data types.
2101 But this assumption doesn't hold true for DeriveAnyClass, since it's perfectly
2102 reasonable to do something like this:
2103
2104 {-# LANGUAGE DeriveAnyClass #-}
2105 class C1 (a :: Constraint) where
2106 class C2 where
2107 deriving instance C1 C2
2108 -- This is equivalent to `instance C1 C2`
2109
2110 If DeriveAnyClass isn't enabled in the code above (i.e., it defaults to stock
2111 deriving), we throw a special error message indicating that DeriveAnyClass is
2112 the only way to go. We don't bother throwing this error if an explicit 'stock'
2113 or 'newtype' keyword is used, since both options have their own perfectly
2114 sensible error messages in the case of the above code (as C1 isn't a stock
2115 derivable class, and C2 isn't a newtype).
2116
2117 ************************************************************************
2118 * *
2119 \subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
2120 * *
2121 ************************************************************************
2122 -}
2123
2124 nonUnaryErr :: LHsSigType GhcRn -> SDoc
2125 nonUnaryErr ct = quotes (ppr ct)
2126 <+> text "is not a unary constraint, as expected by a deriving clause"
2127
2128 nonStdErr :: Class -> SDoc
2129 nonStdErr cls =
2130 quotes (ppr cls)
2131 <+> text "is not a stock derivable class (Eq, Show, etc.)"
2132
2133 gndNonNewtypeErr :: SDoc
2134 gndNonNewtypeErr =
2135 text "GeneralizedNewtypeDeriving cannot be used on non-newtypes"
2136
2137 derivingNullaryErr :: MsgDoc
2138 derivingNullaryErr = text "Cannot derive instances for nullary classes"
2139
2140 derivingKindErr :: TyCon -> Class -> [Type] -> Kind -> Bool -> MsgDoc
2141 derivingKindErr tc cls cls_tys cls_kind enough_args
2142 = sep [ hang (text "Cannot derive well-kinded instance of form"
2143 <+> quotes (pprClassPred cls cls_tys
2144 <+> parens (ppr tc <+> text "...")))
2145 2 gen1_suggestion
2146 , nest 2 (text "Class" <+> quotes (ppr cls)
2147 <+> text "expects an argument of kind"
2148 <+> quotes (pprKind cls_kind))
2149 ]
2150 where
2151 gen1_suggestion | cls `hasKey` gen1ClassKey && enough_args
2152 = text "(Perhaps you intended to use PolyKinds)"
2153 | otherwise = Outputable.empty
2154
2155 derivingViaKindErr :: Class -> Kind -> Type -> Kind -> MsgDoc
2156 derivingViaKindErr cls cls_kind via_ty via_kind
2157 = hang (text "Cannot derive instance via" <+> quotes (pprType via_ty))
2158 2 (text "Class" <+> quotes (ppr cls)
2159 <+> text "expects an argument of kind"
2160 <+> quotes (pprKind cls_kind) <> char ','
2161 $+$ text "but" <+> quotes (pprType via_ty)
2162 <+> text "has kind" <+> quotes (pprKind via_kind))
2163
2164 derivingEtaErr :: Class -> [Type] -> Type -> MsgDoc
2165 derivingEtaErr cls cls_tys inst_ty
2166 = sep [text "Cannot eta-reduce to an instance of form",
2167 nest 2 (text "instance (...) =>"
2168 <+> pprClassPred cls (cls_tys ++ [inst_ty]))]
2169
2170 derivingThingErr :: Bool -> Class -> [Type] -> Type
2171 -> Maybe (DerivStrategy GhcTc) -> MsgDoc -> MsgDoc
2172 derivingThingErr newtype_deriving cls cls_tys inst_ty mb_strat why
2173 = derivingThingErr' newtype_deriving cls cls_tys inst_ty mb_strat
2174 (maybe empty derivStrategyName mb_strat) why
2175
2176 derivingThingErrM :: Bool -> MsgDoc -> DerivM MsgDoc
2177 derivingThingErrM newtype_deriving why
2178 = do DerivEnv { denv_tc = tc
2179 , denv_tc_args = tc_args
2180 , denv_cls = cls
2181 , denv_cls_tys = cls_tys
2182 , denv_strat = mb_strat } <- ask
2183 pure $ derivingThingErr newtype_deriving cls cls_tys
2184 (mkTyConApp tc tc_args) mb_strat why
2185
2186 derivingThingErrMechanism :: DerivSpecMechanism -> MsgDoc -> DerivM MsgDoc
2187 derivingThingErrMechanism mechanism why
2188 = do DerivEnv { denv_tc = tc
2189 , denv_tc_args = tc_args
2190 , denv_cls = cls
2191 , denv_cls_tys = cls_tys
2192 , denv_strat = mb_strat } <- ask
2193 pure $ derivingThingErr' (isDerivSpecNewtype mechanism) cls cls_tys
2194 (mkTyConApp tc tc_args) mb_strat
2195 (derivStrategyName $ derivSpecMechanismToStrategy mechanism)
2196 why
2197
2198 derivingThingErr' :: Bool -> Class -> [Type] -> Type
2199 -> Maybe (DerivStrategy GhcTc) -> MsgDoc -> MsgDoc -> MsgDoc
2200 derivingThingErr' newtype_deriving cls cls_tys inst_ty mb_strat strat_msg why
2201 = sep [(hang (text "Can't make a derived instance of")
2202 2 (quotes (ppr pred) <+> via_mechanism)
2203 $$ nest 2 extra) <> colon,
2204 nest 2 why]
2205 where
2206 strat_used = isJust mb_strat
2207 extra | not strat_used, newtype_deriving
2208 = text "(even with cunning GeneralizedNewtypeDeriving)"
2209 | otherwise = empty
2210 pred = mkClassPred cls (cls_tys ++ [inst_ty])
2211 via_mechanism | strat_used
2212 = text "with the" <+> strat_msg <+> text "strategy"
2213 | otherwise
2214 = empty
2215
2216 derivingHiddenErr :: TyCon -> SDoc
2217 derivingHiddenErr tc
2218 = hang (text "The data constructors of" <+> quotes (ppr tc) <+> ptext (sLit "are not all in scope"))
2219 2 (text "so you cannot derive an instance for it")
2220
2221 standaloneCtxt :: LHsSigWcType GhcRn -> SDoc
2222 standaloneCtxt ty = hang (text "In the stand-alone deriving instance for")
2223 2 (quotes (ppr ty))