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