Skip to content

Commit

Permalink
Make exe behave like a lua interpreter when called as pandoc-lua.
Browse files Browse the repository at this point in the history
  • Loading branch information
tarleb committed Sep 22, 2022
1 parent bd1d923 commit 02eae65
Show file tree
Hide file tree
Showing 4 changed files with 148 additions and 0 deletions.
10 changes: 10 additions & 0 deletions MANUAL.txt
Expand Up @@ -7096,6 +7096,16 @@ will be performed on the server during pandoc conversions.

[pandoc-server]: https://github.com/jgm/pandoc/blob/master/doc/pandoc-server.md

# Running pandoc as a Lua interpreter

Calling the pandoc executable under the name `pandoc-lua` will
make it function as a standalone Lua interpreter. The behavior is
mostly identical to that of the [standalone `lua`
executable][standalone lua], version 5.4. However, there is no
REPL yet, and the options `-W`, `-E`, and `-i` are currently don't
have any effect.

[lua standalone]: https://www.lua.org/manual/5.4/manual.html#7

# A note on security

Expand Down
2 changes: 2 additions & 0 deletions pandoc-cli/src/pandoc.hs
Expand Up @@ -14,6 +14,7 @@ module Main where
import qualified Control.Exception as E
import Text.Pandoc.App (convertWithOpts, defaultOpts, options, parseOptions)
import Text.Pandoc.Error (handleError)
import Text.Pandoc.Lua (runScript)
import Text.Pandoc.Server (ServerOpts(..), parseServerOpts, app)
import Safe (readDef)
import System.Environment (getProgName, lookupEnv)
Expand All @@ -30,4 +31,5 @@ main = E.handle (handleError . Left) $ do
"pandoc-server" -> do
sopts <- parseServerOpts
Warp.run (serverPort sopts) (timeout (serverTimeout sopts) app)
"pandoc-lua" -> runScript
_ -> parseOptions options defaultOpts >>= convertWithOpts
1 change: 1 addition & 0 deletions pandoc.cabal
Expand Up @@ -502,6 +502,7 @@ library
http-types >= 0.8 && < 0.13,
ipynb >= 0.2 && < 0.3,
jira-wiki-markup >= 1.4 && < 1.5,
lua >= 2.2 && < 2.3,
lpeg >= 1.0.1 && < 1.1,
mime-types >= 0.1.1 && < 0.2,
mtl >= 2.2 && < 2.3,
Expand Down
135 changes: 135 additions & 0 deletions src/Text/Pandoc/Lua.hs
@@ -1,3 +1,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{- |
Module : Text.Pandoc.Lua
Copyright : Copyright © 2017-2022 Albert Krewinkel
Expand All @@ -13,15 +16,147 @@ module Text.Pandoc.Lua
applyFilter
, readCustom
, writeCustom
-- * Run scripts as program
, runScript
-- * Low-level functions
, Global(..)
, setGlobals
, runLua
) where

import Control.Monad (forM_, when)
import Data.ByteString (ByteString)
import Data.Foldable (foldl')
import Data.Text (unpack)
import Foreign.Ptr (nullPtr)
import System.Console.GetOpt
import System.Environment (getArgs)
import System.Exit (exitSuccess)
import System.IO (hPutStrLn, stderr)
import Text.Pandoc.Class (runIOorExplode)
import Text.Pandoc.Error (handleError)
import Text.Pandoc.Lua.Filter (applyFilter)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Init (runLua)
import Text.Pandoc.Lua.Reader (readCustom)
import Text.Pandoc.Lua.Writer (writeCustom)
import Text.Pandoc.Lua.Orphans ()
import Text.Pandoc.Shared (pandocVersion)
import qualified Lua.Auxiliary as Lua
import qualified Lua.Constants as Lua
import qualified HsLua as Lua
import qualified HsLua.Core.Types as Lua
import qualified Text.Pandoc.UTF8 as UTF8

-- | Uses the first command line argument as the name of a script file
-- and tries to run that script in Lua. Falls back to stdin if no file
-- is given. Any remaining args are passed to Lua via the global table
-- @arg@.
runScript :: IO ()
runScript = do
rawArgs <- getArgs
let (actions, args, errs) = getOpt RequireOrder luaOptions rawArgs
when (not $ null errs) . ioError . userError $
concat errs ++
usageInfo "Usage: pandoc-lua [options] [script [args]]" luaOptions

let (script, arg) = splitAt 1 args
opts <- foldl' (>>=) (return defaultLuaOpts) actions
luaResult <- runIOorExplode . runLua $ do
Lua.pushList Lua.pushString arg
Lua.setglobal "arg"

forM_ (reverse $ optExecute opts) $ \case
ExecuteCode stat -> do
status <- Lua.dostringTrace stat
when (status /= Lua.OK)
Lua.throwErrorAsException
RequireModule g mod' -> do
Lua.getglobal "require"
Lua.pushName mod'
status <- Lua.pcallTrace 1 1
if status == Lua.OK
then Lua.setglobal g
else Lua.throwErrorAsException

result <- case script of
[fp] -> Lua.dofileTrace fp
_ -> do
-- load script from stdin
l <- Lua.state
Lua.liftIO (Lua.luaL_loadfile l nullPtr) >>= \case
Lua.LUA_OK -> Lua.pcallTrace 0 Lua.multret
s -> pure $ Lua.toStatus s

when (result /= Lua.OK)
Lua.throwErrorAsException
handleError luaResult

-- | Code to execute on startup.
data LuaCode = ExecuteCode ByteString | RequireModule Lua.Name Lua.Name

-- | Lua runner command line options.
data LuaOpt = LuaOpt
{ optNoEnv :: Bool -- ^ Ignore environment variables
, optInteractive :: Bool -- ^ Interactive
, optWarnings :: Bool -- ^ Whether warnings are enabled
, optExecute :: [LuaCode] -- ^ code to execute
}

defaultLuaOpts :: LuaOpt
defaultLuaOpts = LuaOpt
{ optNoEnv = False
, optInteractive = False
, optWarnings = False
, optExecute = mempty
}

-- | Lua command line options.
luaOptions :: [OptDescr (LuaOpt -> IO LuaOpt)]
luaOptions =
[ Option "e" []
(flip ReqArg "stat" $ \stat opt -> return $
let code = ExecuteCode $ UTF8.fromString stat
in opt{ optExecute = code:(optExecute opt) })
"execute string 'stat'"

, Option "i" []
(NoArg $ \opt -> do
hPutStrLn stderr "[WARNING] Flag `-i` is not supported yet."
return opt { optInteractive = True })
"interactive mode -- currently not supported"

, Option "l" []
(flip ReqArg "mod" $ \mod' opt -> return $
let toName = Lua.Name . UTF8.fromString
code = case break (== '=') mod' of
(glb, ('=':m)) -> RequireModule (toName glb) (toName m)
(glb, _ ) -> RequireModule (toName glb) (toName glb)
in opt{ optExecute = code:(optExecute opt) })
(unlines
[ "require library 'mod' into global 'mod';"
, "if 'mod' has the pattern 'g=module', then"
, "require library 'module' into global 'g'"
])

, Option "v" []
(NoArg $ \_opt -> do
Lua.run @Lua.Exception $ do
Lua.openlibs
Lua.dostring "print(_VERSION)"
putStrLn $ "Embedded in pandoc " ++ unpack pandocVersion
exitSuccess)
"show version information"

, Option "E" []
(NoArg $ \opt -> do
hPutStrLn stderr "[WARNING] Flag `-E` is not supported yet."
return opt { optNoEnv = True })
"ignore environment variables -- currently not supported"

, Option "W" []
(NoArg $ \opt -> do
hPutStrLn stderr "[WARNING] Flag `-W` is not supported yet."
return opt { optWarnings = True })
"turn warnings on -- currently not supported"
]

0 comments on commit 02eae65

Please sign in to comment.