{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module      : Text.Pandoc.Lua.Marshal.Template
Copyright   : © 2021-2023 Albert Krewinkel
License     : GNU GPL, version 2 or above
Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Marshal 'Template' 'Text'.
-}
module Text.Pandoc.Lua.Marshal.Template
  ( pushTemplate
  , peekTemplate
  , typeTemplate
  ) where

import Data.Text (Text)
import HsLua as Lua
import HsLua.Core.Utf8 as Lua
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.PandocLua (unPandocLua)
import Text.Pandoc.Templates (Template, compileTemplate, runWithDefaultPartials)

-- | Pushes a 'Template' as a an opaque userdata value.
pushTemplate :: LuaError e => Pusher e (Template Text)
pushTemplate :: forall e. LuaError e => Pusher e (Template Text)
pushTemplate = forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e (Template Text)
typeTemplate

-- | Retrieves a 'Template' 'Text' value from the stack.
peekTemplate :: Peeker PandocError (Template Text)
peekTemplate :: Peeker PandocError (Template Text)
peekTemplate StackIndex
idx = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeString -> do
    let path :: FilePath
path = FilePath
"templates/default.custom"
    let liftPM :: PandocLua a -> Peek PandocError a
liftPM = forall e a. LuaE e a -> Peek e a
liftLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PandocLua a -> LuaE PandocError a
unPandocLua
    Text
tmpl <- forall e. Peeker e Text
peekText StackIndex
idx
    forall {a}. PandocLua a -> Peek PandocError a
liftPM (forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials (forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate FilePath
path Text
tmpl)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left FilePath
e  -> forall a e. ByteString -> Peek e a
failPeek (FilePath -> ByteString
Lua.fromString FilePath
e)
      Right Template Text
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Template Text
t
  Type
_ -> forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e (Template Text)
typeTemplate StackIndex
idx

-- | Template object type.
typeTemplate :: LuaError e => DocumentedType e (Template Text)
typeTemplate :: forall e. LuaError e => DocumentedType e (Template Text)
typeTemplate = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"pandoc Template" [] []