git.iko.soy/typeable/pandoc
on master help sign in
Rewrote haddock reader to use haddock-library.

This brings pandoc's rendering of haddock markup in line with the new haddock. Note that we preserve line breaks in `@` code blocks, unlike the earlier version. Modified tests pass. More tests would be good.

commit9fc5c8d7af31a47d8e3e8ea6dbb541178ec9ca66 authorJohn MacFarlane <jgm@berkeley.edu> dateWed 18 Jun 2014, 12:27 (12 years ago) parenta78d8b8
3 files changed+115−35
compare with master
unifiedsplit
src/Text/Pandoc/Readers/Haddock.hs+102−22 tests/haddock-reader.haddock+10−10 tests/haddock-reader.native+3−3
src/Text/Pandoc/Readers/Haddock.hs+102−22
@@ -15,10 +15,13 @@ module Text.Pandoc.Readers.Haddock
1515
1616import Text.Pandoc.Builder (Blocks, Inlines)
1717import qualified Text.Pandoc.Builder as B
18+import Text.Pandoc.Shared (trim, splitBy)
1819import Data.Monoid
20+import Data.List (intersperse, stripPrefix)
21+import Data.Maybe (fromMaybe)
1922import Text.Pandoc.Definition
2023import Text.Pandoc.Options
21−import Documentation.Haddock.Parser (parseParas, Identifier)
24+import Documentation.Haddock.Parser
2225import Documentation.Haddock.Types
2326
2427-- | Parse Haddock markup and return a 'Pandoc' document.
@@ -27,25 +30,102 @@ readHaddock :: ReaderOptions -- ^ Reader options
2730 -> Pandoc
2831readHaddock _ = B.doc . docHToBlocks . parseParas
2932
30−docHToBlocks :: DocH mod Identifier -> Blocks
31−docHToBlocks d =
32− case d of
33+docHToBlocks :: DocH String Identifier -> Blocks
34+docHToBlocks d' =
35+ case d' of
36+ DocEmpty -> mempty
3337 DocAppend d1 d2 -> mappend (docHToBlocks d1) (docHToBlocks d2)
34− DocParagraph ils -> B.para $ docHToInlines ils
35−
36−docHToInlines :: DocH mod Identifier -> Inlines
37−docHToInlines d =
38− case d of
39− DocAppend d1 d2 -> mappend (docHToInlines d1) (docHToInlines d2)
40− DocString s -> B.text s
41−
42−-- similar to 'docAppend' in Haddock.Doc
43−mergeLists :: [Block] -> [Block]
44−mergeLists (BulletList xs : BulletList ys : blocks)
45− = mergeLists (BulletList (xs ++ ys) : blocks)
46−mergeLists (OrderedList _ xs : OrderedList a ys : blocks)
47− = mergeLists (OrderedList a (xs ++ ys) : blocks)
48−mergeLists (DefinitionList xs : DefinitionList ys : blocks)
49− = mergeLists (DefinitionList (xs ++ ys) : blocks)
50−mergeLists (x : blocks) = x : mergeLists blocks
51−mergeLists [] = []
38+ DocString _ -> inlineFallback
39+ DocParagraph ils -> B.para $ docHToInlines False ils
40+ DocIdentifier _ -> inlineFallback
41+ DocIdentifierUnchecked _ -> inlineFallback
42+ DocModule s -> B.plain $ docHToInlines False $ DocModule s
43+ DocWarning _ -> mempty -- TODO
44+ DocEmphasis _ -> inlineFallback
45+ DocMonospaced _ -> inlineFallback
46+ DocBold _ -> inlineFallback
47+ DocHeader h -> B.header (headerLevel h)
48+ (docHToInlines False $ headerTitle h)
49+ DocUnorderedList items -> B.bulletList (map docHToBlocks items)
50+ DocOrderedList items -> B.orderedList (map docHToBlocks items)
51+ DocDefList items -> B.definitionList (map (\(d,t) ->
52+ (docHToInlines False d,
53+ [consolidatePlains $ docHToBlocks t])) items)
54+ DocCodeBlock (DocString s) -> B.codeBlockWith ("",["haskell"],[]) s
55+ DocCodeBlock d -> B.para $ docHToInlines True d
56+ DocHyperlink _ -> inlineFallback
57+ DocPic _ -> inlineFallback
58+ DocAName _ -> inlineFallback
59+ DocProperty s -> B.codeBlockWith ("",["property","haskell"],[]) (trim s)
60+ DocExamples es -> mconcat $ map (\e ->
61+ makeExample ">>>" (exampleExpression e) (exampleResult e)) es
62+
63+ where inlineFallback = B.plain $ docHToInlines False d'
64+ consolidatePlains = B.fromList . consolidatePlains' . B.toList
65+ consolidatePlains' zs@(Plain _ : _) =
66+ let (xs, ys) = span isPlain zs in
67+ Plain (concatMap extractContents xs) : consolidatePlains' ys
68+ consolidatePlains' (x : xs) = x : consolidatePlains' xs
69+ consolidatePlains' [] = []
70+ isPlain (Plain _) = True
71+ isPlain _ = False
72+ extractContents (Plain xs) = xs
73+ extractContents _ = []
74+
75+docHToInlines :: Bool -> DocH String Identifier -> Inlines
76+docHToInlines isCode d' =
77+ case d' of
78+ DocEmpty -> mempty
79+ DocAppend d1 d2 -> mappend (docHToInlines isCode d1)
80+ (docHToInlines isCode d2)
81+ DocString s
82+ | isCode -> mconcat $ intersperse B.linebreak
83+ $ map B.code $ splitBy (=='\n') s
84+ | otherwise -> B.text s
85+ DocParagraph _ -> mempty
86+ DocIdentifier (_,s,_) -> B.codeWith ("",["haskell"],[]) s
87+ DocIdentifierUnchecked s -> B.codeWith ("",["haskell"],[]) s
88+ DocModule s -> B.codeWith ("",["haskell"],[]) s
89+ DocWarning _ -> mempty -- TODO
90+ DocEmphasis d -> B.emph (docHToInlines isCode d)
91+ DocMonospaced (DocString s) -> B.code s
92+ DocMonospaced d -> docHToInlines True d
93+ DocBold d -> B.strong (docHToInlines isCode d)
94+ DocHeader _ -> mempty
95+ DocUnorderedList _ -> mempty
96+ DocOrderedList _ -> mempty
97+ DocDefList _ -> mempty
98+ DocCodeBlock _ -> mempty
99+ DocHyperlink h -> B.link (hyperlinkUrl h) (hyperlinkUrl h)
100+ (maybe (B.text $ hyperlinkUrl h) B.text $ hyperlinkLabel h)
101+ DocPic p -> B.image (pictureUri p) (fromMaybe (pictureUri p) $ pictureTitle p)
102+ (maybe mempty B.text $ pictureTitle p)
103+ DocAName s -> B.spanWith (s,["anchor"],[]) mempty
104+ DocProperty _ -> mempty
105+ DocExamples _ -> mempty
106+
107+-- | Create an 'Example', stripping superfluous characters as appropriate
108+makeExample :: String -> String -> [String] -> Blocks
109+makeExample prompt expression result =
110+ B.para $ B.codeWith ("",["prompt"],[]) prompt
111+ <> B.space
112+ <> B.codeWith ([], ["haskell","expr"], []) (trim expression)
113+ <> B.linebreak
114+ <> (mconcat $ intersperse B.linebreak $ map coder result')
115+ where
116+ -- 1. drop trailing whitespace from the prompt, remember the prefix
117+ prefix = takeWhile (`elem` " \t") prompt
118+
119+ -- 2. drop, if possible, the exact same sequence of whitespace
120+ -- characters from each result line
121+ --
122+ -- 3. interpret lines that only contain the string "<BLANKLINE>" as an
123+ -- empty line
124+ result' = map (substituteBlankLine . tryStripPrefix prefix) result
125+ where
126+ tryStripPrefix xs ys = fromMaybe ys $ stripPrefix xs ys
127+
128+ substituteBlankLine "<BLANKLINE>" = ""
129+ substituteBlankLine line = line
130+ coder = B.codeWith ([], ["result"], [])
131+
tests/haddock-reader.haddock+10−10
@@ -18,10 +18,10 @@ This is a code block:
1818This is another code block:
1919
2020@
21− f x = x + x.
22− The \@...\@ code block /interprets markup normally/.
23− "Module.Foo"
24− \"Hello World\"
21+f x = x + x.
22+The \@...\@ code block /interprets markup normally/.
23+"Module.Foo"
24+\"Hello World\"
2525@
2626
2727Haddock supports REPL examples:
@@ -42,21 +42,21 @@ This is a reference to the "Foo" module.
4242
4343This is a bulleted list:
4444
45− * first item
45+ * first item
4646
47− * second item
47+ * second item
4848
4949This is an enumerated list:
5050
51− (1) first item
51+ (1) first item
5252
53− 2. second item
53+ 2. second item
5454
5555This is a definition list:
5656
57− [@foo@] The description of @foo@.
57+ [@foo@] The description of @foo@.
5858
59− [@bar@] The description of @bar@.
59+ [@bar@] The description of @bar@.
6060
6161Here is a link: <http://haskell.org>
6262
tests/haddock-reader.native+3−3
@@ -4,13 +4,13 @@ Pandoc (Meta {unMeta = fromList []})
44,Para [Str "*",Space,Str "This",Space,Str "is",Space,Str "a",Space,Str "paragraph,",Space,Str "not",Space,Str "a",Space,Str "list",Space,Str "item.",Space,Str ">",Space,Str "This",Space,Str "sentence",Space,Str "is",Space,Str "not",Space,Str "code.",Space,Str ">>>",Space,Str "This",Space,Str "is",Space,Str "not",Space,Str "an",Space,Str "example."]
55,Para [Str "The",Space,Str "references",Space,Str "\955,",Space,Str "\955",Space,Str "and",Space,Str "\955",Space,Str "all",Space,Str "represent",Space,Str "the",Space,Str "lower-case",Space,Str "letter",Space,Str "lambda."]
66,Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "code",Space,Str "block:"]
7−,CodeBlock ("",["haskell"],[]) " map :: (a -> b) -> [a] -> [b]\n map _ [] = []\n map f (x:xs) = f x : map f xs\n"
7+,CodeBlock ("",["haskell"],[]) "map :: (a -> b) -> [a] -> [b]\nmap _ [] = []\nmap f (x:xs) = f x : map f xs"
88,Para [Str "This",Space,Str "is",Space,Str "another",Space,Str "code",Space,Str "block:"]
9−,Para [Code ("",[],[]) "f",Space,Code ("",[],[]) "x",Space,Code ("",[],[]) "=",Space,Code ("",[],[]) "x",Space,Code ("",[],[]) "+",Space,Code ("",[],[]) "x.",Space,Code ("",[],[]) "The",Space,Code ("",[],[]) "@...@",Space,Code ("",[],[]) "code",Space,Code ("",[],[]) "block",Space,Emph [Code ("",[],[]) "interprets markup normally"],Code ("",[],[]) ".",Space,Code ("",["haskell"],[]) "Module.Foo",Space,Code ("",[],[]) "\"Hello",Space,Code ("",[],[]) "World\""]
9+,Para [Code ("",[],[]) "f x = x + x.",LineBreak,Code ("",[],[]) "The @...@ code block ",Emph [Code ("",[],[]) "interprets markup normally"],Code ("",[],[]) ".",Code ("",["haskell"],[]) "Module.Foo",Code ("",[],[]) "",LineBreak,Code ("",[],[]) "\"Hello World\""]
1010,Para [Str "Haddock",Space,Str "supports",Space,Str "REPL",Space,Str "examples:"]
1111,Para [Code ("",["haskell","expr"],[]) "fib 10",LineBreak,Code ("",["result"],[]) "55"]
1212,Para [Code ("",["haskell","expr"],[]) "putStrLn \"foo\\nbar\"",LineBreak,Code ("",["result"],[]) "foo",LineBreak,Code ("",["result"],[]) "bar"]
13−,Para [Str "That",Space,Str "was",Space,Emph [Str "really cool"],Str "!",Space,Str "I",Space,Str "had",Space,Str "no",Space,Str "idea",Space,Code ("",[],[]) "fib",Space,Code ("",[],[]) "10",Space,Code ("",[],[]) "=",Space,Code ("",[],[]) "55",Str "."]
13+,Para [Str "That",Space,Str "was",Space,Emph [Str "really",Space,Str "cool"],Str "!",Space,Str "I",Space,Str "had",Space,Str "no",Space,Str "idea",Space,Code ("",[],[]) "fib 10 = 55",Str "."]
1414,Para [Str "This",Space,Str "module",Space,Str "defines",Space,Str "the",Space,Str "type",Space,Code ("",["haskell"],[]) "T",Str ".",Space,Str "The",Space,Str "identifier",Space,Code ("",["haskell"],[]) "M.T",Space,Str "is",Space,Str "not",Space,Str "in",Space,Str "scope",Space,Str "I",Space,Str "don't",Space,Str "have",Space,Str "to",Space,Str "escape",Space,Str "my",Space,Str "apostrophes;",Space,Str "great,",Space,Str "isn't",Space,Str "it?",Space,Str "This",Space,Str "is",Space,Str "a",Space,Str "reference",Space,Str "to",Space,Str "the",Space,Code ("",["haskell"],[]) "Foo",Space,Str "module."]
1515,Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "bulleted",Space,Str "list:"]
1616,BulletList