{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
   Module      : Text.Pandoc.Parsing.GridTable
   Copyright   : Copyright (C) 2006-2024 John MacFarlane
   License     : GPL-2.0-or-later
   Maintainer  : John MacFarlane <jgm@berkeley.edu>

Shared parsers for plaintext tables.
-}
module Text.Pandoc.Parsing.GridTable
  ( gridTableWith
  , gridTableWith'
  , tableWith
  , tableWith'
  , widthsFromIndices
    -- * Components of a plain-text table
  , 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

-- | Collection of components making up a Table block.
data TableComponents = TableComponents
  { TableComponents -> Attr
tableAttr     :: Attr
  , TableComponents -> Caption
tableCaption  :: Caption
  , TableComponents -> [ColSpec]
tableColSpecs :: [ColSpec]
  , TableComponents -> TableHead
tableHead     :: TableHead
  , TableComponents -> [TableBody]
tableBodies   :: [TableBody]
  , TableComponents -> TableFoot
tableFoot     :: TableFoot
  }

-- | Creates a table block from the collection of table parts.
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

-- | Bundles basic table components into a single value.
toTableComponents :: [Alignment] -> [Double] -> [Blocks] -> [[Blocks]]
                  -> TableComponents
toTableComponents :: [Alignment]
-> [Double] -> [Blocks] -> [[Blocks]] -> TableComponents
toTableComponents = TableNormalization
-> [Alignment]
-> [Double]
-> [Blocks]
-> [[Blocks]]
-> TableComponents
toTableComponents' TableNormalization
NoNormalization

-- | Bundles basic table components into a single value, performing
-- normalizations as necessary.
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

-- | Combine a list of column alignments and column widths into a list
-- of column specifiers. Both input lists should have the same length.
toColSpecs :: [Alignment]   -- ^ column alignments
           -> [Double]      -- ^ column widths
           -> [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

    -- renormalize widths if greater than 100%:
    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

-- | Whether the table header should be normalized, i.e., whether an header row
-- with only empty cells should be omitted.
data TableNormalization
  = NoNormalization
  | NormalizeHeader

--
-- Grid Tables
--

-- | Parse a grid table: starts with row of '-' on top, then header
-- (which may be grid), then the rows, which may be grid, separated by
-- blank lines, and ending with a footer (dashed line followed by blank
-- line).
gridTableWith :: (Monad m, Monad mf, HasLastStrPosition st, HasReaderOptions st)
              => ParsecT Sources st m (mf Blocks)  -- ^ Block list parser
              -> 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

-- | Like @'gridTableWith'@, but returns 'TableComponents' instead of a
-- Table.
gridTableWith' :: (Monad m, Monad mf,
                   HasReaderOptions st, HasLastStrPosition st)
               => TableNormalization
               -> ParsecT Sources st m (mf Blocks) -- ^ Block list parser
               -> 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
  ArrayTable [Text]
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 :: ArrayTable (ParsecT Sources st m (mf Blocks))
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'  -- ensure proper block parsing
                        (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 :: [[Cell (ParsecT Sources st m (mf Blocks))]]
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 :: Cell (f (f Blocks)) -> f (f Cell)
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
  [[mf Cell]]
rows' <- ([Cell (ParsecT Sources st m (mf Blocks))]
 -> ParsecT Sources st m [mf Cell])
-> [[Cell (ParsecT Sources st m (mf Blocks))]]
-> ParsecT Sources st m [[mf Cell]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Cell (ParsecT Sources st m (mf Blocks))
 -> ParsecT Sources st m (mf Cell))
-> [Cell (ParsecT Sources st m (mf Blocks))]
-> ParsecT Sources st m [mf Cell]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Cell (ParsecT Sources st m (mf Blocks))
-> ParsecT Sources st m (mf Cell)
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
Cell (f (f Blocks)) -> f (f Cell)
toPandocCell) [[Cell (ParsecT Sources st m (mf Blocks))]]
rows
  Int
columns <- (ReaderOptions -> Int) -> ParsecT Sources st m Int
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Int
readerColumns
  let colspecs :: [ColSpec]
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
caption = Caption
B.emptyCaption
  mf TableComponents -> ParsecT Sources st m (mf TableComponents)
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (mf TableComponents -> ParsecT Sources st m (mf TableComponents))
-> mf TableComponents -> ParsecT Sources st m (mf TableComponents)
forall a b. (a -> b) -> a -> b
$ do
    [[Cell]]
rows'' <- ([mf Cell] -> mf [Cell]) -> [[mf Cell]] -> mf [[Cell]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [mf Cell] -> mf [Cell]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [[mf Cell]]
rows'
    let headLen :: Int
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 ([Row]
hRows, [Row]
bRows') =
          Int -> [Row] -> ([Row], [Row])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
headLen (([Cell] -> Row) -> [[Cell]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> [Cell] -> Row
B.Row Attr
B.nullAttr) [[Cell]]
rows'')
    let ([Row]
bRows, [Row]
fRows) =
          case ArrayTable [Text] -> Maybe RowIndex
forall a. ArrayTable a -> Maybe RowIndex
GT.arrayTableFoot ArrayTable [Text]
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 :: TableHead
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
          -- normalize header if necessary: remove header if it contains
          -- only a single row in which all cells are empty.
          ([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 :: TableFoot
tfoot = Attr -> [Row] -> TableFoot
B.TableFoot Attr
B.nullAttr [Row]
fRows
    let tbody :: TableBody
tbody = Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
B.TableBody Attr
B.nullAttr RowHeadColumns
0 [] [Row]
bRows
    TableComponents -> mf TableComponents
forall a. a -> mf a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableComponents -> mf TableComponents)
-> TableComponents -> mf TableComponents
forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> TableComponents
TableComponents Attr
nullAttr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody
tbody] TableFoot
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) -- include width of separator
               (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

---

-- | Parse a table using 'headerParser', 'rowParser',
-- 'lineParser', and 'footerParser'.
tableWith :: (Stream s m Char, UpdateSourcePos s Char,
              HasReaderOptions st, Monad mf)
          => ParsecT s st m (mf [Blocks], [Alignment], [Int]) -- ^ header parser
          -> ([Int] -> ParsecT s st m (mf [Blocks]))  -- ^ row parser
          -> ParsecT s st m sep                       -- ^ line parser
          -> ParsecT s st m end                       -- ^ footer parser
          -> 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]) -- ^ header parser
           -> ([Int] -> ParsecT s st m (mf [Blocks]))  -- ^ row parser
           -> ParsecT s st m sep                       -- ^ line parser
           -> ParsecT s st m end                       -- ^ footer parser
           -> 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
  (mf [Blocks]
heads, [Alignment]
aligns, [Int]
indices) <- ParsecT s st m (mf [Blocks], [Alignment], [Int])
headerParser
  mf [[Blocks]]
lines' <- [mf [Blocks]] -> mf [[Blocks]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([mf [Blocks]] -> mf [[Blocks]])
-> ParsecT s st m [mf [Blocks]] -> ParsecT s st m (mf [[Blocks]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> ParsecT s st m (mf [Blocks])
rowParser [Int]
indices ParsecT s st m (mf [Blocks])
-> ParsecT s st m sep -> ParsecT s st m [mf [Blocks]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy1` ParsecT s st m sep
lineParser
  ParsecT s st m end
footerParser
  Int
numColumns <- (ReaderOptions -> Int) -> ParsecT s st m Int
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Int
readerColumns
  let widths :: [Double]
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
  mf TableComponents -> ParsecT s st m (mf TableComponents)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (mf TableComponents -> ParsecT s st m (mf TableComponents))
-> mf TableComponents -> ParsecT s st m (mf TableComponents)
forall a b. (a -> b) -> a -> b
$ TableNormalization
-> [Alignment]
-> [Double]
-> [Blocks]
-> [[Blocks]]
-> TableComponents
toTableComponents' TableNormalization
n11n [Alignment]
aligns [Double]
widths ([Blocks] -> [[Blocks]] -> TableComponents)
-> mf [Blocks] -> mf ([[Blocks]] -> TableComponents)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> mf [Blocks]
heads mf ([[Blocks]] -> TableComponents)
-> mf [[Blocks]] -> mf TableComponents
forall a b. mf (a -> b) -> mf a -> mf b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> mf [[Blocks]]
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]
toHeaderRow :: TableNormalization -> [Blocks] -> [Row]
toHeaderRow = \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)]

-- | Calculate relative widths of table columns, based on indices
widthsFromIndices :: Int      -- Number of columns on terminal
                  -> [Int]    -- Indices
                  -> [Double] -- Fractional relative sizes of columns
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]
                      -- compensate for the fact that intercolumn
                      -- spaces are counted in widths of all columns
                      -- but the last...
                      (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
  [Double] -> [Double]
forall a. HasCallStack => [a] -> [a]
tail [Double]
fracs