{-# 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 :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> Module e
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 =
  [ Name
-> (Text
    -> Maybe FilePath
    -> LuaE PandocError (Either FilePath (Template Text)))
-> HsFnPrecursor
     PandocError
     (Text
      -> Maybe FilePath
      -> LuaE PandocError (Either FilePath (Template Text)))
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))
     HsFnPrecursor
  PandocError
  (Text
   -> Maybe FilePath
   -> LuaE PandocError (Either FilePath (Template Text)))
-> Parameter PandocError Text
-> HsFnPrecursor
     PandocError
     (Maybe FilePath
      -> LuaE PandocError (Either FilePath (Template Text)))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Text
-> Text -> Text -> Text -> Parameter PandocError Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError Text
forall e. Peeker e Text
peekText Text
"string" Text
"template" Text
"template string"
     HsFnPrecursor
  PandocError
  (Maybe FilePath
   -> LuaE PandocError (Either FilePath (Template Text)))
-> Parameter PandocError (Maybe FilePath)
-> HsFnPrecursor
     PandocError (LuaE PandocError (Either FilePath (Template Text)))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError FilePath
-> Text -> Text -> Text -> Parameter PandocError (Maybe FilePath)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker PandocError FilePath
forall e. Peeker e FilePath
peekString Text
"string" Text
"templ_path" Text
"template path"
     HsFnPrecursor
  PandocError (LuaE PandocError (Either FilePath (Template Text)))
-> FunctionResults PandocError (Either FilePath (Template Text))
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError (Either FilePath (Template Text))
-> Text
-> Text
-> FunctionResults PandocError (Either FilePath (Template Text))
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult ((FilePath -> LuaE PandocError ())
-> (Template Text -> LuaE PandocError ())
-> Pusher PandocError (Either FilePath (Template Text))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> LuaE PandocError ()
forall e a. LuaError e => FilePath -> LuaE e a
failLua Template Text -> LuaE PandocError ()
forall e. LuaError e => Pusher e (Template Text)
pushTemplate) Text
"pandoc Template"
           Text
"compiled template"

  , Name
-> (Maybe Text -> LuaE PandocError Text)
-> HsFnPrecursor PandocError (Maybe Text -> LuaE PandocError Text)
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)
     HsFnPrecursor PandocError (Maybe Text -> LuaE PandocError Text)
-> Parameter PandocError (Maybe Text)
-> HsFnPrecursor PandocError (LuaE PandocError Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Text
-> Text -> Text -> Text -> Parameter PandocError (Maybe Text)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker PandocError Text
forall e. Peeker e Text
peekText Text
"string" Text
"writer"
           Text
"writer for which the template should be returned."
     HsFnPrecursor PandocError (LuaE PandocError Text)
-> FunctionResults PandocError Text
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Text
-> Text -> Text -> FunctionResults PandocError Text
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher PandocError Text
forall e. Pusher e Text
pushText Text
"string"
           Text
"string representation of the writer's default template"

  ]