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

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

Pandoc data type constructors.
-}
module Text.Pandoc.Lua.Module.Types
  ( documentedModule
  ) where

import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..)
             , defun, functionResult, parameter, (###), (<#>), (=#>))
import HsLua.Module.Version (peekVersionFuzzy, pushVersion)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.ErrorConversion ()
import Text.Pandoc.Lua.Marshaling.AST

import qualified HsLua as Lua

-- | Push the pandoc.types module on the Lua stack.
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> Module e
Module
  { moduleName :: Name
moduleName = Name
"pandoc.types"
  , moduleDescription :: Text
moduleDescription =
      Text
"Constructors for types that are not part of the pandoc AST."
  , moduleFields :: [Field PandocError]
moduleFields =
    [ Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
      { fieldName :: Text
fieldName = Text
"clone"
      , fieldDescription :: Text
fieldDescription = Text
"DEPRECATED! Helper functions for element cloning."
      , fieldPushValue :: LuaE PandocError ()
fieldPushValue = do
          LuaE PandocError ()
forall e. LuaE e ()
Lua.newtable
          Name -> HaskellFunction PandocError -> LuaE PandocError ()
forall e. LuaError e => Name -> HaskellFunction e -> LuaE e ()
addFunction Name
"Meta" (HaskellFunction PandocError -> LuaE PandocError ())
-> HaskellFunction PandocError -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Peeker PandocError Meta
-> Pusher PandocError Meta -> HaskellFunction PandocError
forall a.
Peeker PandocError a
-> Pusher PandocError a -> HaskellFunction PandocError
cloneWith Peeker PandocError Meta
forall e. LuaError e => Peeker e Meta
peekMeta Pusher PandocError Meta
forall e. LuaError e => Pusher e Meta
pushMeta
          Name -> HaskellFunction PandocError -> LuaE PandocError ()
forall e. LuaError e => Name -> HaskellFunction e -> LuaE e ()
addFunction Name
"MetaValue" (HaskellFunction PandocError -> LuaE PandocError ())
-> HaskellFunction PandocError -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Peeker PandocError MetaValue
-> Pusher PandocError MetaValue -> HaskellFunction PandocError
forall a.
Peeker PandocError a
-> Pusher PandocError a -> HaskellFunction PandocError
cloneWith Peeker PandocError MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue Pusher PandocError MetaValue
forall e. LuaError e => MetaValue -> LuaE e ()
pushMetaValue
      }
    ]
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
      [ Name
-> (Version -> LuaE PandocError Version)
-> HsFnPrecursor PandocError (Version -> LuaE PandocError Version)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Version"
        ### return
        HsFnPrecursor PandocError (Version -> LuaE PandocError Version)
-> Parameter PandocError Version
-> HsFnPrecursor PandocError (LuaE PandocError Version)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Version
-> Text -> Text -> Text -> Parameter PandocError Version
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError Version
forall e. LuaError e => Peeker e Version
peekVersionFuzzy Text
"string|integer|{integer,...}|Version"
              Text
"version_specifier"
              ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"either a version string like `'2.7.3'`, "
                       , Text
"a single integer like `2`, "
                       , Text
"list of integers like `{2,7,3}`, "
                       , Text
"or a Version object"
                       ])
        HsFnPrecursor PandocError (LuaE PandocError Version)
-> FunctionResults PandocError Version
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Version
-> Text -> Text -> FunctionResults PandocError Version
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher PandocError Version
forall e. LuaError e => Pusher e Version
pushVersion Text
"Version" Text
"A new Version object."
      ]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  }
 where addFunction :: Name -> HaskellFunction e -> LuaE e ()
addFunction Name
name HaskellFunction e
fn = do
         Name -> LuaE e ()
forall e. Name -> LuaE e ()
Lua.pushName Name
name
         HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction HaskellFunction e
fn
         StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (CInt -> StackIndex
Lua.nth CInt
3)

cloneWith :: Peeker PandocError a
          -> Pusher PandocError a
          -> LuaE PandocError NumResults
cloneWith :: Peeker PandocError a
-> Pusher PandocError a -> HaskellFunction PandocError
cloneWith Peeker PandocError a
peeker Pusher PandocError a
pusher = do
  a
x <- Peek PandocError a -> LuaE PandocError a
forall e a. LuaError e => Peek e a -> LuaE e a
Lua.forcePeek (Peek PandocError a -> LuaE PandocError a)
-> Peek PandocError a -> LuaE PandocError a
forall a b. (a -> b) -> a -> b
$ Peeker PandocError a
peeker (CInt -> StackIndex
Lua.nthBottom CInt
1)
  Pusher PandocError a
pusher a
x
  NumResults -> HaskellFunction PandocError
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
Lua.NumResults CInt
1)