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

Lua module to handle pandoc templates.
-}
module Text.Pandoc.Lua.Module.Template
  ( documentedModule
  ) where

import HsLua
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshal.Template (pushTemplate)
import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua), liftPandocLua)
import Text.Pandoc.Templates
  (compileTemplate, getDefaultTemplate, runWithPartials, runWithDefaultPartials)

import qualified Data.Text as T

-- | The "pandoc.template" module.
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"pandoc.template"
  , moduleDescription :: Text
moduleDescription = [Text] -> Text
T.unlines
    [ Text
"Lua functions for pandoc templates."
    ]
  , moduleFields :: [Field PandocError]
moduleFields = []
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions = [DocumentedFunction PandocError]
functions
  }

-- | Template module functions.
functions :: [DocumentedFunction PandocError]
functions :: [DocumentedFunction PandocError]
functions =
  [ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"compile"
     ### (\template mfilepath -> unPandocLua $
           case mfilepath of
             Just fp -> runWithPartials (compileTemplate fp template)
             Nothing -> runWithDefaultPartials
                        (compileTemplate "templates/default" template))
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e Text
peekText Text
"string" Text
"template" Text
"template string"
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e String
stringParam Text
"templ_path" Text
"template path")
     forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. LuaError e => String -> LuaE e a
failLua forall e. LuaError e => Pusher e (Template Text)
pushTemplate) Text
"pandoc Template"
           Text
"compiled template"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"default"
     ### (\mformat -> unPandocLua $ do
           let getFORMAT = liftPandocLua $ do
                 getglobal "FORMAT"
                 forcePeek $ peekText top `lastly` pop 1
           format <- maybe getFORMAT pure mformat
           getDefaultTemplate format)
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Text
textParam Text
"writer"
              Text
"writer for which the template should be returned.")
     forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. Pusher e Text
pushText Text
"string"
           Text
"string representation of the writer's default template"

  ]