{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
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
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)
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)
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)
type CellIndex = (RowIndex, ColIndex)
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]
, :: 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
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
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 ()
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')
STRef s ColIndex -> ColIndex -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ColIndex
cidx ColIndex
cidx'
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)
(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