diff options
Diffstat (limited to 'haddock-library')
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser.hs | 22 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Types.hs | 10 | ||||
| -rw-r--r-- | haddock-library/test/Documentation/Haddock/ParserSpec.hs | 6 | 
3 files changed, 30 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). diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index 6269184a..e186a5cf 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -132,6 +132,12 @@ spec = do        it "can parse an identifier that starts with an underscore" $ do          "'_x'" `shouldParseTo` DocIdentifier "_x" +      it "can parse value-namespaced identifiers" $ do +        "v'foo'" `shouldParseTo` DocIdentifier "foo" + +      it "can parse type-namespaced identifiers" $ do +        "t'foo'" `shouldParseTo` DocIdentifier "foo" +      context "when parsing operators" $ do        it "can parse an operator enclosed within single quotes" $ do          "'.='" `shouldParseTo` DocIdentifier ".="  | 
