content: {-# LANGUAGE CPP                  #-}
  {-# LANGUAGE LambdaCase           #-}
  {-# LANGUAGE OverloadedStrings    #-}
  {-# LANGUAGE ScopedTypeVariables  #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  {- |
     Module      : Text.Pandoc.Lua.Marshaling.ReaderOptions
     Copyright   : © 2012-2024 John MacFarlane
                   © 2017-2024 Albert Krewinkel
     License     : GNU GPL, version 2 or above
  
     Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>
     Stability   : alpha
  
  Marshaling instance for ReaderOptions and its components.
  -}
  module Text.Pandoc.Lua.Marshal.ReaderOptions
    ( peekReaderOptions
    , pushReaderOptions
    , pushReaderOptionsReadonly
    ) where
  
  import Data.Default (def)
  import HsLua as Lua
  import Text.Pandoc.Lua.Marshal.Format (peekExtensions, pushExtensions)
  import Text.Pandoc.Lua.Marshal.List (pushPandocList)
  import Text.Pandoc.Options (ReaderOptions (..))
  
  --
  -- Reader Options
  --
  
  -- | Retrieve a ReaderOptions value, either from a normal ReaderOptions
  -- value, from a read-only object, or from a table with the same
  -- keys as a ReaderOptions object.
  peekReaderOptions :: LuaError e => Peeker e ReaderOptions
  peekReaderOptions = retrieving "ReaderOptions" . \idx ->
    liftLua (ltype idx) >>= \case
      TypeUserdata -> choice [ peekUD typeReaderOptions
                             , peekUD typeReaderOptionsReadonly
                             ]
                             idx
      TypeTable    -> peekReaderOptionsTable idx
      _            -> failPeek =<<
                      typeMismatchMessage "ReaderOptions userdata or table" idx
  
  -- | Pushes a ReaderOptions value as userdata object.
  pushReaderOptions :: LuaError e => Pusher e ReaderOptions
  pushReaderOptions = pushUD typeReaderOptions
  
  -- | Pushes a ReaderOptions object, but makes it read-only.
  pushReaderOptionsReadonly :: LuaError e => Pusher e ReaderOptions
  pushReaderOptionsReadonly = pushUD typeReaderOptionsReadonly
  
  -- | ReaderOptions object type for read-only values.
  typeReaderOptionsReadonly :: LuaError e => DocumentedType e ReaderOptions
  typeReaderOptionsReadonly = deftype "ReaderOptions (read-only)"
    [ operation Tostring $ lambda
      ### liftPure show
      <#> udparam typeReaderOptions "opts" "options to print in native format"
      =#> functionResult pushString "string" "Haskell representation"
    , operation Newindex $ lambda
      ### (failLua "This ReaderOptions value is read-only.")
      =?> "Throws an error when called, i.e., an assignment is made."
    ]
    readerOptionsMembers
  
  -- | 'ReaderOptions' object type.
  typeReaderOptions :: LuaError e => DocumentedType e ReaderOptions
  typeReaderOptions = deftype "ReaderOptions"
    [ operation Tostring $ lambda
      ### liftPure show
      <#> udparam typeReaderOptions "opts" "options to print in native format"
      =#> functionResult pushString "string" "Haskell representation"
    ]
    readerOptionsMembers
  
  -- | Member properties of 'ReaderOptions' Lua values.
  readerOptionsMembers :: LuaError e
                       => [Member e (DocumentedFunction e) ReaderOptions]
  readerOptionsMembers =
    [ property "abbreviations" ""
        (pushSet pushText, readerAbbreviations)
        (peekSet peekText, \opts x -> opts{ readerAbbreviations = x })
    , property "columns" ""
        (pushIntegral, readerColumns)
        (peekIntegral, \opts x -> opts{ readerColumns = x })
    , property "default_image_extension" ""
        (pushText, readerDefaultImageExtension)
        (peekText, \opts x -> opts{ readerDefaultImageExtension = x })
    , property "extensions" ""
        (pushExtensions, readerExtensions)
        (peekExtensions, \opts x -> opts{ readerExtensions = x })
    , property "indented_code_classes" ""
        (pushPandocList pushText, readerIndentedCodeClasses)
        (peekList peekText, \opts x -> opts{ readerIndentedCodeClasses = x })
    , property "standalone" ""
        (pushBool, readerStandalone)
        (peekBool, \opts x -> opts{ readerStandalone = x })
    , property "strip_comments" ""
        (pushBool, readerStripComments)
        (peekBool, \opts x -> opts{ readerStripComments = x })
    , property "tab_stop" ""
        (pushIntegral, readerTabStop)
        (peekIntegral, \opts x -> opts{ readerTabStop = x })
    , property "track_changes" ""
        (pushViaJSON, readerTrackChanges)
        (choice [peekRead, peekViaJSON], \opts x -> opts{ readerTrackChanges = x })
    ]
  
  -- | Retrieves a 'ReaderOptions' object from a table on the stack, using
  -- the default values for all missing fields.
  --
  -- Internally, this pushes the default reader 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.
  peekReaderOptionsTable :: LuaError e => Peeker e ReaderOptions
  peekReaderOptionsTable idx = retrieving "ReaderOptions (table)" $ do
    liftLua $ do
      absidx <- absindex idx
      pushUD typeReaderOptions 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 typeReaderOptions top `lastly` pop 1
  
  instance Pushable ReaderOptions where
    push = pushReaderOptions
  