Introduce DerivingVia

This implements the `DerivingVia` proposal put forth in
https://github.com/ghc-proposals/ghc-proposals/pull/120.

This introduces the `DerivingVia` deriving strategy. This is a
generalization of `GeneralizedNewtypeDeriving` that permits the user
to specify the type to `coerce` from.

The major change in this patch is the introduction of the
`ViaStrategy` constructor to `DerivStrategy`, which takes a type
as a field. As a result, `DerivStrategy` is no longer a simple
enumeration type, but rather something that must be renamed and
typechecked. The process by which this is done is explained more
thoroughly in section 3 of this paper
( https://www.kosmikus.org/DerivingVia/deriving-via-paper.pdf ),
although I have inlined the relevant parts into Notes where possible.

There are some knock-on changes as well. I took the opportunity to
do some refactoring of code in `TcDeriv`, especially the
`mkNewTypeEqn` function, since it was bundling all of the logic for
(1) deriving instances for newtypes and
(2) `GeneralizedNewtypeDeriving`
into one huge broth. `DerivingVia` reuses much of part (2), so that
was factored out as much as possible.

Bumps the Haddock submodule.

Test Plan: ./validate

Reviewers: simonpj, bgamari, goldfire, alanz

Subscribers: alanz, goldfire, rwbarton, thomie, mpickering, carter

GHC Trac Issues: #15178

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

6 files changed, 60 insertions, 13 deletions

diff --git a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
index e98c871ce4..518491783f 100644
--- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
+++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
@@ -82,6 +82,7 @@ data Extension
    | DeriveAnyClass           -- Allow deriving any class
    | DeriveLift               -- Allow deriving Lift
    | DerivingStrategies
+   | DerivingVia              -- Derive through equal representation
 
    | TypeSynonymInstances
    | FlexibleContexts
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index dbf01f11df..b7966cefac 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -21,7 +21,7 @@ module Language.Haskell.TH.Lib (
         StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,
         BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,
         FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,
-        FamilyResultSigQ,
+        FamilyResultSigQ, DerivStrategyQ,
 
     -- ** Constructors lifted to 'Q'
     -- *** Literals
@@ -79,7 +79,9 @@ module Language.Haskell.TH.Lib (
     -- *** Top Level Declarations
     -- **** Data
     valD, funD, tySynD, dataD, newtypeD,
-    derivClause, DerivClause(..), DerivStrategy(..),
+    derivClause, DerivClause(..),
+    stockStrategy, anyclassStrategy, newtypeStrategy,
+    viaStrategy, DerivStrategy(..),
     -- **** Class
     classD, instanceD, instanceWithOverlapD, Overlap(..),
     sigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,
@@ -140,6 +142,9 @@ import Language.Haskell.TH.Lib.Internal hiding
   , kindSig
   , tyVarSig
 
+  , derivClause
+  , standaloneDerivWithStrategyD
+
   , Role
   , InjectivityAnn
   )
@@ -262,3 +267,17 @@ kindSig = KindSig
 
 tyVarSig :: TyVarBndr -> FamilyResultSig
 tyVarSig = TyVarSig
+
+-------------------------------------------------------------------------------
+-- * Top Level Declarations
+
+derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
+derivClause mds p = do
+  p' <- cxt p
+  return $ DerivClause mds p'
+
+standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD mds ctxt ty = do
+  ctxt' <- ctxt
+  ty'   <- ty
+  return $ StandaloneDerivD mds ctxt' ty'
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index 4496ecda25..cac8ea8643 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -57,6 +57,7 @@ type TySynEqnQ           = Q TySynEqn
 type PatSynDirQ          = Q PatSynDir
 type PatSynArgsQ         = Q PatSynArgs
 type FamilyResultSigQ    = Q FamilyResultSig
+type DerivStrategyQ      = Q DerivStrategy
 
 -- must be defined here for DsMeta to find it
 type Role                = TH.Role
@@ -533,12 +534,13 @@ roleAnnotD name roles = return $ RoleAnnotD name roles
 standaloneDerivD :: CxtQ -> TypeQ -> DecQ
 standaloneDerivD = standaloneDerivWithStrategyD Nothing
 
-standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
-standaloneDerivWithStrategyD ds ctxtq tyq =
+standaloneDerivWithStrategyD :: Maybe DerivStrategyQ -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD mdsq ctxtq tyq =
   do
+    mds  <- sequenceA mdsq
     ctxt <- ctxtq
     ty   <- tyq
-    return $ StandaloneDerivD ds ctxt ty
+    return $ StandaloneDerivD mds ctxt ty
 
 defaultSigD :: Name -> TypeQ -> DecQ
 defaultSigD n tyq =
@@ -570,9 +572,22 @@ tySynEqn lhs rhs =
 cxt :: [PredQ] -> CxtQ
 cxt = sequence
 
-derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
-derivClause ds p = do p' <- cxt p
-                      return $ DerivClause ds p'
+derivClause :: Maybe DerivStrategyQ -> [PredQ] -> DerivClauseQ
+derivClause mds p = do mds' <- sequenceA mds
+                       p'   <- cxt p
+                       return $ DerivClause mds' p'
+
+stockStrategy :: DerivStrategyQ
+stockStrategy = pure StockStrategy
+
+anyclassStrategy :: DerivStrategyQ
+anyclassStrategy = pure AnyclassStrategy
+
+newtypeStrategy :: DerivStrategyQ
+newtypeStrategy = pure NewtypeStrategy
+
+viaStrategy :: TypeQ -> DerivStrategyQ
+viaStrategy = fmap ViaStrategy
 
 normalC :: Name -> [BangTypeQ] -> ConQ
 normalC con strtys = liftM (NormalC con) $ sequence strtys
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 46f4dc0444..7edc15c696 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -388,11 +388,12 @@ ppr_dec _ (PatSynSigD name ty)
   = pprPatSynSig name ty
 
 ppr_deriv_strategy :: DerivStrategy -> Doc
-ppr_deriv_strategy ds = text $
+ppr_deriv_strategy ds =
   case ds of
-    StockStrategy    -> "stock"
-    AnyclassStrategy -> "anyclass"
-    NewtypeStrategy  -> "newtype"
+    StockStrategy    -> text "stock"
+    AnyclassStrategy -> text "anyclass"
+    NewtypeStrategy  -> text "newtype"
+    ViaStrategy ty   -> text "via" <+> pprParendType ty
 
 ppr_overlap :: Overlap -> Doc
 ppr_overlap o = text $
@@ -452,8 +453,16 @@ ppr_newtype maybeInst ctxt t argsDoc ksig c decs
 
 ppr_deriv_clause :: DerivClause -> Doc
 ppr_deriv_clause (DerivClause ds ctxt)
-  = text "deriving" <+> maybe empty ppr_deriv_strategy ds
+  = text "deriving" <+> pp_strat_before
                     <+> ppr_cxt_preds ctxt
+                    <+> pp_strat_after
+  where
+    -- @via@ is unique in that in comes /after/ the class being derived,
+    -- so we must special-case it.
+    (pp_strat_before, pp_strat_after) =
+      case ds of
+        Just (via@ViaStrategy{}) -> (empty, ppr_deriv_strategy via)
+        _                        -> (maybe empty ppr_deriv_strategy ds, empty)
 
 ppr_tySyn :: Doc -> Name -> Doc -> Type -> Doc
 ppr_tySyn maybeInst t argsDoc rhs
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 3a3cf60349..95ece50bcc 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1743,6 +1743,7 @@ data DerivClause = DerivClause (Maybe DerivStrategy) Cxt
 data DerivStrategy = StockStrategy    -- ^ A \"standard\" derived instance
                    | AnyclassStrategy -- ^ @-XDeriveAnyClass@
                    | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@
+                   | ViaStrategy Type -- ^ @-XDerivingVia@
   deriving( Show, Eq, Ord, Data, Generic )
 
 -- | A Pattern synonym's type. Note that a pattern synonym's *fully*
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 41b7eea26c..f60bb6ec52 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -16,6 +16,8 @@
     `qAddTempFile` method to `Quasi`, which requests a temporary file of
     a given suffix.
 
+  * Add a `ViaStrategy` constructor to `DerivStrategy`.
+
 ## 2.13.0.0 *March 2018*
 
   * Bundled with GHC 8.4.1