path: root/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs

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

   Maintainer  : Albert Krewinkel <[email protected]>
   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 = 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 :: Pusher PandocError WriterOptions
pushWriterOptions = pushUD typeWriterOptions

-- | 'WriterOptions' object type.
typeWriterOptions :: DocumentedType PandocError WriterOptions
typeWriterOptions = deftype "WriterOptions"
  [ operation Tostring $ lambda
    ### liftPure show
    <#> udparam typeWriterOptions "opts" "options to print in native format"
    =#> functionResult pushString "string" "Haskell representation"
  ]
  [ property "chunk_template"
    "Templates used to generate chunked HTML filenames (string)"
    (pushViaJSON, writerChunkTemplate)
    (peekViaJSON, \opts x -> opts{ writerChunkTemplate = x })

  , 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 "split_level"
    "Level at which EPUB or chunked HTML documents are split into files"
    (pushIntegral, writerSplitLevel)
    (peekIntegral, \opts x -> opts{ writerSplitLevel = x })

  , property "epub_chapter_level"
    "Deprecated synonym for split_level"
    (pushIntegral, writerSplitLevel)
    (peekIntegral, \opts x -> opts{ writerSplitLevel = x })

  , property "epub_fonts"
    "Paths to fonts to embed"
    (pushPandocList pushString, writerEpubFonts)
    (peekList peekString, \opts x -> opts{ writerEpubFonts = x })

  , property "epub_title_page"
    "Determines whether a title page is included in EPUB"
    (pushBool, writerEpubTitlePage)
    (peekBool, \opts x -> opts{ writerEpubTitlePage = 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"
    (pushExtensions, writerExtensions)
    (peekExtensions, \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 "link_images"
    "Include links to images instead of embedding in ODT"
    (pushBool, writerLinkImages)
    (peekBool, \opts x -> opts{ writerLinkImages = 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 "figure_caption_position"
    "Location of caption relative to the figure"
    (pushViaJSON, writerFigureCaptionPosition)
    (peekViaJSON, \opts x -> opts{ writerFigureCaptionPosition = x })

  , property "table_caption_position"
    "Location of caption relative to the table"
    (pushViaJSON, writerTableCaptionPosition)
    (peekViaJSON, \opts x -> opts{ writerTableCaptionPosition = 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 "list_tables"
    "Render tables using list tables in RST output"
    (pushBool, writerListTables)
    (peekBool, \opts x -> opts{ writerListTables = 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"
    (pushContext, writerVariables)
    (peekContext, \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 :: Peeker PandocError 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