Serialize docstrings to ifaces, display them with new GHCi :doc command

If `-haddock` is set, we now extract docstrings from the renamed ast
and serialize them in the .hi-files.

This includes some of the changes from D4749 with the notable
exceptions of the docstring lexing and renaming.

A currently limited and experimental GHCi :doc command can be used
to display docstrings for declarations.

The formatting of pretty-printed docstrings is changed slightly,
causing some changes in testsuite/tests/haddock.

Test Plan: ./validate

Reviewers: alexbiehl, hvr, gershomb, harpocrates, bgamari

Reviewed By: alexbiehl

Subscribers: rwbarton, thomie, carter

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

28 files changed, 185 insertions, 78 deletions

diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
index 8f06390348..d230d58eaa 100644
--- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
+++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
@@ -17,7 +17,7 @@ visible a = a
 [3 of 3] Compiling Test             ( Test.hs, Test.o )
 
 ==================== Parser ====================
-
+"
  Module      :  Test
  Copyright   :  (c) Simon Marlow 2002
  License     :  BSD-style
@@ -28,63 +28,65 @@ visible a = a
 
  This module illustrates & tests most of the features of Haddock.
  Testing references from the description: 'T', 'f', 'g', 'Visible.visible'.
-
+"
 module Test (
         <IEGroup: 1>, <IEGroup: 2>, T(..), T2, T3(..), T4(..), T5(..),
         T6(..), N1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..),
         <IEGroup: 2>, R(..), R1(..),
-         test that we can export record selectors on their own:, p, q, u,
+        " test that we can export record selectors on their own:", p, q, u,
         <IEGroup: 1>, C(a, b), D(..), E, F(..),
-         Test that we can export a class method on its own:, a,
+        " Test that we can export a class method on its own:", a,
         <IEGroup: 1>, f, g, <IEGroup: 1>, <IEDocNamed: aux1>,
         <IEDocNamed: aux2>, <IEDocNamed: aux3>, <IEDocNamed: aux4>,
         <IEDocNamed: aux5>, <IEDocNamed: aux6>, <IEDocNamed: aux7>,
         <IEDocNamed: aux8>, <IEDocNamed: aux9>, <IEDocNamed: aux10>,
         <IEDocNamed: aux11>, <IEDocNamed: aux12>,
-         This is some inline documentation in the export list
+        " This is some inline documentation in the export list
 
  > a code block using bird-tracks
  > each line must begin with > (which isn't significant unless it
- > is at the beginning of the line).,
+ > is at the beginning of the line).",
         <IEGroup: 1>, module Hidden, <IEGroup: 1>, module Visible,
-         nested-style doc comments , <IEGroup: 1>, Ex(..), <IEGroup: 1>, k,
-        l, m, o, <IEGroup: 1>, <IEGroup: 2>,
-        
+        " nested-style doc comments ", <IEGroup: 1>, Ex(..), <IEGroup: 1>,
+        k, l, m, o, <IEGroup: 1>, <IEGroup: 2>,
+        "
  > a literal line
 
  $ a non /literal/ line $
-, f'
+", f'
     ) where
 import Hidden
 import Visible
 <document comment>
 data T a b
-  =  This comment describes the 'A' constructor A Int (Maybe Float) |
-     This comment describes the 'B' constructor B (T a b, T Int Float)
+  = " This comment describes the 'A' constructor"
+    A Int (Maybe Float) |
+    " This comment describes the 'B' constructor"
+    B (T a b, T Int Float)
 <document comment>
 data T2 a b = T2 a b
 <document comment>
 data T3 a b = A1 a | B1 b
 data T4 a b = A2 a | B2 b
-data T5 a b =  documents 'A3' A3 a |  documents 'B3' B3 b
+data T5 a b = " documents 'A3'" A3 a | " documents 'B3'" B3 b
 <document comment>
 data T6
-  =  This is the doc for 'A4' A4 |
-     This is the doc for 'B4' B4 |
-     This is the doc for 'C4' C4
+  = " This is the doc for 'A4'" A4 |
+    " This is the doc for 'B4'" B4 |
+    " This is the doc for 'C4'" C4
 <document comment>
 newtype N1 a = N1 a
 <document comment>
 newtype N2 a b = N2 {n :: a b}
 <document comment>
-newtype N3 a b = N3 {n3 :: a b  this is the 'n3' field}
+newtype N3 a b = N3 {n3 :: a b " this is the 'n3' field"}
 <document comment>
 newtype N4 a b = N4 a
 newtype N5 a b
-  = N5 {n5 :: a b  no docs on the datatype or the constructor}
-newtype N6 a b =  docs on the constructor only N6 {n6 :: a b}
+  = N5 {n5 :: a b " no docs on the datatype or the constructor"}
+newtype N6 a b = " docs on the constructor only" N6 {n6 :: a b}
 <document comment>
-newtype N7 a b =  The 'N7' constructor N7 {n7 :: a b}
+newtype N7 a b = " The 'N7' constructor" N7 {n7 :: a b}
 class (D a) => C a where
   a :: IO a
   b :: [a]
@@ -107,20 +109,20 @@ class F a where
   ff :: a
 <document comment>
 data R
-  =  This is the 'C1' record constructor, with the following fields:
-    C1 {p :: Int  This comment applies to the 'p' field,
-        q :: forall a. a -> a  This comment applies to the 'q' field,
-        r, s :: Int  This comment applies to both 'r' and 's'} |
-     This is the 'C2' record constructor, also with some fields:
+  = " This is the 'C1' record constructor, with the following fields:"
+    C1 {p :: Int " This comment applies to the 'p' field",
+        q :: forall a. a -> a " This comment applies to the 'q' field",
+        r, s :: Int " This comment applies to both 'r' and 's'"} |
+    " This is the 'C2' record constructor, also with some fields:"
     C2 {t :: T1
              -> (T2 Int Int) -> (T3 Bool Bool) -> (T4 Float Float) -> T5 () (),
         u, v :: Int}
 <document comment>
 data R1
-  =  This is the 'C3' record constructor
-    C3 {s1 :: Int  The 's1' record selector,
-        s2 :: Int  The 's2' record selector,
-        s3 :: Int  The 's3' record selector}
+  = " This is the 'C3' record constructor"
+    C3 {s1 :: Int " The 's1' record selector",
+        s2 :: Int " The 's2' record selector",
+        s3 :: Int " The 's3' record selector"}
 <document comment>
 <document comment>
 <document comment>
@@ -151,26 +153,27 @@ data Ex a
     Ex4 (forall a. a -> a)
 <document comment>
 k ::
-  T () ()  This argument has type 'T'
-  -> (T2 Int Int)  This argument has type 'T2 Int Int'
+  T () () " This argument has type 'T'"
+  -> (T2 Int Int) " This argument has type 'T2 Int Int'"
      -> (T3 Bool Bool
-         -> T4 Float Float)  This argument has type @T3 Bool Bool -> T4 Float Float@
-        -> T5 () ()  This argument has a very long description that should
+         -> T4 Float Float) " This argument has type @T3 Bool Bool -> T4 Float Float@"
+        -> T5 () () " This argument has a very long description that should
  hopefully cause some wrapping to happen when it is finally
- rendered by Haddock in the generated HTML page.
-           -> IO ()  This is the result type
-l :: (Int, Int, Float)  takes a triple -> Int  returns an 'Int'
+ rendered by Haddock in the generated HTML page."
+           -> IO () " This is the result type"
+l :: (Int, Int, Float) " takes a triple" -> Int " returns an 'Int'"
 <document comment>
 m ::
-  R -> N1 ()  one of the arguments -> IO Int  and the return value
+  R
+  -> N1 () " one of the arguments" -> IO Int " and the return value"
 <document comment>
 newn ::
-  R  one of the arguments, an 'R'
-  -> N1 ()  one of the arguments -> IO Int
+  R " one of the arguments, an 'R'"
+  -> N1 () " one of the arguments" -> IO Int
 newn = undefined
 <document comment>
 foreign import ccall unsafe "header.h" o
-  :: Float  The input float -> IO Float  The output float
+  :: Float " The input float" -> IO Float " The output float"
 <document comment>
 newp :: Int
 newp = undefined
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
index 060dd06ad2..997c2ef24c 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
@@ -3,10 +3,10 @@
 module T11768 where
 data Foo
   = Foo
-  deriving Eq  Documenting a single type
+  deriving Eq " Documenting a single type"
 data Bar
   = Bar
-  deriving (Eq  Documenting one of multiple types, Ord)
+  deriving (Eq " Documenting one of multiple types", Ord)
 <document comment>
 deriving instance Read Bar
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr
index a70f624278..f55f8afab1 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr
@@ -1,6 +1,6 @@
 
 ==================== Parser ====================
- a header
+" a header"
 module HeaderTest where
 <document comment>
 x = 0
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr
index 3bfc17d811..15adf3e54e 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr
@@ -1,6 +1,6 @@
 
 ==================== Parser ====================
- a header
+" a header"
 module HeaderTest where
 <document comment>
 x = 0
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr
index 48dd0870c9..e9ccec44a0 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr
@@ -1,6 +1,6 @@
 
 ==================== Parser ====================
-Module description
+"Module description"
 module A where
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr
index 2aa5245f50..357f7540e2 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr
@@ -1,6 +1,6 @@
 
 ==================== Parser ====================
- module header bla bla 
+" module header bla bla "
 module A where
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr
index ca316bc8b8..c7a34730d9 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module A (
-         bla bla,  blabla 
+        " bla bla", " blabla "
     ) where
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr
index 2aaa3eba98..660b28036e 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module A (
-         bla bla,  blabla , x, <IEGroup: 2>,  qweljqwelkqjwelqjkq
+        " bla bla", " blabla ", x, <IEGroup: 2>, " qweljqwelkqjwelqjkq"
     ) where
 x = True
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr
index 162c403b84..befbee45f9 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr
@@ -1,8 +1,8 @@
 
 ==================== Parser ====================
 module A (
-         bla bla,  blabla , x, <IEGroup: 2>,  qweljqwelkqjwelqjkq, y,
-         dkashdakj, z, <IEGroup: 1>
+        " bla bla", " blabla ", x, <IEGroup: 2>, " qweljqwelkqjwelqjkq", y,
+        " dkashdakj", z, <IEGroup: 1>
     ) where
 x = True
 y = False
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr
index fcb953a495..d04558c301 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module ShouldCompile where
-test :: (Eq a) => [a]  doc1 -> [a]  doc2 -> [a]  doc3
+test :: (Eq a) => [a] " doc1" -> [a] " doc2 " -> [a] " doc3"
 test xs ys = xs
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr
index 9f57f5df07..c453e071a3 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module ShouldCompile where
-test2 :: a  doc1 -> b  doc2 -> a  doc 3 
+test2 :: a " doc1 " -> b " doc2 " -> a " doc 3 "
 test2 x y = x
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr
index 472ec1a1eb..e0b8a4a7bf 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module ShouldCompile where
-test2 :: a  doc1  -> a
+test2 :: a " doc1 " -> a
 test2 x = x
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr
index 5f7335b6b9..37135099a0 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr
@@ -2,7 +2,7 @@
 ==================== Parser ====================
 module ShouldCompile where
 test ::
-  (Eq a) => [a]  doc1 -> forall b. [b]  doc2 -> [a]  doc3
+  (Eq a) => [a] " doc1" -> forall b. [b] " doc2 " -> [a] " doc3"
 test xs ys = xs
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr
index e7707c5ec0..0bbb612119 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr
@@ -2,9 +2,9 @@
 ==================== Parser ====================
 module ShouldCompile where
 test ::
-  [a]  doc1
+  [a] " doc1"
   -> forall b.
-     (Ord b) => [b]  doc2  -> forall c. (Num c) => [c]  doc3 -> [a]
+     (Ord b) => [b] " doc2 " -> forall c. (Num c) => [c] " doc3" -> [a]
 test xs ys zs = xs
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr
index 47d2468ea5..3c1bbc9565 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr
@@ -2,7 +2,7 @@
 ==================== Parser ====================
 module ShouldCompile where
 data a <--> b = Mk a b
-test :: [a]  doc1  -> a <--> b -> [a]  blabla
+test :: [a] " doc1 " -> a <--> b -> [a] " blabla"
 test xs ys = xs
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr
index 820ffa6708..7271238e3e 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr
@@ -2,6 +2,6 @@
 ==================== Parser ====================
 module ShouldCompile where
 data A
-  =  A comment that documents the first constructor A | B | C | D
+  = " A comment that documents the first constructor" A | B | C | D
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
index b0ef139199..e09cfa2187 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
@@ -2,6 +2,9 @@
 ==================== Parser ====================
 module ShouldCompile where
 data A
-  =  comment for A  A |  comment for B  B |  comment for C   C | D
+  = " comment for A " A |
+    " comment for B " B |
+    " comment for C  " C |
+    D
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr
index 1d033cd6d7..eb6fcaef1e 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr
@@ -3,7 +3,7 @@
 module ShouldCompile where
 data A
   = A |
-     comment for B  forall a. B a a |
-     comment for C  forall a. Num a => C a
+    " comment for B " forall a. B a a |
+    " comment for C " forall a. Num a => C a
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr
index 5cf2d9b034..eec30285f5 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr
@@ -3,8 +3,8 @@
 module ShouldCompile where
 data R a
   = R {field1 :: a,
-       field2 :: a  comment for field2,
-       field3 :: a  comment for field3,
-       field4 :: a  comment for field4 }
+       field2 :: a " comment for field2",
+       field3 :: a " comment for field3",
+       field4 :: a " comment for field4 "}
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr
index f743393349..64478fed12 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr
@@ -2,4 +2,6 @@
 ==================== Parser ====================
 module Hi where
 <document comment>
-data Hi where  This is a GADT constructor. Hi :: () -> Hi
+data Hi where " This is a GADT constructor." Hi :: () -> Hi
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.stderr
index d0e5bbc57d..3f12a0cffd 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.stderr
@@ -3,7 +3,9 @@
 module Hi where
 data Hi
   where
-      Hi :: ()  This is a comment on the '()' field of 'Hi'
-            -> Int
-               -> String  This is a comment on the 'String' field of 'Hi'
-                  -> Hi  This is a comment on the return type of 'Hi'
+    Hi :: () " This is a comment on the '()' field of 'Hi'"
+          -> Int
+             -> String " This is a comment on the 'String' field of 'Hi'"
+                -> Hi " This is a comment on the return type of 'Hi'"
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.stderr
index 0d884ab0e3..5cd0a59a05 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.stderr
@@ -2,11 +2,13 @@
 ==================== Parser ====================
 module ConstructorFields where
 data Foo
-  =  doc on `Bar` constructor Bar Int String |
-     doc on the `Baz` constructor
-    Baz Int  doc on the `Int` field of `Baz` String  doc on the `String` field of `Baz` |
-     doc on the `:+` constructor Int :+ String |
-     doc on the `:*` constructor
-    Int  doc on the `Int` field of the `:*` constructor :* String  doc on the `String` field of the `:*` constructor |
-     doc on the `Boo` record constructor Boo {x :: ()} |
-     doc on the `Boa` record constructor Boa {y :: ()}
+  = " doc on `Bar` constructor" Bar Int String |
+    " doc on the `Baz` constructor"
+    Baz Int " doc on the `Int` field of `Baz`" String " doc on the `String` field of `Baz`" |
+    " doc on the `:+` constructor" Int :+ String |
+    " doc on the `:*` constructor"
+    Int " doc on the `Int` field of the `:*` constructor" :* String " doc on the `String` field of the `:*` constructor" |
+    " doc on the `Boo` record constructor" Boo {x :: ()} |
+    " doc on the `Boa` record constructor" Boa {y :: ()}
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.stderr
index 8e90efa691..b9ecfa6303 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.stderr
@@ -4,4 +4,6 @@ module UnamedConstructorFields where
 data A = A
 data B = B
 data C = C
-data Foo = MkFoo A  'A' has a comment B C  'C' has a comment
+data Foo = MkFoo A " 'A' has a comment" B C " 'C' has a comment"
+
+
diff --git a/testsuite/tests/showIface/DocsInHiFile.hs b/testsuite/tests/showIface/DocsInHiFile.hs
new file mode 100644
index 0000000000..26156722ac
--- /dev/null
+++ b/testsuite/tests/showIface/DocsInHiFile.hs
@@ -0,0 +1,37 @@
+{-| `elem`, 'print',
+`Unknown',
+'<>', ':=:', 'Bool'
+-}
+module DocsInHiFile
+  ( DocsInHiFile.elem
+  , D(..)
+  , add
+  , P(..)
+  , Show(..)
+  ) where
+
+-- | '()', 'elem'.
+elem :: ()
+elem = ()
+
+-- | A datatype.
+data D
+  = D0 -- ^ A constructor for 'D'. '
+  | D1 -- ^ Another constructor
+  deriving ( Show -- ^ 'Show' instance
+           )
+
+add :: Int -- ^ First summand for 'add'
+    -> Int -- ^ Second summand
+    -> Int -- ^ Sum
+add a b = a + b
+
+-- | A class
+class P f where
+  -- | A class method
+  p :: a -- ^ An argument
+    -> f a
+
+-- | Another datatype...
+data D'
+-- ^ ...with two docstrings.
diff --git a/testsuite/tests/showIface/DocsInHiFile0.stdout b/testsuite/tests/showIface/DocsInHiFile0.stdout
new file mode 100644
index 0000000000..e1c32d63c8
--- /dev/null
+++ b/testsuite/tests/showIface/DocsInHiFile0.stdout
@@ -0,0 +1,4 @@
+module header:
+  Nothing
+declaration docs:
+arg docs:
diff --git a/testsuite/tests/showIface/DocsInHiFile1.stdout b/testsuite/tests/showIface/DocsInHiFile1.stdout
new file mode 100644
index 0000000000..fcb5f94f71
--- /dev/null
+++ b/testsuite/tests/showIface/DocsInHiFile1.stdout
@@ -0,0 +1,36 @@
+module header:
+  Just " `elem`, 'print',
+`Unknown',
+'<>', ':=:', 'Bool'
+"
+declaration docs:
+  D':
+    " Another datatype...
+
+ ...with two docstrings."
+  P:
+    " A class"
+  p:
+    " A class method"
+  D:
+    " A datatype."
+  D0:
+    " A constructor for 'D'. '"
+  D1:
+    " Another constructor"
+  elem:
+    " '()', 'elem'."
+  $fShowD:
+    " 'Show' instance"
+arg docs:
+  p:
+    0:
+      " An argument"
+  add:
+    0:
+      " First summand for 'add'"
+    1:
+      " Second summand"
+    2:
+      " Sum"
+
diff --git a/testsuite/tests/showIface/Makefile b/testsuite/tests/showIface/Makefile
index 49b90342b3..7eafdfc9d2 100644
--- a/testsuite/tests/showIface/Makefile
+++ b/testsuite/tests/showIface/Makefile
@@ -5,3 +5,11 @@ include $(TOP)/mk/test.mk
 Orphans:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c Orphans.hs
 	'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface Orphans.hi | grep -E '^(instance |family instance |"myrule)' | grep -v 'family instance modules:'
+
+DocsInHiFile0:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c DocsInHiFile.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface DocsInHiFile.hi | grep -A 4 'module header:'
+
+DocsInHiFile1:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c -haddock DocsInHiFile.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface DocsInHiFile.hi | grep -A 100 'module header:'
diff --git a/testsuite/tests/showIface/all.T b/testsuite/tests/showIface/all.T
index 5c89b70b59..df5d5cd9ec 100644
--- a/testsuite/tests/showIface/all.T
+++ b/testsuite/tests/showIface/all.T
@@ -1 +1,9 @@
 test('Orphans', normal, run_command, ['$MAKE -s --no-print-directory Orphans'])
+test('DocsInHiFile0',
+     extra_files(['DocsInHiFile.hs']),
+     run_command,
+     ['$MAKE -s --no-print-directory DocsInHiFile0'])
+test('DocsInHiFile1',
+     extra_files(['DocsInHiFile.hs']),
+     run_command,
+     ['$MAKE -s --no-print-directory DocsInHiFile1'])