diff options
| author | John MacFarlane <jgm@berkeley.edu> | 2018-03-16 22:38:34 -0700 |
|---|---|---|
| committer | John MacFarlane <jgm@berkeley.edu> | 2018-03-16 22:38:34 -0700 |
| commit | be12ae3bca4f1c2d712e412b11a14b6473c7ab10 (patch) | |
| tree | 14c09685f47b6470d5ae6a486890eef0b9f28add /src/Text | |
| parent | c166861ee64bbeed19d508ac3ff24c07c80093af (diff) | |
| download | pandoc-be12ae3bca4f1c2d712e412b11a14b6473c7ab10.tar.gz | |
Better table handling for Haddock.
In the reader, we use the new Table type in Haddock.
Note that tables with col/rowspans will not translate
well into Pandoc.
In the writer, we now render tables always as grid tables,
since Haddock supports these.
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Readers/Haddock.hs | 15 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Haddock.hs | 63 |
2 files changed, 18 insertions, 60 deletions
diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 2f76fc1a0..b593c4cc8 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -19,7 +19,7 @@ import Data.List (intersperse, stripPrefix) import Data.Maybe (fromMaybe) import Data.Text (Text, unpack) import Documentation.Haddock.Parser -import Documentation.Haddock.Types +import Documentation.Haddock.Types as H import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class (PandocMonad) @@ -85,6 +85,18 @@ docHToBlocks d' = DocProperty s -> B.codeBlockWith ("",["property","haskell"],[]) (trim s) DocExamples es -> mconcat $ map (\e -> makeExample ">>>" (exampleExpression e) (exampleResult e)) es + DocTable H.Table{ tableHeaderRows = headerRows + , tableBodyRows = bodyRows + } + -> let toCells = map (docHToBlocks . tableCellContents) . tableRowCells + (header, body) = + if null headerRows + then ([], map toCells bodyRows) + else (toCells (head headerRows), + map toCells (tail headerRows ++ bodyRows)) + colspecs = replicate (maximum (map length body)) + (AlignDefault, 0.0) + in B.table mempty colspecs header body where inlineFallback = B.plain $ docHToInlines False d' consolidatePlains = B.fromList . consolidatePlains' . B.toList @@ -133,6 +145,7 @@ docHToInlines isCode d' = DocAName s -> B.spanWith (s,["anchor"],[]) mempty DocProperty _ -> mempty DocExamples _ -> mempty + DocTable _ -> mempty -- | Create an 'Example', stripping superfluous characters as appropriate makeExample :: String -> String -> [String] -> Blocks diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 688c1f390..3f96f5802 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -35,7 +35,6 @@ Haddock: <http://www.haskell.org/haddock/doc/html/> module Text.Pandoc.Writers.Haddock (writeHaddock) where import Control.Monad.State.Strict import Data.Default -import Data.List (intersperse, transpose) import Data.Text (Text) import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition @@ -136,29 +135,15 @@ blockToHaddock _ (CodeBlock (_,_,_) str) = -- Nothing in haddock corresponds to block quotes: blockToHaddock opts (BlockQuote blocks) = blockListToHaddock opts blocks --- Haddock doesn't have tables. Use haddock tables in code. blockToHaddock opts (Table caption aligns widths headers rows) = do caption' <- inlineListToHaddock opts caption let caption'' = if null caption then empty else blankline <> caption' <> blankline - rawHeaders <- mapM (blockListToHaddock opts) headers - rawRows <- mapM (mapM (blockListToHaddock opts)) rows - let isSimple = all (==0) widths - let isPlainBlock (Plain _) = True - isPlainBlock _ = False - let hasBlocks = not (all isPlainBlock $ concat . concat $ headers:rows) - (nst,tbl) <- case True of - _ | isSimple -> (nest 2,) <$> - pandocTable opts (all null headers) aligns widths - rawHeaders rawRows - | not hasBlocks -> (nest 2,) <$> - pandocTable opts (all null headers) aligns widths - rawHeaders rawRows - | otherwise -> (id,) <$> - gridTable opts blockListToHaddock - (all null headers) aligns widths headers rows - return $ prefixed "> " (nst $ tbl $$ blankline $$ caption'') $$ blankline + tbl <- gridTable opts blockListToHaddock + (all null headers) (map (\_ -> AlignDefault) aligns) + widths headers rows + return $ prefixed "> " (tbl $$ blankline $$ caption'') $$ blankline blockToHaddock opts (BulletList items) = do contents <- mapM (bulletListItemToHaddock opts) items return $ cat contents <> blankline @@ -174,46 +159,6 @@ blockToHaddock opts (DefinitionList items) = do contents <- mapM (definitionListItemToHaddock opts) items return $ cat contents <> blankline -pandocTable :: PandocMonad m - => WriterOptions -> Bool -> [Alignment] -> [Double] - -> [Doc] -> [[Doc]] -> StateT WriterState m Doc -pandocTable opts headless aligns widths rawHeaders rawRows = do - let isSimple = all (==0) widths - let alignHeader alignment = case alignment of - AlignLeft -> lblock - AlignCenter -> cblock - AlignRight -> rblock - AlignDefault -> lblock - let numChars = maximum . map offset - let widthsInChars = if isSimple - then map ((+2) . numChars) - $ transpose (rawHeaders : rawRows) - else map - (floor . (fromIntegral (writerColumns opts) *)) - widths - let makeRow = hcat . intersperse (lblock 1 (text " ")) . - zipWith3 alignHeader aligns widthsInChars - let rows' = map makeRow rawRows - let head' = makeRow rawHeaders - let maxRowHeight = maximum $ map height (head':rows') - let underline = cat $ intersperse (text " ") $ - map (\width -> text (replicate width '-')) widthsInChars - let border - | maxRowHeight > 1 = text (replicate (sum widthsInChars + - length widthsInChars - 1) '-') - | headless = underline - | otherwise = empty - let head'' = if headless - then empty - else border <> cr <> head' - let body = if maxRowHeight > 1 - then vsep rows' - else vcat rows' - let bottom = if headless - then underline - else border - return $ head'' $$ underline $$ body $$ bottom - -- | Convert bullet list item (list of blocks) to haddock bulletListItemToHaddock :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Doc |