{-# LANGUAGE OverloadedStrings  #-}
{- |
   Module      : Text.Pandoc.Lua
   Copyright   : Copyright © 2017-2021 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 Paths_pandoc (version)
import Text.Pandoc.Class.CommonState (CommonState)
import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.CommonState (pushCommonState)
import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptions)
import Text.Pandoc.Options (ReaderOptions)

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_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
    Text -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push 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
    UDTypeWithList
  PandocError (DocumentedFunction PandocError) Pandoc Void
-> Pandoc -> LuaE PandocError ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList
  PandocError (DocumentedFunction PandocError) Pandoc Void
forall e. LuaError e => DocumentedType e Pandoc
typePandocLazy  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
pushReaderOptions ReaderOptions
ropts
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_READER_OPTIONS"
  PANDOC_SCRIPT_FILE FilePath
filePath -> do
    FilePath -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push 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
version
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_VERSION"

-- | Readonly and lazy pandoc objects.
typePandocLazy :: LuaError e => DocumentedType e Pandoc
typePandocLazy :: DocumentedType e Pandoc
typePandocLazy = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Pandoc]
-> DocumentedType e Pandoc
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Pandoc (lazy)" []
  [ Name
-> Text
-> (Pusher e Meta, Pandoc -> Meta)
-> Member e (DocumentedFunction e) Pandoc
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"meta" Text
"document metadata" (Pusher e Meta
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push, \(Pandoc Meta
meta [Block]
_) -> Meta
meta)
  , Name
-> Text
-> (Pusher e [Block], Pandoc -> [Block])
-> Member e (DocumentedFunction e) Pandoc
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"blocks" Text
"content blocks" (Pusher e [Block]
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push, \(Pandoc Meta
_ [Block]
blocks) -> [Block]
blocks)
  ]