{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
   Module      : Text.Pandoc.Writers.AnnotatedTable
   Copyright   : Copyright 2020 Christian Despres
   License     : GNU GPL, version 2 or above

   Maintainer  : Christian Despres <christian.j.j.despres@gmail.com>
   Stability   : alpha
   Portability : portable

Definitions and conversion functions for an intermediate 'Table' and
related types, which annotates the existing Pandoc 'B.Table' types
with additional inferred information. For use in writers that need to
know the details of columns that cells span, row numbers, and the
cells that are in the row head.
-}

module Text.Pandoc.Writers.AnnotatedTable
  ( toTable
  , fromTable
  , Table(..)
  , TableHead(..)
  , TableBody(..)
  , TableFoot(..)
  , HeaderRow(..)
  , BodyRow(..)
  , RowNumber(..)
  , RowHead
  , RowBody
  , Cell(..)
  , ColNumber(..)
  )
where

import           Control.Monad.RWS.Strict
import           Data.Generics                  ( Data
                                                , Typeable
                                                )
import           Data.List.NonEmpty             ( NonEmpty(..) )
import           GHC.Generics                   ( Generic )
import qualified Text.Pandoc.Builder           as B
import           Text.Pandoc.Walk               ( Walkable (..) )

-- | An annotated table type, corresponding to the Pandoc 'B.Table'
-- constructor and the HTML @\<table\>@ element. It records the data
-- of the columns that cells span, the cells in the row head, the row
-- numbers of rows, and the column numbers of cells, in addition to
-- the data in a 'B.Table'. The type itself does not enforce any
-- guarantees about the consistency of this data. Use 'toTable' to
-- produce a 'Table' from a Pandoc 'B.Table'.
data Table = Table B.Attr B.Caption [B.ColSpec] TableHead [TableBody] TableFoot
  deriving (Table -> Table -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq, Eq Table
Table -> Table -> Bool
Table -> Table -> Ordering
Table -> Table -> Table
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Table -> Table -> Table
$cmin :: Table -> Table -> Table
max :: Table -> Table -> Table
$cmax :: Table -> Table -> Table
>= :: Table -> Table -> Bool
$c>= :: Table -> Table -> Bool
> :: Table -> Table -> Bool
$c> :: Table -> Table -> Bool
<= :: Table -> Table -> Bool
$c<= :: Table -> Table -> Bool
< :: Table -> Table -> Bool
$c< :: Table -> Table -> Bool
compare :: Table -> Table -> Ordering
$ccompare :: Table -> Table -> Ordering
Ord, ReadPrec [Table]
ReadPrec Table
Int -> ReadS Table
ReadS [Table]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Table]
$creadListPrec :: ReadPrec [Table]
readPrec :: ReadPrec Table
$creadPrec :: ReadPrec Table
readList :: ReadS [Table]
$creadList :: ReadS [Table]
readsPrec :: Int -> ReadS Table
$creadsPrec :: Int -> ReadS Table
Read, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show, Typeable, Typeable Table
Table -> DataType
Table -> Constr
(forall b. Data b => b -> b) -> Table -> Table
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Table -> u
forall u. (forall d. Data d => d -> u) -> Table -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Table -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Table -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Table -> m Table
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Table -> m Table
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Table
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Table -> c Table
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Table)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Table)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Table -> m Table
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Table -> m Table
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Table -> m Table
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Table -> m Table
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Table -> m Table
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Table -> m Table
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Table -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Table -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Table -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Table -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Table -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Table -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Table -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Table -> r
gmapT :: (forall b. Data b => b -> b) -> Table -> Table
$cgmapT :: (forall b. Data b => b -> b) -> Table -> Table
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Table)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Table)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Table)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Table)
dataTypeOf :: Table -> DataType
$cdataTypeOf :: Table -> DataType
toConstr :: Table -> Constr
$ctoConstr :: Table -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Table
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Table
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Table -> c Table
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Table -> c Table
Data, forall x. Rep Table x -> Table
forall x. Table -> Rep Table x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Table x -> Table
$cfrom :: forall x. Table -> Rep Table x
Generic)

-- | An annotated table head, corresponding to a Pandoc 'B.TableHead'
-- and the HTML @\<thead\>@ element.
data TableHead = TableHead B.Attr [HeaderRow]
  deriving (TableHead -> TableHead -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableHead -> TableHead -> Bool
$c/= :: TableHead -> TableHead -> Bool
== :: TableHead -> TableHead -> Bool
$c== :: TableHead -> TableHead -> Bool
Eq, Eq TableHead
TableHead -> TableHead -> Bool
TableHead -> TableHead -> Ordering
TableHead -> TableHead -> TableHead
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TableHead -> TableHead -> TableHead
$cmin :: TableHead -> TableHead -> TableHead
max :: TableHead -> TableHead -> TableHead
$cmax :: TableHead -> TableHead -> TableHead
>= :: TableHead -> TableHead -> Bool
$c>= :: TableHead -> TableHead -> Bool
> :: TableHead -> TableHead -> Bool
$c> :: TableHead -> TableHead -> Bool
<= :: TableHead -> TableHead -> Bool
$c<= :: TableHead -> TableHead -> Bool
< :: TableHead -> TableHead -> Bool
$c< :: TableHead -> TableHead -> Bool
compare :: TableHead -> TableHead -> Ordering
$ccompare :: TableHead -> TableHead -> Ordering
Ord, ReadPrec [TableHead]
ReadPrec TableHead
Int -> ReadS TableHead
ReadS [TableHead]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableHead]
$creadListPrec :: ReadPrec [TableHead]
readPrec :: ReadPrec TableHead
$creadPrec :: ReadPrec TableHead
readList :: ReadS [TableHead]
$creadList :: ReadS [TableHead]
readsPrec :: Int -> ReadS TableHead
$creadsPrec :: Int -> ReadS TableHead
Read, Int -> TableHead -> ShowS
[TableHead] -> ShowS
TableHead -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableHead] -> ShowS
$cshowList :: [TableHead] -> ShowS
show :: TableHead -> String
$cshow :: TableHead -> String
showsPrec :: Int -> TableHead -> ShowS
$cshowsPrec :: Int -> TableHead -> ShowS
Show, Typeable, Typeable TableHead
TableHead -> DataType
TableHead -> Constr
(forall b. Data b => b -> b) -> TableHead -> TableHead
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TableHead -> u
forall u. (forall d. Data d => d -> u) -> TableHead -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableHead -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableHead -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableHead
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableHead -> c TableHead
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableHead)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableHead)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableHead -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableHead -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TableHead -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableHead -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableHead -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableHead -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableHead -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableHead -> r
gmapT :: (forall b. Data b => b -> b) -> TableHead -> TableHead
$cgmapT :: (forall b. Data b => b -> b) -> TableHead -> TableHead
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableHead)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableHead)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableHead)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableHead)
dataTypeOf :: TableHead -> DataType
$cdataTypeOf :: TableHead -> DataType
toConstr :: TableHead -> Constr
$ctoConstr :: TableHead -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableHead
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableHead
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableHead -> c TableHead
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableHead -> c TableHead
Data, forall x. Rep TableHead x -> TableHead
forall x. TableHead -> Rep TableHead x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableHead x -> TableHead
$cfrom :: forall x. TableHead -> Rep TableHead x
Generic)

-- | An annotated table body, with an intermediate head and body,
-- corresponding to a Pandoc 'B.TableBody' and the HTML @\<tbody\>@
-- element.
data TableBody = TableBody B.Attr B.RowHeadColumns [HeaderRow] [BodyRow]
  deriving (TableBody -> TableBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableBody -> TableBody -> Bool
$c/= :: TableBody -> TableBody -> Bool
== :: TableBody -> TableBody -> Bool
$c== :: TableBody -> TableBody -> Bool
Eq, Eq TableBody
TableBody -> TableBody -> Bool
TableBody -> TableBody -> Ordering
TableBody -> TableBody -> TableBody
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TableBody -> TableBody -> TableBody
$cmin :: TableBody -> TableBody -> TableBody
max :: TableBody -> TableBody -> TableBody
$cmax :: TableBody -> TableBody -> TableBody
>= :: TableBody -> TableBody -> Bool
$c>= :: TableBody -> TableBody -> Bool
> :: TableBody -> TableBody -> Bool
$c> :: TableBody -> TableBody -> Bool
<= :: TableBody -> TableBody -> Bool
$c<= :: TableBody -> TableBody -> Bool
< :: TableBody -> TableBody -> Bool
$c< :: TableBody -> TableBody -> Bool
compare :: TableBody -> TableBody -> Ordering
$ccompare :: TableBody -> TableBody -> Ordering
Ord, ReadPrec [TableBody]
ReadPrec TableBody
Int -> ReadS TableBody
ReadS [TableBody]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableBody]
$creadListPrec :: ReadPrec [TableBody]
readPrec :: ReadPrec TableBody
$creadPrec :: ReadPrec TableBody
readList :: ReadS [TableBody]
$creadList :: ReadS [TableBody]
readsPrec :: Int -> ReadS TableBody
$creadsPrec :: Int -> ReadS TableBody
Read, Int -> TableBody -> ShowS
[TableBody] -> ShowS
TableBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableBody] -> ShowS
$cshowList :: [TableBody] -> ShowS
show :: TableBody -> String
$cshow :: TableBody -> String
showsPrec :: Int -> TableBody -> ShowS
$cshowsPrec :: Int -> TableBody -> ShowS
Show, Typeable, Typeable TableBody
TableBody -> DataType
TableBody -> Constr
(forall b. Data b => b -> b) -> TableBody -> TableBody
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TableBody -> u
forall u. (forall d. Data d => d -> u) -> TableBody -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableBody -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableBody -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableBody
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableBody -> c TableBody
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableBody)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableBody)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableBody -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableBody -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TableBody -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableBody -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableBody -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableBody -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableBody -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableBody -> r
gmapT :: (forall b. Data b => b -> b) -> TableBody -> TableBody
$cgmapT :: (forall b. Data b => b -> b) -> TableBody -> TableBody
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableBody)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableBody)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableBody)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableBody)
dataTypeOf :: TableBody -> DataType
$cdataTypeOf :: TableBody -> DataType
toConstr :: TableBody -> Constr
$ctoConstr :: TableBody -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableBody
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableBody
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableBody -> c TableBody
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableBody -> c TableBody
Data, forall x. Rep TableBody x -> TableBody
forall x. TableBody -> Rep TableBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableBody x -> TableBody
$cfrom :: forall x. TableBody -> Rep TableBody x
Generic)

-- | An annotated table foot, corresponding to a Pandoc 'B.TableFoot'
-- and the HTML @\<tfoot\>@ element.
data TableFoot = TableFoot B.Attr [HeaderRow]
  deriving (TableFoot -> TableFoot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableFoot -> TableFoot -> Bool
$c/= :: TableFoot -> TableFoot -> Bool
== :: TableFoot -> TableFoot -> Bool
$c== :: TableFoot -> TableFoot -> Bool
Eq, Eq TableFoot
TableFoot -> TableFoot -> Bool
TableFoot -> TableFoot -> Ordering
TableFoot -> TableFoot -> TableFoot
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TableFoot -> TableFoot -> TableFoot
$cmin :: TableFoot -> TableFoot -> TableFoot
max :: TableFoot -> TableFoot -> TableFoot
$cmax :: TableFoot -> TableFoot -> TableFoot
>= :: TableFoot -> TableFoot -> Bool
$c>= :: TableFoot -> TableFoot -> Bool
> :: TableFoot -> TableFoot -> Bool
$c> :: TableFoot -> TableFoot -> Bool
<= :: TableFoot -> TableFoot -> Bool
$c<= :: TableFoot -> TableFoot -> Bool
< :: TableFoot -> TableFoot -> Bool
$c< :: TableFoot -> TableFoot -> Bool
compare :: TableFoot -> TableFoot -> Ordering
$ccompare :: TableFoot -> TableFoot -> Ordering
Ord, ReadPrec [TableFoot]
ReadPrec TableFoot
Int -> ReadS TableFoot
ReadS [TableFoot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableFoot]
$creadListPrec :: ReadPrec [TableFoot]
readPrec :: ReadPrec TableFoot
$creadPrec :: ReadPrec TableFoot
readList :: ReadS [TableFoot]
$creadList :: ReadS [TableFoot]
readsPrec :: Int -> ReadS TableFoot
$creadsPrec :: Int -> ReadS TableFoot
Read, Int -> TableFoot -> ShowS
[TableFoot] -> ShowS
TableFoot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableFoot] -> ShowS
$cshowList :: [TableFoot] -> ShowS
show :: TableFoot -> String
$cshow :: TableFoot -> String
showsPrec :: Int -> TableFoot -> ShowS
$cshowsPrec :: Int -> TableFoot -> ShowS
Show, Typeable, Typeable TableFoot
TableFoot -> DataType
TableFoot -> Constr
(forall b. Data b => b -> b) -> TableFoot -> TableFoot
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TableFoot -> u
forall u. (forall d. Data d => d -> u) -> TableFoot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableFoot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableFoot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableFoot -> m TableFoot
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableFoot -> m TableFoot
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableFoot
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableFoot -> c TableFoot
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableFoot)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableFoot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableFoot -> m TableFoot
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableFoot -> m TableFoot
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableFoot -> m TableFoot
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableFoot -> m TableFoot
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableFoot -> m TableFoot
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableFoot -> m TableFoot
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableFoot -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableFoot -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TableFoot -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableFoot -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableFoot -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableFoot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableFoot -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableFoot -> r
gmapT :: (forall b. Data b => b -> b) -> TableFoot -> TableFoot
$cgmapT :: (forall b. Data b => b -> b) -> TableFoot -> TableFoot
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableFoot)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableFoot)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableFoot)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableFoot)
dataTypeOf :: TableFoot -> DataType
$cdataTypeOf :: TableFoot -> DataType
toConstr :: TableFoot -> Constr
$ctoConstr :: TableFoot -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableFoot
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableFoot
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableFoot -> c TableFoot
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableFoot -> c TableFoot
Data, forall x. Rep TableFoot x -> TableFoot
forall x. TableFoot -> Rep TableFoot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableFoot x -> TableFoot
$cfrom :: forall x. TableFoot -> Rep TableFoot x
Generic)

-- | An annotated header row, corresponding to a Pandoc 'B.Row' and
-- the HTML @\<tr\>@ element, and also recording the row number of the
-- row. All the cells in a 'HeaderRow' are header (@\<th\>@) cells.
data HeaderRow = HeaderRow B.Attr RowNumber [Cell]
  deriving (HeaderRow -> HeaderRow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderRow -> HeaderRow -> Bool
$c/= :: HeaderRow -> HeaderRow -> Bool
== :: HeaderRow -> HeaderRow -> Bool
$c== :: HeaderRow -> HeaderRow -> Bool
Eq, Eq HeaderRow
HeaderRow -> HeaderRow -> Bool
HeaderRow -> HeaderRow -> Ordering
HeaderRow -> HeaderRow -> HeaderRow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HeaderRow -> HeaderRow -> HeaderRow
$cmin :: HeaderRow -> HeaderRow -> HeaderRow
max :: HeaderRow -> HeaderRow -> HeaderRow
$cmax :: HeaderRow -> HeaderRow -> HeaderRow
>= :: HeaderRow -> HeaderRow -> Bool
$c>= :: HeaderRow -> HeaderRow -> Bool
> :: HeaderRow -> HeaderRow -> Bool
$c> :: HeaderRow -> HeaderRow -> Bool
<= :: HeaderRow -> HeaderRow -> Bool
$c<= :: HeaderRow -> HeaderRow -> Bool
< :: HeaderRow -> HeaderRow -> Bool
$c< :: HeaderRow -> HeaderRow -> Bool
compare :: HeaderRow -> HeaderRow -> Ordering
$ccompare :: HeaderRow -> HeaderRow -> Ordering
Ord, ReadPrec [HeaderRow]
ReadPrec HeaderRow
Int -> ReadS HeaderRow
ReadS [HeaderRow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderRow]
$creadListPrec :: ReadPrec [HeaderRow]
readPrec :: ReadPrec HeaderRow
$creadPrec :: ReadPrec HeaderRow
readList :: ReadS [HeaderRow]
$creadList :: ReadS [HeaderRow]
readsPrec :: Int -> ReadS HeaderRow
$creadsPrec :: Int -> ReadS HeaderRow
Read, Int -> HeaderRow -> ShowS
[HeaderRow] -> ShowS
HeaderRow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderRow] -> ShowS
$cshowList :: [HeaderRow] -> ShowS
show :: HeaderRow -> String
$cshow :: HeaderRow -> String
showsPrec :: Int -> HeaderRow -> ShowS
$cshowsPrec :: Int -> HeaderRow -> ShowS
Show, Typeable, Typeable HeaderRow
HeaderRow -> DataType
HeaderRow -> Constr
(forall b. Data b => b -> b) -> HeaderRow -> HeaderRow
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HeaderRow -> u
forall u. (forall d. Data d => d -> u) -> HeaderRow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderRow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderRow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HeaderRow -> m HeaderRow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HeaderRow -> m HeaderRow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HeaderRow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderRow -> c HeaderRow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HeaderRow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HeaderRow)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HeaderRow -> m HeaderRow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HeaderRow -> m HeaderRow
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HeaderRow -> m HeaderRow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HeaderRow -> m HeaderRow
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HeaderRow -> m HeaderRow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HeaderRow -> m HeaderRow
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HeaderRow -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HeaderRow -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HeaderRow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HeaderRow -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderRow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderRow -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderRow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderRow -> r
gmapT :: (forall b. Data b => b -> b) -> HeaderRow -> HeaderRow
$cgmapT :: (forall b. Data b => b -> b) -> HeaderRow -> HeaderRow
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HeaderRow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HeaderRow)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HeaderRow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HeaderRow)
dataTypeOf :: HeaderRow -> DataType
$cdataTypeOf :: HeaderRow -> DataType
toConstr :: HeaderRow -> Constr
$ctoConstr :: HeaderRow -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HeaderRow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HeaderRow
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderRow -> c HeaderRow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderRow -> c HeaderRow
Data, forall x. Rep HeaderRow x -> HeaderRow
forall x. HeaderRow -> Rep HeaderRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HeaderRow x -> HeaderRow
$cfrom :: forall x. HeaderRow -> Rep HeaderRow x
Generic)

-- | An annotated body row, corresponding to a Pandoc 'B.Row' and the
-- HTML @\<tr\>@ element, and also recording its row number and
-- separating the row head cells from the row body cells.
data BodyRow = BodyRow B.Attr RowNumber RowHead RowBody
  deriving (BodyRow -> BodyRow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BodyRow -> BodyRow -> Bool
$c/= :: BodyRow -> BodyRow -> Bool
== :: BodyRow -> BodyRow -> Bool
$c== :: BodyRow -> BodyRow -> Bool
Eq, Eq BodyRow
BodyRow -> BodyRow -> Bool
BodyRow -> BodyRow -> Ordering
BodyRow -> BodyRow -> BodyRow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BodyRow -> BodyRow -> BodyRow
$cmin :: BodyRow -> BodyRow -> BodyRow
max :: BodyRow -> BodyRow -> BodyRow
$cmax :: BodyRow -> BodyRow -> BodyRow
>= :: BodyRow -> BodyRow -> Bool
$c>= :: BodyRow -> BodyRow -> Bool
> :: BodyRow -> BodyRow -> Bool
$c> :: BodyRow -> BodyRow -> Bool
<= :: BodyRow -> BodyRow -> Bool
$c<= :: BodyRow -> BodyRow -> Bool
< :: BodyRow -> BodyRow -> Bool
$c< :: BodyRow -> BodyRow -> Bool
compare :: BodyRow -> BodyRow -> Ordering
$ccompare :: BodyRow -> BodyRow -> Ordering
Ord, ReadPrec [BodyRow]
ReadPrec BodyRow
Int -> ReadS BodyRow
ReadS [BodyRow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BodyRow]
$creadListPrec :: ReadPrec [BodyRow]
readPrec :: ReadPrec BodyRow
$creadPrec :: ReadPrec BodyRow
readList :: ReadS [BodyRow]
$creadList :: ReadS [BodyRow]
readsPrec :: Int -> ReadS BodyRow
$creadsPrec :: Int -> ReadS BodyRow
Read, Int -> BodyRow -> ShowS
[BodyRow] -> ShowS
BodyRow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BodyRow] -> ShowS
$cshowList :: [BodyRow] -> ShowS
show :: BodyRow -> String
$cshow :: BodyRow -> String
showsPrec :: Int -> BodyRow -> ShowS
$cshowsPrec :: Int -> BodyRow -> ShowS
Show, Typeable, Typeable BodyRow
BodyRow -> DataType
BodyRow -> Constr
(forall b. Data b => b -> b) -> BodyRow -> BodyRow
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BodyRow -> u
forall u. (forall d. Data d => d -> u) -> BodyRow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BodyRow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BodyRow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BodyRow -> m BodyRow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BodyRow -> m BodyRow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BodyRow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BodyRow -> c BodyRow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BodyRow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BodyRow)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BodyRow -> m BodyRow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BodyRow -> m BodyRow
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BodyRow -> m BodyRow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BodyRow -> m BodyRow
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BodyRow -> m BodyRow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BodyRow -> m BodyRow
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BodyRow -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BodyRow -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BodyRow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BodyRow -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BodyRow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BodyRow -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BodyRow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BodyRow -> r
gmapT :: (forall b. Data b => b -> b) -> BodyRow -> BodyRow
$cgmapT :: (forall b. Data b => b -> b) -> BodyRow -> BodyRow
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BodyRow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BodyRow)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BodyRow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BodyRow)
dataTypeOf :: BodyRow -> DataType
$cdataTypeOf :: BodyRow -> DataType
toConstr :: BodyRow -> Constr
$ctoConstr :: BodyRow -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BodyRow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BodyRow
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BodyRow -> c BodyRow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BodyRow -> c BodyRow
Data, forall x. Rep BodyRow x -> BodyRow
forall x. BodyRow -> Rep BodyRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BodyRow x -> BodyRow
$cfrom :: forall x. BodyRow -> Rep BodyRow x
Generic)

-- | The row number of a row. Note that rows are numbered continuously
-- from zero from the start of the table, so the first row in a table
-- body, for instance, may have a large 'RowNumber'.
newtype RowNumber = RowNumber Int
  deriving (RowNumber -> RowNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowNumber -> RowNumber -> Bool
$c/= :: RowNumber -> RowNumber -> Bool
== :: RowNumber -> RowNumber -> Bool
$c== :: RowNumber -> RowNumber -> Bool
Eq, Eq RowNumber
RowNumber -> RowNumber -> Bool
RowNumber -> RowNumber -> Ordering
RowNumber -> RowNumber -> RowNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RowNumber -> RowNumber -> RowNumber
$cmin :: RowNumber -> RowNumber -> RowNumber
max :: RowNumber -> RowNumber -> RowNumber
$cmax :: RowNumber -> RowNumber -> RowNumber
>= :: RowNumber -> RowNumber -> Bool
$c>= :: RowNumber -> RowNumber -> Bool
> :: RowNumber -> RowNumber -> Bool
$c> :: RowNumber -> RowNumber -> Bool
<= :: RowNumber -> RowNumber -> Bool
$c<= :: RowNumber -> RowNumber -> Bool
< :: RowNumber -> RowNumber -> Bool
$c< :: RowNumber -> RowNumber -> Bool
compare :: RowNumber -> RowNumber -> Ordering
$ccompare :: RowNumber -> RowNumber -> Ordering
Ord, ReadPrec [RowNumber]
ReadPrec RowNumber
Int -> ReadS RowNumber
ReadS [RowNumber]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RowNumber]
$creadListPrec :: ReadPrec [RowNumber]
readPrec :: ReadPrec RowNumber
$creadPrec :: ReadPrec RowNumber
readList :: ReadS [RowNumber]
$creadList :: ReadS [RowNumber]
readsPrec :: Int -> ReadS RowNumber
$creadsPrec :: Int -> ReadS RowNumber
Read, Int -> RowNumber -> ShowS
[RowNumber] -> ShowS
RowNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowNumber] -> ShowS
$cshowList :: [RowNumber] -> ShowS
show :: RowNumber -> String
$cshow :: RowNumber -> String
showsPrec :: Int -> RowNumber -> ShowS
$cshowsPrec :: Int -> RowNumber -> ShowS
Show, Typeable, Typeable RowNumber
RowNumber -> DataType
RowNumber -> Constr
(forall b. Data b => b -> b) -> RowNumber -> RowNumber
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RowNumber -> u
forall u. (forall d. Data d => d -> u) -> RowNumber -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowNumber -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowNumber -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RowNumber -> m RowNumber
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowNumber -> m RowNumber
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowNumber
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowNumber -> c RowNumber
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowNumber)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RowNumber)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowNumber -> m RowNumber
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowNumber -> m RowNumber
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowNumber -> m RowNumber
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowNumber -> m RowNumber
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RowNumber -> m RowNumber
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RowNumber -> m RowNumber
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RowNumber -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RowNumber -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RowNumber -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RowNumber -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowNumber -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowNumber -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowNumber -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowNumber -> r
gmapT :: (forall b. Data b => b -> b) -> RowNumber -> RowNumber
$cgmapT :: (forall b. Data b => b -> b) -> RowNumber -> RowNumber
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RowNumber)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RowNumber)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowNumber)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowNumber)
dataTypeOf :: RowNumber -> DataType
$cdataTypeOf :: RowNumber -> DataType
toConstr :: RowNumber -> Constr
$ctoConstr :: RowNumber -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowNumber
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowNumber
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowNumber -> c RowNumber
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowNumber -> c RowNumber
Data, forall x. Rep RowNumber x -> RowNumber
forall x. RowNumber -> Rep RowNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RowNumber x -> RowNumber
$cfrom :: forall x. RowNumber -> Rep RowNumber x
Generic, Integer -> RowNumber
RowNumber -> RowNumber
RowNumber -> RowNumber -> RowNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> RowNumber
$cfromInteger :: Integer -> RowNumber
signum :: RowNumber -> RowNumber
$csignum :: RowNumber -> RowNumber
abs :: RowNumber -> RowNumber
$cabs :: RowNumber -> RowNumber
negate :: RowNumber -> RowNumber
$cnegate :: RowNumber -> RowNumber
* :: RowNumber -> RowNumber -> RowNumber
$c* :: RowNumber -> RowNumber -> RowNumber
- :: RowNumber -> RowNumber -> RowNumber
$c- :: RowNumber -> RowNumber -> RowNumber
+ :: RowNumber -> RowNumber -> RowNumber
$c+ :: RowNumber -> RowNumber -> RowNumber
Num, Int -> RowNumber
RowNumber -> Int
RowNumber -> [RowNumber]
RowNumber -> RowNumber
RowNumber -> RowNumber -> [RowNumber]
RowNumber -> RowNumber -> RowNumber -> [RowNumber]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RowNumber -> RowNumber -> RowNumber -> [RowNumber]
$cenumFromThenTo :: RowNumber -> RowNumber -> RowNumber -> [RowNumber]
enumFromTo :: RowNumber -> RowNumber -> [RowNumber]
$cenumFromTo :: RowNumber -> RowNumber -> [RowNumber]
enumFromThen :: RowNumber -> RowNumber -> [RowNumber]
$cenumFromThen :: RowNumber -> RowNumber -> [RowNumber]
enumFrom :: RowNumber -> [RowNumber]
$cenumFrom :: RowNumber -> [RowNumber]
fromEnum :: RowNumber -> Int
$cfromEnum :: RowNumber -> Int
toEnum :: Int -> RowNumber
$ctoEnum :: Int -> RowNumber
pred :: RowNumber -> RowNumber
$cpred :: RowNumber -> RowNumber
succ :: RowNumber -> RowNumber
$csucc :: RowNumber -> RowNumber
Enum)

-- | The head of a body row; the portion of the row lying in the stub
-- of the 'TableBody'. Its cells correspond to HTML @\<th\>@ cells.
type RowHead = [Cell]

-- | The body of a body row; the portion of the row lying after the
-- stub of the 'TableBody'. Its cells correspond to HTML @\<td\>@
-- cells.
type RowBody = [Cell]

-- | An annotated table cell, wrapping a Pandoc 'B.Cell' with its
-- 'ColNumber' and the 'B.ColSpec' data for the columns that the cell
-- spans.
data Cell = Cell (NonEmpty B.ColSpec) ColNumber B.Cell
  deriving (Cell -> Cell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq, Eq Cell
Cell -> Cell -> Bool
Cell -> Cell -> Ordering
Cell -> Cell -> Cell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Cell -> Cell -> Cell
$cmin :: Cell -> Cell -> Cell
max :: Cell -> Cell -> Cell
$cmax :: Cell -> Cell -> Cell
>= :: Cell -> Cell -> Bool
$c>= :: Cell -> Cell -> Bool
> :: Cell -> Cell -> Bool
$c> :: Cell -> Cell -> Bool
<= :: Cell -> Cell -> Bool
$c<= :: Cell -> Cell -> Bool
< :: Cell -> Cell -> Bool
$c< :: Cell -> Cell -> Bool
compare :: Cell -> Cell -> Ordering
$ccompare :: Cell -> Cell -> Ordering
Ord, ReadPrec [Cell]
ReadPrec Cell
Int -> ReadS Cell
ReadS [Cell]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cell]
$creadListPrec :: ReadPrec [Cell]
readPrec :: ReadPrec Cell
$creadPrec :: ReadPrec Cell
readList :: ReadS [Cell]
$creadList :: ReadS [Cell]
readsPrec :: Int -> ReadS Cell
$creadsPrec :: Int -> ReadS Cell
Read, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show, Typeable, Typeable Cell
Cell -> DataType
Cell -> Constr
(forall b. Data b => b -> b) -> Cell -> Cell
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Cell -> u
forall u. (forall d. Data d => d -> u) -> Cell -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cell -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cell -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cell
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cell -> c Cell
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cell)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cell)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cell -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cell -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Cell -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Cell -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cell -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cell -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cell -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cell -> r
gmapT :: (forall b. Data b => b -> b) -> Cell -> Cell
$cgmapT :: (forall b. Data b => b -> b) -> Cell -> Cell
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cell)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cell)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cell)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cell)
dataTypeOf :: Cell -> DataType
$cdataTypeOf :: Cell -> DataType
toConstr :: Cell -> Constr
$ctoConstr :: Cell -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cell
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cell
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cell -> c Cell
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cell -> c Cell
Data, forall x. Rep Cell x -> Cell
forall x. Cell -> Rep Cell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cell x -> Cell
$cfrom :: forall x. Cell -> Rep Cell x
Generic)

-- | The column number of a cell, meaning the column number of the
-- first column that the cell spans, if the table were laid on a
-- grid. Columns are numbered starting from zero.
newtype ColNumber = ColNumber Int
  deriving (ColNumber -> ColNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColNumber -> ColNumber -> Bool
$c/= :: ColNumber -> ColNumber -> Bool
== :: ColNumber -> ColNumber -> Bool
$c== :: ColNumber -> ColNumber -> Bool
Eq, Eq ColNumber
ColNumber -> ColNumber -> Bool
ColNumber -> ColNumber -> Ordering
ColNumber -> ColNumber -> ColNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColNumber -> ColNumber -> ColNumber
$cmin :: ColNumber -> ColNumber -> ColNumber
max :: ColNumber -> ColNumber -> ColNumber
$cmax :: ColNumber -> ColNumber -> ColNumber
>= :: ColNumber -> ColNumber -> Bool
$c>= :: ColNumber -> ColNumber -> Bool
> :: ColNumber -> ColNumber -> Bool
$c> :: ColNumber -> ColNumber -> Bool
<= :: ColNumber -> ColNumber -> Bool
$c<= :: ColNumber -> ColNumber -> Bool
< :: ColNumber -> ColNumber -> Bool
$c< :: ColNumber -> ColNumber -> Bool
compare :: ColNumber -> ColNumber -> Ordering
$ccompare :: ColNumber -> ColNumber -> Ordering
Ord, ReadPrec [ColNumber]
ReadPrec ColNumber
Int -> ReadS ColNumber
ReadS [ColNumber]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColNumber]
$creadListPrec :: ReadPrec [ColNumber]
readPrec :: ReadPrec ColNumber
$creadPrec :: ReadPrec ColNumber
readList :: ReadS [ColNumber]
$creadList :: ReadS [ColNumber]
readsPrec :: Int -> ReadS ColNumber
$creadsPrec :: Int -> ReadS ColNumber
Read, Int -> ColNumber -> ShowS
[ColNumber] -> ShowS
ColNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColNumber] -> ShowS
$cshowList :: [ColNumber] -> ShowS
show :: ColNumber -> String
$cshow :: ColNumber -> String
showsPrec :: Int -> ColNumber -> ShowS
$cshowsPrec :: Int -> ColNumber -> ShowS
Show, Typeable, Typeable ColNumber
ColNumber -> DataType
ColNumber -> Constr
(forall b. Data b => b -> b) -> ColNumber -> ColNumber
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ColNumber -> u
forall u. (forall d. Data d => d -> u) -> ColNumber -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColNumber -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColNumber -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColNumber -> m ColNumber
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColNumber -> m ColNumber
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColNumber
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColNumber -> c ColNumber
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColNumber)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColNumber)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColNumber -> m ColNumber
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColNumber -> m ColNumber
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColNumber -> m ColNumber
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColNumber -> m ColNumber
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColNumber -> m ColNumber
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColNumber -> m ColNumber
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColNumber -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColNumber -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ColNumber -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColNumber -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColNumber -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColNumber -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColNumber -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColNumber -> r
gmapT :: (forall b. Data b => b -> b) -> ColNumber -> ColNumber
$cgmapT :: (forall b. Data b => b -> b) -> ColNumber -> ColNumber
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColNumber)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColNumber)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColNumber)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColNumber)
dataTypeOf :: ColNumber -> DataType
$cdataTypeOf :: ColNumber -> DataType
toConstr :: ColNumber -> Constr
$ctoConstr :: ColNumber -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColNumber
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColNumber
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColNumber -> c ColNumber
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColNumber -> c ColNumber
Data, forall x. Rep ColNumber x -> ColNumber
forall x. ColNumber -> Rep ColNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColNumber x -> ColNumber
$cfrom :: forall x. ColNumber -> Rep ColNumber x
Generic, Integer -> ColNumber
ColNumber -> ColNumber
ColNumber -> ColNumber -> ColNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ColNumber
$cfromInteger :: Integer -> ColNumber
signum :: ColNumber -> ColNumber
$csignum :: ColNumber -> ColNumber
abs :: ColNumber -> ColNumber
$cabs :: ColNumber -> ColNumber
negate :: ColNumber -> ColNumber
$cnegate :: ColNumber -> ColNumber
* :: ColNumber -> ColNumber -> ColNumber
$c* :: ColNumber -> ColNumber -> ColNumber
- :: ColNumber -> ColNumber -> ColNumber
$c- :: ColNumber -> ColNumber -> ColNumber
+ :: ColNumber -> ColNumber -> ColNumber
$c+ :: ColNumber -> ColNumber -> ColNumber
Num, Int -> ColNumber
ColNumber -> Int
ColNumber -> [ColNumber]
ColNumber -> ColNumber
ColNumber -> ColNumber -> [ColNumber]
ColNumber -> ColNumber -> ColNumber -> [ColNumber]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ColNumber -> ColNumber -> ColNumber -> [ColNumber]
$cenumFromThenTo :: ColNumber -> ColNumber -> ColNumber -> [ColNumber]
enumFromTo :: ColNumber -> ColNumber -> [ColNumber]
$cenumFromTo :: ColNumber -> ColNumber -> [ColNumber]
enumFromThen :: ColNumber -> ColNumber -> [ColNumber]
$cenumFromThen :: ColNumber -> ColNumber -> [ColNumber]
enumFrom :: ColNumber -> [ColNumber]
$cenumFrom :: ColNumber -> [ColNumber]
fromEnum :: ColNumber -> Int
$cfromEnum :: ColNumber -> Int
toEnum :: Int -> ColNumber
$ctoEnum :: Int -> ColNumber
pred :: ColNumber -> ColNumber
$cpred :: ColNumber -> ColNumber
succ :: ColNumber -> ColNumber
$csucc :: ColNumber -> ColNumber
Enum)

-- | Convert a Pandoc 'B.Table' to an annotated 'Table'. This function
-- also performs the same normalization that the 'B.table' builder
-- does (fixing overlapping cells, cells that protrude out of their
-- table section, and so on). If the input table happens to satisfy
-- the conditions that 'B.table' guarantees, then the resulting
-- 'Table' will be identical, save for the addition of the inferred
-- table information.
toTable
  :: B.Attr
  -> B.Caption
  -> [B.ColSpec]
  -> B.TableHead
  -> [B.TableBody]
  -> B.TableFoot
  -> Table
toTable :: Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
toTable Attr
attr Caption
cap [ColSpec]
cs TableHead
th [TableBody]
tbs TableFoot
tf = Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Table Attr
attr Caption
cap [ColSpec]
cs TableHead
th' [TableBody]
tbs' TableFoot
tf'
 where
  (TableHead
th', [TableBody]
tbs', TableFoot
tf') = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS (TableHead
-> [TableBody]
-> TableFoot
-> AnnM (TableHead, [TableBody], TableFoot)
annotateTable TableHead
th [TableBody]
tbs TableFoot
tf) ([ColSpec]
cs, forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
cs) RowNumber
0

-- | Internal monad for annotating a table, passing in the 'B.ColSpec'
-- data for the table, the grid width, and the current 'RowNumber' to
-- be referenced or updated.
type AnnM a = RWS ([B.ColSpec], Int) () RowNumber a

incRowNumber :: AnnM RowNumber
incRowNumber :: AnnM RowNumber
incRowNumber = do
  RowNumber
rn <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ RowNumber
rn forall a. Num a => a -> a -> a
+ RowNumber
1
  forall (m :: * -> *) a. Monad m => a -> m a
return RowNumber
rn

annotateTable
  :: B.TableHead
  -> [B.TableBody]
  -> B.TableFoot
  -> AnnM (TableHead, [TableBody], TableFoot)
annotateTable :: TableHead
-> [TableBody]
-> TableFoot
-> AnnM (TableHead, [TableBody], TableFoot)
annotateTable TableHead
th [TableBody]
tbs TableFoot
tf = do
  TableHead
th'  <- TableHead -> AnnM TableHead
annotateTableHead TableHead
th
  [TableBody]
tbs' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TableBody -> AnnM TableBody
annotateTableBody [TableBody]
tbs
  TableFoot
tf'  <- TableFoot -> AnnM TableFoot
annotateTableFoot TableFoot
tf
  forall (m :: * -> *) a. Monad m => a -> m a
return (TableHead
th', [TableBody]
tbs', TableFoot
tf')

annotateTableHead :: B.TableHead -> AnnM TableHead
annotateTableHead :: TableHead -> AnnM TableHead
annotateTableHead (B.TableHead Attr
attr [Row]
rows) =
  Attr -> [HeaderRow] -> TableHead
TableHead Attr
attr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row] -> AnnM [HeaderRow]
annotateHeaderSection [Row]
rows

annotateTableBody :: B.TableBody -> AnnM TableBody
annotateTableBody :: TableBody -> AnnM TableBody
annotateTableBody (B.TableBody Attr
attr RowHeadColumns
rhc [Row]
th [Row]
tb) = do
  Int
twidth <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a, b) -> b
snd
  let rhc' :: RowHeadColumns
rhc' = forall a. Ord a => a -> a -> a
max RowHeadColumns
0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (Int -> RowHeadColumns
B.RowHeadColumns Int
twidth) RowHeadColumns
rhc
  [HeaderRow]
th' <- [Row] -> AnnM [HeaderRow]
annotateHeaderSection [Row]
th
  [BodyRow]
tb' <- RowHeadColumns -> [Row] -> AnnM [BodyRow]
annotateBodySection RowHeadColumns
rhc' [Row]
tb
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> RowHeadColumns -> [HeaderRow] -> [BodyRow] -> TableBody
TableBody Attr
attr RowHeadColumns
rhc' [HeaderRow]
th' [BodyRow]
tb'

annotateTableFoot :: B.TableFoot -> AnnM TableFoot
annotateTableFoot :: TableFoot -> AnnM TableFoot
annotateTableFoot (B.TableFoot Attr
attr [Row]
rows) =
  Attr -> [HeaderRow] -> TableFoot
TableFoot Attr
attr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row] -> AnnM [HeaderRow]
annotateHeaderSection [Row]
rows

annotateHeaderSection :: [B.Row] -> AnnM [HeaderRow]
annotateHeaderSection :: [Row] -> AnnM [HeaderRow]
annotateHeaderSection [Row]
rows = do
  [ColSpec]
colspec <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a, b) -> a
fst
  let hangcolspec :: [(RowSpan, ColSpec)]
hangcolspec = (RowSpan
1, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColSpec]
colspec
  forall {b}.
[(RowSpan, ColSpec)]
-> ([HeaderRow] -> b)
-> [Row]
-> RWST ([ColSpec], Int) () RowNumber Identity b
annotateHeaderSection' [(RowSpan, ColSpec)]
hangcolspec forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ [Row] -> [Row]
B.clipRows [Row]
rows
 where
  annotateHeaderSection' :: [(RowSpan, ColSpec)]
-> ([HeaderRow] -> b)
-> [Row]
-> RWST ([ColSpec], Int) () RowNumber Identity b
annotateHeaderSection' [(RowSpan, ColSpec)]
oldHang [HeaderRow] -> b
acc (B.Row Attr
attr [Cell]
cells : [Row]
rs) = do
    let (ColNumber
_, [(RowSpan, ColSpec)]
newHang, [Cell]
cells', [Cell]
_) =
          ColNumber
-> [(RowSpan, ColSpec)]
-> [Cell]
-> (ColNumber, [(RowSpan, ColSpec)], [Cell], [Cell])
annotateRowSection ColNumber
0 [(RowSpan, ColSpec)]
oldHang forall a b. (a -> b) -> a -> b
$ [Cell]
cells forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat Cell
B.emptyCell
    RowNumber
n <- AnnM RowNumber
incRowNumber
    let annRow :: HeaderRow
annRow = Attr -> RowNumber -> [Cell] -> HeaderRow
HeaderRow Attr
attr RowNumber
n [Cell]
cells'
    [(RowSpan, ColSpec)]
-> ([HeaderRow] -> b)
-> [Row]
-> RWST ([ColSpec], Int) () RowNumber Identity b
annotateHeaderSection' [(RowSpan, ColSpec)]
newHang ([HeaderRow] -> b
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderRow
annRow forall a. a -> [a] -> [a]
:)) [Row]
rs
  annotateHeaderSection' [(RowSpan, ColSpec)]
_ [HeaderRow] -> b
acc [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [HeaderRow] -> b
acc []

annotateBodySection :: B.RowHeadColumns -> [B.Row] -> AnnM [BodyRow]
annotateBodySection :: RowHeadColumns -> [Row] -> AnnM [BodyRow]
annotateBodySection (B.RowHeadColumns Int
rhc) [Row]
rows = do
  [ColSpec]
colspec <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a, b) -> a
fst
  let colspec' :: [(RowSpan, ColSpec)]
colspec'             = (RowSpan
1, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColSpec]
colspec
  let ([(RowSpan, ColSpec)]
stubspec, [(RowSpan, ColSpec)]
bodyspec) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
rhc [(RowSpan, ColSpec)]
colspec'
  forall {b}.
[(RowSpan, ColSpec)]
-> [(RowSpan, ColSpec)]
-> ([BodyRow] -> b)
-> [Row]
-> RWST ([ColSpec], Int) () RowNumber Identity b
normalizeBodySection' [(RowSpan, ColSpec)]
stubspec [(RowSpan, ColSpec)]
bodyspec forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ [Row] -> [Row]
B.clipRows [Row]
rows
 where
  normalizeBodySection' :: [(RowSpan, ColSpec)]
-> [(RowSpan, ColSpec)]
-> ([BodyRow] -> b)
-> [Row]
-> RWST ([ColSpec], Int) () RowNumber Identity b
normalizeBodySection' [(RowSpan, ColSpec)]
headHang [(RowSpan, ColSpec)]
bodyHang [BodyRow] -> b
acc (B.Row Attr
attr [Cell]
cells : [Row]
rs) = do
    let (ColNumber
colnum, [(RowSpan, ColSpec)]
headHang', [Cell]
rowStub, [Cell]
cells') =
          ColNumber
-> [(RowSpan, ColSpec)]
-> [Cell]
-> (ColNumber, [(RowSpan, ColSpec)], [Cell], [Cell])
annotateRowSection ColNumber
0 [(RowSpan, ColSpec)]
headHang forall a b. (a -> b) -> a -> b
$ [Cell]
cells forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat Cell
B.emptyCell
    let (ColNumber
_, [(RowSpan, ColSpec)]
bodyHang', [Cell]
rowBody, [Cell]
_) = ColNumber
-> [(RowSpan, ColSpec)]
-> [Cell]
-> (ColNumber, [(RowSpan, ColSpec)], [Cell], [Cell])
annotateRowSection ColNumber
colnum [(RowSpan, ColSpec)]
bodyHang [Cell]
cells'
    RowNumber
n <- AnnM RowNumber
incRowNumber
    let annRow :: BodyRow
annRow = Attr -> RowNumber -> [Cell] -> [Cell] -> BodyRow
BodyRow Attr
attr RowNumber
n [Cell]
rowStub [Cell]
rowBody
    [(RowSpan, ColSpec)]
-> [(RowSpan, ColSpec)]
-> ([BodyRow] -> b)
-> [Row]
-> RWST ([ColSpec], Int) () RowNumber Identity b
normalizeBodySection' [(RowSpan, ColSpec)]
headHang' [(RowSpan, ColSpec)]
bodyHang' ([BodyRow] -> b
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyRow
annRow forall a. a -> [a] -> [a]
:)) [Row]
rs
  normalizeBodySection' [(RowSpan, ColSpec)]
_ [(RowSpan, ColSpec)]
_ [BodyRow] -> b
acc [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [BodyRow] -> b
acc []

-- | Lay out a section of a 'Table' row on a grid row, annotating the
-- cells with the 'B.ColSpec' data for the columns that they
-- span. Performs the same normalization as 'B.placeRowSection'.
annotateRowSection
  :: ColNumber -- ^ The current column number
  -> [(B.RowSpan, B.ColSpec)] -- ^ The overhang of the previous grid row,
                              -- with column data
  -> [B.Cell] -- ^ The cells to annotate
  -> (ColNumber, [(B.RowSpan, B.ColSpec)], [Cell], [B.Cell]) -- ^ The new
                                                             -- column
                                                             -- number,
                                                             -- overhang,
                                                             -- annotated
                                                             -- cells,
                                                             -- and
                                                             -- remaining
                                                             -- cells
annotateRowSection :: ColNumber
-> [(RowSpan, ColSpec)]
-> [Cell]
-> (ColNumber, [(RowSpan, ColSpec)], [Cell], [Cell])
annotateRowSection !ColNumber
colnum [(RowSpan, ColSpec)]
oldHang [Cell]
cells
  -- If the grid has overhang at our position, try to re-lay in
  -- the next position.
  | (RowSpan
o, ColSpec
colspec) : [(RowSpan, ColSpec)]
os <- [(RowSpan, ColSpec)]
oldHang
  , RowSpan
o forall a. Ord a => a -> a -> Bool
> RowSpan
1
  = let (ColNumber
colnum', [(RowSpan, ColSpec)]
newHang, [Cell]
newCell, [Cell]
cells') =
            ColNumber
-> [(RowSpan, ColSpec)]
-> [Cell]
-> (ColNumber, [(RowSpan, ColSpec)], [Cell], [Cell])
annotateRowSection (ColNumber
colnum forall a. Num a => a -> a -> a
+ ColNumber
1) [(RowSpan, ColSpec)]
os [Cell]
cells
    in  (ColNumber
colnum', (RowSpan
o forall a. Num a => a -> a -> a
- RowSpan
1, ColSpec
colspec) forall a. a -> [a] -> [a]
: [(RowSpan, ColSpec)]
newHang, [Cell]
newCell, [Cell]
cells')
  -- Otherwise if there is any available width, place the cell and
  -- continue.
  | Cell
c : [Cell]
cells' <- [Cell]
cells
  , (RowSpan
h, ColSpan
w) <- Cell -> (RowSpan, ColSpan)
getDim Cell
c
  , ColSpan
w' <- forall a. Ord a => a -> a -> a
max ColSpan
1 ColSpan
w
  , (ColSpan
w'', cellHang :: [(RowSpan, ColSpec)]
cellHang@((RowSpan, ColSpec)
chStart : [(RowSpan, ColSpec)]
chRest), [(RowSpan, ColSpec)]
oldHang') <- RowSpan
-> ColSpan
-> [(RowSpan, ColSpec)]
-> (ColSpan, [(RowSpan, ColSpec)], [(RowSpan, ColSpec)])
splitCellHang RowSpan
h ColSpan
w' [(RowSpan, ColSpec)]
oldHang
  = let c' :: Cell
c'      = ColSpan -> Cell -> Cell
setW ColSpan
w'' Cell
c
        annCell :: Cell
annCell = NonEmpty ColSpec -> ColNumber -> Cell -> Cell
Cell (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RowSpan, ColSpec)
chStart forall a. a -> [a] -> NonEmpty a
:| [(RowSpan, ColSpec)]
chRest) ColNumber
colnum Cell
c'
        colnum' :: ColNumber
colnum' = ColNumber
colnum forall a. Num a => a -> a -> a
+ Int -> ColNumber
ColNumber (ColSpan -> Int
getColSpan ColSpan
w'')
        (ColNumber
colnum'', [(RowSpan, ColSpec)]
newHang, [Cell]
newCells, [Cell]
remainCells) =
            ColNumber
-> [(RowSpan, ColSpec)]
-> [Cell]
-> (ColNumber, [(RowSpan, ColSpec)], [Cell], [Cell])
annotateRowSection ColNumber
colnum' [(RowSpan, ColSpec)]
oldHang' [Cell]
cells'
    in  (ColNumber
colnum'', [(RowSpan, ColSpec)]
cellHang forall a. Semigroup a => a -> a -> a
<> [(RowSpan, ColSpec)]
newHang, Cell
annCell forall a. a -> [a] -> [a]
: [Cell]
newCells, [Cell]
remainCells)
  -- Otherwise there is no room in the section
  | Bool
otherwise
  = (ColNumber
colnum, [], [], [Cell]
cells)
 where
  getColSpan :: ColSpan -> Int
getColSpan (B.ColSpan Int
x) = Int
x
  getDim :: Cell -> (RowSpan, ColSpan)
getDim (B.Cell Attr
_ Alignment
_ RowSpan
h ColSpan
w [Block]
_) = (RowSpan
h, ColSpan
w)
  setW :: ColSpan -> Cell -> Cell
setW ColSpan
w (B.Cell Attr
a Alignment
b RowSpan
h ColSpan
_ [Block]
c) = Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
B.Cell Attr
a Alignment
b RowSpan
h ColSpan
w [Block]
c

-- | In @'splitCellHang' rs cs coldata@, with @rs@ the height of a
-- cell that lies at the beginning of @coldata@, and @cs@ its width
-- (which is not assumed to fit in the available space), return the
-- actual width of the cell (what will fit in the available space),
-- the data for the columns that the cell spans (including updating
-- the overhang to equal @rs@), and the remaining column data.
splitCellHang
  :: B.RowSpan
  -> B.ColSpan
  -> [(B.RowSpan, B.ColSpec)]
  -> (B.ColSpan, [(B.RowSpan, B.ColSpec)], [(B.RowSpan, B.ColSpec)])
splitCellHang :: RowSpan
-> ColSpan
-> [(RowSpan, ColSpec)]
-> (ColSpan, [(RowSpan, ColSpec)], [(RowSpan, ColSpec)])
splitCellHang RowSpan
h ColSpan
n = forall {a} {b}.
(Eq a, Num a) =>
ColSpan -> [(a, b)] -> (ColSpan, [(RowSpan, b)], [(a, b)])
go ColSpan
0
 where
  go :: ColSpan -> [(a, b)] -> (ColSpan, [(RowSpan, b)], [(a, b)])
go ColSpan
acc ((a
1, b
spec) : [(a, b)]
ls) | ColSpan
acc forall a. Ord a => a -> a -> Bool
< ColSpan
n =
    let (ColSpan
acc', [(RowSpan, b)]
hang, [(a, b)]
ls') = ColSpan -> [(a, b)] -> (ColSpan, [(RowSpan, b)], [(a, b)])
go (ColSpan
acc forall a. Num a => a -> a -> a
+ ColSpan
1) [(a, b)]
ls in (ColSpan
acc', (RowSpan
h, b
spec) forall a. a -> [a] -> [a]
: [(RowSpan, b)]
hang, [(a, b)]
ls')
  go ColSpan
acc [(a, b)]
l = (ColSpan
acc, [], [(a, b)]
l)

-- | Convert an annotated 'Table' to a Pandoc
-- 'B.Table'. This is the inverse of 'toTable' on
-- well-formed tables (i.e. tables satisfying the guarantees of
-- 'B.table').
fromTable
  :: Table
  -> ( B.Attr
     , B.Caption
     , [B.ColSpec]
     , B.TableHead
     , [B.TableBody]
     , B.TableFoot
     )
fromTable :: Table
-> (Attr, Caption, [ColSpec], TableHead, [TableBody], TableFoot)
fromTable (Table Attr
attr Caption
cap [ColSpec]
cs TableHead
th [TableBody]
tbs TableFoot
tf) = (Attr
attr, Caption
cap, [ColSpec]
cs, TableHead
th', [TableBody]
tbs', TableFoot
tf')
 where
  th' :: TableHead
th'  = TableHead -> TableHead
fromTableHead TableHead
th
  tbs' :: [TableBody]
tbs' = forall a b. (a -> b) -> [a] -> [b]
map TableBody -> TableBody
fromTableBody [TableBody]
tbs
  tf' :: TableFoot
tf'  = TableFoot -> TableFoot
fromTableFoot TableFoot
tf

fromTableHead :: TableHead -> B.TableHead
fromTableHead :: TableHead -> TableHead
fromTableHead (TableHead Attr
attr [HeaderRow]
rows) = Attr -> [Row] -> TableHead
B.TableHead Attr
attr forall a b. (a -> b) -> a -> b
$ HeaderRow -> Row
fromHeaderRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HeaderRow]
rows

fromTableBody :: TableBody -> B.TableBody
fromTableBody :: TableBody -> TableBody
fromTableBody (TableBody Attr
attr RowHeadColumns
rhc [HeaderRow]
th [BodyRow]
tb) =
  Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
B.TableBody Attr
attr RowHeadColumns
rhc (HeaderRow -> Row
fromHeaderRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HeaderRow]
th) (BodyRow -> Row
fromBodyRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BodyRow]
tb)

fromTableFoot :: TableFoot -> B.TableFoot
fromTableFoot :: TableFoot -> TableFoot
fromTableFoot (TableFoot Attr
attr [HeaderRow]
rows) = Attr -> [Row] -> TableFoot
B.TableFoot Attr
attr forall a b. (a -> b) -> a -> b
$ HeaderRow -> Row
fromHeaderRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HeaderRow]
rows

fromHeaderRow :: HeaderRow -> B.Row
fromHeaderRow :: HeaderRow -> Row
fromHeaderRow (HeaderRow Attr
attr RowNumber
_ [Cell]
cells) = Attr -> [Cell] -> Row
B.Row Attr
attr forall a b. (a -> b) -> a -> b
$ Cell -> Cell
fromCell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cell]
cells

fromBodyRow :: BodyRow -> B.Row
fromBodyRow :: BodyRow -> Row
fromBodyRow (BodyRow Attr
attr RowNumber
_ [Cell]
rh [Cell]
rb) =
  Attr -> [Cell] -> Row
B.Row Attr
attr ((Cell -> Cell
fromCell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cell]
rh) forall a. Semigroup a => a -> a -> a
<> (Cell -> Cell
fromCell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cell]
rb))

fromCell :: Cell -> B.Cell
fromCell :: Cell -> Cell
fromCell (Cell NonEmpty ColSpec
_ ColNumber
_ Cell
c) = Cell
c

--
-- Instances
--
instance Walkable a B.Cell => Walkable a Cell where
  walkM :: forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(a -> m a) -> Cell -> m Cell
walkM a -> m a
f (Cell NonEmpty ColSpec
colspecs ColNumber
colnum Cell
cell) =
    NonEmpty ColSpec -> ColNumber -> Cell -> Cell
Cell NonEmpty ColSpec
colspecs ColNumber
colnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM a -> m a
f Cell
cell
  query :: forall c. Monoid c => (a -> c) -> Cell -> c
query a -> c
f (Cell NonEmpty ColSpec
_colspecs ColNumber
_colnum Cell
cell) = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query a -> c
f Cell
cell

instance Walkable a B.Cell => Walkable a HeaderRow where
  walkM :: forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(a -> m a) -> HeaderRow -> m HeaderRow
walkM a -> m a
f (HeaderRow Attr
attr RowNumber
rownum [Cell]
cells) =
    Attr -> RowNumber -> [Cell] -> HeaderRow
HeaderRow Attr
attr RowNumber
rownum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM a -> m a
f [Cell]
cells
  query :: forall c. Monoid c => (a -> c) -> HeaderRow -> c
query a -> c
f (HeaderRow Attr
_attr RowNumber
_rownum [Cell]
cells) = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query a -> c
f [Cell]
cells

instance Walkable a B.Cell => Walkable a TableHead where
  walkM :: forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(a -> m a) -> TableHead -> m TableHead
walkM a -> m a
f (TableHead Attr
attr [HeaderRow]
rows) =
    Attr -> [HeaderRow] -> TableHead
TableHead Attr
attr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM a -> m a
f [HeaderRow]
rows
  query :: forall c. Monoid c => (a -> c) -> TableHead -> c
query a -> c
f (TableHead Attr
_attr [HeaderRow]
rows) = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query a -> c
f [HeaderRow]
rows