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