git.iko.soy/typeable/pandoc
on master help sign in
More polish on Haddock reader/writer.
commitff6a2baeb9940276fbbaf486a5711378d13cc1e1 authorJohn MacFarlane <jgm@berkeley.edu> dateWed 18 Jun 2014, 17:49 (12 years ago) parent0d364a2
2 files changed+47−22
src/Text/Pandoc/Readers/Haddock.hs+41−5 src/Text/Pandoc/Writers/Haddock.hs+6−17
src/Text/Pandoc/Readers/Haddock.hs+41−5
@@ -45,7 +45,9 @@ docHToBlocks d' =
4545 DocString _ -> inlineFallback
4646 DocParagraph (DocHeader h) -> docHToBlocks (DocHeader h)
4747 DocParagraph (DocAName h) -> B.plain $ docHToInlines False $ DocAName h
48− DocParagraph ils -> B.para $ docHToInlines False ils
48+ DocParagraph x -> let (ils, rest) = getInlines x
49+ in (B.para $ docHToInlines False ils)
50+ <> docHToBlocks rest
4951 DocIdentifier _ -> inlineFallback
5052 DocIdentifierUnchecked _ -> inlineFallback
5153 DocModule s -> B.plain $ docHToInlines False $ DocModule s
@@ -60,7 +62,7 @@ docHToBlocks d' =
6062 DocDefList items -> B.definitionList (map (\(d,t) ->
6163 (docHToInlines False d,
6264 [consolidatePlains $ docHToBlocks t])) items)
63− DocCodeBlock (DocString s) -> B.codeBlockWith ("",["haskell"],[]) s
65+ DocCodeBlock (DocString s) -> B.codeBlockWith ("",[],[]) s
6466 DocCodeBlock d -> B.para $ docHToInlines True d
6567 DocHyperlink _ -> inlineFallback
6668 DocPic _ -> inlineFallback
@@ -92,9 +94,9 @@ docHToInlines isCode d' =
9294 $ map B.code $ splitBy (=='\n') s
9395 | otherwise -> B.text s
9496 DocParagraph _ -> mempty
95− DocIdentifier (_,s,_) -> B.codeWith ("",["haskell"],[]) s
96− DocIdentifierUnchecked s -> B.codeWith ("",["haskell"],[]) s
97− DocModule s -> B.codeWith ("",["haskell"],[]) s
97+ DocIdentifier (_,s,_) -> B.codeWith ("",["haskell","identifier"],[]) s
98+ DocIdentifierUnchecked s -> B.codeWith ("",["haskell","identifier"],[]) s
99+ DocModule s -> B.codeWith ("",["haskell","module"],[]) s
98100 DocWarning _ -> mempty -- TODO
99101 DocEmphasis d -> B.emph (docHToInlines isCode d)
100102 DocMonospaced (DocString s) -> B.code s
@@ -113,6 +115,40 @@ docHToInlines isCode d' =
113115 DocProperty _ -> mempty
114116 DocExamples _ -> mempty
115117
118+getInlines :: DocH String Identifier -> (DocH String Identifier, DocH String Identifier)
119+getInlines (DocAppend x y) = if isInline x
120+ then let (a, b) = getInlines y
121+ in (DocAppend x a, b)
122+ else (DocEmpty, DocAppend x y)
123+getInlines x = if isInline x
124+ then (x, DocEmpty)
125+ else (DocEmpty, x)
126+
127+isInline :: DocH String Identifier -> Bool
128+isInline d' =
129+ case d' of
130+ DocEmpty -> True
131+ DocAppend d1 _ -> isInline d1
132+ DocString _ -> True
133+ DocParagraph _ -> False
134+ DocIdentifier _ -> True
135+ DocIdentifierUnchecked _ -> True
136+ DocModule _ -> True
137+ DocWarning _ -> True
138+ DocEmphasis _ -> True
139+ DocMonospaced _ -> True
140+ DocBold _ -> True
141+ DocHeader _ -> False
142+ DocUnorderedList _ -> False
143+ DocOrderedList _ -> False
144+ DocDefList _ -> False
145+ DocCodeBlock _ -> False
146+ DocHyperlink _ -> True
147+ DocPic _ -> True
148+ DocAName _ -> True
149+ DocProperty _ -> False
150+ DocExamples _ -> False
151+
116152-- | Create an 'Example', stripping superfluous characters as appropriate
117153makeExample :: String -> String -> [String] -> Blocks
118154makeExample prompt expression result =
src/Text/Pandoc/Writers/Haddock.hs+6−17
@@ -80,22 +80,11 @@ pandocToHaddock opts (Pandoc meta blocks) = do
8080-- | Return haddock representation of notes.
8181notesToHaddock :: WriterOptions -> [[Block]] -> State WriterState Doc
8282notesToHaddock opts notes =
83− mapM (\(num, note) -> noteToHaddock opts num note) (zip [1..] notes) >>=
84− return . vsep
85−
86−-- | Return haddock representation of a note.
87−noteToHaddock :: WriterOptions -> Int -> [Block] -> State WriterState Doc
88−noteToHaddock opts num blocks = do
89− contents <- blockListToHaddock opts blocks
90− let num' = text $ writerIdentifierPrefix opts ++ show num
91− let marker = text "[" <> num' <> text "]"
92− let markerSize = 4 + offset num'
93− let spacer = case writerTabStop opts - markerSize of
94− n | n > 0 -> text $ replicate n ' '
95− _ -> text " "
96− return $ if isEnabled Ext_footnotes opts
97− then hang (writerTabStop opts) (marker <> spacer) contents
98− else marker <> spacer <> contents
83+ if null notes
84+ then return empty
85+ else do
86+ contents <- blockToHaddock opts $ OrderedList (1,DefaultStyle,DefaultDelim) notes
87+ return $ text "#notes#" <> blankline <> contents
9988
10089-- | Escape special characters for Haddock.
10190escapeString :: String -> String
@@ -354,4 +343,4 @@ inlineToHaddock opts (Note contents) = do
354343 modify (\st -> st{ stNotes = contents : stNotes st })
355344 st <- get
356345 let ref = text $ writerIdentifierPrefix opts ++ show (length $ stNotes st)
357− return $ "[" <> ref <> "]"
346+ return $ "<#notes [" <> ref <> "]>"