Allow Haddock comments before function arguments.
authorIavor Diatchki <iavor.diatchki@gmail.com>
Thu, 7 Jun 2018 17:32:27 +0000 (13:32 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 7 Jun 2018 22:06:31 +0000 (18:06 -0400)
Currently, documentation strings on function arguments has to be written
after the argument (i.e., using `{-^ -}` comments).  This patch allows
us to use `{-| -}` comments to put the comment string before an
argument.   The same works for the results of functions.

Reviewers: bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, mpickering, carter

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

compiler/parser/Parser.y
testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr
testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs [new file with mode: 0644]
testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr [new file with mode: 0644]

index 6fc233e..25edb3e 100644 (file)
@@ -1890,6 +1890,7 @@ type :: { LHsType GhcPs }
 typedoc :: { LHsType GhcPs }
         : btype                          { $1 }
         | btype docprev                  { sLL $1 $> $ HsDocTy noExt $1 $2 }
+        | docnext btype                  { sLL $1 $> $ HsDocTy noExt $2 $1 }
         | btype '->'     ctypedoc        {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
                                          >> ams (sLL $1 $> $ HsFunTy noExt $1 $3)
                                                 [mu AnnRarrow $2] }
@@ -1899,6 +1900,14 @@ typedoc :: { LHsType GhcPs }
                                                             (HsDocTy noExt $1 $2))
                                                          $4)
                                                 [mu AnnRarrow $3] }
+        | docnext btype '->' ctypedoc    {% ams $2 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
+                                         >> ams (sLL $1 $> $
+                                                 HsFunTy noExt (L (comb2 $1 $2)
+                                                            (HsDocTy noExt $2 $1))
+                                                         $4)
+                                                [mu AnnRarrow $3] }
+
+
 
 -- See Note [Parsing ~]
 btype :: { LHsType GhcPs }
index 94318ef..3021fa7 100644 (file)
@@ -3,5 +3,5 @@
 module UnamedConstructorStrictFields where
 data A = A
 data B = B
-data Foo = MkFoo {-# UNPACK #-} !A  Unpacked strict field B
-data Bar = {-# UNPACK #-} !A  Unpacked strict field :%% B
+data Foo = MkFoo {-# UNPACK #-} !A " Unpacked strict field" B
+data Bar = {-# UNPACK #-} !A " Unpacked strict field" :%% B
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs
new file mode 100644 (file)
index 0000000..79d23e9
--- /dev/null
@@ -0,0 +1,29 @@
+module CommentsBeforeArguments where
+
+data A = A
+data B = B
+
+f1 :: {-| Comment before -}
+     () ->
+
+     ()
+     {-^ Comment after -} ->
+
+     ()
+     {-^ Result after -}
+f1 _ _ = ()
+
+
+f2 :: {-| Comment before -}
+     () ->
+
+     ()
+     {-^ Comment after -} ->
+
+     {-| Result after -}
+     ()
+f2 _ _ = ()
+
+
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr
new file mode 100644 (file)
index 0000000..0c12f5c
--- /dev/null
@@ -0,0 +1,11 @@
+
+==================== Parser ====================
+module CommentsBeforeArguments where
+f1 ::
+  ()  Comment before  -> ()  Comment after  -> ()  Result after 
+f1 _ _ = ()
+f2 ::
+  ()  Comment before  -> ()  Comment after  -> ()  Result after 
+f2 _ _ = ()
+
+