{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Module
( initModules
) where
import Control.Monad (forM_, when)
import Data.Version (makeVersion)
import HsLua as Lua
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshal.List (pushPandocList, pushListModule)
import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua)
import qualified Data.ByteString.Char8 as Char8
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.Zip as Module.Zip
import qualified Text.Pandoc.Lua.Module.CLI as Pandoc.CLI
import qualified Text.Pandoc.Lua.Module.Format as Pandoc.Format
import qualified Text.Pandoc.Lua.Module.Image as Pandoc.Image
import qualified Text.Pandoc.Lua.Module.JSON as Pandoc.JSON
import qualified Text.Pandoc.Lua.Module.Log as Pandoc.Log
import qualified Text.Pandoc.Lua.Module.MediaBag as Pandoc.MediaBag
import qualified Text.Pandoc.Lua.Module.Pandoc as Module.Pandoc
import qualified Text.Pandoc.Lua.Module.Scaffolding as Pandoc.Scaffolding
import qualified Text.Pandoc.Lua.Module.Structure as Pandoc.Structure
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.Text as Pandoc.Text
import qualified Text.Pandoc.Lua.Module.Types as Pandoc.Types
import qualified Text.Pandoc.Lua.Module.Utils as Pandoc.Utils
initModules :: PandocLua ()
initModules :: PandocLua ()
initModules = do
PandocLua ()
initPandocModule
PandocLua ()
initJsonMetatable
PandocLua ()
installLpegSearcher
PandocLua ()
setGlobalModules
initPandocModule :: PandocLua ()
initPandocModule :: PandocLua ()
initPandocModule = 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
Module PandocError -> LuaE PandocError ()
forall e. LuaError e => Module e -> LuaE e ()
registerModule Module PandocError
Module.Pandoc.documentedModule
[Module PandocError]
-> (Module PandocError -> LuaE PandocError ())
-> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Module PandocError]
submodules ((Module PandocError -> LuaE PandocError ())
-> LuaE PandocError ())
-> (Module PandocError -> LuaE PandocError ())
-> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ \Module PandocError
mdl -> do
Module PandocError -> LuaE PandocError ()
forall e. LuaError e => Module e -> LuaE e ()
registerModule Module PandocError
mdl
Bool -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module PandocError -> Name
forall e. Module e -> Name
moduleName Module PandocError
mdl Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"pandoc.text") (LuaE PandocError () -> LuaE PandocError ())
-> LuaE PandocError () -> LuaE PandocError ()
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
loaded
StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
"text"
Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
let fieldname :: Name -> Name
fieldname (Name ByteString
mdlname) = ByteString -> Name
Name (ByteString -> Name)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteString
-> ((Char, ByteString) -> ByteString)
-> Maybe (Char, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
mdlname (Char, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Maybe (Char, ByteString) -> ByteString)
-> ((ByteString, ByteString) -> Maybe (Char, ByteString))
-> (ByteString, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Char, ByteString)
Char8.uncons (ByteString -> Maybe (Char, ByteString))
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Maybe (Char, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> Name)
-> (ByteString, ByteString) -> Name
forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> ByteString -> (ByteString, ByteString)
Char8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') ByteString
mdlname
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
nth CInt
2) (Name -> Name
fieldname (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Module PandocError -> Name
forall e. Module e -> Name
moduleName Module PandocError
mdl)
Name -> (Name -> LuaE PandocError ()) -> LuaE PandocError ()
forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
requirehs Name
"pandoc.List" (LuaE PandocError () -> Name -> LuaE PandocError ()
forall a b. a -> b -> a
const LuaE PandocError ()
forall e. LuaError e => LuaE e ()
pushListModule)
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
"List"
Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"pandoc"
submodules :: [Module PandocError]
submodules :: [Module PandocError]
submodules =
[ Module PandocError
Pandoc.CLI.documentedModule
, Module PandocError
Pandoc.Format.documentedModule
, Module PandocError
Pandoc.Image.documentedModule
, Module PandocError
Pandoc.JSON.documentedModule
, Module PandocError
Pandoc.Log.documentedModule
, Module PandocError
Pandoc.MediaBag.documentedModule
, Module PandocError
Pandoc.Scaffolding.documentedModule
, Module PandocError
Pandoc.Structure.documentedModule
, Module PandocError
forall e. LuaError e => Module e
Pandoc.System.documentedModule
, Module PandocError
Pandoc.Template.documentedModule
, Module PandocError
Pandoc.Text.documentedModule
, Module PandocError
Pandoc.Types.documentedModule
, Module PandocError
Pandoc.Utils.documentedModule
, ((Module PandocError
forall e. LuaError e => Module e
Module.Layout.documentedModule { moduleName = "pandoc.layout" }
Module PandocError -> [Int] -> Module PandocError
forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
2,Int
18])
Module PandocError -> [Name] -> [Int] -> Module PandocError
forall {t :: * -> *} {e}.
Foldable t =>
Module e -> t Name -> [Int] -> Module e
`functionsSince` [Name
"bold", Name
"italic", Name
"underlined", Name
"strikeout", Name
"fg", Name
"bg"])
[Int
3, Int
4, Int
1]
, Module PandocError
forall e. LuaError e => Module e
Module.Path.documentedModule { moduleName = "pandoc.path" }
Module PandocError -> [Int] -> Module PandocError
forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
2,Int
12]
, Module PandocError
forall e. LuaError e => Module e
Module.Zip.documentedModule { moduleName = "pandoc.zip" }
Module PandocError -> [Int] -> Module PandocError
forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
3,Int
0]
]
where
allSince :: Module e -> [Int] -> Module e
allSince Module e
mdl [Int]
version = Module e
mdl
{ moduleFunctions = map (`since` makeVersion version) $ moduleFunctions mdl
}
functionsSince :: Module e -> t Name -> [Int] -> Module e
functionsSince Module e
mdl t Name
fns [Int]
version = Module e
mdl
{ moduleFunctions = map (\DocumentedFunction e
fn ->
if (DocumentedFunction e -> Name
forall e. DocumentedFunction e -> Name
functionName DocumentedFunction e
fn) Name -> t Name -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Name
fns
then DocumentedFunction e
fn DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int]
version
else DocumentedFunction e
fn) $ moduleFunctions mdl
}
setGlobalModules :: PandocLua ()
setGlobalModules :: PandocLua ()
setGlobalModules = 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
let globalModules :: [(Name, CFunction)]
globalModules =
[ (Name
"lpeg", CFunction
LPeg.luaopen_lpeg_ptr)
, (Name
"re", CFunction
LPeg.luaopen_re_ptr)
]
[(Name, CFunction)]
-> ((Name, CFunction) -> LuaE PandocError ())
-> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, CFunction)]
globalModules (((Name, CFunction) -> LuaE PandocError ()) -> LuaE PandocError ())
-> ((Name, CFunction) -> LuaE PandocError ())
-> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$
\(Name
pkgname, CFunction
luaopen) -> do
CFunction -> LuaE PandocError ()
forall e. CFunction -> LuaE e ()
Lua.pushcfunction CFunction
luaopen
NumArgs
-> NumResults -> Maybe StackIndex -> LuaE PandocError Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall NumArgs
0 NumResults
1 Maybe StackIndex
forall a. Maybe a
Nothing LuaE PandocError Status
-> (Status -> LuaE PandocError ()) -> LuaE PandocError ()
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 -> do
StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue (CInt -> StackIndex
Lua.nth CInt
2)
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
Lua.nth CInt
2) Name
pkgname
Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
Status
_ -> do
Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
Name -> LuaE PandocError Type
forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"require"
Name -> LuaE PandocError ()
forall e. Name -> LuaE e ()
Lua.pushName Name
pkgname
NumArgs -> NumResults -> LuaE PandocError ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
Lua.call NumArgs
1 NumResults
1
Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
pkgname
installLpegSearcher :: PandocLua ()
installLpegSearcher :: PandocLua ()
installLpegSearcher = 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
Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.getglobal' Name
"package.searchers"
HaskellFunction PandocError -> LuaE PandocError ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction (HaskellFunction PandocError -> LuaE PandocError ())
-> HaskellFunction PandocError -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ LuaE PandocError State
forall e. LuaE e State
Lua.state LuaE PandocError State
-> (State -> HaskellFunction PandocError)
-> HaskellFunction PandocError
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
>>= IO NumResults -> HaskellFunction PandocError
forall a. IO a -> LuaE PandocError a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NumResults -> HaskellFunction PandocError)
-> (State -> IO NumResults) -> State -> HaskellFunction PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> IO NumResults
LPeg.lpeg_searcher
StackIndex -> Integer -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (CInt -> StackIndex
Lua.nth CInt
2) (Integer -> LuaE PandocError ())
-> (Int -> Integer) -> Int -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) (Integer -> Integer) -> (Int -> Integer) -> Int -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> LuaE PandocError ())
-> LuaE PandocError Int -> LuaE PandocError ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StackIndex -> LuaE PandocError Int
forall e. StackIndex -> LuaE e Int
Lua.rawlen (CInt -> StackIndex
Lua.nth CInt
2)
Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
initJsonMetatable :: PandocLua ()
initJsonMetatable :: PandocLua ()
initJsonMetatable = 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
Pusher PandocError (ZonkAny 0) -> Pusher PandocError [ZonkAny 0]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (LuaE PandocError () -> Pusher PandocError (ZonkAny 0)
forall a b. a -> b -> a
const LuaE PandocError ()
forall e. LuaE e ()
pushnil) []
StackIndex -> LuaE PandocError Bool
forall e. StackIndex -> LuaE e Bool
getmetatable StackIndex
top
StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
HsLua.Aeson.jsonarray
Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1