{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{- |
   Module      : Text.Pandoc.Options
   Copyright   : Copyright (C) 2012-2022 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Data structures and functions for representing parser and writer
options.
-}
module Text.Pandoc.Options ( module Text.Pandoc.Extensions
                           , ReaderOptions(..)
                           , HTMLMathMethod (..)
                           , CiteMethod (..)
                           , ObfuscationMethod (..)
                           , HTMLSlideVariant (..)
                           , EPUBVersion (..)
                           , WrapOption (..)
                           , TopLevelDivision (..)
                           , WriterOptions (..)
                           , TrackChanges (..)
                           , ReferenceLocation (..)
                           , def
                           , isEnabled
                           , defaultMathJaxURL
                           , defaultKaTeXURL
                           ) where
import Control.Applicative ((<|>))
import Data.Maybe (fromMaybe)
import Data.Data (Data)
import Data.Default
import Data.Char (toLower)
import Data.Text (Text)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Skylighting (SyntaxMap, defaultSyntaxMap)
import Text.DocTemplates (Context(..), Template)
import Text.Pandoc.Extensions
import Text.Pandoc.Highlighting (Style, pygments)
import Text.Pandoc.UTF8 (toStringLazy)
import Data.Aeson.TH (deriveJSON)
import Data.Aeson

class HasSyntaxExtensions a where
  getExtensions :: a -> Extensions

data ReaderOptions = ReaderOptions{
         ReaderOptions -> Extensions
readerExtensions            :: Extensions  -- ^ Syntax extensions
       , ReaderOptions -> Bool
readerStandalone            :: Bool -- ^ Standalone document with header
       , ReaderOptions -> Int
readerColumns               :: Int  -- ^ Number of columns in terminal
       , ReaderOptions -> Int
readerTabStop               :: Int  -- ^ Tab stop
       , ReaderOptions -> [Text]
readerIndentedCodeClasses   :: [Text] -- ^ Default classes for
                                       -- indented code blocks
       , ReaderOptions -> Set Text
readerAbbreviations         :: Set.Set Text -- ^ Strings to treat as abbreviations
       , ReaderOptions -> Text
readerDefaultImageExtension :: Text -- ^ Default extension for images
       , ReaderOptions -> TrackChanges
readerTrackChanges          :: TrackChanges -- ^ Track changes setting for docx
       , ReaderOptions -> Bool
readerStripComments         :: Bool -- ^ Strip HTML comments instead of parsing as raw HTML
                                             -- (only implemented in commonmark)
} deriving (Int -> ReaderOptions -> ShowS
[ReaderOptions] -> ShowS
ReaderOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReaderOptions] -> ShowS
$cshowList :: [ReaderOptions] -> ShowS
show :: ReaderOptions -> String
$cshow :: ReaderOptions -> String
showsPrec :: Int -> ReaderOptions -> ShowS
$cshowsPrec :: Int -> ReaderOptions -> ShowS
Show, ReadPrec [ReaderOptions]
ReadPrec ReaderOptions
Int -> ReadS ReaderOptions
ReadS [ReaderOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReaderOptions]
$creadListPrec :: ReadPrec [ReaderOptions]
readPrec :: ReadPrec ReaderOptions
$creadPrec :: ReadPrec ReaderOptions
readList :: ReadS [ReaderOptions]
$creadList :: ReadS [ReaderOptions]
readsPrec :: Int -> ReadS ReaderOptions
$creadsPrec :: Int -> ReadS ReaderOptions
Read, Typeable ReaderOptions
ReaderOptions -> DataType
ReaderOptions -> Constr
(forall b. Data b => b -> b) -> ReaderOptions -> ReaderOptions
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) -> ReaderOptions -> u
forall u. (forall d. Data d => d -> u) -> ReaderOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReaderOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReaderOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ReaderOptions -> m ReaderOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReaderOptions -> m ReaderOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReaderOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReaderOptions -> c ReaderOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReaderOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReaderOptions)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReaderOptions -> m ReaderOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReaderOptions -> m ReaderOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReaderOptions -> m ReaderOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReaderOptions -> m ReaderOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ReaderOptions -> m ReaderOptions
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ReaderOptions -> m ReaderOptions
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ReaderOptions -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ReaderOptions -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ReaderOptions -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ReaderOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReaderOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReaderOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReaderOptions -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReaderOptions -> r
gmapT :: (forall b. Data b => b -> b) -> ReaderOptions -> ReaderOptions
$cgmapT :: (forall b. Data b => b -> b) -> ReaderOptions -> ReaderOptions
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReaderOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReaderOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReaderOptions)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReaderOptions)
dataTypeOf :: ReaderOptions -> DataType
$cdataTypeOf :: ReaderOptions -> DataType
toConstr :: ReaderOptions -> Constr
$ctoConstr :: ReaderOptions -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReaderOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReaderOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReaderOptions -> c ReaderOptions
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReaderOptions -> c ReaderOptions
Data, Typeable, forall x. Rep ReaderOptions x -> ReaderOptions
forall x. ReaderOptions -> Rep ReaderOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReaderOptions x -> ReaderOptions
$cfrom :: forall x. ReaderOptions -> Rep ReaderOptions x
Generic)

instance HasSyntaxExtensions ReaderOptions where
  getExtensions :: ReaderOptions -> Extensions
getExtensions ReaderOptions
opts = ReaderOptions -> Extensions
readerExtensions ReaderOptions
opts

instance Default ReaderOptions
  where def :: ReaderOptions
def = ReaderOptions{
                 readerExtensions :: Extensions
readerExtensions            = Extensions
emptyExtensions
               , readerStandalone :: Bool
readerStandalone            = Bool
False
               , readerColumns :: Int
readerColumns               = Int
80
               , readerTabStop :: Int
readerTabStop               = Int
4
               , readerIndentedCodeClasses :: [Text]
readerIndentedCodeClasses   = []
               , readerAbbreviations :: Set Text
readerAbbreviations         = Set Text
defaultAbbrevs
               , readerDefaultImageExtension :: Text
readerDefaultImageExtension = Text
""
               , readerTrackChanges :: TrackChanges
readerTrackChanges          = TrackChanges
AcceptChanges
               , readerStripComments :: Bool
readerStripComments         = Bool
False
               }

defaultAbbrevs :: Set.Set Text
defaultAbbrevs :: Set Text
defaultAbbrevs = forall a. Ord a => [a] -> Set a
Set.fromList
                 [ Text
"Mr.", Text
"Mrs.", Text
"Ms.", Text
"Capt.", Text
"Dr.", Text
"Prof.",
                   Text
"Gen.", Text
"Gov.", Text
"e.g.", Text
"i.e.", Text
"Sgt.", Text
"St.",
                   Text
"vol.", Text
"vs.", Text
"Sen.", Text
"Rep.", Text
"Pres.", Text
"Hon.",
                   Text
"Rev.", Text
"Ph.D.", Text
"M.D.", Text
"M.A.", Text
"p.", Text
"pp.",
                   Text
"ch.", Text
"sec.", Text
"cf.", Text
"cp."]

--
-- Writer options
--

data EPUBVersion = EPUB2 | EPUB3 deriving (EPUBVersion -> EPUBVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EPUBVersion -> EPUBVersion -> Bool
$c/= :: EPUBVersion -> EPUBVersion -> Bool
== :: EPUBVersion -> EPUBVersion -> Bool
$c== :: EPUBVersion -> EPUBVersion -> Bool
Eq, Int -> EPUBVersion -> ShowS
[EPUBVersion] -> ShowS
EPUBVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EPUBVersion] -> ShowS
$cshowList :: [EPUBVersion] -> ShowS
show :: EPUBVersion -> String
$cshow :: EPUBVersion -> String
showsPrec :: Int -> EPUBVersion -> ShowS
$cshowsPrec :: Int -> EPUBVersion -> ShowS
Show, ReadPrec [EPUBVersion]
ReadPrec EPUBVersion
Int -> ReadS EPUBVersion
ReadS [EPUBVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EPUBVersion]
$creadListPrec :: ReadPrec [EPUBVersion]
readPrec :: ReadPrec EPUBVersion
$creadPrec :: ReadPrec EPUBVersion
readList :: ReadS [EPUBVersion]
$creadList :: ReadS [EPUBVersion]
readsPrec :: Int -> ReadS EPUBVersion
$creadsPrec :: Int -> ReadS EPUBVersion
Read, Typeable EPUBVersion
EPUBVersion -> DataType
EPUBVersion -> Constr
(forall b. Data b => b -> b) -> EPUBVersion -> EPUBVersion
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) -> EPUBVersion -> u
forall u. (forall d. Data d => d -> u) -> EPUBVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EPUBVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EPUBVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EPUBVersion -> m EPUBVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EPUBVersion -> m EPUBVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EPUBVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EPUBVersion -> c EPUBVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EPUBVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EPUBVersion)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EPUBVersion -> m EPUBVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EPUBVersion -> m EPUBVersion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EPUBVersion -> m EPUBVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EPUBVersion -> m EPUBVersion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EPUBVersion -> m EPUBVersion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EPUBVersion -> m EPUBVersion
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EPUBVersion -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EPUBVersion -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EPUBVersion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EPUBVersion -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EPUBVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EPUBVersion -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EPUBVersion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EPUBVersion -> r
gmapT :: (forall b. Data b => b -> b) -> EPUBVersion -> EPUBVersion
$cgmapT :: (forall b. Data b => b -> b) -> EPUBVersion -> EPUBVersion
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EPUBVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EPUBVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EPUBVersion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EPUBVersion)
dataTypeOf :: EPUBVersion -> DataType
$cdataTypeOf :: EPUBVersion -> DataType
toConstr :: EPUBVersion -> Constr
$ctoConstr :: EPUBVersion -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EPUBVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EPUBVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EPUBVersion -> c EPUBVersion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EPUBVersion -> c EPUBVersion
Data, Typeable, forall x. Rep EPUBVersion x -> EPUBVersion
forall x. EPUBVersion -> Rep EPUBVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EPUBVersion x -> EPUBVersion
$cfrom :: forall x. EPUBVersion -> Rep EPUBVersion x
Generic)

data HTMLMathMethod = PlainMath
                    | WebTeX Text               -- url of TeX->image script.
                    | GladTeX
                    | MathML
                    | MathJax Text              -- url of MathJax.js
                    | KaTeX Text                -- url of KaTeX files
                    deriving (Int -> HTMLMathMethod -> ShowS
[HTMLMathMethod] -> ShowS
HTMLMathMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTMLMathMethod] -> ShowS
$cshowList :: [HTMLMathMethod] -> ShowS
show :: HTMLMathMethod -> String
$cshow :: HTMLMathMethod -> String
showsPrec :: Int -> HTMLMathMethod -> ShowS
$cshowsPrec :: Int -> HTMLMathMethod -> ShowS
Show, ReadPrec [HTMLMathMethod]
ReadPrec HTMLMathMethod
Int -> ReadS HTMLMathMethod
ReadS [HTMLMathMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HTMLMathMethod]
$creadListPrec :: ReadPrec [HTMLMathMethod]
readPrec :: ReadPrec HTMLMathMethod
$creadPrec :: ReadPrec HTMLMathMethod
readList :: ReadS [HTMLMathMethod]
$creadList :: ReadS [HTMLMathMethod]
readsPrec :: Int -> ReadS HTMLMathMethod
$creadsPrec :: Int -> ReadS HTMLMathMethod
Read, HTMLMathMethod -> HTMLMathMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTMLMathMethod -> HTMLMathMethod -> Bool
$c/= :: HTMLMathMethod -> HTMLMathMethod -> Bool
== :: HTMLMathMethod -> HTMLMathMethod -> Bool
$c== :: HTMLMathMethod -> HTMLMathMethod -> Bool
Eq, Typeable HTMLMathMethod
HTMLMathMethod -> DataType
HTMLMathMethod -> Constr
(forall b. Data b => b -> b) -> HTMLMathMethod -> HTMLMathMethod
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) -> HTMLMathMethod -> u
forall u. (forall d. Data d => d -> u) -> HTMLMathMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLMathMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLMathMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HTMLMathMethod -> m HTMLMathMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLMathMethod -> m HTMLMathMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HTMLMathMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HTMLMathMethod -> c HTMLMathMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HTMLMathMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HTMLMathMethod)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLMathMethod -> m HTMLMathMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLMathMethod -> m HTMLMathMethod
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLMathMethod -> m HTMLMathMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLMathMethod -> m HTMLMathMethod
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HTMLMathMethod -> m HTMLMathMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HTMLMathMethod -> m HTMLMathMethod
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HTMLMathMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HTMLMathMethod -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HTMLMathMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HTMLMathMethod -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLMathMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLMathMethod -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLMathMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLMathMethod -> r
gmapT :: (forall b. Data b => b -> b) -> HTMLMathMethod -> HTMLMathMethod
$cgmapT :: (forall b. Data b => b -> b) -> HTMLMathMethod -> HTMLMathMethod
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HTMLMathMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HTMLMathMethod)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HTMLMathMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HTMLMathMethod)
dataTypeOf :: HTMLMathMethod -> DataType
$cdataTypeOf :: HTMLMathMethod -> DataType
toConstr :: HTMLMathMethod -> Constr
$ctoConstr :: HTMLMathMethod -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HTMLMathMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HTMLMathMethod
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HTMLMathMethod -> c HTMLMathMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HTMLMathMethod -> c HTMLMathMethod
Data, Typeable, forall x. Rep HTMLMathMethod x -> HTMLMathMethod
forall x. HTMLMathMethod -> Rep HTMLMathMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HTMLMathMethod x -> HTMLMathMethod
$cfrom :: forall x. HTMLMathMethod -> Rep HTMLMathMethod x
Generic)

instance FromJSON HTMLMathMethod where
   parseJSON :: Value -> Parser HTMLMathMethod
parseJSON Value
node =
     (forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HTMLMathMethod" forall a b. (a -> b) -> a -> b
$ \Object
m -> do
        Text
method <- Object
m forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        Maybe Text
mburl <- Object
m forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"
        case Text
method :: Text of
          Text
"plain" -> forall (m :: * -> *) a. Monad m => a -> m a
return HTMLMathMethod
PlainMath
          Text
"webtex" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> HTMLMathMethod
WebTeX forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mburl
          Text
"gladtex" -> forall (m :: * -> *) a. Monad m => a -> m a
return HTMLMathMethod
GladTeX
          Text
"mathml" -> forall (m :: * -> *) a. Monad m => a -> m a
return HTMLMathMethod
MathML
          Text
"mathjax" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> HTMLMathMethod
MathJax forall a b. (a -> b) -> a -> b
$
                         forall a. a -> Maybe a -> a
fromMaybe Text
defaultMathJaxURL Maybe Text
mburl
          Text
"katex" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> HTMLMathMethod
KaTeX forall a b. (a -> b) -> a -> b
$
                         forall a. a -> Maybe a -> a
fromMaybe Text
defaultKaTeXURL Maybe Text
mburl
          Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown HTML math method " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
method) Value
node
       forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (case Value
node of
               String Text
"plain" -> forall (m :: * -> *) a. Monad m => a -> m a
return HTMLMathMethod
PlainMath
               String Text
"webtex" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> HTMLMathMethod
WebTeX Text
""
               String Text
"gladtex" -> forall (m :: * -> *) a. Monad m => a -> m a
return HTMLMathMethod
GladTeX
               String Text
"mathml" -> forall (m :: * -> *) a. Monad m => a -> m a
return HTMLMathMethod
MathML
               String Text
"mathjax" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> HTMLMathMethod
MathJax Text
defaultMathJaxURL
               String Text
"katex" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> HTMLMathMethod
KaTeX Text
defaultKaTeXURL
               Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown HTML math method " forall a. Semigroup a => a -> a -> a
<>
                             ByteString -> String
toStringLazy (forall a. ToJSON a => a -> ByteString
encode Value
node))

instance ToJSON HTMLMathMethod where
  toJSON :: HTMLMathMethod -> Value
toJSON HTMLMathMethod
PlainMath = Text -> Value
String Text
"plain"
  toJSON (WebTeX Text
"") = Text -> Value
String Text
"webtex"
  toJSON (WebTeX Text
url) = [Pair] -> Value
object [Key
"method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"webtex",
                                Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
url]
  toJSON HTMLMathMethod
GladTeX = Text -> Value
String Text
"gladtex"
  toJSON HTMLMathMethod
MathML = Text -> Value
String Text
"mathml"
  toJSON (MathJax Text
"") = Text -> Value
String Text
"mathjax"
  toJSON (MathJax Text
url) = [Pair] -> Value
object [Key
"method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"mathjax",
                                 Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
url]
  toJSON (KaTeX Text
"") = Text -> Value
String Text
"katex"
  toJSON (KaTeX Text
url) = [Pair] -> Value
object [Key
"method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"katex",
                               Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
url]

data CiteMethod = Citeproc                        -- use citeproc to render them
                  | Natbib                        -- output natbib cite commands
                  | Biblatex                      -- output biblatex cite commands
                deriving (Int -> CiteMethod -> ShowS
[CiteMethod] -> ShowS
CiteMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CiteMethod] -> ShowS
$cshowList :: [CiteMethod] -> ShowS
show :: CiteMethod -> String
$cshow :: CiteMethod -> String
showsPrec :: Int -> CiteMethod -> ShowS
$cshowsPrec :: Int -> CiteMethod -> ShowS
Show, ReadPrec [CiteMethod]
ReadPrec CiteMethod
Int -> ReadS CiteMethod
ReadS [CiteMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CiteMethod]
$creadListPrec :: ReadPrec [CiteMethod]
readPrec :: ReadPrec CiteMethod
$creadPrec :: ReadPrec CiteMethod
readList :: ReadS [CiteMethod]
$creadList :: ReadS [CiteMethod]
readsPrec :: Int -> ReadS CiteMethod
$creadsPrec :: Int -> ReadS CiteMethod
Read, CiteMethod -> CiteMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CiteMethod -> CiteMethod -> Bool
$c/= :: CiteMethod -> CiteMethod -> Bool
== :: CiteMethod -> CiteMethod -> Bool
$c== :: CiteMethod -> CiteMethod -> Bool
Eq, Typeable CiteMethod
CiteMethod -> DataType
CiteMethod -> Constr
(forall b. Data b => b -> b) -> CiteMethod -> CiteMethod
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) -> CiteMethod -> u
forall u. (forall d. Data d => d -> u) -> CiteMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CiteMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CiteMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CiteMethod -> m CiteMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteMethod -> m CiteMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CiteMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CiteMethod -> c CiteMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CiteMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CiteMethod)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteMethod -> m CiteMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteMethod -> m CiteMethod
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteMethod -> m CiteMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteMethod -> m CiteMethod
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CiteMethod -> m CiteMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CiteMethod -> m CiteMethod
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CiteMethod -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CiteMethod -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CiteMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CiteMethod -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CiteMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CiteMethod -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CiteMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CiteMethod -> r
gmapT :: (forall b. Data b => b -> b) -> CiteMethod -> CiteMethod
$cgmapT :: (forall b. Data b => b -> b) -> CiteMethod -> CiteMethod
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CiteMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CiteMethod)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CiteMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CiteMethod)
dataTypeOf :: CiteMethod -> DataType
$cdataTypeOf :: CiteMethod -> DataType
toConstr :: CiteMethod -> Constr
$ctoConstr :: CiteMethod -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CiteMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CiteMethod
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CiteMethod -> c CiteMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CiteMethod -> c CiteMethod
Data, Typeable, forall x. Rep CiteMethod x -> CiteMethod
forall x. CiteMethod -> Rep CiteMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CiteMethod x -> CiteMethod
$cfrom :: forall x. CiteMethod -> Rep CiteMethod x
Generic)

instance FromJSON CiteMethod where
  parseJSON :: Value -> Parser CiteMethod
parseJSON Value
v =
    case Value
v of
      String Text
"citeproc" -> forall (m :: * -> *) a. Monad m => a -> m a
return CiteMethod
Citeproc
      String Text
"natbib"   -> forall (m :: * -> *) a. Monad m => a -> m a
return CiteMethod
Natbib
      String Text
"biblatex" -> forall (m :: * -> *) a. Monad m => a -> m a
return CiteMethod
Biblatex
      Value
_                 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown citation method: " forall a. Semigroup a => a -> a -> a
<>
                                    ByteString -> String
toStringLazy (forall a. ToJSON a => a -> ByteString
encode Value
v)

instance ToJSON CiteMethod where
  toJSON :: CiteMethod -> Value
toJSON CiteMethod
Citeproc = Text -> Value
String Text
"citeproc"
  toJSON CiteMethod
Natbib = Text -> Value
String Text
"natbib"
  toJSON CiteMethod
Biblatex = Text -> Value
String Text
"biblatex"

-- | Methods for obfuscating email addresses in HTML.
data ObfuscationMethod = NoObfuscation
                       | ReferenceObfuscation
                       | JavascriptObfuscation
                       deriving (Int -> ObfuscationMethod -> ShowS
[ObfuscationMethod] -> ShowS
ObfuscationMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObfuscationMethod] -> ShowS
$cshowList :: [ObfuscationMethod] -> ShowS
show :: ObfuscationMethod -> String
$cshow :: ObfuscationMethod -> String
showsPrec :: Int -> ObfuscationMethod -> ShowS
$cshowsPrec :: Int -> ObfuscationMethod -> ShowS
Show, ReadPrec [ObfuscationMethod]
ReadPrec ObfuscationMethod
Int -> ReadS ObfuscationMethod
ReadS [ObfuscationMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ObfuscationMethod]
$creadListPrec :: ReadPrec [ObfuscationMethod]
readPrec :: ReadPrec ObfuscationMethod
$creadPrec :: ReadPrec ObfuscationMethod
readList :: ReadS [ObfuscationMethod]
$creadList :: ReadS [ObfuscationMethod]
readsPrec :: Int -> ReadS ObfuscationMethod
$creadsPrec :: Int -> ReadS ObfuscationMethod
Read, ObfuscationMethod -> ObfuscationMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObfuscationMethod -> ObfuscationMethod -> Bool
$c/= :: ObfuscationMethod -> ObfuscationMethod -> Bool
== :: ObfuscationMethod -> ObfuscationMethod -> Bool
$c== :: ObfuscationMethod -> ObfuscationMethod -> Bool
Eq, Typeable ObfuscationMethod
ObfuscationMethod -> DataType
ObfuscationMethod -> Constr
(forall b. Data b => b -> b)
-> ObfuscationMethod -> ObfuscationMethod
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) -> ObfuscationMethod -> u
forall u. (forall d. Data d => d -> u) -> ObfuscationMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObfuscationMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObfuscationMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObfuscationMethod -> m ObfuscationMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObfuscationMethod -> m ObfuscationMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObfuscationMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObfuscationMethod -> c ObfuscationMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObfuscationMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObfuscationMethod)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObfuscationMethod -> m ObfuscationMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObfuscationMethod -> m ObfuscationMethod
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObfuscationMethod -> m ObfuscationMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObfuscationMethod -> m ObfuscationMethod
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObfuscationMethod -> m ObfuscationMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObfuscationMethod -> m ObfuscationMethod
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ObfuscationMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ObfuscationMethod -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ObfuscationMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ObfuscationMethod -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObfuscationMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObfuscationMethod -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObfuscationMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObfuscationMethod -> r
gmapT :: (forall b. Data b => b -> b)
-> ObfuscationMethod -> ObfuscationMethod
$cgmapT :: (forall b. Data b => b -> b)
-> ObfuscationMethod -> ObfuscationMethod
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObfuscationMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObfuscationMethod)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObfuscationMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObfuscationMethod)
dataTypeOf :: ObfuscationMethod -> DataType
$cdataTypeOf :: ObfuscationMethod -> DataType
toConstr :: ObfuscationMethod -> Constr
$ctoConstr :: ObfuscationMethod -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObfuscationMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObfuscationMethod
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObfuscationMethod -> c ObfuscationMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObfuscationMethod -> c ObfuscationMethod
Data, Typeable, forall x. Rep ObfuscationMethod x -> ObfuscationMethod
forall x. ObfuscationMethod -> Rep ObfuscationMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObfuscationMethod x -> ObfuscationMethod
$cfrom :: forall x. ObfuscationMethod -> Rep ObfuscationMethod x
Generic)

instance FromJSON ObfuscationMethod where
  parseJSON :: Value -> Parser ObfuscationMethod
parseJSON Value
v =
    case Value
v of
      String Text
"none"       -> forall (m :: * -> *) a. Monad m => a -> m a
return ObfuscationMethod
NoObfuscation
      String Text
"references" -> forall (m :: * -> *) a. Monad m => a -> m a
return ObfuscationMethod
ReferenceObfuscation
      String Text
"javascript" -> forall (m :: * -> *) a. Monad m => a -> m a
return ObfuscationMethod
JavascriptObfuscation
      Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown obfuscation method " forall a. [a] -> [a] -> [a]
++ ByteString -> String
toStringLazy (forall a. ToJSON a => a -> ByteString
encode Value
v)

instance ToJSON ObfuscationMethod where
   toJSON :: ObfuscationMethod -> Value
toJSON ObfuscationMethod
NoObfuscation = Text -> Value
String Text
"none"
   toJSON ObfuscationMethod
ReferenceObfuscation = Text -> Value
String Text
"references"
   toJSON ObfuscationMethod
JavascriptObfuscation = Text -> Value
String Text
"javascript"

-- | Varieties of HTML slide shows.
data HTMLSlideVariant = S5Slides
                      | SlidySlides
                      | SlideousSlides
                      | DZSlides
                      | RevealJsSlides
                      | NoSlides
                      deriving (Int -> HTMLSlideVariant -> ShowS
[HTMLSlideVariant] -> ShowS
HTMLSlideVariant -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTMLSlideVariant] -> ShowS
$cshowList :: [HTMLSlideVariant] -> ShowS
show :: HTMLSlideVariant -> String
$cshow :: HTMLSlideVariant -> String
showsPrec :: Int -> HTMLSlideVariant -> ShowS
$cshowsPrec :: Int -> HTMLSlideVariant -> ShowS
Show, ReadPrec [HTMLSlideVariant]
ReadPrec HTMLSlideVariant
Int -> ReadS HTMLSlideVariant
ReadS [HTMLSlideVariant]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HTMLSlideVariant]
$creadListPrec :: ReadPrec [HTMLSlideVariant]
readPrec :: ReadPrec HTMLSlideVariant
$creadPrec :: ReadPrec HTMLSlideVariant
readList :: ReadS [HTMLSlideVariant]
$creadList :: ReadS [HTMLSlideVariant]
readsPrec :: Int -> ReadS HTMLSlideVariant
$creadsPrec :: Int -> ReadS HTMLSlideVariant
Read, HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTMLSlideVariant -> HTMLSlideVariant -> Bool
$c/= :: HTMLSlideVariant -> HTMLSlideVariant -> Bool
== :: HTMLSlideVariant -> HTMLSlideVariant -> Bool
$c== :: HTMLSlideVariant -> HTMLSlideVariant -> Bool
Eq, Typeable HTMLSlideVariant
HTMLSlideVariant -> DataType
HTMLSlideVariant -> Constr
(forall b. Data b => b -> b)
-> HTMLSlideVariant -> HTMLSlideVariant
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) -> HTMLSlideVariant -> u
forall u. (forall d. Data d => d -> u) -> HTMLSlideVariant -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLSlideVariant -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLSlideVariant -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HTMLSlideVariant -> m HTMLSlideVariant
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLSlideVariant -> m HTMLSlideVariant
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HTMLSlideVariant
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HTMLSlideVariant -> c HTMLSlideVariant
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HTMLSlideVariant)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HTMLSlideVariant)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLSlideVariant -> m HTMLSlideVariant
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLSlideVariant -> m HTMLSlideVariant
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLSlideVariant -> m HTMLSlideVariant
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HTMLSlideVariant -> m HTMLSlideVariant
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HTMLSlideVariant -> m HTMLSlideVariant
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HTMLSlideVariant -> m HTMLSlideVariant
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HTMLSlideVariant -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HTMLSlideVariant -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HTMLSlideVariant -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HTMLSlideVariant -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLSlideVariant -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLSlideVariant -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLSlideVariant -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HTMLSlideVariant -> r
gmapT :: (forall b. Data b => b -> b)
-> HTMLSlideVariant -> HTMLSlideVariant
$cgmapT :: (forall b. Data b => b -> b)
-> HTMLSlideVariant -> HTMLSlideVariant
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HTMLSlideVariant)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HTMLSlideVariant)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HTMLSlideVariant)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HTMLSlideVariant)
dataTypeOf :: HTMLSlideVariant -> DataType
$cdataTypeOf :: HTMLSlideVariant -> DataType
toConstr :: HTMLSlideVariant -> Constr
$ctoConstr :: HTMLSlideVariant -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HTMLSlideVariant
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HTMLSlideVariant
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HTMLSlideVariant -> c HTMLSlideVariant
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HTMLSlideVariant -> c HTMLSlideVariant
Data, Typeable, forall x. Rep HTMLSlideVariant x -> HTMLSlideVariant
forall x. HTMLSlideVariant -> Rep HTMLSlideVariant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HTMLSlideVariant x -> HTMLSlideVariant
$cfrom :: forall x. HTMLSlideVariant -> Rep HTMLSlideVariant x
Generic)

-- | Options for accepting or rejecting MS Word track-changes.
data TrackChanges = AcceptChanges
                  | RejectChanges
                  | AllChanges
                  deriving (Int -> TrackChanges -> ShowS
[TrackChanges] -> ShowS
TrackChanges -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrackChanges] -> ShowS
$cshowList :: [TrackChanges] -> ShowS
show :: TrackChanges -> String
$cshow :: TrackChanges -> String
showsPrec :: Int -> TrackChanges -> ShowS
$cshowsPrec :: Int -> TrackChanges -> ShowS
Show, ReadPrec [TrackChanges]
ReadPrec TrackChanges
Int -> ReadS TrackChanges
ReadS [TrackChanges]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TrackChanges]
$creadListPrec :: ReadPrec [TrackChanges]
readPrec :: ReadPrec TrackChanges
$creadPrec :: ReadPrec TrackChanges
readList :: ReadS [TrackChanges]
$creadList :: ReadS [TrackChanges]
readsPrec :: Int -> ReadS TrackChanges
$creadsPrec :: Int -> ReadS TrackChanges
Read, TrackChanges -> TrackChanges -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackChanges -> TrackChanges -> Bool
$c/= :: TrackChanges -> TrackChanges -> Bool
== :: TrackChanges -> TrackChanges -> Bool
$c== :: TrackChanges -> TrackChanges -> Bool
Eq, Typeable TrackChanges
TrackChanges -> DataType
TrackChanges -> Constr
(forall b. Data b => b -> b) -> TrackChanges -> TrackChanges
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) -> TrackChanges -> u
forall u. (forall d. Data d => d -> u) -> TrackChanges -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TrackChanges -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TrackChanges -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TrackChanges -> m TrackChanges
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TrackChanges -> m TrackChanges
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TrackChanges
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TrackChanges -> c TrackChanges
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TrackChanges)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TrackChanges)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TrackChanges -> m TrackChanges
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TrackChanges -> m TrackChanges
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TrackChanges -> m TrackChanges
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TrackChanges -> m TrackChanges
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TrackChanges -> m TrackChanges
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TrackChanges -> m TrackChanges
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TrackChanges -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TrackChanges -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TrackChanges -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TrackChanges -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TrackChanges -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TrackChanges -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TrackChanges -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TrackChanges -> r
gmapT :: (forall b. Data b => b -> b) -> TrackChanges -> TrackChanges
$cgmapT :: (forall b. Data b => b -> b) -> TrackChanges -> TrackChanges
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TrackChanges)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TrackChanges)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TrackChanges)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TrackChanges)
dataTypeOf :: TrackChanges -> DataType
$cdataTypeOf :: TrackChanges -> DataType
toConstr :: TrackChanges -> Constr
$ctoConstr :: TrackChanges -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TrackChanges
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TrackChanges
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TrackChanges -> c TrackChanges
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TrackChanges -> c TrackChanges
Data, Typeable, forall x. Rep TrackChanges x -> TrackChanges
forall x. TrackChanges -> Rep TrackChanges x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TrackChanges x -> TrackChanges
$cfrom :: forall x. TrackChanges -> Rep TrackChanges x
Generic)

-- update in doc/filters.md if this changes:
instance FromJSON TrackChanges where
  parseJSON :: Value -> Parser TrackChanges
parseJSON Value
v =
    case Value
v of
      String Text
"accept"     -> forall (m :: * -> *) a. Monad m => a -> m a
return TrackChanges
AcceptChanges
      String Text
"reject"     -> forall (m :: * -> *) a. Monad m => a -> m a
return TrackChanges
RejectChanges
      String Text
"all"        -> forall (m :: * -> *) a. Monad m => a -> m a
return TrackChanges
AllChanges
      String Text
"accept-changes" -> forall (m :: * -> *) a. Monad m => a -> m a
return TrackChanges
AcceptChanges
      String Text
"reject-changes" -> forall (m :: * -> *) a. Monad m => a -> m a
return TrackChanges
RejectChanges
      String Text
"all-changes"    -> forall (m :: * -> *) a. Monad m => a -> m a
return TrackChanges
AllChanges
      Value
_  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown track changes method " forall a. Semigroup a => a -> a -> a
<> ByteString -> String
toStringLazy (forall a. ToJSON a => a -> ByteString
encode Value
v)

instance ToJSON TrackChanges where
  toJSON :: TrackChanges -> Value
toJSON TrackChanges
AcceptChanges = Text -> Value
String Text
"accept-changes"
  toJSON TrackChanges
RejectChanges = Text -> Value
String Text
"reject-changes"
  toJSON TrackChanges
AllChanges = Text -> Value
String Text
"all-changes"

-- | Options for wrapping text in the output.
data WrapOption = WrapAuto        -- ^ Automatically wrap to width
                | WrapNone        -- ^ No non-semantic newlines
                | WrapPreserve    -- ^ Preserve wrapping of input source
                deriving (Int -> WrapOption -> ShowS
[WrapOption] -> ShowS
WrapOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WrapOption] -> ShowS
$cshowList :: [WrapOption] -> ShowS
show :: WrapOption -> String
$cshow :: WrapOption -> String
showsPrec :: Int -> WrapOption -> ShowS
$cshowsPrec :: Int -> WrapOption -> ShowS
Show, ReadPrec [WrapOption]
ReadPrec WrapOption
Int -> ReadS WrapOption
ReadS [WrapOption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WrapOption]
$creadListPrec :: ReadPrec [WrapOption]
readPrec :: ReadPrec WrapOption
$creadPrec :: ReadPrec WrapOption
readList :: ReadS [WrapOption]
$creadList :: ReadS [WrapOption]
readsPrec :: Int -> ReadS WrapOption
$creadsPrec :: Int -> ReadS WrapOption
Read, WrapOption -> WrapOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrapOption -> WrapOption -> Bool
$c/= :: WrapOption -> WrapOption -> Bool
== :: WrapOption -> WrapOption -> Bool
$c== :: WrapOption -> WrapOption -> Bool
Eq, Typeable WrapOption
WrapOption -> DataType
WrapOption -> Constr
(forall b. Data b => b -> b) -> WrapOption -> WrapOption
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) -> WrapOption -> u
forall u. (forall d. Data d => d -> u) -> WrapOption -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WrapOption -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WrapOption -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WrapOption -> m WrapOption
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WrapOption -> m WrapOption
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WrapOption
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WrapOption -> c WrapOption
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WrapOption)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WrapOption)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WrapOption -> m WrapOption
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WrapOption -> m WrapOption
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WrapOption -> m WrapOption
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WrapOption -> m WrapOption
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WrapOption -> m WrapOption
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WrapOption -> m WrapOption
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WrapOption -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WrapOption -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> WrapOption -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WrapOption -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WrapOption -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WrapOption -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WrapOption -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WrapOption -> r
gmapT :: (forall b. Data b => b -> b) -> WrapOption -> WrapOption
$cgmapT :: (forall b. Data b => b -> b) -> WrapOption -> WrapOption
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WrapOption)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WrapOption)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WrapOption)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WrapOption)
dataTypeOf :: WrapOption -> DataType
$cdataTypeOf :: WrapOption -> DataType
toConstr :: WrapOption -> Constr
$ctoConstr :: WrapOption -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WrapOption
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WrapOption
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WrapOption -> c WrapOption
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WrapOption -> c WrapOption
Data, Typeable, forall x. Rep WrapOption x -> WrapOption
forall x. WrapOption -> Rep WrapOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WrapOption x -> WrapOption
$cfrom :: forall x. WrapOption -> Rep WrapOption x
Generic)

instance FromJSON WrapOption where
  parseJSON :: Value -> Parser WrapOption
parseJSON Value
v =
    case Value
v of
      String Text
"auto"      -> forall (m :: * -> *) a. Monad m => a -> m a
return WrapOption
WrapAuto
      String Text
"wrap-auto" -> forall (m :: * -> *) a. Monad m => a -> m a
return WrapOption
WrapAuto
      String Text
"none"      -> forall (m :: * -> *) a. Monad m => a -> m a
return WrapOption
WrapNone
      String Text
"wrap-none" -> forall (m :: * -> *) a. Monad m => a -> m a
return WrapOption
WrapNone
      String Text
"preserve"  -> forall (m :: * -> *) a. Monad m => a -> m a
return WrapOption
WrapPreserve
      String Text
"wrap-preserve" -> forall (m :: * -> *) a. Monad m => a -> m a
return WrapOption
WrapPreserve
      Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown wrap method " forall a. Semigroup a => a -> a -> a
<> ByteString -> String
toStringLazy (forall a. ToJSON a => a -> ByteString
encode Value
v)

instance ToJSON WrapOption where
  toJSON :: WrapOption -> Value
toJSON WrapOption
WrapAuto = Value
"wrap-auto"
  toJSON WrapOption
WrapNone = Value
"wrap-none"
  toJSON WrapOption
WrapPreserve = Value
"wrap-preserve"

-- | Options defining the type of top-level headers.
data TopLevelDivision = TopLevelPart      -- ^ Top-level headers become parts
                      | TopLevelChapter   -- ^ Top-level headers become chapters
                      | TopLevelSection   -- ^ Top-level headers become sections
                      | TopLevelDefault   -- ^ Top-level type is determined via
                                          --   heuristics
                      deriving (Int -> TopLevelDivision -> ShowS
[TopLevelDivision] -> ShowS
TopLevelDivision -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopLevelDivision] -> ShowS
$cshowList :: [TopLevelDivision] -> ShowS
show :: TopLevelDivision -> String
$cshow :: TopLevelDivision -> String
showsPrec :: Int -> TopLevelDivision -> ShowS
$cshowsPrec :: Int -> TopLevelDivision -> ShowS
Show, ReadPrec [TopLevelDivision]
ReadPrec TopLevelDivision
Int -> ReadS TopLevelDivision
ReadS [TopLevelDivision]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TopLevelDivision]
$creadListPrec :: ReadPrec [TopLevelDivision]
readPrec :: ReadPrec TopLevelDivision
$creadPrec :: ReadPrec TopLevelDivision
readList :: ReadS [TopLevelDivision]
$creadList :: ReadS [TopLevelDivision]
readsPrec :: Int -> ReadS TopLevelDivision
$creadsPrec :: Int -> ReadS TopLevelDivision
Read, TopLevelDivision -> TopLevelDivision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopLevelDivision -> TopLevelDivision -> Bool
$c/= :: TopLevelDivision -> TopLevelDivision -> Bool
== :: TopLevelDivision -> TopLevelDivision -> Bool
$c== :: TopLevelDivision -> TopLevelDivision -> Bool
Eq, Typeable TopLevelDivision
TopLevelDivision -> DataType
TopLevelDivision -> Constr
(forall b. Data b => b -> b)
-> TopLevelDivision -> TopLevelDivision
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) -> TopLevelDivision -> u
forall u. (forall d. Data d => d -> u) -> TopLevelDivision -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDivision -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDivision -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TopLevelDivision -> m TopLevelDivision
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TopLevelDivision -> m TopLevelDivision
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TopLevelDivision
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TopLevelDivision -> c TopLevelDivision
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TopLevelDivision)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TopLevelDivision)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TopLevelDivision -> m TopLevelDivision
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TopLevelDivision -> m TopLevelDivision
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TopLevelDivision -> m TopLevelDivision
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TopLevelDivision -> m TopLevelDivision
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TopLevelDivision -> m TopLevelDivision
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TopLevelDivision -> m TopLevelDivision
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TopLevelDivision -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TopLevelDivision -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TopLevelDivision -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TopLevelDivision -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDivision -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDivision -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDivision -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDivision -> r
gmapT :: (forall b. Data b => b -> b)
-> TopLevelDivision -> TopLevelDivision
$cgmapT :: (forall b. Data b => b -> b)
-> TopLevelDivision -> TopLevelDivision
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TopLevelDivision)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TopLevelDivision)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TopLevelDivision)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TopLevelDivision)
dataTypeOf :: TopLevelDivision -> DataType
$cdataTypeOf :: TopLevelDivision -> DataType
toConstr :: TopLevelDivision -> Constr
$ctoConstr :: TopLevelDivision -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TopLevelDivision
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TopLevelDivision
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TopLevelDivision -> c TopLevelDivision
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TopLevelDivision -> c TopLevelDivision
Data, Typeable, forall x. Rep TopLevelDivision x -> TopLevelDivision
forall x. TopLevelDivision -> Rep TopLevelDivision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TopLevelDivision x -> TopLevelDivision
$cfrom :: forall x. TopLevelDivision -> Rep TopLevelDivision x
Generic)

instance FromJSON TopLevelDivision where
  parseJSON :: Value -> Parser TopLevelDivision
parseJSON Value
v =
      case Value
v of
        String Text
"part"              -> forall (m :: * -> *) a. Monad m => a -> m a
return TopLevelDivision
TopLevelPart
        String Text
"top-level-part"    -> forall (m :: * -> *) a. Monad m => a -> m a
return TopLevelDivision
TopLevelPart
        String Text
"chapter"           -> forall (m :: * -> *) a. Monad m => a -> m a
return TopLevelDivision
TopLevelChapter
        String Text
"top-level-chapter" -> forall (m :: * -> *) a. Monad m => a -> m a
return TopLevelDivision
TopLevelChapter
        String Text
"section"           -> forall (m :: * -> *) a. Monad m => a -> m a
return TopLevelDivision
TopLevelSection
        String Text
"top-level-section" -> forall (m :: * -> *) a. Monad m => a -> m a
return TopLevelDivision
TopLevelSection
        String Text
"default"           -> forall (m :: * -> *) a. Monad m => a -> m a
return TopLevelDivision
TopLevelDefault
        String Text
"top-level-default" -> forall (m :: * -> *) a. Monad m => a -> m a
return TopLevelDivision
TopLevelDefault
        Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown top level division " forall a. Semigroup a => a -> a -> a
<> ByteString -> String
toStringLazy (forall a. ToJSON a => a -> ByteString
encode Value
v)

instance ToJSON TopLevelDivision where
  toJSON :: TopLevelDivision -> Value
toJSON TopLevelDivision
TopLevelPart = Value
"top-level-part"
  toJSON TopLevelDivision
TopLevelChapter = Value
"top-level-chapter"
  toJSON TopLevelDivision
TopLevelSection = Value
"top-level-section"
  toJSON TopLevelDivision
TopLevelDefault = Value
"top-level-default"

-- | Locations for footnotes and references in markdown output
data ReferenceLocation = EndOfBlock    -- ^ End of block
                       | EndOfSection  -- ^ prior to next section header (or end of document)
                       | EndOfDocument -- ^ at end of document
                       deriving (Int -> ReferenceLocation -> ShowS
[ReferenceLocation] -> ShowS
ReferenceLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceLocation] -> ShowS
$cshowList :: [ReferenceLocation] -> ShowS
show :: ReferenceLocation -> String
$cshow :: ReferenceLocation -> String
showsPrec :: Int -> ReferenceLocation -> ShowS
$cshowsPrec :: Int -> ReferenceLocation -> ShowS
Show, ReadPrec [ReferenceLocation]
ReadPrec ReferenceLocation
Int -> ReadS ReferenceLocation
ReadS [ReferenceLocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReferenceLocation]
$creadListPrec :: ReadPrec [ReferenceLocation]
readPrec :: ReadPrec ReferenceLocation
$creadPrec :: ReadPrec ReferenceLocation
readList :: ReadS [ReferenceLocation]
$creadList :: ReadS [ReferenceLocation]
readsPrec :: Int -> ReadS ReferenceLocation
$creadsPrec :: Int -> ReadS ReferenceLocation
Read, ReferenceLocation -> ReferenceLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceLocation -> ReferenceLocation -> Bool
$c/= :: ReferenceLocation -> ReferenceLocation -> Bool
== :: ReferenceLocation -> ReferenceLocation -> Bool
$c== :: ReferenceLocation -> ReferenceLocation -> Bool
Eq, Typeable ReferenceLocation
ReferenceLocation -> DataType
ReferenceLocation -> Constr
(forall b. Data b => b -> b)
-> ReferenceLocation -> ReferenceLocation
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) -> ReferenceLocation -> u
forall u. (forall d. Data d => d -> u) -> ReferenceLocation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReferenceLocation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReferenceLocation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ReferenceLocation -> m ReferenceLocation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReferenceLocation -> m ReferenceLocation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReferenceLocation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReferenceLocation -> c ReferenceLocation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReferenceLocation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReferenceLocation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReferenceLocation -> m ReferenceLocation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReferenceLocation -> m ReferenceLocation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReferenceLocation -> m ReferenceLocation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReferenceLocation -> m ReferenceLocation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ReferenceLocation -> m ReferenceLocation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ReferenceLocation -> m ReferenceLocation
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ReferenceLocation -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ReferenceLocation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ReferenceLocation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ReferenceLocation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReferenceLocation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReferenceLocation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReferenceLocation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReferenceLocation -> r
gmapT :: (forall b. Data b => b -> b)
-> ReferenceLocation -> ReferenceLocation
$cgmapT :: (forall b. Data b => b -> b)
-> ReferenceLocation -> ReferenceLocation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReferenceLocation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReferenceLocation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReferenceLocation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReferenceLocation)
dataTypeOf :: ReferenceLocation -> DataType
$cdataTypeOf :: ReferenceLocation -> DataType
toConstr :: ReferenceLocation -> Constr
$ctoConstr :: ReferenceLocation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReferenceLocation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReferenceLocation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReferenceLocation -> c ReferenceLocation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReferenceLocation -> c ReferenceLocation
Data, Typeable, forall x. Rep ReferenceLocation x -> ReferenceLocation
forall x. ReferenceLocation -> Rep ReferenceLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReferenceLocation x -> ReferenceLocation
$cfrom :: forall x. ReferenceLocation -> Rep ReferenceLocation x
Generic)

instance FromJSON ReferenceLocation where
  parseJSON :: Value -> Parser ReferenceLocation
parseJSON Value
v =
    case Value
v of
      String Text
"block"           -> forall (m :: * -> *) a. Monad m => a -> m a
return ReferenceLocation
EndOfBlock
      String Text
"end-of-block"    -> forall (m :: * -> *) a. Monad m => a -> m a
return ReferenceLocation
EndOfBlock
      String Text
"section"         -> forall (m :: * -> *) a. Monad m => a -> m a
return ReferenceLocation
EndOfSection
      String Text
"end-of-section"  -> forall (m :: * -> *) a. Monad m => a -> m a
return ReferenceLocation
EndOfSection
      String Text
"document"        -> forall (m :: * -> *) a. Monad m => a -> m a
return ReferenceLocation
EndOfDocument
      String Text
"end-of-document" -> forall (m :: * -> *) a. Monad m => a -> m a
return ReferenceLocation
EndOfDocument
      Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown reference location " forall a. Semigroup a => a -> a -> a
<> ByteString -> String
toStringLazy (forall a. ToJSON a => a -> ByteString
encode Value
v)

instance ToJSON ReferenceLocation where
   toJSON :: ReferenceLocation -> Value
toJSON ReferenceLocation
EndOfBlock = Value
"end-of-block"
   toJSON ReferenceLocation
EndOfSection = Value
"end-of-section"
   toJSON ReferenceLocation
EndOfDocument = Value
"end-of-document"

-- | Options for writers
data WriterOptions = WriterOptions
  { WriterOptions -> Maybe (Template Text)
writerTemplate          :: Maybe (Template Text) -- ^ Template to use
  , WriterOptions -> Context Text
writerVariables         :: Context Text -- ^ Variables to set in template
  , WriterOptions -> Int
writerTabStop           :: Int    -- ^ Tabstop for conversion btw spaces and tabs
  , WriterOptions -> Bool
writerTableOfContents   :: Bool   -- ^ Include table of contents
  , WriterOptions -> Bool
writerIncremental       :: Bool   -- ^ True if lists should be incremental
  , WriterOptions -> HTMLMathMethod
writerHTMLMathMethod    :: HTMLMathMethod  -- ^ How to print math in HTML
  , WriterOptions -> Bool
writerNumberSections    :: Bool   -- ^ Number sections in LaTeX
  , WriterOptions -> [Int]
writerNumberOffset      :: [Int]  -- ^ Starting number for section, subsection, ...
  , WriterOptions -> Bool
writerSectionDivs       :: Bool   -- ^ Put sections in div tags in HTML
  , WriterOptions -> Extensions
writerExtensions        :: Extensions -- ^ Markdown extensions that can be used
  , WriterOptions -> Bool
writerReferenceLinks    :: Bool   -- ^ Use reference links in writing markdown, rst
  , WriterOptions -> Int
writerDpi               :: Int    -- ^ Dpi for pixel to\/from inch\/cm conversions
  , WriterOptions -> WrapOption
writerWrapText          :: WrapOption  -- ^ Option for wrapping text
  , WriterOptions -> Int
writerColumns           :: Int    -- ^ Characters in a line (for text wrapping)
  , WriterOptions -> ObfuscationMethod
writerEmailObfuscation  :: ObfuscationMethod -- ^ How to obfuscate emails
  , WriterOptions -> Text
writerIdentifierPrefix  :: Text -- ^ Prefix for section & note ids in HTML
                                     -- and for footnote marks in markdown
  , WriterOptions -> CiteMethod
writerCiteMethod        :: CiteMethod -- ^ How to print cites
  , WriterOptions -> Bool
writerHtmlQTags         :: Bool       -- ^ Use @<q>@ tags for quotes in HTML
  , WriterOptions -> Maybe Int
writerSlideLevel        :: Maybe Int  -- ^ Force header level of slides
  , WriterOptions -> TopLevelDivision
writerTopLevelDivision  :: TopLevelDivision -- ^ Type of top-level divisions
  , WriterOptions -> Bool
writerListings          :: Bool       -- ^ Use listings package for code
  , WriterOptions -> Maybe Style
writerHighlightStyle    :: Maybe Style  -- ^ Style to use for highlighting
                                           -- (Nothing = no highlighting)
  , WriterOptions -> Bool
writerSetextHeaders     :: Bool       -- ^ Use setext headers for levels 1-2 in markdown
  , WriterOptions -> Text
writerEpubSubdirectory  :: Text       -- ^ Subdir for epub in OCF
  , WriterOptions -> Maybe Text
writerEpubMetadata      :: Maybe Text -- ^ Metadata to include in EPUB
  , WriterOptions -> [String]
writerEpubFonts         :: [FilePath] -- ^ Paths to fonts to embed
  , WriterOptions -> Int
writerEpubChapterLevel  :: Int            -- ^ Header level for chapters (separate files)
  , WriterOptions -> Int
writerTOCDepth          :: Int            -- ^ Number of levels to include in TOC
  , WriterOptions -> Maybe String
writerReferenceDoc      :: Maybe FilePath -- ^ Path to reference document if specified
  , WriterOptions -> ReferenceLocation
writerReferenceLocation :: ReferenceLocation    -- ^ Location of footnotes and references for writing markdown
  , WriterOptions -> SyntaxMap
writerSyntaxMap         :: SyntaxMap
  , WriterOptions -> Bool
writerPreferAscii       :: Bool           -- ^ Prefer ASCII representations of characters when possible
  } deriving (Int -> WriterOptions -> ShowS
[WriterOptions] -> ShowS
WriterOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriterOptions] -> ShowS
$cshowList :: [WriterOptions] -> ShowS
show :: WriterOptions -> String
$cshow :: WriterOptions -> String
showsPrec :: Int -> WriterOptions -> ShowS
$cshowsPrec :: Int -> WriterOptions -> ShowS
Show, Typeable WriterOptions
WriterOptions -> DataType
WriterOptions -> Constr
(forall b. Data b => b -> b) -> WriterOptions -> WriterOptions
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) -> WriterOptions -> u
forall u. (forall d. Data d => d -> u) -> WriterOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WriterOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WriterOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WriterOptions -> m WriterOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WriterOptions -> m WriterOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WriterOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WriterOptions -> c WriterOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WriterOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WriterOptions)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WriterOptions -> m WriterOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WriterOptions -> m WriterOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WriterOptions -> m WriterOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WriterOptions -> m WriterOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WriterOptions -> m WriterOptions
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WriterOptions -> m WriterOptions
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WriterOptions -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WriterOptions -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> WriterOptions -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WriterOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WriterOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WriterOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WriterOptions -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WriterOptions -> r
gmapT :: (forall b. Data b => b -> b) -> WriterOptions -> WriterOptions
$cgmapT :: (forall b. Data b => b -> b) -> WriterOptions -> WriterOptions
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WriterOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WriterOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WriterOptions)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WriterOptions)
dataTypeOf :: WriterOptions -> DataType
$cdataTypeOf :: WriterOptions -> DataType
toConstr :: WriterOptions -> Constr
$ctoConstr :: WriterOptions -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WriterOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WriterOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WriterOptions -> c WriterOptions
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WriterOptions -> c WriterOptions
Data, Typeable, forall x. Rep WriterOptions x -> WriterOptions
forall x. WriterOptions -> Rep WriterOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WriterOptions x -> WriterOptions
$cfrom :: forall x. WriterOptions -> Rep WriterOptions x
Generic)

instance Default WriterOptions where
  def :: WriterOptions
def = WriterOptions { writerTemplate :: Maybe (Template Text)
writerTemplate         = forall a. Maybe a
Nothing
                      , writerVariables :: Context Text
writerVariables        = forall a. Monoid a => a
mempty
                      , writerTabStop :: Int
writerTabStop          = Int
4
                      , writerTableOfContents :: Bool
writerTableOfContents  = Bool
False
                      , writerIncremental :: Bool
writerIncremental      = Bool
False
                      , writerHTMLMathMethod :: HTMLMathMethod
writerHTMLMathMethod   = HTMLMathMethod
PlainMath
                      , writerNumberSections :: Bool
writerNumberSections   = Bool
False
                      , writerNumberOffset :: [Int]
writerNumberOffset     = [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0]
                      , writerSectionDivs :: Bool
writerSectionDivs      = Bool
False
                      , writerExtensions :: Extensions
writerExtensions       = Extensions
emptyExtensions
                      , writerReferenceLinks :: Bool
writerReferenceLinks   = Bool
False
                      , writerDpi :: Int
writerDpi              = Int
96
                      , writerWrapText :: WrapOption
writerWrapText         = WrapOption
WrapAuto
                      , writerColumns :: Int
writerColumns          = Int
72
                      , writerEmailObfuscation :: ObfuscationMethod
writerEmailObfuscation = ObfuscationMethod
NoObfuscation
                      , writerIdentifierPrefix :: Text
writerIdentifierPrefix = Text
""
                      , writerCiteMethod :: CiteMethod
writerCiteMethod       = CiteMethod
Citeproc
                      , writerHtmlQTags :: Bool
writerHtmlQTags        = Bool
False
                      , writerSlideLevel :: Maybe Int
writerSlideLevel       = forall a. Maybe a
Nothing
                      , writerTopLevelDivision :: TopLevelDivision
writerTopLevelDivision = TopLevelDivision
TopLevelDefault
                      , writerListings :: Bool
writerListings         = Bool
False
                      , writerHighlightStyle :: Maybe Style
writerHighlightStyle   = forall a. a -> Maybe a
Just Style
pygments
                      , writerSetextHeaders :: Bool
writerSetextHeaders    = Bool
False
                      , writerEpubSubdirectory :: Text
writerEpubSubdirectory = Text
"EPUB"
                      , writerEpubMetadata :: Maybe Text
writerEpubMetadata     = forall a. Maybe a
Nothing
                      , writerEpubFonts :: [String]
writerEpubFonts        = []
                      , writerEpubChapterLevel :: Int
writerEpubChapterLevel = Int
1
                      , writerTOCDepth :: Int
writerTOCDepth         = Int
3
                      , writerReferenceDoc :: Maybe String
writerReferenceDoc     = forall a. Maybe a
Nothing
                      , writerReferenceLocation :: ReferenceLocation
writerReferenceLocation = ReferenceLocation
EndOfDocument
                      , writerSyntaxMap :: SyntaxMap
writerSyntaxMap        = SyntaxMap
defaultSyntaxMap
                      , writerPreferAscii :: Bool
writerPreferAscii      = Bool
False
                      }

instance HasSyntaxExtensions WriterOptions where
  getExtensions :: WriterOptions -> Extensions
getExtensions WriterOptions
opts = WriterOptions -> Extensions
writerExtensions WriterOptions
opts

-- | Returns True if the given extension is enabled.
isEnabled :: HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled :: forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
ext a
opts = Extension
ext Extension -> Extensions -> Bool
`extensionEnabled` forall a. HasSyntaxExtensions a => a -> Extensions
getExtensions a
opts

defaultMathJaxURL :: Text
defaultMathJaxURL :: Text
defaultMathJaxURL = Text
"https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-chtml-full.js"

defaultKaTeXURL :: Text
defaultKaTeXURL :: Text
defaultKaTeXURL = Text
"https://cdn.jsdelivr.net/npm/katex@0.15.1/dist/"

-- Update documentation in doc/filters.md if this is changed.
$(deriveJSON defaultOptions{ fieldLabelModifier =
                               camelTo2 '-' . drop 6 }
                            ''ReaderOptions)

$(deriveJSON defaultOptions{ constructorTagModifier = map toLower }
  ''HTMLSlideVariant)