{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module      : Text.Pandoc.Lua
Copyright   : Copyright © 2017-2022 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert@hslua.org>

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
  { forall e. Settings e -> Text
settingsVersionInfo :: Text
  , forall e. Settings e -> LuaE e () -> IO ()
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 :: IO Options
getOptions = do
  [String]
rawArgs <- IO [String]
getArgs
  String
progName <- IO String
getProgName
  let ([Options -> IO Options]
actions, [String]
args, [String]
errs) = forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt forall a. ArgOrder a
RequireOrder [OptDescr (Options -> IO 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 -> IO 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
  Options
opts <- forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (forall (m :: * -> *) a. Monad m => a -> m a
return Options
defaultLuaOpts) [Options -> IO 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
    }

-- | Print version information to the terminal.
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

-- | Runs code given on the command line
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

-- | 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 :: forall e. LuaError e => Settings e -> IO ()
runStandalone Settings e
settings = do
  Options
opts <- IO Options
getOptions
  forall e. Settings e -> LuaE e () -> IO ()
settingsRunner Settings e
settings forall a b. (a -> b) -> a -> b
$ do
    -- print version info
    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)

    -- push `arg` table
    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"

    -- run code statements and module loading instructions
    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
    Status
result <- case Options -> Maybe String
optScript Options
opts of
      -- `dofileTrace` should really accept a (Maybe FilePath)
      Just String
script | String
script forall a. Eq a => a -> a -> Bool
/= String
"-" -> do
        forall e. String -> LuaE e Status
Lua.loadfile String
script forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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)
            forall e. NumArgs -> NumResults -> LuaE e Status
Lua.pcallTrace NumArgs
nargs NumResults
Lua.multret
          Status
s      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
s
      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 Status
Lua.OK
      Maybe String
_ -> do
        -- load script from stdin
        State
l <- forall e. LuaE e State
Lua.state
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (State -> Ptr CChar -> IO StatusCode
Lua.luaL_loadfile State
l forall a. Ptr a
nullPtr) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          StatusCode
Lua.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)
            forall e. NumArgs -> NumResults -> LuaE e Status
Lua.pcallTrace NumArgs
nargs NumResults
Lua.multret
          StatusCode
s          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ StatusCode -> Status
Lua.toStatus StatusCode
s

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
result forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK)
      forall e a. LuaError e => LuaE e a
Lua.throwErrorAsException

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

-- | Lua runner command line options.
data Options = Options
  { Options -> Bool
optNoEnv       :: Bool          -- ^ Ignore environment variables
  , Options -> Bool
optInteractive :: Bool          -- ^ Interactive
  , Options -> Bool
optVersion     :: Bool          -- ^ Show version info
  , Options -> Bool
optWarnings    :: Bool          -- ^ Whether warnings are enabled
  , Options -> [LuaCode]
optExecute     :: [LuaCode]     -- ^ code to execute, in reverse order
  , Options -> String
optProgName    :: String        -- ^ program name
  , Options -> [String]
optAllArgs     :: [String]      -- ^ all arguments
  , Options -> Maybe String
optScript      :: Maybe String  -- ^ script name, if any
  , Options -> [String]
optScriptArgs  :: [String]      -- ^ arguments passed to the script
  }

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
  }

-- | Lua command line options.
luaOptions :: [OptDescr (Options -> IO Options)]
luaOptions :: [OptDescr (Options -> IO 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        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 -> do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"[WARNING] Flag `-i` is not supported yet."
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      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 -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"[WARNING] Flag `-E` is not supported yet."
        forall (m :: * -> *) a. Monad m => a -> m a
return Options
opt { optNoEnv :: Bool
optNoEnv = Bool
True })
    String
"ignore environment variables -- currently not 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 -> do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"[WARNING] Flag `-W` is not supported yet."
        forall (m :: * -> *) a. Monad m => a -> m a
return Options
opt { optWarnings :: Bool
optWarnings = Bool
True })
    String
"turn warnings on -- currently not supported"
  ]