aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2018-07-19 11:42:26 -0700
committerAlec Theriault <alec.theriault@gmail.com>2019-02-25 00:42:41 -0800
commitdd47029cb29c80b1ab4db520c9c2ce4dca37f833 (patch)
tree2721b449e96244729c8764e3c39841f1c30f6d53 /haddock-api/src/Haddock
parent44226fc06adfe66a1d9e63b142374710e482a4e1 (diff)
Support value/type namespaces on identifier links
Identifier links can be prefixed with a 'v' or 't' to indicate the value or type namespace of the desired identifier. For example: -- | Some link to a value: v'Data.Functor.Identity' -- -- Some link to a type: t'Data.Functor.Identity' The default is still the type (with a warning about the ambiguity)
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r--haddock-api/src/Haddock/Interface/LexParseRn.hs55
-rw-r--r--haddock-api/src/Haddock/Interface/ParseModuleHeader.hs3
-rw-r--r--haddock-api/src/Haddock/Parser.hs13
-rw-r--r--haddock-api/src/Haddock/Types.hs6
4 files changed, 56 insertions, 21 deletions
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 59ad4fdf..66083cf5 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -34,8 +34,8 @@ import Haddock.Types
import Name
import Outputable ( showPpr, showSDoc )
import RdrName
+import RdrHsSyn (setRdrNameSpace)
import EnumSet
-import RnEnv (dataTcOccs)
processDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString]
-> ErrMsgM (Maybe (MDoc Name))
@@ -89,24 +89,37 @@ processModuleHeader dflags pkgName gre safety mayStr = do
-- fallbacks in case we can't locate the identifiers.
--
-- See the comments in the source for implementation commentary.
-rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> ErrMsgM (Doc Name)
+rename :: DynFlags -> GlobalRdrEnv -> Doc NsRdrName -> ErrMsgM (Doc Name)
rename dflags gre = rn
where
rn d = case d of
DocAppend a b -> DocAppend <$> rn a <*> rn b
DocParagraph doc -> DocParagraph <$> rn doc
- DocIdentifier x -> do
+ DocIdentifier (NsRdrName ns x) -> do
+ let occ = rdrNameOcc x
+ isValueName = isDataOcc occ || isVarOcc occ
+
+ let valueNsChoices | isValueName = [x]
+ | otherwise = [] -- is this ever possible?
+ typeNsChoices | isValueName = [setRdrNameSpace x tcName]
+ | otherwise = [x]
+
-- Generate the choices for the possible kind of thing this
- -- is.
- let choices = dataTcOccs x
+ -- is. We narrow down the possibilities with the namespace (if
+ -- there is one).
+ let choices = case ns of
+ Value -> valueNsChoices
+ Type -> typeNsChoices
+ None -> valueNsChoices ++ typeNsChoices
-- Lookup any GlobalRdrElts that match the choices.
case concatMap (\c -> lookupGRE_RdrName c gre) choices of
-- We found no names in the env so we start guessing.
[] ->
case choices of
- -- This shouldn't happen as 'dataTcOccs' always returns at least its input.
- [] -> pure (DocMonospaced (DocString (showPpr dflags x)))
+ -- The only way this can happen is if a value namespace was
+ -- specified on something that cannot be a value.
+ [] -> invalidValue dflags x
-- There was nothing in the environment so we need to
-- pick some default from what's available to us. We
@@ -116,7 +129,7 @@ rename dflags gre = rn
-- type constructor names (such as in #253). So now we
-- only get type constructor links if they are actually
-- in scope.
- a:_ -> outOfScope dflags a
+ a:_ -> outOfScope dflags ns a
-- There is only one name in the environment that matches so
-- use it.
@@ -155,17 +168,23 @@ rename dflags gre = rn
-- users shouldn't rely on this doing the right thing. See tickets
-- #253 and #375 on the confusion this causes depending on which
-- default we pick in 'rename'.
-outOfScope :: DynFlags -> RdrName -> ErrMsgM (Doc a)
-outOfScope dflags x =
+outOfScope :: DynFlags -> Namespace -> RdrName -> ErrMsgM (Doc a)
+outOfScope dflags ns x =
case x of
Unqual occ -> warnAndMonospace occ
Qual mdl occ -> pure (DocIdentifierUnchecked (mdl, occ))
Orig _ occ -> warnAndMonospace occ
Exact name -> warnAndMonospace name -- Shouldn't happen since x is out of scope
where
+ prefix = case ns of
+ Value -> "the value "
+ Type -> "the type "
+ None -> ""
+
warnAndMonospace a = do
- tell ["Warning: '" ++ showPpr dflags a ++ "' is out of scope.\n" ++
- " If you qualify the identifier, haddock can try to link it anyway."]
+ tell ["Warning: " ++ prefix ++ "'" ++ showPpr dflags a ++ "' is out of scope.\n" ++
+ " If you qualify the identifier, haddock can try to link it\n" ++
+ " it anyway."]
pure (monospaced a)
monospaced a = DocMonospaced (DocString (showPpr dflags a))
@@ -184,7 +203,7 @@ ambiguous dflags x gres = do
msg = "Warning: " ++ x_str ++ " is ambiguous. It is defined\n" ++
concatMap (\n -> " * " ++ defnLoc n ++ "\n") (map gre_name gres) ++
" You may be able to disambiguate the identifier by qualifying it or\n" ++
- " by hiding some imports.\n" ++
+ " by specifying the type/value namespace explicitly.\n" ++
" Defaulting to " ++ x_str ++ " defined " ++ defnLoc dflt
-- TODO: Once we have a syntax for namespace qualification (#667) we may also
-- want to emit a warning when an identifier is a data constructor for a type
@@ -198,3 +217,13 @@ ambiguous dflags x gres = do
isLocalName _ = False
x_str = '\'' : showPpr dflags x ++ "'"
defnLoc = showSDoc dflags . pprNameDefnLoc
+
+-- | Handle value-namespaced names that cannot be for values.
+--
+-- Emits a warning that the value-namespace is invalid on a non-value identifier.
+invalidValue :: DynFlags -> RdrName -> ErrMsgM (Doc a)
+invalidValue dflags x = do
+ tell ["Warning: '" ++ showPpr dflags x ++ "' cannot be value, yet it is\n" ++
+ " namespaced as such. Did you mean to specify a type namespace\n" ++
+ " instead?"]
+ pure (DocMonospaced (DocString (showPpr dflags x)))
diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
index 050901b6..802ea773 100644
--- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
@@ -16,7 +16,6 @@ import Data.Char
import DynFlags
import Haddock.Parser
import Haddock.Types
-import RdrName
-- -----------------------------------------------------------------------------
-- Parsing module headers
@@ -24,7 +23,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 -> Maybe Package -> String -> (HaddockModInfo RdrName, MDoc RdrName)
+parseModuleHeader :: DynFlags -> Maybe Package -> String -> (HaddockModInfo NsRdrName, MDoc NsRdrName)
parseModuleHeader dflags pkgName str0 =
let
getKey :: String -> String -> (Maybe String,String)
diff --git a/haddock-api/src/Haddock/Parser.hs b/haddock-api/src/Haddock/Parser.hs
index e31ea6a8..8b7dda7c 100644
--- a/haddock-api/src/Haddock/Parser.hs
+++ b/haddock-api/src/Haddock/Parser.hs
@@ -15,26 +15,27 @@ module Haddock.Parser ( parseParas
import qualified Documentation.Haddock.Parser as P
import Documentation.Haddock.Types
+import Haddock.Types (NsRdrName(..))
import DynFlags ( DynFlags )
import FastString ( fsLit )
import Lexer ( mkPState, unP, ParseResult(POk) )
import Parser ( parseIdentifier )
import RdrName ( RdrName )
-import SrcLoc ( mkRealSrcLoc, unLoc )
+import SrcLoc ( mkRealSrcLoc, GenLocated(..) )
import StringBuffer ( stringToStringBuffer )
-parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod RdrName
+parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod NsRdrName
parseParas d p = overDoc (P.overIdentifier (parseIdent d)) . P.parseParas p
-parseString :: DynFlags -> String -> DocH mod RdrName
+parseString :: DynFlags -> String -> DocH mod NsRdrName
parseString d = P.overIdentifier (parseIdent d) . P.parseString
-parseIdent :: DynFlags -> String -> Maybe RdrName
-parseIdent dflags str0 =
+parseIdent :: DynFlags -> Namespace -> String -> Maybe NsRdrName
+parseIdent dflags ns str0 =
let buffer = stringToStringBuffer str0
realSrcLc = mkRealSrcLoc (fsLit "<unknown file>") 0 0
pstate = mkPState dflags buffer realSrcLc
in case unP parseIdentifier pstate of
- POk _ name -> Just (unLoc name)
+ POk _ (L _ name) -> Just (NsRdrName ns name)
_ -> Nothing
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index a4ef5f82..e8da4120 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -284,6 +284,12 @@ noDocForDecl = (Documentation Nothing Nothing, mempty)
-- | Type of environment used to cross-reference identifiers in the syntax.
type LinkEnv = Map Name Module
+-- | An 'RdrName' tagged with some type/value namespace information.
+data NsRdrName = NsRdrName
+ { namespace :: !Namespace
+ , rdrName :: !RdrName
+ }
+
-- | Extends 'Name' with cross-reference information.
data DocName
= Documented Name Module