From dd47029cb29c80b1ab4db520c9c2ce4dca37f833 Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
Date: Thu, 19 Jul 2018 11:42:26 -0700
Subject: 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)
---
 .../src/Documentation/Haddock/Parser.hs            | 22 ++++++++++++++--------
 haddock-library/src/Documentation/Haddock/Types.hs | 10 ++++++++++
 2 files changed, 24 insertions(+), 8 deletions(-)

(limited to 'haddock-library/src/Documentation/Haddock')

diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 82d65a0a..e9b1c496 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -28,6 +28,7 @@ import           Control.Applicative
 import           Control.Arrow (first)
 import           Control.Monad
 import           Data.Char (chr, isUpper, isAlpha, isAlphaNum, isSpace)
+import           Data.Foldable (asum)
 import           Data.List (intercalate, unfoldr, elemIndex)
 import           Data.Maybe (fromMaybe, mapMaybe)
 import           Data.Monoid
@@ -75,24 +76,24 @@ isSymbolChar c = not (isPuncChar c) && case generalCategory c of
 #endif
 
 -- | Identifier string surrounded with opening and closing quotes/backticks.
-type Identifier = (Char, String, Char)
+data Identifier = Identifier !Namespace !Char String !Char
 
 -- | Drops the quotes/backticks around all identifiers, as if they
 -- were valid but still 'String's.
 toRegular :: DocH mod Identifier -> DocH mod String
-toRegular = fmap (\(_, x, _) -> x)
+toRegular = fmap (\(Identifier _ _ x _) -> x)
 
 -- | Maps over 'DocIdentifier's over 'String' with potentially failing
 -- conversion using user-supplied function. If the conversion fails,
 -- the identifier is deemed to not be valid and is treated as a
 -- regular string.
-overIdentifier :: (String -> Maybe a)
+overIdentifier :: (Namespace -> String -> Maybe a)
                -> DocH mod Identifier
                -> DocH mod a
 overIdentifier f d = g d
   where
-    g (DocIdentifier (o, x, e)) = case f x of
-      Nothing -> DocString $ o : x ++ [e]
+    g (DocIdentifier (Identifier ns o x e)) = case f ns x of
+      Nothing -> DocString $ renderNs ns ++ [o] ++ x ++ [e]
       Just x' -> DocIdentifier x'
     g DocEmpty = DocEmpty
     g (DocAppend x x') = DocAppend (g x) (g x')
@@ -314,7 +315,8 @@ markdownImage :: Parser (DocH mod Identifier)
 markdownImage = DocPic . fromHyperlink <$> ("!" *> linkParser)
   where
     fromHyperlink (Hyperlink u l) = Picture u (fmap (markup stringMarkup) l)
-    stringMarkup = plainMarkup (const "") (\(l,c,r) -> [l] <> c <> [r])
+    stringMarkup = plainMarkup (const "") renderIdent
+    renderIdent (Identifier ns l c r) = renderNs ns <> [l] <> c <> [r]
 
 -- | Paragraph parser, called by 'parseParas'.
 paragraph :: Parser (DocH mod Identifier)
@@ -857,9 +859,13 @@ parseValid = p some
 -- 'String' from the string it deems valid.
 identifier :: Parser (DocH mod Identifier)
 identifier = do
+  ns <- asum [ Value <$ Parsec.char 'v'
+             , Type <$ Parsec.char 't'
+             , pure None
+             ]
   o <- idDelim
   vid <- parseValid
   e <- idDelim
-  return $ DocIdentifier (o, vid, e)
+  return $ DocIdentifier (Identifier ns o vid e)
   where
-    idDelim = Parsec.satisfy (\c -> c == '\'' || c == '`')
+    idDelim = Parsec.oneOf "'`"
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index f8f7d353..ba2f873c 100644
--- a/haddock-library/src/Documentation/Haddock/Types.hs
+++ b/haddock-library/src/Documentation/Haddock/Types.hs
@@ -203,6 +203,16 @@ instance Bitraversable DocH where
   bitraverse f g (DocTable (Table header body)) = (\h b -> DocTable (Table h b)) <$> traverse (traverse (bitraverse f g)) header <*> traverse (traverse (bitraverse f g)) body
 #endif
 
+-- | The namespace qualification for an identifier.
+data Namespace = Value | Type | None deriving (Eq, Ord, Enum, Show)
+
+-- | Render the a namespace into the same format it was initially parsed.
+renderNs :: Namespace -> String
+renderNs Value = "v"
+renderNs Type = "t"
+renderNs None = ""
+
+
 -- | 'DocMarkupH' is a set of instructions for marking up documentation.
 -- In fact, it's really just a mapping from 'Doc' to some other
 -- type [a], where [a] is usually the type of the output (HTML, say).
-- 
cgit v1.2.3