{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric,
    FlexibleContexts, GeneralizedNewtypeDeriving, PatternGuards, CPP #-}

{-
Copyright (c) 2006-2019, John MacFarlane

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of John MacFarlane nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}

{- |
   Module      : Text.Pandoc.Definition
   Copyright   : Copyright (C) 2006-2019 John MacFarlane
   License     : BSD3

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Definition of 'Pandoc' data structure for format-neutral representation
of documents.
-}
module Text.Pandoc.Definition ( Pandoc(..)
                              , Meta(..)
                              , MetaValue(..)
                              , nullMeta
                              , isNullMeta
                              , lookupMeta
                              , docTitle
                              , docAuthors
                              , docDate
                              , Block(..)
                              , Inline(..)
                              , Alignment(..)
                              , ListAttributes
                              , ListNumberStyle(..)
                              , ListNumberDelim(..)
                              , Format(..)
                              , Attr
                              , nullAttr
                              , TableCell
                              , 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 m1 :: Meta
m1 bs1 :: [Block]
bs1) <> :: Pandoc -> Pandoc -> Pandoc
<> (Pandoc m2 :: Meta
m2 bs2 :: [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
(<>)

-- | Metadata for the document:  title, authors, date.
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 m1 :: Map Text MetaValue
m1) <> :: Meta -> Meta -> Meta
<> (Meta m2 :: 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)
  -- note: M.union is left-biased, so if there are fields in both m2
  -- and m1, m2 wins.
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 m :: Map Text MetaValue
m) = Map Text MetaValue -> Bool
forall k a. Map k a -> Bool
M.null Map Text MetaValue
m

-- Helper functions to extract metadata

-- | Retrieve the metadata value for a given @key@.
lookupMeta :: Text -> Meta -> Maybe MetaValue
lookupMeta :: Text -> Meta -> Maybe MetaValue
lookupMeta key :: Text
key (Meta m :: 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

-- | Extract document title from metadata; works just like the old @docTitle@.
docTitle :: Meta -> [Inline]
docTitle :: Meta -> [Inline]
docTitle meta :: Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta "title" Meta
meta of
         Just (MetaString s :: Text
s)           -> [Text -> Inline
Str Text
s]
         Just (MetaInlines ils :: [Inline]
ils)        -> [Inline]
ils
         Just (MetaBlocks [Plain ils :: [Inline]
ils]) -> [Inline]
ils
         Just (MetaBlocks [Para ils :: [Inline]
ils])  -> [Inline]
ils
         _                             -> []

-- | Extract document authors from metadata; works just like the old
-- @docAuthors@.
docAuthors :: Meta -> [[Inline]]
docAuthors :: Meta -> [[Inline]]
docAuthors meta :: Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta "author" Meta
meta of
        Just (MetaString s :: Text
s)    -> [[Text -> Inline
Str Text
s]]
        Just (MetaInlines ils :: [Inline]
ils) -> [[Inline]
ils]
        Just (MetaList   ms :: [MetaValue]
ms)   -> [[Inline]
ils | MetaInlines ils :: [Inline]
ils <- [MetaValue]
ms] [[Inline]] -> [[Inline]] -> [[Inline]]
forall a. [a] -> [a] -> [a]
++
                                  [[Inline]
ils | MetaBlocks [Plain ils :: [Inline]
ils] <- [MetaValue]
ms] [[Inline]] -> [[Inline]] -> [[Inline]]
forall a. [a] -> [a] -> [a]
++
                                  [[Inline]
ils | MetaBlocks [Para ils :: [Inline]
ils]  <- [MetaValue]
ms] [[Inline]] -> [[Inline]] -> [[Inline]]
forall a. [a] -> [a] -> [a]
++
                                  [[Text -> Inline
Str Text
x] | MetaString x :: Text
x <- [MetaValue]
ms]
        _                      -> []

-- | Extract date from metadata; works just like the old @docDate@.
docDate :: Meta -> [Inline]
docDate :: Meta -> [Inline]
docDate meta :: Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta "date" Meta
meta of
         Just (MetaString s :: Text
s)           -> [Text -> Inline
Str Text
s]
         Just (MetaInlines ils :: [Inline]
ils)        -> [Inline]
ils
         Just (MetaBlocks [Plain ils :: [Inline]
ils]) -> [Inline]
ils
         Just (MetaBlocks [Para ils :: [Inline]
ils])  -> [Inline]
ils
         _                             -> []

-- | Alignment of a table column.
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)

-- | List attributes.  The first element of the triple is the
-- start number of the list.
type ListAttributes = (Int, ListNumberStyle, ListNumberDelim)

-- | Style of list numbers.
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)

-- | Delimiter of list numbers.
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)

-- | Attributes: identifier, classes, key-value pairs
type Attr = (Text, [Text], [(Text, Text)])

nullAttr :: Attr
nullAttr :: Attr
nullAttr = ("",[],[])

-- | Table cells are list of Blocks
type TableCell = [Block]

-- | Formats for raw blocks
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 f :: 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 x :: Text
x == :: Format -> Format -> Bool
== Format y :: 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 x :: Text
x) (Format y :: 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)

-- | Block element.
data Block
    = Plain [Inline]        -- ^ Plain text, not a paragraph
    | Para [Inline]         -- ^ Paragraph
    | LineBlock [[Inline]]  -- ^ Multiple non-breaking lines
    | CodeBlock Attr Text -- ^ Code block (literal) with attributes
    | RawBlock Format Text -- ^ Raw block
    | BlockQuote [Block]    -- ^ Block quote (list of blocks)
    | OrderedList ListAttributes [[Block]] -- ^ Ordered list (attributes
                            -- and a list of items, each a list of blocks)
    | BulletList [[Block]]  -- ^ Bullet list (list of items, each
                            -- a list of blocks)
    | DefinitionList [([Inline],[[Block]])]  -- ^ Definition list
                            -- Each list item is a pair consisting of a
                            -- term (a list of inlines) and one or more
                            -- definitions (each a list of blocks)
    | Header Int Attr [Inline] -- ^ Header - level (integer) and text (inlines)
    | HorizontalRule        -- ^ Horizontal rule
    | Table [Inline] [Alignment] [Double] [TableCell] [[TableCell]]  -- ^ Table,
                            -- with caption, column alignments (required),
                            -- relative column widths (0 = default),
                            -- column headers (each a list of blocks), and
                            -- rows (each a list of lists of blocks)
    | Div Attr [Block]      -- ^ Generic block container with attributes
    | Null                  -- ^ Nothing
    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, Typeable Block
DataType
Constr
Typeable Block =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Block -> c Block)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Block)
-> (Block -> Constr)
-> (Block -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Block))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block))
-> ((forall b. Data b => b -> b) -> Block -> Block)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r)
-> (forall u. (forall d. Data d => d -> u) -> Block -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Block -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> Data Block
Block -> DataType
Block -> Constr
(forall b. Data b => b -> b) -> Block -> Block
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
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) -> Block -> u
forall u. (forall d. Data d => d -> u) -> Block -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
$cNull :: Constr
$cDiv :: Constr
$cTable :: Constr
$cHorizontalRule :: Constr
$cHeader :: Constr
$cDefinitionList :: Constr
$cBulletList :: Constr
$cOrderedList :: Constr
$cBlockQuote :: Constr
$cRawBlock :: Constr
$cCodeBlock :: Constr
$cLineBlock :: Constr
$cPara :: Constr
$cPlain :: Constr
$tBlock :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Block -> m Block
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapMp :: (forall d. Data d => d -> m d) -> Block -> m Block
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapM :: (forall d. Data d => d -> m d) -> Block -> m Block
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapQi :: Int -> (forall d. Data d => d -> u) -> Block -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Block -> u
gmapQ :: (forall d. Data d => d -> u) -> Block -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Block -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
gmapT :: (forall b. Data b => b -> b) -> Block -> Block
$cgmapT :: (forall b. Data b => b -> b) -> Block -> Block
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Block)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
dataTypeOf :: Block -> DataType
$cdataTypeOf :: Block -> DataType
toConstr :: Block -> Constr
$ctoConstr :: Block -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
$cp1Data :: Typeable Block
Data, (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)

-- | Type of quotation marks to use in Quoted inline.
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)

-- | Link target (URL, title).
type Target = (Text, Text)

-- | Type of math element (display or inline).
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)

-- | Inline elements.
data Inline
    = Str Text            -- ^ Text (string)
    | Emph [Inline]         -- ^ Emphasized text (list of inlines)
    | Strong [Inline]       -- ^ Strongly emphasized text (list of inlines)
    | Strikeout [Inline]    -- ^ Strikeout text (list of inlines)
    | Superscript [Inline]  -- ^ Superscripted text (list of inlines)
    | Subscript [Inline]    -- ^ Subscripted text (list of inlines)
    | SmallCaps [Inline]    -- ^ Small caps text (list of inlines)
    | Quoted QuoteType [Inline] -- ^ Quoted text (list of inlines)
    | Cite [Citation]  [Inline] -- ^ Citation (list of inlines)
    | Code Attr Text      -- ^ Inline code (literal)
    | Space                 -- ^ Inter-word space
    | SoftBreak             -- ^ Soft line break
    | LineBreak             -- ^ Hard line break
    | Math MathType Text  -- ^ TeX math (literal)
    | RawInline Format Text -- ^ Raw inline
    | Link Attr [Inline] Target  -- ^ Hyperlink: alt text (list of inlines), target
    | Image Attr [Inline] Target -- ^ Image:  alt text (list of inlines), target
    | Note [Block]          -- ^ Footnote or endnote
    | Span Attr [Inline]    -- ^ Generic inline container with attributes
    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
$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)


-- ToJSON/FromJSON instances. We do this by hand instead of deriving
-- from generics, so we can have more control over the format.

taggedNoContent :: Text -> Value
taggedNoContent :: Text -> Value
taggedNoContent x :: Text
x = [Pair] -> Value
object [ "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 x :: Text
x y :: a
y = [Pair] -> Value
object [ "t" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
x, "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 v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "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
.: "c")
      "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
.: "c")
      "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
.: "c")
      "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
.: "c")
      "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
.: "c")
      "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
.: "c")
      _ -> Parser MetaValue
forall a. Monoid a => a
mempty
  parseJSON _ = Parser MetaValue
forall a. Monoid a => a
mempty
instance ToJSON MetaValue where
  toJSON :: MetaValue -> Value
toJSON (MetaMap mp :: Map Text MetaValue
mp) = Text -> Map Text MetaValue -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "MetaMap" Map Text MetaValue
mp
  toJSON (MetaList lst :: [MetaValue]
lst) = Text -> [MetaValue] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "MetaList" [MetaValue]
lst
  toJSON (MetaBool bool :: Bool
bool) = Text -> Bool -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "MetaBool" Bool
bool
  toJSON (MetaString s :: Text
s) = Text -> Text -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "MetaString" Text
s
  toJSON (MetaInlines ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "MetaInlines" [Inline]
ils
  toJSON (MetaBlocks blks :: [Block]
blks) = Text -> [Block] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "MetaBlocks" [Block]
blks

instance FromJSON Meta where
  parseJSON :: Value -> Parser Meta
parseJSON j :: 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
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 v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "AuthorInText"   -> CitationMode -> Parser CitationMode
forall (m :: * -> *) a. Monad m => a -> m a
return CitationMode
AuthorInText
      "SuppressAuthor" -> CitationMode -> Parser CitationMode
forall (m :: * -> *) a. Monad m => a -> m a
return CitationMode
SuppressAuthor
      "NormalCitation" -> CitationMode -> Parser CitationMode
forall (m :: * -> *) a. Monad m => a -> m a
return CitationMode
NormalCitation
      _ -> Parser CitationMode
forall a. Monoid a => a
mempty
  parseJSON _ = Parser CitationMode
forall a. Monoid a => a
mempty
instance ToJSON CitationMode where
  toJSON :: CitationMode -> Value
toJSON cmode :: CitationMode
cmode = Text -> Value
taggedNoContent Text
s
    where s :: Text
s = case CitationMode
cmode of
            AuthorInText   -> "AuthorInText"
            SuppressAuthor -> "SuppressAuthor"
            NormalCitation -> "NormalCitation"


instance FromJSON Citation where
  parseJSON :: Value -> Parser Citation
parseJSON (Object v :: Object
v) = do
    Text
citationId'      <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "citationId"
    [Inline]
citationPrefix'  <- Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: "citationPrefix"
    [Inline]
citationSuffix'  <- Object
v Object -> Text -> Parser [Inline]
forall a. FromJSON a => Object -> Text -> Parser a
.: "citationSuffix"
    CitationMode
citationMode'    <- Object
v Object -> Text -> Parser CitationMode
forall a. FromJSON a => Object -> Text -> Parser a
.: "citationMode"
    Int
citationNoteNum' <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "citationNoteNum"
    Int
citationHash'    <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 _ = Parser Citation
forall a. Monoid a => a
mempty
instance ToJSON Citation where
  toJSON :: Citation -> Value
toJSON cit :: Citation
cit =
    [Pair] -> Value
object [ "citationId"      Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> Text
citationId Citation
cit
           , "citationPrefix"  Text -> [Inline] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> [Inline]
citationPrefix Citation
cit
           , "citationSuffix"  Text -> [Inline] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> [Inline]
citationSuffix Citation
cit
           , "citationMode"    Text -> CitationMode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> CitationMode
citationMode Citation
cit
           , "citationNoteNum" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Citation -> Int
citationNoteNum Citation
cit
           , "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 v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "SingleQuote" -> QuoteType -> Parser QuoteType
forall (m :: * -> *) a. Monad m => a -> m a
return QuoteType
SingleQuote
      "DoubleQuote" -> QuoteType -> Parser QuoteType
forall (m :: * -> *) a. Monad m => a -> m a
return QuoteType
DoubleQuote
      _                    -> Parser QuoteType
forall a. Monoid a => a
mempty
  parseJSON _ = Parser QuoteType
forall a. Monoid a => a
mempty
instance ToJSON QuoteType where
  toJSON :: QuoteType -> Value
toJSON qtype :: QuoteType
qtype = Text -> Value
taggedNoContent Text
s
    where s :: Text
s = case QuoteType
qtype of
            SingleQuote -> "SingleQuote"
            DoubleQuote -> "DoubleQuote"


instance FromJSON MathType where
  parseJSON :: Value -> Parser MathType
parseJSON (Object v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "DisplayMath" -> MathType -> Parser MathType
forall (m :: * -> *) a. Monad m => a -> m a
return MathType
DisplayMath
      "InlineMath"  -> MathType -> Parser MathType
forall (m :: * -> *) a. Monad m => a -> m a
return MathType
InlineMath
      _                    -> Parser MathType
forall a. Monoid a => a
mempty
  parseJSON _ = Parser MathType
forall a. Monoid a => a
mempty
instance ToJSON MathType where
  toJSON :: MathType -> Value
toJSON mtype :: MathType
mtype = Text -> Value
taggedNoContent Text
s
    where s :: Text
s = case MathType
mtype of
            DisplayMath -> "DisplayMath"
            InlineMath  -> "InlineMath"

instance FromJSON ListNumberStyle where
  parseJSON :: Value -> Parser ListNumberStyle
parseJSON (Object v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "DefaultStyle" -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
DefaultStyle
      "Example"      -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
Example
      "Decimal"      -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
Decimal
      "LowerRoman"   -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
LowerRoman
      "UpperRoman"   -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
UpperRoman
      "LowerAlpha"   -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
LowerAlpha
      "UpperAlpha"   -> ListNumberStyle -> Parser ListNumberStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberStyle
UpperAlpha
      _              -> Parser ListNumberStyle
forall a. Monoid a => a
mempty
  parseJSON _ = Parser ListNumberStyle
forall a. Monoid a => a
mempty
instance ToJSON ListNumberStyle where
  toJSON :: ListNumberStyle -> Value
toJSON lsty :: ListNumberStyle
lsty = Text -> Value
taggedNoContent Text
s
    where s :: Text
s = case ListNumberStyle
lsty of
            DefaultStyle -> "DefaultStyle"
            Example      -> "Example"
            Decimal      -> "Decimal"
            LowerRoman   -> "LowerRoman"
            UpperRoman   -> "UpperRoman"
            LowerAlpha   -> "LowerAlpha"
            UpperAlpha   -> "UpperAlpha"

instance FromJSON ListNumberDelim where
  parseJSON :: Value -> Parser ListNumberDelim
parseJSON (Object v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "DefaultDelim" -> ListNumberDelim -> Parser ListNumberDelim
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberDelim
DefaultDelim
      "Period"       -> ListNumberDelim -> Parser ListNumberDelim
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberDelim
Period
      "OneParen"     -> ListNumberDelim -> Parser ListNumberDelim
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberDelim
OneParen
      "TwoParens"    -> ListNumberDelim -> Parser ListNumberDelim
forall (m :: * -> *) a. Monad m => a -> m a
return ListNumberDelim
TwoParens
      _                     -> Parser ListNumberDelim
forall a. Monoid a => a
mempty
  parseJSON _ = Parser ListNumberDelim
forall a. Monoid a => a
mempty
instance ToJSON ListNumberDelim where
  toJSON :: ListNumberDelim -> Value
toJSON delim :: ListNumberDelim
delim = Text -> Value
taggedNoContent Text
s
    where s :: Text
s = case ListNumberDelim
delim of
            DefaultDelim -> "DefaultDelim"
            Period       -> "Period"
            OneParen     -> "OneParen"
            TwoParens    -> "TwoParens"

instance FromJSON Alignment where
  parseJSON :: Value -> Parser Alignment
parseJSON (Object v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "AlignLeft"    -> Alignment -> Parser Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment
AlignLeft
      "AlignRight"   -> Alignment -> Parser Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment
AlignRight
      "AlignCenter"  -> Alignment -> Parser Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment
AlignCenter
      "AlignDefault" -> Alignment -> Parser Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment
AlignDefault
      _                     -> Parser Alignment
forall a. Monoid a => a
mempty
  parseJSON _ = Parser Alignment
forall a. Monoid a => a
mempty
instance ToJSON Alignment where
  toJSON :: Alignment -> Value
toJSON delim :: Alignment
delim = Text -> Value
taggedNoContent Text
s
    where s :: Text
s = case Alignment
delim of
            AlignLeft    -> "AlignLeft"
            AlignRight   -> "AlignRight"
            AlignCenter  -> "AlignCenter"
            AlignDefault -> "AlignDefault"


instance FromJSON Inline where
  parseJSON :: Value -> Parser Inline
parseJSON (Object v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "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
.: "c"
      "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
.: "c"
      "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
.: "c"
      "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
.: "c"
      "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
.: "c"
      "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
.: "c"
      "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
.: "c"
      "Quoted"      -> do (qt :: QuoteType
qt, ils :: [Inline]
ils) <- Object
v Object -> Text -> Parser (QuoteType, [Inline])
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "Cite"        -> do (cits :: [Citation]
cits, ils :: [Inline]
ils) <- Object
v Object -> Text -> Parser ([Citation], [Inline])
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "Code"        -> do (attr :: Attr
attr, s :: Text
s) <- Object
v Object -> Text -> Parser (Attr, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "Space"       -> Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
Space
      "SoftBreak"   -> Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
SoftBreak
      "LineBreak"   -> Inline -> Parser Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
LineBreak
      "Math"        -> do (mtype :: MathType
mtype, s :: Text
s) <- Object
v Object -> Text -> Parser (MathType, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "RawInline"   -> do (fmt :: Format
fmt, s :: Text
s) <- Object
v Object -> Text -> Parser (Format, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "Link"        -> do (attr :: Attr
attr, ils :: [Inline]
ils, tgt :: Target
tgt) <- Object
v Object -> Text -> Parser (Attr, [Inline], Target)
forall a. FromJSON a => Object -> Text -> Parser a
.: "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] -> Target -> Inline
Link Attr
attr [Inline]
ils Target
tgt
      "Image"       -> do (attr :: Attr
attr, ils :: [Inline]
ils, tgt :: Target
tgt) <- Object
v Object -> Text -> Parser (Attr, [Inline], Target)
forall a. FromJSON a => Object -> Text -> Parser a
.: "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] -> Target -> Inline
Image Attr
attr [Inline]
ils Target
tgt
      "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
.: "c"
      "Span"        -> do (attr :: Attr
attr, ils :: [Inline]
ils) <- Object
v Object -> Text -> Parser (Attr, [Inline])
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      _ -> Parser Inline
forall a. Monoid a => a
mempty
  parseJSON _ = Parser Inline
forall a. Monoid a => a
mempty

instance ToJSON Inline where
  toJSON :: Inline -> Value
toJSON (Str s :: Text
s) = Text -> Text -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Str" Text
s
  toJSON (Emph ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Emph" [Inline]
ils
  toJSON (Strong ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Strong" [Inline]
ils
  toJSON (Strikeout ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Strikeout" [Inline]
ils
  toJSON (Superscript ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Superscript" [Inline]
ils
  toJSON (Subscript ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Subscript" [Inline]
ils
  toJSON (SmallCaps ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "SmallCaps" [Inline]
ils
  toJSON (Quoted qtype :: QuoteType
qtype ils :: [Inline]
ils) = Text -> (QuoteType, [Inline]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Quoted" (QuoteType
qtype, [Inline]
ils)
  toJSON (Cite cits :: [Citation]
cits ils :: [Inline]
ils) = Text -> ([Citation], [Inline]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Cite" ([Citation]
cits, [Inline]
ils)
  toJSON (Code attr :: Attr
attr s :: Text
s) = Text -> (Attr, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Code" (Attr
attr, Text
s)
  toJSON Space = Text -> Value
taggedNoContent "Space"
  toJSON SoftBreak = Text -> Value
taggedNoContent "SoftBreak"
  toJSON LineBreak = Text -> Value
taggedNoContent "LineBreak"
  toJSON (Math mtype :: MathType
mtype s :: Text
s) = Text -> (MathType, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Math" (MathType
mtype, Text
s)
  toJSON (RawInline fmt :: Format
fmt s :: Text
s) = Text -> (Format, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "RawInline" (Format
fmt, Text
s)
  toJSON (Link attr :: Attr
attr ils :: [Inline]
ils target :: Target
target) = Text -> (Attr, [Inline], Target) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Link" (Attr
attr, [Inline]
ils, Target
target)
  toJSON (Image attr :: Attr
attr ils :: [Inline]
ils target :: Target
target) = Text -> (Attr, [Inline], Target) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Image" (Attr
attr, [Inline]
ils, Target
target)
  toJSON (Note blks :: [Block]
blks) = Text -> [Block] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Note" [Block]
blks
  toJSON (Span attr :: Attr
attr ils :: [Inline]
ils) = Text -> (Attr, [Inline]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Span" (Attr
attr, [Inline]
ils)

instance FromJSON Block where
  parseJSON :: Value -> Parser Block
parseJSON (Object v :: Object
v) = do
    Value
t <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "t" :: Aeson.Parser Value
    case Value
t of
      "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
.: "c"
      "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
.: "c"
      "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
.: "c"
      "CodeBlock"      -> do (attr :: Attr
attr, s :: Text
s) <- Object
v Object -> Text -> Parser (Attr, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "RawBlock"       -> do (fmt :: Format
fmt, s :: Text
s) <- Object
v Object -> Text -> Parser (Format, Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "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
.: "c"
      "OrderedList"    -> do (attr :: ListAttributes
attr, items :: [[Block]]
items) <- Object
v Object -> Text -> Parser (ListAttributes, [[Block]])
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "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
.: "c"
      "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
.: "c"
      "Header"         -> do (n :: Int
n, attr :: Attr
attr, ils :: [Inline]
ils) <- Object
v Object -> Text -> Parser (Int, Attr, [Inline])
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "HorizontalRule" -> Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
HorizontalRule
      "Table"          -> do (cpt :: [Inline]
cpt, align :: [Alignment]
align, wdths :: [Double]
wdths, hdr :: [[Block]]
hdr, rows :: [[[Block]]]
rows) <- Object
v Object
-> Text
-> Parser ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
$ [Inline]
-> [Alignment] -> [Double] -> [[Block]] -> [[[Block]]] -> Block
Table [Inline]
cpt [Alignment]
align [Double]
wdths [[Block]]
hdr [[[Block]]]
rows
      "Div"            -> do (attr :: Attr
attr, blks :: [Block]
blks) <- Object
v Object -> Text -> Parser (Attr, [Block])
forall a. FromJSON a => Object -> Text -> Parser a
.: "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
      "Null"           -> Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
Null
      _                -> Parser Block
forall a. Monoid a => a
mempty
  parseJSON _ = Parser Block
forall a. Monoid a => a
mempty
instance ToJSON Block where
  toJSON :: Block -> Value
toJSON (Plain ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Plain" [Inline]
ils
  toJSON (Para ils :: [Inline]
ils) = Text -> [Inline] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Para" [Inline]
ils
  toJSON (LineBlock lns :: [[Inline]]
lns) = Text -> [[Inline]] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "LineBlock" [[Inline]]
lns
  toJSON (CodeBlock attr :: Attr
attr s :: Text
s) = Text -> (Attr, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "CodeBlock" (Attr
attr, Text
s)
  toJSON (RawBlock fmt :: Format
fmt s :: Text
s) = Text -> (Format, Text) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "RawBlock" (Format
fmt, Text
s)
  toJSON (BlockQuote blks :: [Block]
blks) = Text -> [Block] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "BlockQuote" [Block]
blks
  toJSON (OrderedList listAttrs :: ListAttributes
listAttrs blksList :: [[Block]]
blksList) = Text -> (ListAttributes, [[Block]]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "OrderedList" (ListAttributes
listAttrs, [[Block]]
blksList)
  toJSON (BulletList blksList :: [[Block]]
blksList) = Text -> [[Block]] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "BulletList" [[Block]]
blksList
  toJSON (DefinitionList defs :: [([Inline], [[Block]])]
defs) = Text -> [([Inline], [[Block]])] -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "DefinitionList" [([Inline], [[Block]])]
defs
  toJSON (Header n :: Int
n attr :: Attr
attr ils :: [Inline]
ils) = Text -> (Int, Attr, [Inline]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Header" (Int
n, Attr
attr, [Inline]
ils)
  toJSON HorizontalRule = Text -> Value
taggedNoContent "HorizontalRule"
  toJSON (Table caption :: [Inline]
caption aligns :: [Alignment]
aligns widths :: [Double]
widths cells :: [[Block]]
cells rows :: [[[Block]]]
rows) =
    Text
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
-> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Table" ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
cells, [[[Block]]]
rows)
  toJSON (Div attr :: Attr
attr blks :: [Block]
blks) = Text -> (Attr, [Block]) -> Value
forall a. ToJSON a => Text -> a -> Value
tagged "Div" (Attr
attr, [Block]
blks)
  toJSON Null = Text -> Value
taggedNoContent "Null"

instance FromJSON Pandoc where
  parseJSON :: Value -> Parser Pandoc
parseJSON (Object v :: Object
v) = do
    Maybe [Int]
mbJVersion <- Object
v Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "pandoc-api-version" :: Aeson.Parser (Maybe [Int])
    case Maybe [Int]
mbJVersion of
      Just jVersion :: [Int]
jVersion  | x :: Int
x : y :: Int
y : _ <- [Int]
jVersion
                     , x' :: Int
x' : y' :: Int
y' : _ <- 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
.: "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
.: "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 [ "Incompatible API versions: "
                                        , "encoded with "
                                        , [Int] -> String
forall a. Show a => a -> String
show [Int]
jVersion
                                        , " 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 -> Parser Pandoc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "JSON missing pandoc-api-version."
  parseJSON _ = Parser Pandoc
forall a. Monoid a => a
mempty
instance ToJSON Pandoc where
  toJSON :: Pandoc -> Value
toJSON (Pandoc meta :: Meta
meta blks :: [Block]
blks) =
    [Pair] -> Value
object [ "pandoc-api-version" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version -> [Int]
versionBranch Version
pandocTypesVersion
           , "meta"               Text -> Meta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Meta
meta
           , "blocks"             Text -> [Block] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Block]
blks
           ]

-- Instances for deepseq
instance NFData MetaValue
instance NFData Meta
instance NFData Citation
instance NFData Alignment
instance NFData Inline
instance NFData MathType
instance NFData Format
instance NFData CitationMode
instance NFData QuoteType
instance NFData ListNumberDelim
instance NFData ListNumberStyle
instance NFData Block
instance NFData Pandoc

pandocTypesVersion :: Version
pandocTypesVersion :: Version
pandocTypesVersion = Version
version