diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/Haddock.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/Haddock.hs | 66 |
1 files changed, 33 insertions, 33 deletions
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 5e759110c..1d70913c5 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -23,7 +23,7 @@ import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.Pandoc.Pretty +import Text.DocLayout import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Writers.Shared @@ -49,23 +49,20 @@ pandocToHaddock opts (Pandoc meta blocks) = do body <- blockListToHaddock opts blocks st <- get notes' <- notesToHaddock opts (reverse $ stNotes st) - let render' :: Doc -> Text - render' = render colwidth - let main = render' $ body <> - (if isEmpty notes' then empty else blankline <> notes') - metadata <- metaToJSON opts - (fmap render' . blockListToHaddock opts) - (fmap render' . inlineListToHaddock opts) + let main = body <> (if isEmpty notes' then empty else blankline <> notes') + metadata <- metaToContext opts + (blockListToHaddock opts) + (fmap chomp . inlineListToHaddock opts) meta let context = defField "body" main metadata - return $ + return $ render colwidth $ case writerTemplate opts of Nothing -> main Just tpl -> renderTemplate tpl context -- | Return haddock representation of notes. notesToHaddock :: PandocMonad m - => WriterOptions -> [[Block]] -> StateT WriterState m Doc + => WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text) notesToHaddock opts notes = if null notes then return empty @@ -82,7 +79,7 @@ escapeString = escapeStringUsing haddockEscapes blockToHaddock :: PandocMonad m => WriterOptions -- ^ Options -> Block -- ^ Block element - -> StateT WriterState m Doc + -> StateT WriterState m (Doc Text) blockToHaddock _ Null = return empty blockToHaddock opts (Div _ ils) = do contents <- blockListToHaddock opts ils @@ -129,7 +126,7 @@ blockToHaddock opts (Table caption aligns widths headers rows) = do return $ prefixed "> " (tbl $$ blankline $$ caption'') $$ blankline blockToHaddock opts (BulletList items) = do contents <- mapM (bulletListItemToHaddock opts) items - return $ cat contents <> blankline + return $ (if isTightList items then vcat else vsep) contents <> blankline blockToHaddock opts (OrderedList (start,_,delim) items) = do let attribs = (start, Decimal, delim) let markers = orderedListMarkers attribs @@ -137,69 +134,72 @@ blockToHaddock opts (OrderedList (start,_,delim) items) = do then m ++ replicate (3 - length m) ' ' else m) markers contents <- zipWithM (orderedListItemToHaddock opts) markers' items - return $ cat contents <> blankline + return $ (if isTightList items then vcat else vsep) contents <> blankline blockToHaddock opts (DefinitionList items) = do contents <- mapM (definitionListItemToHaddock opts) items - return $ cat contents <> blankline + return $ vcat contents <> blankline -- | Convert bullet list item (list of blocks) to haddock bulletListItemToHaddock :: PandocMonad m - => WriterOptions -> [Block] -> StateT WriterState m Doc + => WriterOptions -> [Block] -> StateT WriterState m (Doc Text) bulletListItemToHaddock opts items = do contents <- blockListToHaddock opts items let sps = replicate (writerTabStop opts - 2) ' ' let start = text ('-' : ' ' : sps) - -- remove trailing blank line if it is a tight list - let contents' = case reverse items of - (BulletList xs:_) | isTightList xs -> - chomp contents <> cr - (OrderedList _ xs:_) | isTightList xs -> - chomp contents <> cr - _ -> contents - return $ hang (writerTabStop opts) start $ contents' <> cr + return $ hang (writerTabStop opts) start contents $$ + if endsWithPlain items + then cr + else blankline -- | Convert ordered list item (a list of blocks) to haddock orderedListItemToHaddock :: PandocMonad m => WriterOptions -- ^ options -> String -- ^ list item marker -> [Block] -- ^ list item (list of blocks) - -> StateT WriterState m Doc + -> StateT WriterState m (Doc Text) orderedListItemToHaddock opts marker items = do contents <- blockListToHaddock opts items let sps = case length marker - writerTabStop opts of n | n > 0 -> text $ replicate n ' ' _ -> text " " let start = text marker <> sps - return $ hang (writerTabStop opts) start $ contents <> cr + return $ hang (writerTabStop opts) start contents $$ + if endsWithPlain items + then cr + else blankline -- | Convert definition list item (label, list of blocks) to haddock definitionListItemToHaddock :: PandocMonad m => WriterOptions -> ([Inline],[[Block]]) - -> StateT WriterState m Doc + -> StateT WriterState m (Doc Text) definitionListItemToHaddock opts (label, defs) = do labelText <- inlineListToHaddock opts label defs' <- mapM (mapM (blockToHaddock opts)) defs - let contents = vcat $ map (\d -> hang 4 empty $ vcat d <> cr) defs' - return $ nowrap (brackets labelText) <> cr <> contents <> cr + let contents = (if isTightList defs then vcat else vsep) $ + map (\d -> hang 4 empty $ vcat d <> cr) defs' + return $ nowrap (brackets labelText) $$ contents $$ + if isTightList defs + then cr + else blankline -- | Convert list of Pandoc block elements to haddock blockListToHaddock :: PandocMonad m => WriterOptions -- ^ Options -> [Block] -- ^ List of block elements - -> StateT WriterState m Doc + -> StateT WriterState m (Doc Text) blockListToHaddock opts blocks = - cat <$> mapM (blockToHaddock opts) blocks + mconcat <$> mapM (blockToHaddock opts) blocks -- | Convert list of Pandoc inline elements to haddock. inlineListToHaddock :: PandocMonad m - => WriterOptions -> [Inline] -> StateT WriterState m Doc + => WriterOptions -> [Inline] -> StateT WriterState m (Doc Text) inlineListToHaddock opts lst = - cat <$> mapM (inlineToHaddock opts) lst + mconcat <$> mapM (inlineToHaddock opts) lst -- | Convert Pandoc inline element to haddock. inlineToHaddock :: PandocMonad m - => WriterOptions -> Inline -> StateT WriterState m Doc + => WriterOptions -> Inline -> StateT WriterState m (Doc Text) inlineToHaddock opts (Span (ident,_,_) ils) = do contents <- inlineListToHaddock opts ils if not (null ident) && null ils |