{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE TupleSections              #-}

{- |
Module      : Text.Pandoc.Writers.GridTable
Copyright   : © 2020-2024 Albert Krewinkel
License     : GNU GPL, version 2 or above

Maintainer  : Albert Krewinkel <albert@zeitkraut.de>

Grid representation of pandoc tables. The structures in this module
allow to describe 'Text.Pandoc.Definition.Table' elements without loss
of information. However, they are simpler to use when the grid layout of
a table must be known.

The "grid tables" handled here are conceptually similar to grid tables
in reStructuredText and Markdown, but are more general.
-}
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
  | UnassignedCell
  deriving (Int -> GridCell -> ShowS
[GridCell] -> ShowS
GridCell -> String
(Int -> GridCell -> ShowS)
-> (GridCell -> String) -> ([GridCell] -> ShowS) -> Show GridCell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GridCell -> ShowS
showsPrec :: Int -> GridCell -> ShowS
$cshow :: GridCell -> String
show :: GridCell -> String
$cshowList :: [GridCell] -> ShowS
showList :: [GridCell] -> ShowS
Show)

-- | Row index in a table part.
newtype RowIndex = RowIndex Int deriving (Int -> RowIndex
RowIndex -> Int
RowIndex -> [RowIndex]
RowIndex -> RowIndex
RowIndex -> RowIndex -> [RowIndex]
RowIndex -> RowIndex -> RowIndex -> [RowIndex]
(RowIndex -> RowIndex)
-> (RowIndex -> RowIndex)
-> (Int -> RowIndex)
-> (RowIndex -> Int)
-> (RowIndex -> [RowIndex])
-> (RowIndex -> RowIndex -> [RowIndex])
-> (RowIndex -> RowIndex -> [RowIndex])
-> (RowIndex -> RowIndex -> RowIndex -> [RowIndex])
-> Enum RowIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RowIndex -> RowIndex
succ :: RowIndex -> RowIndex
$cpred :: RowIndex -> RowIndex
pred :: RowIndex -> RowIndex
$ctoEnum :: Int -> RowIndex
toEnum :: Int -> RowIndex
$cfromEnum :: RowIndex -> Int
fromEnum :: RowIndex -> Int
$cenumFrom :: RowIndex -> [RowIndex]
enumFrom :: RowIndex -> [RowIndex]
$cenumFromThen :: RowIndex -> RowIndex -> [RowIndex]
enumFromThen :: RowIndex -> RowIndex -> [RowIndex]
$cenumFromTo :: RowIndex -> RowIndex -> [RowIndex]
enumFromTo :: RowIndex -> RowIndex -> [RowIndex]
$cenumFromThenTo :: RowIndex -> RowIndex -> RowIndex -> [RowIndex]
enumFromThenTo :: RowIndex -> RowIndex -> RowIndex -> [RowIndex]
Enum, RowIndex -> RowIndex -> Bool
(RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> Bool) -> Eq RowIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RowIndex -> RowIndex -> Bool
== :: RowIndex -> RowIndex -> Bool
$c/= :: RowIndex -> RowIndex -> Bool
/= :: RowIndex -> RowIndex -> Bool
Eq, Ord RowIndex
Ord RowIndex =>
((RowIndex, RowIndex) -> [RowIndex])
-> ((RowIndex, RowIndex) -> RowIndex -> Int)
-> ((RowIndex, RowIndex) -> RowIndex -> Int)
-> ((RowIndex, RowIndex) -> RowIndex -> Bool)
-> ((RowIndex, RowIndex) -> Int)
-> ((RowIndex, RowIndex) -> Int)
-> Ix RowIndex
(RowIndex, RowIndex) -> Int
(RowIndex, RowIndex) -> [RowIndex]
(RowIndex, RowIndex) -> RowIndex -> Bool
(RowIndex, RowIndex) -> RowIndex -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (RowIndex, RowIndex) -> [RowIndex]
range :: (RowIndex, RowIndex) -> [RowIndex]
$cindex :: (RowIndex, RowIndex) -> RowIndex -> Int
index :: (RowIndex, RowIndex) -> RowIndex -> Int
$cunsafeIndex :: (RowIndex, RowIndex) -> RowIndex -> Int
unsafeIndex :: (RowIndex, RowIndex) -> RowIndex -> Int
$cinRange :: (RowIndex, RowIndex) -> RowIndex -> Bool
inRange :: (RowIndex, RowIndex) -> RowIndex -> Bool
$crangeSize :: (RowIndex, RowIndex) -> Int
rangeSize :: (RowIndex, RowIndex) -> Int
$cunsafeRangeSize :: (RowIndex, RowIndex) -> Int
unsafeRangeSize :: (RowIndex, RowIndex) -> Int
Ix, Eq RowIndex
Eq RowIndex =>
(RowIndex -> RowIndex -> Ordering)
-> (RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex -> RowIndex)
-> Ord RowIndex
RowIndex -> RowIndex -> Bool
RowIndex -> RowIndex -> Ordering
RowIndex -> RowIndex -> RowIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RowIndex -> RowIndex -> Ordering
compare :: RowIndex -> RowIndex -> Ordering
$c< :: RowIndex -> RowIndex -> Bool
< :: RowIndex -> RowIndex -> Bool
$c<= :: RowIndex -> RowIndex -> Bool
<= :: RowIndex -> RowIndex -> Bool
$c> :: RowIndex -> RowIndex -> Bool
> :: RowIndex -> RowIndex -> Bool
$c>= :: RowIndex -> RowIndex -> Bool
>= :: RowIndex -> RowIndex -> Bool
$cmax :: RowIndex -> RowIndex -> RowIndex
max :: RowIndex -> RowIndex -> RowIndex
$cmin :: RowIndex -> RowIndex -> RowIndex
min :: RowIndex -> RowIndex -> RowIndex
Ord, Int -> RowIndex -> ShowS
[RowIndex] -> ShowS
RowIndex -> String
(Int -> RowIndex -> ShowS)
-> (RowIndex -> String) -> ([RowIndex] -> ShowS) -> Show RowIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowIndex -> ShowS
showsPrec :: Int -> RowIndex -> ShowS
$cshow :: RowIndex -> String
show :: RowIndex -> String
$cshowList :: [RowIndex] -> ShowS
showList :: [RowIndex] -> ShowS
Show)
-- | Column index in a table part.
newtype ColIndex = ColIndex Int deriving (Int -> ColIndex
ColIndex -> Int
ColIndex -> [ColIndex]
ColIndex -> ColIndex
ColIndex -> ColIndex -> [ColIndex]
ColIndex -> ColIndex -> ColIndex -> [ColIndex]
(ColIndex -> ColIndex)
-> (ColIndex -> ColIndex)
-> (Int -> ColIndex)
-> (ColIndex -> Int)
-> (ColIndex -> [ColIndex])
-> (ColIndex -> ColIndex -> [ColIndex])
-> (ColIndex -> ColIndex -> [ColIndex])
-> (ColIndex -> ColIndex -> ColIndex -> [ColIndex])
-> Enum ColIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ColIndex -> ColIndex
succ :: ColIndex -> ColIndex
$cpred :: ColIndex -> ColIndex
pred :: ColIndex -> ColIndex
$ctoEnum :: Int -> ColIndex
toEnum :: Int -> ColIndex
$cfromEnum :: ColIndex -> Int
fromEnum :: ColIndex -> Int
$cenumFrom :: ColIndex -> [ColIndex]
enumFrom :: ColIndex -> [ColIndex]
$cenumFromThen :: ColIndex -> ColIndex -> [ColIndex]
enumFromThen :: ColIndex -> ColIndex -> [ColIndex]
$cenumFromTo :: ColIndex -> ColIndex -> [ColIndex]
enumFromTo :: ColIndex -> ColIndex -> [ColIndex]
$cenumFromThenTo :: ColIndex -> ColIndex -> ColIndex -> [ColIndex]
enumFromThenTo :: ColIndex -> ColIndex -> ColIndex -> [ColIndex]
Enum, ColIndex -> ColIndex -> Bool
(ColIndex -> ColIndex -> Bool)
-> (ColIndex -> ColIndex -> Bool) -> Eq ColIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColIndex -> ColIndex -> Bool
== :: ColIndex -> ColIndex -> Bool
$c/= :: ColIndex -> ColIndex -> Bool
/= :: ColIndex -> ColIndex -> Bool
Eq, Ord ColIndex
Ord ColIndex =>
((ColIndex, ColIndex) -> [ColIndex])
-> ((ColIndex, ColIndex) -> ColIndex -> Int)
-> ((ColIndex, ColIndex) -> ColIndex -> Int)
-> ((ColIndex, ColIndex) -> ColIndex -> Bool)
-> ((ColIndex, ColIndex) -> Int)
-> ((ColIndex, ColIndex) -> Int)
-> Ix ColIndex
(ColIndex, ColIndex) -> Int
(ColIndex, ColIndex) -> [ColIndex]
(ColIndex, ColIndex) -> ColIndex -> Bool
(ColIndex, ColIndex) -> ColIndex -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (ColIndex, ColIndex) -> [ColIndex]
range :: (ColIndex, ColIndex) -> [ColIndex]
$cindex :: (ColIndex, ColIndex) -> ColIndex -> Int
index :: (ColIndex, ColIndex) -> ColIndex -> Int
$cunsafeIndex :: (ColIndex, ColIndex) -> ColIndex -> Int
unsafeIndex :: (ColIndex, ColIndex) -> ColIndex -> Int
$cinRange :: (ColIndex, ColIndex) -> ColIndex -> Bool
inRange :: (ColIndex, ColIndex) -> ColIndex -> Bool
$crangeSize :: (ColIndex, ColIndex) -> Int
rangeSize :: (ColIndex, ColIndex) -> Int
$cunsafeRangeSize :: (ColIndex, ColIndex) -> Int
unsafeRangeSize :: (ColIndex, ColIndex) -> Int
Ix, Eq ColIndex
Eq ColIndex =>
(ColIndex -> ColIndex -> Ordering)
-> (ColIndex -> ColIndex -> Bool)
-> (ColIndex -> ColIndex -> Bool)
-> (ColIndex -> ColIndex -> Bool)
-> (ColIndex -> ColIndex -> Bool)
-> (ColIndex -> ColIndex -> ColIndex)
-> (ColIndex -> ColIndex -> ColIndex)
-> Ord ColIndex
ColIndex -> ColIndex -> Bool
ColIndex -> ColIndex -> Ordering
ColIndex -> ColIndex -> ColIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ColIndex -> ColIndex -> Ordering
compare :: ColIndex -> ColIndex -> Ordering
$c< :: ColIndex -> ColIndex -> Bool
< :: ColIndex -> ColIndex -> Bool
$c<= :: ColIndex -> ColIndex -> Bool
<= :: ColIndex -> ColIndex -> Bool
$c> :: ColIndex -> ColIndex -> Bool
> :: ColIndex -> ColIndex -> Bool
$c>= :: ColIndex -> ColIndex -> Bool
>= :: ColIndex -> ColIndex -> Bool
$cmax :: ColIndex -> ColIndex -> ColIndex
max :: ColIndex -> ColIndex -> ColIndex
$cmin :: ColIndex -> ColIndex -> ColIndex
min :: ColIndex -> ColIndex -> ColIndex
Ord, Int -> ColIndex -> ShowS
[ColIndex] -> ShowS
ColIndex -> String
(Int -> ColIndex -> ShowS)
-> (ColIndex -> String) -> ([ColIndex] -> ShowS) -> Show ColIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColIndex -> ShowS
showsPrec :: Int -> ColIndex -> ShowS
$cshow :: ColIndex -> String
show :: ColIndex -> String
$cshowList :: [ColIndex] -> ShowS
showList :: [ColIndex] -> ShowS
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
  { Part -> Attr
partAttr :: Attr
  , Part -> Array (RowIndex, ColIndex) GridCell
partCellArray :: Array (RowIndex,ColIndex) GridCell
  , Part -> Array RowIndex Attr
partRowAttrs  :: Array RowIndex Attr
  }

data Table = Table
  { Table -> Attr
tableAttr     :: Attr
  , Table -> Caption
tableCaption  :: Caption
  , Table -> Array ColIndex ColSpec
tableColSpecs :: Array ColIndex ColSpec
  , Table -> RowHeadColumns
tableRowHeads :: RowHeadColumns
  , Table -> Part
tableHead     :: Part
  , Table -> [Part]
tableBodies   :: [Part]
  , Table -> Part
tableFoot     :: Part
  }

toTable
  :: B.Attr
  -> B.Caption
  -> [B.ColSpec]
  -> B.TableHead
  -> [B.TableBody]
  -> B.TableFoot
  -> Table
toTable :: Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
toTable Attr
attr Caption
caption [ColSpec]
colSpecs  TableHead
thead [TableBody]
tbodies TableFoot
tfoot =
  Attr
-> Caption
-> Array ColIndex ColSpec
-> RowHeadColumns
-> Part
-> [Part]
-> Part
-> Table
Table Attr
attr Caption
caption Array ColIndex ColSpec
colSpecs' RowHeadColumns
rowHeads Part
thGrid [Part]
tbGrids Part
tfGrid
  where
    colSpecs' :: Array ColIndex ColSpec
colSpecs' = (ColIndex, ColIndex) -> [ColSpec] -> Array ColIndex ColSpec
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int -> ColIndex
ColIndex Int
1, Int -> ColIndex
ColIndex (Int -> ColIndex) -> Int -> ColIndex
forall a b. (a -> b) -> a -> b
$ [ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
colSpecs) [ColSpec]
colSpecs
    rowHeads :: RowHeadColumns
rowHeads = case [TableBody] -> Maybe TableBody
forall a. [a] -> Maybe a
listToMaybe [TableBody]
tbodies of
      Maybe TableBody
Nothing -> Int -> RowHeadColumns
RowHeadColumns Int
0
      Just (TableBody Attr
_attr RowHeadColumns
rowHeadCols [Row]
_headerRows [Row]
_rows) -> RowHeadColumns
rowHeadCols
    thGrid :: Part
thGrid = let (TableHead Attr
headAttr [Row]
rows) = TableHead
thead
             in Attr -> [Row] -> Part
rowsToPart Attr
headAttr [Row]
rows
    tbGrids :: [Part]
tbGrids = (TableBody -> Part) -> [TableBody] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map TableBody -> Part
bodyToGrid [TableBody]
tbodies
    tfGrid :: Part
tfGrid = let (TableFoot Attr
footAttr [Row]
rows) = TableFoot
tfoot
             in Attr -> [Row] -> Part
rowsToPart Attr
footAttr [Row]
rows
    bodyToGrid :: TableBody -> Part
bodyToGrid (TableBody Attr
bodyAttr RowHeadColumns
_rowHeadCols [Row]
headRows [Row]
rows) =
      Attr -> [Row] -> Part
rowsToPart Attr
bodyAttr ([Row]
headRows [Row] -> [Row] -> [Row]
forall a. [a] -> [a] -> [a]
++ [Row]
rows)

data BuilderCell
  = FilledCell GridCell
  | FreeCell

fromBuilderCell :: BuilderCell -> GridCell
fromBuilderCell :: BuilderCell -> GridCell
fromBuilderCell = \case
  FilledCell GridCell
c -> GridCell
c
  BuilderCell
FreeCell -> GridCell
UnassignedCell

rowsToPart :: Attr -> [B.Row] -> Part
rowsToPart :: Attr -> [Row] -> Part
rowsToPart Attr
attr = \case
  [] -> Attr
-> Array (RowIndex, ColIndex) GridCell
-> Array RowIndex Attr
-> Part
Part
        Attr
attr
        (((RowIndex, ColIndex), (RowIndex, ColIndex))
-> [GridCell] -> Array (RowIndex, ColIndex) GridCell
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int -> RowIndex
RowIndex Int
1, Int -> ColIndex
ColIndex Int
1), (Int -> RowIndex
RowIndex Int
0, Int -> ColIndex
ColIndex Int
0)) [])
        ((RowIndex, RowIndex) -> [Attr] -> Array RowIndex Attr
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int -> RowIndex
RowIndex Int
1, Int -> RowIndex
RowIndex Int
0) [])
  rows :: [Row]
rows@(Row Attr
_attr [Cell]
firstRow:[Row]
_) ->
    let nrows :: Int
nrows = [Row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Row]
rows
        ncols :: Int
ncols = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Cell -> Int) -> [Cell] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Cell Attr
_ Alignment
_ RowSpan
_ (ColSpan Int
cs) [Block]
_) -> Int
cs) [Cell]
firstRow
        gbounds :: ((RowIndex, ColIndex), (RowIndex, ColIndex))
gbounds = ((Int -> RowIndex
RowIndex Int
1, Int -> ColIndex
ColIndex Int
1), (Int -> RowIndex
RowIndex Int
nrows, Int -> ColIndex
ColIndex Int
ncols))
        mutableGrid :: ST s (STArray s CellIndex GridCell)
        mutableGrid :: forall s. ST s (STArray s (RowIndex, ColIndex) GridCell)
mutableGrid = do
          STArray s (RowIndex, ColIndex) BuilderCell
grid <- ((RowIndex, ColIndex), (RowIndex, ColIndex))
-> BuilderCell -> ST s (STArray s (RowIndex, ColIndex) BuilderCell)
forall i.
Ix i =>
(i, i) -> BuilderCell -> ST s (STArray s i BuilderCell)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((RowIndex, ColIndex), (RowIndex, ColIndex))
gbounds BuilderCell
FreeCell
          STRef s RowIndex
ridx <- RowIndex -> ST s (STRef s RowIndex)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> RowIndex
RowIndex Int
1)
          [Row] -> (Row -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Row]
rows ((Row -> ST s ()) -> ST s ()) -> (Row -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Row Attr
_attr [Cell]
cells) -> do
            STRef s ColIndex
cidx <- ColIndex -> ST s (STRef s ColIndex)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ColIndex
ColIndex Int
1)
            [Cell] -> (Cell -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Cell]
cells ((Cell -> ST s ()) -> ST s ()) -> (Cell -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Cell Attr
cellAttr Alignment
align RowSpan
rs ColSpan
cs [Block]
blks) -> do
              RowIndex
ridx' <- STRef s RowIndex -> ST s RowIndex
forall s a. STRef s a -> ST s a
readSTRef STRef s RowIndex
ridx
              let nextFreeInRow :: ColIndex -> m (Maybe ColIndex)
nextFreeInRow colindex :: ColIndex
colindex@(ColIndex Int
c) = do
                    let idx :: (RowIndex, ColIndex)
idx = (RowIndex
ridx', ColIndex
colindex)
                    if ((RowIndex, ColIndex), (RowIndex, ColIndex))
gbounds ((RowIndex, ColIndex), (RowIndex, ColIndex))
-> (RowIndex, ColIndex) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`inRange` (RowIndex, ColIndex)
idx
                      then STArray s (RowIndex, ColIndex) BuilderCell
-> (RowIndex, ColIndex) -> m BuilderCell
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s (RowIndex, ColIndex) BuilderCell
grid (RowIndex, ColIndex)
idx m BuilderCell
-> (BuilderCell -> m (Maybe ColIndex)) -> m (Maybe ColIndex)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                             BuilderCell
FreeCell -> Maybe ColIndex -> m (Maybe ColIndex)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColIndex -> Maybe ColIndex
forall a. a -> Maybe a
Just ColIndex
colindex)
                             BuilderCell
_ -> ColIndex -> m (Maybe ColIndex)
nextFreeInRow (ColIndex -> m (Maybe ColIndex)) -> ColIndex -> m (Maybe ColIndex)
forall a b. (a -> b) -> a -> b
$ Int -> ColIndex
ColIndex (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                      else Maybe ColIndex -> m (Maybe ColIndex)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ColIndex
forall a. Maybe a
Nothing  -- invalid table
              Maybe ColIndex
mcidx' <- STRef s ColIndex -> ST s ColIndex
forall s a. STRef s a -> ST s a
readSTRef STRef s ColIndex
cidx ST s ColIndex
-> (ColIndex -> ST s (Maybe ColIndex)) -> ST s (Maybe ColIndex)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ColIndex -> ST s (Maybe ColIndex)
forall {m :: * -> *}.
MArray (STArray s) BuilderCell m =>
ColIndex -> m (Maybe ColIndex)
nextFreeInRow
              -- If there is a FreeCell in the current row, then fill it
              -- with the current cell and mark cells in this and the
              -- following rows as continuation cells if necessary.
              --
              -- Just skip the current table cell if no FreeCell was
              -- found; this can only happen with invalid tables.
              case Maybe ColIndex
mcidx' of
                Maybe ColIndex
Nothing -> () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- no FreeCell left in row -- skip cell
                Just ColIndex
cidx' -> do
                  STArray s (RowIndex, ColIndex) BuilderCell
-> (RowIndex, ColIndex) -> BuilderCell -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s (RowIndex, ColIndex) BuilderCell
grid (RowIndex
ridx', ColIndex
cidx') (BuilderCell -> ST s ())
-> (GridCell -> BuilderCell) -> GridCell -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GridCell -> BuilderCell
FilledCell (GridCell -> ST s ()) -> GridCell -> ST s ()
forall a b. (a -> b) -> a -> b
$
                    Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> GridCell
ContentCell Attr
cellAttr Alignment
align RowSpan
rs ColSpan
cs [Block]
blks
                  [(RowIndex, ColIndex)]
-> ((RowIndex, ColIndex) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (RowIndex
-> ColIndex -> RowSpan -> ColSpan -> [(RowIndex, ColIndex)]
continuationIndices RowIndex
ridx' ColIndex
cidx' RowSpan
rs ColSpan
cs) (((RowIndex, ColIndex) -> ST s ()) -> ST s ())
-> ((RowIndex, ColIndex) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(RowIndex, ColIndex)
idx -> do
                    STArray s (RowIndex, ColIndex) BuilderCell
-> (RowIndex, ColIndex) -> BuilderCell -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s (RowIndex, ColIndex) BuilderCell
grid (RowIndex, ColIndex)
idx (BuilderCell -> ST s ())
-> (GridCell -> BuilderCell) -> GridCell -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GridCell -> BuilderCell
FilledCell (GridCell -> ST s ()) -> GridCell -> ST s ()
forall a b. (a -> b) -> a -> b
$
                      (RowIndex, ColIndex) -> GridCell
ContinuationCell (RowIndex
ridx', ColIndex
cidx')
                  -- go to new column
                  STRef s ColIndex -> ColIndex -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ColIndex
cidx ColIndex
cidx'
            -- go to next row
            STRef s RowIndex -> (RowIndex -> RowIndex) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s RowIndex
ridx (RowSpan -> RowIndex -> RowIndex
incrRowIndex RowSpan
1)
          -- Swap BuilderCells with normal GridCells.
          (BuilderCell -> GridCell)
-> STArray s (RowIndex, ColIndex) BuilderCell
-> ST s (STArray s (RowIndex, ColIndex) GridCell)
forall (a :: * -> * -> *) e' (m :: * -> *) e i.
(MArray a e' m, MArray a e m, Ix i) =>
(e' -> e) -> a i e' -> m (a i e)
mapArray BuilderCell -> GridCell
fromBuilderCell STArray s (RowIndex, ColIndex) BuilderCell
grid
    in Part
       { partCellArray :: Array (RowIndex, ColIndex) GridCell
partCellArray = (forall s. ST s (STArray s (RowIndex, ColIndex) GridCell))
-> Array (RowIndex, ColIndex) GridCell
forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray ST s (STArray s (RowIndex, ColIndex) GridCell)
forall s. ST s (STArray s (RowIndex, ColIndex) GridCell)
mutableGrid
       , partRowAttrs :: Array RowIndex Attr
partRowAttrs = (RowIndex, RowIndex) -> [Attr] -> Array RowIndex Attr
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int -> RowIndex
RowIndex Int
1, Int -> RowIndex
RowIndex Int
nrows) ([Attr] -> Array RowIndex Attr) -> [Attr] -> Array RowIndex Attr
forall a b. (a -> b) -> a -> b
$
                        (Row -> Attr) -> [Row] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map (\(Row Attr
rowAttr [Cell]
_) -> Attr
rowAttr) [Row]
rows
       , partAttr :: Attr
partAttr = Attr
attr
       }

continuationIndices :: RowIndex -> ColIndex -> RowSpan -> ColSpan -> [CellIndex]
continuationIndices :: RowIndex
-> ColIndex -> RowSpan -> ColSpan -> [(RowIndex, ColIndex)]
continuationIndices (RowIndex Int
ridx) (ColIndex Int
cidx) RowSpan
rowspan ColSpan
colspan =
  let (RowSpan Int
rs) = RowSpan
rowspan
      (ColSpan Int
cs) = ColSpan
colspan
  in [ (Int -> RowIndex
RowIndex Int
r, Int -> ColIndex
ColIndex Int
c) | Int
r <- [Int
ridx..(Int
ridx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
                                , Int
c <- [Int
cidx..(Int
cidx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
                                , (Int
r, Int
c) (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
ridx, Int
cidx)]

rowArray :: RowIndex -> Array CellIndex GridCell -> Array ColIndex GridCell
rowArray :: RowIndex
-> Array (RowIndex, ColIndex) GridCell -> Array ColIndex GridCell
rowArray RowIndex
ridx Array (RowIndex, ColIndex) GridCell
grid =
  let ((RowIndex
_minRidx, ColIndex
minCidx), (RowIndex
_maxRidx, ColIndex
maxCidx)) = Array (RowIndex, ColIndex) GridCell
-> ((RowIndex, ColIndex), (RowIndex, ColIndex))
forall i e. Array i e -> (i, i)
bounds Array (RowIndex, ColIndex) GridCell
grid
  in (ColIndex, ColIndex)
-> (ColIndex -> (RowIndex, ColIndex))
-> Array (RowIndex, ColIndex) GridCell
-> Array ColIndex GridCell
forall i j e.
(Ix i, Ix j) =>
(i, i) -> (i -> j) -> Array j e -> Array i e
ixmap (ColIndex
minCidx, ColIndex
maxCidx) (RowIndex
ridx,) Array (RowIndex, ColIndex) GridCell
grid

incrRowIndex :: RowSpan -> RowIndex -> RowIndex
incrRowIndex :: RowSpan -> RowIndex -> RowIndex
incrRowIndex (RowSpan Int
n) (RowIndex Int
r) = Int -> RowIndex
RowIndex (Int -> RowIndex) -> Int -> RowIndex
forall a b. (a -> b) -> a -> b
$ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n