aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/src/Documentation/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-library/src/Documentation/Haddock')
-rw-r--r--haddock-library/src/Documentation/Haddock/Parser.hs22
-rw-r--r--haddock-library/src/Documentation/Haddock/Types.hs10
2 files changed, 24 insertions, 8 deletions
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).