diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2019-05-14 15:04:02 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-05-23 22:43:12 -0400 |
commit | 6eedbd83a19cad94414b37f984b6e9c2b0c0b2e4 (patch) | |
tree | f9558c084950b8879dbe2e42f2703aeb820e1071 /compiler/deSugar | |
parent | 59f4cb6fb73ade6f9b0bdc85380dfddba93bf14b (diff) | |
download | haskell-6eedbd83a19cad94414b37f984b6e9c2b0c0b2e4.tar.gz |
Some forall-related cleanup in deriving code
* Tweak the parser to allow `deriving` clauses to mention explicit
`forall`s or kind signatures without gratuitous parentheses.
(This fixes #14332 as a consequence.)
* Allow Haddock comments on `deriving` clauses with explicit
`forall`s. This requires corresponding changes in Haddock.
Diffstat (limited to 'compiler/deSugar')
-rw-r--r-- | compiler/deSugar/ExtractDocs.hs | 17 |
1 files changed, 14 insertions, 3 deletions
diff --git a/compiler/deSugar/ExtractDocs.hs b/compiler/deSugar/ExtractDocs.hs index 4a5e890553..f608424d7d 100644 --- a/compiler/deSugar/ExtractDocs.hs +++ b/compiler/deSugar/ExtractDocs.hs @@ -191,11 +191,22 @@ subordinates instMap decl = case decl of , (dL->L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (dL->L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty) - | HsIB { hsib_body = (dL->L l (HsDocTy _ _ doc)) } - <- concatMap (unLoc . deriv_clause_tys . unLoc) $ - unLoc $ dd_derivs dd + | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ + concatMap (unLoc . deriv_clause_tys . unLoc) $ + unLoc $ dd_derivs dd , Just instName <- [M.lookup l instMap] ] + extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty ty = + case dL ty of + -- deriving (forall a. C a {- ^ Doc comment -}) + L l (HsForAllTy{ hst_fvf = ForallInvis + , hst_body = dL->L _ (HsDocTy _ _ doc) }) + -> Just (l, doc) + -- deriving (C a {- ^ Doc comment -}) + L l (HsDocTy _ _ doc) -> Just (l, doc) + _ -> Nothing + -- | Extract constructor argument docs from inside constructor decls. conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString) conArgDocs con = case getConArgs con of |