    {-# 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 Data.List (foldl')
    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
    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
    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