{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module HsLua.CLI
(
runStandalone
, Settings (..)
, EnvBehavior (..)
) where
import Control.Monad (unless, void, when, zipWithM_)
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import Foreign.C.String (withCString)
import Lua (pattern LUA_COPYRIGHT)
import HsLua.Core (LuaE, LuaError)
import HsLua.REPL (Config (..), defaultConfig, repl, setup)
import System.Console.GetOpt
import System.Environment (lookupEnv)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Lua.Constants as Lua
import qualified Lua.Primary as Lua
import qualified HsLua.Core as Lua
import qualified HsLua.Core.Utf8 as UTF8
import qualified HsLua.Marshalling as Lua
#if !MIN_VERSION_base(4,20,0)
import Data.Foldable (foldl')
#endif
#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
{ forall e. Settings e -> Text
settingsVersionInfo :: Text
, forall e. Settings e -> EnvBehavior -> LuaE e () -> IO ()
settingsRunner :: EnvBehavior -> LuaE e () -> IO ()
, forall e. Settings e -> Maybe String
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
$c== :: EnvBehavior -> EnvBehavior -> Bool
== :: EnvBehavior -> EnvBehavior -> Bool
$c/= :: EnvBehavior -> EnvBehavior -> Bool
/= :: EnvBehavior -> EnvBehavior -> Bool
Eq, Int -> EnvBehavior -> ShowS
[EnvBehavior] -> ShowS
EnvBehavior -> String
(Int -> EnvBehavior -> ShowS)
-> (EnvBehavior -> String)
-> ([EnvBehavior] -> ShowS)
-> Show EnvBehavior
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvBehavior -> ShowS
showsPrec :: Int -> EnvBehavior -> ShowS
$cshow :: EnvBehavior -> String
show :: EnvBehavior -> String
$cshowList :: [EnvBehavior] -> ShowS
showList :: [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) = ArgOrder (Options -> Options)
-> [OptDescr (Options -> Options)]
-> [String]
-> ([Options -> Options], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder (Options -> Options)
forall a. ArgOrder a
RequireOrder [OptDescr (Options -> Options)]
luaOptions [String]
rawArgs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs) (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> (String -> IOError) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
let usageHead :: String
usageHead = String
"Usage: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
progName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" [options] [script [args]]"
in [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
errs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [OptDescr (Options -> Options)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
usageHead [OptDescr (Options -> Options)]
luaOptions
let (Maybe String
mscript, [String]
arg) = ([String] -> Maybe String)
-> ([String], [String]) -> (Maybe String, [String])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe (([String], [String]) -> (Maybe String, [String]))
-> ([String], [String]) -> (Maybe String, [String])
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [String]
args
let opts :: Options
opts = (Options -> (Options -> Options) -> Options)
-> Options -> [Options -> Options] -> Options
forall b a. (b -> a -> b) -> b -> [a] -> b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Options
opts
{ optScript = mscript
, optScriptArgs = arg
, optProgName = progName
, optAllArgs = rawArgs
}
showVersion :: Text -> LuaE e ()
showVersion :: forall e. Text -> LuaE e ()
showVersion Text
extraInfo = do
let copyrightString :: Text
copyrightString = String -> Text
T.pack String
LUA_COPYRIGHT
IO () -> LuaE e ()
forall a. IO a -> LuaE e a
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
copyrightString 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 <- 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 :: 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
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. 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 String
optScript Options
opts of
Just String
_script -> do
let setField :: Integer -> String -> LuaE e ()
setField Integer
i String
x = String -> LuaE e ()
forall e. String -> LuaE e ()
Lua.pushString String
x LuaE e () -> LuaE e () -> LuaE e ()
forall a b. LuaE e a -> LuaE e b -> LuaE e b
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 = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Options -> [String]
optAllArgs Options
opts) Int -> Int -> Int
forall a. Num a => a -> a -> a
- [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Options -> [String]
optScriptArgs Options
opts)
let arg :: [String]
arg = Options -> String
optProgName Options
opts String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> [String]
optAllArgs Options
opts
LuaE e ()
forall e. LuaE e ()
Lua.newtable
(Integer -> String -> LuaE e ())
-> [Integer] -> [String] -> LuaE e ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Integer -> String -> LuaE e ()
forall {e}. LuaError e => Integer -> String -> LuaE e ()
setField [-(Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nprogargs)..] [String]
arg
Maybe String
Nothing -> do
(String -> LuaE e ()) -> [String] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
Lua.pushList String -> LuaE e ()
forall e. String -> LuaE e ()
Lua.pushString (Options -> [String]
optAllArgs Options
opts)
String -> LuaE e ()
forall e. String -> LuaE e ()
Lua.pushString (Options -> String
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 a. IO a -> LuaE e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO () -> LuaE e ()) -> IO () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
"@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 String
init' <- IO (Maybe String) -> LuaE e (Maybe String)
forall a. IO a -> LuaE e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO (Maybe String) -> LuaE e (Maybe String))
-> IO (Maybe String) -> LuaE e (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
"LUA_INIT"
(case Maybe String
init' of
Just (Char
'@' : String
filename) -> Maybe String -> LuaE e Status
forall e. Maybe String -> LuaE e Status
Lua.dofileTrace (String -> Maybe String
forall a. a -> Maybe a
Just String
filename)
Just String
cmd -> ByteString -> LuaE e Status
forall e. ByteString -> LuaE e Status
Lua.dostring (String -> ByteString
UTF8.fromString String
cmd)
Maybe String
Nothing -> Status -> LuaE e Status
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Lua.OK)
LuaE e Status -> (Status -> LuaE e ()) -> LuaE e ()
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
Lua.OK -> () -> LuaE e ()
forall a. a -> LuaE e a
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) -> ([String] -> Int) -> [String] -> NumArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> NumArgs) -> [String] -> NumArgs
forall a b. (a -> b) -> a -> b
$ Options -> [String]
optScriptArgs Options
opts
let startREPL :: LuaE e ()
startREPL = do
Config -> LuaE e ()
forall e. Config -> LuaE e ()
setup Config
defaultConfig
{ replHistory = settingsHistory settings
, replInfo = replInfo defaultConfig `T.append`
settingsVersionInfo 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
(String -> LuaE e ()) -> [String] -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> LuaE e ()
forall e. String -> LuaE e ()
Lua.pushString (Options -> [String]
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 a. IO a -> LuaE e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO IO Bool
istty
case Options -> Maybe String
optScript Options
opts of
Just String
"-" ->
Maybe String -> LuaE e Status
forall e. Maybe String -> LuaE e Status
Lua.loadfile Maybe String
forall a. Maybe a
Nothing LuaE e Status -> (Status -> LuaE e ()) -> LuaE e ()
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Status -> LuaE e ()
handleScriptResult
Just String
script ->
Maybe String -> LuaE e Status
forall e. Maybe String -> LuaE e Status
Lua.loadfile (String -> Maybe String
forall a. a -> Maybe a
Just String
script) LuaE e Status -> (Status -> LuaE e ()) -> LuaE e ()
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Status -> LuaE e ()
handleScriptResult
Maybe String
_ | Options -> Bool
optInteractive Options
opts -> do
LuaE e ()
startREPL
Maybe String
_ | Options -> Bool
optVersion Options
opts Bool -> Bool -> Bool
|| Bool -> Bool
not ([LuaCode] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Options -> [LuaCode]
optExecute Options
opts)) ->
() -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe String
_ | Bool
tty -> do
LuaE e ()
startREPL
Maybe String
_ -> do
Maybe String -> LuaE e Status
forall e. Maybe String -> LuaE e Status
Lua.loadfile Maybe String
forall a. Maybe a
Nothing LuaE e Status -> (Status -> LuaE e ()) -> LuaE e ()
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
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 = [LuaCode]
forall a. Monoid a => a
mempty
, optProgName :: String
optProgName = String
forall a. Monoid a => a
mempty
, optAllArgs :: [String]
optAllArgs = [String]
forall a. Monoid a => a
mempty
, optScript :: Maybe String
optScript = Maybe String
forall a. Maybe a
Nothing
, optScriptArgs :: [String]
optScriptArgs = [String]
forall a. Monoid a => a
mempty
}
luaOptions :: [OptDescr (Options -> Options)]
luaOptions :: [OptDescr (Options -> Options)]
luaOptions =
[ String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"e" []
(((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options))
-> String
-> (String -> Options -> Options)
-> ArgDescr (Options -> Options)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String
"stat" ((String -> Options -> Options) -> ArgDescr (Options -> Options))
-> (String -> Options -> Options) -> ArgDescr (Options -> Options)
forall a b. (a -> b) -> a -> b
$ \String
stat Options
opt ->
let code :: LuaCode
code = ByteString -> LuaCode
ExecuteCode (ByteString -> LuaCode) -> ByteString -> LuaCode
forall a b. (a -> b) -> a -> b
$ String -> ByteString
UTF8.fromString String
stat
in Options
opt{ optExecute = code:optExecute opt })
String
"execute string 'stat'"
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"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 = True })
String
"interactive mode"
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"l" []
(((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options))
-> String
-> (String -> Options -> Options)
-> ArgDescr (Options -> Options)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String
"mod" ((String -> Options -> Options) -> ArgDescr (Options -> Options))
-> (String -> Options -> Options) -> ArgDescr (Options -> Options)
forall a b. (a -> b) -> a -> b
$ \String
mod' Options
opt ->
let toName :: String -> Name
toName = ByteString -> Name
Lua.Name (ByteString -> Name) -> (String -> ByteString) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString
code :: LuaCode
code = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
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 = code:optExecute 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'"
])
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"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 = True })
String
"show version information"
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"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 = True })
String
"ignore environment variables -- partially supported"
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"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 = True })
String
"turn warnings on -- currently not supported"
]