{-# LANGUAGE CPP                  #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.WriterOptions
   Copyright   : © 2021-2022 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
#if !MIN_VERSION_hslua(2,2,0)
import HsLua.Aeson (peekViaJSON, pushViaJSON)
#endif
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 :: LuaError e => Peeker e WriterOptions
peekWriterOptions :: forall e. LuaError e => Peeker e WriterOptions
peekWriterOptions = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"WriterOptions" forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx ->
  forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeUserdata -> forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e WriterOptions
typeWriterOptions StackIndex
idx
    Type
TypeTable    -> forall e. LuaError e => Peeker e WriterOptions
peekWriterOptionsTable StackIndex
idx
    Type
_            -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"WriterOptions userdata or table" StackIndex
idx

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

-- | 'WriterOptions' object type.
typeWriterOptions :: LuaError e => DocumentedType e WriterOptions
typeWriterOptions :: forall e. LuaError e => DocumentedType e WriterOptions
typeWriterOptions = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"WriterOptions"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e WriterOptions
typeWriterOptions Text
"opts" Text
"options to print in native format"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString Text
"string" Text
"Haskell representation"
  ]
  [ 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"
    (forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> CiteMethod
writerCiteMethod)
    (forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts CiteMethod
x -> WriterOptions
opts{ writerCiteMethod :: CiteMethod
writerCiteMethod = CiteMethod
x })

  , 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)"
    (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerColumns)
    (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerColumns :: Int
writerColumns = Int
x })

  , 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"
    (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerDpi)
    (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerDpi :: Int
writerDpi = Int
x })

  , 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"
    (forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> ObfuscationMethod
writerEmailObfuscation)
    (forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts ObfuscationMethod
x -> WriterOptions
opts{ writerEmailObfuscation :: ObfuscationMethod
writerEmailObfuscation = ObfuscationMethod
x })

  , 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
"Header level for chapters (separate files)"
    (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerEpubChapterLevel)
    (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerEpubChapterLevel :: Int
writerEpubChapterLevel = Int
x })

  , 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"
    (forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall e. String -> LuaE e ()
pushString, WriterOptions -> [String]
writerEpubFonts)
    (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. Peeker e String
peekString, \WriterOptions
opts [String]
x -> WriterOptions
opts{ writerEpubFonts :: [String]
writerEpubFonts = [String]
x })

  , 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"
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil forall e. Pusher e Text
pushText, WriterOptions -> Maybe Text
writerEpubMetadata)
    (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Peeker e Text
peekText, \WriterOptions
opts Maybe Text
x -> WriterOptions
opts{ writerEpubMetadata :: Maybe Text
writerEpubMetadata = Maybe Text
x })

  , 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"
    (forall e. Pusher e Text
pushText, WriterOptions -> Text
writerEpubSubdirectory)
    (forall e. Peeker e Text
peekText, \WriterOptions
opts Text
x -> WriterOptions
opts{ writerEpubSubdirectory :: Text
writerEpubSubdirectory = Text
x })

  , 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"
    (forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> Extensions
writerExtensions)
    (forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts Extensions
x -> WriterOptions
opts{ writerExtensions :: Extensions
writerExtensions = Extensions
x })

  , 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)"
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> Maybe Style
writerHighlightStyle)
    (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 })

  , 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"
    (forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> HTMLMathMethod
writerHTMLMathMethod)
    (forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts HTMLMathMethod
x -> WriterOptions
opts{ writerHTMLMathMethod :: HTMLMathMethod
writerHTMLMathMethod = HTMLMathMethod
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerHtmlQTags)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerHtmlQTags :: Bool
writerHtmlQTags = Bool
x })

  , 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"
    (forall e. Pusher e Text
pushText, WriterOptions -> Text
writerIdentifierPrefix)
    (forall e. Peeker e Text
peekText, \WriterOptions
opts Text
x -> WriterOptions
opts{ writerIdentifierPrefix :: Text
writerIdentifierPrefix = Text
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerIncremental)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerIncremental :: Bool
writerIncremental = Bool
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerListings)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerListings :: Bool
writerListings = Bool
x })

  , 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, ..."
    (forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> [Int]
writerNumberOffset)
    (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts [Int]
x -> WriterOptions
opts{ writerNumberOffset :: [Int]
writerNumberOffset = [Int]
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerNumberSections)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerNumberSections :: Bool
writerNumberSections = Bool
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerPreferAscii)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerPreferAscii :: Bool
writerPreferAscii = Bool
x })

  , 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"
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil forall e. String -> LuaE e ()
pushString, WriterOptions -> Maybe String
writerReferenceDoc)
    (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Peeker e String
peekString, \WriterOptions
opts Maybe String
x -> WriterOptions
opts{ writerReferenceDoc :: Maybe String
writerReferenceDoc = Maybe String
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerReferenceLinks)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerReferenceLinks :: Bool
writerReferenceLinks = Bool
x })

  , 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"
    (forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> ReferenceLocation
writerReferenceLocation)
    (forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts ReferenceLocation
x -> WriterOptions
opts{ writerReferenceLocation :: ReferenceLocation
writerReferenceLocation = ReferenceLocation
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerSectionDivs)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerSectionDivs :: Bool
writerSectionDivs = Bool
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerSetextHeaders)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerSetextHeaders :: Bool
writerSetextHeaders = Bool
x })

  , 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"
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Maybe Int
writerSlideLevel)
    (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

  , 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"
    (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerTabStop)
    (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerTabStop :: Int
writerTabStop = Int
x })

  , 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"
    (forall e. Pusher e Bool
pushBool, WriterOptions -> Bool
writerTableOfContents)
    (forall e. Peeker e Bool
peekBool, \WriterOptions
opts Bool
x -> WriterOptions
opts{ writerTableOfContents :: Bool
writerTableOfContents = Bool
x })

  , 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"
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil forall e. LuaError e => Pusher e (Template Text)
pushTemplate, WriterOptions -> Maybe (Template Text)
writerTemplate)
    (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e (Template Text)
peekTemplate, \WriterOptions
opts Maybe (Template Text)
x -> WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Maybe (Template Text)
x })
    -- :: Maybe (Template Text)

  , 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"
    (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, WriterOptions -> Int
writerTOCDepth)
    (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \WriterOptions
opts Int
x -> WriterOptions
opts{ writerTOCDepth :: Int
writerTOCDepth = Int
x })

  , 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"
    (forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> TopLevelDivision
writerTopLevelDivision)
    (forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts TopLevelDivision
x -> WriterOptions
opts{ writerTopLevelDivision :: TopLevelDivision
writerTopLevelDivision = TopLevelDivision
x })

  , 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"
    (forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> Context Text
writerVariables)
    (forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON, \WriterOptions
opts Context Text
x -> WriterOptions
opts{ writerVariables :: Context Text
writerVariables = Context Text
x })

  , 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"
    (forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON, WriterOptions -> WrapOption
writerWrapText)
    (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 :: LuaError e => Peeker e WriterOptions
peekWriterOptionsTable :: forall e. LuaError e => Peeker e WriterOptions
peekWriterOptionsTable StackIndex
idx = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"WriterOptions (table)" forall a b. (a -> b) -> a -> b
$ do
  forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ do
    StackIndex
absidx <- forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
    forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e WriterOptions
typeWriterOptions forall a. Default a => a
def
    let setFields :: LuaE e ()
setFields = do
          forall e. LuaError e => StackIndex -> LuaE e Bool
next StackIndex
absidx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- all fields were copied
            Bool
True -> do
              forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. StackIndex -> LuaE e ()
insert (CInt -> StackIndex
nth CInt
2)
              forall e. LuaError e => StackIndex -> LuaE e ()
settable (CInt -> StackIndex
nth CInt
4) -- set in userdata object
              LuaE e ()
setFields
    forall e. LuaE e ()
pushnil -- first key
    LuaE e ()
setFields
  forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e WriterOptions
typeWriterOptions StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1

instance Pushable WriterOptions where
  push :: forall e. LuaError e => Pusher e WriterOptions
push = forall e. LuaError e => Pusher e WriterOptions
pushWriterOptions