{-# 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.Init (runLuaWith)
import Text.Pandoc.Lua.Marshal.Format (peekExtensionsConfig)
import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc)
import Text.Pandoc.Lua.Marshal.WriterOptions (pushWriterOptions)
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
loadCustom :: (PandocMonad m, MonadIO m)
=> FilePath -> m (CustomComponents m)
loadCustom :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m (CustomComponents m)
loadCustom FilePath
luaFile = do
GCManagedState
luaState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO GCManagedState
newGCManagedState
FilePath
luaFile' <- forall a. a -> Maybe a -> a
fromMaybe FilePath
luaFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *).
PandocMonad m =>
FilePath -> FilePath -> m (Maybe FilePath)
findFileWithDataFallback FilePath
"custom" FilePath
luaFile
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
GCManagedState -> LuaE PandocError a -> m (Either PandocError a)
runLuaWith GCManagedState
luaState forall a b. (a -> b) -> a -> b
$ do
let globals :: [Global]
globals = [ FilePath -> Global
PANDOC_SCRIPT_FILE FilePath
luaFile ]
[Global] -> LuaE PandocError ()
setGlobals [Global]
globals
forall e. Maybe FilePath -> LuaE e Status
dofileTrace (forall a. a -> Maybe a
Just FilePath
luaFile') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
OK -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Status
_ -> forall e a. LuaError e => LuaE e a
throwErrorAsException
Maybe ExtensionsConfig
mextsConf <- forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"Extensions" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Type
TypeFunction -> forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
0 NumResults
1
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Peeker e ExtensionsConfig
peekExtensionsConfig StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1
Type
_ -> forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Peeker e ExtensionsConfig
peekExtensionsConfig StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1
Maybe Text
mtemplate <- forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"Template" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Type
TypeFunction -> forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
0 NumResults
1
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. Peeker e Text
peekText StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1
Type
_ -> forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. Peeker e Text
peekText StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1
Maybe (Reader m)
mreader <- forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"Reader" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> do
forall e. Int -> LuaE e ()
pop Int
1
forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"ByteStringReader" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Type
_ -> do
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
readerField
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => GCManagedState -> Reader m
byteStringReader GCManagedState
luaState
Type
_ -> do
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
readerField
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => GCManagedState -> Reader m
textReader GCManagedState
luaState
Maybe (Writer m)
mwriter <- forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"Writer" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"ByteStringWriter" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> do
Type
docType <- forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"Doc"
forall e. Int -> LuaE e ()
pop Int
3
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if Type
docType forall a. Eq a => a -> a -> Bool
/= Type
TypeFunction
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(WriterOptions -> Pandoc -> m Text) -> Writer m
TextWriter forall a b. (a -> b) -> a -> b
$ \WriterOptions
opts Pandoc
doc ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. GCManagedState -> LuaE e a -> IO a
withGCManagedState GCManagedState
luaState forall a b. (a -> b) -> a -> b
$
forall e. LuaError e => WriterOptions -> Pandoc -> LuaE e Text
Classic.runCustom @PandocError WriterOptions
opts Pandoc
doc
Type
_ -> forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
writerField
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(WriterOptions -> Pandoc -> m ByteString) -> Writer m
ByteStringWriter forall a b. (a -> b) -> a -> b
$ \WriterOptions
opts Pandoc
doc ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. GCManagedState -> LuaE e a -> IO a
withGCManagedState GCManagedState
luaState forall a b. (a -> b) -> a -> b
$ do
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
writerField
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Pandoc
doc
Pusher PandocError WriterOptions
pushWriterOptions WriterOptions
opts
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
2 NumResults
1
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek @PandocError forall a b. (a -> b) -> a -> b
$ forall e. Peeker e ByteString
peekLazyByteString StackIndex
top
Type
_ -> forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
writerField
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(WriterOptions -> Pandoc -> m Text) -> Writer m
TextWriter forall a b. (a -> b) -> a -> b
$ \WriterOptions
opts Pandoc
doc ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. GCManagedState -> LuaE e a -> IO a
withGCManagedState GCManagedState
luaState forall a b. (a -> b) -> a -> b
$ do
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
writerField
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Pandoc
doc
Pusher PandocError WriterOptions
pushWriterOptions WriterOptions
opts
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
2 NumResults
1
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek @PandocError forall a b. (a -> b) -> a -> b
$ forall e. Peeker e Text
peekText StackIndex
top
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CustomComponents
{ customReader :: Maybe (Reader m)
customReader = Maybe (Reader m)
mreader
, customWriter :: Maybe (Writer m)
customWriter = Maybe (Writer m)
mwriter
, customTemplate :: Maybe Text
customTemplate = Maybe Text
mtemplate
, customExtensions :: Maybe ExtensionsConfig
customExtensions = Maybe ExtensionsConfig
mextsConf
}
rawgetglobal :: LuaError e => Name -> LuaE e Lua.Type
rawgetglobal :: forall e. LuaError e => Name -> LuaE e Type
rawgetglobal Name
x = do
forall e. LuaE e ()
pushglobaltable
forall e. Name -> LuaE e ()
pushName Name
x
forall e. LuaError e => StackIndex -> LuaE e Type
rawget (CInt -> StackIndex
nth CInt
2) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 = forall (m :: * -> *).
(ReaderOptions -> ByteString -> m Pandoc) -> Reader m
ByteStringReader forall a b. (a -> b) -> a -> b
$ \ReaderOptions
ropts ByteString
input -> forall (m :: * -> *) a.
MonadIO m =>
GCManagedState -> LuaE PandocError a -> m a
inLua GCManagedState
st forall a b. (a -> b) -> a -> b
$ do
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
readerField
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push ByteString
input
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push ReaderOptions
ropts
forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
OK -> forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Peeker e Pandoc
peekPandoc StackIndex
top
Status
_ -> 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 (m :: * -> *).
(forall a. ToSources a => ReaderOptions -> a -> m Pandoc)
-> Reader m
TextReader forall a b. (a -> b) -> a -> b
$ \ReaderOptions
ropts a
srcs -> forall (m :: * -> *) a.
MonadIO m =>
GCManagedState -> LuaE PandocError a -> m a
inLua GCManagedState
st forall a b. (a -> b) -> a -> b
$ do
let input :: Sources
input = forall a. ToSources a => a -> Sources
toSources a
srcs
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
readerField
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Sources
input
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push ReaderOptions
ropts
forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
OK -> forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Peeker e Pandoc
peekPandoc StackIndex
top
Status
_ -> forall e a. LuaError e => LuaE e a
throwErrorAsException