{-# LANGUAGE OverloadedStrings    #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.CommonState
   Copyright   : © 2012-2021 John MacFarlane
                 © 2017-2021 Albert Krewinkel
   License     : GNU GPL, version 2 or above
   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Instances to marshal (push) and unmarshal (peek) the common state.
-}
module Text.Pandoc.Lua.Marshaling.CommonState
  ( typeCommonState
  , peekCommonState
  , pushCommonState
  ) where

import HsLua.Core
import HsLua.Marshalling
import HsLua.Packaging
import Text.Pandoc.Class (CommonState (..))
import Text.Pandoc.Logging (LogMessage, showLogMessage)
import Text.Pandoc.Lua.Marshaling.List (pushPandocList)

-- | Lua type used for the @CommonState@ object.
typeCommonState :: LuaError e => DocumentedType e CommonState
typeCommonState :: DocumentedType e CommonState
typeCommonState = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) CommonState]
-> DocumentedType e CommonState
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"pandoc CommonState" []
  [ Name
-> Text
-> (Pusher e [String], CommonState -> [String])
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"input_files" Text
"input files passed to pandoc"
      (Pusher e String -> Pusher e [String]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e String
forall e. String -> LuaE e ()
pushString, CommonState -> [String]
stInputFiles)

  , Name
-> Text
-> (Pusher e (Maybe String), CommonState -> Maybe String)
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"output_file" Text
"the file to which pandoc will write"
      (LuaE e () -> Pusher e String -> Pusher e (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil Pusher e String
forall e. String -> LuaE e ()
pushString, CommonState -> Maybe String
stOutputFile)

  , Name
-> Text
-> (Pusher e [LogMessage], CommonState -> [LogMessage])
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"log" Text
"list of log messages"
      (Pusher e LogMessage -> Pusher e [LogMessage]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (UDTypeWithList e (DocumentedFunction e) LogMessage Void
-> Pusher e LogMessage
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) LogMessage Void
forall e. LuaError e => DocumentedType e LogMessage
typeLogMessage), CommonState -> [LogMessage]
stLog)

  , Name
-> Text
-> (Pusher e [(Text, Text)], CommonState -> [(Text, Text)])
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"request_headers" Text
"headers to add for HTTP requests"
      (Pusher e (Text, Text) -> Pusher e [(Text, Text)]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (Pusher e Text -> Pusher e Text -> Pusher e (Text, Text)
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text
forall e. Pusher e Text
pushText), CommonState -> [(Text, Text)]
stRequestHeaders)

  , Name
-> Text
-> (Pusher e [String], CommonState -> [String])
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"resource_path"
      Text
"path to search for resources like included images"
      (Pusher e String -> Pusher e [String]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e String
forall e. String -> LuaE e ()
pushString, CommonState -> [String]
stResourcePath)

  , Name
-> Text
-> (Pusher e (Maybe Text), CommonState -> Maybe Text)
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"source_url" Text
"absolute URL + dir of 1st source file"
      (LuaE e () -> Pusher e Text -> Pusher e (Maybe Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil Pusher e Text
forall e. Pusher e Text
pushText, CommonState -> Maybe Text
stSourceURL)

  , Name
-> Text
-> (Pusher e (Maybe String), CommonState -> Maybe String)
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"user_data_dir" Text
"directory to search for data files"
      (LuaE e () -> Pusher e String -> Pusher e (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil Pusher e String
forall e. String -> LuaE e ()
pushString, CommonState -> Maybe String
stUserDataDir)

  , Name
-> Text
-> (Pusher e Bool, CommonState -> Bool)
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"trace" Text
"controls whether tracing messages are issued"
      (Pusher e Bool
forall e. Pusher e Bool
pushBool, CommonState -> Bool
stTrace)

  , Name
-> Text
-> (Pusher e Verbosity, CommonState -> Verbosity)
-> Member e (DocumentedFunction e) CommonState
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"verbosity" Text
"verbosity level"
      (Pusher e String
forall e. String -> LuaE e ()
pushString Pusher e String -> (Verbosity -> String) -> Pusher e Verbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> String
forall a. Show a => a -> String
show, CommonState -> Verbosity
stVerbosity)
  ]

peekCommonState :: LuaError e => Peeker e CommonState
peekCommonState :: Peeker e CommonState
peekCommonState = UDTypeWithList e (DocumentedFunction e) CommonState Void
-> Peeker e CommonState
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) CommonState Void
forall e. LuaError e => DocumentedType e CommonState
typeCommonState

pushCommonState :: LuaError e => Pusher e CommonState
pushCommonState :: Pusher e CommonState
pushCommonState = UDTypeWithList e (DocumentedFunction e) CommonState Void
-> Pusher e CommonState
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) CommonState Void
forall e. LuaError e => DocumentedType e CommonState
typeCommonState

typeLogMessage :: LuaError e => DocumentedType e LogMessage
typeLogMessage :: DocumentedType e LogMessage
typeLogMessage = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) LogMessage]
-> DocumentedType e LogMessage
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"pandoc LogMessage"
  [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Index (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ Name
-> (LogMessage -> LuaE e Text)
-> HsFnPrecursor e (LogMessage -> LuaE e Text)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__tostring"
      ### liftPure showLogMessage
      HsFnPrecursor e (LogMessage -> LuaE e Text)
-> Parameter e LogMessage -> HsFnPrecursor e (LuaE e Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e LogMessage
-> Text -> Text -> Parameter e LogMessage
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e LogMessage
forall e. LuaError e => DocumentedType e LogMessage
typeLogMessage Text
"msg" Text
"object"
      HsFnPrecursor e (LuaE e Text)
-> FunctionResults e Text -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Text -> Text -> Text -> FunctionResults e Text
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Text
forall e. Pusher e Text
pushText Text
"string" Text
"stringified log message"
  ]
  [Member e (DocumentedFunction e) LogMessage]
forall a. Monoid a => a
mempty -- no members