{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Init
( runLua
) where
import Control.Monad (forM, forM_, when)
import Control.Monad.Catch (throwM, try)
import Control.Monad.Trans (MonadIO (..))
import Data.Maybe (catMaybes)
import HsLua as Lua hiding (status, try)
import Text.Pandoc.Class.PandocMonad (PandocMonad, readDataFile)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushListModule)
import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Text as T
import qualified Lua.LPeg as LPeg
import qualified HsLua.Aeson
import qualified HsLua.Module.DocLayout as Module.Layout
import qualified HsLua.Module.Path as Module.Path
import qualified HsLua.Module.Text as Module.Text
import qualified Text.Pandoc.Lua.Module.Pandoc as Module.Pandoc
import qualified Text.Pandoc.Lua.Module.MediaBag as Pandoc.MediaBag
import qualified Text.Pandoc.Lua.Module.System as Pandoc.System
import qualified Text.Pandoc.Lua.Module.Template as Pandoc.Template
import qualified Text.Pandoc.Lua.Module.Types as Pandoc.Types
import qualified Text.Pandoc.Lua.Module.Utils as Pandoc.Utils
runLua :: (PandocMonad m, MonadIO m)
=> LuaE PandocError a -> m (Either PandocError a)
runLua :: forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
LuaE PandocError a -> m (Either PandocError a)
runLua LuaE PandocError a
action =
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
PandocLua a -> m a
runPandocLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
PandocLua ()
initLuaState
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError a
action
loadedModules :: [Module PandocError]
loadedModules :: [Module PandocError]
loadedModules =
[ Module PandocError
Pandoc.MediaBag.documentedModule
, forall e. LuaError e => Module e
Pandoc.System.documentedModule
, Module PandocError
Pandoc.Template.documentedModule
, Module PandocError
Pandoc.Types.documentedModule
, Module PandocError
Pandoc.Utils.documentedModule
, forall e. LuaError e => Module e
Module.Layout.documentedModule { moduleName :: Name
moduleName = Name
"pandoc.layout" }
, forall e. LuaError e => Module e
Module.Path.documentedModule { moduleName :: Name
moduleName = Name
"pandoc.path" }
, forall e. Module e
Module.Text.documentedModule
]
initLuaState :: PandocLua ()
initLuaState :: PandocLua ()
initLuaState = do
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall e. LuaE e ()
Lua.openlibs
PandocLua ()
initJsonMetatable
PandocLua ()
initPandocModule
PandocLua ()
installLpegSearcher
PandocLua ()
setGlobalModules
FilePath -> PandocLua ()
loadInitScript FilePath
"init.lua"
where
initPandocModule :: PandocLua ()
initPandocModule :: PandocLua ()
initPandocModule = forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ do
forall e. LuaError e => Module e -> LuaE e ()
registerModule Module PandocError
Module.Pandoc.documentedModule
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Module PandocError]
loadedModules forall a b. (a -> b) -> a -> b
$ \Module PandocError
mdl -> do
forall e. LuaError e => Module e -> LuaE e ()
registerModule Module PandocError
mdl
let fieldname :: Name -> Name
fieldname (Name ByteString
mdlname) = ByteString -> Name
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
mdlname forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Char, ByteString)
Char8.uncons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> ByteString -> (ByteString, ByteString)
Char8.break (forall a. Eq a => a -> a -> Bool
== Char
'.') ByteString
mdlname
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
nth CInt
2) (Name -> Name
fieldname forall a b. (a -> b) -> a -> b
$ forall e. Module e -> Name
moduleName Module PandocError
mdl)
forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
requirehs Name
"pandoc.List" (forall a b. a -> b -> a
const forall e. LuaError e => LuaE e ()
pushListModule)
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
"List"
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"pandoc"
loadInitScript :: FilePath -> PandocLua ()
loadInitScript :: FilePath -> PandocLua ()
loadInitScript FilePath
scriptFile = do
ByteString
script <- forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
scriptFile
Status
status <- forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ forall e. ByteString -> LuaE e Status
Lua.dostring ByteString
script
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
status forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ do
PandocError
err <- forall e. LuaError e => LuaE e e
popException
let prefix :: Text
prefix = Text
"Couldn't load '" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
scriptFile forall a. Semigroup a => a -> a -> a
<> Text
"':\n"
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
prefix forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ case PandocError
err of
PandocLuaError Text
msg -> Text
msg
PandocError
_ -> FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show PandocError
err
setGlobalModules :: PandocLua ()
setGlobalModules :: PandocLua ()
setGlobalModules = forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ do
let globalModules :: [(Name, CFunction)]
globalModules =
[ (Name
"lpeg", CFunction
LPeg.luaopen_lpeg_ptr)
, (Name
"re", CFunction
LPeg.luaopen_re_ptr)
]
[Name]
loadedBuiltInModules <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, CFunction)]
globalModules forall a b. (a -> b) -> a -> b
$
\(Name
pkgname, CFunction
luaopen) -> do
forall e. CFunction -> LuaE e ()
Lua.pushcfunction CFunction
luaopen
Bool
usedBuiltIn <- forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall NumArgs
0 NumResults
1 forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
OK -> do
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
forall e. StackIndex -> LuaE e ()
Lua.pushvalue (CInt -> StackIndex
Lua.nth CInt
2)
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
Lua.nth CInt
2) Name
pkgname
forall e. Int -> LuaE e ()
Lua.pop Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Status
_ -> do
forall e. Int -> LuaE e ()
Lua.pop Int
1
forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"require"
forall e. Name -> LuaE e ()
Lua.pushName Name
pkgname
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
Lua.call NumArgs
1 NumResults
1
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
pkgname
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
usedBuiltIn then forall a. a -> Maybe a
Just Name
pkgname else forall a. Maybe a
Nothing
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
loadedBuiltInModules forall a b. (a -> b) -> a -> b
$ \Name
pkgname -> do
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
forall e. LuaE e ()
Lua.pushnil
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
Lua.nth CInt
2) Name
pkgname
forall e. Int -> LuaE e ()
Lua.pop Int
1
installLpegSearcher :: PandocLua ()
installLpegSearcher :: PandocLua ()
installLpegSearcher = forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ do
forall e. LuaError e => Name -> LuaE e ()
Lua.getglobal' Name
"package.searchers"
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction forall a b. (a -> b) -> a -> b
$ forall e. LuaE e State
Lua.state forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreCFunction
LPeg.lpeg_searcher
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (CInt -> StackIndex
Lua.nth CInt
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. StackIndex -> LuaE e Int
Lua.rawlen (CInt -> StackIndex
Lua.nth CInt
2)
forall e. Int -> LuaE e ()
Lua.pop Int
1
initJsonMetatable :: PandocLua ()
initJsonMetatable :: PandocLua ()
initJsonMetatable = forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ do
forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
HsLua.Aeson.jsonarray (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())