Commit 9e862765 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Implement deriving strategies

Allows users to explicitly request which approach to `deriving` to use
via keywords, e.g.,

```
newtype Foo = Foo Bar
  deriving Eq
  deriving stock    Ord
  deriving newtype Show
```

Fixes #10598. Updates haddock submodule.

Test Plan: ./validate

Reviewers: hvr, kosmikus, goldfire, alanz, bgamari, simonpj, austin,
erikd, simonmar

Reviewed By: alanz, bgamari, simonpj

Subscribers: thomie, mpickering, oerjan

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

GHC Trac Issues: #10598
parent b3d55e20
......@@ -41,6 +41,8 @@ module BasicTypes(
TopLevelFlag(..), isTopLevel, isNotTopLevel,
DerivStrategy(..),
OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,
......@@ -476,6 +478,30 @@ instance Outputable Origin where
ppr FromSource = text "FromSource"
ppr Generated = text "Generated"
{-
************************************************************************
* *
Deriving strategies
* *
************************************************************************
-}
-- | Which technique the user explicitly requested when deriving an instance.
data DerivStrategy
-- See Note [Deriving strategies] in TcDeriv
= DerivStock -- ^ GHC's \"standard\" strategy, which is to implement a
-- custom instance for the data type. This only works for
-- certain types that GHC knows about (e.g., 'Eq', 'Show',
-- 'Functor' when @-XDeriveFunctor@ is enabled, etc.)
| DerivAnyclass -- ^ @-XDeriveAnyClass@
| DerivNewtype -- ^ @-XGeneralizedNewtypeDeriving@
deriving (Eq, Data)
instance Outputable DerivStrategy where
ppr DerivStock = text "stock"
ppr DerivAnyclass = text "anyclass"
ppr DerivNewtype = text "newtype"
{-
************************************************************************
* *
......
......@@ -455,11 +455,13 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
(tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
repStandaloneDerivD :: LDerivDecl Name -> DsM (SrcSpan, Core TH.DecQ)
repStandaloneDerivD (L loc (DerivDecl { deriv_type = ty }))
repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
, deriv_type = ty }))
= do { dec <- addSimpleTyVarBinds tvs $
do { cxt' <- repLContext cxt
; strat' <- repDerivStrategy strat
; inst_ty' <- repLTy inst_ty
; repDeriv cxt' inst_ty' }
; repDeriv strat' cxt' inst_ty' }
; return (loc, dec) }
where
(tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
......@@ -668,22 +670,22 @@ repBangTy ty = do
_ -> (NoSrcUnpack, NoSrcStrict, ty)
-------------------------------------------------------
-- Deriving clause
-- Deriving clauses
-------------------------------------------------------
repDerivs :: HsDeriving Name -> DsM (Core TH.CxtQ)
repDerivs deriv = do
let clauses = case deriv of
Nothing -> []
Just (L _ ctxt) -> ctxt
tys <- repList typeQTyConName
(rep_deriv . hsSigType)
clauses
:: DsM (Core [TH.PredQ])
repCtxt tys
repDerivs :: HsDeriving Name -> DsM (Core [TH.DerivClauseQ])
repDerivs (L _ clauses) = repList derivClauseQTyConName repDerivClause clauses
repDerivClause :: LHsDerivingClause Name
-> DsM (Core TH.DerivClauseQ)
repDerivClause (L _ (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L _ dct }))
= do MkC dcs' <- repDerivStrategy dcs
MkC dct' <- repList typeQTyConName (rep_deriv_ty . hsSigType) dct
rep2 derivClauseName [dcs',dct']
where
rep_deriv :: LHsType Name -> DsM (Core TH.TypeQ)
rep_deriv (L _ ty) = repTy ty
rep_deriv_ty :: LHsType Name -> DsM (Core TH.TypeQ)
rep_deriv_ty (L _ ty) = repTy ty
-------------------------------------------------------
-- Signatures in a class decl, or a group of bindings
......@@ -1982,7 +1984,7 @@ repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
-> Maybe (Core [TH.TypeQ]) -> Core (Maybe TH.Kind)
-> Core [TH.ConQ] -> Core TH.CxtQ -> DsM (Core TH.DecQ)
-> Core [TH.ConQ] -> Core [TH.DerivClauseQ] -> DsM (Core TH.DecQ)
repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC ksig) (MkC cons) (MkC derivs)
= rep2 dataDName [cxt, nm, tvs, ksig, cons, derivs]
repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC ksig) (MkC cons)
......@@ -1991,7 +1993,7 @@ repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC ksig) (MkC cons)
repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
-> Maybe (Core [TH.TypeQ]) -> Core (Maybe TH.Kind)
-> Core TH.ConQ -> Core TH.CxtQ -> DsM (Core TH.DecQ)
-> Core TH.ConQ -> Core [TH.DerivClauseQ] -> DsM (Core TH.DecQ)
repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC ksig) (MkC con)
(MkC derivs)
= rep2 newtypeDName [cxt, nm, tvs, ksig, con, derivs]
......@@ -2009,6 +2011,20 @@ repInst :: Core (Maybe TH.Overlap) ->
repInst (MkC o) (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceWithOverlapDName
[o, cxt, ty, ds]
repDerivStrategy :: Maybe (Located DerivStrategy)
-> DsM (Core (Maybe TH.DerivStrategy))
repDerivStrategy mds =
case mds of
Nothing -> nothing
Just (L _ ds) ->
case ds of
DerivStock -> just =<< dataCon stockDataConName
DerivAnyclass -> just =<< dataCon anyclassDataConName
DerivNewtype -> just =<< dataCon newtypeDataConName
where
nothing = coreNothing derivStrategyTyConName
just = coreJust derivStrategyTyConName
repOverlap :: Maybe OverlapMode -> DsM (Core (Maybe TH.Overlap))
repOverlap mb =
case mb of
......@@ -2031,8 +2047,11 @@ repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)
= rep2 classDName [cxt, cls, tvs, fds, ds]
repDeriv :: Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.DecQ)
repDeriv (MkC cxt) (MkC ty) = rep2 standaloneDerivDName [cxt, ty]
repDeriv :: Core (Maybe TH.DerivStrategy)
-> Core TH.CxtQ -> Core TH.TypeQ
-> DsM (Core TH.DecQ)
repDeriv (MkC ds) (MkC cxt) (MkC ty)
= rep2 standaloneDerivWithStrategyDName [ds, cxt, ty]
repPragInl :: Core TH.Name -> Core TH.Inline -> Core TH.RuleMatch
-> Core TH.Phases -> DsM (Core TH.DecQ)
......
......@@ -339,12 +339,14 @@ cvtDec (TH.RoleAnnotD tc roles)
; let roles' = map (noLoc . cvtRole) roles
; returnJustL $ Hs.RoleAnnotD (RoleAnnotDecl tc' roles') }
cvtDec (TH.StandaloneDerivD cxt ty)
cvtDec (TH.StandaloneDerivD ds cxt ty)
= do { cxt' <- cvtContext cxt
; L loc ty' <- cvtType ty
; let inst_ty' = L loc $ HsQualTy { hst_ctxt = cxt', hst_body = L loc ty' }
; returnJustL $ DerivD $
DerivDecl { deriv_type = mkLHsSigType inst_ty', deriv_overlap_mode = Nothing } }
DerivDecl { deriv_strategy = fmap (L loc . cvtDerivStrategy) ds
, deriv_type = mkLHsSigType inst_ty'
, deriv_overlap_mode = Nothing } }
cvtDec (TH.DefaultSigD nm typ)
= do { nm' <- vNameL nm
......@@ -560,12 +562,9 @@ cvt_id_arg (i, str, ty)
, cd_fld_type = ty'
, cd_fld_doc = Nothing}) }
cvtDerivs :: TH.Cxt -> CvtM (HsDeriving RdrName)
cvtDerivs [] = return Nothing
cvtDerivs cs = fmap (Just . mkSigTypes) (cvtContext cs)
where
mkSigTypes :: Located (HsContext RdrName) -> Located [LHsSigType RdrName]
mkSigTypes = fmap (map mkLHsSigType)
cvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving RdrName)
cvtDerivs cs = do { cs' <- mapM cvtDerivClause cs
; returnL cs' }
cvt_fundep :: FunDep -> CvtM (Located (Class.FunDep (Located RdrName)))
cvt_fundep (FunDep xs ys) = do { xs' <- mapM tNameL xs
......@@ -1127,6 +1126,18 @@ cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' }
cvtPred :: TH.Pred -> CvtM (LHsType RdrName)
cvtPred = cvtType
cvtDerivClause :: TH.DerivClause
-> CvtM (LHsDerivingClause RdrName)
cvtDerivClause (TH.DerivClause ds ctxt)
= do { ctxt'@(L loc _) <- fmap (map mkLHsSigType) <$> cvtContext ctxt
; let ds' = fmap (L loc . cvtDerivStrategy) ds
; returnL $ HsDerivingClause ds' ctxt' }
cvtDerivStrategy :: TH.DerivStrategy -> Hs.DerivStrategy
cvtDerivStrategy TH.Stock = Hs.DerivStock
cvtDerivStrategy TH.Anyclass = Hs.DerivAnyclass
cvtDerivStrategy TH.Newtype = Hs.DerivNewtype
cvtType :: TH.Type -> CvtM (LHsType RdrName)
cvtType = cvtTypeKind "type"
......
......@@ -19,6 +19,7 @@
module HsDecls (
-- * Toplevel declarations
HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving,
HsDerivingClause(..), LHsDerivingClause,
-- ** Class or type declarations
TyClDecl(..), LTyClDecl,
......@@ -1027,23 +1028,47 @@ data HsDataDefn name -- The payload of a data type defn
deriving instance (DataId id) => Data (HsDataDefn id)
-- | Haskell Deriving clause
type HsDeriving name = Maybe (Located [LHsSigType name])
-- ^ The optional 'deriving' clause of a data declaration
type HsDeriving name = Located [LHsDerivingClause name]
-- ^ The optional @deriving@ clauses of a data declaration. "Clauses" is
-- plural because one can specify multiple deriving clauses using the
-- @-XDerivingStrategies@ language extension.
--
-- @Nothing@ => not specified,
-- @Just []@ => derive exactly what is asked
--
-- It's a 'LHsSigType' because, with Generalised Newtype
-- Deriving, we can mention type variables that aren't
-- bound by the date type. e.g.
-- data T b = ... deriving( C [a] )
-- should producd a derived instance for (C [a] (T b))
--
-- The payload of the Maybe is Located so that we have a
-- place to hang the API annotations:
-- - 'ApiAnnotation.AnnKeywordId' :
-- 'ApiAnnotation.AnnDeriving',
-- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
-- The list of 'LHsDerivingClause's corresponds to exactly what the user
-- requested to derive, in order. If no deriving clauses were specified,
-- the list is empty.
type LHsDerivingClause name = Located (HsDerivingClause name)
-- | A single @deriving@ clause of a data declaration.
--
-- - 'ApiAnnotation.AnnKeywordId' :
-- 'ApiAnnotation.AnnDeriving', 'ApiAnnotation.AnnStock',
-- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
-- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
data HsDerivingClause name
-- See Note [Deriving strategies] in TcDeriv
= HsDerivingClause
{ deriv_clause_strategy :: Maybe (Located DerivStrategy)
-- ^ The user-specified strategy (if any) to use when deriving
-- 'deriv_clause_tys'.
, deriv_clause_tys :: Located [LHsSigType name]
-- ^ The types to derive.
--
-- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@,
-- we can mention type variables that aren't bound by the datatype, e.g.
--
-- > data T b = ... deriving (C [a])
--
-- should produce a derived instance for @C [a] (T b)@.
}
deriving instance (DataId id) => Data (HsDerivingClause id)
instance (OutputableBndrId name) => Outputable (HsDerivingClause name) where
ppr (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L _ dct })
= hsep [ text "deriving"
, ppDerivStrategy dcs
, parens (interpp'SP dct) ]
data NewOrData
= NewType -- ^ @newtype Blah ...@
......@@ -1159,15 +1184,12 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
| otherwise
= hang (ppr new_or_data <+> pp_hdr context <+> pp_sig)
2 (pp_condecls condecls $$ pp_derivings)
2 (pp_condecls condecls $$ pp_derivings derivings)
where
pp_sig = case mb_sig of
Nothing -> empty
Just kind -> dcolon <+> ppr kind
pp_derivings = case derivings of
Nothing -> empty
Just (L _ ds) -> hsep [ text "deriving"
, parens (interpp'SP ds)]
pp_derivings (L _ ds) = vcat (map ppr ds)
instance (OutputableBndrId name) => Outputable (HsDataDefn name) where
ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
......@@ -1455,6 +1477,12 @@ instance (OutputableBndrId name) => Outputable (ClsInstDecl name) where
top_matter = text "instance" <+> ppOverlapPragma mbOverlap
<+> ppr inst_ty
ppDerivStrategy :: Maybe (Located DerivStrategy) -> SDoc
ppDerivStrategy mb =
case mb of
Nothing -> empty
Just (L _ ds) -> ppr ds
ppOverlapPragma :: Maybe (Located OverlapMode) -> SDoc
ppOverlapPragma mb =
case mb of
......@@ -1496,19 +1524,26 @@ type LDerivDecl name = Located (DerivDecl name)
-- | Deriving Declaration
data DerivDecl name = DerivDecl
{ deriv_type :: LHsSigType name
, deriv_strategy :: Maybe (Located DerivStrategy)
, deriv_overlap_mode :: Maybe (Located OverlapMode)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
-- 'ApiAnnotation.AnnClose',
-- 'ApiAnnotation.AnnDeriving',
-- 'ApiAnnotation.AnnInstance'
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',
-- 'ApiAnnotation.AnnInstance', 'ApiAnnotation.AnnStock',
-- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
-- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
-- For details on above see note [Api annotations] in ApiAnnotation
}
deriving instance (DataId name) => Data (DerivDecl name)
instance (OutputableBndrId name) => Outputable (DerivDecl name) where
ppr (DerivDecl ty o)
= hsep [text "deriving instance", ppOverlapPragma o, ppr ty]
ppr (DerivDecl { deriv_type = ty
, deriv_strategy = ds
, deriv_overlap_mode = o })
= hsep [ text "deriving"
, ppDerivStrategy ds
, text "instance"
, ppOverlapPragma o
, ppr ty ]
{-
************************************************************************
......
......@@ -3561,6 +3561,7 @@ xFlagsDeps = [
flagSpec "DeriveGeneric" LangExt.DeriveGeneric,
flagSpec "DeriveLift" LangExt.DeriveLift,
flagSpec "DeriveTraversable" LangExt.DeriveTraversable,
flagSpec "DerivingStrategies" LangExt.DerivingStrategies,
flagSpec "DisambiguateRecordFields" LangExt.DisambiguateRecordFields,
flagSpec "DoAndIfThenElse" LangExt.DoAndIfThenElse,
depFlagSpec' "DoRec" LangExt.RecursiveDo
......
......@@ -16,6 +16,7 @@ import SrcLoc
import Util
import Data.Char
import Data.Foldable (foldl')
-- | Source Statistics
ppSourceStats :: Bool -> Located (HsModule RdrName) -> SDoc
......@@ -128,9 +129,10 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
spec_info (Just (True, _)) = (0,0,0,0,0,0,1)
data_info (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = cs
, dd_derivs = derivs}})
= (length cs, case derivs of Nothing -> 0
Just (L _ ds) -> length ds)
, dd_derivs = L _ derivs}})
= ( length cs
, foldl' (\s dc -> length (deriv_clause_tys $ unLoc dc) + s)
0 derivs )
data_info _ = (0,0)
class_info decl@(ClassDecl {})
......
......@@ -186,7 +186,8 @@ getAndRemoveAnnotationComments (anns,canns) span =
-- corresponding token, unless otherwise noted
-- See note [Api annotations] above for details of the usage
data AnnKeywordId
= AnnAs
= AnnAnyclass
| AnnAs
| AnnAt
| AnnBang -- ^ '!'
| AnnBackquote -- ^ '`'
......@@ -256,6 +257,7 @@ data AnnKeywordId
| AnnSemi -- ^ ';'
| AnnSimpleQuote -- ^ '''
| AnnStatic -- ^ 'static'
| AnnStock
| AnnThen
| AnnThIdSplice -- ^ '$'
| AnnThIdTySplice -- ^ '$$'
......
......@@ -612,6 +612,8 @@ data Token
| ITusing
| ITpattern
| ITstatic
| ITstock
| ITanyclass
-- Pragmas, see note [Pragma source text] in BasicTypes
| ITinline_prag SourceText InlineSpec RuleMatchInfo
......@@ -803,6 +805,8 @@ reservedWordsFM = listToUFM $
( "role", ITrole, 0 ),
( "pattern", ITpattern, xbit PatternSynonymsBit),
( "static", ITstatic, 0 ),
( "stock", ITstock, 0 ),
( "anyclass", ITanyclass, 0 ),
( "group", ITgroup, xbit TransformComprehensionsBit),
( "by", ITby, xbit TransformComprehensionsBit),
( "using", ITusing, xbit TransformComprehensionsBit),
......
This diff is collapsed.
This diff is collapsed.
......@@ -42,11 +42,11 @@ import NameEnv
import Avail
import Outputable
import Bag
import BasicTypes ( RuleName, pprRuleName )
import BasicTypes ( DerivStrategy, RuleName, pprRuleName )
import FastString
import SrcLoc
import DynFlags
import Util ( debugIsOn, partitionWith )
import Util ( debugIsOn, lengthExceeds, partitionWith )
import HscTypes ( HscEnv, hsc_dflags )
import ListSetOps ( findDupsEq, removeDups, equivClasses )
import Digraph ( SCC, flattenSCC, flattenSCCs
......@@ -57,6 +57,7 @@ import qualified GHC.LanguageExtensions as LangExt
import Control.Monad
import Control.Arrow ( first )
import Data.List ( sortBy, mapAccumL )
import Data.Maybe ( isJust )
import qualified Data.Set as Set ( difference, fromList, toList, null )
{-
......@@ -945,11 +946,14 @@ Here 'k' is in scope in the kind signature, just like 'x'.
-}
rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
rnSrcDerivDecl (DerivDecl ty overlap)
rnSrcDerivDecl (DerivDecl ty deriv_strat overlap)
= do { standalone_deriv_ok <- xoptM LangExt.StandaloneDeriving
; deriv_strats_ok <- xoptM LangExt.DerivingStrategies
; unless standalone_deriv_ok (addErr standaloneDerivErr)
; failIfTc (isJust deriv_strat && not deriv_strats_ok) $
illegalDerivStrategyErr $ fmap unLoc deriv_strat
; (ty', fvs) <- rnLHsInstType (text "In a deriving declaration") ty
; return (DerivDecl ty' overlap, fvs) }
; return (DerivDecl ty' deriv_strat overlap, fvs) }
standaloneDerivErr :: SDoc
standaloneDerivErr
......@@ -1767,17 +1771,40 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
L _ (ConDeclGADT {}) : _ -> False
_ -> True
rn_derivs Nothing
= return (Nothing, emptyFVs)
rn_derivs (Just (L loc ds))
= do { (ds', fvs) <- mapFvRn (rnHsSigType doc) ds
; return (Just (L loc ds'), fvs) }
rn_derivs (L loc ds)
= do { deriv_strats_ok <- xoptM LangExt.DerivingStrategies
; failIfTc (lengthExceeds ds 1 && not deriv_strats_ok)
multipleDerivClausesErr
; (ds', fvs) <- mapFvRn (rnLHsDerivingClause deriv_strats_ok doc) ds
; return (L loc ds', fvs) }
rnLHsDerivingClause :: Bool -> HsDocContext -> LHsDerivingClause RdrName
-> RnM (LHsDerivingClause Name, FreeVars)
rnLHsDerivingClause deriv_strats_ok doc
(L loc (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L loc' dct }))
= do { failIfTc (isJust dcs && not deriv_strats_ok) $
illegalDerivStrategyErr $ fmap unLoc dcs
; (dct', fvs) <- mapFvRn (rnHsSigType doc) dct
; return ( L loc (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L loc' dct' })
, fvs ) }
badGadtStupidTheta :: HsDocContext -> SDoc
badGadtStupidTheta _
= vcat [text "No context is allowed on a GADT-style data declaration",
text "(You can put a context on each constructor, though.)"]
illegalDerivStrategyErr :: Maybe DerivStrategy -> SDoc
illegalDerivStrategyErr ds
= vcat [ text "Illegal deriving strategy" <> colon <+> maybe empty ppr ds
, text "Use DerivingStrategies to enable this extension" ]
multipleDerivClausesErr :: SDoc
multipleDerivClausesErr
= vcat [ text "Illegal use of multiple, consecutive deriving clauses"
, text "Use DerivingStrategies to allow this" ]
rnFamDecl :: Maybe Name -- Just cls => this FamilyDecl is nested
-- inside an *class decl* for cls
-- used for associated types
......
......@@ -1553,11 +1553,11 @@ extractDataDefnKindVars :: HsDataDefn RdrName -> RnM [Located RdrName]
-- Eg data T a = T1 (S (a :: k) | forall (b::k). T2 (S b)
-- Here k should scope over the whole definition
extractDataDefnKindVars (HsDataDefn { dd_ctxt = ctxt, dd_kindSig = ksig
, dd_cons = cons, dd_derivs = derivs })
, dd_cons = cons, dd_derivs = L _ derivs })
= (nubL . freeKiTyVarsKindVars) <$>
(extract_lctxt TypeLevel ctxt =<<
extract_mb extract_lkind ksig =<<
extract_mb (extract_sig_tys . unLoc) derivs =<<
extract_sig_tys (concatMap (unLoc . deriv_clause_tys . unLoc) derivs) =<<
foldrM (extract_con . unLoc) emptyFKTV cons)
where
extract_con (ConDeclGADT { }) acc = return acc
......
This diff is collapsed.
......@@ -18,7 +18,7 @@ This is where we do all the grimy bindings' generation.
module TcGenDeriv (
BagDerivStuff, DerivStuff(..),
hasBuiltinDeriving,
hasStockDeriving,
FFoldType(..), functorLikeTraverse,
deepSubtypesContaining, foldDataConArgs,
mkCoerceClassMethEqn,
......@@ -102,20 +102,25 @@ data DerivStuff -- Please add this auxiliary stuff
* *
************************************************************************
Only certain blessed classes can be used in a deriving clause. These classes
are listed below in the definition of hasBuiltinDeriving (with the exception
Only certain blessed classes can be used in a deriving clause (without the
assistance of GeneralizedNewtypeDeriving or DeriveAnyClass). These classes
are listed below in the definition of hasStockDeriving (with the exception
of Generic and Generic1, which are handled separately in TcGenGenerics).
A class might be able to be used in a deriving clause if it -XDeriveAnyClass
is willing to support it. The canDeriveAnyClass function checks if this is
the case.
A class might be able to be used in a deriving clause if -XDeriveAnyClass
is willing to support it. The canDeriveAnyClass function in TcDeriv checks
if this is the case.
-}
hasBuiltinDeriving :: Class
-- NB: The classes listed below should be in sync with the ones listed in
-- the definition of sideConditions in TcDeriv (except for Generic(1), as
-- noted above). If you add a new class to hasStockDeriving, make sure to
-- update sideConditions as well!
hasStockDeriving :: Class
-> Maybe (SrcSpan
-> TyCon
-> TcM (LHsBinds RdrName, BagDerivStuff))
hasBuiltinDeriving clas
hasStockDeriving clas
= assocMaybe gen_list (getUnique clas)
where
gen_list :: [(Unique, SrcSpan -> TyCon -> TcM (LHsBinds RdrName, BagDerivStuff))]
......
......@@ -683,11 +683,11 @@ tcDataFamInstDecl mb_clsinfo
; checkValidTyCon rep_tc
; let m_deriv_info = case derivs of
Nothing -> Nothing
Just (L _ preds) ->
Just $ DerivInfo { di_rep_tc = rep_tc
, di_preds = preds
, di_ctxt = tcMkDataFamInstCtxt decl }
L _ [] -> Nothing
L _ preds ->
Just $ DerivInfo { di_rep_tc = rep_tc
, di_clauses = preds
, di_ctxt = tcMkDataFamInstCtxt decl }
; fam_inst <- newFamInst (DataFamilyInst rep_tc) axiom
; return (fam_inst, m_deriv_info) } }
......
......@@ -38,6 +38,10 @@ Compiler
syntax can be used, in addition to a new form for specifying the cost centre
name. See :ref:`scc-pragma` for examples.
- It is now possible to explicitly pick a strategy to use when deriving a
class instance using the :ghc-flag:`-XDerivingStrategies` language extension
(see :ref:`deriving-strategies`).
GHCi
~~~~
......
......@@ -3955,10 +3955,10 @@ usually have one "main" parameter for which deriving new instances is
most interesting.
Lastly, all of this applies only for classes other than ``Read``,
``Show``, ``Typeable``, and ``Data``, for which the built-in derivation
``Show``, ``Typeable``, and ``Data``, for which the stock derivation
applies (section 4.3.3. of the Haskell Report). (For the standard
classes ``Eq``, ``Ord``, ``Ix``, and ``Bounded`` it is immaterial
whether the standard method is used or the one described here.)
whether the stock method is used or the one described here.)
.. _derive-any-class:
......@@ -4064,6 +4064,64 @@ Note the following details
and then the normal rules for filling in associated types from the
default will apply, making ``Size Bar`` equal to ``Int``.
.. _deriving-strategies:
Deriving strategies
-------------------
In most scenarios, every ``deriving`` statement generates a typeclass instance
in an unambiguous fashion. There is a corner case, however, where
simultaneously enabling both the :ghc-flag:`-XGeneralizedNewtypeDeriving` and
:ghc-flag:`-XDeriveAnyClass` extensions can make deriving become ambiguous.
Consider the following example ::
{-# LANGUAGE DeriveAnyClass, GeneralizedNewtypeDeriving #-}
newtype Foo = MkFoo Bar deriving C
One could either pick the ``DeriveAnyClass`` approach to deriving ``C`` or the
``GeneralizedNewtypeDeriving`` approach to deriving ``C``, both of which would
be equally as valid. GHC defaults to favoring ``DeriveAnyClass`` in such a
dispute, but this is not a satisfying solution, since that leaves users unable
to use both language extensions in a single module.
To make this more robust, GHC has a notion of deriving strategies, which allow
the user to explicitly request which approach to use when deriving an instance.
To enable this feature, one must enable the :ghc-flag:`-XDerivingStrategies`
language extension. A deriving strategy can be specified in a deriving
clause ::
newtype Foo = MkFoo Bar
deriving newtype C
Or in a standalone deriving declaration ::
deriving anyclass instance C Foo
:ghc-flag:`-XDerivingStrategies` also allows the use of multiple deriving
clauses per data declaration so that a user can derive some instance with
one deriving strategy and other instances with another deriving strategy.
For example ::
newtype Baz = Baz Quux
deriving (Eq, Ord)
deriving stock (Read, Show)
deriving newtype (Num, Floating)
deriving anyclass C
Currently, the deriving strategies are:
- ``stock``: Have GHC implement a "standard" instance for a data type,
if possible (e.g., ``Eq``, ``Ord``, ``Generic``, ``Data``, ``Functor``, etc.)
- ``anyclass``: Use :ghc-flag:`-XDeriveAnyClass`
- ``newtype``: Use :ghc-flag:`-XGeneralizedNewtypeDeriving`
If an explicit deriving strategy is not given, GHC has an algorithm for
determining how it will actually derive an instance. For brevity, the algorithm
is omitted here. You can read the full algorithm at
:ghc-wiki:`Wiki page <DerivingStrategies>`.
.. _pattern-synonyms:
Pattern synonyms
......
......@@ -284,7 +284,12 @@ Furthermore, we restrict the following features:
the structure of the data type for which the instance is defined, and
allowing manually implemented ``Generic`` instances would break that
invariant. Derived instances (through the :ghc-flag:`-XDeriveGeneric`
extension) are still allowed. Refer to the
extension) are still allowed. Note that the only allowed
:ref:`deriving strategy <deriving-strategies>` for deriving ``Generic`` under
Safe Haskell is ``stock``, as another strategy (e.g., ``anyclass``) would
produce an instance that violates the invariant.
Refer to the
:ref:`generic programming <generic-programming>` section for more details.
.. _safe-overlapping-instances:
......
......@@ -80,6 +80,7 @@ data Extension
| DefaultSignatures -- Allow extra signatures for defmeths
| DeriveAnyClass -- Allow deriving any class
| DeriveLift -- Allow deriving Lift
| DerivingStrategies
| TypeSynonymInstances
| FlexibleContexts
......
......@@ -30,6 +30,8 @@ instance Binary TH.Pat
instance Binary TH.Exp
instance Binary TH.Dec
instance Binary TH.Overlap
instance Binary TH.DerivClause
instance Binary TH.DerivStrategy
instance Binary TH.Guard
instance Binary TH.Body
instance Binary TH.Match
......
......@@ -85,11 +85,11 @@ module Language.Haskell.TH(