{-# 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 Control.Monad (guard)
import Data.List (transpose)
import Data.Text (Text)
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.Shared (compactify, splitTextByIndices, trim, trimr)
import Text.Pandoc.Sources
import Text.Parsec
  ( Stream (..), many1, notFollowedBy, option, optional, sepEndBy1, try )

import qualified Data.Text as T
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 (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)
              => ParserT Sources st m (mf Blocks)  -- ^ Block list parser
              -> Bool                              -- ^ Headerless table
              -> 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)
-> Bool -> ParserT Sources st m (mf Blocks)
gridTableWith ParserT Sources st m (mf Blocks)
blocks Bool
headless =
  ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT Sources st m (mf [Blocks]))
-> ParserT Sources st m Char
-> ParserT Sources st m ()
-> ParserT Sources st m (mf Blocks)
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 (Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
gridTableHeader Bool
headless ParserT Sources st m (mf Blocks)
blocks) (ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
gridTableRow ParserT Sources st m (mf Blocks)
blocks)
            (Char -> ParserT Sources st m Char
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m Char
gridTableSep Char
'-') ParserT Sources st m ()
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m ()
gridTableFooter

-- | 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
               -> Bool                             -- ^ Headerless table
               -> 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)
-> Bool
-> ParserT Sources st m (mf TableComponents)
gridTableWith' TableNormalization
normalization ParserT Sources st m (mf Blocks)
blocks Bool
headless =
  TableNormalization
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT Sources st m (mf [Blocks]))
-> ParserT Sources st m Char
-> ParserT Sources st m ()
-> ParserT Sources st m (mf TableComponents)
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
normalization
             (Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
gridTableHeader Bool
headless ParserT Sources st m (mf Blocks)
blocks) (ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
gridTableRow ParserT Sources st m (mf Blocks)
blocks)
             (Char -> ParserT Sources st m Char
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m Char
gridTableSep Char
'-') ParserT Sources st m ()
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m ()
gridTableFooter

gridTableSplitLine :: [Int] -> Text -> [Text]
gridTableSplitLine :: [Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices Text
line = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
removeFinalBar ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
  [Int] -> Text -> [Text]
splitTextByIndices ([Int] -> [Int]
forall a. [a] -> [a]
init [Int]
indices) (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimr Text
line

-- | Parses a grid segment, where the grid line is made up from the
-- given char and terminated with a plus (@+@). The grid line may begin
-- and/or end with a colon, signaling column alignment. Returns the size
-- of the grid part and column alignment
gridPart :: Monad m => Char -> ParserT Sources st m (Int, Alignment)
gridPart :: forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m (Int, Alignment)
gridPart Char
ch = do
  Bool
leftColon <- Bool -> ParsecT Sources st m Bool -> ParsecT Sources st m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool -> ParsecT Sources st m Char -> ParsecT Sources st m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':')
  [Char]
dashes <- ParsecT Sources st m Char -> ParsecT Sources st m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
ch)
  Bool
rightColon <- Bool -> ParsecT Sources st m Bool -> ParsecT Sources st m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool -> ParsecT Sources st m Char -> ParsecT Sources st m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':')
  Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'+'
  let lengthDashes :: Int
lengthDashes = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
dashes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
leftColon then Int
1 else Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                       (if Bool
rightColon then Int
1 else Int
0)
  let alignment :: Alignment
alignment = case (Bool
leftColon, Bool
rightColon) of
                       (Bool
True, Bool
True)   -> Alignment
AlignCenter
                       (Bool
True, Bool
False)  -> Alignment
AlignLeft
                       (Bool
False, Bool
True)  -> Alignment
AlignRight
                       (Bool
False, Bool
False) -> Alignment
AlignDefault
  (Int, Alignment) -> ParserT Sources st m (Int, Alignment)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
lengthDashes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Alignment
alignment)

gridDashedLines :: Monad m
                => Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines :: forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
ch = ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m [(Int, Alignment)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m [(Int, Alignment)]
 -> ParsecT Sources st m [(Int, Alignment)])
-> ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m [(Int, Alignment)]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT Sources st m Char
-> ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m [(Int, Alignment)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources st m (Int, Alignment)
-> ParsecT Sources st m [(Int, Alignment)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Sources st m (Int, Alignment)
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m (Int, Alignment)
gridPart Char
ch) ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m Char
-> ParsecT Sources st m [(Int, Alignment)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline

removeFinalBar :: Text -> Text
removeFinalBar :: Text -> Text
removeFinalBar = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
go (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'|')
  where
    go :: Char -> Bool
go Char
c = (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
" \t"

-- | Separator between rows of grid table.
gridTableSep :: Monad m => Char -> ParserT Sources st m Char
gridTableSep :: forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m Char
gridTableSep Char
ch = ParsecT Sources st m Char -> ParsecT Sources st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m Char -> ParsecT Sources st m Char)
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParserT Sources st m [(Int, Alignment)]
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
ch ParserT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources st m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'

-- | Parse header for a grid table.
gridTableHeader :: (Monad m, Monad mf, HasLastStrPosition st)
                => Bool -- ^ Headerless table
                -> ParserT Sources st m (mf Blocks)
                -> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
gridTableHeader :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
gridTableHeader Bool
True ParserT Sources st m (mf Blocks)
_ = do
  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) =>
ParserT s st m Text
blanklines
  [(Int, Alignment)]
dashes <- Char -> ParserT Sources st m [(Int, Alignment)]
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
'-'
  let aligns :: [Alignment]
aligns = ((Int, Alignment) -> Alignment)
-> [(Int, Alignment)] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Alignment) -> Alignment
forall a b. (a, b) -> b
snd [(Int, Alignment)]
dashes
  let lines' :: [Int]
lines'   = ((Int, Alignment) -> Int) -> [(Int, Alignment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Alignment) -> Int
forall a b. (a, b) -> a
fst [(Int, Alignment)]
dashes
  let indices :: [Int]
indices  = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
lines'
  (mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks] -> mf [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return [], [Alignment]
aligns, [Int]
indices)
gridTableHeader Bool
False ParserT Sources st m (mf Blocks)
blocks = ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Sources st m (mf [Blocks], [Alignment], [Int])
 -> ParserT Sources st m (mf [Blocks], [Alignment], [Int]))
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall a b. (a -> b) -> a -> b
$ do
  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) =>
ParserT s st m Text
blanklines
  [(Int, Alignment)]
dashes <- Char -> ParserT Sources st m [(Int, Alignment)]
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
'-'
  [Text]
rawContent  <- ParsecT Sources st m Text -> ParsecT Sources st m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources st m Char -> ParsecT Sources st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Sources st m Char
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m Char
gridTableSep Char
'=') ParsecT Sources st m ()
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Sources st m Char
-> ParsecT Sources st m Text -> ParsecT Sources st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                           [Char] -> Text
T.pack ([Char] -> Text)
-> ParsecT Sources st m [Char] -> ParsecT Sources st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources st m Char
-> ParsecT Sources st m Char -> ParsecT Sources st m [Char]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline)
  [(Int, Alignment)]
underDashes <- Char -> ParserT Sources st m [(Int, Alignment)]
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
'='
  Bool -> ParsecT Sources st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources st m ())
-> Bool -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ [(Int, Alignment)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Alignment)]
dashes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Int, Alignment)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Alignment)]
underDashes
  let lines' :: [Int]
lines'   = ((Int, Alignment) -> Int) -> [(Int, Alignment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Alignment) -> Int
forall a b. (a, b) -> a
fst [(Int, Alignment)]
underDashes
  let indices :: [Int]
indices  = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
lines'
  let aligns :: [Alignment]
aligns   = ((Int, Alignment) -> Alignment)
-> [(Int, Alignment)] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Alignment) -> Alignment
forall a b. (a, b) -> b
snd [(Int, Alignment)]
underDashes
  let rawHeads :: [Text]
rawHeads = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trim) ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose
                       ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ (Text -> [Text]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices) [Text]
rawContent
  mf [Blocks]
heads <- [mf Blocks] -> mf [Blocks]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([mf Blocks] -> mf [Blocks])
-> ParsecT Sources st m [mf Blocks]
-> ParsecT Sources st m (mf [Blocks])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParserT Sources st m (mf Blocks))
-> [Text] -> ParsecT Sources st m [mf Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Sources st m (mf Blocks)
-> Text -> ParserT Sources st m (mf Blocks)
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 (Text -> ParserT Sources st m (mf Blocks))
-> (Text -> Text) -> Text -> ParserT Sources st m (mf Blocks)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim) [Text]
rawHeads
  (mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return (mf [Blocks]
heads, [Alignment]
aligns, [Int]
indices)

gridTableRawLine :: (Stream s m Char, UpdateSourcePos s Char)
                 => [Int] -> ParserT s st m [Text]
gridTableRawLine :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Int] -> ParserT s st m [Text]
gridTableRawLine [Int]
indices = do
  Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|'
  [Char]
line <- ParsecT s st m Char -> ParsecT s st m Char -> ParserT s st m [Char]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
  [Text] -> ParserT s st m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
line)

-- | Parse row of grid table.
gridTableRow :: (Monad m, Monad mf, HasLastStrPosition st)
             => ParserT Sources st m (mf Blocks)
             -> [Int]
             -> ParserT Sources st m (mf [Blocks])
gridTableRow :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
gridTableRow ParserT Sources st m (mf Blocks)
blocks [Int]
indices = do
  [[Text]]
colLines <- ParsecT Sources st m [Text] -> ParsecT Sources st m [[Text]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Int] -> ParsecT Sources st m [Text]
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Int] -> ParserT s st m [Text]
gridTableRawLine [Int]
indices)
  let cols :: [Text]
cols = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\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]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$
               [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose [[Text]]
colLines
      compactifyCell :: Blocks -> Blocks
compactifyCell Blocks
bs = case [Blocks] -> [Blocks]
compactify [Blocks
bs] of
                            []  -> Blocks
forall a. Monoid a => a
mempty
                            Blocks
x:[Blocks]
_ -> Blocks
x
  mf [Blocks]
cells <- [mf Blocks] -> mf [Blocks]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([mf Blocks] -> mf [Blocks])
-> ParsecT Sources st m [mf Blocks]
-> ParserT Sources st m (mf [Blocks])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParserT Sources st m (mf Blocks))
-> [Text] -> ParsecT Sources st m [mf Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Sources st m (mf Blocks)
-> Text -> ParserT Sources st m (mf Blocks)
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) [Text]
cols
  mf [Blocks] -> ParserT Sources st m (mf [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return (mf [Blocks] -> ParserT Sources st m (mf [Blocks]))
-> mf [Blocks] -> ParserT Sources st m (mf [Blocks])
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> [Blocks]) -> mf [Blocks] -> mf [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Blocks
compactifyCell) mf [Blocks]
cells

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
' '

-- | Parse footer for a grid table.
gridTableFooter :: (Stream s m Char, UpdateSourcePos s Char)
                => ParserT s st m ()
gridTableFooter :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m ()
gridTableFooter = ParsecT s st m Text -> ParsecT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines

---

-- | 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 = (TableComponents -> Blocks) -> mf TableComponents -> mf Blocks
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
-> 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
-> 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
-> 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 = 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) <- ParserT 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)
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] -> ParserT s st m (mf [Blocks])
rowParser [Int]
indices ParserT s st m (mf [Blocks])
-> ParserT 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` ParserT s st m sep
lineParser
  ParserT s st m end
footerParser
  Int
numColumns <- (ReaderOptions -> Int) -> ParserT s st m Int
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 [Int] -> 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 (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 (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 (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 (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 (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 (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' (if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
indices then Int
0 else [Int] -> Int
forall a. [a] -> a
last [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 (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. [a] -> [a]
tail [Double]
fracs