diff --git a/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs b/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs index a3dc219f..7575f3bc 100644 --- a/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs +++ b/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs @@ -373,7 +373,7 @@ enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do when (flush == NoFlushComments) $ do when ((getFollowingComments cs) /= []) $ do debugM $ "starting trailing comments:" ++ showAst (getFollowingComments cs) - mapM_ printOneComment (map tokComment $ getFollowingComments cs) + mapM_ printOneComment (concatMap tokComment $ getFollowingComments cs) debugM $ "ending trailing comments" let newAchor = anchor' { anchor_op = MovedAnchor edp } @@ -389,7 +389,7 @@ enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do -- --------------------------------------------------------------------- addCommentsA :: (Monad m, Monoid w) => [LEpaComment] -> EP w m () -addCommentsA csNew = addComments (map tokComment csNew) +addCommentsA csNew = addComments (concatMap tokComment csNew) {- TODO: When we addComments, some may have an anchor that is no longer @@ -430,7 +430,7 @@ flushComments trailing = do mapM_ printOneComment (sortComments cs) debugM $ "flushing comments:EOF:trailing:" ++ showAst (trailing) debugM $ "flushing comments:EOF:" ++ showAst (filterEofComment True trailing) - mapM_ printOneComment (map tokComment (filterEofComment True trailing)) + mapM_ printOneComment (concatMap tokComment (filterEofComment True trailing)) debugM $ "flushing comments done" filterEofComment :: Bool -> [LEpaComment] -> [LEpaComment] @@ -553,7 +553,7 @@ printStringAtAAC :: (Monad m, Monoid w) => CaptureComments -> EpaLocation -> String -> EP w m EpaLocation printStringAtAAC capture (EpaSpan r) s = printStringAtRsC capture r s printStringAtAAC capture (EpaDelta d cs) s = do - mapM_ (printOneComment . tokComment) cs + mapM_ printOneComment $ concatMap tokComment cs pe1 <- getPriorEndD p1 <- getPosP printStringAtLsDelta d s @@ -1388,7 +1388,7 @@ instance ExactPrint HsModule where debugM "HsModule Entered" - mbDoc' <- markAnnotated mbDoc + -- mbDoc' <- markAnnotated mbDoc (an0, mmn' , mdeprec', mexports') <- case mmn of @@ -1419,7 +1419,7 @@ instance ExactPrint HsModule where let anf = an0 { anns = (anns an0) { am_decls = am_decls' }} debugM $ "HsModule, anf=" ++ showAst anf - return (HsModule anf lo mmn' mexports' imports' decls' mdeprec' mbDoc') + return (HsModule anf lo mmn' mexports' imports' decls' mdeprec' mbDoc) -- --------------------------------------------------------------------- @@ -4240,7 +4240,7 @@ instance ExactPrint (ConDecl GhcPs) where , con_mb_cxt = mcxt , con_args = args , con_doc = doc }) = do - doc' <- mapM markAnnotated doc + -- doc' <- mapM markAnnotated doc an0 <- if has_forall then markEpAnnL an lidl AnnForall else return an @@ -4260,7 +4260,7 @@ instance ExactPrint (ConDecl GhcPs) where , con_ex_tvs = ex_tvs' , con_mb_cxt = mcxt' , con_args = args' - , con_doc = doc' }) + , con_doc = doc }) where -- -- In ppr_details: let's not print the multiplicities (they are always 1, by @@ -4287,7 +4287,7 @@ instance ExactPrint (ConDecl GhcPs) where , con_bndrs = bndrs , con_mb_cxt = mcxt, con_g_args = args , con_res_ty = res_ty, con_doc = doc }) = do - doc' <- mapM markAnnotated doc + -- doc' <- mapM markAnnotated doc cons' <- mapM markAnnotated cons an0 <- markEpAnnL an lidl AnnDcolon an1 <- annotationsToComments an0 lidl [AnnOpenP, AnnCloseP] @@ -4314,7 +4314,7 @@ instance ExactPrint (ConDecl GhcPs) where , con_names = cons' , con_bndrs = bndrs' , con_mb_cxt = mcxt', con_g_args = args' - , con_res_ty = res_ty', con_doc = doc' }) + , con_res_ty = res_ty', con_doc = doc }) -- --------------------------------------------------------------------- @@ -4350,8 +4350,8 @@ instance ExactPrint (ConDeclField GhcPs) where names' <- markAnnotated names an0 <- markEpAnnL an lidl AnnDcolon ftype' <- markAnnotated ftype - mdoc' <- mapM markAnnotated mdoc - return (ConDeclField an0 names' ftype' mdoc') + -- mdoc' <- mapM markAnnotated mdoc + return (ConDeclField an0 names' ftype' mdoc) -- --------------------------------------------------------------------- @@ -4562,10 +4562,14 @@ instance ExactPrint (IE GhcPs) where m' <- markAnnotated m return (IEModuleContents an0 m') - -- exact (IEGroup _ _ _) = NoEntryVal - -- exact (IEDoc _ _) = NoEntryVal - -- exact (IEDocNamed _ _) = NoEntryVal - exact x = error $ "missing match for IE:" ++ showAst x + -- These three exist to not error out, but are no-ops The contents + -- appear as "normal" comments too, which we process instead. + exact (IEGroup x lev doc) = do + return (IEGroup x lev doc) + exact (IEDoc x doc) = do + return (IEDoc x doc) + exact (IEDocNamed x str) = do + return (IEDocNamed x str) -- --------------------------------------------------------------------- diff --git a/src/Language/Haskell/GHC/ExactPrint/Preprocess.hs b/src/Language/Haskell/GHC/ExactPrint/Preprocess.hs index ed8f6dc1..b2603824 100644 --- a/src/Language/Haskell/GHC/ExactPrint/Preprocess.hs +++ b/src/Language/Haskell/GHC/ExactPrint/Preprocess.hs @@ -125,8 +125,9 @@ getCppTokensAsComments cppOptions sourceFile = do goodComment :: GHC.LEpaComment -> Bool goodComment c = isGoodComment (tokComment c) where - isGoodComment :: Comment -> Bool - isGoodComment (Comment "" _ _ _) = False + isGoodComment :: [Comment] -> Bool + isGoodComment [] = False + isGoodComment [Comment "" _ _ _] = False isGoodComment _ = True diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs index b4fbc77b..7c2b5e7b 100644 --- a/src/Language/Haskell/GHC/ExactPrint/Utils.hs +++ b/src/Language/Haskell/GHC/ExactPrint/Utils.hs @@ -43,8 +43,8 @@ import Data.Default -- |Global switch to enable debug tracing in ghc-exactprint Delta / Print debugEnabledFlag :: Bool --- debugEnabledFlag = True -debugEnabledFlag = False +debugEnabledFlag = True +-- debugEnabledFlag = False -- |Global switch to enable debug tracing in ghc-exactprint Pretty debugPEnabledFlag :: Bool @@ -212,7 +212,13 @@ insertCppComments (L l p) cs = L l p' -- --------------------------------------------------------------------- ghcCommentText :: LEpaComment -> String -ghcCommentText (L _ (GHC.EpaComment (EpaDocCommentNext s) _)) = s +-- ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _)) = exactPrintHsDocString s +-- ghcCommentText (L _ (GHC.EpaComment (EpaDocCommentNext s) _)) = s +ghcCommentText (L _ (GHC.EpaComment (EpaDocCommentNext s) _)) = -- "-- |" ++ s + case lines s of + [] -> "" + (x:xs) -> unlines' $ ( "-- |" ++ x) + : map (\y -> "--"++y) xs ghcCommentText (L _ (GHC.EpaComment (EpaDocCommentPrev s) _)) = s ghcCommentText (L _ (GHC.EpaComment (EpaDocCommentNamed s) _)) = s ghcCommentText (L _ (GHC.EpaComment (EpaDocSection _ s) _)) = s @@ -221,8 +227,93 @@ ghcCommentText (L _ (GHC.EpaComment (EpaLineComment s) _)) = s ghcCommentText (L _ (GHC.EpaComment (EpaBlockComment s) _)) = s ghcCommentText (L _ (GHC.EpaComment (EpaEofComment) _)) = "" -tokComment :: LEpaComment -> Comment -tokComment t@(L lt c) = mkComment (normaliseCommentText $ ghcCommentText t) lt (ac_prior_tok c) +-- | Like unlines, but no trailing newline +unlines' :: [String] -> String +unlines' [] = [] +unlines' [x] = x +unlines' (x:xs) = x++"\n"++unlines' xs + +-- tokComment :: LEpaComment -> Comment +-- tokComment t@(L lt c) = mkComment (normaliseCommentText $ ghcCommentText t) lt (ac_prior_tok c) + +tokComment :: LEpaComment -> [Comment] +tokComment t@(L lt c) = + case t of + (L l (GHC.EpaComment (EpaDocCommentNext s) pt)) -> + case lines s of + [] -> [mkComment "" lt (ac_prior_tok c)] + (x:xs) -> + let + docChunk :: Anchor -> RealSrcSpan -> [String] -> [Comment] + docChunk _ _ [] = [] + docChunk l' pt' (chunk:cs) + = Comment ( "--" ++ chunk) (addLine 0 (length x + 2) l') pt' Nothing : docChunk (addLine 1 1 l') (anchor l') cs + + r = Comment ("-- |" ++ x) (addLine 0 (length x + 4) l) pt Nothing + : docChunk (addLine 1 1 l) (anchor l) xs + in + r + `debug` ("tokComment:r=" ++ showGhc r) + + _ -> [mkComment (normaliseCommentText (ghcCommentText t)) lt (ac_prior_tok c)] + + +addLine :: Int -> Int -> Anchor -> Anchor +addLine bump len (Anchor l op) = Anchor l' op + where + f = srcSpanFile l + sl = srcSpanStartLine l + sc = srcSpanStartCol l + el = srcSpanEndLine l + ec = srcSpanEndCol l + l' = mkRealSrcSpan (mkRealSrcLoc f (sl + bump) sc) + (mkRealSrcLoc f (sl + bump) (sc + len)) + +-- hsDocStringComments :: Anchor -> RealSrcSpan -> GHC.HsDocString -> [Comment] +-- hsDocStringComments _ pt (MultiLineDocString dec (x :| xs)) = +-- let +-- decStr = printDecorator dec +-- L lx x' = dedentDocChunkBy (3 + length decStr) x +-- str = "-- " ++ decStr ++ unpackHDSC x' +-- docChunk _ [] = [] +-- docChunk pt' (L l chunk:cs) +-- = Comment ("--" ++ unpackHDSC chunk) (spanAsAnchor l) pt' Nothing : docChunk (rs l) cs +-- in +-- (Comment str (spanAsAnchor lx) pt Nothing : docChunk (rs lx) (map dedentDocChunk xs)) +-- hsDocStringComments anc pt (NestedDocString dec@(HsDocStringNamed _) (L _ chunk)) +-- = [Comment ("{- " ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") anc pt Nothing ] +-- hsDocStringComments anc pt (NestedDocString dec (L _ chunk)) +-- = [Comment ("{-" ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") anc pt Nothing ] + +-- hsDocStringComments _ _ (GeneratedDocString _) = [] -- Should not appear in user-written code + +-- -- Temporary until https://gitlab.haskell.org/ghc/ghc/-/issues/23459 is landed +-- -- At the moment the locations of the 'HsDocStringChunk's are from the start of +-- -- the string part, leaving aside the "--". So we need to subtract 2 columns from it +-- dedentDocChunk :: LHsDocStringChunk -> LHsDocStringChunk +-- dedentDocChunk chunk = dedentDocChunkBy 2 chunk + +-- dedentDocChunkBy :: Int -> LHsDocStringChunk -> LHsDocStringChunk +-- dedentDocChunkBy dedent (L (RealSrcSpan l mb) c) = L (RealSrcSpan l' mb) c +-- where +-- f = srcSpanFile l +-- sl = srcSpanStartLine l +-- sc = srcSpanStartCol l +-- el = srcSpanEndLine l +-- ec = srcSpanEndCol l +-- l' = mkRealSrcSpan (mkRealSrcLoc f sl (sc - dedent)) +-- (mkRealSrcLoc f el (ec - dedent)) + +-- dedentDocChunkBy _ x = x + +-- -- Temporary until https://gitlab.haskell.org/ghc/ghc/-/issues/23459 is landed +-- printDecorator :: HsDocStringDecorator -> String +-- printDecorator HsDocStringNext = "|" +-- printDecorator HsDocStringPrevious = "^" +-- printDecorator (HsDocStringNamed n) = '$':n +-- printDecorator (HsDocStringGroup n) = replicate n '*' + + mkEpaComments :: [Comment] -> [Comment] -> EpAnnComments mkEpaComments priorCs [] diff --git a/tests/Test.hs b/tests/Test.hs index 3b0f55f7..a0d5ec13 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -199,7 +199,7 @@ tt' = do -- mkTestModChange libdir rmDecl1 "RmDecl1.hs" - mkTestModChange libdir rmDecl4 "RmDecl4.hs" + -- mkTestModChange libdir rmDecl4 "RmDecl4.hs" -- mkParserTestMD libdir "ghc92" "Foo.hs" -- mkParserTest libdir "ghc92" "Foo.hs" -- mkParserTestMD libdir "ghc92" "Foo.hs" @@ -209,6 +209,7 @@ tt' = do -- mkParserTestBC libdir "ghc92" "CommentPlacement3.hs" -- mkParserTestBC libdir "ghc92" "TopLevelSemis.hs" + mkParserTest libdir "ghc92" "Haddock1.hs" -- Needs GHC changes diff --git a/tests/Test/NoAnnotations.hs b/tests/Test/NoAnnotations.hs index 8e31354b..630a3f29 100644 --- a/tests/Test/NoAnnotations.hs +++ b/tests/Test/NoAnnotations.hs @@ -90,7 +90,7 @@ runPrettyRoundTrip libdir origFile !parsedOrig _cs = do -- let !newAnns = addAnnotationsForPretty [] parsedOrig mempty let priorComments = GHC.priorComments $ GHC.epAnnComments $ GHC.hsmodAnn $ GHC.unLoc parsedOrig -- let comments = map tokComment $ GHC.sortRealLocated priorComments - let comments = map tokComment priorComments + let comments = concatMap tokComment priorComments let pragmas = filter (\(Comment c _ _ _) -> isPrefixOf "{-#" c ) comments let pragmaStr = intercalate "\n" $ map commentContents pragmas diff --git a/tests/examples/ghc92/Haddock.hs b/tests/examples/ghc92/Haddock.hs new file mode 100644 index 00000000..85f5f8b5 --- /dev/null +++ b/tests/examples/ghc92/Haddock.hs @@ -0,0 +1,408 @@ +{-# OPTIONS_GHC -fno-warn-redundant-constraints -haddock #-} +----------------------------------------------------------------------------- +-- | +-- Module : Test +-- Copyright : (c) Simon Marlow 2002 +-- License : BSD-style +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- This module illustrates & tests most of the features of Haddock. +-- Testing references from the description: 'T', 'f', 'g', 'Visible.visible'. +-- +----------------------------------------------------------------------------- + +-- This is plain comment, ignored by Haddock. + +module Haddock ( + + -- Section headings are introduced with '-- *': + -- * Type declarations + + -- Subsection headings are introduced with '-- **' and so on. + -- ** Data types + T(..), T2, T3(..), T4(..), T5(..), T6(..), + N1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..), + + -- ** Records + R(..), R1(..), + + -- | test that we can export record selectors on their own: + p, q, u, + + -- * Class declarations + C(a,b), D(..), E, F(..), + + -- | Test that we can export a class method on its own: + a, + + -- * Function types + f, g, + + -- * Auxiliary stuff + + -- $aux1 + + -- $aux2 + + -- $aux3 + + -- $aux4 + + -- $aux5 + + -- $aux6 + + -- $aux7 + + -- $aux8 + + -- $aux9 + + -- $aux10 + + -- $aux11 + + -- $aux12 + + -- | 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). + + -- * A hidden module + module Hidden, + + -- * A visible module + module Visible, + + {-| nested-style doc comments -} + + -- * Existential \/ Universal types + Ex(..), + + -- * Type signatures with argument docs + k, l, m, o, + + -- * A section + -- and without an intervening comma: + -- ** A subsection + +{-| + > a literal line + + $ a non /literal/ line $ +-} + + f', + ) where + +import Hidden +import Visible + +-- | This comment applies to the /following/ declaration +-- and it continues until the next non-comment line +data T a b + = A Int (Maybe Float) -- ^ This comment describes the 'A' constructor + | -- | This comment describes the 'B' constructor + B (T a b, T Int Float) -- ^ + +-- | An abstract data declaration +data T2 a b = T2 a b + +-- | A data declaration with no documentation annotations on the constructors +data T3 a b = A1 a | B1 b + +-- A data declaration with no documentation annotations at all +data T4 a b = A2 a | B2 b + +-- A data declaration documentation on the constructors only +data T5 a b + = A3 a -- ^ documents 'A3' + | B3 b -- ^ documents 'B3' + +-- | Testing alternative comment styles +data T6 + -- | This is the doc for 'A4' + = A4 + | B4 + | -- ^ This is the doc for 'B4' + + -- | This is the doc for 'C4' + C4 + +-- | A newtype +newtype N1 a = N1 a + +-- | A newtype with a fieldname +newtype N2 a b = N2 {n :: a b} + +-- | A newtype with a fieldname, documentation on the field +newtype N3 a b = N3 {n3 :: a b -- ^ this is the 'n3' field + } + +-- | An abstract newtype - we show this one as data rather than newtype because +-- the difference isn\'t visible to the programmer for an abstract type. +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 = N6 {n6 :: a b + } + -- ^ docs on the constructor only + +-- | docs on the newtype and the constructor +newtype N7 a b = N7 {n7 :: a b + } + -- ^ The 'N7' constructor + + +class (D a) => C a where + -- |this is a description of the 'a' method + a :: IO a + b :: [a] + -- ^ this is a description of the 'b' method + c :: a -- c is hidden in the export list + +-- ^ This comment applies to the /previous/ declaration (the 'C' class) + +class D a where + d :: T a b + e :: (a,a) +-- ^ This is a class declaration with no separate docs for the methods + +instance D Int where + d = undefined + e = undefined + +-- instance with a qualified class name +instance Test.D Float where + d = undefined + e = undefined + +class E a where + ee :: a +-- ^ This is a class declaration with no methods (or no methods exported) + +-- This is a class declaration with no documentation at all +class F a where + ff :: a + +-- | This is the documentation for the 'R' record, which has four fields, +-- 'p', 'q', 'r', and 's'. +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 + , -- | This comment applies to both 'r' and 's' + r,s :: Int + } + | C2 { t :: T1 -> (T2 Int Int)-> (T3 Bool Bool) -> (T4 Float Float) -> T5 () (), + u,v :: Int + } + -- ^ This is the 'C2' record constructor, also with some fields: + +-- | Testing different record commenting styles +data R1 + -- | This is the 'C3' record constructor + = C3 { + -- | The 's1' record selector + s1 :: Int + -- | The 's2' record selector + , s2 :: Int + , s3 :: Int -- NOTE: In the original examples/Test.hs in Haddock, there is an extra "," here. + -- Since GHC doesn't allow that, I have removed it in this file. + -- ^ The 's3' record selector + } + +-- These section headers are only used when there is no export list to +-- give the structure of the documentation: + +-- * This is a section header (level 1) +-- ** This is a section header (level 2) +-- *** This is a section header (level 3) + +{-| +In a comment string we can refer to identifiers in scope with +single quotes like this: 'T', and we can refer to modules by +using double quotes: "Foo". We can add emphasis /like this/. + + * This is a bulleted list + + - This is the next item (different kind of bullet) + + (1) This is an ordered list + + 2. This is the next item (different kind of bullet) + +@ + This is a block of code, which can include other markup: 'R' + formatting + is + significant +@ + +> this is another block of code + +We can also include URLs in documentation: . +-} + +f :: C a => a -> Int + +-- | we can export foreign declarations too +foreign import ccall "header.h" g :: Int -> IO CInt + +-- | this doc string has a parse error in it: \' +h :: Int +h = 42 + + +-- $aux1 This is some documentation that is attached to a name ($aux1) +-- rather than a source declaration. The documentation may be +-- referred to in the export list using its name. +-- +-- @ code block in named doc @ + +-- $aux2 This is some documentation that is attached to a name ($aux2) + +-- $aux3 +-- @ code block on its own in named doc @ + +-- $aux4 +-- +-- @ code block on its own in named doc (after newline) @ + +{- $aux5 a nested, named doc comment + + with a paragraph, + + @ and a code block @ +-} + +-- some tests for various arrangements of code blocks: + +{- $aux6 +>test +>test1 + +@ test2 + test3 +@ +-} + +{- $aux7 +@ +test1 +test2 +@ +-} + +{- $aux8 +>test3 +>test4 +-} + +{- $aux9 +@ +test1 +test2 +@ + +>test3 +>test4 +-} + +{- $aux10 +>test3 +>test4 + +@ +test1 +test2 +@ +-} + +-- This one is currently wrong (Haddock 0.4). The @...@ part is +-- interpreted as part of the bird-tracked code block. +{- $aux11 +aux11: + +>test3 +>test4 + +@ +test1 +test2 +@ +-} + +-- $aux12 +-- > foo +-- +-- > bar +-- + +-- | A data-type using existential\/universal types +data Ex a + = forall b . C b => Ex1 b + | forall b . Ex2 b + | forall b . C a => Ex3 b -- NOTE: I have added "forall b" here make GHC accept this file + | Ex4 (forall a . a -> a) + +-- | This is a function with documentation for each argument +k :: 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 + -- hopefully cause some wrapping to happen when it is finally + -- rendered by Haddock in the generated HTML page. + -> IO () -- ^ This is the result type + +-- This function has arg docs but no docs for the function itself +l :: (Int, Int, Float) -- ^ takes a triple + -> Int -- ^ returns an 'Int' + +-- | This function has some arg docs +m :: R + -> N1 () -- ^ one of the arguments + -> IO Int -- ^ and the return value + +-- | This function has some arg docs but not a return value doc + +-- can't use the original name ('n') with GHC +newn :: R -- ^ one of the arguments, an 'R' + -> N1 () -- ^ one of the arguments + -> IO Int +newn = undefined + + +-- | A foreign import with argument docs +foreign import ccall unsafe "header.h" + o :: Float -- ^ The input float + -> IO Float -- ^ The output float + +-- | We should be able to escape this: \#\#\# + +-- p :: Int +-- can't use the above original definition with GHC +newp :: Int +newp = undefined + +-- | a function with a prime can be referred to as 'f'' +-- but f' doesn't get link'd 'f\'' +f' :: Int + + +-- Add some definitions here so that this file can be compiled with GHC + +data T1 +f = undefined +f' = undefined +type CInt = Int +k = undefined +l = undefined +m = undefined diff --git a/tests/examples/ghc92/Haddock1.hs b/tests/examples/ghc92/Haddock1.hs new file mode 100644 index 00000000..4dc7c928 --- /dev/null +++ b/tests/examples/ghc92/Haddock1.hs @@ -0,0 +1,39 @@ +{-# OPTIONS_GHC -fno-warn-redundant-constraints -haddock #-} +-- | Haddock comment, +-- coming before the module +module Haddock1 ( + + -- | 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). + f + + {-| nested-style doc comments -} + , g + + {-| nested-style doc comments, + multi-line + -} + , h + + -- * A section + -- and without an intervening comma: + -- ** A subsection + ) where + +-- | Haddock before imports +import Data.List + +-- | Haddock before decl +f = undefined +g = undefined +h = undefined + +-- | This comment applies to the /following/ declaration +-- and it continues until the next non-comment line +data T a b + = A Int (Maybe Float) -- ^ This comment describes the 'A' constructor + | -- | This comment describes the 'B' constructor + B (T a b, T Int Float) -- ^