{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric,
FlexibleContexts, GeneralizedNewtypeDeriving, PatternGuards, CPP #-}
module Text.Pandoc.Definition ( Pandoc(..)
, Meta(..)
, MetaValue(..)
, nullMeta
, isNullMeta
, lookupMeta
, docTitle
, docAuthors
, docDate
, Block(..)
, Inline(..)
, ListAttributes
, ListNumberStyle(..)
, ListNumberDelim(..)
, Format(..)
, Attr
, nullAttr
, Caption(..)
, ShortCaption
, RowHeadColumns(..)
, Alignment(..)
, ColWidth(..)
, ColSpec
, Row(..)
, TableHead(..)
, TableBody(..)
, TableFoot(..)
, Cell(..)
, RowSpan(..)
, ColSpan(..)
, QuoteType(..)
, Target
, MathType(..)
, Citation(..)
, CitationMode(..)
, pandocTypesVersion
) where
import Data.Generics (Data, Typeable)
import Data.Ord (comparing)
import Data.Aeson hiding (Null)
import qualified Data.Aeson.Types as Aeson
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Data.String
import Control.DeepSeq
import Paths_pandoc_types (version)
import Data.Version (Version, versionBranch)
import Data.Semigroup (Semigroup(..))
data Pandoc = Pandoc Meta [Block]
deriving (Pandoc -> Pandoc -> Bool
(Pandoc -> Pandoc -> Bool)
-> (Pandoc -> Pandoc -> Bool) -> Eq Pandoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pandoc -> Pandoc -> Bool
$c/= :: Pandoc -> Pandoc -> Bool
== :: Pandoc -> Pandoc -> Bool
$c== :: Pandoc -> Pandoc -> Bool
Eq, Eq Pandoc
Eq Pandoc
-> (Pandoc -> Pandoc -> Ordering)
-> (Pandoc -> Pandoc -> Bool)
-> (Pandoc -> Pandoc -> Bool)
-> (Pandoc -> Pandoc -> Bool)
-> (Pandoc -> Pandoc -> Bool)
-> (Pandoc -> Pandoc -> Pandoc)
-> (Pandoc -> Pandoc -> Pandoc)
-> Ord Pandoc
Pandoc -> Pandoc -> Bool
Pandoc -> Pandoc -> Ordering
Pandoc -> Pandoc -> Pandoc
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 :: Pandoc -> Pandoc -> Pandoc
$cmin :: Pandoc -> Pandoc -> Pandoc
max :: Pandoc -> Pandoc -> Pandoc
$cmax :: Pandoc -> Pandoc -> Pandoc
>= :: Pandoc -> Pandoc -> Bool
$c>= :: Pandoc -> Pandoc -> Bool
> :: Pandoc -> Pandoc -> Bool
$c> :: Pandoc -> Pandoc -> Bool
<= :: Pandoc -> Pandoc -> Bool
$c<= :: Pandoc -> Pandoc -> Bool
< :: Pandoc -> Pandoc -> Bool
$c< :: Pandoc -> Pandoc -> Bool
compare :: Pandoc -> Pandoc -> Ordering
$ccompare :: Pandoc -> Pandoc -> Ordering
$cp1Ord :: Eq Pandoc
Ord, ReadPrec [Pandoc]
ReadPrec Pandoc
Int -> ReadS Pandoc
ReadS [Pandoc]
(Int -> ReadS Pandoc)
-> ReadS [Pandoc]
-> ReadPrec Pandoc
-> ReadPrec [Pandoc]
-> Read Pandoc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pandoc]
$creadListPrec :: ReadPrec [Pandoc]
readPrec :: ReadPrec Pandoc
$creadPrec :: ReadPrec Pandoc
readList :: ReadS [Pandoc]
$creadList :: ReadS [Pandoc]
readsPrec :: Int -> ReadS Pandoc
$creadsPrec :: Int -> ReadS Pandoc
Read, Int -> Pandoc -> ShowS
[Pandoc] -> ShowS
Pandoc -> String
(Int -> Pandoc -> ShowS)
-> (Pandoc -> String) -> ([Pandoc] -> ShowS) -> Show Pandoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pandoc] -> ShowS
$cshowList :: [Pandoc] -> ShowS
show :: Pandoc -> String
$cshow :: Pandoc -> String
showsPrec :: Int -> Pandoc -> ShowS
$cshowsPrec :: Int -> Pandoc -> ShowS
Show, Typeable, Typeable Pandoc
DataType
Constr
Typeable Pandoc
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pandoc -> c Pandoc)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pandoc)
-> (Pandoc -> Constr)
-> (Pandoc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pandoc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pandoc))
-> ((forall b. Data b => b -> b) -> Pandoc -> Pandoc)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pandoc -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pandoc -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pandoc -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pandoc -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pandoc -> m Pandoc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pandoc -> m Pandoc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pandoc -> m Pandoc)
-> Data Pandoc
Pandoc -> DataType
Pandoc -> Constr
(forall b. Data b => b -> b) -> Pandoc -> Pandoc
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pandoc -> c Pandoc
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pandoc
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) -> Pandoc -> u
forall u. (forall d. Data d => d -> u) -> Pandoc -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pandoc -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pandoc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pandoc -> m Pandoc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pandoc -> m Pandoc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pandoc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pandoc -> c Pandoc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pandoc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pandoc)
$cPandoc :: Constr
$tPandoc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pandoc -> m Pandoc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pandoc -> m Pandoc
gmapMp :: (forall d. Data d => d -> m d) -> Pandoc -> m Pandoc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pandoc -> m Pandoc
gmapM :: (forall d. Data d => d -> m d) -> Pandoc -> m Pandoc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pandoc -> m Pandoc
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pandoc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pandoc -> u
gmapQ :: (forall d. Data d => d -> u) -> Pandoc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pandoc -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pandoc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pandoc -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pandoc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pandoc -> r
gmapT :: (forall b. Data b => b -> b) -> Pandoc -> Pandoc
$cgmapT :: (forall b. Data b => b -> b) -> Pandoc -> Pandoc
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pandoc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pandoc)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pandoc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pandoc)
dataTypeOf :: Pandoc -> DataType
$cdataTypeOf :: Pandoc -> DataType
toConstr :: Pandoc -> Constr
$ctoConstr :: Pandoc -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pandoc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pandoc
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pandoc -> c Pandoc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pandoc -> c Pandoc
$cp1Data :: Typeable Pandoc
Data, (forall x. Pandoc -> Rep Pandoc x)
-> (forall x. Rep Pandoc x -> Pandoc) -> Generic Pandoc
forall x. Rep Pandoc x -> Pandoc
forall x. Pandoc -> Rep Pandoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pandoc x -> Pandoc
$cfrom :: forall x. Pandoc -> Rep Pandoc x
Generic)
instance Semigroup Pandoc where
(Pandoc Meta
m1 [Block]
bs1) <> :: Pandoc -> Pandoc -> Pandoc
<> (Pandoc Meta
m2 [Block]
bs2) =
Meta -> [Block] -> Pandoc
Pandoc (Meta
m1 Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Meta
m2) ([Block]
bs1 [Block] -> [Block] -> [Block]
forall a. Semigroup a => a -> a -> a
<> [Block]
bs2)
instance Monoid Pandoc where
mempty :: Pandoc
mempty = Meta -> [Block] -> Pandoc
Pandoc Meta
forall a. Monoid a => a
mempty [Block]
forall a. Monoid a => a
mempty
mappend :: Pandoc -> Pandoc -> Pandoc
mappend = Pandoc -> Pandoc -> Pandoc
forall a. Semigroup a => a -> a -> a
(<>)
newtype Meta = Meta { Meta -> Map Text MetaValue
unMeta :: M.Map Text MetaValue }
deriving (Meta -> Meta -> Bool
(Meta -> Meta -> Bool) -> (Meta -> Meta -> Bool) -> Eq Meta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meta -> Meta -> Bool
$c/= :: Meta -> Meta -> Bool
== :: Meta -> Meta -> Bool
$c== :: Meta -> Meta -> Bool
Eq, Eq Meta
Eq Meta
-> (Meta -> Meta -> Ordering)
-> (Meta -> Meta -> Bool)
-> (Meta -> Meta -> Bool)
-> (Meta -> Meta -> Bool)
-> (Meta -> Meta -> Bool)
-> (Meta -> Meta -> Meta)
-> (Meta -> Meta -> Meta)
-> Ord Meta
Meta -> Meta -> Bool
Meta -> Meta -> Ordering
Meta -> Meta -> Meta
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 :: Meta -> Meta -> Meta
$cmin :: Meta -> Meta -> Meta
max :: Meta -> Meta -> Meta
$cmax :: Meta -> Meta -> Meta
>= :: Meta -> Meta -> Bool
$c>= :: Meta -> Meta -> Bool
> :: Meta -> Meta -> Bool
$c> :: Meta -> Meta -> Bool
<= :: Meta -> Meta -> Bool
$c<= :: Meta -> Meta -> Bool
< :: Meta -> Meta -> Bool
$c< :: Meta -> Meta -> Bool
compare :: Meta -> Meta -> Ordering
$ccompare :: Meta -> Meta -> Ordering
$cp1Ord :: Eq Meta
Ord, Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
(Int -> Meta -> ShowS)
-> (Meta -> String) -> ([Meta] -> ShowS) -> Show Meta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta] -> ShowS
$cshowList :: [Meta] -> ShowS
show :: Meta -> String
$cshow :: Meta -> String
showsPrec :: Int -> Meta -> ShowS
$cshowsPrec :: Int -> Meta -> ShowS
Show, ReadPrec [Meta]
ReadPrec Meta
Int -> ReadS Meta
ReadS [Meta]
(Int -> ReadS Meta)
-> ReadS [Meta] -> ReadPrec Meta -> ReadPrec [Meta] -> Read Meta
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Meta]
$creadListPrec :: ReadPrec [Meta]
readPrec :: ReadPrec Meta
$creadPrec :: ReadPrec Meta
readList :: ReadS [Meta]
$creadList :: ReadS [Meta]
readsPrec :: Int -> ReadS Meta
$creadsPrec :: Int -> ReadS Meta
Read, Typeable, Typeable Meta
DataType
Constr
Typeable Meta
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Meta -> c Meta)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Meta)
-> (Meta -> Constr)
-> (Meta -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Meta))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Meta))
-> ((forall b. Data b => b -> b) -> Meta -> Meta)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Meta -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Meta -> r)
-> (forall u. (forall d. Data d => d -> u) -> Meta -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Meta -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Meta -> m Meta)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Meta -> m Meta)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Meta -> m Meta)
-> Data Meta
Meta -> DataType
Meta -> Constr
(forall b. Data b => b -> b) -> Meta -> Meta
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Meta -> c Meta
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Meta
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) -> Meta -> u
forall u. (forall d. Data d => d -> u) -> Meta -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Meta -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Meta -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Meta -> m Meta
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Meta -> m Meta
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Meta
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Meta -> c Meta
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Meta)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Meta)
$cMeta :: Constr
$tMeta :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Meta -> m Meta
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Meta -> m Meta
gmapMp :: (forall d. Data d => d -> m d) -> Meta -> m Meta
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Meta -> m Meta
gmapM :: (forall d. Data d => d -> m d) -> Meta -> m Meta
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Meta -> m Meta
gmapQi :: Int -> (forall d. Data d => d -> u) -> Meta -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Meta -> u
gmapQ :: (forall d. Data d => d -> u) -> Meta -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Meta -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Meta -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Meta -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Meta -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Meta -> r
gmapT :: (forall b. Data b => b -> b) -> Meta -> Meta
$cgmapT :: (forall b. Data b => b -> b) -> Meta -> Meta
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Meta)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Meta)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Meta)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Meta)
dataTypeOf :: Meta -> DataType
$cdataTypeOf :: Meta -> DataType
toConstr :: Meta -> Constr
$ctoConstr :: Meta -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Meta
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Meta
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Meta -> c Meta
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Meta -> c Meta
$cp1Data :: Typeable Meta
Data, (forall x. Meta -> Rep Meta x)
-> (forall x. Rep Meta x -> Meta) -> Generic Meta
forall x. Rep Meta x -> Meta
forall x. Meta -> Rep Meta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Meta x -> Meta
$cfrom :: forall x. Meta -> Rep Meta x
Generic)
instance Semigroup Meta where
(Meta Map Text MetaValue
m1) <> :: Meta -> Meta -> Meta
<> (Meta Map Text MetaValue
m2) = Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Text MetaValue
m2 Map Text MetaValue
m1)
instance Monoid Meta where
mempty :: Meta
mempty = Map Text MetaValue -> Meta
Meta Map Text MetaValue
forall k a. Map k a
M.empty
mappend :: Meta -> Meta -> Meta
mappend = Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
(<>)
data MetaValue = MetaMap (M.Map Text MetaValue)
| MetaList [MetaValue]
| MetaBool Bool
| MetaString Text
| MetaInlines [Inline]
| MetaBlocks [Block]
deriving (MetaValue -> MetaValue -> Bool
(MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> Bool) -> Eq MetaValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaValue -> MetaValue -> Bool
$c/= :: MetaValue -> MetaValue -> Bool
== :: MetaValue -> MetaValue -> Bool
$c== :: MetaValue -> MetaValue -> Bool
Eq, Eq MetaValue
Eq MetaValue
-> (MetaValue -> MetaValue -> Ordering)
-> (MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> MetaValue)
-> (MetaValue -> MetaValue -> MetaValue)
-> Ord MetaValue
MetaValue -> MetaValue -> Bool
MetaValue -> MetaValue -> Ordering
MetaValue -> MetaValue -> MetaValue
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 :: MetaValue -> MetaValue -> MetaValue
$cmin :: MetaValue -> MetaValue -> MetaValue
max :: MetaValue -> MetaValue -> MetaValue
$cmax :: MetaValue -> MetaValue -> MetaValue
>= :: MetaValue -> MetaValue -> Bool
$c>= :: MetaValue -> MetaValue -> Bool
> :: MetaValue -> MetaValue -> Bool
$c> :: MetaValue -> MetaValue -> Bool
<= :: MetaValue -> MetaValue -> Bool
$c<= :: MetaValue -> MetaValue -> Bool
< :: MetaValue -> MetaValue -> Bool
$c< :: MetaValue -> MetaValue -> Bool
compare :: MetaValue -> MetaValue -> Ordering
$ccompare :: MetaValue -> MetaValue -> Ordering
$cp1Ord :: Eq MetaValue
Ord, Int -> MetaValue -> ShowS
[MetaValue] -> ShowS
MetaValue -> String
(Int -> MetaValue -> ShowS)
-> (MetaValue -> String)
-> ([MetaValue] -> ShowS)
-> Show MetaValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaValue] -> ShowS
$cshowList :: [MetaValue] -> ShowS
show :: MetaValue -> String
$cshow :: MetaValue -> String
showsPrec :: Int -> MetaValue -> ShowS
$cshowsPrec :: Int -> MetaValue -> ShowS
Show, ReadPrec [MetaValue]
ReadPrec MetaValue
Int -> ReadS MetaValue
ReadS [MetaValue]
(Int -> ReadS MetaValue)
-> ReadS [MetaValue]
-> ReadPrec MetaValue
-> ReadPrec [MetaValue]
-> Read MetaValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MetaValue]
$creadListPrec :: ReadPrec [MetaValue]
readPrec :: ReadPrec MetaValue
$creadPrec :: ReadPrec MetaValue
readList :: ReadS [MetaValue]
$creadList :: ReadS [MetaValue]
readsPrec :: Int -> ReadS MetaValue
$creadsPrec :: Int -> ReadS MetaValue
Read, Typeable, Typeable MetaValue
DataType
Constr
Typeable MetaValue
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MetaValue -> c MetaValue)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MetaValue)
-> (MetaValue -> Constr)
-> (MetaValue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MetaValue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MetaValue))
-> ((forall b. Data b => b -> b) -> MetaValue -> MetaValue)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MetaValue -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MetaValue -> r)
-> (forall u. (forall d. Data d => d -> u) -> MetaValue -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> MetaValue -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MetaValue -> m MetaValue)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MetaValue -> m MetaValue)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MetaValue -> m MetaValue)
-> Data MetaValue
MetaValue -> DataType
MetaValue -> Constr
(forall b. Data b => b -> b) -> MetaValue -> MetaValue
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MetaValue -> c MetaValue
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MetaValue
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) -> MetaValue -> u
forall u. (forall d. Data d => d -> u) -> MetaValue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MetaValue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MetaValue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MetaValue -> m MetaValue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MetaValue -> m MetaValue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MetaValue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MetaValue -> c MetaValue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MetaValue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MetaValue)
$cMetaBlocks :: Constr
$cMetaInlines :: Constr
$cMetaString :: Constr
$cMetaBool :: Constr
$cMetaList :: Constr
$cMetaMap :: Constr
$tMetaValue :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MetaValue -> m MetaValue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MetaValue -> m MetaValue
gmapMp :: (forall d. Data d => d -> m d) -> MetaValue -> m MetaValue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MetaValue -> m MetaValue
gmapM :: (forall d. Data d => d -> m d) -> MetaValue -> m MetaValue
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MetaValue -> m MetaValue
gmapQi :: Int -> (forall d. Data d => d -> u) -> MetaValue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MetaValue -> u
gmapQ :: (forall d. Data d => d -> u) -> MetaValue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MetaValue -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MetaValue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MetaValue -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MetaValue -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MetaValue -> r
gmapT :: (forall b. Data b => b -> b) -> MetaValue -> MetaValue
$cgmapT :: (forall b. Data b => b -> b) -> MetaValue -> MetaValue
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MetaValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MetaValue)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MetaValue)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MetaValue)
dataTypeOf :: MetaValue -> DataType
$cdataTypeOf :: MetaValue -> DataType
toConstr :: MetaValue -> Constr
$ctoConstr :: MetaValue -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MetaValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MetaValue
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MetaValue -> c MetaValue
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MetaValue -> c MetaValue
$cp1Data :: Typeable MetaValue
Data, (forall x. MetaValue -> Rep MetaValue x)
-> (forall x. Rep MetaValue x -> MetaValue) -> Generic MetaValue
forall x. Rep MetaValue x -> MetaValue
forall x. MetaValue -> Rep MetaValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaValue x -> MetaValue
$cfrom :: forall x. MetaValue -> Rep MetaValue x
Generic)
nullMeta :: Meta
nullMeta :: Meta
nullMeta = Map Text MetaValue -> Meta
Meta Map Text MetaValue
forall k a. Map k a
M.empty
isNullMeta :: Meta -> Bool
isNullMeta :: Meta -> Bool
isNullMeta (Meta Map Text MetaValue
m) = Map Text MetaValue -> Bool
forall k a. Map k a -> Bool
M.null Map Text MetaValue
m
lookupMeta :: Text -> Meta -> Maybe MetaValue
lookupMeta :: Text -> Meta -> Maybe MetaValue
lookupMeta Text
key (Meta Map Text MetaValue
m) = Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Map Text MetaValue
m
docTitle :: Meta -> [Inline]
docTitle :: Meta -> [Inline]
docTitle Meta
meta =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"title" Meta
meta of
Just (MetaString Text
s) -> [Text -> Inline
Str Text
s]
Just (MetaInlines [Inline]
ils) -> [Inline]
ils
Just (MetaBlocks [Plain [Inline]
ils]) -> [Inline]
ils
Just (MetaBlocks [Para [Inline]
ils]) -> [Inline]
ils
Maybe MetaValue
_ -> []
docAuthors :: Meta -> [[Inline]]
docAuthors :: Meta -> [[Inline]]
docAuthors Meta
meta =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"author" Meta
meta of
Just (MetaString Text
s) -> [[Text -> Inline
Str Text
s]]
Just (MetaInlines [Inline]
ils) -> [[Inline]
ils]
Just (MetaList [MetaValue]
ms) -> [[Inline]
ils | MetaInlines [Inline]
ils <- [MetaValue]
ms] [[Inline]] -> [[Inline]] -> [[Inline]]
forall a. [a] -> [a] -> [a]
++
[[Inline]
ils | MetaBlocks [Plain [Inline]
ils] <- [MetaValue]
ms] [[Inline]] -> [[Inline]] -> [[Inline]]
forall a. [a] -> [a] -> [a]
++
[[Inline]
ils | MetaBlocks [Para [Inline]
ils] <- [MetaValue]
ms] [[Inline]] -> [[Inline]] -> [[Inline]]
forall a. [a] -> [a] -> [a]
++
[[Text -> Inline
Str Text
x] | MetaString Text
x <- [MetaValue]
ms]
Maybe MetaValue
_ -> []
docDate :: Meta -> [Inline]
docDate :: Meta -> [Inline]
docDate Meta
meta =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"date" Meta
meta of
Just (MetaString Text
s) -> [Text -> Inline
Str Text
s]
Just (MetaInlines [Inline]
ils) -> [Inline]
ils
Just (MetaBlocks [Plain [Inline]
ils]) -> [Inline]
ils
Just (MetaBlocks [Para [Inline]
ils]) -> [Inline]
ils
Maybe MetaValue
_ -> []
type ListAttributes = (Int, ListNumberStyle, ListNumberDelim)
data ListNumberStyle = DefaultStyle
| Example
| Decimal
| LowerRoman
| UpperRoman
| LowerAlpha
| UpperAlpha deriving (ListNumberStyle -> ListNumberStyle -> Bool
(ListNumberStyle -> ListNumberStyle -> Bool)
-> (ListNumberStyle -> ListNumberStyle -> Bool)
-> Eq ListNumberStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListNumberStyle -> ListNumberStyle -> Bool
$c/= :: ListNumberStyle -> ListNumberStyle -> Bool
== :: ListNumberStyle -> ListNumberStyle -> Bool
$c== :: ListNumberStyle -> ListNumberStyle -> Bool
Eq, Eq ListNumberStyle
Eq ListNumberStyle
-> (ListNumberStyle -> ListNumberStyle -> Ordering)
-> (ListNumberStyle -> ListNumberStyle -> Bool)
-> (ListNumberStyle -> ListNumberStyle -> Bool)
-> (ListNumberStyle -> ListNumberStyle -> Bool)
-> (ListNumberStyle -> ListNumberStyle -> Bool)
-> (ListNumberStyle -> ListNumberStyle -> ListNumberStyle)
-> (ListNumberStyle -> ListNumberStyle -> ListNumberStyle)
-> Ord ListNumberStyle
ListNumberStyle -> ListNumberStyle -> Bool
ListNumberStyle -> ListNumberStyle -> Ordering
ListNumberStyle -> ListNumberStyle -> ListNumberStyle
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 :: ListNumberStyle -> ListNumberStyle -> ListNumberStyle
$cmin :: ListNumberStyle -> ListNumberStyle -> ListNumberStyle
max :: ListNumberStyle -> ListNumberStyle -> ListNumberStyle
$cmax :: ListNumberStyle -> ListNumberStyle -> ListNumberStyle
>= :: ListNumberStyle -> ListNumberStyle -> Bool
$c>= :: ListNumberStyle -> ListNumberStyle -> Bool
> :: ListNumberStyle -> ListNumberStyle -> Bool
$c> :: ListNumberStyle -> ListNumberStyle -> Bool
<= :: ListNumberStyle -> ListNumberStyle -> Bool
$c<= :: ListNumberStyle -> ListNumberStyle -> Bool
< :: ListNumberStyle -> ListNumberStyle -> Bool
$c< :: ListNumberStyle -> ListNumberStyle -> Bool
compare :: ListNumberStyle -> ListNumberStyle -> Ordering
$ccompare :: ListNumberStyle -> ListNumberStyle -> Ordering
$cp1Ord :: Eq ListNumberStyle
Ord, Int -> ListNumberStyle -> ShowS
[ListNumberStyle] -> ShowS
ListNumberStyle -> String
(Int -> ListNumberStyle -> ShowS)
-> (ListNumberStyle -> String)
-> ([ListNumberStyle] -> ShowS)
-> Show ListNumberStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListNumberStyle] -> ShowS
$cshowList :: [ListNumberStyle] -> ShowS
show :: ListNumberStyle -> String
$cshow :: ListNumberStyle -> String
showsPrec :: Int -> ListNumberStyle -> ShowS
$cshowsPrec :: Int -> ListNumberStyle -> ShowS
Show, ReadPrec [ListNumberStyle]
ReadPrec ListNumberStyle
Int -> ReadS ListNumberStyle
ReadS [ListNumberStyle]
(Int -> ReadS ListNumberStyle)
-> ReadS [ListNumberStyle]
-> ReadPrec ListNumberStyle
-> ReadPrec [ListNumberStyle]
-> Read ListNumberStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListNumberStyle]
$creadListPrec :: ReadPrec [ListNumberStyle]
readPrec :: ReadPrec ListNumberStyle
$creadPrec :: ReadPrec ListNumberStyle
readList :: ReadS [ListNumberStyle]
$creadList :: ReadS [ListNumberStyle]
readsPrec :: Int -> ReadS ListNumberStyle
$creadsPrec :: Int -> ReadS ListNumberStyle
Read, Typeable, Typeable ListNumberStyle
DataType
Constr
Typeable ListNumberStyle
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberStyle -> c ListNumberStyle)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberStyle)
-> (ListNumberStyle -> Constr)
-> (ListNumberStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListNumberStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListNumberStyle))
-> ((forall b. Data b => b -> b)
-> ListNumberStyle -> ListNumberStyle)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberStyle -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberStyle -> r)
-> (forall u.
(forall d. Data d => d -> u) -> ListNumberStyle -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ListNumberStyle -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle)
-> Data ListNumberStyle
ListNumberStyle -> DataType
ListNumberStyle -> Constr
(forall b. Data b => b -> b) -> ListNumberStyle -> ListNumberStyle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberStyle -> c ListNumberStyle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberStyle
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) -> ListNumberStyle -> u
forall u. (forall d. Data d => d -> u) -> ListNumberStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberStyle -> c ListNumberStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListNumberStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListNumberStyle)
$cUpperAlpha :: Constr
$cLowerAlpha :: Constr
$cUpperRoman :: Constr
$cLowerRoman :: Constr
$cDecimal :: Constr
$cExample :: Constr
$cDefaultStyle :: Constr
$tListNumberStyle :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle
gmapMp :: (forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle
gmapM :: (forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListNumberStyle -> m ListNumberStyle
gmapQi :: Int -> (forall d. Data d => d -> u) -> ListNumberStyle -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListNumberStyle -> u
gmapQ :: (forall d. Data d => d -> u) -> ListNumberStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListNumberStyle -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberStyle -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberStyle -> r
gmapT :: (forall b. Data b => b -> b) -> ListNumberStyle -> ListNumberStyle
$cgmapT :: (forall b. Data b => b -> b) -> ListNumberStyle -> ListNumberStyle
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListNumberStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListNumberStyle)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ListNumberStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListNumberStyle)
dataTypeOf :: ListNumberStyle -> DataType
$cdataTypeOf :: ListNumberStyle -> DataType
toConstr :: ListNumberStyle -> Constr
$ctoConstr :: ListNumberStyle -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberStyle
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberStyle -> c ListNumberStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberStyle -> c ListNumberStyle
$cp1Data :: Typeable ListNumberStyle
Data, (forall x. ListNumberStyle -> Rep ListNumberStyle x)
-> (forall x. Rep ListNumberStyle x -> ListNumberStyle)
-> Generic ListNumberStyle
forall x. Rep ListNumberStyle x -> ListNumberStyle
forall x. ListNumberStyle -> Rep ListNumberStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListNumberStyle x -> ListNumberStyle
$cfrom :: forall x. ListNumberStyle -> Rep ListNumberStyle x
Generic)
data ListNumberDelim = DefaultDelim
| Period
| OneParen
| TwoParens deriving (ListNumberDelim -> ListNumberDelim -> Bool
(ListNumberDelim -> ListNumberDelim -> Bool)
-> (ListNumberDelim -> ListNumberDelim -> Bool)
-> Eq ListNumberDelim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListNumberDelim -> ListNumberDelim -> Bool
$c/= :: ListNumberDelim -> ListNumberDelim -> Bool
== :: ListNumberDelim -> ListNumberDelim -> Bool
$c== :: ListNumberDelim -> ListNumberDelim -> Bool
Eq, Eq ListNumberDelim
Eq ListNumberDelim
-> (ListNumberDelim -> ListNumberDelim -> Ordering)
-> (ListNumberDelim -> ListNumberDelim -> Bool)
-> (ListNumberDelim -> ListNumberDelim -> Bool)
-> (ListNumberDelim -> ListNumberDelim -> Bool)
-> (ListNumberDelim -> ListNumberDelim -> Bool)
-> (ListNumberDelim -> ListNumberDelim -> ListNumberDelim)
-> (ListNumberDelim -> ListNumberDelim -> ListNumberDelim)
-> Ord ListNumberDelim
ListNumberDelim -> ListNumberDelim -> Bool
ListNumberDelim -> ListNumberDelim -> Ordering
ListNumberDelim -> ListNumberDelim -> ListNumberDelim
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 :: ListNumberDelim -> ListNumberDelim -> ListNumberDelim
$cmin :: ListNumberDelim -> ListNumberDelim -> ListNumberDelim
max :: ListNumberDelim -> ListNumberDelim -> ListNumberDelim
$cmax :: ListNumberDelim -> ListNumberDelim -> ListNumberDelim
>= :: ListNumberDelim -> ListNumberDelim -> Bool
$c>= :: ListNumberDelim -> ListNumberDelim -> Bool
> :: ListNumberDelim -> ListNumberDelim -> Bool
$c> :: ListNumberDelim -> ListNumberDelim -> Bool
<= :: ListNumberDelim -> ListNumberDelim -> Bool
$c<= :: ListNumberDelim -> ListNumberDelim -> Bool
< :: ListNumberDelim -> ListNumberDelim -> Bool
$c< :: ListNumberDelim -> ListNumberDelim -> Bool
compare :: ListNumberDelim -> ListNumberDelim -> Ordering
$ccompare :: ListNumberDelim -> ListNumberDelim -> Ordering
$cp1Ord :: Eq ListNumberDelim
Ord, Int -> ListNumberDelim -> ShowS
[ListNumberDelim] -> ShowS
ListNumberDelim -> String
(Int -> ListNumberDelim -> ShowS)
-> (ListNumberDelim -> String)
-> ([ListNumberDelim] -> ShowS)
-> Show ListNumberDelim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListNumberDelim] -> ShowS
$cshowList :: [ListNumberDelim] -> ShowS
show :: ListNumberDelim -> String
$cshow :: ListNumberDelim -> String
showsPrec :: Int -> ListNumberDelim -> ShowS
$cshowsPrec :: Int -> ListNumberDelim -> ShowS
Show, ReadPrec [ListNumberDelim]
ReadPrec ListNumberDelim
Int -> ReadS ListNumberDelim
ReadS [ListNumberDelim]
(Int -> ReadS ListNumberDelim)
-> ReadS [ListNumberDelim]
-> ReadPrec ListNumberDelim
-> ReadPrec [ListNumberDelim]
-> Read ListNumberDelim
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListNumberDelim]
$creadListPrec :: ReadPrec [ListNumberDelim]
readPrec :: ReadPrec ListNumberDelim
$creadPrec :: ReadPrec ListNumberDelim
readList :: ReadS [ListNumberDelim]
$creadList :: ReadS [ListNumberDelim]
readsPrec :: Int -> ReadS ListNumberDelim
$creadsPrec :: Int -> ReadS ListNumberDelim
Read, Typeable, Typeable ListNumberDelim
DataType
Constr
Typeable ListNumberDelim
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberDelim -> c ListNumberDelim)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberDelim)
-> (ListNumberDelim -> Constr)
-> (ListNumberDelim -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListNumberDelim))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListNumberDelim))
-> ((forall b. Data b => b -> b)
-> ListNumberDelim -> ListNumberDelim)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberDelim -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberDelim -> r)
-> (forall u.
(forall d. Data d => d -> u) -> ListNumberDelim -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ListNumberDelim -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim)
-> Data ListNumberDelim
ListNumberDelim -> DataType
ListNumberDelim -> Constr
(forall b. Data b => b -> b) -> ListNumberDelim -> ListNumberDelim
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberDelim -> c ListNumberDelim
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberDelim
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) -> ListNumberDelim -> u
forall u. (forall d. Data d => d -> u) -> ListNumberDelim -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberDelim -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberDelim -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberDelim
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberDelim -> c ListNumberDelim
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListNumberDelim)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListNumberDelim)
$cTwoParens :: Constr
$cOneParen :: Constr
$cPeriod :: Constr
$cDefaultDelim :: Constr
$tListNumberDelim :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim
gmapMp :: (forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim
gmapM :: (forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListNumberDelim -> m ListNumberDelim
gmapQi :: Int -> (forall d. Data d => d -> u) -> ListNumberDelim -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListNumberDelim -> u
gmapQ :: (forall d. Data d => d -> u) -> ListNumberDelim -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListNumberDelim -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberDelim -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberDelim -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberDelim -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListNumberDelim -> r
gmapT :: (forall b. Data b => b -> b) -> ListNumberDelim -> ListNumberDelim
$cgmapT :: (forall b. Data b => b -> b) -> ListNumberDelim -> ListNumberDelim
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListNumberDelim)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListNumberDelim)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ListNumberDelim)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListNumberDelim)
dataTypeOf :: ListNumberDelim -> DataType
$cdataTypeOf :: ListNumberDelim -> DataType
toConstr :: ListNumberDelim -> Constr
$ctoConstr :: ListNumberDelim -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberDelim
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListNumberDelim
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberDelim -> c ListNumberDelim
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListNumberDelim -> c ListNumberDelim
$cp1Data :: Typeable ListNumberDelim
Data, (forall x. ListNumberDelim -> Rep ListNumberDelim x)
-> (forall x. Rep ListNumberDelim x -> ListNumberDelim)
-> Generic ListNumberDelim
forall x. Rep ListNumberDelim x -> ListNumberDelim
forall x. ListNumberDelim -> Rep ListNumberDelim x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListNumberDelim x -> ListNumberDelim
$cfrom :: forall x. ListNumberDelim -> Rep ListNumberDelim x
Generic)
type Attr = (Text, [Text], [(Text, Text)])
nullAttr :: Attr
nullAttr :: Attr
nullAttr = (Text
"",[],[])
newtype Format = Format Text
deriving (ReadPrec [Format]
ReadPrec Format
Int -> ReadS Format
ReadS [Format]
(Int -> ReadS Format)
-> ReadS [Format]
-> ReadPrec Format
-> ReadPrec [Format]
-> Read Format
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Format]
$creadListPrec :: ReadPrec [Format]
readPrec :: ReadPrec Format
$creadPrec :: ReadPrec Format
readList :: ReadS [Format]
$creadList :: ReadS [Format]
readsPrec :: Int -> ReadS Format
$creadsPrec :: Int -> ReadS Format
Read, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, Typeable, Typeable Format
DataType
Constr
Typeable Format
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format)
-> (Format -> Constr)
-> (Format -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format))
-> ((forall b. Data b => b -> b) -> Format -> Format)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Format -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Format -> r)
-> (forall u. (forall d. Data d => d -> u) -> Format -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Format -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format)
-> Data Format
Format -> DataType
Format -> Constr
(forall b. Data b => b -> b) -> Format -> Format
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
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) -> Format -> u
forall u. (forall d. Data d => d -> u) -> Format -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
$cFormat :: Constr
$tFormat :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Format -> m Format
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapMp :: (forall d. Data d => d -> m d) -> Format -> m Format
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapM :: (forall d. Data d => d -> m d) -> Format -> m Format
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapQi :: Int -> (forall d. Data d => d -> u) -> Format -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Format -> u
gmapQ :: (forall d. Data d => d -> u) -> Format -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Format -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
gmapT :: (forall b. Data b => b -> b) -> Format -> Format
$cgmapT :: (forall b. Data b => b -> b) -> Format -> Format
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Format)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format)
dataTypeOf :: Format -> DataType
$cdataTypeOf :: Format -> DataType
toConstr :: Format -> Constr
$ctoConstr :: Format -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
$cp1Data :: Typeable Format
Data, (forall x. Format -> Rep Format x)
-> (forall x. Rep Format x -> Format) -> Generic Format
forall x. Rep Format x -> Format
forall x. Format -> Rep Format x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Format x -> Format
$cfrom :: forall x. Format -> Rep Format x
Generic, [Format] -> Encoding
[Format] -> Value
Format -> Encoding
Format -> Value
(Format -> Value)
-> (Format -> Encoding)
-> ([Format] -> Value)
-> ([Format] -> Encoding)
-> ToJSON Format
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Format] -> Encoding
$ctoEncodingList :: [Format] -> Encoding
toJSONList :: [Format] -> Value
$ctoJSONList :: [Format] -> Value
toEncoding :: Format -> Encoding
$ctoEncoding :: Format -> Encoding
toJSON :: Format -> Value
$ctoJSON :: Format -> Value
ToJSON, Value -> Parser [Format]
Value -> Parser Format
(Value -> Parser Format)
-> (Value -> Parser [Format]) -> FromJSON Format
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Format]
$cparseJSONList :: Value -> Parser [Format]
parseJSON :: Value -> Parser Format
$cparseJSON :: Value -> Parser Format
FromJSON)
instance IsString Format where
fromString :: String -> Format
fromString String
f = Text -> Format
Format (Text -> Format) -> Text -> Format
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toCaseFold (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
f
instance Eq Format where
Format Text
x == :: Format -> Format -> Bool
== Format Text
y = Text -> Text
T.toCaseFold Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold Text
y
instance Ord Format where
compare :: Format -> Format -> Ordering
compare (Format Text
x) (Format Text
y) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text
T.toCaseFold Text
x) (Text -> Text
T.toCaseFold Text
y)
newtype RowHeadColumns = RowHeadColumns Int
deriving (RowHeadColumns -> RowHeadColumns -> Bool
(RowHeadColumns -> RowHeadColumns -> Bool)
-> (RowHeadColumns -> RowHeadColumns -> Bool) -> Eq RowHeadColumns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowHeadColumns -> RowHeadColumns -> Bool
$c/= :: RowHeadColumns -> RowHeadColumns -> Bool
== :: RowHeadColumns -> RowHeadColumns -> Bool
$c== :: RowHeadColumns -> RowHeadColumns -> Bool
Eq, Eq RowHeadColumns
Eq RowHeadColumns
-> (RowHeadColumns -> RowHeadColumns -> Ordering)
-> (RowHeadColumns -> RowHeadColumns -> Bool)
-> (RowHeadColumns -> RowHeadColumns -> Bool)
-> (RowHeadColumns -> RowHeadColumns -> Bool)
-> (RowHeadColumns -> RowHeadColumns -> Bool)
-> (RowHeadColumns -> RowHeadColumns -> RowHeadColumns)
-> (RowHeadColumns -> RowHeadColumns -> RowHeadColumns)
-> Ord RowHeadColumns
RowHeadColumns -> RowHeadColumns -> Bool
RowHeadColumns -> RowHeadColumns -> Ordering
RowHeadColumns -> RowHeadColumns -> RowHeadColumns
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 :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
$cmin :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
max :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
$cmax :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
>= :: RowHeadColumns -> RowHeadColumns -> Bool
$c>= :: RowHeadColumns -> RowHeadColumns -> Bool
> :: RowHeadColumns -> RowHeadColumns -> Bool
$c> :: RowHeadColumns -> RowHeadColumns -> Bool
<= :: RowHeadColumns -> RowHeadColumns -> Bool
$c<= :: RowHeadColumns -> RowHeadColumns -> Bool
< :: RowHeadColumns -> RowHeadColumns -> Bool
$c< :: RowHeadColumns -> RowHeadColumns -> Bool
compare :: RowHeadColumns -> RowHeadColumns -> Ordering
$ccompare :: RowHeadColumns -> RowHeadColumns -> Ordering
$cp1Ord :: Eq RowHeadColumns
Ord, Int -> RowHeadColumns -> ShowS
[RowHeadColumns] -> ShowS
RowHeadColumns -> String
(Int -> RowHeadColumns -> ShowS)
-> (RowHeadColumns -> String)
-> ([RowHeadColumns] -> ShowS)
-> Show RowHeadColumns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowHeadColumns] -> ShowS
$cshowList :: [RowHeadColumns] -> ShowS
show :: RowHeadColumns -> String
$cshow :: RowHeadColumns -> String
showsPrec :: Int -> RowHeadColumns -> ShowS
$cshowsPrec :: Int -> RowHeadColumns -> ShowS
Show, ReadPrec [RowHeadColumns]
ReadPrec RowHeadColumns
Int -> ReadS RowHeadColumns
ReadS [RowHeadColumns]
(Int -> ReadS RowHeadColumns)
-> ReadS [RowHeadColumns]
-> ReadPrec RowHeadColumns
-> ReadPrec [RowHeadColumns]
-> Read RowHeadColumns
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RowHeadColumns]
$creadListPrec :: ReadPrec [RowHeadColumns]
readPrec :: ReadPrec RowHeadColumns
$creadPrec :: ReadPrec RowHeadColumns
readList :: ReadS [RowHeadColumns]
$creadList :: ReadS [RowHeadColumns]
readsPrec :: Int -> ReadS RowHeadColumns
$creadsPrec :: Int -> ReadS RowHeadColumns
Read, Typeable, Typeable RowHeadColumns
DataType
Constr
Typeable RowHeadColumns
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowHeadColumns -> c RowHeadColumns)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowHeadColumns)
-> (RowHeadColumns -> Constr)
-> (RowHeadColumns -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowHeadColumns))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RowHeadColumns))
-> ((forall b. Data b => b -> b)
-> RowHeadColumns -> RowHeadColumns)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowHeadColumns -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowHeadColumns -> r)
-> (forall u.
(forall d. Data d => d -> u) -> RowHeadColumns -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RowHeadColumns -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns)
-> Data RowHeadColumns
RowHeadColumns -> DataType
RowHeadColumns -> Constr
(forall b. Data b => b -> b) -> RowHeadColumns -> RowHeadColumns
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowHeadColumns -> c RowHeadColumns
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowHeadColumns
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) -> RowHeadColumns -> u
forall u. (forall d. Data d => d -> u) -> RowHeadColumns -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowHeadColumns -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowHeadColumns -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowHeadColumns
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowHeadColumns -> c RowHeadColumns
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowHeadColumns)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RowHeadColumns)
$cRowHeadColumns :: Constr
$tRowHeadColumns :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns
gmapMp :: (forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns
gmapM :: (forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RowHeadColumns -> m RowHeadColumns
gmapQi :: Int -> (forall d. Data d => d -> u) -> RowHeadColumns -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RowHeadColumns -> u
gmapQ :: (forall d. Data d => d -> u) -> RowHeadColumns -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RowHeadColumns -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowHeadColumns -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowHeadColumns -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowHeadColumns -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowHeadColumns -> r
gmapT :: (forall b. Data b => b -> b) -> RowHeadColumns -> RowHeadColumns
$cgmapT :: (forall b. Data b => b -> b) -> RowHeadColumns -> RowHeadColumns
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RowHeadColumns)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RowHeadColumns)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RowHeadColumns)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowHeadColumns)
dataTypeOf :: RowHeadColumns -> DataType
$cdataTypeOf :: RowHeadColumns -> DataType
toConstr :: RowHeadColumns -> Constr
$ctoConstr :: RowHeadColumns -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowHeadColumns
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowHeadColumns
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowHeadColumns -> c RowHeadColumns
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowHeadColumns -> c RowHeadColumns
$cp1Data :: Typeable RowHeadColumns
Data, (forall x. RowHeadColumns -> Rep RowHeadColumns x)
-> (forall x. Rep RowHeadColumns x -> RowHeadColumns)
-> Generic RowHeadColumns
forall x. Rep RowHeadColumns x -> RowHeadColumns
forall x. RowHeadColumns -> Rep RowHeadColumns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RowHeadColumns x -> RowHeadColumns
$cfrom :: forall x. RowHeadColumns -> Rep RowHeadColumns x
Generic, Integer -> RowHeadColumns
RowHeadColumns -> RowHeadColumns
RowHeadColumns -> RowHeadColumns -> RowHeadColumns
(RowHeadColumns -> RowHeadColumns -> RowHeadColumns)
-> (RowHeadColumns -> RowHeadColumns -> RowHeadColumns)
-> (RowHeadColumns -> RowHeadColumns -> RowHeadColumns)
-> (RowHeadColumns -> RowHeadColumns)
-> (RowHeadColumns -> RowHeadColumns)
-> (RowHeadColumns -> RowHeadColumns)
-> (Integer -> RowHeadColumns)
-> Num RowHeadColumns
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> RowHeadColumns
$cfromInteger :: Integer -> RowHeadColumns
signum :: RowHeadColumns -> RowHeadColumns
$csignum :: RowHeadColumns -> RowHeadColumns
abs :: RowHeadColumns -> RowHeadColumns
$cabs :: RowHeadColumns -> RowHeadColumns
negate :: RowHeadColumns -> RowHeadColumns
$cnegate :: RowHeadColumns -> RowHeadColumns
* :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
$c* :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
- :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
$c- :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
+ :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
$c+ :: RowHeadColumns -> RowHeadColumns -> RowHeadColumns
Num, Int -> RowHeadColumns
RowHeadColumns -> Int
RowHeadColumns -> [RowHeadColumns]
RowHeadColumns -> RowHeadColumns
RowHeadColumns -> RowHeadColumns -> [RowHeadColumns]
RowHeadColumns
-> RowHeadColumns -> RowHeadColumns -> [RowHeadColumns]
(RowHeadColumns -> RowHeadColumns)
-> (RowHeadColumns -> RowHeadColumns)
-> (Int -> RowHeadColumns)
-> (RowHeadColumns -> Int)
-> (RowHeadColumns -> [RowHeadColumns])
-> (RowHeadColumns -> RowHeadColumns -> [RowHeadColumns])
-> (RowHeadColumns -> RowHeadColumns -> [RowHeadColumns])
-> (RowHeadColumns
-> RowHeadColumns -> RowHeadColumns -> [RowHeadColumns])
-> Enum RowHeadColumns
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 :: RowHeadColumns
-> RowHeadColumns -> RowHeadColumns -> [RowHeadColumns]
$cenumFromThenTo :: RowHeadColumns
-> RowHeadColumns -> RowHeadColumns -> [RowHeadColumns]
enumFromTo :: RowHeadColumns -> RowHeadColumns -> [RowHeadColumns]
$cenumFromTo :: RowHeadColumns -> RowHeadColumns -> [RowHeadColumns]
enumFromThen :: RowHeadColumns -> RowHeadColumns -> [RowHeadColumns]
$cenumFromThen :: RowHeadColumns -> RowHeadColumns -> [RowHeadColumns]
enumFrom :: RowHeadColumns -> [RowHeadColumns]
$cenumFrom :: RowHeadColumns -> [RowHeadColumns]
fromEnum :: RowHeadColumns -> Int
$cfromEnum :: RowHeadColumns -> Int
toEnum :: Int -> RowHeadColumns
$ctoEnum :: Int -> RowHeadColumns
pred :: RowHeadColumns -> RowHeadColumns
$cpred :: RowHeadColumns -> RowHeadColumns
succ :: RowHeadColumns -> RowHeadColumns
$csucc :: RowHeadColumns -> RowHeadColumns
Enum)
data Alignment = AlignLeft
| AlignRight
| AlignCenter
| AlignDefault deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Eq Alignment
-> (Alignment -> Alignment -> Ordering)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> Ord Alignment
Alignment -> Alignment -> Bool
Alignment -> Alignment -> Ordering
Alignment -> Alignment -> Alignment
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 :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmax :: Alignment -> Alignment -> Alignment
>= :: Alignment -> Alignment -> Bool
$c>= :: Alignment -> Alignment -> Bool
> :: Alignment -> Alignment -> Bool
$c> :: Alignment -> Alignment -> Bool
<= :: Alignment -> Alignment -> Bool
$c<= :: Alignment -> Alignment -> Bool
< :: Alignment -> Alignment -> Bool
$c< :: Alignment -> Alignment -> Bool
compare :: Alignment -> Alignment -> Ordering
$ccompare :: Alignment -> Alignment -> Ordering
$cp1Ord :: Eq Alignment
Ord, Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show, ReadPrec [Alignment]
ReadPrec Alignment
Int -> ReadS Alignment
ReadS [Alignment]
(Int -> ReadS Alignment)
-> ReadS [Alignment]
-> ReadPrec Alignment
-> ReadPrec [Alignment]
-> Read Alignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Alignment]
$creadListPrec :: ReadPrec [Alignment]
readPrec :: ReadPrec Alignment
$creadPrec :: ReadPrec Alignment
readList :: ReadS [Alignment]
$creadList :: ReadS [Alignment]
readsPrec :: Int -> ReadS Alignment
$creadsPrec :: Int -> ReadS Alignment
Read, Typeable, Typeable Alignment
DataType
Constr
Typeable Alignment
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alignment -> c Alignment)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alignment)
-> (Alignment -> Constr)
-> (Alignment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Alignment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Alignment))
-> ((forall b. Data b => b -> b) -> Alignment -> Alignment)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Alignment -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Alignment -> r)
-> (forall u. (forall d. Data d => d -> u) -> Alignment -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Alignment -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Alignment -> m Alignment)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alignment -> m Alignment)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alignment -> m Alignment)
-> Data Alignment
Alignment -> DataType
Alignment -> Constr
(forall b. Data b => b -> b) -> Alignment -> Alignment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alignment -> c Alignment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alignment
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) -> Alignment -> u
forall u. (forall d. Data d => d -> u) -> Alignment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Alignment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Alignment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Alignment -> m Alignment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alignment -> m Alignment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alignment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alignment -> c Alignment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Alignment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Alignment)
$cAlignDefault :: Constr
$cAlignCenter :: Constr
$cAlignRight :: Constr
$cAlignLeft :: Constr
$tAlignment :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Alignment -> m Alignment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alignment -> m Alignment
gmapMp :: (forall d. Data d => d -> m d) -> Alignment -> m Alignment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alignment -> m Alignment
gmapM :: (forall d. Data d => d -> m d) -> Alignment -> m Alignment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Alignment -> m Alignment
gmapQi :: Int -> (forall d. Data d => d -> u) -> Alignment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Alignment -> u
gmapQ :: (forall d. Data d => d -> u) -> Alignment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Alignment -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Alignment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Alignment -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Alignment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Alignment -> r
gmapT :: (forall b. Data b => b -> b) -> Alignment -> Alignment
$cgmapT :: (forall b. Data b => b -> b) -> Alignment -> Alignment
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Alignment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Alignment)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Alignment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Alignment)
dataTypeOf :: Alignment -> DataType
$cdataTypeOf :: Alignment -> DataType
toConstr :: Alignment -> Constr
$ctoConstr :: Alignment -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alignment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alignment
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alignment -> c Alignment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alignment -> c Alignment
$cp1Data :: Typeable Alignment
Data, (forall x. Alignment -> Rep Alignment x)
-> (forall x. Rep Alignment x -> Alignment) -> Generic Alignment
forall x. Rep Alignment x -> Alignment
forall x. Alignment -> Rep Alignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Alignment x -> Alignment
$cfrom :: forall x. Alignment -> Rep Alignment x
Generic)
data ColWidth = ColWidth Double
| ColWidthDefault deriving (ColWidth -> ColWidth -> Bool
(ColWidth -> ColWidth -> Bool)
-> (ColWidth -> ColWidth -> Bool) -> Eq ColWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColWidth -> ColWidth -> Bool
$c/= :: ColWidth -> ColWidth -> Bool
== :: ColWidth -> ColWidth -> Bool
$c== :: ColWidth -> ColWidth -> Bool
Eq, Eq ColWidth
Eq ColWidth
-> (ColWidth -> ColWidth -> Ordering)
-> (ColWidth -> ColWidth -> Bool)
-> (ColWidth -> ColWidth -> Bool)
-> (ColWidth -> ColWidth -> Bool)
-> (ColWidth -> ColWidth -> Bool)
-> (ColWidth -> ColWidth -> ColWidth)
-> (ColWidth -> ColWidth -> ColWidth)
-> Ord ColWidth
ColWidth -> ColWidth -> Bool
ColWidth -> ColWidth -> Ordering
ColWidth -> ColWidth -> ColWidth
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 :: ColWidth -> ColWidth -> ColWidth
$cmin :: ColWidth -> ColWidth -> ColWidth
max :: ColWidth -> ColWidth -> ColWidth
$cmax :: ColWidth -> ColWidth -> ColWidth
>= :: ColWidth -> ColWidth -> Bool
$c>= :: ColWidth -> ColWidth -> Bool
> :: ColWidth -> ColWidth -> Bool
$c> :: ColWidth -> ColWidth -> Bool
<= :: ColWidth -> ColWidth -> Bool
$c<= :: ColWidth -> ColWidth -> Bool
< :: ColWidth -> ColWidth -> Bool
$c< :: ColWidth -> ColWidth -> Bool
compare :: ColWidth -> ColWidth -> Ordering
$ccompare :: ColWidth -> ColWidth -> Ordering
$cp1Ord :: Eq ColWidth
Ord, Int -> ColWidth -> ShowS
[ColWidth] -> ShowS
ColWidth -> String
(Int -> ColWidth -> ShowS)
-> (ColWidth -> String) -> ([ColWidth] -> ShowS) -> Show ColWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColWidth] -> ShowS
$cshowList :: [ColWidth] -> ShowS
show :: ColWidth -> String
$cshow :: ColWidth -> String
showsPrec :: Int -> ColWidth -> ShowS
$cshowsPrec :: Int -> ColWidth -> ShowS
Show, ReadPrec [ColWidth]
ReadPrec ColWidth
Int -> ReadS ColWidth
ReadS [ColWidth]
(Int -> ReadS ColWidth)
-> ReadS [ColWidth]
-> ReadPrec ColWidth
-> ReadPrec [ColWidth]
-> Read ColWidth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColWidth]
$creadListPrec :: ReadPrec [ColWidth]
readPrec :: ReadPrec ColWidth
$creadPrec :: ReadPrec ColWidth
readList :: ReadS [ColWidth]
$creadList :: ReadS [ColWidth]
readsPrec :: Int -> ReadS ColWidth
$creadsPrec :: Int -> ReadS ColWidth
Read, Typeable, Typeable ColWidth
DataType
Constr
Typeable ColWidth
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColWidth -> c ColWidth)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColWidth)
-> (ColWidth -> Constr)
-> (ColWidth -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColWidth))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColWidth))
-> ((forall b. Data b => b -> b) -> ColWidth -> ColWidth)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColWidth -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColWidth -> r)
-> (forall u. (forall d. Data d => d -> u) -> ColWidth -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ColWidth -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColWidth -> m ColWidth)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColWidth -> m ColWidth)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColWidth -> m ColWidth)
-> Data ColWidth
ColWidth -> DataType
ColWidth -> Constr
(forall b. Data b => b -> b) -> ColWidth -> ColWidth
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColWidth -> c ColWidth
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColWidth
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) -> ColWidth -> u
forall u. (forall d. Data d => d -> u) -> ColWidth -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColWidth -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColWidth -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColWidth -> m ColWidth
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColWidth -> m ColWidth
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColWidth
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColWidth -> c ColWidth
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColWidth)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColWidth)
$cColWidthDefault :: Constr
$cColWidth :: Constr
$tColWidth :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ColWidth -> m ColWidth
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColWidth -> m ColWidth
gmapMp :: (forall d. Data d => d -> m d) -> ColWidth -> m ColWidth
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColWidth -> m ColWidth
gmapM :: (forall d. Data d => d -> m d) -> ColWidth -> m ColWidth
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColWidth -> m ColWidth
gmapQi :: Int -> (forall d. Data d => d -> u) -> ColWidth -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColWidth -> u
gmapQ :: (forall d. Data d => d -> u) -> ColWidth -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColWidth -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColWidth -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColWidth -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColWidth -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColWidth -> r
gmapT :: (forall b. Data b => b -> b) -> ColWidth -> ColWidth
$cgmapT :: (forall b. Data b => b -> b) -> ColWidth -> ColWidth
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColWidth)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColWidth)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ColWidth)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColWidth)
dataTypeOf :: ColWidth -> DataType
$cdataTypeOf :: ColWidth -> DataType
toConstr :: ColWidth -> Constr
$ctoConstr :: ColWidth -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColWidth
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColWidth
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColWidth -> c ColWidth
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColWidth -> c ColWidth
$cp1Data :: Typeable ColWidth
Data, (forall x. ColWidth -> Rep ColWidth x)
-> (forall x. Rep ColWidth x -> ColWidth) -> Generic ColWidth
forall x. Rep ColWidth x -> ColWidth
forall x. ColWidth -> Rep ColWidth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColWidth x -> ColWidth
$cfrom :: forall x. ColWidth -> Rep ColWidth x
Generic)
type ColSpec = (Alignment, ColWidth)
data Row = Row Attr [Cell]
deriving (Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, Eq Row
Eq Row
-> (Row -> Row -> Ordering)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Row)
-> (Row -> Row -> Row)
-> Ord Row
Row -> Row -> Bool
Row -> Row -> Ordering
Row -> Row -> Row
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 :: Row -> Row -> Row
$cmin :: Row -> Row -> Row
max :: Row -> Row -> Row
$cmax :: Row -> Row -> Row
>= :: Row -> Row -> Bool
$c>= :: Row -> Row -> Bool
> :: Row -> Row -> Bool
$c> :: Row -> Row -> Bool
<= :: Row -> Row -> Bool
$c<= :: Row -> Row -> Bool
< :: Row -> Row -> Bool
$c< :: Row -> Row -> Bool
compare :: Row -> Row -> Ordering
$ccompare :: Row -> Row -> Ordering
$cp1Ord :: Eq Row
Ord, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
(Int -> Row -> ShowS)
-> (Row -> String) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show, ReadPrec [Row]
ReadPrec Row
Int -> ReadS Row
ReadS [Row]
(Int -> ReadS Row)
-> ReadS [Row] -> ReadPrec Row -> ReadPrec [Row] -> Read Row
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Row]
$creadListPrec :: ReadPrec [Row]
readPrec :: ReadPrec Row
$creadPrec :: ReadPrec Row
readList :: ReadS [Row]
$creadList :: ReadS [Row]
readsPrec :: Int -> ReadS Row
$creadsPrec :: Int -> ReadS Row
Read, Typeable, Typeable Row
DataType
Constr
Typeable Row
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row -> c Row)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Row)
-> (Row -> Constr)
-> (Row -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Row))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Row))
-> ((forall b. Data b => b -> b) -> Row -> Row)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row -> r)
-> (forall u. (forall d. Data d => d -> u) -> Row -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Row -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Row -> m Row)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row -> m Row)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row -> m Row)
-> Data Row
Row -> DataType
Row -> Constr
(forall b. Data b => b -> b) -> Row -> Row
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row -> c Row
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Row
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) -> Row -> u
forall u. (forall d. Data d => d -> u) -> Row -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Row -> m Row
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row -> m Row
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Row
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row -> c Row
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Row)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Row)
$cRow :: Constr
$tRow :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Row -> m Row
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row -> m Row
gmapMp :: (forall d. Data d => d -> m d) -> Row -> m Row
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row -> m Row
gmapM :: (forall d. Data d => d -> m d) -> Row -> m Row
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Row -> m Row
gmapQi :: Int -> (forall d. Data d => d -> u) -> Row -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Row -> u
gmapQ :: (forall d. Data d => d -> u) -> Row -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Row -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row -> r
gmapT :: (forall b. Data b => b -> b) -> Row -> Row
$cgmapT :: (forall b. Data b => b -> b) -> Row -> Row
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Row)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Row)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Row)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Row)
dataTypeOf :: Row -> DataType
$cdataTypeOf :: Row -> DataType
toConstr :: Row -> Constr
$ctoConstr :: Row -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Row
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Row
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row -> c Row
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row -> c Row
$cp1Data :: Typeable Row
Data, (forall x. Row -> Rep Row x)
-> (forall x. Rep Row x -> Row) -> Generic Row
forall x. Rep Row x -> Row
forall x. Row -> Rep Row x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Row x -> Row
$cfrom :: forall x. Row -> Rep Row x
Generic)
data TableHead = TableHead Attr [Row]
deriving (TableHead -> TableHead -> Bool
(TableHead -> TableHead -> Bool)
-> (TableHead -> TableHead -> Bool) -> Eq TableHead
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
Eq TableHead
-> (TableHead -> TableHead -> Ordering)
-> (TableHead -> TableHead -> Bool)
-> (TableHead -> TableHead -> Bool)
-> (TableHead -> TableHead -> Bool)
-> (TableHead -> TableHead -> Bool)
-> (TableHead -> TableHead -> TableHead)
-> (TableHead -> TableHead -> TableHead)
-> Ord 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
$cp1Ord :: Eq TableHead
Ord, Int -> TableHead -> ShowS
[TableHead] -> ShowS
TableHead -> String
(Int -> TableHead -> ShowS)
-> (TableHead -> String)
-> ([TableHead] -> ShowS)
-> Show TableHead
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, ReadPrec [TableHead]
ReadPrec TableHead
Int -> ReadS TableHead
ReadS [TableHead]
(Int -> ReadS TableHead)
-> ReadS [TableHead]
-> ReadPrec TableHead
-> ReadPrec [TableHead]
-> Read 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, Typeable, Typeable TableHead
DataType
Constr
Typeable TableHead
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableHead -> c TableHead)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableHead)
-> (TableHead -> Constr)
-> (TableHead -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> TableHead -> TableHead)
-> (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 u. (forall d. Data d => d -> u) -> TableHead -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> TableHead -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableHead -> m TableHead)
-> Data TableHead
TableHead -> DataType
TableHead -> Constr
(forall b. Data b => b -> b) -> TableHead -> TableHead
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableHead -> c TableHead
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cTableHead :: Constr
$tTableHead :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> TableHead -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableHead -> u
gmapQ :: (forall d. Data d => d -> u) -> TableHead -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableHead -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable TableHead
Data, (forall x. TableHead -> Rep TableHead x)
-> (forall x. Rep TableHead x -> TableHead) -> Generic TableHead
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)
data TableBody = TableBody Attr RowHeadColumns [Row] [Row]
deriving (TableBody -> TableBody -> Bool
(TableBody -> TableBody -> Bool)
-> (TableBody -> TableBody -> Bool) -> Eq TableBody
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
Eq TableBody
-> (TableBody -> TableBody -> Ordering)
-> (TableBody -> TableBody -> Bool)
-> (TableBody -> TableBody -> Bool)
-> (TableBody -> TableBody -> Bool)
-> (TableBody -> TableBody -> Bool)
-> (TableBody -> TableBody -> TableBody)
-> (TableBody -> TableBody -> TableBody)
-> Ord 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
$cp1Ord :: Eq TableBody
Ord, Int -> TableBody -> ShowS
[TableBody] -> ShowS
TableBody -> String
(Int -> TableBody -> ShowS)
-> (TableBody -> String)
-> ([TableBody] -> ShowS)
-> Show TableBody
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, ReadPrec [TableBody]
ReadPrec TableBody
Int -> ReadS TableBody
ReadS [TableBody]
(Int -> ReadS TableBody)
-> ReadS [TableBody]
-> ReadPrec TableBody
-> ReadPrec [TableBody]
-> Read 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, Typeable, Typeable TableBody
DataType
Constr
Typeable TableBody
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableBody -> c TableBody)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableBody)
-> (TableBody -> Constr)
-> (TableBody -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> TableBody -> TableBody)
-> (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 u. (forall d. Data d => d -> u) -> TableBody -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> TableBody -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableBody -> m TableBody)
-> Data TableBody
TableBody -> DataType
TableBody -> Constr
(forall b. Data b => b -> b) -> TableBody -> TableBody
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableBody -> c TableBody
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cTableBody :: Constr
$tTableBody :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> TableBody -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableBody -> u
gmapQ :: (forall d. Data d => d -> u) -> TableBody -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableBody -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable TableBody
Data, (forall x. TableBody -> Rep TableBody x)
-> (forall x. Rep TableBody x -> TableBody) -> Generic TableBody
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)
data = Attr [Row]
deriving (TableFoot -> TableFoot -> Bool
(TableFoot -> TableFoot -> Bool)
-> (TableFoot -> TableFoot -> Bool) -> Eq TableFoot
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
Eq TableFoot
-> (TableFoot -> TableFoot -> Ordering)
-> (TableFoot -> TableFoot -> Bool)
-> (TableFoot -> TableFoot -> Bool)
-> (TableFoot -> TableFoot -> Bool)
-> (TableFoot -> TableFoot -> Bool)
-> (TableFoot -> TableFoot -> TableFoot)
-> (TableFoot -> TableFoot -> TableFoot)
-> Ord 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
$cp1Ord :: Eq TableFoot
Ord, Int -> TableFoot -> ShowS
[TableFoot] -> ShowS
TableFoot -> String
(Int -> TableFoot -> ShowS)
-> (TableFoot -> String)
-> ([TableFoot] -> ShowS)
-> Show TableFoot
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, ReadPrec [TableFoot]
ReadPrec TableFoot
Int -> ReadS TableFoot
ReadS [TableFoot]
(Int -> ReadS TableFoot)
-> ReadS [TableFoot]
-> ReadPrec TableFoot
-> ReadPrec [TableFoot]
-> Read 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, Typeable, , (forall x. TableFoot -> Rep TableFoot x)
-> (forall x. Rep TableFoot x -> TableFoot) -> Generic TableFoot
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)
type ShortCaption = [Inline]
data Caption = Caption (Maybe ShortCaption) [Block]
deriving (Caption -> Caption -> Bool
(Caption -> Caption -> Bool)
-> (Caption -> Caption -> Bool) -> Eq Caption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Caption -> Caption -> Bool
$c/= :: Caption -> Caption -> Bool
== :: Caption -> Caption -> Bool
$c== :: Caption -> Caption -> Bool
Eq, Eq Caption
Eq Caption
-> (Caption -> Caption -> Ordering)
-> (Caption -> Caption -> Bool)
-> (Caption -> Caption -> Bool)
-> (Caption -> Caption -> Bool)
-> (Caption -> Caption -> Bool)
-> (Caption -> Caption -> Caption)
-> (Caption -> Caption -> Caption)
-> Ord Caption
Caption -> Caption -> Bool
Caption -> Caption -> Ordering
Caption -> Caption -> Caption
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 :: Caption -> Caption -> Caption
$cmin :: Caption -> Caption -> Caption
max :: Caption -> Caption -> Caption
$cmax :: Caption -> Caption -> Caption
>= :: Caption -> Caption -> Bool
$c>= :: Caption -> Caption -> Bool
> :: Caption -> Caption -> Bool
$c> :: Caption -> Caption -> Bool
<= :: Caption -> Caption -> Bool
$c<= :: Caption -> Caption -> Bool
< :: Caption -> Caption -> Bool
$c< :: Caption -> Caption -> Bool
compare :: Caption -> Caption -> Ordering
$ccompare :: Caption -> Caption -> Ordering
$cp1Ord :: Eq Caption
Ord, Int -> Caption -> ShowS
[Caption] -> ShowS
Caption -> String
(Int -> Caption -> ShowS)
-> (Caption -> String) -> ([Caption] -> ShowS) -> Show Caption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Caption] -> ShowS
$cshowList :: [Caption] -> ShowS
show :: Caption -> String
$cshow :: Caption -> String
showsPrec :: Int -> Caption -> ShowS
$cshowsPrec :: Int -> Caption -> ShowS
Show, ReadPrec [Caption]
ReadPrec Caption
Int -> ReadS Caption
ReadS [Caption]
(Int -> ReadS Caption)
-> ReadS [Caption]
-> ReadPrec Caption
-> ReadPrec [Caption]
-> Read Caption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Caption]
$creadListPrec :: ReadPrec [Caption]
readPrec :: ReadPrec Caption
$creadPrec :: ReadPrec Caption
readList :: ReadS [Caption]
$creadList :: ReadS [Caption]
readsPrec :: Int -> ReadS Caption
$creadsPrec :: Int -> ReadS Caption
Read, Typeable, Typeable Caption
DataType
Constr
Typeable Caption
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caption -> c Caption)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caption)
-> (Caption -> Constr)
-> (Caption -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Caption))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caption))
-> ((forall b. Data b => b -> b) -> Caption -> Caption)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Caption -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Caption -> r)
-> (forall u. (forall d. Data d => d -> u) -> Caption -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Caption -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Caption -> m Caption)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caption -> m Caption)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caption -> m Caption)
-> Data Caption
Caption -> DataType
Caption -> Constr
(forall b. Data b => b -> b) -> Caption -> Caption
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caption -> c Caption
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caption
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) -> Caption -> u
forall u. (forall d. Data d => d -> u) -> Caption -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Caption -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Caption -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Caption -> m Caption
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caption -> m Caption
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caption
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caption -> c Caption
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Caption)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caption)
$cCaption :: Constr
$tCaption :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Caption -> m Caption
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caption -> m Caption
gmapMp :: (forall d. Data d => d -> m d) -> Caption -> m Caption
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caption -> m Caption
gmapM :: (forall d. Data d => d -> m d) -> Caption -> m Caption
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Caption -> m Caption
gmapQi :: Int -> (forall d. Data d => d -> u) -> Caption -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Caption -> u
gmapQ :: (forall d. Data d => d -> u) -> Caption -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Caption -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Caption -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Caption -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Caption -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Caption -> r
gmapT :: (forall b. Data b => b -> b) -> Caption -> Caption
$cgmapT :: (forall b. Data b => b -> b) -> Caption -> Caption
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caption)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caption)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Caption)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Caption)
dataTypeOf :: Caption -> DataType
$cdataTypeOf :: Caption -> DataType
toConstr :: Caption -> Constr
$ctoConstr :: Caption -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caption
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caption
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caption -> c Caption
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caption -> c Caption
$cp1Data :: Typeable Caption
Data, (forall x. Caption -> Rep Caption x)
-> (forall x. Rep Caption x -> Caption) -> Generic Caption
forall x. Rep Caption x -> Caption
forall x. Caption -> Rep Caption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Caption x -> Caption
$cfrom :: forall x. Caption -> Rep Caption x
Generic)
data Cell = Cell Attr Alignment RowSpan ColSpan [Block]
deriving (Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
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
Eq Cell
-> (Cell -> Cell -> Ordering)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Cell)
-> (Cell -> Cell -> Cell)
-> Ord 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
$cp1Ord :: Eq Cell
Ord, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
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, ReadPrec [Cell]
ReadPrec Cell
Int -> ReadS Cell
ReadS [Cell]
(Int -> ReadS Cell)
-> ReadS [Cell] -> ReadPrec Cell -> ReadPrec [Cell] -> Read 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, Typeable, Typeable Cell
DataType
Constr
Typeable Cell
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cell -> c Cell)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cell)
-> (Cell -> Constr)
-> (Cell -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Cell -> Cell)
-> (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 u. (forall d. Data d => d -> u) -> Cell -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Cell -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cell -> m Cell)
-> Data Cell
Cell -> DataType
Cell -> Constr
(forall b. Data b => b -> b) -> Cell -> Cell
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cell -> c Cell
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cCell :: Constr
$tCell :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Cell -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cell -> u
gmapQ :: (forall d. Data d => d -> u) -> Cell -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Cell -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Cell
Data, (forall x. Cell -> Rep Cell x)
-> (forall x. Rep Cell x -> Cell) -> Generic Cell
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)
newtype RowSpan = RowSpan Int
deriving (RowSpan -> RowSpan -> Bool
(RowSpan -> RowSpan -> Bool)
-> (RowSpan -> RowSpan -> Bool) -> Eq RowSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowSpan -> RowSpan -> Bool
$c/= :: RowSpan -> RowSpan -> Bool
== :: RowSpan -> RowSpan -> Bool
$c== :: RowSpan -> RowSpan -> Bool
Eq, Eq RowSpan
Eq RowSpan
-> (RowSpan -> RowSpan -> Ordering)
-> (RowSpan -> RowSpan -> Bool)
-> (RowSpan -> RowSpan -> Bool)
-> (RowSpan -> RowSpan -> Bool)
-> (RowSpan -> RowSpan -> Bool)
-> (RowSpan -> RowSpan -> RowSpan)
-> (RowSpan -> RowSpan -> RowSpan)
-> Ord RowSpan
RowSpan -> RowSpan -> Bool
RowSpan -> RowSpan -> Ordering
RowSpan -> RowSpan -> RowSpan
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 :: RowSpan -> RowSpan -> RowSpan
$cmin :: RowSpan -> RowSpan -> RowSpan
max :: RowSpan -> RowSpan -> RowSpan
$cmax :: RowSpan -> RowSpan -> RowSpan
>= :: RowSpan -> RowSpan -> Bool
$c>= :: RowSpan -> RowSpan -> Bool
> :: RowSpan -> RowSpan -> Bool
$c> :: RowSpan -> RowSpan -> Bool
<= :: RowSpan -> RowSpan -> Bool
$c<= :: RowSpan -> RowSpan -> Bool
< :: RowSpan -> RowSpan -> Bool
$c< :: RowSpan -> RowSpan -> Bool
compare :: RowSpan -> RowSpan -> Ordering
$ccompare :: RowSpan -> RowSpan -> Ordering
$cp1Ord :: Eq RowSpan
Ord, Int -> RowSpan -> ShowS
[RowSpan] -> ShowS
RowSpan -> String
(Int -> RowSpan -> ShowS)
-> (RowSpan -> String) -> ([RowSpan] -> ShowS) -> Show RowSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowSpan] -> ShowS
$cshowList :: [RowSpan] -> ShowS
show :: RowSpan -> String
$cshow :: RowSpan -> String
showsPrec :: Int -> RowSpan -> ShowS
$cshowsPrec :: Int -> RowSpan -> ShowS
Show, ReadPrec [RowSpan]
ReadPrec RowSpan
Int -> ReadS RowSpan
ReadS [RowSpan]
(Int -> ReadS RowSpan)
-> ReadS [RowSpan]
-> ReadPrec RowSpan
-> ReadPrec [RowSpan]
-> Read RowSpan
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RowSpan]
$creadListPrec :: ReadPrec [RowSpan]
readPrec :: ReadPrec RowSpan
$creadPrec :: ReadPrec RowSpan
readList :: ReadS [RowSpan]
$creadList :: ReadS [RowSpan]
readsPrec :: Int -> ReadS RowSpan
$creadsPrec :: Int -> ReadS RowSpan
Read, Typeable, Typeable RowSpan
DataType
Constr
Typeable RowSpan
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowSpan -> c RowSpan)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowSpan)
-> (RowSpan -> Constr)
-> (RowSpan -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowSpan))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RowSpan))
-> ((forall b. Data b => b -> b) -> RowSpan -> RowSpan)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowSpan -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowSpan -> r)
-> (forall u. (forall d. Data d => d -> u) -> RowSpan -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RowSpan -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RowSpan -> m RowSpan)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowSpan -> m RowSpan)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowSpan -> m RowSpan)
-> Data RowSpan
RowSpan -> DataType
RowSpan -> Constr
(forall b. Data b => b -> b) -> RowSpan -> RowSpan
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowSpan -> c RowSpan
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowSpan
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) -> RowSpan -> u
forall u. (forall d. Data d => d -> u) -> RowSpan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowSpan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RowSpan -> m RowSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowSpan -> m RowSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowSpan -> c RowSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RowSpan)
$cRowSpan :: Constr
$tRowSpan :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RowSpan -> m RowSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowSpan -> m RowSpan
gmapMp :: (forall d. Data d => d -> m d) -> RowSpan -> m RowSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RowSpan -> m RowSpan
gmapM :: (forall d. Data d => d -> m d) -> RowSpan -> m RowSpan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RowSpan -> m RowSpan
gmapQi :: Int -> (forall d. Data d => d -> u) -> RowSpan -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RowSpan -> u
gmapQ :: (forall d. Data d => d -> u) -> RowSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RowSpan -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RowSpan -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowSpan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RowSpan -> r
gmapT :: (forall b. Data b => b -> b) -> RowSpan -> RowSpan
$cgmapT :: (forall b. Data b => b -> b) -> RowSpan -> RowSpan
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RowSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RowSpan)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RowSpan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RowSpan)
dataTypeOf :: RowSpan -> DataType
$cdataTypeOf :: RowSpan -> DataType
toConstr :: RowSpan -> Constr
$ctoConstr :: RowSpan -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RowSpan
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowSpan -> c RowSpan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RowSpan -> c RowSpan
$cp1Data :: Typeable RowSpan
Data, (forall x. RowSpan -> Rep RowSpan x)
-> (forall x. Rep RowSpan x -> RowSpan) -> Generic RowSpan
forall x. Rep RowSpan x -> RowSpan
forall x. RowSpan -> Rep RowSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RowSpan x -> RowSpan
$cfrom :: forall x. RowSpan -> Rep RowSpan x
Generic, Integer -> RowSpan
RowSpan -> RowSpan
RowSpan -> RowSpan -> RowSpan
(RowSpan -> RowSpan -> RowSpan)
-> (RowSpan -> RowSpan -> RowSpan)
-> (RowSpan -> RowSpan -> RowSpan)
-> (RowSpan -> RowSpan)
-> (RowSpan -> RowSpan)
-> (RowSpan -> RowSpan)
-> (Integer -> RowSpan)
-> Num RowSpan
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> RowSpan
$cfromInteger :: Integer -> RowSpan
signum :: RowSpan -> RowSpan
$csignum :: RowSpan -> RowSpan
abs :: RowSpan -> RowSpan
$cabs :: RowSpan -> RowSpan
negate :: RowSpan -> RowSpan
$cnegate :: RowSpan -> RowSpan
* :: RowSpan -> RowSpan -> RowSpan
$c* :: RowSpan -> RowSpan -> RowSpan
- :: RowSpan -> RowSpan -> RowSpan
$c- :: RowSpan -> RowSpan -> RowSpan
+ :: RowSpan -> RowSpan -> RowSpan
$c+ :: RowSpan -> RowSpan -> RowSpan
Num, Int -> RowSpan
RowSpan -> Int
RowSpan -> [RowSpan]
RowSpan -> RowSpan
RowSpan -> RowSpan -> [RowSpan]
RowSpan -> RowSpan -> RowSpan -> [RowSpan]
(RowSpan -> RowSpan)
-> (RowSpan -> RowSpan)
-> (Int -> RowSpan)
-> (RowSpan -> Int)
-> (RowSpan -> [RowSpan])
-> (RowSpan -> RowSpan -> [RowSpan])
-> (RowSpan -> RowSpan -> [RowSpan])
-> (RowSpan -> RowSpan -> RowSpan -> [RowSpan])
-> Enum RowSpan
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 :: RowSpan -> RowSpan -> RowSpan -> [RowSpan]
$cenumFromThenTo :: RowSpan -> RowSpan -> RowSpan -> [RowSpan]
enumFromTo :: RowSpan -> RowSpan -> [RowSpan]
$cenumFromTo :: RowSpan -> RowSpan -> [RowSpan]
enumFromThen :: RowSpan -> RowSpan -> [RowSpan]
$cenumFromThen :: RowSpan -> RowSpan -> [RowSpan]
enumFrom :: RowSpan -> [RowSpan]
$cenumFrom :: RowSpan -> [RowSpan]
fromEnum :: RowSpan -> Int
$cfromEnum :: RowSpan -> Int
toEnum :: Int -> RowSpan
$ctoEnum :: Int -> RowSpan
pred :: RowSpan -> RowSpan
$cpred :: RowSpan -> RowSpan
succ :: RowSpan -> RowSpan
$csucc :: RowSpan -> RowSpan
Enum)
newtype ColSpan = ColSpan Int
deriving (ColSpan -> ColSpan -> Bool
(ColSpan -> ColSpan -> Bool)
-> (ColSpan -> ColSpan -> Bool) -> Eq ColSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColSpan -> ColSpan -> Bool
$c/= :: ColSpan -> ColSpan -> Bool
== :: ColSpan -> ColSpan -> Bool
$c== :: ColSpan -> ColSpan -> Bool
Eq, Eq ColSpan
Eq ColSpan
-> (ColSpan -> ColSpan -> Ordering)
-> (ColSpan -> ColSpan -> Bool)
-> (ColSpan -> ColSpan -> Bool)
-> (ColSpan -> ColSpan -> Bool)
-> (ColSpan -> ColSpan -> Bool)
-> (ColSpan -> ColSpan -> ColSpan)
-> (ColSpan -> ColSpan -> ColSpan)
-> Ord ColSpan
ColSpan -> ColSpan -> Bool
ColSpan -> ColSpan -> Ordering
ColSpan -> ColSpan -> ColSpan
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 :: ColSpan -> ColSpan -> ColSpan
$cmin :: ColSpan -> ColSpan -> ColSpan
max :: ColSpan -> ColSpan -> ColSpan
$cmax :: ColSpan -> ColSpan -> ColSpan
>= :: ColSpan -> ColSpan -> Bool
$c>= :: ColSpan -> ColSpan -> Bool
> :: ColSpan -> ColSpan -> Bool
$c> :: ColSpan -> ColSpan -> Bool
<= :: ColSpan -> ColSpan -> Bool
$c<= :: ColSpan -> ColSpan -> Bool
< :: ColSpan -> ColSpan -> Bool
$c< :: ColSpan -> ColSpan -> Bool
compare :: ColSpan -> ColSpan -> Ordering
$ccompare :: ColSpan -> ColSpan -> Ordering
$cp1Ord :: Eq ColSpan
Ord, Int -> ColSpan -> ShowS
[ColSpan] -> ShowS
ColSpan -> String
(Int -> ColSpan -> ShowS)
-> (ColSpan -> String) -> ([ColSpan] -> ShowS) -> Show ColSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColSpan] -> ShowS
$cshowList :: [ColSpan] -> ShowS
show :: ColSpan -> String
$cshow :: ColSpan -> String
showsPrec :: Int -> ColSpan -> ShowS
$cshowsPrec :: Int -> ColSpan -> ShowS
Show, ReadPrec [ColSpan]
ReadPrec ColSpan
Int -> ReadS ColSpan
ReadS [ColSpan]
(Int -> ReadS ColSpan)
-> ReadS [ColSpan]
-> ReadPrec ColSpan
-> ReadPrec [ColSpan]
-> Read ColSpan
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColSpan]
$creadListPrec :: ReadPrec [ColSpan]
readPrec :: ReadPrec ColSpan
$creadPrec :: ReadPrec ColSpan
readList :: ReadS [ColSpan]
$creadList :: ReadS [ColSpan]
readsPrec :: Int -> ReadS ColSpan
$creadsPrec :: Int -> ReadS ColSpan
Read, Typeable, Typeable ColSpan
DataType
Constr
Typeable ColSpan
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSpan -> c ColSpan)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSpan)
-> (ColSpan -> Constr)
-> (ColSpan -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColSpan))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColSpan))
-> ((forall b. Data b => b -> b) -> ColSpan -> ColSpan)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColSpan -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColSpan -> r)
-> (forall u. (forall d. Data d => d -> u) -> ColSpan -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ColSpan -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColSpan -> m ColSpan)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColSpan -> m ColSpan)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColSpan -> m ColSpan)
-> Data ColSpan
ColSpan -> DataType
ColSpan -> Constr
(forall b. Data b => b -> b) -> ColSpan -> ColSpan
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSpan -> c ColSpan
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSpan
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) -> ColSpan -> u
forall u. (forall d. Data d => d -> u) -> ColSpan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColSpan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColSpan -> m ColSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColSpan -> m ColSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSpan -> c ColSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColSpan)
$cColSpan :: Constr
$tColSpan :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ColSpan -> m ColSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColSpan -> m ColSpan
gmapMp :: (forall d. Data d => d -> m d) -> ColSpan -> m ColSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColSpan -> m ColSpan
gmapM :: (forall d. Data d => d -> m d) -> ColSpan -> m ColSpan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColSpan -> m ColSpan
gmapQi :: Int -> (forall d. Data d => d -> u) -> ColSpan -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColSpan -> u
gmapQ :: (forall d. Data d => d -> u) -> ColSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColSpan -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColSpan -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColSpan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColSpan -> r
gmapT :: (forall b. Data b => b -> b) -> ColSpan -> ColSpan
$cgmapT :: (forall b. Data b => b -> b) -> ColSpan -> ColSpan
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColSpan)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ColSpan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColSpan)
dataTypeOf :: ColSpan -> DataType
$cdataTypeOf :: ColSpan -> DataType
toConstr :: ColSpan -> Constr
$ctoConstr :: ColSpan -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSpan
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSpan -> c ColSpan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSpan -> c ColSpan
$cp1Data :: Typeable ColSpan
Data, (forall x. ColSpan -> Rep ColSpan x)
-> (forall x. Rep ColSpan x -> ColSpan) -> Generic ColSpan
forall x. Rep ColSpan x -> ColSpan
forall x. ColSpan -> Rep ColSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColSpan x -> ColSpan
$cfrom :: forall x. ColSpan -> Rep ColSpan x
Generic, Integer -> ColSpan
ColSpan -> ColSpan
ColSpan -> ColSpan -> ColSpan
(ColSpan -> ColSpan -> ColSpan)
-> (ColSpan -> ColSpan -> ColSpan)
-> (ColSpan -> ColSpan -> ColSpan)
-> (ColSpan -> ColSpan)
-> (ColSpan -> ColSpan)
-> (ColSpan -> ColSpan)
-> (Integer -> ColSpan)
-> Num ColSpan
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ColSpan
$cfromInteger :: Integer -> ColSpan
signum :: ColSpan -> ColSpan
$csignum :: ColSpan -> ColSpan
abs :: ColSpan -> ColSpan
$cabs :: ColSpan -> ColSpan
negate :: ColSpan -> ColSpan
$cnegate :: ColSpan -> ColSpan
* :: ColSpan -> ColSpan -> ColSpan
$c* :: ColSpan -> ColSpan -> ColSpan
- :: ColSpan -> ColSpan -> ColSpan
$c- :: ColSpan -> ColSpan -> ColSpan
+ :: ColSpan -> ColSpan -> ColSpan
$c+ :: ColSpan -> ColSpan -> ColSpan
Num, Int -> ColSpan
ColSpan -> Int
ColSpan -> [ColSpan]
ColSpan -> ColSpan
ColSpan -> ColSpan -> [ColSpan]
ColSpan -> ColSpan -> ColSpan -> [ColSpan]
(ColSpan -> ColSpan)
-> (ColSpan -> ColSpan)
-> (Int -> ColSpan)
-> (ColSpan -> Int)
-> (ColSpan -> [ColSpan])
-> (ColSpan -> ColSpan -> [ColSpan])
-> (ColSpan -> ColSpan -> [ColSpan])
-> (ColSpan -> ColSpan -> ColSpan -> [ColSpan])
-> Enum ColSpan
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 :: ColSpan -> ColSpan -> ColSpan -> [ColSpan]
$cenumFromThenTo :: ColSpan -> ColSpan -> ColSpan -> [ColSpan]
enumFromTo :: ColSpan -> ColSpan -> [ColSpan]
$cenumFromTo :: ColSpan -> ColSpan -> [ColSpan]
enumFromThen :: ColSpan -> ColSpan -> [ColSpan]
$cenumFromThen :: ColSpan -> ColSpan -> [ColSpan]
enumFrom :: ColSpan -> [ColSpan]
$cenumFrom :: ColSpan -> [ColSpan]
fromEnum :: ColSpan -> Int
$cfromEnum :: ColSpan -> Int
toEnum :: Int -> ColSpan
$ctoEnum :: Int -> ColSpan
pred :: ColSpan -> ColSpan
$cpred :: ColSpan -> ColSpan
succ :: ColSpan -> ColSpan
$csucc :: ColSpan -> ColSpan
Enum)
data Block
= Plain [Inline]
| Para [Inline]
| LineBlock [[Inline]]
| CodeBlock Attr Text
| RawBlock Format Text
| BlockQuote [Block]
| OrderedList ListAttributes [[Block]]
| BulletList [[Block]]
| DefinitionList [([Inline],[[Block]])]
| Int Attr [Inline]
| HorizontalRule
| Table Attr Caption [ColSpec] TableHead [TableBody] TableFoot
| Div Attr [Block]
| Null
deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq, Eq Block
Eq Block
-> (Block -> Block -> Ordering)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Block)
-> (Block -> Block -> Block)
-> Ord Block
Block -> Block -> Bool
Block -> Block -> Ordering
Block -> Block -> Block
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 :: Block -> Block -> Block
$cmin :: Block -> Block -> Block
max :: Block -> Block -> Block
$cmax :: Block -> Block -> Block
>= :: Block -> Block -> Bool
$c>= :: Block -> Block -> Bool
> :: Block -> Block -> Bool
$c> :: Block -> Block -> Bool
<= :: Block -> Block -> Bool
$c<= :: Block -> Block -> Bool
< :: Block -> Block -> Bool
$c< :: Block -> Block -> Bool
compare :: Block -> Block -> Ordering
$ccompare :: Block -> Block -> Ordering
$cp1Ord :: Eq Block
Ord, ReadPrec [Block]
ReadPrec Block
Int -> ReadS Block
ReadS [Block]
(Int -> ReadS Block)
-> ReadS [Block]
-> ReadPrec Block
-> ReadPrec [Block]
-> Read Block
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Block]
$creadListPrec :: ReadPrec [Block]
readPrec :: ReadPrec Block
$creadPrec :: ReadPrec Block
readList :: ReadS [Block]
$creadList :: ReadS [Block]
readsPrec :: Int -> ReadS Block
$creadsPrec :: Int -> ReadS Block
Read, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, Typeable, , (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic)
data QuoteType = SingleQuote | DoubleQuote deriving (Int -> QuoteType -> ShowS
[QuoteType] -> ShowS
QuoteType -> String
(Int -> QuoteType -> ShowS)
-> (QuoteType -> String)
-> ([QuoteType] -> ShowS)
-> Show QuoteType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuoteType] -> ShowS
$cshowList :: [QuoteType] -> ShowS
show :: QuoteType -> String
$cshow :: QuoteType -> String
showsPrec :: Int -> QuoteType -> ShowS
$cshowsPrec :: Int -> QuoteType -> ShowS
Show, QuoteType -> QuoteType -> Bool
(QuoteType -> QuoteType -> Bool)
-> (QuoteType -> QuoteType -> Bool) -> Eq QuoteType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuoteType -> QuoteType -> Bool
$c/= :: QuoteType -> QuoteType -> Bool
== :: QuoteType -> QuoteType -> Bool
$c== :: QuoteType -> QuoteType -> Bool
Eq, Eq QuoteType
Eq QuoteType
-> (QuoteType -> QuoteType -> Ordering)
-> (QuoteType -> QuoteType -> Bool)
-> (QuoteType -> QuoteType -> Bool)
-> (QuoteType -> QuoteType -> Bool)
-> (QuoteType -> QuoteType -> Bool)
-> (QuoteType -> QuoteType -> QuoteType)
-> (QuoteType -> QuoteType -> QuoteType)
-> Ord QuoteType
QuoteType -> QuoteType -> Bool
QuoteType -> QuoteType -> Ordering
QuoteType -> QuoteType -> QuoteType
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 :: QuoteType -> QuoteType -> QuoteType
$cmin :: QuoteType -> QuoteType -> QuoteType
max :: QuoteType -> QuoteType -> QuoteType
$cmax :: QuoteType -> QuoteType -> QuoteType
>= :: QuoteType -> QuoteType -> Bool
$c>= :: QuoteType -> QuoteType -> Bool
> :: QuoteType -> QuoteType -> Bool
$c> :: QuoteType -> QuoteType -> Bool
<= :: QuoteType -> QuoteType -> Bool
$c<= :: QuoteType -> QuoteType -> Bool
< :: QuoteType -> QuoteType -> Bool
$c< :: QuoteType -> QuoteType -> Bool
compare :: QuoteType -> QuoteType -> Ordering
$ccompare :: QuoteType -> QuoteType -> Ordering
$cp1Ord :: Eq QuoteType
Ord, ReadPrec [QuoteType]
ReadPrec QuoteType
Int -> ReadS QuoteType
ReadS [QuoteType]
(Int -> ReadS QuoteType)
-> ReadS [QuoteType]
-> ReadPrec QuoteType
-> ReadPrec [QuoteType]
-> Read QuoteType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QuoteType]
$creadListPrec :: ReadPrec [QuoteType]
readPrec :: ReadPrec QuoteType
$creadPrec :: ReadPrec QuoteType
readList :: ReadS [QuoteType]
$creadList :: ReadS [QuoteType]
readsPrec :: Int -> ReadS QuoteType
$creadsPrec :: Int -> ReadS QuoteType
Read, Typeable, Typeable QuoteType
DataType
Constr
Typeable QuoteType
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuoteType -> c QuoteType)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuoteType)
-> (QuoteType -> Constr)
-> (QuoteType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QuoteType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QuoteType))
-> ((forall b. Data b => b -> b) -> QuoteType -> QuoteType)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r)
-> (forall u. (forall d. Data d => d -> u) -> QuoteType -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> QuoteType -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType)
-> Data QuoteType
QuoteType -> DataType
QuoteType -> Constr
(forall b. Data b => b -> b) -> QuoteType -> QuoteType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuoteType -> c QuoteType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuoteType
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) -> QuoteType -> u
forall u. (forall d. Data d => d -> u) -> QuoteType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuoteType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuoteType -> c QuoteType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QuoteType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QuoteType)
$cDoubleQuote :: Constr
$cSingleQuote :: Constr
$tQuoteType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
gmapMp :: (forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
gmapM :: (forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
gmapQi :: Int -> (forall d. Data d => d -> u) -> QuoteType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QuoteType -> u
gmapQ :: (forall d. Data d => d -> u) -> QuoteType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QuoteType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
gmapT :: (forall b. Data b => b -> b) -> QuoteType -> QuoteType
$cgmapT :: (forall b. Data b => b -> b) -> QuoteType -> QuoteType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QuoteType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QuoteType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c QuoteType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QuoteType)
dataTypeOf :: QuoteType -> DataType
$cdataTypeOf :: QuoteType -> DataType
toConstr :: QuoteType -> Constr
$ctoConstr :: QuoteType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuoteType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuoteType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuoteType -> c QuoteType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuoteType -> c QuoteType
$cp1Data :: Typeable QuoteType
Data, (forall x. QuoteType -> Rep QuoteType x)
-> (forall x. Rep QuoteType x -> QuoteType) -> Generic QuoteType
forall x. Rep QuoteType x -> QuoteType
forall x. QuoteType -> Rep QuoteType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QuoteType x -> QuoteType
$cfrom :: forall x. QuoteType -> Rep QuoteType x
Generic)
type Target = (Text, Text)
data MathType = DisplayMath | InlineMath deriving (Int -> MathType -> ShowS
[MathType] -> ShowS
MathType -> String
(Int -> MathType -> ShowS)
-> (MathType -> String) -> ([MathType] -> ShowS) -> Show MathType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MathType] -> ShowS
$cshowList :: [MathType] -> ShowS
show :: MathType -> String
$cshow :: MathType -> String
showsPrec :: Int -> MathType -> ShowS
$cshowsPrec :: Int -> MathType -> ShowS
Show, MathType -> MathType -> Bool
(MathType -> MathType -> Bool)
-> (MathType -> MathType -> Bool) -> Eq MathType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MathType -> MathType -> Bool
$c/= :: MathType -> MathType -> Bool
== :: MathType -> MathType -> Bool
$c== :: MathType -> MathType -> Bool
Eq, Eq MathType
Eq MathType
-> (MathType -> MathType -> Ordering)
-> (MathType -> MathType -> Bool)
-> (MathType -> MathType -> Bool)
-> (MathType -> MathType -> Bool)
-> (MathType -> MathType -> Bool)
-> (MathType -> MathType -> MathType)
-> (MathType -> MathType -> MathType)
-> Ord MathType
MathType -> MathType -> Bool
MathType -> MathType -> Ordering
MathType -> MathType -> MathType
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 :: MathType -> MathType -> MathType
$cmin :: MathType -> MathType -> MathType
max :: MathType -> MathType -> MathType
$cmax :: MathType -> MathType -> MathType
>= :: MathType -> MathType -> Bool
$c>= :: MathType -> MathType -> Bool
> :: MathType -> MathType -> Bool
$c> :: MathType -> MathType -> Bool
<= :: MathType -> MathType -> Bool
$c<= :: MathType -> MathType -> Bool
< :: MathType -> MathType -> Bool
$c< :: MathType -> MathType -> Bool
compare :: MathType -> MathType -> Ordering
$ccompare :: MathType -> MathType -> Ordering
$cp1Ord :: Eq MathType
Ord, ReadPrec [MathType]
ReadPrec MathType
Int -> ReadS MathType
ReadS [MathType]
(Int -> ReadS MathType)
-> ReadS [MathType]
-> ReadPrec MathType
-> ReadPrec [MathType]
-> Read MathType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MathType]
$creadListPrec :: ReadPrec [MathType]
readPrec :: ReadPrec MathType
$creadPrec :: ReadPrec MathType
readList :: ReadS [MathType]
$creadList :: ReadS [MathType]
readsPrec :: Int -> ReadS MathType
$creadsPrec :: Int -> ReadS MathType
Read, Typeable, Typeable MathType
DataType
Constr
Typeable MathType
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MathType -> c MathType)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MathType)
-> (MathType -> Constr)
-> (MathType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MathType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MathType))
-> ((forall b. Data b => b -> b) -> MathType -> MathType)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MathType -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MathType -> r)
-> (forall u. (forall d. Data d => d -> u) -> MathType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> MathType -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MathType -> m MathType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MathType -> m MathType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MathType -> m MathType)
-> Data MathType
MathType -> DataType
MathType -> Constr
(forall b. Data b => b -> b) -> MathType -> MathType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MathType -> c MathType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MathType
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) -> MathType -> u
forall u. (forall d. Data d => d -> u) -> MathType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MathType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MathType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MathType -> m MathType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MathType -> m MathType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MathType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MathType -> c MathType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MathType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MathType)
$cInlineMath :: Constr
$cDisplayMath :: Constr
$tMathType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MathType -> m MathType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MathType -> m MathType
gmapMp :: (forall d. Data d => d -> m d) -> MathType -> m MathType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MathType -> m MathType
gmapM :: (forall d. Data d => d -> m d) -> MathType -> m MathType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MathType -> m MathType
gmapQi :: Int -> (forall d. Data d => d -> u) -> MathType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MathType -> u
gmapQ :: (forall d. Data d => d -> u) -> MathType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MathType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MathType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MathType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MathType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MathType -> r
gmapT :: (forall b. Data b => b -> b) -> MathType -> MathType
$cgmapT :: (forall b. Data b => b -> b) -> MathType -> MathType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MathType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MathType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MathType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MathType)
dataTypeOf :: MathType -> DataType
$cdataTypeOf :: MathType -> DataType
toConstr :: MathType -> Constr
$ctoConstr :: MathType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MathType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MathType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MathType -> c MathType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MathType -> c MathType
$cp1Data :: Typeable MathType
Data, (forall x. MathType -> Rep MathType x)
-> (forall x. Rep MathType x -> MathType) -> Generic MathType
forall x. Rep MathType x -> MathType
forall x. MathType -> Rep MathType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MathType x -> MathType
$cfrom :: forall x. MathType -> Rep MathType x
Generic)
data Inline
= Str Text
| Emph [Inline]
| Underline [Inline]
| Strong [Inline]
| Strikeout [Inline]
| Superscript [Inline]
| Subscript [Inline]
| SmallCaps [Inline]
| Quoted QuoteType [Inline]
| Cite [Citation] [Inline]
| Code Attr Text
| Space
| SoftBreak
| LineBreak
| Math MathType Text
| RawInline Format Text
| Link Attr [Inline] Target
| Image Attr [Inline] Target
| Note [Block]
| Span Attr [Inline]
deriving (Int -> Inline -> ShowS
[Inline] -> ShowS
Inline -> String
(Int -> Inline -> ShowS)
-> (Inline -> String) -> ([Inline] -> ShowS) -> Show Inline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inline] -> ShowS
$cshowList :: [Inline] -> ShowS
show :: Inline -> String
$cshow :: Inline -> String
showsPrec :: Int -> Inline -> ShowS
$cshowsPrec :: Int -> Inline -> ShowS
Show, Inline -> Inline -> Bool
(Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool) -> Eq Inline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inline -> Inline -> Bool
$c/= :: Inline -> Inline -> Bool
== :: Inline -> Inline -> Bool
$c== :: Inline -> Inline -> Bool
Eq, Eq Inline
Eq Inline
-> (Inline -> Inline -> Ordering)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Inline)
-> (Inline -> Inline -> Inline)
-> Ord Inline
Inline -> Inline -> Bool
Inline -> Inline -> Ordering
Inline -> Inline -> Inline
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 :: Inline -> Inline -> Inline
$cmin :: Inline -> Inline -> Inline
max :: Inline -> Inline -> Inline
$cmax :: Inline -> Inline -> Inline
>= :: Inline -> Inline -> Bool
$c>= :: Inline -> Inline -> Bool
> :: Inline -> Inline -> Bool
$c> :: Inline -> Inline -> Bool
<= :: Inline -> Inline -> Bool
$c<= :: Inline -> Inline -> Bool
< :: Inline -> Inline -> Bool
$c< :: Inline -> Inline -> Bool
compare :: Inline -> Inline -> Ordering
$ccompare :: Inline -> Inline -> Ordering
$cp1Ord :: Eq Inline
Ord, ReadPrec [Inline]
ReadPrec Inline
Int -> ReadS Inline
ReadS [Inline]
(Int -> ReadS Inline)
-> ReadS [Inline]
-> ReadPrec Inline
-> ReadPrec [Inline]
-> Read Inline
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Inline]
$creadListPrec :: ReadPrec [Inline]
readPrec :: ReadPrec Inline
$creadPrec :: ReadPrec Inline
readList :: ReadS [Inline]
$creadList :: ReadS [Inline]
readsPrec :: Int -> ReadS Inline
$creadsPrec :: Int -> ReadS Inline
Read, Typeable, Typeable Inline
DataType
Constr
Typeable Inline
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inline -> c Inline)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Inline)
-> (Inline -> Constr)
-> (Inline -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Inline))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Inline))
-> ((forall b. Data b => b -> b) -> Inline -> Inline)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Inline -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Inline -> r)
-> (forall u. (forall d. Data d => d -> u) -> Inline -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Inline -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Inline -> m Inline)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Inline -> m Inline)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Inline -> m Inline)
-> Data Inline
Inline -> DataType
Inline -> Constr
(forall b. Data b => b -> b) -> Inline -> Inline
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inline -> c Inline
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Inline
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) -> Inline -> u
forall u. (forall d. Data d => d -> u) -> Inline -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Inline -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Inline -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Inline -> m Inline
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Inline -> m Inline
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Inline
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inline -> c Inline
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Inline)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Inline)
$cSpan :: Constr
$cNote :: Constr
$cImage :: Constr
$cLink :: Constr
$cRawInline :: Constr
$cMath :: Constr
$cLineBreak :: Constr
$cSoftBreak :: Constr
$cSpace :: Constr
$cCode :: Constr
$cCite :: Constr
$cQuoted :: Constr
$cSmallCaps :: Constr
$cSubscript :: Constr
$cSuperscript :: Constr
$cStrikeout :: Constr
$cStrong :: Constr
$cUnderline :: Constr
$cEmph :: Constr
$cStr :: Constr
$tInline :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Inline -> m Inline
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Inline -> m Inline
gmapMp :: (forall d. Data d => d -> m d) -> Inline -> m Inline
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Inline -> m Inline
gmapM :: (forall d. Data d => d -> m d) -> Inline -> m Inline
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Inline -> m Inline
gmapQi :: Int -> (forall d. Data d => d -> u) -> Inline -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Inline -> u
gmapQ :: (forall d. Data d => d -> u) -> Inline -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Inline -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Inline -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Inline -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Inline -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Inline -> r
gmapT :: (forall b. Data b => b -> b) -> Inline -> Inline
$cgmapT :: (forall b. Data b => b -> b) -> Inline -> Inline
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Inline)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Inline)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Inline)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Inline)
dataTypeOf :: Inline -> DataType
$cdataTypeOf :: Inline -> DataType
toConstr :: Inline -> Constr
$ctoConstr :: Inline -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Inline
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Inline
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inline -> c Inline
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inline -> c Inline
$cp1Data :: Typeable Inline
Data, (forall x. Inline -> Rep Inline x)
-> (forall x. Rep Inline x -> Inline) -> Generic Inline
forall x. Rep Inline x -> Inline
forall x. Inline -> Rep Inline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Inline x -> Inline
$cfrom :: forall x. Inline -> Rep Inline x
Generic)
data Citation = Citation { Citation -> Text
citationId :: Text
, Citation -> [Inline]
citationPrefix :: [Inline]
, Citation -> [Inline]
citationSuffix :: [Inline]
, Citation -> CitationMode
citationMode :: CitationMode
, Citation -> Int
citationNoteNum :: Int
, Citation -> Int
citationHash :: Int
}
deriving (Int -> Citation -> ShowS
[Citation] -> ShowS
Citation -> String
(Int -> Citation -> ShowS)
-> (Citation -> String) -> ([Citation] -> ShowS) -> Show Citation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Citation] -> ShowS
$cshowList :: [Citation] -> ShowS
show :: Citation -> String
$cshow :: Citation -> String
showsPrec :: Int -> Citation -> ShowS
$cshowsPrec :: Int -> Citation -> ShowS
Show, Citation -> Citation -> Bool
(Citation -> Citation -> Bool)
-> (Citation -> Citation -> Bool) -> Eq Citation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Citation -> Citation -> Bool
$c/= :: Citation -> Citation -> Bool
== :: Citation -> Citation -> Bool
$c== :: Citation -> Citation -> Bool
Eq, ReadPrec [Citation]
ReadPrec Citation
Int -> ReadS Citation
ReadS [Citation]
(Int -> ReadS Citation)
-> ReadS [Citation]
-> ReadPrec Citation
-> ReadPrec [Citation]
-> Read Citation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Citation]
$creadListPrec :: ReadPrec [Citation]
readPrec :: ReadPrec Citation
$creadPrec :: ReadPrec Citation
readList :: ReadS [Citation]
$creadList :: ReadS [Citation]
readsPrec :: Int -> ReadS Citation
$creadsPrec :: Int -> ReadS Citation
Read, Typeable, Typeable Citation
DataType
Constr
Typeable Citation
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Citation -> c Citation)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Citation)
-> (Citation -> Constr)
-> (Citation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Citation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Citation))
-> ((forall b. Data b => b -> b) -> Citation -> Citation)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Citation -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Citation -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation)
-> Data Citation
Citation -> DataType
Citation -> Constr
(forall b. Data b => b -> b) -> Citation -> Citation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Citation -> c Citation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Citation
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) -> Citation -> u
forall u. (forall d. Data d => d -> u) -> Citation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Citation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Citation -> c Citation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Citation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Citation)
$cCitation :: Constr
$tCitation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Citation -> m Citation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
gmapMp :: (forall d. Data d => d -> m d) -> Citation -> m Citation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
gmapM :: (forall d. Data d => d -> m d) -> Citation -> m Citation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
gmapQi :: Int -> (forall d. Data d => d -> u) -> Citation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Citation -> u
gmapQ :: (forall d. Data d => d -> u) -> Citation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Citation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
gmapT :: (forall b. Data b => b -> b) -> Citation -> Citation
$cgmapT :: (forall b. Data b => b -> b) -> Citation -> Citation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Citation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Citation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Citation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Citation)
dataTypeOf :: Citation -> DataType
$cdataTypeOf :: Citation -> DataType
toConstr :: Citation -> Constr
$ctoConstr :: Citation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Citation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Citation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Citation -> c Citation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Citation -> c Citation
$cp1Data :: Typeable Citation
Data, (forall x. Citation -> Rep Citation x)
-> (forall x. Rep Citation x -> Citation) -> Generic Citation
forall x. Rep Citation x -> Citation
forall x. Citation -> Rep Citation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Citation x -> Citation
$cfrom :: forall x. Citation -> Rep Citation x
Generic)
instance Ord Citation where
compare :: Citation -> Citation -> Ordering
compare = (Citation -> Int) -> Citation -> Citation -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Citation -> Int
citationHash
data CitationMode = AuthorInText | SuppressAuthor | NormalCitation
deriving (Int -> CitationMode -> ShowS
[CitationMode] -> ShowS
CitationMode -> String
(Int -> CitationMode -> ShowS)
-> (CitationMode -> String)
-> ([CitationMode] -> ShowS)
-> Show CitationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CitationMode] -> ShowS
$cshowList :: [CitationMode] -> ShowS
show :: CitationMode -> String
$cshow :: CitationMode -> String
showsPrec :: Int -> CitationMode -> ShowS
$cshowsPrec :: Int -> CitationMode -> ShowS
Show, CitationMode -> CitationMode -> Bool
(CitationMode -> CitationMode -> Bool)
-> (CitationMode -> CitationMode -> Bool) -> Eq CitationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CitationMode -> CitationMode -> Bool
$c/= :: CitationMode -> CitationMode -> Bool
== :: CitationMode -> CitationMode -> Bool
$c== :: CitationMode -> CitationMode -> Bool
Eq, Eq CitationMode
Eq CitationMode
-> (CitationMode -> CitationMode -> Ordering)
-> (CitationMode -> CitationMode -> Bool)
-> (CitationMode -> CitationMode -> Bool)
-> (CitationMode -> CitationMode -> Bool)
-> (CitationMode -> CitationMode -> Bool)
-> (CitationMode -> CitationMode -> CitationMode)
-> (CitationMode -> CitationMode -> CitationMode)
-> Ord CitationMode
CitationMode -> CitationMode -> Bool
CitationMode -> CitationMode -> Ordering
CitationMode -> CitationMode -> CitationMode
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 :: CitationMode -> CitationMode -> CitationMode
$cmin :: CitationMode -> CitationMode -> CitationMode
max :: CitationMode -> CitationMode -> CitationMode
$cmax :: CitationMode -> CitationMode -> CitationMode
>= :: CitationMode -> CitationMode -> Bool
$c>= :: CitationMode -> CitationMode -> Bool
> :: CitationMode -> CitationMode -> Bool
$c> :: CitationMode -> CitationMode -> Bool
<= :: CitationMode -> CitationMode -> Bool
$c<= :: CitationMode -> CitationMode -> Bool
< :: CitationMode -> CitationMode -> Bool
$c< :: CitationMode -> CitationMode -> Bool
compare :: CitationMode -> CitationMode -> Ordering
$ccompare :: CitationMode -> CitationMode -> Ordering
$cp1Ord :: Eq CitationMode
Ord, ReadPrec [CitationMode]
ReadPrec CitationMode
Int -> ReadS CitationMode
ReadS [CitationMode]
(Int -> ReadS CitationMode)
-> ReadS [CitationMode]
-> ReadPrec CitationMode
-> ReadPrec [CitationMode]
-> Read CitationMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CitationMode]
$creadListPrec :: ReadPrec [CitationMode]
readPrec :: ReadPrec CitationMode
$creadPrec :: ReadPrec CitationMode
readList :: ReadS [CitationMode]
$creadList :: ReadS [CitationMode]
readsPrec :: Int -> ReadS CitationMode
$creadsPrec :: Int -> ReadS CitationMode
Read, Typeable, Typeable CitationMode
DataType
Constr
Typeable CitationMode
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CitationMode -> c CitationMode)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CitationMode)
-> (CitationMode -> Constr)
-> (CitationMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CitationMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CitationMode))
-> ((forall b. Data b => b -> b) -> CitationMode -> CitationMode)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CitationMode -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CitationMode -> r)
-> (forall u. (forall d. Data d => d -> u) -> CitationMode -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> CitationMode -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CitationMode -> m CitationMode)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CitationMode -> m CitationMode)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CitationMode -> m CitationMode)
-> Data CitationMode
CitationMode -> DataType
CitationMode -> Constr
(forall b. Data b => b -> b) -> CitationMode -> CitationMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CitationMode -> c CitationMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CitationMode
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) -> CitationMode -> u
forall u. (forall d. Data d => d -> u) -> CitationMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CitationMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CitationMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CitationMode -> m CitationMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CitationMode -> m CitationMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CitationMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CitationMode -> c CitationMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CitationMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CitationMode)
$cNormalCitation :: Constr
$cSuppressAuthor :: Constr
$cAuthorInText :: Constr
$tCitationMode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CitationMode -> m CitationMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CitationMode -> m CitationMode
gmapMp :: (forall d. Data d => d -> m d) -> CitationMode -> m CitationMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CitationMode -> m CitationMode
gmapM :: (forall d. Data d => d -> m d) -> CitationMode -> m CitationMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CitationMode -> m CitationMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> CitationMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CitationMode -> u
gmapQ :: (forall d. Data d => d -> u) -> CitationMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CitationMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CitationMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CitationMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CitationMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CitationMode -> r
gmapT :: (forall b. Data b => b -> b) -> CitationMode -> CitationMode
$cgmapT :: (forall b. Data b => b -> b) -> CitationMode -> CitationMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CitationMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CitationMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CitationMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CitationMode)
dataTypeOf :: CitationMode -> DataType
$cdataTypeOf :: CitationMode -> DataType
toConstr :: CitationMode -> Constr
$ctoConstr :: CitationMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CitationMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CitationMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CitationMode -> c CitationMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CitationMode -> c CitationMode
$cp1Data :: Typeable CitationMode
Data, (forall x. CitationMode -> Rep CitationMode x)
-> (forall x. Rep CitationMode x -> CitationMode)
-> Generic CitationMode
forall x. Rep CitationMode x -> CitationMode
forall x. CitationMode -> Rep CitationMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CitationMode x -> CitationMode
$cfrom :: forall x. CitationMode -> Rep CitationMode x
Generic)
taggedNoContent :: Text -> Value
taggedNoContent :: Text -> Value
taggedNoContent Text
x = [Pair] -> Value
object [ Text
"t" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
x ]
tagged :: ToJSON a => Text -> a -> Value
tagged :: Text -> a -> Value
tagged Text
x a
y = [Pair] -> Value
object [ Text
"t" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
x, Text
"c" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
y ]
instance FromJSON MetaValue where
parseJSON :: Value -> Parser MetaValue
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"MetaMap" -> Map Text MetaValue -> MetaValue
MetaMap (Map Text MetaValue -> MetaValue)
-> Parser (Map Text MetaValue) -> Parser MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Map Text MetaValue)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c")
Value
"MetaList" -> [MetaValue] -> MetaValue
MetaList ([MetaValue] -> MetaValue)
-> Parser [MetaValue] -> Parser MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser [MetaValue]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c")
Value
"MetaBool" -> Bool -> MetaValue
MetaBool (Bool -> MetaValue) -> Parser Bool -> Parser MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c")
Value
"MetaString" -> Text -> MetaValue
MetaString (Text -> MetaValue) -> Parser Text -> Parser MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c")
Value
"MetaInlines" -> [Inline] -> MetaValue
MetaInlines ([Inline] -> MetaValue) -> Parser [Inline] -> Parser MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c")
Value
"MetaBlocks" -> [Block] -> MetaValue
MetaBlocks ([Block] -> MetaValue) -> Parser [Block] -> Parser MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser [Block]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c")
Value
_ -> Parser MetaValue
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser MetaValue
forall a. Monoid a => a
mempty
instance ToJSON MetaValue where
toJSON :: MetaValue -> Value
toJSON (MetaMap Map Text MetaValue
mp) = Text -> Map Text MetaValue -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"MetaMap" Map Text MetaValue
mp
toJSON (MetaList [MetaValue]
lst) = Text -> [MetaValue] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"MetaList" [MetaValue]
lst
toJSON (MetaBool Bool
bool) = Text -> Bool -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"MetaBool" Bool
bool
toJSON (MetaString Text
s) = Text -> Text -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"MetaString" Text
s
toJSON (MetaInlines [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"MetaInlines" [Inline]
ils
toJSON (MetaBlocks [Block]
blks) = Text -> [Block] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"MetaBlocks" [Block]
blks
instance FromJSON Meta where
parseJSON :: Value -> Parser Meta
parseJSON Value
j = Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta)
-> Parser (Map Text MetaValue) -> Parser Meta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map Text MetaValue)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j
instance ToJSON Meta where
toJSON :: Meta -> Value
toJSON Meta
meta = Map Text MetaValue -> Value
forall a. ToJSON a => a -> Value
toJSON (Map Text MetaValue -> Value) -> Map Text MetaValue -> Value
forall a b. (a -> b) -> a -> b
$ Meta -> Map Text MetaValue
unMeta Meta
meta
instance FromJSON CitationMode where
parseJSON :: Value -> Parser CitationMode
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"AuthorInText" -> CitationMode -> Parser CitationMode
forall (m :: * -> *) a. Monad m => a -> m a
return CitationMode
AuthorInText
Value
"SuppressAuthor" -> CitationMode -> Parser CitationMode
forall (m :: * -> *) a. Monad m => a -> m a
return CitationMode
SuppressAuthor
Value
"NormalCitation" -> CitationMode -> Parser CitationMode
forall (m :: * -> *) a. Monad m => a -> m a
return CitationMode
NormalCitation
Value
_ -> Parser CitationMode
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser CitationMode
forall a. Monoid a => a
mempty
instance ToJSON CitationMode where
toJSON :: CitationMode -> Value
toJSON CitationMode
cmode = Text -> Value
taggedNoContent Text
s
where s :: Text
s = case CitationMode
cmode of
CitationMode
AuthorInText -> Text
"AuthorInText"
CitationMode
SuppressAuthor -> Text
"SuppressAuthor"
CitationMode
NormalCitation -> Text
"NormalCitation"
instance FromJSON Citation where
parseJSON :: Value -> Parser Citation
parseJSON (Object Object
v) = do
Text
citationId' <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"citationId"
[Inline]
citationPrefix' <- Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"citationPrefix"
[Inline]
citationSuffix' <- Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"citationSuffix"
CitationMode
citationMode' <- Object
v Object -> Text -> Parser CitationMode
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"citationMode"
Int
citationNoteNum' <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"citationNoteNum"
Int
citationHash' <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"citationHash"
Citation -> Parser Citation
forall (m :: * -> *) a. Monad m => a -> m a
return Citation :: Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation { citationId :: Text
citationId = Text
citationId'
, citationPrefix :: [Inline]
citationPrefix = [Inline]
citationPrefix'
, citationSuffix :: [Inline]
citationSuffix = [Inline]
citationSuffix'
, citationMode :: CitationMode
citationMode = CitationMode
citationMode'
, citationNoteNum :: Int
citationNoteNum = Int
citationNoteNum'
, citationHash :: Int
citationHash = Int
citationHash'
}
parseJSON Value
_ = Parser Citation
forall a. Monoid a => a
mempty
instance ToJSON Citation where
toJSON :: Citation -> Value
toJSON Citation
cit =
[Pair] -> Value
object [ Text
"citationId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> Text
citationId Citation
cit
, Text
"citationPrefix" Text -> [Inline] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> [Inline]
citationPrefix Citation
cit
, Text
"citationSuffix" Text -> [Inline] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> [Inline]
citationSuffix Citation
cit
, Text
"citationMode" Text -> CitationMode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> CitationMode
citationMode Citation
cit
, Text
"citationNoteNum" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> Int
citationNoteNum Citation
cit
, Text
"citationHash" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> Int
citationHash Citation
cit
]
instance FromJSON QuoteType where
parseJSON :: Value -> Parser QuoteType
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"SingleQuote" -> QuoteType -> Parser QuoteType
forall (m :: * -> *) a. Monad m => a -> m a
return QuoteType
SingleQuote
Value
"DoubleQuote" -> QuoteType -> Parser QuoteType
forall (m :: * -> *) a. Monad m => a -> m a
return QuoteType
DoubleQuote
Value
_ -> Parser QuoteType
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser QuoteType
forall a. Monoid a => a
mempty
instance ToJSON QuoteType where
toJSON :: QuoteType -> Value
toJSON QuoteType
qtype = Text -> Value
taggedNoContent Text
s
where s :: Text
s = case QuoteType
qtype of
QuoteType
SingleQuote -> Text
"SingleQuote"
QuoteType
DoubleQuote -> Text
"DoubleQuote"
instance FromJSON MathType where
parseJSON :: Value -> Parser MathType
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"DisplayMath" -> MathType -> Parser MathType
forall (m :: * -> *) a. Monad m => a -> m a
return MathType
DisplayMath
Value
"InlineMath" -> MathType -> Parser MathType
forall (m :: * -> *) a. Monad m => a -> m a
return MathType
InlineMath
Value
_ -> Parser MathType
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser MathType
forall a. Monoid a => a
mempty
instance ToJSON MathType where
toJSON :: MathType -> Value
toJSON MathType
mtype = Text -> Value
taggedNoContent Text
s
where s :: Text
s = case MathType
mtype of
MathType
DisplayMath -> Text
"DisplayMath"
MathType
InlineMath -> Text
"InlineMath"
instance FromJSON ListNumberStyle where
parseJSON :: Value -> Parser ListNumberStyle
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"DefaultStyle" -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
DefaultStyle
Value
"Example" -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
Example
Value
"Decimal" -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
Decimal
Value
"LowerRoman" -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
LowerRoman
Value
"UpperRoman" -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
UpperRoman
Value
"LowerAlpha" -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
LowerAlpha
Value
"UpperAlpha" -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
UpperAlpha
Value
_ -> Parser ListNumberStyle
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser ListNumberStyle
forall a. Monoid a => a
mempty
instance ToJSON ListNumberStyle where
toJSON :: ListNumberStyle -> Value
toJSON ListNumberStyle
lsty = Text -> Value
taggedNoContent Text
s
where s :: Text
s = case ListNumberStyle
lsty of
ListNumberStyle
DefaultStyle -> Text
"DefaultStyle"
ListNumberStyle
Example -> Text
"Example"
ListNumberStyle
Decimal -> Text
"Decimal"
ListNumberStyle
LowerRoman -> Text
"LowerRoman"
ListNumberStyle
UpperRoman -> Text
"UpperRoman"
ListNumberStyle
LowerAlpha -> Text
"LowerAlpha"
ListNumberStyle
UpperAlpha -> Text
"UpperAlpha"
instance FromJSON ListNumberDelim where
parseJSON :: Value -> Parser ListNumberDelim
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"DefaultDelim" -> ListNumberDelim -> Parser ListNumberDelim
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberDelim
DefaultDelim
Value
"Period" -> ListNumberDelim -> Parser ListNumberDelim
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberDelim
Period
Value
"OneParen" -> ListNumberDelim -> Parser ListNumberDelim
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberDelim
OneParen
Value
"TwoParens" -> ListNumberDelim -> Parser ListNumberDelim
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberDelim
TwoParens
Value
_ -> Parser ListNumberDelim
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser ListNumberDelim
forall a. Monoid a => a
mempty
instance ToJSON ListNumberDelim where
toJSON :: ListNumberDelim -> Value
toJSON ListNumberDelim
delim = Text -> Value
taggedNoContent Text
s
where s :: Text
s = case ListNumberDelim
delim of
ListNumberDelim
DefaultDelim -> Text
"DefaultDelim"
ListNumberDelim
Period -> Text
"Period"
ListNumberDelim
OneParen -> Text
"OneParen"
ListNumberDelim
TwoParens -> Text
"TwoParens"
instance FromJSON Alignment where
parseJSON :: Value -> Parser Alignment
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"AlignLeft" -> Alignment -> Parser Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment
AlignLeft
Value
"AlignRight" -> Alignment -> Parser Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment
AlignRight
Value
"AlignCenter" -> Alignment -> Parser Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment
AlignCenter
Value
"AlignDefault" -> Alignment -> Parser Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment
AlignDefault
Value
_ -> Parser Alignment
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser Alignment
forall a. Monoid a => a
mempty
instance ToJSON Alignment where
toJSON :: Alignment -> Value
toJSON Alignment
delim = Text -> Value
taggedNoContent Text
s
where s :: Text
s = case Alignment
delim of
Alignment
AlignLeft -> Text
"AlignLeft"
Alignment
AlignRight -> Text
"AlignRight"
Alignment
AlignCenter -> Text
"AlignCenter"
Alignment
AlignDefault -> Text
"AlignDefault"
instance FromJSON ColWidth where
parseJSON :: Value -> Parser ColWidth
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"ColWidth" -> Double -> ColWidth
ColWidth (Double -> ColWidth) -> Parser Double -> Parser ColWidth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"ColWidthDefault" -> ColWidth -> Parser ColWidth
forall (m :: * -> *) a. Monad m => a -> m a
return ColWidth
ColWidthDefault
Value
_ -> Parser ColWidth
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser ColWidth
forall a. Monoid a => a
mempty
instance ToJSON ColWidth where
toJSON :: ColWidth -> Value
toJSON (ColWidth Double
ils) = Text -> Double -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"ColWidth" Double
ils
toJSON ColWidth
ColWidthDefault = Text -> Value
taggedNoContent Text
"ColWidthDefault"
instance FromJSON Row where
parseJSON :: Value -> Parser Row
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"Row" -> do (Attr
attr, [Cell]
body) <- Object
v Object -> Text -> Parser (Attr, [Cell])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Row -> Parser Row
forall (m :: * -> *) a. Monad m => a -> m a
return (Row -> Parser Row) -> Row -> Parser Row
forall a b. (a -> b) -> a -> b
$ Attr -> [Cell] -> Row
Row Attr
attr [Cell]
body
Value
_ -> Parser Row
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser Row
forall a. Monoid a => a
mempty
instance ToJSON Row where
toJSON :: Row -> Value
toJSON (Row Attr
attr [Cell]
body) = Text -> (Attr, [Cell]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Row" (Attr
attr, [Cell]
body)
instance FromJSON Caption where
parseJSON :: Value -> Parser Caption
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"Caption" -> do (Maybe [Inline]
mshort, [Block]
body) <- Object
v Object -> Text -> Parser (Maybe [Inline], [Block])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Caption -> Parser Caption
forall (m :: * -> *) a. Monad m => a -> m a
return (Caption -> Parser Caption) -> Caption -> Parser Caption
forall a b. (a -> b) -> a -> b
$ Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
mshort [Block]
body
Value
_ -> Parser Caption
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser Caption
forall a. Monoid a => a
mempty
instance ToJSON Caption where
toJSON :: Caption -> Value
toJSON (Caption Maybe [Inline]
mshort [Block]
body) = Text -> (Maybe [Inline], [Block]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Caption" (Maybe [Inline]
mshort, [Block]
body)
instance FromJSON RowSpan where
parseJSON :: Value -> Parser RowSpan
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"RowSpan" -> Int -> RowSpan
RowSpan (Int -> RowSpan) -> Parser Int -> Parser RowSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
_ -> Parser RowSpan
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser RowSpan
forall a. Monoid a => a
mempty
instance ToJSON RowSpan where
toJSON :: RowSpan -> Value
toJSON (RowSpan Int
h) = Text -> Int -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"RowSpan" Int
h
instance FromJSON ColSpan where
parseJSON :: Value -> Parser ColSpan
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"ColSpan" -> Int -> ColSpan
ColSpan (Int -> ColSpan) -> Parser Int -> Parser ColSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
_ -> Parser ColSpan
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser ColSpan
forall a. Monoid a => a
mempty
instance ToJSON ColSpan where
toJSON :: ColSpan -> Value
toJSON (ColSpan Int
w) = Text -> Int -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"ColSpan" Int
w
instance FromJSON RowHeadColumns where
parseJSON :: Value -> Parser RowHeadColumns
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"RowHeadColumns" -> Int -> RowHeadColumns
RowHeadColumns (Int -> RowHeadColumns) -> Parser Int -> Parser RowHeadColumns
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
_ -> Parser RowHeadColumns
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser RowHeadColumns
forall a. Monoid a => a
mempty
instance ToJSON RowHeadColumns where
toJSON :: RowHeadColumns -> Value
toJSON (RowHeadColumns Int
w) = Text -> Int -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"RowHeadColumns" Int
w
instance FromJSON TableHead where
parseJSON :: Value -> Parser TableHead
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"TableHead" -> do (Attr
attr, [Row]
body) <- Object
v Object -> Text -> Parser (Attr, [Row])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
TableHead -> Parser TableHead
forall (m :: * -> *) a. Monad m => a -> m a
return (TableHead -> Parser TableHead) -> TableHead -> Parser TableHead
forall a b. (a -> b) -> a -> b
$ Attr -> [Row] -> TableHead
TableHead Attr
attr [Row]
body
Value
_ -> Parser TableHead
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser TableHead
forall a. Monoid a => a
mempty
instance ToJSON TableHead where
toJSON :: TableHead -> Value
toJSON (TableHead Attr
attr [Row]
body) = Text -> (Attr, [Row]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"TableHead" (Attr
attr, [Row]
body)
instance FromJSON TableBody where
parseJSON :: Value -> Parser TableBody
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"TableBody" -> do (Attr
attr, RowHeadColumns
rhc, [Row]
hd, [Row]
body) <- Object
v Object -> Text -> Parser (Attr, RowHeadColumns, [Row], [Row])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
TableBody -> Parser TableBody
forall (m :: * -> *) a. Monad m => a -> m a
return (TableBody -> Parser TableBody) -> TableBody -> Parser TableBody
forall a b. (a -> b) -> a -> b
$ Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
attr RowHeadColumns
rhc [Row]
hd [Row]
body
Value
_ -> Parser TableBody
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser TableBody
forall a. Monoid a => a
mempty
instance ToJSON TableBody where
toJSON :: TableBody -> Value
toJSON (TableBody Attr
attr RowHeadColumns
rhc [Row]
hd [Row]
body) = Text -> (Attr, RowHeadColumns, [Row], [Row]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"TableBody" (Attr
attr, RowHeadColumns
rhc, [Row]
hd, [Row]
body)
instance FromJSON TableFoot where
parseJSON :: Value -> Parser TableFoot
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"TableFoot" -> do (Attr
attr, [Row]
body) <- Object
v Object -> Text -> Parser (Attr, [Row])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
TableFoot -> Parser TableFoot
forall (m :: * -> *) a. Monad m => a -> m a
return (TableFoot -> Parser TableFoot) -> TableFoot -> Parser TableFoot
forall a b. (a -> b) -> a -> b
$ Attr -> [Row] -> TableFoot
TableFoot Attr
attr [Row]
body
Value
_ -> Parser TableFoot
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser TableFoot
forall a. Monoid a => a
mempty
instance ToJSON TableFoot where
toJSON :: TableFoot -> Value
toJSON (TableFoot Attr
attr [Row]
body) = Text -> (Attr, [Row]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"TableFoot" (Attr
attr, [Row]
body)
instance FromJSON Cell where
parseJSON :: Value -> Parser Cell
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"Cell" -> do (Attr
attr, Alignment
malign, RowSpan
rs, ColSpan
cs, [Block]
body) <- Object
v Object
-> Text -> Parser (Attr, Alignment, RowSpan, ColSpan, [Block])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Cell -> Parser Cell
forall (m :: * -> *) a. Monad m => a -> m a
return (Cell -> Parser Cell) -> Cell -> Parser Cell
forall a b. (a -> b) -> a -> b
$ Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
malign RowSpan
rs ColSpan
cs [Block]
body
Value
_ -> Parser Cell
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser Cell
forall a. Monoid a => a
mempty
instance ToJSON Cell where
toJSON :: Cell -> Value
toJSON (Cell Attr
attr Alignment
malign RowSpan
rs ColSpan
cs [Block]
body) = Text -> (Attr, Alignment, RowSpan, ColSpan, [Block]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Cell" (Attr
attr, Alignment
malign, RowSpan
rs, ColSpan
cs, [Block]
body)
instance FromJSON Inline where
parseJSON :: Value -> Parser Inline
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"Str" -> Text -> Inline
Str (Text -> Inline) -> Parser Text -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Emph" -> [Inline] -> Inline
Emph ([Inline] -> Inline) -> Parser [Inline] -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Underline" -> [Inline] -> Inline
Underline ([Inline] -> Inline) -> Parser [Inline] -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Strong" -> [Inline] -> Inline
Strong ([Inline] -> Inline) -> Parser [Inline] -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Strikeout" -> [Inline] -> Inline
Strikeout ([Inline] -> Inline) -> Parser [Inline] -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Superscript" -> [Inline] -> Inline
Superscript ([Inline] -> Inline) -> Parser [Inline] -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Subscript" -> [Inline] -> Inline
Subscript ([Inline] -> Inline) -> Parser [Inline] -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"SmallCaps" -> [Inline] -> Inline
SmallCaps ([Inline] -> Inline) -> Parser [Inline] -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Quoted" -> do (QuoteType
qt, [Inline]
ils) <- Object
v Object -> Text -> Parser (QuoteType, [Inline])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Inline) -> Inline -> Parser Inline
forall a b. (a -> b) -> a -> b
$ QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt [Inline]
ils
Value
"Cite" -> do ([Citation]
cits, [Inline]
ils) <- Object
v Object -> Text -> Parser ([Citation], [Inline])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Inline) -> Inline -> Parser Inline
forall a b. (a -> b) -> a -> b
$ [Citation] -> [Inline] -> Inline
Cite [Citation]
cits [Inline]
ils
Value
"Code" -> do (Attr
attr, Text
s) <- Object
v Object -> Text -> Parser (Attr, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Inline) -> Inline -> Parser Inline
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inline
Code Attr
attr Text
s
Value
"Space" -> Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
Space
Value
"SoftBreak" -> Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
SoftBreak
Value
"LineBreak" -> Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
LineBreak
Value
"Math" -> do (MathType
mtype, Text
s) <- Object
v Object -> Text -> Parser (MathType, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Inline) -> Inline -> Parser Inline
forall a b. (a -> b) -> a -> b
$ MathType -> Text -> Inline
Math MathType
mtype Text
s
Value
"RawInline" -> do (Format
fmt, Text
s) <- Object
v Object -> Text -> Parser (Format, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Inline) -> Inline -> Parser Inline
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline Format
fmt Text
s
Value
"Link" -> do (Attr
attr, [Inline]
ils, (Text, Text)
tgt) <- Object
v Object -> Text -> Parser (Attr, [Inline], (Text, Text))
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Inline) -> Inline -> Parser Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
ils (Text, Text)
tgt
Value
"Image" -> do (Attr
attr, [Inline]
ils, (Text, Text)
tgt) <- Object
v Object -> Text -> Parser (Attr, [Inline], (Text, Text))
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Inline) -> Inline -> Parser Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
ils (Text, Text)
tgt
Value
"Note" -> [Block] -> Inline
Note ([Block] -> Inline) -> Parser [Block] -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Block]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Span" -> do (Attr
attr, [Inline]
ils) <- Object
v Object -> Text -> Parser (Attr, [Inline])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Inline) -> Inline -> Parser Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span Attr
attr [Inline]
ils
Value
_ -> Parser Inline
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser Inline
forall a. Monoid a => a
mempty
instance ToJSON Inline where
toJSON :: Inline -> Value
toJSON (Str Text
s) = Text -> Text -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Str" Text
s
toJSON (Emph [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Emph" [Inline]
ils
toJSON (Underline [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Underline" [Inline]
ils
toJSON (Strong [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Strong" [Inline]
ils
toJSON (Strikeout [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Strikeout" [Inline]
ils
toJSON (Superscript [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Superscript" [Inline]
ils
toJSON (Subscript [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Subscript" [Inline]
ils
toJSON (SmallCaps [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"SmallCaps" [Inline]
ils
toJSON (Quoted QuoteType
qtype [Inline]
ils) = Text -> (QuoteType, [Inline]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Quoted" (QuoteType
qtype, [Inline]
ils)
toJSON (Cite [Citation]
cits [Inline]
ils) = Text -> ([Citation], [Inline]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Cite" ([Citation]
cits, [Inline]
ils)
toJSON (Code Attr
attr Text
s) = Text -> (Attr, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Code" (Attr
attr, Text
s)
toJSON Inline
Space = Text -> Value
taggedNoContent Text
"Space"
toJSON Inline
SoftBreak = Text -> Value
taggedNoContent Text
"SoftBreak"
toJSON Inline
LineBreak = Text -> Value
taggedNoContent Text
"LineBreak"
toJSON (Math MathType
mtype Text
s) = Text -> (MathType, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Math" (MathType
mtype, Text
s)
toJSON (RawInline Format
fmt Text
s) = Text -> (Format, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"RawInline" (Format
fmt, Text
s)
toJSON (Link Attr
attr [Inline]
ils (Text, Text)
target) = Text -> (Attr, [Inline], (Text, Text)) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Link" (Attr
attr, [Inline]
ils, (Text, Text)
target)
toJSON (Image Attr
attr [Inline]
ils (Text, Text)
target) = Text -> (Attr, [Inline], (Text, Text)) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Image" (Attr
attr, [Inline]
ils, (Text, Text)
target)
toJSON (Note [Block]
blks) = Text -> [Block] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Note" [Block]
blks
toJSON (Span Attr
attr [Inline]
ils) = Text -> (Attr, [Inline]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Span" (Attr
attr, [Inline]
ils)
instance FromJSON Block where
parseJSON :: Value -> Parser Block
parseJSON (Object Object
v) = do
Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t" :: Aeson.Parser Value
case Value
t of
Value
"Plain" -> [Inline] -> Block
Plain ([Inline] -> Block) -> Parser [Inline] -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Para" -> [Inline] -> Block
Para ([Inline] -> Block) -> Parser [Inline] -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"LineBlock" -> [[Inline]] -> Block
LineBlock ([[Inline]] -> Block) -> Parser [[Inline]] -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [[Inline]]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"CodeBlock" -> do (Attr
attr, Text
s) <- Object
v Object -> Text -> Parser (Attr, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Parser Block) -> Block -> Parser Block
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Block
CodeBlock Attr
attr Text
s
Value
"RawBlock" -> do (Format
fmt, Text
s) <- Object
v Object -> Text -> Parser (Format, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Parser Block) -> Block -> Parser Block
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Block
RawBlock Format
fmt Text
s
Value
"BlockQuote" -> [Block] -> Block
BlockQuote ([Block] -> Block) -> Parser [Block] -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Block]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"OrderedList" -> do (ListAttributes
attr, [[Block]]
items) <- Object
v Object -> Text -> Parser (ListAttributes, [[Block]])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Parser Block) -> Block -> Parser Block
forall a b. (a -> b) -> a -> b
$ ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attr [[Block]]
items
Value
"BulletList" -> [[Block]] -> Block
BulletList ([[Block]] -> Block) -> Parser [[Block]] -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [[Block]]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"DefinitionList" -> [([Inline], [[Block]])] -> Block
DefinitionList ([([Inline], [[Block]])] -> Block)
-> Parser [([Inline], [[Block]])] -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [([Inline], [[Block]])]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Value
"Header" -> do (Int
n, Attr
attr, [Inline]
ils) <- Object
v Object -> Text -> Parser (Int, Attr, [Inline])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Parser Block) -> Block -> Parser Block
forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
n Attr
attr [Inline]
ils
Value
"HorizontalRule" -> Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
HorizontalRule
Value
"Table" -> do (Attr
attr, Caption
cpt, [ColSpec]
align, TableHead
hdr, [TableBody]
body, TableFoot
foot) <- Object
v Object
-> Text
-> Parser
(Attr, Caption, [ColSpec], TableHead, [TableBody], TableFoot)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Parser Block) -> Block -> Parser Block
forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
cpt [ColSpec]
align TableHead
hdr [TableBody]
body TableFoot
foot
Value
"Div" -> do (Attr
attr, [Block]
blks) <- Object
v Object -> Text -> Parser (Attr, [Block])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"c"
Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Parser Block) -> Block -> Parser Block
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div Attr
attr [Block]
blks
Value
"Null" -> Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
Null
Value
_ -> Parser Block
forall a. Monoid a => a
mempty
parseJSON Value
_ = Parser Block
forall a. Monoid a => a
mempty
instance ToJSON Block where
toJSON :: Block -> Value
toJSON (Plain [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Plain" [Inline]
ils
toJSON (Para [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Para" [Inline]
ils
toJSON (LineBlock [[Inline]]
lns) = Text -> [[Inline]] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"LineBlock" [[Inline]]
lns
toJSON (CodeBlock Attr
attr Text
s) = Text -> (Attr, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"CodeBlock" (Attr
attr, Text
s)
toJSON (RawBlock Format
fmt Text
s) = Text -> (Format, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"RawBlock" (Format
fmt, Text
s)
toJSON (BlockQuote [Block]
blks) = Text -> [Block] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"BlockQuote" [Block]
blks
toJSON (OrderedList ListAttributes
listAttrs [[Block]]
blksList) = Text -> (ListAttributes, [[Block]]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"OrderedList" (ListAttributes
listAttrs, [[Block]]
blksList)
toJSON (BulletList [[Block]]
blksList) = Text -> [[Block]] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"BulletList" [[Block]]
blksList
toJSON (DefinitionList [([Inline], [[Block]])]
defs) = Text -> [([Inline], [[Block]])] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"DefinitionList" [([Inline], [[Block]])]
defs
toJSON (Header Int
n Attr
attr [Inline]
ils) = Text -> (Int, Attr, [Inline]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Header" (Int
n, Attr
attr, [Inline]
ils)
toJSON Block
HorizontalRule = Text -> Value
taggedNoContent Text
"HorizontalRule"
toJSON (Table Attr
attr Caption
caption [ColSpec]
aligns TableHead
hd [TableBody]
body TableFoot
foot) =
Text
-> (Attr, Caption, [ColSpec], TableHead, [TableBody], TableFoot)
-> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Table" (Attr
attr, Caption
caption, [ColSpec]
aligns, TableHead
hd, [TableBody]
body, TableFoot
foot)
toJSON (Div Attr
attr [Block]
blks) = Text -> (Attr, [Block]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged Text
"Div" (Attr
attr, [Block]
blks)
toJSON Block
Null = Text -> Value
taggedNoContent Text
"Null"
instance FromJSON Pandoc where
parseJSON :: Value -> Parser Pandoc
parseJSON (Object Object
v) = do
Maybe [Int]
mbJVersion <- Object
v Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"pandoc-api-version" :: Aeson.Parser (Maybe [Int])
case Maybe [Int]
mbJVersion of
Just [Int]
jVersion | Int
x : Int
y : [Int]
_ <- [Int]
jVersion
, Int
x' : Int
y' : [Int]
_ <- Version -> [Int]
versionBranch Version
pandocTypesVersion
, Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x'
, Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y' -> Meta -> [Block] -> Pandoc
Pandoc (Meta -> [Block] -> Pandoc)
-> Parser Meta -> Parser ([Block] -> Pandoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Meta
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"meta" Parser ([Block] -> Pandoc) -> Parser [Block] -> Parser Pandoc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Block]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"blocks"
| Bool
otherwise ->
String -> Parser Pandoc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Pandoc) -> String -> Parser Pandoc
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
"Incompatible API versions: "
, String
"encoded with "
, [Int] -> String
forall a. Show a => a -> String
show [Int]
jVersion
, String
" but attempted to decode with "
, [Int] -> String
forall a. Show a => a -> String
show ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
pandocTypesVersion
, String
"."
]
Maybe [Int]
_ -> String -> Parser Pandoc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"JSON missing pandoc-api-version."
parseJSON Value
_ = Parser Pandoc
forall a. Monoid a => a
mempty
instance ToJSON Pandoc where
toJSON :: Pandoc -> Value
toJSON (Pandoc Meta
meta [Block]
blks) =
[Pair] -> Value
object [ Text
"pandoc-api-version" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version -> [Int]
versionBranch Version
pandocTypesVersion
, Text
"meta" Text -> Meta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Meta
meta
, Text
"blocks" Text -> [Block] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Block]
blks
]
instance NFData MetaValue
instance NFData Meta
instance NFData Citation
instance NFData Alignment
instance NFData RowSpan
instance NFData ColSpan
instance NFData Cell
instance NFData Row
instance NFData TableHead
instance NFData TableBody
instance NFData TableFoot
instance NFData Caption
instance NFData Inline
instance NFData MathType
instance NFData Format
instance NFData CitationMode
instance NFData QuoteType
instance NFData ListNumberDelim
instance NFData ListNumberStyle
instance NFData ColWidth
instance NFData RowHeadColumns
instance NFData Block
instance NFData Pandoc
pandocTypesVersion :: Version
pandocTypesVersion :: Version
pandocTypesVersion = Version
version