diff options
Diffstat (limited to 'haddock-library/src')
| -rw-r--r-- | haddock-library/src/CompatPrelude.hs | 52 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser.hs | 104 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser/Identifier.hs | 160 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser/Monad.hs | 16 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser/Util.hs | 14 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Types.hs | 20 | 
6 files changed, 281 insertions, 85 deletions
| diff --git a/haddock-library/src/CompatPrelude.hs b/haddock-library/src/CompatPrelude.hs new file mode 100644 index 00000000..60fa94d9 --- /dev/null +++ b/haddock-library/src/CompatPrelude.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} + +#if !MIN_VERSION_base(4,5,0) +# error This module doesn't provide compat-shims for versions prior to base-4.5 +#endif + +-- | Bridge impedance mismatch of different @base@ versions back till @base-4.5@ (GHC 7.4.2) +module CompatPrelude +    ( ($>) +    , isSymbolChar +    ) where + +#if MIN_VERSION_base(4,7,0) +import           Data.Functor                ( ($>) ) +#else +import           Data.Functor                ( (<$) ) +#endif + +#if MIN_VERSION_base(4,9,0) +import           Text.Read.Lex                      (isSymbolChar) +#else +import           Data.Char (GeneralCategory(..), generalCategory) +#endif + + +#if !MIN_VERSION_base(4,7,0) +infixl 4 $> + +-- | Flipped version of '<$'. +-- +-- @since 4.7.0.0 +($>) :: Functor f => f a -> b -> f b +($>) = flip (<$) +#endif + +#if !MIN_VERSION_base(4,9,0) +-- inlined from base-4.10.0.0 +isSymbolChar :: Char -> Bool +isSymbolChar c = not (isPuncChar c) && case generalCategory c of +    MathSymbol           -> True +    CurrencySymbol       -> True +    ModifierSymbol       -> True +    OtherSymbol          -> True +    DashPunctuation      -> True +    OtherPunctuation     -> c `notElem` "'\"" +    ConnectorPunctuation -> c /= '_' +    _                    -> False +  where +    -- | The @special@ character class as defined in the Haskell Report. +    isPuncChar :: Char -> Bool +    isPuncChar = (`elem` (",;()[]{}`" :: String)) +#endif diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 82d65a0a..a3bba38a 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP               #-}  {-# LANGUAGE OverloadedStrings #-}  {-# LANGUAGE ViewPatterns      #-}  -- | @@ -27,7 +26,7 @@ module Documentation.Haddock.Parser (  import           Control.Applicative  import           Control.Arrow (first)  import           Control.Monad -import           Data.Char (chr, isUpper, isAlpha, isAlphaNum, isSpace) +import           Data.Char (chr, isUpper, isAlpha, isSpace)  import           Data.List (intercalate, unfoldr, elemIndex)  import           Data.Maybe (fromMaybe, mapMaybe)  import           Data.Monoid @@ -36,6 +35,7 @@ import           Documentation.Haddock.Doc  import           Documentation.Haddock.Markup ( markup, plainMarkup )  import           Documentation.Haddock.Parser.Monad  import           Documentation.Haddock.Parser.Util +import           Documentation.Haddock.Parser.Identifier  import           Documentation.Haddock.Types  import           Prelude hiding (takeWhile)  import qualified Prelude as P @@ -46,53 +46,26 @@ import           Text.Parsec (try)  import qualified Data.Text as T  import           Data.Text (Text) -#if MIN_VERSION_base(4,9,0) -import           Text.Read.Lex                      (isSymbolChar) -#else -import           Data.Char                          (GeneralCategory (..), -                                                     generalCategory) -#endif  -- $setup  -- >>> :set -XOverloadedStrings -#if !MIN_VERSION_base(4,9,0) --- inlined from base-4.10.0.0 -isSymbolChar :: Char -> Bool -isSymbolChar c = not (isPuncChar c) && case generalCategory c of -    MathSymbol           -> True -    CurrencySymbol       -> True -    ModifierSymbol       -> True -    OtherSymbol          -> True -    DashPunctuation      -> True -    OtherPunctuation     -> c `notElem` ("'\"" :: String) -    ConnectorPunctuation -> c /= '_' -    _                    -> False -  where -    -- | The @special@ character class as defined in the Haskell Report. -    isPuncChar :: Char -> Bool -    isPuncChar = (`elem` (",;()[]{}`" :: String)) -#endif - --- | Identifier string surrounded with opening and closing quotes/backticks. -type Identifier = (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') @@ -254,7 +227,7 @@ takeWhile1_ = mfilter (not . T.null) . takeWhile_  -- DocAName "Hello world"  anchor :: Parser (DocH mod a)  anchor = DocAName . T.unpack <$> -         disallowNewline ("#" *> takeWhile1_ (/= '#') <* "#") +         ("#" *> takeWhile1_ (\x -> x /= '#' && not (isSpace x)) <* "#")  -- | Monospaced strings.  -- @@ -269,12 +242,18 @@ monospace = DocMonospaced . parseParagraph  -- Note that we allow '#' and '\' to support anchors (old style anchors are of  -- the form "SomeModule\#anchor").  moduleName :: Parser (DocH mod a) -moduleName = DocModule <$> ("\"" *> modid <* "\"") +moduleName = DocModule <$> ("\"" *> (modid `maybeFollowedBy` anchor_) <* "\"")    where      modid = intercalate "." <$> conid `Parsec.sepBy1` "." +    anchor_ = (++) +      <$> (Parsec.string "#" <|> Parsec.string "\\#") +      <*> many (Parsec.satisfy (\c -> c /= '"' && not (isSpace c))) + +    maybeFollowedBy pre suf = (\x -> maybe x (x ++)) <$> pre <*> optional suf +      conid = (:)        <$> Parsec.satisfy (\c -> isAlpha c && isUpper c) -      <*> many (conChar <|> Parsec.oneOf "\\#") +      <*> many conChar      conChar = Parsec.alphaNum <|> Parsec.char '_' @@ -294,7 +273,7 @@ picture = DocPic . makeLabeled Picture  -- >>> parseString "\\(\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\)"  -- DocMathInline "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}"  mathInline :: Parser (DocH mod a) -mathInline = DocMathInline . T.unpack  +mathInline = DocMathInline . T.unpack               <$> disallowNewline  ("\\(" *> takeUntil "\\)")  -- | Display math parser, surrounded by \\[ and \\]. @@ -314,7 +293,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) @@ -518,7 +498,7 @@ tableStepFour rs hdrIndex cells =  case hdrIndex of      -- extract cell contents given boundaries      extract :: Int -> Int -> Int -> Int -> Text      extract x y x2 y2 = T.intercalate "\n" -        [ T.take (x2 - x + 1) $ T.drop x $ rs !! y' +        [ T.stripEnd $ T.stripStart $ T.take (x2 - x + 1) $ T.drop x $ rs !! y'          | y' <- [y .. y2]          ] @@ -538,11 +518,11 @@ since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince  header :: Parser (DocH mod Identifier)  header = do    let psers = map (string . flip T.replicate "=") [6, 5 .. 1] -      pser = choice' psers -  delim <- T.unpack <$> pser -  line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseText +      pser = Parsec.choice psers +  depth <- T.length <$> pser +  line <- parseText <$> (skipHorizontalSpace *> nonEmptyLine)    rest <- try paragraph <|> return DocEmpty -  return $ DocHeader (Header (length delim) line) `docAppend` rest +  return $ DocHeader (Header depth line) `docAppend` rest  textParagraph :: Parser (DocH mod Identifier)  textParagraph = parseText . T.intercalate "\n" <$> some nonEmptyLine @@ -605,7 +585,7 @@ definitionList indent = DocDefList <$> p          Right i -> (label, contents) : i  -- | Drops all trailing newlines. -dropNLs :: Text -> Text  +dropNLs :: Text -> Text  dropNLs = T.dropWhileEnd (== '\n')  -- | Main worker for 'innerList' and 'definitionList'. @@ -679,7 +659,7 @@ takeNonEmptyLine = do  --  -- More precisely: skips all whitespace-only lines and returns indentation  -- (horizontal space, might be empty) of that non-empty line. -takeIndent :: Parser Text  +takeIndent :: Parser Text  takeIndent = do    indent <- takeHorizontalSpace    choice' [ "\n" *> takeIndent @@ -737,14 +717,14 @@ examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go)          substituteBlankLine "<BLANKLINE>" = ""          substituteBlankLine xs = xs -nonEmptyLine :: Parser Text  +nonEmptyLine :: Parser Text  nonEmptyLine = try (mfilter (T.any (not . isSpace)) takeLine)  takeLine :: Parser Text  takeLine = try (takeWhile (/= '\n') <* endOfLine)  endOfLine :: Parser () -endOfLine = void "\n" <|> Parsec.eof  +endOfLine = void "\n" <|> Parsec.eof  -- | Property parser.  -- @@ -826,7 +806,7 @@ autoUrl :: Parser (DocH mod a)  autoUrl = mkLink <$> url    where      url = mappend <$> choice' [ "http://", "https://", "ftp://"] <*> takeWhile1 (not . isSpace) -     +      mkLink :: Text -> DocH mod a      mkLink s = case T.unsnoc s of        Just (xs,x) | x `elem` (",.!?" :: String) -> DocHyperlink (mkHyperlink xs) `docAppend` DocString [x] @@ -836,30 +816,6 @@ autoUrl = mkLink <$> url      mkHyperlink lnk = Hyperlink (T.unpack lnk) Nothing - --- | Parses strings between identifier delimiters. Consumes all input that it --- deems to be valid in an identifier. Note that it simply blindly consumes --- characters and does no actual validation itself. -parseValid :: Parser String -parseValid = p some -  where -    idChar = Parsec.satisfy (\c -> isAlphaNum c || isSymbolChar c || c == '_') - -    p p' = do -      vs <- p' idChar -      c <- peekChar' -      case c of -        '`' -> return vs -        '\'' -> choice' [ (\x -> vs ++ "'" ++ x) <$> ("'" *> p many), return vs ] -        _ -> fail "outofvalid" - --- | Parses identifiers with help of 'parseValid'. Asks GHC for --- 'String' from the string it deems valid. +-- | Parses identifiers with help of 'parseValid'.  identifier :: Parser (DocH mod Identifier) -identifier = do -  o <- idDelim -  vid <- parseValid -  e <- idDelim -  return $ DocIdentifier (o, vid, e) -  where -    idDelim = Parsec.satisfy (\c -> c == '\'' || c == '`') +identifier = DocIdentifier <$> parseValid diff --git a/haddock-library/src/Documentation/Haddock/Parser/Identifier.hs b/haddock-library/src/Documentation/Haddock/Parser/Identifier.hs new file mode 100644 index 00000000..b8afb951 --- /dev/null +++ b/haddock-library/src/Documentation/Haddock/Parser/Identifier.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module      :  Documentation.Haddock.Parser.Identifier +-- Copyright   :  (c) Alec Theriault 2019, +-- License     :  BSD-like +-- +-- Maintainer  :  haddock@projects.haskell.org +-- Stability   :  experimental +-- Portability :  portable +-- +-- Functionality for parsing identifiers and operators + +module Documentation.Haddock.Parser.Identifier ( +  Identifier(..), +  parseValid, +) where + +import Documentation.Haddock.Types           ( Namespace(..) ) +import Documentation.Haddock.Parser.Monad +import qualified Text.Parsec as Parsec +import           Text.Parsec.Pos             ( updatePosChar ) +import           Text.Parsec                 ( State(..) +                                             , getParserState, setParserState ) + +import Data.Text (Text) +import qualified Data.Text as T + +import           Data.Char (isAlpha, isAlphaNum) +import Control.Monad (guard) +import Data.Maybe +import CompatPrelude + +-- | Identifier string surrounded with namespace, opening, and closing quotes/backticks. +data Identifier = Identifier !Namespace !Char String !Char +  deriving (Show, Eq) + +parseValid :: Parser Identifier +parseValid = do +  s@State{ stateInput = inp, statePos = pos } <- getParserState + +  case takeIdentifier inp of +    Nothing -> Parsec.parserFail "parseValid: Failed to match a valid identifier" +    Just (ns, op, ident, cl, inp') -> +      let posOp = updatePosChar pos op +          posIdent = T.foldl updatePosChar posOp ident +          posCl = updatePosChar posIdent cl +          s' = s{ stateInput = inp', statePos = posCl } +      in setParserState s' $> Identifier ns op (T.unpack ident) cl + + +-- | Try to parse a delimited identifier off the front of the given input. +-- +-- This tries to match as many valid Haskell identifiers/operators as possible, +-- to the point of sometimes accepting invalid things (ex: keywords). Some +-- considerations: +-- +--   - operators and identifiers can have module qualifications +--   - operators can be wrapped in parens (for prefix) +--   - identifiers can be wrapped in backticks (for infix) +--   - delimiters are backticks or regular ticks +--   - since regular ticks are also valid in identifiers, we opt for the +--     longest successful parse +-- +-- This function should make /O(1)/ allocations +takeIdentifier :: Text -> Maybe (Namespace, Char, Text, Char, Text) +takeIdentifier input = listToMaybe $ do + +    -- Optional namespace +    let (ns, input') = case T.uncons input of +                         Just ('v', i) -> (Value, i) +                         Just ('t', i) -> (Type, i) +                         _             -> (None, input) + +    -- Opening tick +    (op, input'') <- maybeToList (T.uncons input') +    guard (op == '\'' || op == '`') + +    -- Identifier/operator +    (ident, input''') <- wrapped input'' + +    -- Closing tick +    (cl, input'''') <- maybeToList (T.uncons input''') +    guard (cl == '\'' || cl == '`') + +    return (ns, op, ident, cl, input'''') + +  where + +    -- | Parse out a wrapped, possibly qualified, operator or identifier +    wrapped t = do +      (c, t'  ) <- maybeToList (T.uncons t) +      -- Tuples +      case c of +        '(' | Just (c', _) <- T.uncons t' +            , c' == ',' || c' == ')' +            -> do let (commas, t'') = T.span (== ',') t' +                  (')', t''') <- maybeToList (T.uncons t'') +                  return (T.take (T.length commas + 2) t, t''') + +        -- Parenthesized +        '(' -> do (n,   t'' ) <- general False 0 [] t' +                  (')', t''') <- maybeToList (T.uncons t'') +                  return (T.take (n + 2) t, t''') + +        -- Backticked +        '`' -> do (n,   t'' ) <- general False 0 [] t' +                  ('`', t''') <- maybeToList (T.uncons t'') +                  return (T.take (n + 2) t, t''') + +        -- Unadorned +        _   -> do (n,   t'' ) <- general False 0 [] t +                  return (T.take n t, t'') + +    -- | Parse out a possibly qualified operator or identifier +    general :: Bool           -- ^ refuse inputs starting with operators +            -> Int            -- ^ total characters \"consumed\" so far +            -> [(Int, Text)]  -- ^ accumulated results +            -> Text           -- ^ current input +            -> [(Int, Text)]  -- ^ total characters parsed & what remains +    general !identOnly !i acc t +      -- Starts with an identifier (either just an identifier, or a module qual) +      | Just (n, rest) <- identLike t +      = if T.null rest +          then acc +          else case T.head rest of +                 '`' -> (n + i, rest) : acc +                 ')' -> (n + i, rest) : acc +                 '.' -> general False (n + i + 1) acc (T.tail rest) +                 '\'' -> let (m, rest') = quotes rest +                         in general True (n + m + 1 + i) ((n + m + i, rest') : acc) (T.tail rest') +                 _ -> acc + +      -- An operator +      | Just (n, rest) <- optr t +      , not identOnly +      = (n + i, rest) : acc + +      -- Anything else +      | otherwise +      = acc + +    -- | Parse an identifier off the front of the input +    identLike t +      | T.null t = Nothing +      | isAlpha (T.head t) || '_' == T.head t +      = let !(idt, rest) = T.span (\c -> isAlphaNum c || c == '_') t +            !(octos, rest') = T.span (== '#') rest +      in Just (T.length idt + T.length octos, rest') +      | otherwise = Nothing + +    -- | Parse all but the last quote off the front of the input +    -- PRECONDITION: T.head t == '\'' +    quotes :: Text -> (Int, Text) +    quotes t = let !n = T.length (T.takeWhile (== '\'') t) - 1 +               in (n, T.drop n t) + +    -- | Parse an operator off the front of the input +    optr t = let !(op, rest) = T.span isSymbolChar t +             in if T.null op then Nothing else Just (T.length op, rest) diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs index 8f5bd217..7c73a168 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs @@ -4,6 +4,18 @@  {-# LANGUAGE TypeFamilies #-}  {-# LANGUAGE BangPatterns #-}  {-# LANGUAGE TypeSynonymInstances #-} +-- | +-- Module      :  Documentation.Haddock.Parser.Monad +-- Copyright   :  (c) Alec Theriault 2018-2019, +-- License     :  BSD-like +-- +-- Maintainer  :  haddock@projects.haskell.org +-- Stability   :  experimental +-- Portability :  portable +-- +-- Defines the Parsec monad over which all parsing is done and also provides +-- more efficient versions of the usual parsec combinator functions (but +-- specialized to 'Text').  module Documentation.Haddock.Parser.Monad where @@ -17,7 +29,6 @@ import qualified Data.Text as T  import           Data.Text                   ( Text )  import           Control.Monad               ( mfilter ) -import           Data.Functor                ( ($>) )  import           Data.String                 ( IsString(..) )  import           Data.Bits                   ( Bits(..) )  import           Data.Char                   ( ord ) @@ -25,7 +36,9 @@ import           Data.List                   ( foldl' )  import           Control.Applicative as App  import           Documentation.Haddock.Types ( Version ) +  import           Prelude hiding (takeWhile) +import           CompatPrelude  -- | The only bit of information we really care about truding along with us  -- through parsing is the version attached to a @\@since@ annotation - if @@ -96,7 +109,6 @@ takeWhile f = do        s' = s{ stateInput = inp', statePos = pos' }    setParserState s' $> t -  -- | Like 'takeWhile', but fails if no characters matched.  --  -- Equivalent to @fmap T.pack . Parsec.many1@, but more efficient. diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs index 98570c22..eef744d8 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Util.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs @@ -31,16 +31,16 @@ import           Prelude hiding (takeWhile)  import           Data.Char (isSpace)  -- | Characters that count as horizontal space -horizontalSpace :: [Char] -horizontalSpace = " \t\f\v\r" +horizontalSpace :: Char -> Bool +horizontalSpace c = isSpace c && c /= '\n'  -- | Skip and ignore leading horizontal space  skipHorizontalSpace :: Parser () -skipHorizontalSpace = Parsec.skipMany (Parsec.oneOf horizontalSpace) +skipHorizontalSpace = Parsec.skipMany (Parsec.satisfy horizontalSpace)  -- | Take leading horizontal space -takeHorizontalSpace :: Parser Text  -takeHorizontalSpace = takeWhile (`elem` horizontalSpace) +takeHorizontalSpace :: Parser Text +takeHorizontalSpace = takeWhile horizontalSpace  makeLabeled :: (String -> Maybe String -> a) -> Text -> a  makeLabeled f input = case T.break isSpace $ removeEscapes $ T.strip input of @@ -60,10 +60,10 @@ removeEscapes = T.unfoldr go  -- | Consume characters from the input up to and including the given pattern.  -- Return everything consumed except for the end pattern itself. -takeUntil :: Text -> Parser Text  +takeUntil :: Text -> Parser Text  takeUntil end_ = T.dropEnd (T.length end_) <$> requireEnd (scan p (False, end)) >>= gotSome    where -    end = T.unpack end_  +    end = T.unpack end_      p :: (Bool, String) -> Char -> Maybe (Bool, String)      p acc c = case acc of diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index f8f7d353..12ccd28d 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -44,14 +44,17 @@ data MetaDoc mod id =            } deriving (Eq, Show, Functor, Foldable, Traversable)  #if MIN_VERSION_base(4,8,0) +-- | __NOTE__: Only defined for @base >= 4.8.0@  instance Bifunctor MetaDoc where    bimap f g (MetaDoc m d) = MetaDoc m (bimap f g d)  #endif  #if MIN_VERSION_base(4,10,0) +-- | __NOTE__: Only defined for @base >= 4.10.0@  instance Bifoldable MetaDoc where    bifoldr f g z d = bifoldr f g z (_doc d) +-- | __NOTE__: Only defined for @base >= 4.10.0@  instance Bitraversable MetaDoc where    bitraverse f g (MetaDoc m d) = MetaDoc m <$> bitraverse f g d  #endif @@ -76,7 +79,7 @@ data Picture = Picture    } deriving (Eq, Show)  data Header id = Header -  { headerLevel :: Int +  { headerLevel :: Int  -- ^ between 1 and 6 inclusive    , headerTitle :: id    } deriving (Eq, Show, Functor, Foldable, Traversable) @@ -123,7 +126,7 @@ data DocH mod id    | DocMathInline String    | DocMathDisplay String    | DocAName String -  -- ^ A (HTML) anchor. +  -- ^ A (HTML) anchor. It must not contain any spaces.    | DocProperty String    | DocExamples [Example]    | DocHeader (Header (DocH mod id)) @@ -131,6 +134,7 @@ data DocH mod id    deriving (Eq, Show, Functor, Foldable, Traversable)  #if MIN_VERSION_base(4,8,0) +-- | __NOTE__: Only defined for @base >= 4.8.0@  instance Bifunctor DocH where    bimap _ _ DocEmpty = DocEmpty    bimap f g (DocAppend docA docB) = DocAppend (bimap f g docA) (bimap f g docB) @@ -159,6 +163,7 @@ instance Bifunctor DocH where  #endif  #if MIN_VERSION_base(4,10,0) +-- | __NOTE__: Only defined for @base >= 4.10.0@  instance Bifoldable DocH where    bifoldr f g z (DocAppend docA docB) = bifoldr f g (bifoldr f g z docA) docB    bifoldr f g z (DocParagraph doc) = bifoldr f g z doc @@ -176,6 +181,7 @@ instance Bifoldable DocH where    bifoldr f g z (DocTable (Table header body)) = foldr (\r acc -> foldr (flip (bifoldr f g)) acc r) (foldr (\r acc -> foldr (flip (bifoldr f g)) acc r) z body) header    bifoldr _ _ z _ = z +-- | __NOTE__: Only defined for @base >= 4.10.0@  instance Bitraversable DocH where    bitraverse _ _ DocEmpty = pure DocEmpty    bitraverse f g (DocAppend docA docB) = DocAppend <$> bitraverse f g docA <*> bitraverse f g docB @@ -203,6 +209,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). | 
