/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs
Haskell | 244 lines | 171 code | 38 blank | 35 comment | 15 complexity | b3ab18e8c30b29fc8913000dc70e5699 MD5 | raw file
Possible License(s): GPL-2.0, BSD-3-Clause
- {-# 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 = retrieving "WriterOptions" . \idx ->
- liftLua (ltype idx) >>= \case
- TypeUserdata -> peekUD typeWriterOptions idx
- TypeTable -> peekWriterOptionsTable idx
- _ -> failPeek =<<
- typeMismatchMessage "WriterOptions userdata or table" idx
- -- | Pushes a WriterOptions value as userdata object.
- pushWriterOptions :: LuaError e => Pusher e WriterOptions
- pushWriterOptions = pushUD typeWriterOptions
- -- | 'WriterOptions' object type.
- typeWriterOptions :: LuaError e => DocumentedType e WriterOptions
- typeWriterOptions = deftype "WriterOptions"
- [ operation Tostring $ lambda
- ### liftPure show
- <#> udparam typeWriterOptions "opts" "options to print in native format"
- =#> functionResult pushString "string" "Haskell representation"
- ]
- [ property "cite_method"
- "How to print cites"
- (pushViaJSON, writerCiteMethod)
- (peekViaJSON, \opts x -> opts{ writerCiteMethod = x })
- , property "columns"
- "Characters in a line (for text wrapping)"
- (pushIntegral, writerColumns)
- (peekIntegral, \opts x -> opts{ writerColumns = x })
- , property "dpi"
- "DPI for pixel to/from inch/cm conversions"
- (pushIntegral, writerDpi)
- (peekIntegral, \opts x -> opts{ writerDpi = x })
- , property "email_obfuscation"
- "How to obfuscate emails"
- (pushViaJSON, writerEmailObfuscation)
- (peekViaJSON, \opts x -> opts{ writerEmailObfuscation = x })
- , property "epub_chapter_level"
- "Header level for chapters (separate files)"
- (pushIntegral, writerEpubChapterLevel)
- (peekIntegral, \opts x -> opts{ writerEpubChapterLevel = x })
- , property "epub_fonts"
- "Paths to fonts to embed"
- (pushPandocList pushString, writerEpubFonts)
- (peekList peekString, \opts x -> opts{ writerEpubFonts = x })
- , property "epub_metadata"
- "Metadata to include in EPUB"
- (maybe pushnil pushText, writerEpubMetadata)
- (optional . peekText, \opts x -> opts{ writerEpubMetadata = x })
- , property "epub_subdirectory"
- "Subdir for epub in OCF"
- (pushText, writerEpubSubdirectory)
- (peekText, \opts x -> opts{ writerEpubSubdirectory = x })
- , property "extensions"
- "Markdown extensions that can be used"
- (pushViaJSON, writerExtensions)
- (peekViaJSON, \opts x -> opts{ writerExtensions = x })
- , property "highlight_style"
- "Style to use for highlighting (nil = no highlighting)"
- (maybe pushnil pushViaJSON, writerHighlightStyle)
- (optional . peekViaJSON, \opts x -> opts{ writerHighlightStyle = x })
- , property "html_math_method"
- "How to print math in HTML"
- (pushViaJSON, writerHTMLMathMethod)
- (peekViaJSON, \opts x -> opts{ writerHTMLMathMethod = x })
- , property "html_q_tags"
- "Use @<q>@ tags for quotes in HTML"
- (pushBool, writerHtmlQTags)
- (peekBool, \opts x -> opts{ writerHtmlQTags = x })
- , property "identifier_prefix"
- "Prefix for section & note ids in HTML and for footnote marks in markdown"
- (pushText, writerIdentifierPrefix)
- (peekText, \opts x -> opts{ writerIdentifierPrefix = x })
- , property "incremental"
- "True if lists should be incremental"
- (pushBool, writerIncremental)
- (peekBool, \opts x -> opts{ writerIncremental = x })
- , property "listings"
- "Use listings package for code"
- (pushBool, writerListings)
- (peekBool, \opts x -> opts{ writerListings = x })
- , property "number_offset"
- "Starting number for section, subsection, ..."
- (pushPandocList pushIntegral, writerNumberOffset)
- (peekList peekIntegral, \opts x -> opts{ writerNumberOffset = x })
- , property "number_sections"
- "Number sections in LaTeX"
- (pushBool, writerNumberSections)
- (peekBool, \opts x -> opts{ writerNumberSections = x })
- , property "prefer_ascii"
- "Prefer ASCII representations of characters when possible"
- (pushBool, writerPreferAscii)
- (peekBool, \opts x -> opts{ writerPreferAscii = x })
- , property "reference_doc"
- "Path to reference document if specified"
- (maybe pushnil pushString, writerReferenceDoc)
- (optional . peekString, \opts x -> opts{ writerReferenceDoc = x })
- , property "reference_links"
- "Use reference links in writing markdown, rst"
- (pushBool, writerReferenceLinks)
- (peekBool, \opts x -> opts{ writerReferenceLinks = x })
- , property "reference_location"
- "Location of footnotes and references for writing markdown"
- (pushViaJSON, writerReferenceLocation)
- (peekViaJSON, \opts x -> opts{ writerReferenceLocation = x })
- , property "section_divs"
- "Put sections in div tags in HTML"
- (pushBool, writerSectionDivs)
- (peekBool, \opts x -> opts{ writerSectionDivs = x })
- , property "setext_headers"
- "Use setext headers for levels 1-2 in markdown"
- (pushBool, writerSetextHeaders)
- (peekBool, \opts x -> opts{ writerSetextHeaders = x })
- , property "slide_level"
- "Force header level of slides"
- (maybe pushnil pushIntegral, writerSlideLevel)
- (optional . peekIntegral, \opts x -> opts{ writerSlideLevel = x })
- -- , property "syntax_map" "Syntax highlighting definition"
- -- (pushViaJSON, writerSyntaxMap)
- -- (peekViaJSON, \opts x -> opts{ writerSyntaxMap = x })
- -- :: SyntaxMap
- , property "tab_stop"
- "Tabstop for conversion btw spaces and tabs"
- (pushIntegral, writerTabStop)
- (peekIntegral, \opts x -> opts{ writerTabStop = x })
- , property "table_of_contents"
- "Include table of contents"
- (pushBool, writerTableOfContents)
- (peekBool, \opts x -> opts{ writerTableOfContents = x })
- , property "template"
- "Template to use"
- (maybe pushnil pushTemplate, writerTemplate)
- (optional . peekTemplate, \opts x -> opts{ writerTemplate = x })
- -- :: Maybe (Template Text)
- , property "toc_depth"
- "Number of levels to include in TOC"
- (pushIntegral, writerTOCDepth)
- (peekIntegral, \opts x -> opts{ writerTOCDepth = x })
- , property "top_level_division"
- "Type of top-level divisions"
- (pushViaJSON, writerTopLevelDivision)
- (peekViaJSON, \opts x -> opts{ writerTopLevelDivision = x })
- , property "variables"
- "Variables to set in template"
- (pushViaJSON, writerVariables)
- (peekViaJSON, \opts x -> opts{ writerVariables = x })
- , property "wrap_text"
- "Option for wrapping text"
- (pushViaJSON, writerWrapText)
- (peekViaJSON, \opts x -> opts{ writerWrapText = 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 idx = retrieving "WriterOptions (table)" $ do
- liftLua $ do
- absidx <- absindex idx
- pushUD typeWriterOptions def
- let setFields = do
- next absidx >>= \case
- False -> return () -- all fields were copied
- True -> do
- pushvalue (nth 2) *> insert (nth 2)
- settable (nth 4) -- set in userdata object
- setFields
- pushnil -- first key
- setFields
- peekUD typeWriterOptions top `lastly` pop 1
- instance Pushable WriterOptions where
- push = pushWriterOptions