{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
   Module      : Text.Pandoc.Parsing.GridTable
   Copyright   : Copyright (C) 2006-2022 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.Parsing.Types
import Text.Pandoc.Sources
import Text.Parsec (Stream (..), 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 [] (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 = forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns (forall a b. (a -> b) -> [a] -> [b]
map Double -> ColWidth
fromWidth [Double]
widths')
  where
    fromWidth :: Double -> ColWidth
fromWidth Double
n
      | Double
n 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
    widths' :: [Double]
widths' = if Double
totalWidth forall a. Ord a => a -> a -> Bool
< Double
1
              then [Double]
widths
              else forall a b. (a -> b) -> [a] -> [b]
map (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)
              => ParserT Sources st m (mf Blocks)  -- ^ Block list parser
              -> ParserT Sources st m (mf Blocks)
gridTableWith :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st, HasReaderOptions st) =>
ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf Blocks)
gridTableWith ParserT Sources st m (mf Blocks)
blocks = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableComponents -> Blocks
tableFromComponents forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasReaderOptions st, HasLastStrPosition st) =>
TableNormalization
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf TableComponents)
gridTableWith' TableNormalization
NoNormalization ParserT 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
               -> ParserT Sources st m (mf Blocks) -- ^ Block list parser
               -> ParserT Sources st m (mf TableComponents)
gridTableWith' :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasReaderOptions st, HasLastStrPosition st) =>
TableNormalization
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf TableComponents)
gridTableWith' TableNormalization
normalization ParserT Sources st m (mf Blocks)
blocks = do
  ArrayTable [Text]
tbl <- forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (ArrayTable [Text])
GT.gridTable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
  let blkTbl :: ArrayTable (ParserT Sources st m (mf Blocks))
blkTbl = forall a b. (a -> b) -> ArrayTable a -> ArrayTable b
GT.mapCells
               (\[Text]
lns -> forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' ParserT Sources st m (mf Blocks)
blocks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
'\n'  -- ensure proper block parsing
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
removeOneLeadingSpace
                        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.stripEnd [Text]
lns)
               ArrayTable [Text]
tbl
  let rows :: [[Cell (ParserT Sources st m (mf Blocks))]]
rows = forall a. ArrayTable a -> [[Cell a]]
GT.rows ArrayTable (ParserT 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)) =
        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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
plainify) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f Blocks)
c
  [[mf Cell]]
rows' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
Cell (f (f Blocks)) -> f (f Cell)
toPandocCell) [[Cell (ParserT Sources st m (mf Blocks))]]
rows
  Int
columns <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Int
readerColumns
  let colspecs :: [ColSpec]
colspecs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Alignment, Int)
cs Double
w -> (Alignment -> Alignment
convAlign forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Alignment, Int)
cs, Double -> ColWidth
B.ColWidth Double
w))
                         (forall i e. Array i e -> [e]
elems forall a b. (a -> b) -> a -> b
$ forall a. ArrayTable a -> Array ColIndex (Alignment, Int)
GT.arrayTableColSpecs ArrayTable [Text]
tbl)
                         (forall a. ArrayTable a -> Int -> [Double]
fractionalColumnWidths ArrayTable [Text]
tbl Int
columns)
  let caption :: Caption
caption = Caption
B.emptyCaption
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
    [[Cell]]
rows'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [[mf Cell]]
rows'
    let ([Row]
hRows, [Row]
bRows) =
          forall a. Int -> [a] -> ([a], [a])
splitAt (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 RowIndex -> Int
GT.fromRowIndex forall a b. (a -> b) -> a -> b
$ forall a. ArrayTable a -> Maybe RowIndex
GT.arrayTableHead ArrayTable [Text]
tbl)
                  (forall a b. (a -> b) -> [a] -> [b]
map (Attr -> [Cell] -> Row
B.Row Attr
B.nullAttr) [[Cell]]
rows'')
    let thead :: TableHead
thead = Attr -> [Row] -> TableHead
B.TableHead Attr
B.nullAttr 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cell]
cells) Bool -> Bool -> Bool
&&
                                       Bool -> Bool
not (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 []
    let tbody :: TableBody
tbody = Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
B.TableBody Attr
B.nullAttr RowHeadColumns
0 [] [Row]
bRows
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
startsWithSpace [Text]
xs
     then 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 forall a. Eq a => a -> a -> Bool
== Char
' '

plainify :: B.Blocks -> B.Blocks
plainify :: Blocks -> Blocks
plainify Blocks
blks = case forall a. Many a -> [a]
B.toList Blocks
blks of
  [Para [Inline]
x] -> 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 = forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ -- include width of separator
               (forall i e. Array i e -> [e]
elems forall a b. (a -> b) -> a -> b
$ forall a. ArrayTable a -> Array ColIndex (Alignment, Int)
GT.arrayTableColSpecs ArrayTable a
gt)
      norm :: Double
norm = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widths forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
widths forall a. Num a => a -> a -> a
- Int
2) Int
charColumns
  in forall a b. (a -> b) -> [a] -> [b]
map (\Int
w -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w 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)
          => ParserT s st m (mf [Blocks], [Alignment], [Int]) -- ^ header parser
          -> ([Int] -> ParserT s st m (mf [Blocks]))  -- ^ row parser
          -> ParserT s st m sep                       -- ^ line parser
          -> ParserT s st m end                       -- ^ footer parser
          -> ParserT s st m (mf Blocks)
tableWith :: forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
 Monad mf) =>
ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf Blocks)
tableWith ParserT s st m (mf [Blocks], [Alignment], [Int])
hp [Int] -> ParserT s st m (mf [Blocks])
rp ParserT s st m sep
lp ParserT s st m end
fp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableComponents -> Blocks
tableFromComponents forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
 Monad mf) =>
TableNormalization
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf TableComponents)
tableWith' TableNormalization
NoNormalization ParserT s st m (mf [Blocks], [Alignment], [Int])
hp [Int] -> ParserT s st m (mf [Blocks])
rp ParserT s st m sep
lp ParserT s st m end
fp

tableWith' :: (Stream s m Char, UpdateSourcePos s Char,
               HasReaderOptions st, Monad mf)
           => TableNormalization
           -> ParserT s st m (mf [Blocks], [Alignment], [Int]) -- ^ header parser
           -> ([Int] -> ParserT s st m (mf [Blocks]))  -- ^ row parser
           -> ParserT s st m sep                       -- ^ line parser
           -> ParserT s st m end                       -- ^ footer parser
           -> ParserT 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
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf TableComponents)
tableWith' TableNormalization
n11n ParserT s st m (mf [Blocks], [Alignment], [Int])
headerParser [Int] -> ParserT s st m (mf [Blocks])
rowParser ParserT s st m sep
lineParser ParserT s st m end
footerParser = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (mf [Blocks]
heads, [Alignment]
aligns, [Int]
indices) <- ParserT s st m (mf [Blocks], [Alignment], [Int])
headerParser
  mf [[Blocks]]
lines' <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> ParserT s st m (mf [Blocks])
rowParser [Int]
indices 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` ParserT s st m sep
lineParser
  ParserT s st m end
footerParser
  Int
numColumns <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Int
readerColumns
  let widths :: [Double]
widths = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
indices
               then forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns) Double
0.0
               else Int -> [Int] -> [Double]
widthsFromIndices Int
numColumns [Int]
indices
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TableNormalization
-> [Alignment]
-> [Double]
-> [Blocks]
-> [[Blocks]]
-> TableComponents
toTableComponents' TableNormalization
n11n [Alignment]
aligns [Double]
widths forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> mf [Blocks]
heads 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
  TableNormalization
NormalizeHeader -> \[Blocks]
l -> [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all 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 = forall a. Ord a => a -> a -> a
max Int
numColumns' (forall a. a -> [a] -> a
lastDef Int
0 [Int]
indices)
      lengths' :: [Int]
lengths' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
indices (Int
0forall a. a -> [a] -> [a]
:[Int]
indices)
      lengths :: [Int]
lengths  = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
                 case 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 forall a. Ord a => a -> a -> Bool
< Int
y Bool -> Bool -> Bool
&& Int
y forall a. Num a => a -> a -> a
- Int
x forall a. Ord a => a -> a -> Bool
<= Int
2
                                     then Int
yforall a. a -> [a] -> [a]
:Int
yforall a. a -> [a] -> [a]
:[Int]
zs
                                     else Int
xforall a. a -> [a] -> [a]
:Int
yforall a. a -> [a] -> [a]
:[Int]
zs
      totLength :: Int
totLength = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
lengths
      quotient :: Double
quotient = if Int
totLength forall a. Ord a => a -> a -> Bool
> Int
numColumns
                   then forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totLength
                   else forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numColumns
      fracs :: [Double]
fracs = forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l forall a. Fractional a => a -> a -> a
/ Double
quotient) [Int]
lengths in
  forall a. [a] -> [a]
tail [Double]
fracs