Allow putting Haddocks on derived instances
authorRyan Scott <ryan.gl.scott@gmail.com>
Wed, 11 May 2016 13:58:35 +0000 (15:58 +0200)
committerBen Gamari <ben@smart-cactus.org>
Thu, 12 May 2016 13:42:56 +0000 (15:42 +0200)
Currently, one can document top-level instance declarations, but derived
instances (both those in `deriving` clauses and standalone `deriving`
instances) do not enjoy the same privilege. This makes the necessary
changes to the parser to enable attaching Haddock comments for derived
instances.

Updates haddock submodule.

Fixes #11768.

Test Plan: ./validate

Reviewers: hvr, bgamari, austin

Reviewed By: austin

Subscribers: thomie, mpickering

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

GHC Trac Issues: #11768

compiler/parser/Parser.y
testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs [new file with mode: 0644]
testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr [new file with mode: 0644]
testsuite/tests/haddock/should_compile_flag_haddock/all.T
utils/haddock

index 9489be4..ef1c3ec 100644 (file)
@@ -1727,9 +1727,9 @@ inst_type :: { LHsSigType RdrName }
         : sigtype                       { mkLHsSigType $1 }
 
 deriv_types :: { [LHsSigType RdrName] }
-        : type                          { [mkLHsSigType $1] }
+        : typedoc                       { [mkLHsSigType $1] }
 
-        | type ',' deriv_types          {% addAnnotation (gl $1) AnnComma (gl $2)
+        | typedoc ',' deriv_types       {% addAnnotation (gl $1) AnnComma (gl $2)
                                            >> return (mkLHsSigType $1 : $3) }
 
 comma_types0  :: { [LHsType RdrName] }  -- Zero or more:  ty,ty,ty
@@ -1936,10 +1936,9 @@ fielddecl :: { LConDeclField RdrName }
 -- know the rightmost extremity of the 'deriving' clause
 deriving :: { Located (HsDeriving RdrName) }
         : {- empty -}             { noLoc Nothing }
-        | 'deriving' qtycon       {% let { L tv_loc tv = $2
-                                         ; full_loc = comb2 $1 $> }
+        | 'deriving' qtycondoc    {% let { full_loc = comb2 $1 $> }
                                       in ams (L full_loc $ Just $ L full_loc $
-                                                 [mkLHsSigType (L tv_loc (HsTyVar $2))])
+                                                 [mkLHsSigType $2])
                                              [mj AnnDeriving $1] }
 
         | 'deriving' '(' ')'      {% let { full_loc = comb2 $1 $> }
@@ -2896,6 +2895,10 @@ qtycon :: { Located RdrName }   -- Qualified or unqualified
         : QCONID            { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
         | tycon             { $1 }
 
+qtycondoc :: { LHsType RdrName } -- Qualified or unqualified
+        : qtycon            { sL1 $1                     (HsTyVar $1)      }
+        | qtycon docprev    { sLL $1 $> (HsDocTy (sL1 $1 (HsTyVar $1)) $2) }
+
 tycon   :: { Located RdrName }  -- Unqualified
         : CONID                   { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs
new file mode 100644 (file)
index 0000000..5689b42
--- /dev/null
@@ -0,0 +1,13 @@
+{-# LANGUAGE StandaloneDeriving #-}
+module T11768 where
+
+data Foo = Foo
+  deriving Eq -- ^ Documenting a single type
+
+data Bar = Bar
+  deriving ( Eq -- ^ Documenting one of multiple types
+           , Ord
+           )
+
+-- | Documenting a standalone deriving instance
+deriving instance Read Bar
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
new file mode 100644 (file)
index 0000000..684a6f0
--- /dev/null
@@ -0,0 +1,13 @@
+
+==================== Parser ====================
+module T11768 where
+data Foo
+  = Foo
+  deriving (Eq  Documenting a single type)
+data Bar
+  = Bar
+  deriving (Eq  Documenting one of multiple types, Ord)
+<document comment>
+deriving instance Read Bar
+
+
index 344210e..7db4379 100644 (file)
@@ -46,3 +46,4 @@ 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'])
+test('T11768', normal, compile, ['-haddock -ddump-parsed'])
index 9760ee9..d7ef908 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 9760ee9efe22f0256d626bc567a7adfc754e9066
+Subproject commit d7ef90898c6d8ddeae23caf0f9fb68c25537dcd0