aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs19
-rw-r--r--haddock-api/src/Haddock/Interface/LexParseRn.hs35
-rw-r--r--haddock-api/src/Haddock/Interface/ParseModuleHeader.hs2
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs5
4 files changed, 28 insertions, 33 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 00c119fa..2ed25542 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -14,7 +14,7 @@
-----------------------------------------------------------------------------
module Haddock.Interface.Create (createInterface) where
-import Documentation.Haddock.Doc (docAppend)
+import Documentation.Haddock.Doc (metaDocAppend)
import Haddock.Types
import Haddock.Options
import Haddock.GhcUtils
@@ -256,19 +256,19 @@ mkMaps dflags gre instances decls =
f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
f = M.fromListWith (<>) . concat
- f' :: [[(Name, Doc Name)]] -> Map Name (Doc Name)
- f' = M.fromListWith docAppend . concat
+ f' :: [[(Name, MDoc Name)]] -> Map Name (MDoc Name)
+ f' = M.fromListWith metaDocAppend . concat
mappings :: (LHsDecl Name, [HsDocString])
- -> ( [(Name, Doc Name)]
- , [(Name, Map Int (Doc Name))]
+ -> ( [(Name, MDoc Name)]
+ , [(Name, Map Int (MDoc Name))]
, [(Name, [Name])]
, [(Name, [LHsDecl Name])]
)
mappings (ldecl, docStrs) =
let L l decl = ldecl
declDoc :: [HsDocString] -> Map Int HsDocString
- -> (Maybe (Doc Name), Map Int (Doc Name))
+ -> (Maybe (MDoc Name), Map Int (MDoc Name))
declDoc strs m =
let doc' = processDocStrings dflags gre strs
m' = M.map (processDocStringParas dflags gre) m
@@ -641,7 +641,8 @@ hiValExportItem dflags name doc splice fixity = do
-- | Lookup docs for a declaration from maps.
-lookupDocs :: Name -> WarningMap -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
+lookupDocs :: Name -> WarningMap -> DocMap Name -> ArgMap Name -> SubMap
+ -> (DocForDecl Name, [(Name, DocForDecl Name)])
lookupDocs n warnings docMap argMap subMap =
let lookupArgDoc x = M.findWithDefault M.empty x argMap in
let doc = (lookupDoc n, lookupArgDoc n) in
@@ -731,8 +732,8 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
expandSig = foldr f []
where
f :: LHsDecl name -> [LHsDecl name] -> [LHsDecl name]
- f (L l (SigD (TypeSig names t))) xs = foldr (\n acc -> L l (SigD (TypeSig [n] t)) : acc) xs names
- f (L l (SigD (GenericSig names t))) xs = foldr (\n acc -> L l (SigD (GenericSig [n] t)) : acc) xs names
+ f (L l (SigD (TypeSig names t))) xs = foldr (\n acc -> L l (SigD (TypeSig [n] t)) : acc) xs names
+ f (L l (SigD (GenericSig names t))) xs = foldr (\n acc -> L l (SigD (GenericSig [n] t)) : acc) xs names
f x xs = x : xs
mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name))
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index f1021436..35abf8a6 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -21,7 +21,7 @@ module Haddock.Interface.LexParseRn
import Control.Applicative
import Data.IntSet (toList)
import Data.List
-import Documentation.Haddock.Doc (docConcat)
+import Documentation.Haddock.Doc (metaDocConcat)
import DynFlags (ExtensionFlag(..), languageExtensions)
import FastString
import GHC
@@ -32,31 +32,26 @@ import Name
import Outputable (showPpr)
import RdrName
-processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Maybe (Doc Name)
+processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString]
+ -> Maybe (MDoc Name)
processDocStrings dflags gre strs =
- case docConcat $ map (processDocStringParas dflags gre) strs of
- DocEmpty -> Nothing
+ case metaDocConcat $ map (processDocStringParas dflags gre) strs of
+ -- We check that we don't have any version info to render instead
+ -- of just checking if there is no comment: there may not be a
+ -- comment but we still want to pass through any meta data.
+ MetaDoc { _meta = Meta { _version = Nothing }, _doc = DocEmpty } -> Nothing
x -> Just x
-
-processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name
-processDocStringParas = process parseParas
-
+processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> MDoc Name
+processDocStringParas dflags gre (HsDocString fs) =
+ overDoc (rename dflags gre) $ parseParas dflags (unpackFS fs)
processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name
-processDocString = process parseString
-
-process :: (DynFlags -> String -> Doc RdrName)
- -> DynFlags
- -> GlobalRdrEnv
- -> HsDocString
- -> Doc Name
-process parse dflags gre (HsDocString fs) =
- rename dflags gre $ parse dflags (unpackFS fs)
-
+processDocString dflags gre (HsDocString fs) =
+ rename dflags gre $ parseString dflags (unpackFS fs)
processModuleHeader :: DynFlags -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString
- -> ErrMsgM (HaddockModInfo Name, Maybe (Doc Name))
+ -> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))
processModuleHeader dflags gre safety mayStr = do
(hmi, doc) <-
case mayStr of
@@ -66,7 +61,7 @@ processModuleHeader dflags gre safety mayStr = do
(hmi, doc) = parseModuleHeader dflags str
!descr = rename dflags gre <$> hmi_description hmi
hmi' = hmi { hmi_description = descr }
- doc' = rename dflags gre doc
+ doc' = overDoc (rename dflags gre) doc
return (hmi', Just doc')
let flags :: [ExtensionFlag]
diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
index 6848dc63..d92e8b2a 100644
--- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
@@ -25,7 +25,7 @@ import RdrName
-- NB. The headers must be given in the order Module, Description,
-- Copyright, License, Maintainer, Stability, Portability, except that
-- any or all may be omitted.
-parseModuleHeader :: DynFlags -> String -> (HaddockModInfo RdrName, Doc RdrName)
+parseModuleHeader :: DynFlags -> String -> (HaddockModInfo RdrName, MDoc RdrName)
parseModuleHeader dflags str0 =
let
getKey :: String -> String -> (Maybe String,String)
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 748e0210..277d6ca9 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -12,7 +12,7 @@
module Haddock.Interface.Rename (renameInterface) where
-import Data.Traversable (traverse)
+import Data.Traversable (traverse, Traversable)
import Haddock.GhcUtils
import Haddock.Types
@@ -160,10 +160,9 @@ renameLDocHsSyn :: LHsDocString -> RnM LHsDocString
renameLDocHsSyn = return
-renameDoc :: Doc Name -> RnM (Doc DocName)
+renameDoc :: Traversable t => t Name -> RnM (t DocName)
renameDoc = traverse rename
-
renameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName)
renameFnArgsDoc = mapM renameDoc
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 08:36:27 +0000