{-# LANGUAGE OverloadedStrings  #-}
{- |
   Module      : Text.Pandoc.Lua
   Copyright   : Copyright © 2017-2023 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Pandoc's Lua globals.
-}
module Text.Pandoc.Lua.Global
  ( Global (..)
  , setGlobals
  ) where

import HsLua as Lua
import HsLua.Module.Version (pushVersion)
import Text.Pandoc.Class (CommonState)
import Text.Pandoc.Definition (Pandoc, pandocTypesVersion)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshal.CommonState (pushCommonState)
import Text.Pandoc.Lua.Marshal.Pandoc (pushPandoc)
import Text.Pandoc.Lua.Marshal.ReaderOptions (pushReaderOptionsReadonly)
import Text.Pandoc.Lua.Marshal.WriterOptions (pushWriterOptions)
import Text.Pandoc.Lua.PandocLua ()
import Text.Pandoc.Options (ReaderOptions, WriterOptions)
import Text.Pandoc.Version (pandocVersion)

import qualified Data.Text as Text

-- | Permissible global Lua variables.
data Global =
    FORMAT Text.Text
  | PANDOC_API_VERSION
  | PANDOC_DOCUMENT Pandoc
  | PANDOC_READER_OPTIONS ReaderOptions
  | PANDOC_WRITER_OPTIONS WriterOptions
  | PANDOC_SCRIPT_FILE FilePath
  | PANDOC_STATE CommonState
  | PANDOC_VERSION
  -- Cannot derive instance of Data because of CommonState

-- | Set all given globals.
setGlobals :: [Global] -> LuaE PandocError ()
setGlobals :: [Global] -> LuaE PandocError ()
setGlobals = (Global -> LuaE PandocError ()) -> [Global] -> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Global -> LuaE PandocError ()
setGlobal

setGlobal :: Global -> LuaE PandocError ()
setGlobal :: Global -> LuaE PandocError ()
setGlobal Global
global = case Global
global of
  -- This could be simplified if Global was an instance of Data.
  FORMAT Text
format -> do
    Pusher PandocError Text
forall e. Pusher e Text
Lua.pushText Text
format
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"FORMAT"
  Global
PANDOC_API_VERSION -> do
    Pusher PandocError Version
forall e. LuaError e => Pusher e Version
pushVersion Version
pandocTypesVersion
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_API_VERSION"
  PANDOC_DOCUMENT Pandoc
doc -> do
    Pusher PandocError Pandoc
forall e. LuaError e => Pusher e Pandoc
pushPandoc Pandoc
doc
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_DOCUMENT"
  PANDOC_READER_OPTIONS ReaderOptions
ropts -> do
    Pusher PandocError ReaderOptions
forall e. LuaError e => Pusher e ReaderOptions
pushReaderOptionsReadonly ReaderOptions
ropts
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_READER_OPTIONS"
  PANDOC_WRITER_OPTIONS WriterOptions
wopts -> do
    Pusher PandocError WriterOptions
pushWriterOptions WriterOptions
wopts
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_WRITER_OPTIONS"
  PANDOC_SCRIPT_FILE FilePath
filePath -> do
    FilePath -> LuaE PandocError ()
forall e. FilePath -> LuaE e ()
Lua.pushString FilePath
filePath
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_SCRIPT_FILE"
  PANDOC_STATE CommonState
commonState -> do
    Pusher PandocError CommonState
forall e. LuaError e => Pusher e CommonState
pushCommonState CommonState
commonState
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_STATE"
  Global
PANDOC_VERSION              -> do
    Pusher PandocError Version
forall e. LuaError e => Pusher e Version
pushVersion Version
pandocVersion
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_VERSION"