{-# LANGUAGE CPP                  #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.WriterOptions
   Copyright   : © 2021-2023 Albert Krewinkel, John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Marshaling instance for WriterOptions and its components.
-}
module Text.Pandoc.Lua.Marshal.WriterOptions
  ( peekWriterOptions
  , pushWriterOptions
  ) where

import Control.Applicative (optional)
import Data.Default (def)
import HsLua as Lua
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshal.Context (peekContext, pushContext)
import Text.Pandoc.Lua.Marshal.Format (peekExtensions, pushExtensions)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Lua.Marshal.Template (peekTemplate, pushTemplate)
import Text.Pandoc.Options (WriterOptions (..))

--
-- Writer Options
--

-- | Retrieve a WriterOptions value, either from a normal WriterOptions
-- value, from a read-only object, or from a table with the same
-- keys as a WriterOptions object.
peekWriterOptions :: Peeker PandocError WriterOptions
peekWriterOptions :: Peeker PandocError WriterOptions
peekWriterOptions = Name
-> Peek PandocError WriterOptions -> Peek PandocError WriterOptions
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"WriterOptions" (Peek PandocError WriterOptions -> Peek PandocError WriterOptions)
-> Peeker PandocError WriterOptions
-> Peeker PandocError WriterOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx ->
  LuaE PandocError Type -> Peek PandocError Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE PandocError Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek PandocError Type
-> (Type -> Peek PandocError WriterOptions)
-> Peek PandocError WriterOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeUserdata -> DocumentedTypeWithList PandocError WriterOptions Void
-> Peeker PandocError WriterOptions
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList PandocError WriterOptions Void
typeWriterOptions StackIndex
idx
    Type
TypeTable    -> Peeker PandocError WriterOptions
peekWriterOptionsTable StackIndex
idx
    Type
_            -> ByteString -> Peek PandocError WriterOptions
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek PandocError WriterOptions)
-> Peek PandocError ByteString -> Peek PandocError WriterOptions
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    Name -> StackIndex -> Peek PandocError ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"WriterOptions userdata or table" StackIndex
idx

-- | Pushes a WriterOptions value as userdata object.
pushWriterOptions :: Pusher PandocError WriterOptions
pushWriterOptions :: Pusher PandocError WriterOptions
pushWriterOptions = DocumentedTypeWithList PandocError WriterOptions Void
-> Pusher PandocError WriterOptions
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList PandocError WriterOptions Void
typeWriterOptions

-- | 'WriterOptions' object type.
typeWriterOptions :: DocumentedType PandocError WriterOptions
typeWriterOptions :: DocumentedTypeWithList PandocError WriterOptions Void
typeWriterOptions = Name
-> [(Operation, DocumentedFunction PandocError)]
-> [Member
      PandocError (DocumentedFunction PandocError) WriterOptions]
-> DocumentedTypeWithList PandocError WriterOptions Void
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"WriterOptions"
  [ Operation
-> DocumentedFunction PandocError
-> (Operation, DocumentedFunction PandocError)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction PandocError
 -> (Operation, DocumentedFunction PandocError))
-> DocumentedFunction PandocError
-> (Operation, DocumentedFunction PandocError)
forall a b. (a -> b) -> a -> b
$ (WriterOptions -> LuaE PandocError String)
-> HsFnPrecursor
     PandocError (WriterOptions -> LuaE PandocError String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    HsFnPrecursor
  PandocError (WriterOptions -> LuaE PandocError String)
-> Parameter PandocError WriterOptions
-> HsFnPrecursor PandocError (LuaE PandocError String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedTypeWithList PandocError WriterOptions Void
-> Text -> Text -> Parameter PandocError WriterOptions
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedTypeWithList PandocError WriterOptions Void
typeWriterOptions Text
"opts" Text
"options to print in native format"
    HsFnPrecursor PandocError (LuaE PandocError String)
-> FunctionResults PandocError String
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError String
-> TypeSpec -> Text -> FunctionResults PandocError String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher PandocError String
forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"Haskell representation"
  ]
  [ Name
-> Text
-> (Pusher PandocError PathTemplate, WriterOptions -> PathTemplate)
-> (Peeker PandocError PathTemplate,
    WriterOptions -> PathTemplate -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"chunk_template"
    Text
"Templates used to generate chunked HTML filenames (string)"
    (Pusher PandocError PathTemplate
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> PathTemplate
writerChunkTemplate)
    (Peeker PandocError PathTemplate
forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts PathTemplate
x -> WriterOptions
opts{ writerChunkTemplate :: PathTemplate
writerChunkTemplate = PathTemplate
x })

  , Name
-> Text
-> (Pusher PandocError CiteMethod, WriterOptions -> CiteMethod)
-> (Peeker PandocError CiteMethod,
    WriterOptions -> CiteMethod -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"cite_method"
    Text
"How to print cites"
    (Pusher PandocError CiteMethod
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> CiteMethod
writerCiteMethod)
    (Peeker PandocError CiteMethod
forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts CiteMethod
x -> WriterOptions
opts{ writerCiteMethod :: CiteMethod
writerCiteMethod = CiteMethod
x })

  , Name
-> Text
-> (Pusher PandocError Int, WriterOptions -> Int)
-> (Peeker PandocError Int, WriterOptions -> Int -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"columns"
    Text
"Characters in a line (for text wrapping)"
    (Pusher PandocError Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerColumns)
    (Peeker PandocError Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerColumns :: Int
writerColumns = Int
x })

  , Name
-> Text
-> (Pusher PandocError Int, WriterOptions -> Int)
-> (Peeker PandocError Int, WriterOptions -> Int -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"dpi"
    Text
"DPI for pixel to/from inch/cm conversions"
    (Pusher PandocError Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerDpi)
    (Peeker PandocError Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerDpi :: Int
writerDpi = Int
x })

  , Name
-> Text
-> (Pusher PandocError ObfuscationMethod,
    WriterOptions -> ObfuscationMethod)
-> (Peeker PandocError ObfuscationMethod,
    WriterOptions -> ObfuscationMethod -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"email_obfuscation"
    Text
"How to obfuscate emails"
    (Pusher PandocError ObfuscationMethod
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> ObfuscationMethod
writerEmailObfuscation)
    (Peeker PandocError ObfuscationMethod
forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts ObfuscationMethod
x -> WriterOptions
opts{ writerEmailObfuscation :: ObfuscationMethod
writerEmailObfuscation = ObfuscationMethod
x })

  , Name
-> Text
-> (Pusher PandocError Int, WriterOptions -> Int)
-> (Peeker PandocError Int, WriterOptions -> Int -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"split_level"
    Text
"Level at which EPUB or chunked HTML documents are split into files"
    (Pusher PandocError Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerSplitLevel)
    (Peeker PandocError Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerSplitLevel :: Int
writerSplitLevel = Int
x })

  , Name
-> Text
-> (Pusher PandocError Int, WriterOptions -> Int)
-> (Peeker PandocError Int, WriterOptions -> Int -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"epub_chapter_level"
    Text
"Deprecated synonym for split_level"
    (Pusher PandocError Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerSplitLevel)
    (Peeker PandocError Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerSplitLevel :: Int
writerSplitLevel = Int
x })

  , Name
-> Text
-> (Pusher PandocError [String], WriterOptions -> [String])
-> (Peeker PandocError [String],
    WriterOptions -> [String] -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"epub_fonts"
    Text
"Paths to fonts to embed"
    (Pusher PandocError String -> Pusher PandocError [String]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher PandocError String
forall e. String -> LuaE e ()
pushString, WriterOptions -> [String]
writerEpubFonts)
    (Peeker PandocError String -> Peeker PandocError [String]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker PandocError String
forall e. Peeker e String
peekString, \WriterOptions
opts [String]
x -> WriterOptions
opts{ writerEpubFonts :: [String]
writerEpubFonts = [String]
x })

  , Name
-> Text
-> (Pusher PandocError (Maybe Text), WriterOptions -> Maybe Text)
-> (Peeker PandocError (Maybe Text),
    WriterOptions -> Maybe Text -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"epub_metadata"
    Text
"Metadata to include in EPUB"
    (LuaE PandocError ()
-> (Text -> LuaE PandocError ()) -> Pusher PandocError (Maybe Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE PandocError ()
forall e. LuaE e ()
pushnil Text -> LuaE PandocError ()
forall e. Pusher e Text
pushText, WriterOptions -> Maybe Text
writerEpubMetadata)
    (Peek PandocError Text -> Peek PandocError (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek PandocError Text -> Peek PandocError (Maybe Text))
-> (StackIndex -> Peek PandocError Text)
-> Peeker PandocError (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek PandocError Text
forall e. Peeker e Text
peekText, \WriterOptions
opts Maybe Text
x -> WriterOptions
opts{ writerEpubMetadata :: Maybe Text
writerEpubMetadata = Maybe Text
x })

  , Name
-> Text
-> (Text -> LuaE PandocError (), WriterOptions -> Text)
-> (StackIndex -> Peek PandocError Text,
    WriterOptions -> Text -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"epub_subdirectory"
    Text
"Subdir for epub in OCF"
    (Text -> LuaE PandocError ()
forall e. Pusher e Text
pushText, WriterOptions -> Text
writerEpubSubdirectory)
    (StackIndex -> Peek PandocError Text
forall e. Peeker e Text
peekText, \WriterOptions
opts Text
x -> WriterOptions
opts{ writerEpubSubdirectory :: Text
writerEpubSubdirectory = Text
x })

  , Name
-> Text
-> (Pusher PandocError Extensions, WriterOptions -> Extensions)
-> (Peeker PandocError Extensions,
    WriterOptions -> Extensions -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"extensions"
    Text
"Markdown extensions that can be used"
    (Pusher PandocError Extensions
forall e. LuaError e => Pusher e Extensions
pushExtensions, WriterOptions -> Extensions
writerExtensions)
    (Peeker PandocError Extensions
forall e. LuaError e => Peeker e Extensions
peekExtensions, \WriterOptions
opts Extensions
x -> WriterOptions
opts{ writerExtensions :: Extensions
writerExtensions = Extensions
x })

  , Name
-> Text
-> (Pusher PandocError (Maybe Style), WriterOptions -> Maybe Style)
-> (Peeker PandocError (Maybe Style),
    WriterOptions -> Maybe Style -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"highlight_style"
    Text
"Style to use for highlighting (nil = no highlighting)"
    (LuaE PandocError ()
-> (Style -> LuaE PandocError ())
-> Pusher PandocError (Maybe Style)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE PandocError ()
forall e. LuaE e ()
pushnil Style -> LuaE PandocError ()
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> Maybe Style
writerHighlightStyle)
    (Peek PandocError Style -> Peek PandocError (Maybe Style)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek PandocError Style -> Peek PandocError (Maybe Style))
-> (StackIndex -> Peek PandocError Style)
-> Peeker PandocError (Maybe Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek PandocError Style
forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts Maybe Style
x -> WriterOptions
opts{ writerHighlightStyle :: Maybe Style
writerHighlightStyle = Maybe Style
x })

  , Name
-> Text
-> (Pusher PandocError HTMLMathMethod,
    WriterOptions -> HTMLMathMethod)
-> (Peeker PandocError HTMLMathMethod,
    WriterOptions -> HTMLMathMethod -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"html_math_method"
    Text
"How to print math in HTML"
    (Pusher PandocError HTMLMathMethod
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> HTMLMathMethod
writerHTMLMathMethod)
    (Peeker PandocError HTMLMathMethod
forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts HTMLMathMethod
x -> WriterOptions
opts{ writerHTMLMathMethod :: HTMLMathMethod
writerHTMLMathMethod = HTMLMathMethod
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"html_q_tags"
    Text
"Use @<q>@ tags for quotes in HTML"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerHtmlQTags)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerHtmlQTags :: Bool
writerHtmlQTags = Bool
x })

  , Name
-> Text
-> (Text -> LuaE PandocError (), WriterOptions -> Text)
-> (StackIndex -> Peek PandocError Text,
    WriterOptions -> Text -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"identifier_prefix"
    Text
"Prefix for section & note ids in HTML and for footnote marks in markdown"
    (Text -> LuaE PandocError ()
forall e. Pusher e Text
pushText, WriterOptions -> Text
writerIdentifierPrefix)
    (StackIndex -> Peek PandocError Text
forall e. Peeker e Text
peekText, \WriterOptions
opts Text
x -> WriterOptions
opts{ writerIdentifierPrefix :: Text
writerIdentifierPrefix = Text
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"incremental"
    Text
"True if lists should be incremental"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerIncremental)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerIncremental :: Bool
writerIncremental = Bool
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"listings"
    Text
"Use listings package for code"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerListings)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerListings :: Bool
writerListings = Bool
x })

  , Name
-> Text
-> (Pusher PandocError [Int], WriterOptions -> [Int])
-> (Peeker PandocError [Int],
    WriterOptions -> [Int] -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"number_offset"
    Text
"Starting number for section, subsection, ..."
    (Pusher PandocError Int -> Pusher PandocError [Int]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher PandocError Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> [Int]
writerNumberOffset)
    (Peeker PandocError Int -> Peeker PandocError [Int]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker PandocError Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts [Int]
x -> WriterOptions
opts{ writerNumberOffset :: [Int]
writerNumberOffset = [Int]
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"number_sections"
    Text
"Number sections in LaTeX"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerNumberSections)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerNumberSections :: Bool
writerNumberSections = Bool
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"prefer_ascii"
    Text
"Prefer ASCII representations of characters when possible"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerPreferAscii)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerPreferAscii :: Bool
writerPreferAscii = Bool
x })

  , Name
-> Text
-> (Pusher PandocError (Maybe String),
    WriterOptions -> Maybe String)
-> (Peeker PandocError (Maybe String),
    WriterOptions -> Maybe String -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"reference_doc"
    Text
"Path to reference document if specified"
    (LuaE PandocError ()
-> Pusher PandocError String -> Pusher PandocError (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE PandocError ()
forall e. LuaE e ()
pushnil Pusher PandocError String
forall e. String -> LuaE e ()
pushString, WriterOptions -> Maybe String
writerReferenceDoc)
    (Peek PandocError String -> Peek PandocError (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek PandocError String -> Peek PandocError (Maybe String))
-> Peeker PandocError String -> Peeker PandocError (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker PandocError String
forall e. Peeker e String
peekString, \WriterOptions
opts Maybe String
x -> WriterOptions
opts{ writerReferenceDoc :: Maybe String
writerReferenceDoc = Maybe String
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"reference_links"
    Text
"Use reference links in writing markdown, rst"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerReferenceLinks)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerReferenceLinks :: Bool
writerReferenceLinks = Bool
x })

  , Name
-> Text
-> (Pusher PandocError ReferenceLocation,
    WriterOptions -> ReferenceLocation)
-> (Peeker PandocError ReferenceLocation,
    WriterOptions -> ReferenceLocation -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"reference_location"
    Text
"Location of footnotes and references for writing markdown"
    (Pusher PandocError ReferenceLocation
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> ReferenceLocation
writerReferenceLocation)
    (Peeker PandocError ReferenceLocation
forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts ReferenceLocation
x -> WriterOptions
opts{ writerReferenceLocation :: ReferenceLocation
writerReferenceLocation = ReferenceLocation
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"section_divs"
    Text
"Put sections in div tags in HTML"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerSectionDivs)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerSectionDivs :: Bool
writerSectionDivs = Bool
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"setext_headers"
    Text
"Use setext headers for levels 1-2 in markdown"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerSetextHeaders)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerSetextHeaders :: Bool
writerSetextHeaders = Bool
x })

  , Name
-> Text
-> (Pusher PandocError (Maybe Int), WriterOptions -> Maybe Int)
-> (Peeker PandocError (Maybe Int),
    WriterOptions -> Maybe Int -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"slide_level"
    Text
"Force header level of slides"
    (LuaE PandocError ()
-> Pusher PandocError Int -> Pusher PandocError (Maybe Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE PandocError ()
forall e. LuaE e ()
pushnil Pusher PandocError Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Maybe Int
writerSlideLevel)
    (Peek PandocError Int -> Peek PandocError (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek PandocError Int -> Peek PandocError (Maybe Int))
-> Peeker PandocError Int -> Peeker PandocError (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker PandocError Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Maybe Int
x -> WriterOptions
opts{ writerSlideLevel :: Maybe Int
writerSlideLevel = Maybe Int
x })

  -- , property "syntax_map" "Syntax highlighting definition"
  --   (pushViaJSON, writerSyntaxMap)
  --   (peekViaJSON, \opts x -> opts{ writerSyntaxMap = x })
    -- :: SyntaxMap

  , Name
-> Text
-> (Pusher PandocError Int, WriterOptions -> Int)
-> (Peeker PandocError Int, WriterOptions -> Int -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"tab_stop"
    Text
"Tabstop for conversion btw spaces and tabs"
    (Pusher PandocError Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerTabStop)
    (Peeker PandocError Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerTabStop :: Int
writerTabStop = Int
x })

  , Name
-> Text
-> (Pusher PandocError Bool, WriterOptions -> Bool)
-> (Peeker PandocError Bool,
    WriterOptions -> Bool -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"table_of_contents"
    Text
"Include table of contents"
    (Pusher PandocError Bool
forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerTableOfContents)
    (Peeker PandocError Bool
forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerTableOfContents :: Bool
writerTableOfContents = Bool
x })

  , Name
-> Text
-> (Pusher PandocError (Maybe (Template Text)),
    WriterOptions -> Maybe (Template Text))
-> (Peeker PandocError (Maybe (Template Text)),
    WriterOptions -> Maybe (Template Text) -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"template"
    Text
"Template to use"
    (LuaE PandocError ()
-> (Template Text -> LuaE PandocError ())
-> Pusher PandocError (Maybe (Template Text))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE PandocError ()
forall e. LuaE e ()
pushnil Template Text -> LuaE PandocError ()
forall e. LuaError e => Pusher e (Template Text)
pushTemplate, WriterOptions -> Maybe (Template Text)
writerTemplate)
    (Peek PandocError (Template Text)
-> Peek PandocError (Maybe (Template Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek PandocError (Template Text)
 -> Peek PandocError (Maybe (Template Text)))
-> (StackIndex -> Peek PandocError (Template Text))
-> Peeker PandocError (Maybe (Template Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek PandocError (Template Text)
peekTemplate, \WriterOptions
opts Maybe (Template Text)
x -> WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Maybe (Template Text)
x })
    -- :: Maybe (Template Text)

  , Name
-> Text
-> (Pusher PandocError Int, WriterOptions -> Int)
-> (Peeker PandocError Int, WriterOptions -> Int -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"toc_depth"
    Text
"Number of levels to include in TOC"
    (Pusher PandocError Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerTOCDepth)
    (Peeker PandocError Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerTOCDepth :: Int
writerTOCDepth = Int
x })

  , Name
-> Text
-> (Pusher PandocError TopLevelDivision,
    WriterOptions -> TopLevelDivision)
-> (Peeker PandocError TopLevelDivision,
    WriterOptions -> TopLevelDivision -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"top_level_division"
    Text
"Type of top-level divisions"
    (Pusher PandocError TopLevelDivision
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> TopLevelDivision
writerTopLevelDivision)
    (Peeker PandocError TopLevelDivision
forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts TopLevelDivision
x -> WriterOptions
opts{ writerTopLevelDivision :: TopLevelDivision
writerTopLevelDivision = TopLevelDivision
x })

  , Name
-> Text
-> (Pusher PandocError (Context Text),
    WriterOptions -> Context Text)
-> (Peeker PandocError (Context Text),
    WriterOptions -> Context Text -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"variables"
    Text
"Variables to set in template"
    (Pusher PandocError (Context Text)
forall e. LuaError e => Pusher e (Context Text)
pushContext, WriterOptions -> Context Text
writerVariables)
    (Peeker PandocError (Context Text)
forall e. LuaError e => Peeker e (Context Text)
peekContext, \WriterOptions
opts Context Text
x -> WriterOptions
opts{ writerVariables :: Context Text
writerVariables = Context Text
x })

  , Name
-> Text
-> (Pusher PandocError WrapOption, WriterOptions -> WrapOption)
-> (Peeker PandocError WrapOption,
    WriterOptions -> WrapOption -> WriterOptions)
-> Member
     PandocError (DocumentedFunction PandocError) WriterOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"wrap_text"
    Text
"Option for wrapping text"
    (Pusher PandocError WrapOption
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> WrapOption
writerWrapText)
    (Peeker PandocError WrapOption
forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts WrapOption
x -> WriterOptions
opts{ writerWrapText :: WrapOption
writerWrapText = WrapOption
x })
  ]

-- | Retrieves a 'WriterOptions' object from a table on the stack, using
-- the default values for all missing fields.
--
-- Internally, this pushes the default writer options, sets each
-- key/value pair of the table in the userdata value, then retrieves the
-- object again. This will update all fields and complain about unknown
-- keys.
peekWriterOptionsTable :: Peeker PandocError WriterOptions
peekWriterOptionsTable :: Peeker PandocError WriterOptions
peekWriterOptionsTable StackIndex
idx = Name
-> Peek PandocError WriterOptions -> Peek PandocError WriterOptions
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"WriterOptions (table)" (Peek PandocError WriterOptions -> Peek PandocError WriterOptions)
-> Peek PandocError WriterOptions -> Peek PandocError WriterOptions
forall a b. (a -> b) -> a -> b
$ do
  LuaE PandocError () -> Peek PandocError ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE PandocError () -> Peek PandocError ())
-> LuaE PandocError () -> Peek PandocError ()
forall a b. (a -> b) -> a -> b
$ do
    StackIndex
absidx <- StackIndex -> LuaE PandocError StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
    DocumentedTypeWithList PandocError WriterOptions Void
-> Pusher PandocError WriterOptions
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList PandocError WriterOptions Void
typeWriterOptions WriterOptions
forall a. Default a => a
def
    let setFields :: LuaE PandocError ()
setFields = do
          StackIndex -> LuaE PandocError Bool
forall e. LuaError e => StackIndex -> LuaE e Bool
next StackIndex
absidx LuaE PandocError Bool
-> Pusher PandocError Bool -> LuaE PandocError ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
False -> () -> LuaE PandocError ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- all fields were copied
            Bool
True -> do
              StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2) LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
insert (CInt -> StackIndex
nth CInt
2)
              StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
settable (CInt -> StackIndex
nth CInt
4) -- set in userdata object
              LuaE PandocError ()
setFields
    LuaE PandocError ()
forall e. LuaE e ()
pushnil -- first key
    LuaE PandocError ()
setFields
  DocumentedTypeWithList PandocError WriterOptions Void
-> Peeker PandocError WriterOptions
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList PandocError WriterOptions Void
typeWriterOptions StackIndex
top Peek PandocError WriterOptions
-> LuaE PandocError () -> Peek PandocError WriterOptions
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Pusher PandocError Int
forall e. Int -> LuaE e ()
pop Int
1