aboutsummaryrefslogtreecommitdiff
path: root/haddock-library
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-library')
-rw-r--r--haddock-library/src/Documentation/Haddock/Markup.hs34
-rw-r--r--haddock-library/src/Documentation/Haddock/Parser.hs15
2 files changed, 44 insertions, 5 deletions
diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs
index b581a4d2..b44fef80 100644
--- a/haddock-library/src/Documentation/Haddock/Markup.hs
+++ b/haddock-library/src/Documentation/Haddock/Markup.hs
@@ -2,10 +2,13 @@
module Documentation.Haddock.Markup (
markup
, idMarkup
+ , plainMarkup
) where
import Documentation.Haddock.Types
+import Data.Maybe ( fromMaybe )
+
markup :: DocMarkupH mod id a -> DocH mod id -> a
markup m DocEmpty = markupEmpty m
markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2)
@@ -63,3 +66,34 @@ idMarkup = Markup {
markupHeader = DocHeader,
markupTable = DocTable
}
+
+-- | Map a 'DocH' into a best estimate of an alternate string. The idea is to
+-- strip away any formatting while preserving as much of the actual text as
+-- possible.
+plainMarkup :: (mod -> String) -> (id -> String) -> DocMarkupH mod id String
+plainMarkup plainMod plainIdent = Markup {
+ markupEmpty = "",
+ markupString = id,
+ markupParagraph = id,
+ markupAppend = (<>),
+ markupIdentifier = plainIdent,
+ markupIdentifierUnchecked = plainMod,
+ markupModule = id,
+ markupWarning = id,
+ markupEmphasis = id,
+ markupBold = id,
+ markupMonospaced = id,
+ markupUnorderedList = const "",
+ markupOrderedList = const "",
+ markupDefList = const "",
+ markupCodeBlock = id,
+ markupHyperlink = \(Hyperlink url lbl) -> fromMaybe url lbl,
+ markupAName = id,
+ markupPic = \(Picture uri title) -> fromMaybe uri title,
+ markupMathInline = id,
+ markupMathDisplay = id,
+ markupProperty = id,
+ markupExample = const "",
+ markupHeader = \(Header _ title) -> title,
+ markupTable = const ""
+ }
diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index fb815dd9..0992dbbc 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -33,6 +33,7 @@ import Data.Maybe (fromMaybe, mapMaybe)
import Data.Monoid
import qualified Data.Set as Set
import Documentation.Haddock.Doc
+import Documentation.Haddock.Markup ( markup, plainMarkup )
import Documentation.Haddock.Parser.Monad
import Documentation.Haddock.Parser.Util
import Documentation.Haddock.Types
@@ -301,15 +302,19 @@ mathInline = DocMathInline . T.unpack
-- >>> parseString "\\[\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\]"
-- DocMathDisplay "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}"
mathDisplay :: Parser (DocH mod a)
-mathDisplay = DocMathDisplay . T.unpack
+mathDisplay = DocMathDisplay . T.unpack
<$> ("\\[" *> takeUntil "\\]")
-markdownImage :: Parser (DocH mod a)
+-- | Markdown image parser. As per the commonmark reference recommendation, the
+-- description text for an image converted to its a plain string representation.
+--
+-- >>> parseString "![some /emphasis/ in a description](www.site.com)"
+-- DocPic (Picture "www.site.com" (Just "some emphasis in a description"))
+markdownImage :: Parser (DocH mod Identifier)
markdownImage = DocPic . fromHyperlink <$> ("!" *> linkParser)
where
- fromHyperlink (Hyperlink url Nothing) = Picture url Nothing
- fromHyperlink (Hyperlink url (Just (DocString s))) = Picture url (Just s)
- -- TODO partial ^
+ fromHyperlink (Hyperlink u l) = Picture u (fmap (markup stringMarkup) l)
+ stringMarkup = plainMarkup (const "") (\(l,c,r) -> [l] <> c <> [r])
-- | Paragraph parser, called by 'parseParas'.
paragraph :: Parser (DocH mod Identifier)