{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Parsing.GridTable
( gridTableWith
, gridTableWith'
, tableWith
, tableWith'
, widthsFromIndices
, TableComponents (..)
, TableNormalization (..)
, toTableComponents
, toTableComponents'
)
where
import Data.Array (elems)
import Data.Text (Text)
import Safe (lastDef)
import Text.Pandoc.Options (ReaderOptions (readerColumns))
import Text.Pandoc.Builder (Blocks)
import Text.Pandoc.Definition
import Text.Pandoc.Parsing.Capabilities
import Text.Pandoc.Parsing.General
import Text.Pandoc.Sources
import Text.Parsec (Stream (..), ParsecT, optional, sepEndBy1, try)
import qualified Data.Text as T
import qualified Text.GridTable as GT
import qualified Text.Pandoc.Builder as B
data TableComponents = TableComponents
{ TableComponents -> Attr
tableAttr :: Attr
, TableComponents -> Caption
tableCaption :: Caption
, TableComponents -> [ColSpec]
tableColSpecs :: [ColSpec]
, TableComponents -> TableHead
tableHead :: TableHead
, TableComponents -> [TableBody]
tableBodies :: [TableBody]
, :: TableFoot
}
tableFromComponents :: TableComponents -> Blocks
tableFromComponents :: TableComponents -> Blocks
tableFromComponents (TableComponents Attr
attr Caption
capt [ColSpec]
colspecs TableHead
th [TableBody]
tb TableFoot
tf) =
Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Blocks
B.tableWith Attr
attr Caption
capt [ColSpec]
colspecs TableHead
th [TableBody]
tb TableFoot
tf
toTableComponents :: [Alignment] -> [Double] -> [Blocks] -> [[Blocks]]
-> TableComponents
toTableComponents :: [Alignment]
-> [Double] -> [Blocks] -> [[Blocks]] -> TableComponents
toTableComponents = TableNormalization
-> [Alignment]
-> [Double]
-> [Blocks]
-> [[Blocks]]
-> TableComponents
toTableComponents' TableNormalization
NoNormalization
toTableComponents' :: TableNormalization
-> [Alignment] -> [Double] -> [Blocks] -> [[Blocks]]
-> TableComponents
toTableComponents' :: TableNormalization
-> [Alignment]
-> [Double]
-> [Blocks]
-> [[Blocks]]
-> TableComponents
toTableComponents' TableNormalization
normalization [Alignment]
aligns [Double]
widths [Blocks]
heads [[Blocks]]
rows =
let th :: TableHead
th = Attr -> [Row] -> TableHead
TableHead Attr
nullAttr (TableNormalization -> [Blocks] -> [Row]
toHeaderRow TableNormalization
normalization [Blocks]
heads)
tb :: TableBody
tb = Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] (([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
rows)
tf :: TableFoot
tf = Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr []
colspecs :: [ColSpec]
colspecs = [Alignment] -> [Double] -> [ColSpec]
toColSpecs [Alignment]
aligns [Double]
widths
in Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> TableComponents
TableComponents Attr
nullAttr Caption
B.emptyCaption [ColSpec]
colspecs TableHead
th [TableBody
tb] TableFoot
tf
toColSpecs :: [Alignment]
-> [Double]
-> [ColSpec]
toColSpecs :: [Alignment] -> [Double] -> [ColSpec]
toColSpecs [Alignment]
aligns [Double]
widths = [Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns ((Double -> ColWidth) -> [Double] -> [ColWidth]
forall a b. (a -> b) -> [a] -> [b]
map Double -> ColWidth
fromWidth [Double]
widths')
where
fromWidth :: Double -> ColWidth
fromWidth Double
n
| Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double -> ColWidth
ColWidth Double
n
| Bool
otherwise = ColWidth
ColWidthDefault
totalWidth :: Double
totalWidth = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
widths' :: [Double]
widths' = if Double
totalWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1
then [Double]
widths
else (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalWidth) [Double]
widths
data TableNormalization
= NoNormalization
|
gridTableWith :: (Monad m, Monad mf, HasLastStrPosition st, HasReaderOptions st)
=> ParsecT Sources st m (mf Blocks)
-> ParsecT Sources st m (mf Blocks)
gridTableWith :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st, HasReaderOptions st) =>
ParsecT Sources st m (mf Blocks)
-> ParsecT Sources st m (mf Blocks)
gridTableWith ParsecT Sources st m (mf Blocks)
blocks = (TableComponents -> Blocks) -> mf TableComponents -> mf Blocks
forall a b. (a -> b) -> mf a -> mf b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableComponents -> Blocks
tableFromComponents (mf TableComponents -> mf Blocks)
-> ParsecT Sources st m (mf TableComponents)
-> ParsecT Sources st m (mf Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
TableNormalization
-> ParsecT Sources st m (mf Blocks)
-> ParsecT Sources st m (mf TableComponents)
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasReaderOptions st, HasLastStrPosition st) =>
TableNormalization
-> ParsecT Sources st m (mf Blocks)
-> ParsecT Sources st m (mf TableComponents)
gridTableWith' TableNormalization
NoNormalization ParsecT Sources st m (mf Blocks)
blocks
gridTableWith' :: (Monad m, Monad mf,
HasReaderOptions st, HasLastStrPosition st)
=> TableNormalization
-> ParsecT Sources st m (mf Blocks)
-> ParsecT Sources st m (mf TableComponents)
gridTableWith' :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasReaderOptions st, HasLastStrPosition st) =>
TableNormalization
-> ParsecT Sources st m (mf Blocks)
-> ParsecT Sources st m (mf TableComponents)
gridTableWith' TableNormalization
normalization ParsecT Sources st m (mf Blocks)
blocks = do
tbl <- ParsecT Sources st m (ArrayTable [Text])
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (ArrayTable [Text])
GT.gridTable ParsecT Sources st m (ArrayTable [Text])
-> ParsecT Sources st m ()
-> ParsecT Sources st m (ArrayTable [Text])
forall a b.
ParsecT Sources st m a
-> ParsecT Sources st m b -> ParsecT Sources st m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources st m Text -> ParsecT Sources st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
let blkTbl = ([Text] -> ParsecT Sources st m (mf Blocks))
-> ArrayTable [Text]
-> ArrayTable (ParsecT Sources st m (mf Blocks))
forall a b. (a -> b) -> ArrayTable a -> ArrayTable b
GT.mapCells
(\[Text]
lns -> ParsecT Sources st m (mf Blocks)
-> Text -> ParsecT Sources st m (mf Blocks)
forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParsecT Sources u m a -> Text -> ParsecT Sources u m a
parseFromString' ParsecT Sources st m (mf Blocks)
blocks
(Text -> ParsecT Sources st m (mf Blocks))
-> ([Text] -> Text) -> [Text] -> ParsecT Sources st m (mf Blocks)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
'\n'
(Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
removeOneLeadingSpace
([Text] -> ParsecT Sources st m (mf Blocks))
-> [Text] -> ParsecT Sources st m (mf Blocks)
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.stripEnd [Text]
lns)
ArrayTable [Text]
tbl
let rows = ArrayTable (ParsecT Sources st m (mf Blocks))
-> [[Cell (ParsecT Sources st m (mf Blocks))]]
forall a. ArrayTable a -> [[Cell a]]
GT.rows ArrayTable (ParsecT Sources st m (mf Blocks))
blkTbl
let toPandocCell (GT.Cell f (f Blocks)
c (GT.RowSpan Int
rs) (GT.ColSpan Int
cs)) =
(Blocks -> Cell) -> f Blocks -> f Cell
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
B.cell Alignment
AlignDefault (Int -> RowSpan
B.RowSpan Int
rs) (Int -> ColSpan
B.ColSpan Int
cs) (Blocks -> Cell) -> (Blocks -> Blocks) -> Blocks -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
plainify) (f Blocks -> f Cell) -> f (f Blocks) -> f (f Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f Blocks)
c
rows' <- mapM (mapM toPandocCell) rows
columns <- getOption readerColumns
let colspecs = ((Alignment, Int) -> Double -> ColSpec)
-> [(Alignment, Int)] -> [Double] -> [ColSpec]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Alignment, Int)
cs Double
w -> (Alignment -> Alignment
convAlign (Alignment -> Alignment) -> Alignment -> Alignment
forall a b. (a -> b) -> a -> b
$ (Alignment, Int) -> Alignment
forall a b. (a, b) -> a
fst (Alignment, Int)
cs, Double -> ColWidth
B.ColWidth Double
w))
(Array ColIndex (Alignment, Int) -> [(Alignment, Int)]
forall i e. Array i e -> [e]
elems (Array ColIndex (Alignment, Int) -> [(Alignment, Int)])
-> Array ColIndex (Alignment, Int) -> [(Alignment, Int)]
forall a b. (a -> b) -> a -> b
$ ArrayTable [Text] -> Array ColIndex (Alignment, Int)
forall a. ArrayTable a -> Array ColIndex (Alignment, Int)
GT.arrayTableColSpecs ArrayTable [Text]
tbl)
(ArrayTable [Text] -> Int -> [Double]
forall a. ArrayTable a -> Int -> [Double]
fractionalColumnWidths ArrayTable [Text]
tbl Int
columns)
let caption = Caption
B.emptyCaption
return $ do
rows'' <- mapM sequence rows'
let headLen = Int -> (RowIndex -> Int) -> Maybe RowIndex -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 RowIndex -> Int
GT.fromRowIndex (Maybe RowIndex -> Int) -> Maybe RowIndex -> Int
forall a b. (a -> b) -> a -> b
$ ArrayTable [Text] -> Maybe RowIndex
forall a. ArrayTable a -> Maybe RowIndex
GT.arrayTableHead ArrayTable [Text]
tbl
let (hRows, bRows') =
splitAt headLen (map (B.Row B.nullAttr) rows'')
let (bRows, fRows) =
case GT.arrayTableFoot tbl of
Just RowIndex
fIdx -> Int -> [Row] -> ([Row], [Row])
forall a. Int -> [a] -> ([a], [a])
splitAt (RowIndex -> Int
GT.fromRowIndex RowIndex
fIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
headLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Row]
bRows'
Maybe RowIndex
Nothing -> ([Row]
bRows', [])
let thead = Attr -> [Row] -> TableHead
B.TableHead Attr
B.nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ case ([Row]
hRows, TableNormalization
normalization) of
([Row
hrow], TableNormalization
NormalizeHeader) ->
let Row Attr
_attr [Cell]
cells = Row
hrow
simple :: Cell -> Bool
simple = \case
Cell (Text
"",[],[]) Alignment
AlignDefault (RowSpan Int
1) (ColSpan Int
1) [] ->
Bool
True
Cell
_ ->
Bool
False
in [Attr -> [Cell] -> Row
B.Row Attr
nullAttr [Cell]
cells | Bool -> Bool
not ([Cell] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cell]
cells) Bool -> Bool -> Bool
&&
Bool -> Bool
not ((Cell -> Bool) -> [Cell] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Cell -> Bool
simple [Cell]
cells)]
([Row], TableNormalization)
_ -> [Row]
hRows
let tfoot = Attr -> [Row] -> TableFoot
B.TableFoot Attr
B.nullAttr [Row]
fRows
let tbody = Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
B.TableBody Attr
B.nullAttr RowHeadColumns
0 [] [Row]
bRows
return $ TableComponents nullAttr caption colspecs thead [tbody] tfoot
removeOneLeadingSpace :: [Text] -> [Text]
removeOneLeadingSpace :: [Text] -> [Text]
removeOneLeadingSpace [Text]
xs =
if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
startsWithSpace [Text]
xs
then (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.drop Int
1) [Text]
xs
else [Text]
xs
where startsWithSpace :: Text -> Bool
startsWithSpace Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> Bool
True
Just (Char
c, Text
_) -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
plainify :: B.Blocks -> B.Blocks
plainify :: Blocks -> Blocks
plainify Blocks
blks = case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
blks of
[Para [Inline]
x] -> [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [[Inline] -> Block
Plain [Inline]
x]
[Block]
_ -> Blocks
blks
convAlign :: GT.Alignment -> B.Alignment
convAlign :: Alignment -> Alignment
convAlign Alignment
GT.AlignLeft = Alignment
B.AlignLeft
convAlign Alignment
GT.AlignRight = Alignment
B.AlignRight
convAlign Alignment
GT.AlignCenter = Alignment
B.AlignCenter
convAlign Alignment
GT.AlignDefault = Alignment
B.AlignDefault
fractionalColumnWidths :: GT.ArrayTable a -> Int -> [Double]
fractionalColumnWidths :: forall a. ArrayTable a -> Int -> [Double]
fractionalColumnWidths ArrayTable a
gt Int
charColumns =
let widths :: [Int]
widths = ((Alignment, Int) -> Int) -> [(Alignment, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int)
-> ((Alignment, Int) -> Int) -> (Alignment, Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alignment, Int) -> Int
forall a b. (a, b) -> b
snd)
(Array ColIndex (Alignment, Int) -> [(Alignment, Int)]
forall i e. Array i e -> [e]
elems (Array ColIndex (Alignment, Int) -> [(Alignment, Int)])
-> Array ColIndex (Alignment, Int) -> [(Alignment, Int)]
forall a b. (a -> b) -> a -> b
$ ArrayTable a -> Array ColIndex (Alignment, Int)
forall a. ArrayTable a -> Array ColIndex (Alignment, Int)
GT.arrayTableColSpecs ArrayTable a
gt)
norm :: Double
norm = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widths Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
widths Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
charColumns
in (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
w -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
norm) [Int]
widths
tableWith :: (Stream s m Char, UpdateSourcePos s Char,
HasReaderOptions st, Monad mf)
=> ParsecT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParsecT s st m (mf [Blocks]))
-> ParsecT s st m sep
-> ParsecT s st m end
-> ParsecT s st m (mf Blocks)
tableWith :: forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
Monad mf) =>
ParsecT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParsecT s st m (mf [Blocks]))
-> ParsecT s st m sep
-> ParsecT s st m end
-> ParsecT s st m (mf Blocks)
tableWith ParsecT s st m (mf [Blocks], [Alignment], [Int])
hp [Int] -> ParsecT s st m (mf [Blocks])
rp ParsecT s st m sep
lp ParsecT s st m end
fp = (TableComponents -> Blocks) -> mf TableComponents -> mf Blocks
forall a b. (a -> b) -> mf a -> mf b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableComponents -> Blocks
tableFromComponents (mf TableComponents -> mf Blocks)
-> ParsecT s st m (mf TableComponents)
-> ParsecT s st m (mf Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
TableNormalization
-> ParsecT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParsecT s st m (mf [Blocks]))
-> ParsecT s st m sep
-> ParsecT s st m end
-> ParsecT s st m (mf TableComponents)
forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
Monad mf) =>
TableNormalization
-> ParsecT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParsecT s st m (mf [Blocks]))
-> ParsecT s st m sep
-> ParsecT s st m end
-> ParsecT s st m (mf TableComponents)
tableWith' TableNormalization
NoNormalization ParsecT s st m (mf [Blocks], [Alignment], [Int])
hp [Int] -> ParsecT s st m (mf [Blocks])
rp ParsecT s st m sep
lp ParsecT s st m end
fp
tableWith' :: (Stream s m Char, UpdateSourcePos s Char,
HasReaderOptions st, Monad mf)
=> TableNormalization
-> ParsecT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParsecT s st m (mf [Blocks]))
-> ParsecT s st m sep
-> ParsecT s st m end
-> ParsecT s st m (mf TableComponents)
tableWith' :: forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
Monad mf) =>
TableNormalization
-> ParsecT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParsecT s st m (mf [Blocks]))
-> ParsecT s st m sep
-> ParsecT s st m end
-> ParsecT s st m (mf TableComponents)
tableWith' TableNormalization
n11n ParsecT s st m (mf [Blocks], [Alignment], [Int])
headerParser [Int] -> ParsecT s st m (mf [Blocks])
rowParser ParsecT s st m sep
lineParser ParsecT s st m end
footerParser = ParsecT s st m (mf TableComponents)
-> ParsecT s st m (mf TableComponents)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m (mf TableComponents)
-> ParsecT s st m (mf TableComponents))
-> ParsecT s st m (mf TableComponents)
-> ParsecT s st m (mf TableComponents)
forall a b. (a -> b) -> a -> b
$ do
(heads, aligns, indices) <- ParsecT s st m (mf [Blocks], [Alignment], [Int])
headerParser
lines' <- sequence <$> rowParser indices `sepEndBy1` lineParser
footerParser
numColumns <- getOption readerColumns
let widths = if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
indices
then Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns) Double
0.0
else Int -> [Int] -> [Double]
widthsFromIndices Int
numColumns [Int]
indices
return $ toTableComponents' n11n aligns widths <$> heads <*> lines'
toRow :: [Blocks] -> Row
toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
B.simpleCell
toHeaderRow :: TableNormalization -> [Blocks] -> [Row]
= \case
TableNormalization
NoNormalization -> \[Blocks]
l -> [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
TableNormalization
NormalizeHeader -> \[Blocks]
l -> [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Blocks -> Bool) -> [Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Blocks -> Bool
forall a. Many a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
widthsFromIndices :: Int
-> [Int]
-> [Double]
widthsFromIndices :: Int -> [Int] -> [Double]
widthsFromIndices Int
_ [] = []
widthsFromIndices Int
numColumns' [Int]
indices =
let numColumns :: Int
numColumns = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
numColumns' (Int -> [Int] -> Int
forall a. a -> [a] -> a
lastDef Int
0 [Int]
indices)
lengths' :: [Int]
lengths' = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
indices (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
indices)
lengths :: [Int]
lengths = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
case [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
lengths' of
[] -> []
[Int
x] -> [Int
x]
(Int
x:Int
y:[Int]
zs) -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y Bool -> Bool -> Bool
&& Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2
then Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
zs
else Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
zs
totLength :: Int
totLength = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
lengths
quotient :: Double
quotient = if Int
totLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
numColumns
then Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totLength
else Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numColumns
fracs :: [Double]
fracs = (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
quotient) [Int]
lengths in
Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop Int
1 [Double]
fracs