{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Init
( runLua
) where
import Control.Monad (when)
import Control.Monad.Catch (throwM, try)
import Control.Monad.Trans (MonadIO (..))
import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
import HsLua as Lua hiding (status, try)
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Text.Pandoc.Class.PandocMonad (PandocMonad, readDataFile)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Packages (installPandocPackageSearcher)
import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua)
import qualified Data.Text as T
import qualified Text.Pandoc.Definition as Pandoc
import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc
runLua :: (PandocMonad m, MonadIO m)
=> LuaE PandocError a -> m (Either PandocError a)
runLua :: LuaE PandocError a -> m (Either PandocError a)
runLua LuaE PandocError a
luaOp = do
TextEncoding
enc <- IO TextEncoding -> m TextEncoding
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextEncoding -> m TextEncoding)
-> IO TextEncoding -> m TextEncoding
forall a b. (a -> b) -> a -> b
$ IO TextEncoding
getForeignEncoding IO TextEncoding -> IO () -> IO TextEncoding
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TextEncoding -> IO ()
setForeignEncoding TextEncoding
utf8
Either PandocError a
res <- PandocLua (Either PandocError a) -> m (Either PandocError a)
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
PandocLua a -> m a
runPandocLua (PandocLua (Either PandocError a) -> m (Either PandocError a))
-> (PandocLua a -> PandocLua (Either PandocError a))
-> PandocLua a
-> m (Either PandocError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocLua a -> PandocLua (Either PandocError a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (PandocLua a -> m (Either PandocError a))
-> PandocLua a -> m (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ do
PandocLua ()
initLuaState
LuaE PandocError a -> PandocLua a
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError a
luaOp
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TextEncoding -> IO ()
setForeignEncoding TextEncoding
enc
Either PandocError a -> m (Either PandocError a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either PandocError a
res
initLuaState :: PandocLua ()
initLuaState :: PandocLua ()
initLuaState = do
LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError ()
forall e. LuaE e ()
Lua.openlibs
PandocLua ()
installPandocPackageSearcher
PandocLua ()
initPandocModule
FilePath -> PandocLua ()
loadInitScript FilePath
"init.lua"
where
initPandocModule :: PandocLua ()
initPandocModule :: PandocLua ()
initPandocModule = do
PandocLua NumResults
ModulePandoc.pushModule
LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue StackIndex
Lua.top
StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
Lua.nth CInt
2) Name
"pandoc"
Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
PandocLua ()
putConstructorsInRegistry
LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"pandoc"
loadInitScript :: FilePath -> PandocLua ()
loadInitScript :: FilePath -> PandocLua ()
loadInitScript FilePath
scriptFile = do
ByteString
script <- FilePath -> PandocLua ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
scriptFile
Status
status <- LuaE PandocError Status -> PandocLua Status
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError Status -> PandocLua Status)
-> LuaE PandocError Status -> PandocLua Status
forall a b. (a -> b) -> a -> b
$ ByteString -> LuaE PandocError Status
forall e. ByteString -> LuaE e Status
Lua.dostring ByteString
script
Bool -> PandocLua () -> PandocLua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK) (PandocLua () -> PandocLua ())
-> (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError ()
-> PandocLua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
PandocError
err <- LuaE PandocError PandocError
forall e. LuaError e => LuaE e e
popException
let prefix :: Text
prefix = Text
"Couldn't load '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
scriptFile Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"':\n"
PandocError -> LuaE PandocError ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> LuaE PandocError ())
-> (Text -> PandocError) -> Text -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> PandocError) -> (Text -> Text) -> Text -> PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> LuaE PandocError ()) -> Text -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ case PandocError
err of
PandocLuaError Text
msg -> Text
msg
PandocError
_ -> FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ PandocError -> FilePath
forall a. Show a => a -> FilePath
show PandocError
err
putConstructorsInRegistry :: PandocLua ()
putConstructorsInRegistry :: PandocLua ()
putConstructorsInRegistry = LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
Pandoc -> LuaE PandocError ()
forall a. Data a => a -> LuaE PandocError ()
constrsToReg (Pandoc -> LuaE PandocError ()) -> Pandoc -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc.Pandoc Meta
forall a. Monoid a => a
mempty [Block]
forall a. Monoid a => a
mempty
Inline -> LuaE PandocError ()
forall a. Data a => a -> LuaE PandocError ()
constrsToReg (Inline -> LuaE PandocError ()) -> Inline -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Pandoc.Str Text
forall a. Monoid a => a
mempty
Block -> LuaE PandocError ()
forall a. Data a => a -> LuaE PandocError ()
constrsToReg (Block -> LuaE PandocError ()) -> Block -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Pandoc.Para [Inline]
forall a. Monoid a => a
mempty
Meta -> LuaE PandocError ()
forall a. Data a => a -> LuaE PandocError ()
constrsToReg (Meta -> LuaE PandocError ()) -> Meta -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Map Text MetaValue -> Meta
Pandoc.Meta Map Text MetaValue
forall a. Monoid a => a
mempty
MetaValue -> LuaE PandocError ()
forall a. Data a => a -> LuaE PandocError ()
constrsToReg (MetaValue -> LuaE PandocError ())
-> MetaValue -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ [MetaValue] -> MetaValue
Pandoc.MetaList [MetaValue]
forall a. Monoid a => a
mempty
Citation -> LuaE PandocError ()
forall a. Data a => a -> LuaE PandocError ()
constrsToReg (Citation -> LuaE PandocError ())
-> Citation -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Pandoc.Citation Text
forall a. Monoid a => a
mempty [Inline]
forall a. Monoid a => a
mempty [Inline]
forall a. Monoid a => a
mempty CitationMode
Pandoc.AuthorInText Int
0 Int
0
FilePath -> LuaE PandocError ()
putInReg FilePath
"ListAttributes"
FilePath -> LuaE PandocError ()
putInReg FilePath
"List"
FilePath -> LuaE PandocError ()
putInReg FilePath
"SimpleTable"
where
constrsToReg :: Data a => a -> LuaE PandocError ()
constrsToReg :: a -> LuaE PandocError ()
constrsToReg = (Constr -> LuaE PandocError ()) -> [Constr] -> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> LuaE PandocError ()
putInReg (FilePath -> LuaE PandocError ())
-> (Constr -> FilePath) -> Constr -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> FilePath
showConstr) ([Constr] -> LuaE PandocError ())
-> (a -> [Constr]) -> a -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs (DataType -> [Constr]) -> (a -> DataType) -> a -> [Constr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DataType
forall a. Data a => a -> DataType
dataTypeOf
putInReg :: String -> LuaE PandocError ()
putInReg :: FilePath -> LuaE PandocError ()
putInReg FilePath
name = do
FilePath -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (FilePath
"pandoc." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name)
FilePath -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push FilePath
name
StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawget (CInt -> StackIndex
Lua.nth CInt
3)
StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset StackIndex
Lua.registryindex