aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/Haddock.hs46
-rw-r--r--src/Text/Pandoc/Writers/Haddock.hs23
2 files changed, 47 insertions, 22 deletions
diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs
index f184eabdb..a3dfb7c3c 100644
--- a/src/Text/Pandoc/Readers/Haddock.hs
+++ b/src/Text/Pandoc/Readers/Haddock.hs
@@ -45,7 +45,9 @@ docHToBlocks d' =
DocString _ -> inlineFallback
DocParagraph (DocHeader h) -> docHToBlocks (DocHeader h)
DocParagraph (DocAName h) -> B.plain $ docHToInlines False $ DocAName h
- DocParagraph ils -> B.para $ docHToInlines False ils
+ DocParagraph x -> let (ils, rest) = getInlines x
+ in (B.para $ docHToInlines False ils)
+ <> docHToBlocks rest
DocIdentifier _ -> inlineFallback
DocIdentifierUnchecked _ -> inlineFallback
DocModule s -> B.plain $ docHToInlines False $ DocModule s
@@ -60,7 +62,7 @@ docHToBlocks d' =
DocDefList items -> B.definitionList (map (\(d,t) ->
(docHToInlines False d,
[consolidatePlains $ docHToBlocks t])) items)
- DocCodeBlock (DocString s) -> B.codeBlockWith ("",["haskell"],[]) s
+ DocCodeBlock (DocString s) -> B.codeBlockWith ("",[],[]) s
DocCodeBlock d -> B.para $ docHToInlines True d
DocHyperlink _ -> inlineFallback
DocPic _ -> inlineFallback
@@ -92,9 +94,9 @@ docHToInlines isCode d' =
$ map B.code $ splitBy (=='\n') s
| otherwise -> B.text s
DocParagraph _ -> mempty
- DocIdentifier (_,s,_) -> B.codeWith ("",["haskell"],[]) s
- DocIdentifierUnchecked s -> B.codeWith ("",["haskell"],[]) s
- DocModule s -> B.codeWith ("",["haskell"],[]) s
+ DocIdentifier (_,s,_) -> B.codeWith ("",["haskell","identifier"],[]) s
+ DocIdentifierUnchecked s -> B.codeWith ("",["haskell","identifier"],[]) s
+ DocModule s -> B.codeWith ("",["haskell","module"],[]) s
DocWarning _ -> mempty -- TODO
DocEmphasis d -> B.emph (docHToInlines isCode d)
DocMonospaced (DocString s) -> B.code s
@@ -113,6 +115,40 @@ docHToInlines isCode d' =
DocProperty _ -> mempty
DocExamples _ -> mempty
+getInlines :: DocH String Identifier -> (DocH String Identifier, DocH String Identifier)
+getInlines (DocAppend x y) = if isInline x
+ then let (a, b) = getInlines y
+ in (DocAppend x a, b)
+ else (DocEmpty, DocAppend x y)
+getInlines x = if isInline x
+ then (x, DocEmpty)
+ else (DocEmpty, x)
+
+isInline :: DocH String Identifier -> Bool
+isInline d' =
+ case d' of
+ DocEmpty -> True
+ DocAppend d1 _ -> isInline d1
+ DocString _ -> True
+ DocParagraph _ -> False
+ DocIdentifier _ -> True
+ DocIdentifierUnchecked _ -> True
+ DocModule _ -> True
+ DocWarning _ -> True
+ DocEmphasis _ -> True
+ DocMonospaced _ -> True
+ DocBold _ -> True
+ DocHeader _ -> False
+ DocUnorderedList _ -> False
+ DocOrderedList _ -> False
+ DocDefList _ -> False
+ DocCodeBlock _ -> False
+ DocHyperlink _ -> True
+ DocPic _ -> True
+ DocAName _ -> True
+ DocProperty _ -> False
+ DocExamples _ -> False
+
-- | Create an 'Example', stripping superfluous characters as appropriate
makeExample :: String -> String -> [String] -> Blocks
makeExample prompt expression result =
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 4d6b8e69f..36f57c2b7 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -80,22 +80,11 @@ pandocToHaddock opts (Pandoc meta blocks) = do
-- | Return haddock representation of notes.
notesToHaddock :: WriterOptions -> [[Block]] -> State WriterState Doc
notesToHaddock opts notes =
- mapM (\(num, note) -> noteToHaddock opts num note) (zip [1..] notes) >>=
- return . vsep
-
--- | Return haddock representation of a note.
-noteToHaddock :: WriterOptions -> Int -> [Block] -> State WriterState Doc
-noteToHaddock opts num blocks = do
- contents <- blockListToHaddock opts blocks
- let num' = text $ writerIdentifierPrefix opts ++ show num
- let marker = text "[" <> num' <> text "]"
- let markerSize = 4 + offset num'
- let spacer = case writerTabStop opts - markerSize of
- n | n > 0 -> text $ replicate n ' '
- _ -> text " "
- return $ if isEnabled Ext_footnotes opts
- then hang (writerTabStop opts) (marker <> spacer) contents
- else marker <> spacer <> contents
+ if null notes
+ then return empty
+ else do
+ contents <- blockToHaddock opts $ OrderedList (1,DefaultStyle,DefaultDelim) notes
+ return $ text "#notes#" <> blankline <> contents
-- | Escape special characters for Haddock.
escapeString :: String -> String
@@ -354,4 +343,4 @@ inlineToHaddock opts (Note contents) = do
modify (\st -> st{ stNotes = contents : stNotes st })
st <- get
let ref = text $ writerIdentifierPrefix opts ++ show (length $ stNotes st)
- return $ "[" <> ref <> "]"
+ return $ "<#notes [" <> ref <> "]>"