{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Text.Pandoc.Lua.Custom ( loadCustom ) where
import Control.Exception
import Control.Monad ((<=<), (<$!>))
import Control.Monad.IO.Class (MonadIO)
import Data.Maybe (fromMaybe)
import HsLua as Lua hiding (Operation (Div))
import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Marshal.Format (peekExtensionsConfig)
import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc)
import Text.Pandoc.Lua.Marshal.WriterOptions (pushWriterOptions)
import Text.Pandoc.Lua.PandocLua (unPandocLua)
import Text.Pandoc.Lua.Run (runLuaWith)
import Text.Pandoc.Readers (Reader (..))
import Text.Pandoc.Sources (ToSources(..))
import Text.Pandoc.Scripting (CustomComponents (..))
import Text.Pandoc.Writers (Writer (..))
import qualified Text.Pandoc.Lua.Writer.Classic as Classic
import qualified Text.Pandoc.Class as PandocMonad
loadCustom :: (PandocMonad m, MonadIO m)
=> FilePath -> m (CustomComponents m)
loadCustom :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m (CustomComponents m)
loadCustom FilePath
luaFile = do
luaState <- IO GCManagedState -> m GCManagedState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO GCManagedState
newGCManagedState
luaFile' <- fromMaybe luaFile <$>
findFileWithDataFallback "custom" luaFile
either throw pure <=< runLuaWith luaState $ do
let globals = [ FilePath -> Global
PANDOC_SCRIPT_FILE FilePath
luaFile' ]
setGlobals globals
dofileTrace (Just luaFile') >>= \case
Status
OK -> () -> LuaE PandocError ()
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Status
_ -> LuaE PandocError ()
forall e a. LuaError e => LuaE e a
throwErrorAsException
mextsConf <- rawgetglobal "Extensions" >>= \case
Type
TypeNil -> Maybe ExtensionsConfig -> LuaE PandocError (Maybe ExtensionsConfig)
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ExtensionsConfig
forall a. Maybe a
Nothing
Type
TypeFunction -> ExtensionsConfig -> Maybe ExtensionsConfig
forall a. a -> Maybe a
Just (ExtensionsConfig -> Maybe ExtensionsConfig)
-> LuaE PandocError ExtensionsConfig
-> LuaE PandocError (Maybe ExtensionsConfig)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
NumArgs -> NumResults -> LuaE PandocError ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
0 NumResults
1
Peek PandocError ExtensionsConfig
-> LuaE PandocError ExtensionsConfig
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError ExtensionsConfig
-> LuaE PandocError ExtensionsConfig)
-> Peek PandocError ExtensionsConfig
-> LuaE PandocError ExtensionsConfig
forall a b. (a -> b) -> a -> b
$ Peeker PandocError ExtensionsConfig
forall e. LuaError e => Peeker e ExtensionsConfig
peekExtensionsConfig StackIndex
top Peek PandocError ExtensionsConfig
-> LuaE PandocError () -> Peek PandocError ExtensionsConfig
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
Type
_ -> ExtensionsConfig -> Maybe ExtensionsConfig
forall a. a -> Maybe a
Just (ExtensionsConfig -> Maybe ExtensionsConfig)
-> LuaE PandocError ExtensionsConfig
-> LuaE PandocError (Maybe ExtensionsConfig)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
Peek PandocError ExtensionsConfig
-> LuaE PandocError ExtensionsConfig
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError ExtensionsConfig
-> LuaE PandocError ExtensionsConfig)
-> Peek PandocError ExtensionsConfig
-> LuaE PandocError ExtensionsConfig
forall a b. (a -> b) -> a -> b
$ Peeker PandocError ExtensionsConfig
forall e. LuaError e => Peeker e ExtensionsConfig
peekExtensionsConfig StackIndex
top Peek PandocError ExtensionsConfig
-> LuaE PandocError () -> Peek PandocError ExtensionsConfig
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
mtemplate <- rawgetglobal "Template" >>= \case
Type
TypeNil -> Maybe Text -> LuaE PandocError (Maybe Text)
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
Type
TypeFunction -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> LuaE PandocError Text -> LuaE PandocError (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
NumArgs -> NumResults -> LuaE PandocError ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
0 NumResults
1
Peek PandocError Text -> LuaE PandocError Text
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError Text -> LuaE PandocError Text)
-> Peek PandocError Text -> LuaE PandocError Text
forall a b. (a -> b) -> a -> b
$ Peeker PandocError Text
forall e. Peeker e Text
peekText StackIndex
top Peek PandocError Text
-> LuaE PandocError () -> Peek PandocError Text
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
Type
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> LuaE PandocError Text -> LuaE PandocError (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
Peek PandocError Text -> LuaE PandocError Text
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError Text -> LuaE PandocError Text)
-> Peek PandocError Text -> LuaE PandocError Text
forall a b. (a -> b) -> a -> b
$ Peeker PandocError Text
forall e. Peeker e Text
peekText StackIndex
top Peek PandocError Text
-> LuaE PandocError () -> Peek PandocError Text
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
mreader <- rawgetglobal "Reader" >>= \case
Type
TypeNil -> do
Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
Name -> LuaE PandocError Type
forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"ByteStringReader" LuaE PandocError Type
-> (Type -> LuaE PandocError (Maybe (Reader m)))
-> LuaE PandocError (Maybe (Reader m))
forall a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> Maybe (Reader m) -> LuaE PandocError (Maybe (Reader m))
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Reader m)
forall a. Maybe a
Nothing
Type
_ -> do
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
readerField
Maybe (Reader m) -> LuaE PandocError (Maybe (Reader m))
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Reader m) -> LuaE PandocError (Maybe (Reader m)))
-> (Reader m -> Maybe (Reader m))
-> Reader m
-> LuaE PandocError (Maybe (Reader m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader m -> Maybe (Reader m)
forall a. a -> Maybe a
Just (Reader m -> LuaE PandocError (Maybe (Reader m)))
-> Reader m -> LuaE PandocError (Maybe (Reader m))
forall a b. (a -> b) -> a -> b
$ GCManagedState -> Reader m
forall (m :: * -> *). MonadIO m => GCManagedState -> Reader m
byteStringReader GCManagedState
luaState
Type
_ -> do
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
readerField
Maybe (Reader m) -> LuaE PandocError (Maybe (Reader m))
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Reader m) -> LuaE PandocError (Maybe (Reader m)))
-> (Reader m -> Maybe (Reader m))
-> Reader m
-> LuaE PandocError (Maybe (Reader m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader m -> Maybe (Reader m)
forall a. a -> Maybe a
Just (Reader m -> LuaE PandocError (Maybe (Reader m)))
-> Reader m -> LuaE PandocError (Maybe (Reader m))
forall a b. (a -> b) -> a -> b
$ GCManagedState -> Reader m
forall (m :: * -> *). MonadIO m => GCManagedState -> Reader m
textReader GCManagedState
luaState
mwriter <- rawgetglobal "Writer" >>= \case
Type
TypeNil -> Name -> LuaE PandocError Type
forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"ByteStringWriter" LuaE PandocError Type
-> (Type -> LuaE PandocError (Maybe (Writer m)))
-> LuaE PandocError (Maybe (Writer m))
forall a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> do
docType <- Name -> LuaE PandocError Type
forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"Doc"
pop 3
pure $
if docType /= TypeFunction
then Nothing
else Just . TextWriter $ \WriterOptions
opts Pandoc
doc -> do
st <- m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
PandocMonad.getCommonState
liftIO $ withGCManagedState luaState $
unPandocLua (PandocMonad.putCommonState st) >>
Classic.runCustom @PandocError opts doc
Type
_ -> Writer m -> Maybe (Writer m)
forall a. a -> Maybe a
Just (Writer m -> Maybe (Writer m))
-> LuaE PandocError (Writer m)
-> LuaE PandocError (Maybe (Writer m))
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
writerField
Writer m -> LuaE PandocError (Writer m)
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Writer m -> LuaE PandocError (Writer m))
-> Writer m -> LuaE PandocError (Writer m)
forall a b. (a -> b) -> a -> b
$ (WriterOptions -> Pandoc -> m ByteString) -> Writer m
forall (m :: * -> *).
(WriterOptions -> Pandoc -> m ByteString) -> Writer m
ByteStringWriter ((WriterOptions -> Pandoc -> m ByteString) -> Writer m)
-> (WriterOptions -> Pandoc -> m ByteString) -> Writer m
forall a b. (a -> b) -> a -> b
$ \WriterOptions
opts Pandoc
doc -> do
st <- m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
PandocMonad.getCommonState
liftIO $ withGCManagedState luaState $ do
unPandocLua (PandocMonad.putCommonState st)
getfield registryindex writerField
push doc
pushWriterOptions opts
callTrace 2 1
forcePeek @PandocError $ peekLazyByteString top
Type
_ -> Writer m -> Maybe (Writer m)
forall a. a -> Maybe a
Just (Writer m -> Maybe (Writer m))
-> LuaE PandocError (Writer m)
-> LuaE PandocError (Maybe (Writer m))
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
writerField
Writer m -> LuaE PandocError (Writer m)
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Writer m -> LuaE PandocError (Writer m))
-> Writer m -> LuaE PandocError (Writer m)
forall a b. (a -> b) -> a -> b
$ (WriterOptions -> Pandoc -> m Text) -> Writer m
forall (m :: * -> *).
(WriterOptions -> Pandoc -> m Text) -> Writer m
TextWriter ((WriterOptions -> Pandoc -> m Text) -> Writer m)
-> (WriterOptions -> Pandoc -> m Text) -> Writer m
forall a b. (a -> b) -> a -> b
$ \WriterOptions
opts Pandoc
doc -> do
st <- m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
PandocMonad.getCommonState
liftIO $ withGCManagedState luaState $ do
unPandocLua (PandocMonad.putCommonState st)
getfield registryindex writerField
push doc
pushWriterOptions opts
callTrace 2 1
forcePeek @PandocError $ peekText top
pure $ CustomComponents
{ customReader = mreader
, customWriter = mwriter
, customTemplate = mtemplate
, customExtensions = mextsConf
}
rawgetglobal :: LuaError e => Name -> LuaE e Lua.Type
rawgetglobal :: forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
x = do
LuaE e ()
forall e. LuaE e ()
pushglobaltable
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
x
StackIndex -> LuaE e Type
forall e. LuaError e => StackIndex -> LuaE e Type
rawget (CInt -> StackIndex
nth CInt
2) LuaE e Type -> LuaE e () -> LuaE e Type
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2)
readerField :: Name
readerField :: Name
readerField = Name
"Pandoc Reader function"
writerField :: Name
writerField :: Name
writerField = Name
"Pandoc Writer function"
inLua :: MonadIO m => GCManagedState -> LuaE PandocError a -> m a
inLua :: forall (m :: * -> *) a.
MonadIO m =>
GCManagedState -> LuaE PandocError a -> m a
inLua GCManagedState
st = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a)
-> (LuaE PandocError a -> IO a) -> LuaE PandocError a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. GCManagedState -> LuaE e a -> IO a
withGCManagedState @PandocError GCManagedState
st
byteStringReader :: MonadIO m => GCManagedState -> Reader m
byteStringReader :: forall (m :: * -> *). MonadIO m => GCManagedState -> Reader m
byteStringReader GCManagedState
st = (ReaderOptions -> ByteString -> m Pandoc) -> Reader m
forall (m :: * -> *).
(ReaderOptions -> ByteString -> m Pandoc) -> Reader m
ByteStringReader ((ReaderOptions -> ByteString -> m Pandoc) -> Reader m)
-> (ReaderOptions -> ByteString -> m Pandoc) -> Reader m
forall a b. (a -> b) -> a -> b
$ \ReaderOptions
ropts ByteString
input -> GCManagedState -> LuaE PandocError Pandoc -> m Pandoc
forall (m :: * -> *) a.
MonadIO m =>
GCManagedState -> LuaE PandocError a -> m a
inLua GCManagedState
st (LuaE PandocError Pandoc -> m Pandoc)
-> LuaE PandocError Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ do
StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
readerField
ByteString -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
forall e. LuaError e => ByteString -> LuaE e ()
push ByteString
input
ReaderOptions -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
forall e. LuaError e => ReaderOptions -> LuaE e ()
push ReaderOptions
ropts
NumArgs -> NumResults -> LuaE PandocError Status
forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
1 LuaE PandocError Status
-> (Status -> LuaE PandocError Pandoc) -> LuaE PandocError Pandoc
forall a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
OK -> Peek PandocError Pandoc -> LuaE PandocError Pandoc
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError Pandoc -> LuaE PandocError Pandoc)
-> Peek PandocError Pandoc -> LuaE PandocError Pandoc
forall a b. (a -> b) -> a -> b
$ Peeker PandocError Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc StackIndex
top
Status
_ -> LuaE PandocError Pandoc
forall e a. LuaError e => LuaE e a
throwErrorAsException
textReader :: MonadIO m => GCManagedState -> Reader m
textReader :: forall (m :: * -> *). MonadIO m => GCManagedState -> Reader m
textReader GCManagedState
st = (forall a. ToSources a => ReaderOptions -> a -> m Pandoc)
-> Reader m
forall (m :: * -> *).
(forall a. ToSources a => ReaderOptions -> a -> m Pandoc)
-> Reader m
TextReader ((forall a. ToSources a => ReaderOptions -> a -> m Pandoc)
-> Reader m)
-> (forall a. ToSources a => ReaderOptions -> a -> m Pandoc)
-> Reader m
forall a b. (a -> b) -> a -> b
$ \ReaderOptions
ropts a
srcs -> GCManagedState -> LuaE PandocError Pandoc -> m Pandoc
forall (m :: * -> *) a.
MonadIO m =>
GCManagedState -> LuaE PandocError a -> m a
inLua GCManagedState
st (LuaE PandocError Pandoc -> m Pandoc)
-> LuaE PandocError Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ do
let input :: Sources
input = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
srcs
StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
readerField
Sources -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
forall e. LuaError e => Sources -> LuaE e ()
push Sources
input
ReaderOptions -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
forall e. LuaError e => ReaderOptions -> LuaE e ()
push ReaderOptions
ropts
NumArgs -> NumResults -> LuaE PandocError Status
forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
1 LuaE PandocError Status
-> (Status -> LuaE PandocError Pandoc) -> LuaE PandocError Pandoc
forall a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
OK -> Peek PandocError Pandoc -> LuaE PandocError Pandoc
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError Pandoc -> LuaE PandocError Pandoc)
-> Peek PandocError Pandoc -> LuaE PandocError Pandoc
forall a b. (a -> b) -> a -> b
$ Peeker PandocError Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc StackIndex
top
Status
_ -> LuaE PandocError Pandoc
forall e a. LuaError e => LuaE e a
throwErrorAsException