diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +# Changelog + +`hslua-cli` uses [PVP Versioning](https://pvp.haskell.org). + +## hslua-cli-1.0.0 + +Released 2022-09-23. + +- Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright © 1994-2022 Lua.org, PUC-Rio. +Copyright © 2007-2012 Gracjan Polak +Copyright © 2012-2015 Ömer Sinan Ağacan +Copyright © 2016-2022 Albert Krewinkel + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,26 @@ +hslua-cli +========= + +Library that allows to embed a standalone Lua interpreter into a +larger program. The provided command-line interface is mostly +compatible with that of the default `lua` executable that ships +with Lua. + +Example +------- + +``` haskell +import HsLua.Core as Lua (Exception, openlibs, run) +import HsLua.CLI (Settings (..), runStandalone) + +-- | Run a default Lua interpreter. +main :: IO () +main = do + let settings = Settings + { settingsVersionInfo = "\nembedded in MyProgram" + , settingsRunner = \action -> run $ do + openlibs + action + } + runStandalone @Lua.Exception settings +``` diff --git a/app/hslua.hs b/app/hslua.hs new file mode 100644 --- /dev/null +++ b/app/hslua.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{- | +Module : Main +Copyright : © 2022 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel + +Re-implementation of the standard Lua interpreter. +-} +module Main (main) where +import HsLua.Core as Lua (Exception, openlibs, run) +import HsLua.CLI (Settings (..), runStandalone) + +-- | Run a default Lua interpreter. +main :: IO () +main = do + let settings = Settings + { settingsVersionInfo = "" + , settingsRunner = \action -> run $ do + openlibs + action + } + runStandalone @Lua.Exception settings diff --git a/hslua-cli.cabal b/hslua-cli.cabal new file mode 100644 --- /dev/null +++ b/hslua-cli.cabal @@ -0,0 +1,78 @@ +cabal-version: 2.2 +name: hslua-cli +version: 1.0.0 +synopsis: Command-line interface for Lua +description: Provides an embeddable command-line interface for Lua. + The interface is compatible with the standard Lua + interpreter, i.e., the `lua` executable provided in a + default Lua installation. +homepage: https://hslua.org/ +bug-reports: https://github.com/hslua/hslua/issues +license: MIT +license-file: LICENSE +author: Albert Krewinkel +maintainer: Albert Krewinkel +copyright: © 2022 Albert Krewinkel +category: Foreign +build-type: Simple +extra-doc-files: README.md + CHANGELOG.md +tested-with: GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.2 + , GHC == 9.2.3 + +source-repository head + type: git + location: https://github.com/hslua/hslua + subdir: hslua-cli + +Flag executable + description: Compile `hslua` standalone executable. + default: False + +common common-options + build-depends: base >= 4.9.1 && < 5 + , bytestring + , hslua-core >= 2.1 && < 2.3 + + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + if impl(ghc >= 8.0) + ghc-options: -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.8) + ghc-options: -Wmissing-deriving-strategies + + default-language: Haskell2010 + +library + import: common-options + hs-source-dirs: src + exposed-modules: HsLua.CLI + build-depends: base >= 4.9.1 && < 5 + , hslua-marshalling >= 2.1 && < 2.3 + , lua >= 2.1 && < 2.3 + , text >= 1.2 && < 2.1 + +executable hslua + import: common-options + hs-source-dirs: app + main-is: hslua.hs + ghc-options: -rtsopts -with-rtsopts=-A8m -threaded + if flag(executable) + buildable: True + build-depends: hslua-cli + else + buildable: False diff --git a/src/HsLua/CLI.hs b/src/HsLua/CLI.hs new file mode 100644 --- /dev/null +++ b/src/HsLua/CLI.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{- | +Module : Text.Pandoc.Lua +Copyright : Copyright © 2017-2022 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel + +Embeddable Lua interpreter interface. +-} +module HsLua.CLI + ( -- * Run scripts as program + runStandalone + , Settings (..) + ) where + +import Control.Monad (unless, when, zipWithM_) +import Data.Bifunctor (first) +import Data.ByteString (ByteString) +import Data.Foldable (foldl') +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Foreign.Ptr (nullPtr) +import HsLua.Core (LuaE, LuaError) +import System.Console.GetOpt +import System.Environment (getArgs, getProgName) +import System.IO (hPutStrLn, stderr) +import qualified Lua.Auxiliary as Lua +import qualified Lua.Constants as Lua +import qualified HsLua.Core as Lua +import qualified HsLua.Marshalling as Lua +import qualified HsLua.Core.Types as Lua +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified HsLua.Core.Utf8 as UTF8 + +-- | Settings for the Lua command line interface. +data Settings e = Settings + { settingsVersionInfo :: Text + , settingsRunner :: LuaE e () -> IO () + } + +-- | Get the Lua interpreter options from the command line. Throws an +-- error with usage instructions if parsing fails. +getOptions :: IO Options +getOptions = do + rawArgs <- getArgs + progName <- getProgName + let (actions, args, errs) = getOpt RequireOrder luaOptions rawArgs + unless (null errs) . ioError . userError $ + let usageHead = "Usage: " ++ progName ++ " [options] [script [args]]" + in concat errs ++ usageInfo usageHead luaOptions + + let (mscript, arg) = first listToMaybe $ splitAt 1 args + opts <- foldl' (>>=) (return defaultLuaOpts) actions + return opts + { optScript = mscript + , optScriptArgs = arg + , optProgName = progName + , optAllArgs = rawArgs + } + +-- | Print version information to the terminal. +showVersion :: LuaError e => Text -> LuaE e () +showVersion extraInfo = do + _ <- Lua.getglobal "_VERSION" + versionString <- Lua.forcePeek $ Lua.peekText Lua.top + Lua.liftIO . T.putStrLn $ versionString `T.append` extraInfo + +-- | Runs code given on the command line +runCode :: LuaError e => LuaCode -> LuaE e () +runCode = \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 + +-- | 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@. +runStandalone :: LuaError e => Settings e -> IO () +runStandalone settings = do + opts <- getOptions + settingsRunner settings $ do + -- print version info + when (optVersion opts) (showVersion $ settingsVersionInfo settings) + + -- push `arg` table + case optScript opts of + Just _script -> do + let setField i x = Lua.pushString x *> Lua.rawseti (Lua.nth 2) i + let nprogargs = length (optAllArgs opts) - length (optScriptArgs opts) + let arg = optProgName opts : optAllArgs opts + Lua.newtable + zipWithM_ setField [-(fromIntegral nprogargs)..] arg + Nothing -> do + Lua.pushList Lua.pushString (optAllArgs opts) + Lua.pushString (optProgName opts) + Lua.rawseti (Lua.nth 2) 0 + Lua.setglobal "arg" + + -- run code statements and module loading instructions + mapM_ runCode (reverse $ optExecute opts) + + let nargs = fromIntegral . length $ optScriptArgs opts + result <- case optScript opts of + -- `dofileTrace` should really accept a (Maybe FilePath) + Just script | script /= "-" -> do + Lua.loadfile script >>= \case + Lua.OK -> do + mapM_ Lua.pushString (optScriptArgs opts) + Lua.pcallTrace nargs Lua.multret + s -> pure s + Nothing | optVersion opts || not (null (optExecute opts)) -> + pure Lua.OK + _ -> do + -- load script from stdin + l <- Lua.state + Lua.liftIO (Lua.luaL_loadfile l nullPtr) >>= \case + Lua.LUA_OK -> do + mapM_ Lua.pushString (optScriptArgs opts) + Lua.pcallTrace nargs Lua.multret + s -> pure $ Lua.toStatus s + + when (result /= Lua.OK) + Lua.throwErrorAsException + +-- | Code to execute on startup. +data LuaCode = + ExecuteCode ByteString + | RequireModule Lua.Name Lua.Name + +-- | Lua runner command line options. +data Options = Options + { optNoEnv :: Bool -- ^ Ignore environment variables + , optInteractive :: Bool -- ^ Interactive + , optVersion :: Bool -- ^ Show version info + , optWarnings :: Bool -- ^ Whether warnings are enabled + , optExecute :: [LuaCode] -- ^ code to execute, in reverse order + , optProgName :: String -- ^ program name + , optAllArgs :: [String] -- ^ all arguments + , optScript :: Maybe String -- ^ script name, if any + , optScriptArgs :: [String] -- ^ arguments passed to the script + } + +defaultLuaOpts :: Options +defaultLuaOpts = Options + { optNoEnv = False + , optInteractive = False + , optVersion = False + , optWarnings = False + , optExecute = mempty + , optProgName = mempty + , optAllArgs = mempty + , optScript = Nothing + , optScriptArgs = mempty + } + +-- | Lua command line options. +luaOptions :: [OptDescr (Options -> IO Options)] +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 -> return opt { optVersion = True }) + "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" + ]