{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE LambdaCase #-}

module Text.Pandoc.Z.WriterOptions(
  HasReferenceLocation(..)
, AsReferenceLocation(..)
, HasTopLevelDivision(..)
, AsTopLevelDivision(..)
, HasCiteMethod(..)
, AsCiteMethod(..)
, HasObfuscationMethod(..)
, AsObfuscationMethod(..)
, HasWrapOption(..)
, AsWrapOption(..)
, HasHTMLMathMethod(..)
, AsHTMLMathMethod(..)
, HasWriterOptions(..)
, AsWriterOptions(..)
, WriterOptions(WriterOptions)
, defaultWriterOptions
) where

import Control.Lens ( prism', Lens', Prism' )
import Data.Text as Text ( Text, pack )
import Skylighting (defaultSyntaxMap)
import Skylighting.Types(SyntaxMap)
import Text.DocTemplates(Context)
import Text.Pandoc.Chunks(PathTemplate(..))
import Text.Pandoc.Highlighting(Style, pygments)
import Text.Pandoc.Options(WriterOptions(WriterOptions), HTMLMathMethod(..), WrapOption(..), ObfuscationMethod(..), CiteMethod(..), TopLevelDivision(..), ReferenceLocation(..))
import Text.Pandoc.Templates(Template)

class HasWriterOptions a where
  writerOptions ::
    Lens' a WriterOptions
  template ::
    Lens' a (Maybe (Template Text))
  template =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Maybe (Template Text) -> f (Maybe (Template Text)))
    -> WriterOptions -> f WriterOptions)
-> (Maybe (Template Text) -> f (Maybe (Template Text)))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Template Text) -> f (Maybe (Template Text)))
-> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a (Maybe (Template Text))
Lens' WriterOptions (Maybe (Template Text))
template
  variables ::
    Lens' a (Context Text)
  variables =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Context Text -> f (Context Text))
    -> WriterOptions -> f WriterOptions)
-> (Context Text -> f (Context Text))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context Text -> f (Context Text))
-> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a (Context Text)
Lens' WriterOptions (Context Text)
variables
  tableOfContents ::
    Lens' a Bool
  tableOfContents =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
tableOfContents
  incremental ::
    Lens' a Bool
  incremental =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
incremental
  numberSections ::
    Lens' a Bool
  numberSections =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
numberSections
  numberOffset ::
    Lens' a [Int]
  numberOffset =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> (([Int] -> f [Int]) -> WriterOptions -> f WriterOptions)
-> ([Int] -> f [Int])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> f [Int]) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a [Int]
Lens' WriterOptions [Int]
numberOffset
  sectionDivs ::
    Lens' a Bool
  sectionDivs =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
sectionDivs
  referenceLinks ::
    Lens' a Bool
  referenceLinks =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
referenceLinks
  dpi ::
    Lens' a Int
  dpi =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Int -> f Int) -> WriterOptions -> f WriterOptions)
-> (Int -> f Int)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Int
Lens' WriterOptions Int
dpi
  identifierPrefix ::
    Lens' a Text
  identifierPrefix =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Text -> f Text) -> WriterOptions -> f WriterOptions)
-> (Text -> f Text)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Text
Lens' WriterOptions Text
identifierPrefix
  htmlQTags ::
    Lens' a Bool
  htmlQTags =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
htmlQTags
  slideLevel ::
    Lens' a (Maybe Int)
  slideLevel =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Maybe Int -> f (Maybe Int))
    -> WriterOptions -> f WriterOptions)
-> (Maybe Int -> f (Maybe Int))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> f (Maybe Int)) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a (Maybe Int)
Lens' WriterOptions (Maybe Int)
slideLevel
  listings ::
    Lens' a Bool
  listings =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
listings
  highlightStyle ::
    Lens' a (Maybe Style)
  highlightStyle =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Maybe Style -> f (Maybe Style))
    -> WriterOptions -> f WriterOptions)
-> (Maybe Style -> f (Maybe Style))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Style -> f (Maybe Style))
-> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a (Maybe Style)
Lens' WriterOptions (Maybe Style)
highlightStyle
  setextHeaders ::
    Lens' a Bool
  setextHeaders =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
setextHeaders
  listTables ::
    Lens' a Bool
  listTables =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
listTables
  epubSubdirectory ::
    Lens' a Text
  epubSubdirectory =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Text -> f Text) -> WriterOptions -> f WriterOptions)
-> (Text -> f Text)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Text
Lens' WriterOptions Text
epubSubdirectory
  epubMetadata ::
    Lens' a (Maybe Text)
  epubMetadata =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Maybe Text -> f (Maybe Text))
    -> WriterOptions -> f WriterOptions)
-> (Maybe Text -> f (Maybe Text))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> f (Maybe Text)) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a (Maybe Text)
Lens' WriterOptions (Maybe Text)
epubMetadata
  epubFonts ::
    Lens' a [FilePath]
  epubFonts =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> (([FilePath] -> f [FilePath])
    -> WriterOptions -> f WriterOptions)
-> ([FilePath] -> f [FilePath])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> f [FilePath]) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a [FilePath]
Lens' WriterOptions [FilePath]
epubFonts
  epubTitlePage ::
    Lens' a Bool
  epubTitlePage =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
epubTitlePage
  splitLevel ::
    Lens' a Int
  splitLevel =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Int -> f Int) -> WriterOptions -> f WriterOptions)
-> (Int -> f Int)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Int
Lens' WriterOptions Int
splitLevel
  chunkTemplate ::
    Lens' a PathTemplate
  chunkTemplate =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((PathTemplate -> f PathTemplate)
    -> WriterOptions -> f WriterOptions)
-> (PathTemplate -> f PathTemplate)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathTemplate -> f PathTemplate)
-> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a PathTemplate
Lens' WriterOptions PathTemplate
chunkTemplate
  tocDepth ::
    Lens' a Int
  tocDepth =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Int -> f Int) -> WriterOptions -> f WriterOptions)
-> (Int -> f Int)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Int
Lens' WriterOptions Int
tocDepth
  referenceDoc ::
    Lens' a (Maybe FilePath)
  referenceDoc =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Maybe FilePath -> f (Maybe FilePath))
    -> WriterOptions -> f WriterOptions)
-> (Maybe FilePath -> f (Maybe FilePath))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> f (Maybe FilePath))
-> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a (Maybe FilePath)
Lens' WriterOptions (Maybe FilePath)
referenceDoc
  syntaxMap ::
    Lens' a SyntaxMap
  syntaxMap =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((SyntaxMap -> f SyntaxMap) -> WriterOptions -> f WriterOptions)
-> (SyntaxMap -> f SyntaxMap)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SyntaxMap -> f SyntaxMap) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a SyntaxMap
Lens' WriterOptions SyntaxMap
syntaxMap
  preferAscii ::
    Lens' a Bool
  preferAscii =
    (WriterOptions -> f WriterOptions) -> a -> f a
forall a. HasWriterOptions a => Lens' a WriterOptions
Lens' a WriterOptions
writerOptions ((WriterOptions -> f WriterOptions) -> a -> f a)
-> ((Bool -> f Bool) -> WriterOptions -> f WriterOptions)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> WriterOptions -> f WriterOptions
forall a. HasWriterOptions a => Lens' a Bool
Lens' WriterOptions Bool
preferAscii

instance HasWriterOptions WriterOptions where
  writerOptions :: Lens' WriterOptions WriterOptions
writerOptions =
    (WriterOptions -> f WriterOptions)
-> WriterOptions -> f WriterOptions
forall a. a -> a
id
  template :: Lens' WriterOptions (Maybe (Template Text))
template Maybe (Template Text) -> f (Maybe (Template Text))
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Maybe (Template Text) -> WriterOptions)
-> f (Maybe (Template Text)) -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (Template Text)
a00' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00' Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Maybe (Template Text) -> f (Maybe (Template Text))
f Maybe (Template Text)
a00)
  variables :: Lens' WriterOptions (Context Text)
variables Context Text -> f (Context Text)
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Context Text -> WriterOptions)
-> f (Context Text) -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Context Text
a01' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01' Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Context Text -> f (Context Text)
f Context Text
a01)
  tableOfContents :: Lens' WriterOptions Bool
tableOfContents Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a03' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03' Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a03)
  incremental :: Lens' WriterOptions Bool
incremental Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a04' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04' HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a04)
  numberSections :: Lens' WriterOptions Bool
numberSections Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a06' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06' [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a06)
  numberOffset :: Lens' WriterOptions [Int]
numberOffset [Int] -> f [Int]
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    ([Int] -> WriterOptions) -> f [Int] -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Int]
a07' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07' Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) ([Int] -> f [Int]
f [Int]
a07)
  sectionDivs :: Lens' WriterOptions Bool
sectionDivs Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a08' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08' Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a08)
  referenceLinks :: Lens' WriterOptions Bool
referenceLinks Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a10' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10' Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a10)
  dpi :: Lens' WriterOptions Int
dpi Int -> f Int
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Int -> WriterOptions) -> f Int -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
a11' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11' WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Int -> f Int
f Int
a11)
  identifierPrefix :: Lens' WriterOptions Text
identifierPrefix Text -> f Text
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Text -> WriterOptions) -> f Text -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
a15' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15' CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Text -> f Text
f Text
a15)
  htmlQTags :: Lens' WriterOptions Bool
htmlQTags Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a17' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17' Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a17)
  slideLevel :: Lens' WriterOptions (Maybe Int)
slideLevel Maybe Int -> f (Maybe Int)
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Maybe Int -> WriterOptions) -> f (Maybe Int) -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Int
a18' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18' TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Maybe Int -> f (Maybe Int)
f Maybe Int
a18)
  listings :: Lens' WriterOptions Bool
listings Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a20' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20' Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a20)
  highlightStyle :: Lens' WriterOptions (Maybe Style)
highlightStyle Maybe Style -> f (Maybe Style)
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Maybe Style -> WriterOptions)
-> f (Maybe Style) -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Style
a21' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21' Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Maybe Style -> f (Maybe Style)
f Maybe Style
a21)
  setextHeaders :: Lens' WriterOptions Bool
setextHeaders Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a22' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22' Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a22)
  listTables :: Lens' WriterOptions Bool
listTables Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a23' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23' Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a23)
  epubSubdirectory :: Lens' WriterOptions Text
epubSubdirectory Text -> f Text
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Text -> WriterOptions) -> f Text -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
a24' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24' Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Text -> f Text
f Text
a24)
  epubMetadata :: Lens' WriterOptions (Maybe Text)
epubMetadata Maybe Text -> f (Maybe Text)
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Maybe Text -> WriterOptions) -> f (Maybe Text) -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Text
a25' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25' [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Maybe Text -> f (Maybe Text)
f Maybe Text
a25)
  epubFonts :: Lens' WriterOptions [FilePath]
epubFonts [FilePath] -> f [FilePath]
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    ([FilePath] -> WriterOptions) -> f [FilePath] -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[FilePath]
a26' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26' Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) ([FilePath] -> f [FilePath]
f [FilePath]
a26)
  epubTitlePage :: Lens' WriterOptions Bool
epubTitlePage Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a27' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27' Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Bool -> f Bool
f Bool
a27)
  splitLevel :: Lens' WriterOptions Int
splitLevel Int -> f Int
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Int -> WriterOptions) -> f Int -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
a28' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28' PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Int -> f Int
f Int
a28)
  chunkTemplate :: Lens' WriterOptions PathTemplate
chunkTemplate PathTemplate -> f PathTemplate
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (PathTemplate -> WriterOptions)
-> f PathTemplate -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PathTemplate
a29' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29' Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (PathTemplate -> f PathTemplate
f PathTemplate
a29)
  tocDepth :: Lens' WriterOptions Int
tocDepth Int -> f Int
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Int -> WriterOptions) -> f Int -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
a30' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30' Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Int -> f Int
f Int
a30)
  referenceDoc :: Lens' WriterOptions (Maybe FilePath)
referenceDoc Maybe FilePath -> f (Maybe FilePath)
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Maybe FilePath -> WriterOptions)
-> f (Maybe FilePath) -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe FilePath
a31' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31' ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Maybe FilePath -> f (Maybe FilePath)
f Maybe FilePath
a31)
  syntaxMap :: Lens' WriterOptions SyntaxMap
syntaxMap SyntaxMap -> f SyntaxMap
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (SyntaxMap -> WriterOptions) -> f SyntaxMap -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SyntaxMap
a33' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33' Bool
a34) (SyntaxMap -> f SyntaxMap
f SyntaxMap
a33)
  preferAscii :: Lens' WriterOptions Bool
preferAscii Bool -> f Bool
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Bool -> WriterOptions) -> f Bool -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33) (Bool -> f Bool
f Bool
a34)

class AsWriterOptions a where
  _WriterOptions ::
    Prism' a WriterOptions

instance AsWriterOptions WriterOptions where
  _WriterOptions :: Prism' WriterOptions WriterOptions
_WriterOptions =
    p WriterOptions (f WriterOptions)
-> p WriterOptions (f WriterOptions)
forall a. a -> a
id

class HasHTMLMathMethod a where
  htmlMathMethod ::
    Lens' a HTMLMathMethod

instance HasHTMLMathMethod HTMLMathMethod where
  htmlMathMethod :: Lens' HTMLMathMethod HTMLMathMethod
htmlMathMethod =
    (HTMLMathMethod -> f HTMLMathMethod)
-> HTMLMathMethod -> f HTMLMathMethod
forall a. a -> a
id

instance HasHTMLMathMethod WriterOptions where
  htmlMathMethod :: Lens' WriterOptions HTMLMathMethod
htmlMathMethod HTMLMathMethod -> f HTMLMathMethod
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (HTMLMathMethod -> WriterOptions)
-> f HTMLMathMethod -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HTMLMathMethod
a05' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05' Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (HTMLMathMethod -> f HTMLMathMethod
f HTMLMathMethod
a05)

class AsHTMLMathMethod a where
  _HtmlMathMethod ::
    Prism' a HTMLMathMethod
  _PlainMath ::
    Prism' a ()
  _PlainMath =
    p HTMLMathMethod (f HTMLMathMethod) -> p a (f a)
forall a. AsHTMLMathMethod a => Prism' a HTMLMathMethod
Prism' a HTMLMathMethod
_HtmlMathMethod (p HTMLMathMethod (f HTMLMathMethod) -> p a (f a))
-> (p () (f ()) -> p HTMLMathMethod (f HTMLMathMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p HTMLMathMethod (f HTMLMathMethod)
forall a. AsHTMLMathMethod a => Prism' a ()
Prism' HTMLMathMethod ()
_PlainMath
  _WebTeX ::
    Prism' a Text
  _WebTeX =
    p HTMLMathMethod (f HTMLMathMethod) -> p a (f a)
forall a. AsHTMLMathMethod a => Prism' a HTMLMathMethod
Prism' a HTMLMathMethod
_HtmlMathMethod (p HTMLMathMethod (f HTMLMathMethod) -> p a (f a))
-> (p Text (f Text) -> p HTMLMathMethod (f HTMLMathMethod))
-> p Text (f Text)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p HTMLMathMethod (f HTMLMathMethod)
forall a. AsHTMLMathMethod a => Prism' a Text
Prism' HTMLMathMethod Text
_WebTeX
  _GladTeX ::
    Prism' a ()
  _GladTeX =
    p HTMLMathMethod (f HTMLMathMethod) -> p a (f a)
forall a. AsHTMLMathMethod a => Prism' a HTMLMathMethod
Prism' a HTMLMathMethod
_HtmlMathMethod (p HTMLMathMethod (f HTMLMathMethod) -> p a (f a))
-> (p () (f ()) -> p HTMLMathMethod (f HTMLMathMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p HTMLMathMethod (f HTMLMathMethod)
forall a. AsHTMLMathMethod a => Prism' a ()
Prism' HTMLMathMethod ()
_GladTeX
  _MathML ::
    Prism' a ()
  _MathML =
    p HTMLMathMethod (f HTMLMathMethod) -> p a (f a)
forall a. AsHTMLMathMethod a => Prism' a HTMLMathMethod
Prism' a HTMLMathMethod
_HtmlMathMethod (p HTMLMathMethod (f HTMLMathMethod) -> p a (f a))
-> (p () (f ()) -> p HTMLMathMethod (f HTMLMathMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p HTMLMathMethod (f HTMLMathMethod)
forall a. AsHTMLMathMethod a => Prism' a ()
Prism' HTMLMathMethod ()
_MathML
  _MathJax ::
    Prism' a Text
  _MathJax =
    p HTMLMathMethod (f HTMLMathMethod) -> p a (f a)
forall a. AsHTMLMathMethod a => Prism' a HTMLMathMethod
Prism' a HTMLMathMethod
_HtmlMathMethod (p HTMLMathMethod (f HTMLMathMethod) -> p a (f a))
-> (p Text (f Text) -> p HTMLMathMethod (f HTMLMathMethod))
-> p Text (f Text)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p HTMLMathMethod (f HTMLMathMethod)
forall a. AsHTMLMathMethod a => Prism' a Text
Prism' HTMLMathMethod Text
_MathJax
  _KaTeX ::
    Prism' a Text
  _KaTeX =
    p HTMLMathMethod (f HTMLMathMethod) -> p a (f a)
forall a. AsHTMLMathMethod a => Prism' a HTMLMathMethod
Prism' a HTMLMathMethod
_HtmlMathMethod (p HTMLMathMethod (f HTMLMathMethod) -> p a (f a))
-> (p Text (f Text) -> p HTMLMathMethod (f HTMLMathMethod))
-> p Text (f Text)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p HTMLMathMethod (f HTMLMathMethod)
forall a. AsHTMLMathMethod a => Prism' a Text
Prism' HTMLMathMethod Text
_KaTeX

instance AsHTMLMathMethod HTMLMathMethod where
  _HtmlMathMethod :: Prism' HTMLMathMethod HTMLMathMethod
_HtmlMathMethod =
    p HTMLMathMethod (f HTMLMathMethod)
-> p HTMLMathMethod (f HTMLMathMethod)
forall a. a -> a
id
  _PlainMath :: Prism' HTMLMathMethod ()
_PlainMath =
    (() -> HTMLMathMethod)
-> (HTMLMathMethod -> Maybe ()) -> Prism' HTMLMathMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> HTMLMathMethod
PlainMath)
      (\case
        HTMLMathMethod
PlainMath -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        HTMLMathMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _WebTeX :: Prism' HTMLMathMethod Text
_WebTeX =
    (Text -> HTMLMathMethod)
-> (HTMLMathMethod -> Maybe Text) -> Prism' HTMLMathMethod Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      Text -> HTMLMathMethod
WebTeX
      (\case
        WebTeX Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
        HTMLMathMethod
_ -> Maybe Text
forall a. Maybe a
Nothing)
  _GladTeX :: Prism' HTMLMathMethod ()
_GladTeX =
    (() -> HTMLMathMethod)
-> (HTMLMathMethod -> Maybe ()) -> Prism' HTMLMathMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> HTMLMathMethod
GladTeX)
      (\case
        HTMLMathMethod
GladTeX -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        HTMLMathMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _MathML :: Prism' HTMLMathMethod ()
_MathML =
    (() -> HTMLMathMethod)
-> (HTMLMathMethod -> Maybe ()) -> Prism' HTMLMathMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> HTMLMathMethod
MathML)
      (\case
        HTMLMathMethod
MathML -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        HTMLMathMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _MathJax :: Prism' HTMLMathMethod Text
_MathJax =
    (Text -> HTMLMathMethod)
-> (HTMLMathMethod -> Maybe Text) -> Prism' HTMLMathMethod Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      Text -> HTMLMathMethod
MathJax
      (\case
        MathJax Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
        HTMLMathMethod
_ -> Maybe Text
forall a. Maybe a
Nothing)
  _KaTeX :: Prism' HTMLMathMethod Text
_KaTeX =
    (Text -> HTMLMathMethod)
-> (HTMLMathMethod -> Maybe Text) -> Prism' HTMLMathMethod Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      Text -> HTMLMathMethod
KaTeX
      (\case
        KaTeX Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
        HTMLMathMethod
_ -> Maybe Text
forall a. Maybe a
Nothing)

class HasWrapOption a where
  wrapOption ::
    Lens' a WrapOption

instance HasWrapOption WrapOption where
  wrapOption :: Lens' WrapOption WrapOption
wrapOption =
    (WrapOption -> f WrapOption) -> WrapOption -> f WrapOption
forall a. a -> a
id

instance HasWrapOption WriterOptions where
  wrapOption :: Lens' WriterOptions WrapOption
wrapOption WrapOption -> f WrapOption
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (WrapOption -> WriterOptions) -> f WrapOption -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\WrapOption
a12' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12' Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (WrapOption -> f WrapOption
f WrapOption
a12)

class AsWrapOption a where
  _WrapOption ::
    Prism' a WrapOption
  _WrapAuto ::
    Prism' a ()
  _WrapAuto =
    p WrapOption (f WrapOption) -> p a (f a)
forall a. AsWrapOption a => Prism' a WrapOption
Prism' a WrapOption
_WrapOption (p WrapOption (f WrapOption) -> p a (f a))
-> (p () (f ()) -> p WrapOption (f WrapOption))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p WrapOption (f WrapOption)
forall a. AsWrapOption a => Prism' a ()
Prism' WrapOption ()
_WrapAuto
  _WrapNone ::
    Prism' a ()
  _WrapNone =
    p WrapOption (f WrapOption) -> p a (f a)
forall a. AsWrapOption a => Prism' a WrapOption
Prism' a WrapOption
_WrapOption (p WrapOption (f WrapOption) -> p a (f a))
-> (p () (f ()) -> p WrapOption (f WrapOption))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p WrapOption (f WrapOption)
forall a. AsWrapOption a => Prism' a ()
Prism' WrapOption ()
_WrapNone
  _WrapPreserve ::
    Prism' a ()
  _WrapPreserve =
    p WrapOption (f WrapOption) -> p a (f a)
forall a. AsWrapOption a => Prism' a WrapOption
Prism' a WrapOption
_WrapOption (p WrapOption (f WrapOption) -> p a (f a))
-> (p () (f ()) -> p WrapOption (f WrapOption))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p WrapOption (f WrapOption)
forall a. AsWrapOption a => Prism' a ()
Prism' WrapOption ()
_WrapPreserve

instance AsWrapOption WrapOption where
  _WrapOption :: Prism' WrapOption WrapOption
_WrapOption =
    p WrapOption (f WrapOption) -> p WrapOption (f WrapOption)
forall a. a -> a
id
  _WrapAuto :: Prism' WrapOption ()
_WrapAuto =
    (() -> WrapOption)
-> (WrapOption -> Maybe ()) -> Prism' WrapOption ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> WrapOption
WrapAuto)
      (\case
        WrapOption
WrapAuto -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        WrapOption
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _WrapNone :: Prism' WrapOption ()
_WrapNone =
    (() -> WrapOption)
-> (WrapOption -> Maybe ()) -> Prism' WrapOption ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> WrapOption
WrapNone)
      (\case
        WrapOption
WrapNone -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        WrapOption
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _WrapPreserve :: Prism' WrapOption ()
_WrapPreserve =
    (() -> WrapOption)
-> (WrapOption -> Maybe ()) -> Prism' WrapOption ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> WrapOption
WrapPreserve)
      (\case
        WrapOption
WrapPreserve -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        WrapOption
_ -> Maybe ()
forall a. Maybe a
Nothing)

class HasObfuscationMethod a where
  obfuscationMethod ::
    Lens' a ObfuscationMethod

instance HasObfuscationMethod ObfuscationMethod where
  obfuscationMethod :: Lens' ObfuscationMethod ObfuscationMethod
obfuscationMethod =
    (ObfuscationMethod -> f ObfuscationMethod)
-> ObfuscationMethod -> f ObfuscationMethod
forall a. a -> a
id

instance HasObfuscationMethod WriterOptions where
  obfuscationMethod :: Lens' WriterOptions ObfuscationMethod
obfuscationMethod ObfuscationMethod -> f ObfuscationMethod
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (ObfuscationMethod -> WriterOptions)
-> f ObfuscationMethod -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ObfuscationMethod
a14' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14' Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (ObfuscationMethod -> f ObfuscationMethod
f ObfuscationMethod
a14)

class AsObfuscationMethod a where
  _ObfuscationMethod ::
    Prism' a ObfuscationMethod
  _NoObfuscation ::
    Prism' a ()
  _NoObfuscation =
    p ObfuscationMethod (f ObfuscationMethod) -> p a (f a)
forall a. AsObfuscationMethod a => Prism' a ObfuscationMethod
Prism' a ObfuscationMethod
_ObfuscationMethod (p ObfuscationMethod (f ObfuscationMethod) -> p a (f a))
-> (p () (f ()) -> p ObfuscationMethod (f ObfuscationMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p ObfuscationMethod (f ObfuscationMethod)
forall a. AsObfuscationMethod a => Prism' a ()
Prism' ObfuscationMethod ()
_NoObfuscation
  _ReferenceObfuscation ::
    Prism' a ()
  _ReferenceObfuscation =
    p ObfuscationMethod (f ObfuscationMethod) -> p a (f a)
forall a. AsObfuscationMethod a => Prism' a ObfuscationMethod
Prism' a ObfuscationMethod
_ObfuscationMethod (p ObfuscationMethod (f ObfuscationMethod) -> p a (f a))
-> (p () (f ()) -> p ObfuscationMethod (f ObfuscationMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p ObfuscationMethod (f ObfuscationMethod)
forall a. AsObfuscationMethod a => Prism' a ()
Prism' ObfuscationMethod ()
_ReferenceObfuscation
  _JavascriptObfuscation ::
    Prism' a ()
  _JavascriptObfuscation =
    p ObfuscationMethod (f ObfuscationMethod) -> p a (f a)
forall a. AsObfuscationMethod a => Prism' a ObfuscationMethod
Prism' a ObfuscationMethod
_ObfuscationMethod (p ObfuscationMethod (f ObfuscationMethod) -> p a (f a))
-> (p () (f ()) -> p ObfuscationMethod (f ObfuscationMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p ObfuscationMethod (f ObfuscationMethod)
forall a. AsObfuscationMethod a => Prism' a ()
Prism' ObfuscationMethod ()
_JavascriptObfuscation

instance AsObfuscationMethod ObfuscationMethod where
  _ObfuscationMethod :: Prism' ObfuscationMethod ObfuscationMethod
_ObfuscationMethod =
    p ObfuscationMethod (f ObfuscationMethod)
-> p ObfuscationMethod (f ObfuscationMethod)
forall a. a -> a
id
  _NoObfuscation :: Prism' ObfuscationMethod ()
_NoObfuscation =
    (() -> ObfuscationMethod)
-> (ObfuscationMethod -> Maybe ()) -> Prism' ObfuscationMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> ObfuscationMethod
NoObfuscation)
      (\case
        ObfuscationMethod
NoObfuscation -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        ObfuscationMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _ReferenceObfuscation :: Prism' ObfuscationMethod ()
_ReferenceObfuscation =
    (() -> ObfuscationMethod)
-> (ObfuscationMethod -> Maybe ()) -> Prism' ObfuscationMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> ObfuscationMethod
ReferenceObfuscation)
      (\case
        ObfuscationMethod
ReferenceObfuscation -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        ObfuscationMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _JavascriptObfuscation :: Prism' ObfuscationMethod ()
_JavascriptObfuscation =
    (() -> ObfuscationMethod)
-> (ObfuscationMethod -> Maybe ()) -> Prism' ObfuscationMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> ObfuscationMethod
JavascriptObfuscation)
      (\case
        ObfuscationMethod
JavascriptObfuscation -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        ObfuscationMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)

class HasCiteMethod a where
  citeMethod ::
    Lens' a CiteMethod

instance HasCiteMethod CiteMethod where
  citeMethod :: Lens' CiteMethod CiteMethod
citeMethod =
    (CiteMethod -> f CiteMethod) -> CiteMethod -> f CiteMethod
forall a. a -> a
id

instance HasCiteMethod WriterOptions where
  citeMethod :: Lens' WriterOptions CiteMethod
citeMethod CiteMethod -> f CiteMethod
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (CiteMethod -> WriterOptions) -> f CiteMethod -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CiteMethod
a16' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16' Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (CiteMethod -> f CiteMethod
f CiteMethod
a16)

class AsCiteMethod a where
  _CiteMethod ::
    Prism' a CiteMethod
  _Citeproc ::
    Prism' a ()
  _Citeproc =
    p CiteMethod (f CiteMethod) -> p a (f a)
forall a. AsCiteMethod a => Prism' a CiteMethod
Prism' a CiteMethod
_CiteMethod (p CiteMethod (f CiteMethod) -> p a (f a))
-> (p () (f ()) -> p CiteMethod (f CiteMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p CiteMethod (f CiteMethod)
forall a. AsCiteMethod a => Prism' a ()
Prism' CiteMethod ()
_Citeproc
  _Natbib ::
    Prism' a ()
  _Natbib =
    p CiteMethod (f CiteMethod) -> p a (f a)
forall a. AsCiteMethod a => Prism' a CiteMethod
Prism' a CiteMethod
_CiteMethod (p CiteMethod (f CiteMethod) -> p a (f a))
-> (p () (f ()) -> p CiteMethod (f CiteMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p CiteMethod (f CiteMethod)
forall a. AsCiteMethod a => Prism' a ()
Prism' CiteMethod ()
_Natbib
  _Biblatex ::
    Prism' a ()
  _Biblatex =
    p CiteMethod (f CiteMethod) -> p a (f a)
forall a. AsCiteMethod a => Prism' a CiteMethod
Prism' a CiteMethod
_CiteMethod (p CiteMethod (f CiteMethod) -> p a (f a))
-> (p () (f ()) -> p CiteMethod (f CiteMethod))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p CiteMethod (f CiteMethod)
forall a. AsCiteMethod a => Prism' a ()
Prism' CiteMethod ()
_Biblatex

instance AsCiteMethod CiteMethod where
  _CiteMethod :: Prism' CiteMethod CiteMethod
_CiteMethod =
    p CiteMethod (f CiteMethod) -> p CiteMethod (f CiteMethod)
forall a. a -> a
id
  _Citeproc :: Prism' CiteMethod ()
_Citeproc =
    (() -> CiteMethod)
-> (CiteMethod -> Maybe ()) -> Prism' CiteMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> CiteMethod
Citeproc)
      (\case
        CiteMethod
Citeproc -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        CiteMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _Natbib :: Prism' CiteMethod ()
_Natbib =
    (() -> CiteMethod)
-> (CiteMethod -> Maybe ()) -> Prism' CiteMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> CiteMethod
Natbib)
      (\case
        CiteMethod
Natbib -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        CiteMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _Biblatex :: Prism' CiteMethod ()
_Biblatex =
    (() -> CiteMethod)
-> (CiteMethod -> Maybe ()) -> Prism' CiteMethod ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> CiteMethod
Biblatex)
      (\case
        CiteMethod
Biblatex -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        CiteMethod
_ -> Maybe ()
forall a. Maybe a
Nothing)

class HasTopLevelDivision a where
  topLevelDivision ::
    Lens' a TopLevelDivision

instance HasTopLevelDivision TopLevelDivision where
  topLevelDivision :: Lens' TopLevelDivision TopLevelDivision
topLevelDivision =
    (TopLevelDivision -> f TopLevelDivision)
-> TopLevelDivision -> f TopLevelDivision
forall a. a -> a
id

instance HasTopLevelDivision WriterOptions where
  topLevelDivision :: Lens' WriterOptions TopLevelDivision
topLevelDivision TopLevelDivision -> f TopLevelDivision
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (TopLevelDivision -> WriterOptions)
-> f TopLevelDivision -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TopLevelDivision
a19' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19' Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (TopLevelDivision -> f TopLevelDivision
f TopLevelDivision
a19)

class AsTopLevelDivision a where
  _TopLevelDivision ::
    Prism' a TopLevelDivision
  _TopLevelPart ::
    Prism' a ()
  _TopLevelPart =
    p TopLevelDivision (f TopLevelDivision) -> p a (f a)
forall a. AsTopLevelDivision a => Prism' a TopLevelDivision
Prism' a TopLevelDivision
_TopLevelDivision (p TopLevelDivision (f TopLevelDivision) -> p a (f a))
-> (p () (f ()) -> p TopLevelDivision (f TopLevelDivision))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p TopLevelDivision (f TopLevelDivision)
forall a. AsTopLevelDivision a => Prism' a ()
Prism' TopLevelDivision ()
_TopLevelPart
  _TopLevelChapter ::
    Prism' a ()
  _TopLevelChapter =
    p TopLevelDivision (f TopLevelDivision) -> p a (f a)
forall a. AsTopLevelDivision a => Prism' a TopLevelDivision
Prism' a TopLevelDivision
_TopLevelDivision (p TopLevelDivision (f TopLevelDivision) -> p a (f a))
-> (p () (f ()) -> p TopLevelDivision (f TopLevelDivision))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p TopLevelDivision (f TopLevelDivision)
forall a. AsTopLevelDivision a => Prism' a ()
Prism' TopLevelDivision ()
_TopLevelChapter
  _TopLevelSection ::
    Prism' a ()
  _TopLevelSection =
    p TopLevelDivision (f TopLevelDivision) -> p a (f a)
forall a. AsTopLevelDivision a => Prism' a TopLevelDivision
Prism' a TopLevelDivision
_TopLevelDivision (p TopLevelDivision (f TopLevelDivision) -> p a (f a))
-> (p () (f ()) -> p TopLevelDivision (f TopLevelDivision))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p TopLevelDivision (f TopLevelDivision)
forall a. AsTopLevelDivision a => Prism' a ()
Prism' TopLevelDivision ()
_TopLevelSection
  _TopLevelDefault ::
    Prism' a ()
  _TopLevelDefault =
    p TopLevelDivision (f TopLevelDivision) -> p a (f a)
forall a. AsTopLevelDivision a => Prism' a TopLevelDivision
Prism' a TopLevelDivision
_TopLevelDivision (p TopLevelDivision (f TopLevelDivision) -> p a (f a))
-> (p () (f ()) -> p TopLevelDivision (f TopLevelDivision))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p TopLevelDivision (f TopLevelDivision)
forall a. AsTopLevelDivision a => Prism' a ()
Prism' TopLevelDivision ()
_TopLevelDefault

instance AsTopLevelDivision TopLevelDivision where
  _TopLevelDivision :: Prism' TopLevelDivision TopLevelDivision
_TopLevelDivision =
    p TopLevelDivision (f TopLevelDivision)
-> p TopLevelDivision (f TopLevelDivision)
forall a. a -> a
id
  _TopLevelPart :: Prism' TopLevelDivision ()
_TopLevelPart =
    (() -> TopLevelDivision)
-> (TopLevelDivision -> Maybe ()) -> Prism' TopLevelDivision ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> TopLevelDivision
TopLevelPart)
      (\case
        TopLevelDivision
TopLevelPart -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        TopLevelDivision
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _TopLevelChapter :: Prism' TopLevelDivision ()
_TopLevelChapter =
    (() -> TopLevelDivision)
-> (TopLevelDivision -> Maybe ()) -> Prism' TopLevelDivision ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> TopLevelDivision
TopLevelChapter)
      (\case
        TopLevelDivision
TopLevelChapter -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        TopLevelDivision
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _TopLevelSection :: Prism' TopLevelDivision ()
_TopLevelSection =
    (() -> TopLevelDivision)
-> (TopLevelDivision -> Maybe ()) -> Prism' TopLevelDivision ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> TopLevelDivision
TopLevelSection)
      (\case
        TopLevelDivision
TopLevelSection -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        TopLevelDivision
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _TopLevelDefault :: Prism' TopLevelDivision ()
_TopLevelDefault =
    (() -> TopLevelDivision)
-> (TopLevelDivision -> Maybe ()) -> Prism' TopLevelDivision ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> TopLevelDivision
TopLevelDefault)
      (\case
        TopLevelDivision
TopLevelDefault -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        TopLevelDivision
_ -> Maybe ()
forall a. Maybe a
Nothing)

class HasReferenceLocation a where
  referenceLocation ::
    Lens' a ReferenceLocation

instance HasReferenceLocation ReferenceLocation where
  referenceLocation :: Lens' ReferenceLocation ReferenceLocation
referenceLocation =
    (ReferenceLocation -> f ReferenceLocation)
-> ReferenceLocation -> f ReferenceLocation
forall a. a -> a
id

instance HasReferenceLocation WriterOptions where
  referenceLocation :: Lens' WriterOptions ReferenceLocation
referenceLocation ReferenceLocation -> f ReferenceLocation
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (ReferenceLocation -> WriterOptions)
-> f ReferenceLocation -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ReferenceLocation
a32' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32' SyntaxMap
a33 Bool
a34) (ReferenceLocation -> f ReferenceLocation
f ReferenceLocation
a32)

class AsReferenceLocation a where
  _ReferenceLocation ::
    Prism' a ReferenceLocation
  _EndOfBlock ::
    Prism' a ()
  _EndOfBlock =
    p ReferenceLocation (f ReferenceLocation) -> p a (f a)
forall a. AsReferenceLocation a => Prism' a ReferenceLocation
Prism' a ReferenceLocation
_ReferenceLocation (p ReferenceLocation (f ReferenceLocation) -> p a (f a))
-> (p () (f ()) -> p ReferenceLocation (f ReferenceLocation))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p ReferenceLocation (f ReferenceLocation)
forall a. AsReferenceLocation a => Prism' a ()
Prism' ReferenceLocation ()
_EndOfBlock
  _EndOfSection ::
    Prism' a ()
  _EndOfSection =
    p ReferenceLocation (f ReferenceLocation) -> p a (f a)
forall a. AsReferenceLocation a => Prism' a ReferenceLocation
Prism' a ReferenceLocation
_ReferenceLocation (p ReferenceLocation (f ReferenceLocation) -> p a (f a))
-> (p () (f ()) -> p ReferenceLocation (f ReferenceLocation))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p ReferenceLocation (f ReferenceLocation)
forall a. AsReferenceLocation a => Prism' a ()
Prism' ReferenceLocation ()
_EndOfSection
  _EndOfDocument ::
    Prism' a ()
  _EndOfDocument =
    p ReferenceLocation (f ReferenceLocation) -> p a (f a)
forall a. AsReferenceLocation a => Prism' a ReferenceLocation
Prism' a ReferenceLocation
_ReferenceLocation (p ReferenceLocation (f ReferenceLocation) -> p a (f a))
-> (p () (f ()) -> p ReferenceLocation (f ReferenceLocation))
-> p () (f ())
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p ReferenceLocation (f ReferenceLocation)
forall a. AsReferenceLocation a => Prism' a ()
Prism' ReferenceLocation ()
_EndOfDocument

instance AsReferenceLocation ReferenceLocation where
  _ReferenceLocation :: Prism' ReferenceLocation ReferenceLocation
_ReferenceLocation =
    p ReferenceLocation (f ReferenceLocation)
-> p ReferenceLocation (f ReferenceLocation)
forall a. a -> a
id
  _EndOfBlock :: Prism' ReferenceLocation ()
_EndOfBlock =
    (() -> ReferenceLocation)
-> (ReferenceLocation -> Maybe ()) -> Prism' ReferenceLocation ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> ReferenceLocation
EndOfBlock)
      (\case
        ReferenceLocation
EndOfBlock -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        ReferenceLocation
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _EndOfSection :: Prism' ReferenceLocation ()
_EndOfSection =
    (() -> ReferenceLocation)
-> (ReferenceLocation -> Maybe ()) -> Prism' ReferenceLocation ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> ReferenceLocation
EndOfSection)
      (\case
        ReferenceLocation
EndOfSection -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        ReferenceLocation
_ -> Maybe ()
forall a. Maybe a
Nothing)
  _EndOfDocument :: Prism' ReferenceLocation ()
_EndOfDocument =
    (() -> ReferenceLocation)
-> (ReferenceLocation -> Maybe ()) -> Prism' ReferenceLocation ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> ReferenceLocation
EndOfDocument)
      (\case
        ReferenceLocation
EndOfDocument -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        ReferenceLocation
_ -> Maybe ()
forall a. Maybe a
Nothing)

defaultWriterOptions ::
  WriterOptions
defaultWriterOptions :: WriterOptions
defaultWriterOptions =
  Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions
    Maybe (Template Text)
forall a. Maybe a
Nothing
    Context Text
forall a. Monoid a => a
mempty
    Int
4
    Bool
False
    Bool
False
    HTMLMathMethod
PlainMath
    Bool
False
    [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0]
    Bool
False
    Extensions
forall a. Monoid a => a
mempty
    Bool
False
    Int
96
    WrapOption
WrapAuto
    Int
72
    ObfuscationMethod
NoObfuscation
    (FilePath -> Text
Text.pack FilePath
"")
    CiteMethod
Citeproc
    Bool
False
    Maybe Int
forall a. Maybe a
Nothing
    TopLevelDivision
TopLevelDefault
    Bool
False
    (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
pygments)
    Bool
False
    Bool
False
    (FilePath -> Text
Text.pack FilePath
"EPUB")
    Maybe Text
forall a. Maybe a
Nothing
    []
    Bool
True
    Int
1
    (Text -> PathTemplate
PathTemplate (FilePath -> Text
Text.pack FilePath
"%s-%i.html"))
    Int
3
    Maybe FilePath
forall a. Maybe a
Nothing
    ReferenceLocation
EndOfDocument
    SyntaxMap
defaultSyntaxMap
    Bool
False