{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module HsLua.CLI
(
runStandalone
, Settings (..)
, EnvBehavior (..)
) 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.C.String (withCString)
import HsLua.Core (LuaE, LuaError)
import System.Console.GetOpt
import System.Environment (lookupEnv)
import System.IO (hPutStrLn, stderr)
import qualified Lua.Constants as Lua
import qualified Lua.Primary as Lua
import qualified HsLua.Core as Lua
import qualified HsLua.Marshalling as Lua
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified HsLua.Core.Utf8 as UTF8
data Settings e = Settings
{ forall e. Settings e -> Text
settingsVersionInfo :: Text
, forall e. Settings e -> EnvBehavior -> LuaE e () -> IO ()
settingsRunner :: EnvBehavior -> LuaE e () -> IO ()
}
data EnvBehavior = IgnoreEnvVars | ConsultEnvVars
deriving (EnvBehavior -> EnvBehavior -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnvBehavior -> EnvBehavior -> Bool
$c/= :: EnvBehavior -> EnvBehavior -> Bool
== :: EnvBehavior -> EnvBehavior -> Bool
$c== :: EnvBehavior -> EnvBehavior -> Bool
Eq, Int -> EnvBehavior -> ShowS
[EnvBehavior] -> ShowS
EnvBehavior -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvBehavior] -> ShowS
$cshowList :: [EnvBehavior] -> ShowS
show :: EnvBehavior -> String
$cshow :: EnvBehavior -> String
showsPrec :: Int -> EnvBehavior -> ShowS
$cshowsPrec :: Int -> EnvBehavior -> ShowS
Show)
getOptions :: String -> [String] -> IO Options
getOptions :: String -> [String] -> IO Options
getOptions String
progName [String]
rawArgs = do
let ([Options -> Options]
actions, [String]
args, [String]
errs) = forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt forall a. ArgOrder a
RequireOrder [OptDescr (Options -> Options)]
luaOptions [String]
rawArgs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IOError -> IO a
ioError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError forall a b. (a -> b) -> a -> b
$
let usageHead :: String
usageHead = String
"Usage: " forall a. [a] -> [a] -> [a]
++ String
progName forall a. [a] -> [a] -> [a]
++ String
" [options] [script [args]]"
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
errs forall a. [a] -> [a] -> [a]
++ forall a. String -> [OptDescr a] -> String
usageInfo String
usageHead [OptDescr (Options -> Options)]
luaOptions
let (Maybe String
mscript, [String]
arg) = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [String]
args
let opts :: Options
opts = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)) Options
defaultLuaOpts [Options -> Options]
actions
forall (m :: * -> *) a. Monad m => a -> m a
return Options
opts
{ optScript :: Maybe String
optScript = Maybe String
mscript
, optScriptArgs :: [String]
optScriptArgs = [String]
arg
, optProgName :: String
optProgName = String
progName
, optAllArgs :: [String]
optAllArgs = [String]
rawArgs
}
showVersion :: LuaError e => Text -> LuaE e ()
showVersion :: forall e. LuaError e => Text -> LuaE e ()
showVersion Text
extraInfo = do
Type
_ <- forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"_VERSION"
Text
versionString <- forall e a. LuaError e => Peek e a -> LuaE e a
Lua.forcePeek forall a b. (a -> b) -> a -> b
$ forall e. Peeker e Text
Lua.peekText StackIndex
Lua.top
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
versionString Text -> Text -> Text
`T.append` Text
extraInfo
runCode :: LuaError e => LuaCode -> LuaE e ()
runCode :: forall e. LuaError e => LuaCode -> LuaE e ()
runCode = \case
ExecuteCode ByteString
stat -> do
Status
status <- forall e. ByteString -> LuaE e Status
Lua.dostringTrace ByteString
stat
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
status forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK)
forall e a. LuaError e => LuaE e a
Lua.throwErrorAsException
RequireModule Name
g Name
mod' -> do
Type
_ <- forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"require"
forall e. Name -> LuaE e ()
Lua.pushName Name
mod'
Status
status <- forall e. NumArgs -> NumResults -> LuaE e Status
Lua.pcallTrace NumArgs
1 NumResults
1
if Status
status forall a. Eq a => a -> a -> Bool
== Status
Lua.OK
then forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
g
else forall e a. LuaError e => LuaE e a
Lua.throwErrorAsException
runStandalone :: LuaError e
=> Settings e
-> String
-> [String]
-> IO ()
runStandalone :: forall e. LuaError e => Settings e -> String -> [String] -> IO ()
runStandalone Settings e
settings String
progName [String]
args = do
Options
opts <- String -> [String] -> IO Options
getOptions String
progName [String]
args
let envVarOpt :: EnvBehavior
envVarOpt = if Options -> Bool
optNoEnv Options
opts
then EnvBehavior
IgnoreEnvVars
else EnvBehavior
ConsultEnvVars
forall e. Settings e -> EnvBehavior -> LuaE e () -> IO ()
settingsRunner Settings e
settings EnvBehavior
envVarOpt forall a b. (a -> b) -> a -> b
$ do
let putErr :: String -> LuaE e ()
putErr = forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
optVersion Options
opts) (forall e. LuaError e => Text -> LuaE e ()
showVersion forall a b. (a -> b) -> a -> b
$ forall e. Settings e -> Text
settingsVersionInfo Settings e
settings)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
optInteractive Options
opts) forall a b. (a -> b) -> a -> b
$
String -> LuaE e ()
putErr String
"[WARNING] Flag `-i` is not supported yet."
case Options -> Maybe String
optScript Options
opts of
Just String
_script -> do
let setField :: Integer -> String -> LuaE e ()
setField Integer
i String
x = forall e. String -> LuaE e ()
Lua.pushString String
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (CInt -> StackIndex
Lua.nth CInt
2) Integer
i
let nprogargs :: Int
nprogargs = forall (t :: * -> *) a. Foldable t => t a -> Int
length (Options -> [String]
optAllArgs Options
opts) forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length (Options -> [String]
optScriptArgs Options
opts)
let arg :: [String]
arg = Options -> String
optProgName Options
opts forall a. a -> [a] -> [a]
: Options -> [String]
optAllArgs Options
opts
forall e. LuaE e ()
Lua.newtable
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ forall {e}. LuaError e => Integer -> String -> LuaE e ()
setField [-(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nprogargs)..] [String]
arg
Maybe String
Nothing -> do
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
Lua.pushList forall e. String -> LuaE e ()
Lua.pushString (Options -> [String]
optAllArgs Options
opts)
forall e. String -> LuaE e ()
Lua.pushString (Options -> String
optProgName Options
opts)
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (CInt -> StackIndex
Lua.nth CInt
2) Integer
0
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"arg"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
optWarnings Options
opts) forall a b. (a -> b) -> a -> b
$ do
State
l <- forall e. LuaE e State
Lua.state
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
"@on" forall a b. (a -> b) -> a -> b
$ \CString
w -> State -> CString -> LuaBool -> IO ()
Lua.lua_warning State
l CString
w LuaBool
Lua.FALSE
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
optNoEnv Options
opts) forall a b. (a -> b) -> a -> b
$ do
Maybe String
init' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
"LUA_INIT"
(case Maybe String
init' of
Just (Char
'@' : String
filename) -> forall e. Maybe String -> LuaE e Status
Lua.dofileTrace (forall a. a -> Maybe a
Just String
filename)
Just String
cmd -> forall e. ByteString -> LuaE e Status
Lua.dostring (String -> ByteString
UTF8.fromString String
cmd)
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Status
Lua.OK)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
Lua.OK -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Status
_ -> forall e a. LuaError e => LuaE e a
Lua.throwErrorAsException
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall e. LuaError e => LuaCode -> LuaE e ()
runCode (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Options -> [LuaCode]
optExecute Options
opts)
let nargs :: NumArgs
nargs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Options -> [String]
optScriptArgs Options
opts
let handleScriptResult :: Status -> LuaE e ()
handleScriptResult = \case
Status
Lua.OK -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall e. String -> LuaE e ()
Lua.pushString (Options -> [String]
optScriptArgs Options
opts)
Status
status <- forall e. NumArgs -> NumResults -> LuaE e Status
Lua.pcallTrace NumArgs
nargs NumResults
Lua.multret
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
status forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK)
forall e a. LuaError e => LuaE e a
Lua.throwErrorAsException
Status
_ -> forall e a. LuaError e => LuaE e a
Lua.throwErrorAsException
case Options -> Maybe String
optScript Options
opts of
Just String
script | String
script forall a. Eq a => a -> a -> Bool
/= String
"-" -> do
forall e. Maybe String -> LuaE e Status
Lua.loadfile (forall a. a -> Maybe a
Just String
script) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Status -> LuaE e ()
handleScriptResult
Maybe String
Nothing | Options -> Bool
optVersion Options
opts Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Options -> [LuaCode]
optExecute Options
opts)) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe String
_ -> do
forall e. Maybe String -> LuaE e Status
Lua.loadfile forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Status -> LuaE e ()
handleScriptResult
data LuaCode =
ExecuteCode ByteString
| RequireModule Lua.Name Lua.Name
data Options = Options
{ Options -> Bool
optNoEnv :: Bool
, Options -> Bool
optInteractive :: Bool
, Options -> Bool
optVersion :: Bool
, Options -> Bool
optWarnings :: Bool
, Options -> [LuaCode]
optExecute :: [LuaCode]
, Options -> String
optProgName :: String
, Options -> [String]
optAllArgs :: [String]
, Options -> Maybe String
optScript :: Maybe String
, Options -> [String]
optScriptArgs :: [String]
}
defaultLuaOpts :: Options
defaultLuaOpts :: Options
defaultLuaOpts = Options
{ optNoEnv :: Bool
optNoEnv = Bool
False
, optInteractive :: Bool
optInteractive = Bool
False
, optVersion :: Bool
optVersion = Bool
False
, optWarnings :: Bool
optWarnings = Bool
False
, optExecute :: [LuaCode]
optExecute = forall a. Monoid a => a
mempty
, optProgName :: String
optProgName = forall a. Monoid a => a
mempty
, optAllArgs :: [String]
optAllArgs = forall a. Monoid a => a
mempty
, optScript :: Maybe String
optScript = forall a. Maybe a
Nothing
, optScriptArgs :: [String]
optScriptArgs = forall a. Monoid a => a
mempty
}
luaOptions :: [OptDescr (Options -> Options)]
luaOptions :: [OptDescr (Options -> Options)]
luaOptions =
[ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"e" []
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (String -> a) -> String -> ArgDescr a
ReqArg String
"stat" forall a b. (a -> b) -> a -> b
$ \String
stat Options
opt ->
let code :: LuaCode
code = ByteString -> LuaCode
ExecuteCode forall a b. (a -> b) -> a -> b
$ String -> ByteString
UTF8.fromString String
stat
in Options
opt{ optExecute :: [LuaCode]
optExecute = LuaCode
codeforall a. a -> [a] -> [a]
:Options -> [LuaCode]
optExecute Options
opt })
String
"execute string 'stat'"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"i" []
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ \Options
opt -> Options
opt { optInteractive :: Bool
optInteractive = Bool
True })
String
"interactive mode -- currently not supported"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"l" []
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (String -> a) -> String -> ArgDescr a
ReqArg String
"mod" forall a b. (a -> b) -> a -> b
$ \String
mod' Options
opt ->
let toName :: String -> Name
toName = ByteString -> Name
Lua.Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString
code :: LuaCode
code = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'=') String
mod' of
(String
glb, Char
'=':String
m) -> Name -> Name -> LuaCode
RequireModule (String -> Name
toName String
glb) (String -> Name
toName String
m)
(String
glb, String
_ ) -> Name -> Name -> LuaCode
RequireModule (String -> Name
toName String
glb) (String -> Name
toName String
glb)
in Options
opt{ optExecute :: [LuaCode]
optExecute = LuaCode
codeforall a. a -> [a] -> [a]
:Options -> [LuaCode]
optExecute Options
opt })
([String] -> String
unlines
[ String
"require library 'mod' into global 'mod';"
, String
"if 'mod' has the pattern 'g=module', then"
, String
"require library 'module' into global 'g'"
])
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" []
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ \Options
opt -> Options
opt { optVersion :: Bool
optVersion = Bool
True })
String
"show version information"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"E" []
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ \Options
opt -> Options
opt { optNoEnv :: Bool
optNoEnv = Bool
True })
String
"ignore environment variables -- partially supported"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"W" []
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ \Options
opt -> Options
opt { optWarnings :: Bool
optWarnings = Bool
True })
String
"turn warnings on -- currently not supported"
]