diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Haddock.hs | 46 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Haddock.hs | 23 |
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 <> "]>" |