Add new internal module Text.Pandoc.Writers.GridTable
This commit is contained in:
parent
56a0d874c7
commit
3da919e35d
2 changed files with 159 additions and 0 deletions
|
@ -438,6 +438,7 @@ library
|
||||||
SHA >= 1.6 && < 1.7,
|
SHA >= 1.6 && < 1.7,
|
||||||
aeson >= 0.7 && < 1.6,
|
aeson >= 0.7 && < 1.6,
|
||||||
aeson-pretty >= 0.8.5 && < 0.9,
|
aeson-pretty >= 0.8.5 && < 0.9,
|
||||||
|
array >= 0.5 && < 0.6,
|
||||||
attoparsec >= 0.12 && < 0.15,
|
attoparsec >= 0.12 && < 0.15,
|
||||||
base64-bytestring >= 0.1 && < 1.3,
|
base64-bytestring >= 0.1 && < 1.3,
|
||||||
binary >= 0.7 && < 0.11,
|
binary >= 0.7 && < 0.11,
|
||||||
|
@ -659,6 +660,7 @@ library
|
||||||
Text.Pandoc.Writers.Docx.StyleMap,
|
Text.Pandoc.Writers.Docx.StyleMap,
|
||||||
Text.Pandoc.Writers.Docx.Table,
|
Text.Pandoc.Writers.Docx.Table,
|
||||||
Text.Pandoc.Writers.Docx.Types,
|
Text.Pandoc.Writers.Docx.Types,
|
||||||
|
Text.Pandoc.Writers.GridTable
|
||||||
Text.Pandoc.Writers.JATS.References,
|
Text.Pandoc.Writers.JATS.References,
|
||||||
Text.Pandoc.Writers.JATS.Table,
|
Text.Pandoc.Writers.JATS.Table,
|
||||||
Text.Pandoc.Writers.JATS.Types,
|
Text.Pandoc.Writers.JATS.Types,
|
||||||
|
|
157
src/Text/Pandoc/Writers/GridTable.hs
Normal file
157
src/Text/Pandoc/Writers/GridTable.hs
Normal file
|
@ -0,0 +1,157 @@
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
|
{- |
|
||||||
|
Module : Text.Pandoc.Writers.GridTable
|
||||||
|
Copyright : © 2020-2021 Albert Krewinkel
|
||||||
|
License : GNU GPL, version 2 or above
|
||||||
|
|
||||||
|
Maintainer : Albert Krewinkel <albert@zeitkraut.de>
|
||||||
|
|
||||||
|
Grid representation of pandoc tables.
|
||||||
|
-}
|
||||||
|
module Text.Pandoc.Writers.GridTable
|
||||||
|
( Table (..)
|
||||||
|
, GridCell (..)
|
||||||
|
, RowIndex (..)
|
||||||
|
, ColIndex (..)
|
||||||
|
, CellIndex
|
||||||
|
, Part (..)
|
||||||
|
, toTable
|
||||||
|
, rowArray
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (forM_)
|
||||||
|
import Control.Monad.ST
|
||||||
|
import Data.Array
|
||||||
|
import Data.Array.MArray
|
||||||
|
import Data.Array.ST
|
||||||
|
import Data.Maybe (listToMaybe)
|
||||||
|
import Data.STRef
|
||||||
|
import Text.Pandoc.Definition hiding (Table)
|
||||||
|
import qualified Text.Pandoc.Builder as B
|
||||||
|
|
||||||
|
-- | A grid cell contains either a real table cell, or is the
|
||||||
|
-- continuation of a column or row-spanning cell. In the latter case,
|
||||||
|
-- the index of the continued cell is provided.
|
||||||
|
data GridCell
|
||||||
|
= ContentCell Attr Alignment RowSpan ColSpan [Block]
|
||||||
|
| ContinuationCell CellIndex
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
-- | Row index in a table part.
|
||||||
|
newtype RowIndex = RowIndex Int deriving (Enum, Eq, Ix, Ord, Show)
|
||||||
|
-- | Column index in a table part.
|
||||||
|
newtype ColIndex = ColIndex Int deriving (Enum, Eq, Ix, Ord, Show)
|
||||||
|
|
||||||
|
-- | Index to a cell in a table part.
|
||||||
|
type CellIndex = (RowIndex, ColIndex)
|
||||||
|
|
||||||
|
-- | Cells are placed on a grid. Row attributes are stored in a separate
|
||||||
|
-- array.
|
||||||
|
data Part = Part
|
||||||
|
{ partAttr :: Attr
|
||||||
|
, partCellArray :: Array (RowIndex,ColIndex) GridCell
|
||||||
|
, partRowAttrs :: Array RowIndex Attr
|
||||||
|
}
|
||||||
|
|
||||||
|
data Table = Table
|
||||||
|
{ tableAttr :: Attr
|
||||||
|
, tableCaption :: Caption
|
||||||
|
, tableColSpecs :: Array ColIndex ColSpec
|
||||||
|
, tableRowHeads :: RowHeadColumns
|
||||||
|
, tableHead :: Part
|
||||||
|
, tableBodies :: [Part]
|
||||||
|
, tableFoot :: Part
|
||||||
|
}
|
||||||
|
|
||||||
|
toTable
|
||||||
|
:: B.Attr
|
||||||
|
-> B.Caption
|
||||||
|
-> [B.ColSpec]
|
||||||
|
-> B.TableHead
|
||||||
|
-> [B.TableBody]
|
||||||
|
-> B.TableFoot
|
||||||
|
-> Table
|
||||||
|
toTable attr caption colSpecs thead tbodies tfoot =
|
||||||
|
Table attr caption colSpecs' rowHeads thGrid tbGrids tfGrid
|
||||||
|
where
|
||||||
|
colSpecs' = listArray (ColIndex 1, ColIndex $ length colSpecs) colSpecs
|
||||||
|
rowHeads = case listToMaybe tbodies of
|
||||||
|
Nothing -> RowHeadColumns 0
|
||||||
|
Just (TableBody _attr rowHeadCols _headerRows _rows) -> rowHeadCols
|
||||||
|
thGrid = let (TableHead headAttr rows) = thead
|
||||||
|
in rowsToPart headAttr rows
|
||||||
|
tbGrids = map bodyToGrid tbodies
|
||||||
|
tfGrid = let (TableFoot footAttr rows) = tfoot
|
||||||
|
in rowsToPart footAttr rows
|
||||||
|
bodyToGrid (TableBody bodyAttr _rowHeadCols _headRows rows) =
|
||||||
|
rowsToPart bodyAttr rows
|
||||||
|
|
||||||
|
data BuilderCell
|
||||||
|
= FilledCell GridCell
|
||||||
|
| FreeCell
|
||||||
|
|
||||||
|
fromBuilderCell :: BuilderCell -> GridCell
|
||||||
|
fromBuilderCell = \case
|
||||||
|
FilledCell c -> c
|
||||||
|
FreeCell -> error "Found an unassigned cell."
|
||||||
|
|
||||||
|
rowsToPart :: Attr -> [B.Row] -> Part
|
||||||
|
rowsToPart attr = \case
|
||||||
|
[] -> Part
|
||||||
|
attr
|
||||||
|
(listArray ((RowIndex 1, ColIndex 1), (RowIndex 0, ColIndex 0)) [])
|
||||||
|
(listArray (RowIndex 1, RowIndex 0) [])
|
||||||
|
rows@(Row _attr firstRow:_) ->
|
||||||
|
let nrows = length rows
|
||||||
|
ncols = sum $ map (\(Cell _ _ _ (ColSpan cs) _) -> cs) firstRow
|
||||||
|
gbounds = ((RowIndex 1, ColIndex 1), (RowIndex nrows, ColIndex ncols))
|
||||||
|
mutableGrid :: ST s (STArray s CellIndex GridCell)
|
||||||
|
mutableGrid = do
|
||||||
|
grid <- newArray gbounds FreeCell
|
||||||
|
ridx <- newSTRef (RowIndex 1)
|
||||||
|
forM_ rows $ \(Row _attr cells) -> do
|
||||||
|
cidx <- newSTRef (ColIndex 1)
|
||||||
|
forM_ cells $ \(Cell cellAttr align rs cs blks) -> do
|
||||||
|
ridx' <- readSTRef ridx
|
||||||
|
let nextFreeInRow colindex@(ColIndex c) = do
|
||||||
|
readArray grid (ridx', colindex) >>= \case
|
||||||
|
FreeCell -> pure colindex
|
||||||
|
_ -> nextFreeInRow $ ColIndex (c + 1)
|
||||||
|
cidx' <- readSTRef cidx >>= nextFreeInRow
|
||||||
|
writeArray grid (ridx', cidx') . FilledCell $
|
||||||
|
ContentCell cellAttr align rs cs blks
|
||||||
|
forM_ (continuationIndices ridx' cidx' rs cs) $ \idx -> do
|
||||||
|
writeArray grid idx . FilledCell $
|
||||||
|
ContinuationCell (ridx', cidx')
|
||||||
|
-- go to new column
|
||||||
|
writeSTRef cidx cidx'
|
||||||
|
-- go to next row
|
||||||
|
modifySTRef ridx (incrRowIndex 1)
|
||||||
|
-- Swap BuilderCells with normal GridCells.
|
||||||
|
mapArray fromBuilderCell grid
|
||||||
|
in Part
|
||||||
|
{ partCellArray = runSTArray mutableGrid
|
||||||
|
, partRowAttrs = listArray (RowIndex 1, RowIndex nrows) $
|
||||||
|
map (\(Row rowAttr _) -> rowAttr) rows
|
||||||
|
, partAttr = attr
|
||||||
|
}
|
||||||
|
|
||||||
|
continuationIndices :: RowIndex -> ColIndex -> RowSpan -> ColSpan -> [CellIndex]
|
||||||
|
continuationIndices (RowIndex ridx) (ColIndex cidx) rowspan colspan =
|
||||||
|
let (RowSpan rs) = rowspan
|
||||||
|
(ColSpan cs) = colspan
|
||||||
|
in [ (RowIndex r, ColIndex c) | r <- [ridx..(ridx + rs - 1)]
|
||||||
|
, c <- [cidx..(cidx + cs - 1)]
|
||||||
|
, (r, c) /= (ridx, cidx)]
|
||||||
|
|
||||||
|
rowArray :: RowIndex -> Array CellIndex GridCell -> Array ColIndex GridCell
|
||||||
|
rowArray ridx grid =
|
||||||
|
let ((_minRidx, minCidx), (_maxRidx, maxCidx)) = bounds grid
|
||||||
|
in ixmap (minCidx, maxCidx) (ridx,) grid
|
||||||
|
|
||||||
|
incrRowIndex :: RowSpan -> RowIndex -> RowIndex
|
||||||
|
incrRowIndex (RowSpan n) (RowIndex r) = RowIndex $ r + n
|
Loading…
Add table
Reference in a new issue