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