Accept next-docstrings on GADT constructors.
authorBen Gamari <bgamari.foss@gmail.com>
Thu, 23 Jul 2015 09:42:07 +0000 (11:42 +0200)
committerBen Gamari <ben@smart-cactus.org>
Thu, 23 Jul 2015 09:42:46 +0000 (11:42 +0200)
Accept next docstrings (`-- | Docstring`) on GADT constructors.

I have confirmed that this adds no shift/reduce conflicts.

Test Plan: haddockA034

Reviewers: austin, simonpj, simonmar

Reviewed By: simonmar

Subscribers: Fuuzetsu, simonmar, thomie, mpickering, edsko

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

compiler/hsSyn/HsDecls.hs
compiler/parser/Parser.y
docs/users_guide/7.12.1-notes.xml
testsuite/tests/haddock/should_compile_flag_haddock/all.T
testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.hs [new file with mode: 0644]
testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr [new file with mode: 0644]

index 9233f4f..79b0dee 100644 (file)
@@ -981,16 +981,17 @@ pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs
 
 pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs
                     , con_cxt = cxt, con_details = PrefixCon arg_tys
-                    , con_res = ResTyGADT _ res_ty })
-  = ppr_con_names cons <+> dcolon <+>
+                    , con_res = ResTyGADT _ res_ty, con_doc = doc })
+  = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon <+>
     sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
   where
     mk_fun_ty a b = noLoc (HsFunTy a b)
 
 pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs
                     , con_cxt = cxt, con_details = RecCon fields
-                    , con_res = ResTyGADT _ res_ty })
-  = sep [ppr_con_names cons <+> dcolon <+> pprHsForAll expl tvs cxt,
+                    , con_res = ResTyGADT _ res_ty, con_doc = doc })
+  = sep [ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
+         <+> pprHsForAll expl tvs cxt,
          pprConDeclFields (unLoc fields) <+> arrow <+> ppr res_ty]
 
 pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT {} })
index d697253..99abf16 100644 (file)
@@ -1870,10 +1870,10 @@ gadt_constrlist :: { Located ([AddAnn]
         | {- empty -}                            { noLoc ([],[]) }
 
 gadt_constrs :: { Located [LConDecl RdrName] }
-        : gadt_constr ';' gadt_constrs
+        : gadt_constr_with_doc ';' gadt_constrs
                   {% addAnnotation (gl $1) AnnSemi (gl $2)
                      >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
-        | gadt_constr                   { L (gl $1) [$1] }
+        | gadt_constr_with_doc          { L (gl $1) [$1] }
         | {- empty -}                   { noLoc [] }
 
 -- We allow the following forms:
@@ -1882,11 +1882,18 @@ gadt_constrs :: { Located [LConDecl RdrName] }
 --      D { x,y :: a } :: T a
 --      forall a. Eq a => D { x,y :: a } :: T a
 
+gadt_constr_with_doc :: { LConDecl RdrName }
+gadt_constr_with_doc
+        : maybe_docnext ';' gadt_constr
+                {% return $ addConDoc $3 $1 }
+        | gadt_constr
+                {% return $1 }
+
 gadt_constr :: { LConDecl RdrName }
                    -- Returns a list because of:   C,D :: ty
         : con_list '::' sigtype
                 {% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3
-                      ; ams (sLL $1 $> gadtDecl)
+                      ; ams (sLL $1 $> gadtDecl)
                             (mj AnnDcolon $2:anns) } }
 
                 -- Deprecated syntax for GADT record declarations
index cfe98b5..27ad849 100644 (file)
            </listitem>
             <listitem>
                 <para>
+                    The parser now supports Haddock comments on GADT data constructors. For example,
+                    <programlisting>
+                      data Expr a where
+                        -- | Just a normal sum
+                        Sum :: Int -> Int -> Expr Int
+                    </programlisting>
+               </para>
+           </listitem>
+            <listitem>
+                <para>
                     Implicit parameters of the new base type
                     <literal>GHC.Stack.CallStack</literal> are treated
                     specially, and automatically solved for the current source
index d803e9d..a0d1d7c 100644 (file)
@@ -31,4 +31,5 @@ test('haddockA030', normal, compile, ['-haddock -ddump-parsed'])
 test('haddockA031', normal, compile, ['-haddock -ddump-parsed -XExistentialQuantification'])
 test('haddockA032', normal, compile, ['-haddock -ddump-parsed'])
 test('haddockA033', normal, compile, ['-haddock -ddump-parsed'])
+test('haddockA034', normal, compile, ['-haddock -ddump-parsed'])
 test('T10398', normal, compile, ['-haddock -ddump-parsed'])
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.hs
new file mode 100644 (file)
index 0000000..195d76c
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE GADTs #-}
+
+module Hi where
+
+-- | This is a GADT.
+data Hi where
+    -- | This is a GADT constructor.
+    Hi :: () -> Hi
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr
new file mode 100644 (file)
index 0000000..f743393
--- /dev/null
@@ -0,0 +1,5 @@
+
+==================== Parser ====================
+module Hi where
+<document comment>
+data Hi where  This is a GADT constructor. Hi :: () -> Hi