    {-# LANGUAGE LambdaCase        #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ViewPatterns      #-}
    {- |
       Module      : Text.Pandoc.Readers.HTML.Table
       Copyright   : © 2006-2024 John MacFarlane,
                       2020-2024 Albert Krewinkel
       License     : GNU GPL, version 2 or above

       Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>
       Stability   : alpha
       Portability : portable

    HTML table parser.
    -}
    module Text.Pandoc.Readers.HTML.Table (pTable) where

    import qualified Data.Vector as V
    import Control.Applicative ((<|>))
    import Data.Maybe (fromMaybe, isJust)
    import Data.Either (lefts, rights)
    import Data.List.NonEmpty (nonEmpty)
    import qualified Data.List as L
    import Data.Text (Text)
    import Text.HTML.TagSoup
    import Text.Pandoc.Builder (Blocks)
    import Text.Pandoc.CSS (cssAttributes)
    import Text.Pandoc.Definition
    import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
    import Text.Pandoc.Parsing
      ( eof, lookAhead, many, many1, manyTill, option, optional
      , optionMaybe, skipMany, try )
    import Text.Pandoc.Readers.HTML.Parsing
    import Text.Pandoc.Readers.HTML.Types (TagParser)
    import Text.Pandoc.Shared (onlySimpleTableCells, safeRead)
    import qualified Data.Text as T
    import qualified Text.Pandoc.Builder as B
    import Control.Monad (guard)

    -- | Parses a @<col>@ element, returning the column's width.
    -- An Either value is used:  Left i means a "relative length" with
    -- integral value i (see https://www.w3.org/TR/html4/types.html#h-6.6);
    -- Right w means a regular width.  Defaults to @'Right ColWidthDefault'@
    -- if the width is not set or cannot be determined.
    pCol :: PandocMonad m => TagParser m (Either Int ColWidth)
    pCol :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m (Either Int ColWidth)
    pCol = ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Int ColWidth)
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Int ColWidth)
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT
       [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Int ColWidth)
     -> ParsecT
          [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Int ColWidth))
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Int ColWidth)
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Int ColWidth)
    forall a b. (a -> b) -> a -> b
    $ do
      TagOpen _ attribs' <- (Tag Text -> Bool) -> TagParser m (Tag Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Tag Text -> Bool) -> TagParser m (Tag Text)
    pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
    matchTagOpen Text
    "col" [])
      let attribs = [Attribute Text] -> [Attribute Text]
    toStringAttr [Attribute Text]
    attribs'
      skipMany pBlank
      optional $ pSatisfy (matchTagClose "col")
      skipMany pBlank
      return $ case lookup "width" attribs of
                    Maybe Text
    Nothing -> case Text -> [Attribute Text] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "style" [Attribute Text]
    attribs of
                      Just (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "width:" -> Just Text
    xs) | (Char -> Bool) -> Text -> Bool
    T.any (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '%') Text
    xs ->
                        Either Int ColWidth
    -> (Double -> Either Int ColWidth)
    -> Maybe Double
    -> Either Int ColWidth
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (ColWidth -> Either Int ColWidth
    forall a b. b -> Either a b
    Right ColWidth
    ColWidthDefault) (ColWidth -> Either Int ColWidth
    forall a b. b -> Either a b
    Right (ColWidth -> Either Int ColWidth)
    -> (Double -> ColWidth) -> Double -> Either Int ColWidth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> ColWidth
    ColWidth (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    100.0))
                          (Maybe Double -> Either Int ColWidth)
    -> Maybe Double -> Either Int ColWidth
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Double
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead ((Char -> Bool) -> Text -> Text
    T.filter
                                       (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` (String
    " \t\r\n%'\";" :: [Char])) Text
    xs)
                      Maybe Text
    _ -> ColWidth -> Either Int ColWidth
    forall a b. b -> Either a b
    Right ColWidth
    ColWidthDefault
                    Just (Text -> Maybe (Text, Char)
    T.unsnoc -> Just (Text
    xs, Char
    '*')) ->
                      Either Int ColWidth
    -> (Int -> Either Int ColWidth) -> Maybe Int -> Either Int ColWidth
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Int -> Either Int ColWidth
    forall a b. a -> Either a b
    Left Int
    1) Int -> Either Int ColWidth
    forall a b. a -> Either a b
    Left (Maybe Int -> Either Int ColWidth)
    -> Maybe Int -> Either Int ColWidth
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead Text
    xs
                    Just (Text -> Maybe (Text, Char)
    T.unsnoc -> Just (Text
    xs, Char
    '%')) ->
                      Either Int ColWidth
    -> (Double -> Either Int ColWidth)
    -> Maybe Double
    -> Either Int ColWidth
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (ColWidth -> Either Int ColWidth
    forall a b. b -> Either a b
    Right ColWidth
    ColWidthDefault)
                            (ColWidth -> Either Int ColWidth
    forall a b. b -> Either a b
    Right (ColWidth -> Either Int ColWidth)
    -> (Double -> ColWidth) -> Double -> Either Int ColWidth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> ColWidth
    ColWidth (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    100.0)) (Maybe Double -> Either Int ColWidth)
    -> Maybe Double -> Either Int ColWidth
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Double
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead Text
    xs
                    Maybe Text
    _ -> ColWidth -> Either Int ColWidth
    forall a b. b -> Either a b
    Right ColWidth
    ColWidthDefault

    pColgroup :: PandocMonad m => TagParser m [Either Int ColWidth]
    pColgroup :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m [Either Int ColWidth]
    pColgroup = ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth]
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT
       [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth]
     -> ParsecT
          [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth])
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth]
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth]
    forall a b. (a -> b) -> a -> b
    $ do
      (Tag Text -> Bool) -> TagParser m (Tag Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Tag Text -> Bool) -> TagParser m (Tag Text)
    pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
    matchTagOpen Text
    "colgroup" [])
      ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Int ColWidth)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth]
    forall s (m :: * -> *) t u a end.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
    manyTill ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Int ColWidth)
    forall (m :: * -> *).
    PandocMonad m =>
    TagParser m (Either Int ColWidth)
    pCol (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
    pCloses Text
    "colgroup" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall a.
    ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s (m :: * -> *) t u.
    (Stream s m t, Show t) =>
    ParsecT s u m ()
    eof) ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth]
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) [Either Int ColWidth]
    forall a b.
    ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank

    resolveRelativeLengths :: [Either Int ColWidth] -> [ColWidth]
    resolveRelativeLengths :: [Either Int ColWidth] -> [ColWidth]
    resolveRelativeLengths [Either Int ColWidth]
    ws =
      let remaining :: Double
    remaining = Double
    1 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - [Double] -> Double
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((ColWidth -> Double) -> [ColWidth] -> [Double]
    forall a b. (a -> b) -> [a] -> [b]
    map ColWidth -> Double
    getColWidth ([ColWidth] -> [Double]) -> [ColWidth] -> [Double]
    forall a b. (a -> b) -> a -> b
    $ [Either Int ColWidth] -> [ColWidth]
    forall a b. [Either a b] -> [b]
    rights [Either Int ColWidth]
    ws)
          relatives :: Int
    relatives = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ [Either Int ColWidth] -> [Int]
    forall a b. [Either a b] -> [a]
    lefts [Either Int ColWidth]
    ws
          relUnit :: Double
    relUnit = Double
    remaining Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    relatives
          toColWidth :: Either a ColWidth -> ColWidth
    toColWidth (Right ColWidth
    x) = ColWidth
    x
          toColWidth (Left a
    i) = Double -> ColWidth
    ColWidth (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    i Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    relUnit)
      in  (Either Int ColWidth -> ColWidth)
    -> [Either Int ColWidth] -> [ColWidth]
    forall a b. (a -> b) -> [a] -> [b]
    map Either Int ColWidth -> ColWidth
    forall {a}. Integral a => Either a ColWidth -> ColWidth
    toColWidth [Either Int ColWidth]
    ws

    getColWidth :: ColWidth -> Double
    getColWidth :: ColWidth -> Double
    getColWidth ColWidth
    ColWidthDefault = Double
    0
    getColWidth (ColWidth Double
    w) = Double
    w

    data CellType
      = HeaderCell
      | BodyCell
      deriving CellType -> CellType -> Bool
    (CellType -> CellType -> Bool)
    -> (CellType -> CellType -> Bool) -> Eq CellType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CellType -> CellType -> Bool
    == :: CellType -> CellType -> Bool
    $c/= :: CellType -> CellType -> Bool
    /= :: CellType -> CellType -> Bool
    Eq

    pCell :: PandocMonad m
          => TagParser m Blocks
          -> CellType
          -> TagParser m (CellType, Cell)
    pCell :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> CellType -> TagParser m (CellType, Cell)
    pCell TagParser m Blocks
    block CellType
    celltype = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (CellType, Cell)
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (CellType, Cell)
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT
       [Tag Text] HTMLState (ReaderT HTMLLocal m) (CellType, Cell)
     -> ParsecT
          [Tag Text] HTMLState (ReaderT HTMLLocal m) (CellType, Cell))
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (CellType, Cell)
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (CellType, Cell)
    forall a b. (a -> b) -> a -> b
    $ do
      let celltype' :: Text
    celltype' = case CellType
    celltype of
            CellType
    HeaderCell -> Text
    "th"
            CellType
    BodyCell   -> Text
    "td"
      ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      TagOpen _ attribs <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m a
    lookAhead (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
     -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
    forall a b. (a -> b) -> a -> b
    $ (Tag Text -> Bool)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Tag Text -> Bool) -> TagParser m (Tag Text)
    pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
    matchTagOpen Text
    celltype' [])
      let cssAttribs = [Attribute Text]
    -> (Text -> [Attribute Text]) -> Maybe Text -> [Attribute Text]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] Text -> [Attribute Text]
    cssAttributes (Maybe Text -> [Attribute Text]) -> Maybe Text -> [Attribute Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> [Attribute Text] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "style" [Attribute Text]
    attribs
      let align = case Text -> [Attribute Text] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "align" [Attribute Text]
    attribs Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
                       Text -> [Attribute Text] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "text-align" [Attribute Text]
    cssAttribs of
                    Just Text
    "left"   -> Alignment
    AlignLeft
                    Just Text
    "right"  -> Alignment
    AlignRight
                    Just Text
    "center" -> Alignment
    AlignCenter
                    Maybe Text
    _             -> Alignment
    AlignDefault
      let rowspan = Int -> RowSpan
    RowSpan (Int -> RowSpan) -> (Maybe Int -> Int) -> Maybe Int -> RowSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    1 (Maybe Int -> RowSpan) -> Maybe Int -> RowSpan
    forall a b. (a -> b) -> a -> b
    $
                    Text -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead (Text -> Maybe Int) -> Maybe Text -> Maybe Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Text -> [Attribute Text] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "rowspan" [Attribute Text]
    attribs
      let colspan = Int -> ColSpan
    ColSpan (Int -> ColSpan) -> (Maybe Int -> Int) -> Maybe Int -> ColSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    1 (Maybe Int -> ColSpan) -> Maybe Int -> ColSpan
    forall a b. (a -> b) -> a -> b
    $
                    Text -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead (Text -> Maybe Int) -> Maybe Text -> Maybe Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Text -> [Attribute Text] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "colspan" [Attribute Text]
    attribs
      res <- pInTags celltype' block
      skipMany pBlank
      let handledAttribs = [Text
    "align", Text
    "colspan", Text
    "rowspan", Text
    "text-align"]
          attribs' = (Attribute Text -> [Attribute Text] -> [Attribute Text])
    -> [Attribute Text] -> [Attribute Text] -> [Attribute Text]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Attribute Text -> [Attribute Text] -> [Attribute Text]
    go [] [Attribute Text]
    attribs
          go kv :: Attribute Text
    kv@(Text
    k, Text
    _) [Attribute Text]
    acc = case Text
    k of
            Text
    "style" -> case (Attribute Text -> Bool) -> [Attribute Text] -> [Attribute Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    "text-align") (Text -> Bool)
    -> (Attribute Text -> Text) -> Attribute Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Attribute Text -> Text
    forall a b. (a, b) -> a
    fst) [Attribute Text]
    cssAttribs of
                         [] -> [Attribute Text]
    acc
                         [Attribute Text]
    cs -> (Text
    "style", [Attribute Text] -> Text
    toStyleString [Attribute Text]
    cs) Attribute Text -> [Attribute Text] -> [Attribute Text]
    forall a. a -> [a] -> [a]
    : [Attribute Text]
    acc
            -- drop attrib if it's already handled
            Text
    _ | Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    handledAttribs -> [Attribute Text]
    acc
            Text
    _ -> Attribute Text
    kv Attribute Text -> [Attribute Text] -> [Attribute Text]
    forall a. a -> [a] -> [a]
    : [Attribute Text]
    acc
      return (celltype, B.cellWith (toAttr attribs') align rowspan colspan res)

    -- | Create a style attribute string from a list of CSS attributes
    toStyleString :: [(Text, Text)] -> Text
    toStyleString :: [Attribute Text] -> Text
    toStyleString = Text -> [Text] -> Text
    T.intercalate Text
    "; " ([Text] -> Text)
    -> ([Attribute Text] -> [Text]) -> [Attribute Text] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Attribute Text -> Text) -> [Attribute Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Text
    k, Text
    v) -> Text
    k Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ": " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    v)

    -- | Parses a normal table row; returns the row and the number
    -- of cells at the beginning that are header cells.
    pRow :: PandocMonad m
         => TagParser m Blocks
         -> TagParser m (Int, B.Row)
    pRow :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> TagParser m (Int, Row)
    pRow TagParser m Blocks
    block = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Int, Row)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Int, Row)
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Int, Row)
     -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Int, Row))
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Int, Row)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Int, Row)
    forall a b. (a -> b) -> a -> b
    $ do
      ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      TagOpen _ attribs <- (Tag Text -> Bool) -> TagParser m (Tag Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Tag Text -> Bool) -> TagParser m (Tag Text)
    pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
    matchTagOpen Text
    "tr" []) TagParser m (Tag Text)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> TagParser m (Tag Text)
    forall a b.
    ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      cells <- many (pCell block BodyCell <|> pCell block HeaderCell)
      TagClose _ <- pSatisfy (matchTagClose "tr")
      let numheadcells = [(CellType, Cell)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([(CellType, Cell)] -> Int) -> [(CellType, Cell)] -> Int
    forall a b. (a -> b) -> a -> b
    $ ((CellType, Cell) -> Bool)
    -> [(CellType, Cell)] -> [(CellType, Cell)]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (\(CellType
    ct,Cell
    _) -> CellType
    ct CellType -> CellType -> Bool
    forall a. Eq a => a -> a -> Bool
    == CellType
    HeaderCell) [(CellType, Cell)]
    cells
      return (numheadcells, Row (toAttr attribs) $ map snd cells)

    -- | Parses a header row, i.e., a row which containing nothing but
    -- @<th>@ elements.
    pHeaderRow :: PandocMonad m
               => TagParser m Blocks
               -> TagParser m B.Row
    pHeaderRow :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> TagParser m Row
    pHeaderRow TagParser m Blocks
    block = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row
     -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row
    forall a b. (a -> b) -> a -> b
    $ do
      ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      let pThs :: ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Cell]
    pThs = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Cell
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Cell]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ((CellType, Cell) -> Cell
    forall a b. (a, b) -> b
    snd ((CellType, Cell) -> Cell)
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (CellType, Cell)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Cell
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TagParser m Blocks
    -> CellType
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (CellType, Cell)
    forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> CellType -> TagParser m (CellType, Cell)
    pCell TagParser m Blocks
    block CellType
    HeaderCell)
      let mkRow :: ([Attribute Text], [Cell]) -> Row
    mkRow ([Attribute Text]
    attribs, [Cell]
    cells) = Attr -> [Cell] -> Row
    Row ([Attribute Text] -> Attr
    toAttr [Attribute Text]
    attribs) [Cell]
    cells
      ([Attribute Text], [Cell]) -> Row
    mkRow (([Attribute Text], [Cell]) -> Row)
    -> ParsecT
         [Tag Text]
         HTMLState
         (ReaderT HTMLLocal m)
         ([Attribute Text], [Cell])
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TagOmission
    -> Text
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Cell]
    -> ParsecT
         [Tag Text]
         HTMLState
         (ReaderT HTMLLocal m)
         ([Attribute Text], [Cell])
    forall (m :: * -> *) a.
    PandocMonad m =>
    TagOmission
    -> Text -> TagParser m a -> TagParser m ([Attribute Text], a)
    pInTagWithAttribs TagOmission
    TagsRequired Text
    "tr" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Cell]
    pThs

    -- | Parses a table head. If there is no @thead@ element, this looks for
    -- a row of @<th>@-only elements as the first line of the table.
    pTableHead :: PandocMonad m
               => TagParser m Blocks
               -> TagParser m TableHead
    pTableHead :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> TagParser m TableHead
    pTableHead TagParser m Blocks
    block = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
     -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
    forall a b. (a -> b) -> a -> b
    $ do
      ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      let pRows :: ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Int, Row)]
    pRows = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Int, Row)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Int, Row)]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many (TagParser m Blocks
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Int, Row)
    forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> TagParser m (Int, Row)
    pRow TagParser m Blocks
    block)
      let pThead :: TagParser m ([Attribute Text], [(Int, Row)])
    pThead = TagOmission
    -> Text
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Int, Row)]
    -> TagParser m ([Attribute Text], [(Int, Row)])
    forall (m :: * -> *) a.
    PandocMonad m =>
    TagOmission
    -> Text -> TagParser m a -> TagParser m ([Attribute Text], a)
    pInTagWithAttribs TagOmission
    ClosingTagOptional Text
    "thead" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Int, Row)]
    pRows
      TagParser m ([Attribute Text], [(Int, Row)])
    -> ParsecT
         [Tag Text]
         HTMLState
         (ReaderT HTMLLocal m)
         (Maybe ([Attribute Text], [(Int, Row)]))
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m (Maybe a)
    optionMaybe TagParser m ([Attribute Text], [(Int, Row)])
    pThead ParsecT
      [Tag Text]
      HTMLState
      (ReaderT HTMLLocal m)
      (Maybe ([Attribute Text], [(Int, Row)]))
    -> (Maybe ([Attribute Text], [(Int, Row)])
        -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
    forall a b.
    ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    -> (a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just ([Attribute Text]
    attribs, [(Int, Row)]
    rows) ->
          TableHead
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
    forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TableHead
     -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead)
    -> TableHead
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
    forall a b. (a -> b) -> a -> b
    $ Attr -> [Row] -> TableHead
    TableHead ([Attribute Text] -> Attr
    toAttr [Attribute Text]
    attribs) ([Row] -> TableHead) -> [Row] -> TableHead
    forall a b. (a -> b) -> a -> b
    $ ((Int, Row) -> Row) -> [(Int, Row)] -> [Row]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, Row) -> Row
    forall a b. (a, b) -> b
    snd [(Int, Row)]
    rows
        Maybe ([Attribute Text], [(Int, Row)])
    Nothing -> Maybe Row -> TableHead
    mkTableHead (Maybe Row -> TableHead)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Row)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableHead
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Row)
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m (Maybe a)
    optionMaybe (TagParser m Blocks
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Row
    forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> TagParser m Row
    pHeaderRow TagParser m Blocks
    block)
                   where
                     mkTableHead :: Maybe Row -> TableHead
    mkTableHead = Attr -> [Row] -> TableHead
    TableHead Attr
    nullAttr ([Row] -> TableHead)
    -> (Maybe Row -> [Row]) -> Maybe Row -> TableHead
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . \case
                       -- Use row as header only if it's non-empty
                       Just row :: Row
    row@(Row Attr
    _ (Cell
    _:[Cell]
    _)) -> [Row
    row]
                       Maybe Row
    _                      -> []

    -- | Parses a table foot
    pTableFoot :: PandocMonad m
               => TagParser m Blocks
               -> TagParser m TableFoot
    pTableFoot :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> TagParser m TableFoot
    pTableFoot TagParser m Blocks
    block = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableFoot
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableFoot
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableFoot
     -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableFoot)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableFoot
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableFoot
    forall a b. (a -> b) -> a -> b
    $ do
      ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      TagOpen _ attribs <- (Tag Text -> Bool) -> TagParser m (Tag Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Tag Text -> Bool) -> TagParser m (Tag Text)
    pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
    matchTagOpen Text
    "tfoot" []) TagParser m (Tag Text)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> TagParser m (Tag Text)
    forall a b.
    ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      rows <- many $ snd <$> (pRow block <* skipMany pBlank)
      optional $ pSatisfy (matchTagClose "tfoot")
      return $ TableFoot (toAttr attribs) rows

    -- | Parses a table body
    pTableBody :: PandocMonad m
               => TagParser m Blocks
               -> TagParser m TableBody
    pTableBody :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> TagParser m TableBody
    pTableBody TagParser m Blocks
    block = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableBody
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableBody
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableBody
     -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableBody)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableBody
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) TableBody
    forall a b. (a -> b) -> a -> b
    $ do
      ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      mbattribs <- Maybe [Attribute Text]
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe [Attribute Text])
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe [Attribute Text])
    forall s (m :: * -> *) t a u.
    Stream s m t =>
    a -> ParsecT s u m a -> ParsecT s u m a
    option Maybe [Attribute Text]
    forall a. Maybe a
    Nothing (ParsecT
       [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe [Attribute Text])
     -> ParsecT
          [Tag Text]
          HTMLState
          (ReaderT HTMLLocal m)
          (Maybe [Attribute Text]))
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe [Attribute Text])
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe [Attribute Text])
    forall a b. (a -> b) -> a -> b
    $ [Attribute Text] -> Maybe [Attribute Text]
    forall a. a -> Maybe a
    Just ([Attribute Text] -> Maybe [Attribute Text])
    -> (Tag Text -> [Attribute Text])
    -> Tag Text
    -> Maybe [Attribute Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tag Text -> [Attribute Text]
    forall {str}. Tag str -> [Attribute str]
    getAttribs (Tag Text -> Maybe [Attribute Text])
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe [Attribute Text])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                     (Tag Text -> Bool)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Tag Text -> Bool) -> TagParser m (Tag Text)
    pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
    matchTagOpen Text
    "tbody" []) ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe [Attribute Text])
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT
         [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe [Attribute Text])
    forall a b.
    ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      bodyheads <- many (pHeaderRow block)
      rows <- many (pRow block <* skipMany pBlank)
      optional $ pSatisfy (matchTagClose "tbody")
      guard $ isJust mbattribs || not (null bodyheads && null rows)
      let attribs = [Attribute Text] -> Maybe [Attribute Text] -> [Attribute Text]
    forall a. a -> Maybe a -> a
    fromMaybe [] Maybe [Attribute Text]
    mbattribs
      -- we only set row head columns if all rows agree;
      -- if some rows have headings but others not, we use 0; see #8984, #8634:
      let numrows = [(Int, Row)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Int, Row)]
    rows
      let adjustRowHeadColsForCell Int
    currentrow Vector Int
    headcolsv
                        (Cell Attr
    _ Alignment
    _ (RowSpan Int
    rowspan) (ColSpan Int
    colspan) [Block]
    _) =
            (Int -> Int -> Int) -> Vector Int -> Vector Int
    forall a b. (Int -> a -> b) -> Vector a -> Vector b
    V.imap (\Int
    i Int
    x -> if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    currentrow Bool -> Bool -> Bool
    &&
                               Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    currentrow Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    rowspan
                               then Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    colspan
                               else Int
    x) Vector Int
    headcolsv
      let adjustRowHeadCols
            Vector Int
    headcolsv
            (Int
    currentrow, (Int
    numheads, Row Attr
    _ [Cell]
    cells)) =
              (Vector Int -> Cell -> Vector Int)
    -> Vector Int -> [Cell] -> Vector Int
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' (Int -> Vector Int -> Cell -> Vector Int
    adjustRowHeadColsForCell Int
    currentrow) Vector Int
    headcolsv
                (Int -> [Cell] -> [Cell]
    forall a. Int -> [a] -> [a]
    take Int
    numheads [Cell]
    cells)
      let headcols = (Vector Int -> (Int, (Int, Row)) -> Vector Int)
    -> Vector Int -> [(Int, (Int, Row))] -> Vector Int
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' Vector Int -> (Int, (Int, Row)) -> Vector Int
    adjustRowHeadCols
                             (Int -> Int -> Vector Int
    forall a. Int -> a -> Vector a
    V.replicate Int
    numrows (Int
    0 :: Int))
                             ([Int] -> [(Int, Row)] -> [(Int, (Int, Row))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Int
    0 :: Int)..] [(Int, Row)]
    rows)
      let rowHeadCols = case Vector Int -> Maybe (Int, Vector Int)
    forall a. Vector a -> Maybe (a, Vector a)
    V.uncons Vector Int
    headcols of
                           Just (Int
    x, Vector Int
    v) | (Int -> Bool) -> Vector Int -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    x) Vector Int
    v -> Int -> RowHeadColumns
    RowHeadColumns Int
    x
                           Maybe (Int, Vector Int)
    _ -> Int -> RowHeadColumns
    RowHeadColumns Int
    0
      return $ TableBody (toAttr attribs) rowHeadCols bodyheads (map snd rows)
      where
        getAttribs :: Tag str -> [Attribute str]
    getAttribs (TagOpen str
    _ [Attribute str]
    attribs) = [Attribute str]
    attribs
        getAttribs Tag str
    _ = []

    -- | Parses a simple HTML table
    pTable :: PandocMonad m
           => TagParser m Blocks -- ^ Caption and cell contents parser
           -> TagParser m Blocks
    pTable :: forall (m :: * -> *).
    PandocMonad m =>
    TagParser m Blocks -> TagParser m Blocks
    pTable TagParser m Blocks
    block = TagParser m Blocks -> TagParser m Blocks
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (TagParser m Blocks -> TagParser m Blocks)
    -> TagParser m Blocks -> TagParser m Blocks
    forall a b. (a -> b) -> a -> b
    $ do
      TagOpen _ attribs <- (Tag Text -> Bool) -> TagParser m (Tag Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Tag Text -> Bool) -> TagParser m (Tag Text)
    pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
    matchTagOpen Text
    "table" [])  TagParser m (Tag Text)
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> TagParser m (Tag Text)
    forall a b.
    ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
    forall (m :: * -> *). PandocMonad m => TagParser m ()
    pBlank
      caption <- option mempty $ pInTags "caption" block       <* skipMany pBlank
      widths <- resolveRelativeLengths <$>
                  ((mconcat <$> many1 pColgroup) <|> many pCol) <* skipMany pBlank
      thead   <- pTableHead block               <* skipMany pBlank
      topfoot <- optionMaybe (pTableFoot block) <* skipMany pBlank
      tbodies <- many (pTableBody block)        <* skipMany pBlank
      botfoot <- optionMaybe (pTableFoot block) <* skipMany pBlank
      TagClose _ <- pSatisfy (matchTagClose "table")
      let tfoot = TableFoot -> Maybe TableFoot -> TableFoot
    forall a. a -> Maybe a -> a
    fromMaybe (Attr -> [Row] -> TableFoot
    TableFoot Attr
    nullAttr []) (Maybe TableFoot -> TableFoot) -> Maybe TableFoot -> TableFoot
    forall a b. (a -> b) -> a -> b
    $ Maybe TableFoot
    topfoot Maybe TableFoot -> Maybe TableFoot -> Maybe TableFoot
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe TableFoot
    botfoot
      case normalize widths thead tbodies tfoot of
        Left String
    err -> String -> TagParser m Blocks
    forall a.
    String -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    err
        Right ([ColSpec]
    colspecs, TableHead
    thead', [TableBody]
    tbodies', TableFoot
    tfoot') -> Blocks -> TagParser m Blocks
    forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
    forall a b. (a -> b) -> a -> b
    $
          Attr
    -> Caption
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> Blocks
    B.tableWith ([Attribute Text] -> Attr
    toAttr [Attribute Text]
    attribs)
                      (Blocks -> Caption
    B.simpleCaption Blocks
    caption)
                      [ColSpec]
    colspecs
                      TableHead
    thead'
                      [TableBody]
    tbodies'
                      TableFoot
    tfoot'
    data TableType
      = SimpleTable
      | NormalTable

    tableType :: [[Cell]] -> TableType
    tableType :: [[Cell]] -> TableType
    tableType [[Cell]]
    cells =
      if [[[Block]]] -> Bool
    onlySimpleTableCells ([[[Block]]] -> Bool) -> [[[Block]]] -> Bool
    forall a b. (a -> b) -> a -> b
    $ ([Cell] -> [[Block]]) -> [[Cell]] -> [[[Block]]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Cell -> [Block]) -> [Cell] -> [[Block]]
    forall a b. (a -> b) -> [a] -> [b]
    map Cell -> [Block]
    cellContents) [[Cell]]
    cells
      then TableType
    SimpleTable
      else TableType
    NormalTable
      where
        cellContents :: Cell -> [Block]
        cellContents :: Cell -> [Block]
    cellContents (Cell Attr
    _ Alignment
    _ RowSpan
    _ ColSpan
    _ [Block]
    bs) = [Block]
    bs

    normalize :: [ColWidth] -> TableHead -> [TableBody] -> TableFoot
              -> Either String ([ColSpec], TableHead, [TableBody], TableFoot)
    normalize :: [ColWidth]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> Either String ([ColSpec], TableHead, [TableBody], TableFoot)
    normalize [ColWidth]
    widths TableHead
    head' [TableBody]
    bodies TableFoot
    foot = do
      let rows :: [Row]
    rows = TableHead -> [Row]
    headRows TableHead
    head' [Row] -> [Row] -> [Row]
    forall a. Semigroup a => a -> a -> a
    <> (TableBody -> [Row]) -> [TableBody] -> [Row]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap TableBody -> [Row]
    bodyRows [TableBody]
    bodies [Row] -> [Row] -> [Row]
    forall a. Semigroup a => a -> a -> a
    <> TableFoot -> [Row]
    footRows TableFoot
    foot
      let cellWidth :: Cell -> Int
    cellWidth (Cell Attr
    _ Alignment
    _ RowSpan
    _ (ColSpan Int
    cs) [Block]
    _) = Int
    cs
      let rowLength :: Row -> Int
    rowLength = (Cell -> Int -> Int) -> Int -> [Cell] -> Int
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Cell
    cell Int
    acc -> Cell -> Int
    cellWidth Cell
    cell Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    acc) Int
    0 ([Cell] -> Int) -> (Row -> [Cell]) -> Row -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Row -> [Cell]
    rowCells
      let ncols :: Int
    ncols = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Maybe (NonEmpty Int)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
    forall a b. (a -> b) -> a -> b
    $ (Row -> Int) -> [Row] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Row -> Int
    rowLength [Row]
    rows
      let tblType :: TableType
    tblType = [[Cell]] -> TableType
    tableType ((Row -> [Cell]) -> [Row] -> [[Cell]]
    forall a b. (a -> b) -> [a] -> [b]
    map Row -> [Cell]
    rowCells [Row]
    rows)
      -- fail on empty table
      if [Row] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Row]
    rows
        then String
    -> Either String ([ColSpec], TableHead, [TableBody], TableFoot)
    forall a b. a -> Either a b
    Left String
    "empty table"
        else ([ColSpec], TableHead, [TableBody], TableFoot)
    -> Either String ([ColSpec], TableHead, [TableBody], TableFoot)
    forall a b. b -> Either a b
    Right
             ( [Alignment] -> [ColWidth] -> [ColSpec]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Int -> [TableBody] -> [Alignment]
    calculateAlignments Int
    ncols [TableBody]
    bodies)
                   (Int -> TableType -> [ColWidth] -> [ColWidth]
    normalizeColWidths Int
    ncols TableType
    tblType [ColWidth]
    widths)
             , TableHead
    head'
             , [TableBody]
    bodies
             , TableFoot
    foot
             )

    normalizeColWidths :: Int -> TableType -> [ColWidth] -> [ColWidth]
    normalizeColWidths :: Int -> TableType -> [ColWidth] -> [ColWidth]
    normalizeColWidths Int
    ncols TableType
    tblType = \case
      [] -> case TableType
    tblType of
              TableType
    SimpleTable -> Int -> ColWidth -> [ColWidth]
    forall a. Int -> a -> [a]
    replicate Int
    ncols ColWidth
    ColWidthDefault
              TableType
    NormalTable -> Int -> ColWidth -> [ColWidth]
    forall a. Int -> a -> [a]
    replicate Int
    ncols (Double -> ColWidth
    ColWidth (Double -> ColWidth) -> Double -> ColWidth
    forall a b. (a -> b) -> a -> b
    $ Double
    1 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    ncols)
      [ColWidth]
    widths -> [ColWidth]
    widths

    calculateAlignments :: Int -> [TableBody] -> [Alignment]
    calculateAlignments :: Int -> [TableBody] -> [Alignment]
    calculateAlignments Int
    cols [TableBody]
    tbodies =
      case [[Cell]]
    cells of
        [Cell]
    cs:[[Cell]]
    _ -> Int -> [Alignment] -> [Alignment]
    forall a. Int -> [a] -> [a]
    take Int
    cols ([Alignment] -> [Alignment]) -> [Alignment] -> [Alignment]
    forall a b. (a -> b) -> a -> b
    $ (Cell -> [Alignment]) -> [Cell] -> [Alignment]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Cell -> [Alignment]
    cellAligns [Cell]
    cs [Alignment] -> [Alignment] -> [Alignment]
    forall a. [a] -> [a] -> [a]
    ++ Alignment -> [Alignment]
    forall a. a -> [a]
    repeat Alignment
    AlignDefault
        [[Cell]]
    _    -> Int -> Alignment -> [Alignment]
    forall a. Int -> a -> [a]
    replicate Int
    cols Alignment
    AlignDefault
      where
        cells :: [[Cell]]
        cells :: [[Cell]]
    cells = (TableBody -> [[Cell]]) -> [TableBody] -> [[Cell]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap TableBody -> [[Cell]]
    bodyRowCells [TableBody]
    tbodies
        cellAligns :: Cell -> [Alignment]
        cellAligns :: Cell -> [Alignment]
    cellAligns (Cell Attr
    _ Alignment
    align RowSpan
    _ (ColSpan Int
    cs) [Block]
    _) = Int -> Alignment -> [Alignment]
    forall a. Int -> a -> [a]
    replicate Int
    cs Alignment
    align

    bodyRowCells :: TableBody -> [[Cell]]
    bodyRowCells :: TableBody -> [[Cell]]
    bodyRowCells = (Row -> [Cell]) -> [Row] -> [[Cell]]
    forall a b. (a -> b) -> [a] -> [b]
    map Row -> [Cell]
    rowCells ([Row] -> [[Cell]])
    -> (TableBody -> [Row]) -> TableBody -> [[Cell]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TableBody -> [Row]
    bodyRows

    headRows :: TableHead -> [B.Row]
    headRows :: TableHead -> [Row]
    headRows (TableHead Attr
    _ [Row]
    rows) = [Row]
    rows

    bodyRows :: TableBody -> [B.Row]
    bodyRows :: TableBody -> [Row]
    bodyRows (TableBody Attr
    _ RowHeadColumns
    _ [Row]
    headerRows [Row]
    bodyRows') = [Row]
    headerRows [Row] -> [Row] -> [Row]
    forall a. Semigroup a => a -> a -> a
    <> [Row]
    bodyRows'

    footRows :: TableFoot -> [B.Row]
    footRows :: TableFoot -> [Row]
    footRows (TableFoot Attr
    _ [Row]
    rows) = [Row]
    rows

    rowCells :: B.Row -> [Cell]
    rowCells :: Row -> [Cell]
    rowCells (Row Attr
    _ [Cell]
    cells) = [Cell]
    cells