{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module      : HsLua.REPL
Copyright   : Copyright © 2017-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Embeddable Lua interpreter interface.
-}
module HsLua.REPL
  ( -- * Run scripts as program
    repl
  , replWithEnv
  , setup
  , Config (..)
  , defaultConfig
  ) where

import Control.Applicative ((<|>))
import Control.Monad (void, when)
import Data.ByteString (ByteString)
import Data.Text (Text)
import Lua (pattern LUA_COPYRIGHT)
import HsLua.Core
import System.Console.Isocline
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified HsLua.Core.Utf8 as UTF8

-- | Lua runner command line options.
data Config = Config
  { Config -> Text
replPrompt     :: Text
  , Config -> Text
replInfo       :: Text
  , Config -> Maybe FilePath
replHistory    :: Maybe FilePath
  }

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config
  { replPrompt :: Text
replPrompt = Text
""
  , replInfo :: Text
replInfo = FilePath -> Text
T.pack FilePath
LUA_COPYRIGHT
  , replHistory :: Maybe FilePath
replHistory = Maybe FilePath
forall a. Maybe a
Nothing
  }

-- | Setup a new repl. Prints the version and extra info before the
-- first prompt.
setup :: Config -> LuaE e ()
setup :: forall e. Config -> LuaE e ()
setup Config
config = do
  IO () -> LuaE e ()
forall a. IO a -> LuaE e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LuaE e ()) -> IO () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Config -> Text
replInfo Config
config)
  case Config -> Maybe FilePath
replHistory Config
config of
    Just FilePath
histfile -> IO () -> LuaE e ()
forall a. IO a -> LuaE e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LuaE e ()) -> IO () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> IO ()
setHistory FilePath
histfile Int
200
    Maybe FilePath
Nothing -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Checks if the error message hints at incomplete input. Removes the
-- message from the stack in that case.
incomplete :: LuaError e => LuaE e Bool
incomplete :: forall e. LuaError e => LuaE e Bool
incomplete = do
  let eofmark :: ByteString
eofmark = ByteString
"<eof>"
  ByteString
msg <- StackIndex -> LuaE e ByteString
forall e. LuaError e => StackIndex -> LuaE e ByteString
tostring' StackIndex
top
  if ByteString
eofmark ByteString -> ByteString -> Bool
`Char8.isSuffixOf` ByteString
msg
    then Bool
True  Bool -> LuaE e () -> LuaE e Bool
forall a b. a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
2  -- error message (duplicated by tostring')
    else Bool
False Bool -> LuaE e () -> LuaE e Bool
forall a b. a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1  -- value pushed by tostring'

-- | Load an input string, mark it as coming from @stdin@.
loadinput :: ByteString -> LuaE e Status
loadinput :: forall e. ByteString -> LuaE e Status
loadinput ByteString
inp = ByteString -> Name -> LuaE e Status
forall e. ByteString -> Name -> LuaE e Status
loadbuffer ByteString
inp Name
"=stdin"

-- | Try to load input while prepending a @return@ statement.
loadExpression :: LuaError e => ByteString -> LuaE e ()
loadExpression :: forall e. LuaError e => ByteString -> LuaE e ()
loadExpression ByteString
input = ByteString -> LuaE e Status
forall e. ByteString -> LuaE e Status
loadinput (ByteString
"return " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
input) 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
OK -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()  -- yep, that worked
  Status
_err   -> LuaE e ()
forall e a. LuaError e => LuaE e a
throwErrorAsException

-- | Load a multiline statement; prompts for more lines if the statement
-- looks incomplete.
loadStatement :: LuaError e
              => [ByteString]      -- ^ input lines
              -> LuaE e ()
loadStatement :: forall e. LuaError e => [ByteString] -> LuaE e ()
loadStatement [ByteString]
lns = do
  ByteString -> LuaE e Status
forall e. ByteString -> LuaE e Status
loadinput ([ByteString] -> ByteString
Char8.unlines ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
lns) 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
OK -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Status
ErrSyntax -> LuaE e Bool
forall e. LuaError e => LuaE e Bool
incomplete LuaE e Bool -> (Bool -> 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
>>= \Bool
isincmplt ->
      if Bool
isincmplt
      then IO (Maybe FilePath) -> LuaE e (Maybe FilePath)
forall a. IO a -> LuaE e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
readlineMaybe FilePath
">") LuaE e (Maybe FilePath)
-> (Maybe FilePath -> 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
        Maybe FilePath
Nothing    -> FilePath -> LuaE e ()
forall e a. LuaError e => FilePath -> LuaE e a
failLua FilePath
"Multiline input aborted"
        Just FilePath
input -> [ByteString] -> LuaE e ()
forall e. LuaError e => [ByteString] -> LuaE e ()
loadStatement (FilePath -> ByteString
UTF8.fromString FilePath
input ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
lns)
      else LuaE e ()
forall e a. LuaError e => LuaE e a
throwErrorAsException
    Status
_ -> LuaE e ()
forall e a. LuaError e => LuaE e a
throwErrorAsException

-- | Run a Lua REPL.
repl :: LuaError e => LuaE e NumResults
repl :: forall e. LuaError e => LuaE e NumResults
repl = Maybe Reference -> LuaE e NumResults
forall e. LuaError e => Maybe Reference -> LuaE e NumResults
replWithEnv Maybe Reference
forall a. Maybe a
Nothing

-- | Run a Lua REPL, using the table in the given upvalue as the load
-- environment.
replWithEnv :: LuaError e => Maybe Reference -> LuaE e NumResults
replWithEnv :: forall e. LuaError e => Maybe Reference -> LuaE e NumResults
replWithEnv Maybe Reference
mEnvRef = LuaE e NumResults -> LuaE e (Either e NumResults)
forall e a. Exception e => LuaE e a -> LuaE e (Either e a)
try LuaE e NumResults
forall e. LuaError e => LuaE e NumResults
repl' LuaE e (Either e NumResults)
-> (Either e NumResults -> LuaE e NumResults) -> LuaE e NumResults
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
  Right NumResults
n  -> NumResults -> LuaE e NumResults
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NumResults
n -- Ctrl-D or Ctrl-C
  Left e
err -> do
    -- something went wrong: report error, reset stack and try again
    LuaE e Type -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Type -> LuaE e ()) -> LuaE e Type -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Name -> LuaE e Type
forall e. LuaError e => Name -> LuaE e Type
getglobal Name
"print"
    e -> LuaE e ()
forall e. LuaError e => e -> LuaE e ()
pushException e
err
    NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call NumArgs
1 NumResults
0
    StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
settop StackIndex
0
    Maybe Reference -> LuaE e NumResults
forall e. LuaError e => Maybe Reference -> LuaE e NumResults
replWithEnv Maybe Reference
mEnvRef
 where
  repl' :: LuaError e => LuaE e NumResults
  repl' :: forall e. LuaError e => LuaE e NumResults
repl' = IO (Maybe FilePath) -> LuaE e (Maybe FilePath)
forall a. IO a -> LuaE e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
readlineMaybe FilePath
"") LuaE e (Maybe FilePath)
-> (Maybe FilePath -> LuaE e NumResults) -> LuaE e NumResults
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
    Maybe FilePath
Nothing ->
      -- Return all values left on the stack as results
      CInt -> NumResults
NumResults (CInt -> NumResults)
-> (StackIndex -> CInt) -> StackIndex -> NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
fromStackIndex (StackIndex -> NumResults)
-> LuaE e StackIndex -> LuaE e NumResults
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LuaE e StackIndex
forall e. LuaE e StackIndex
gettop
    Just FilePath
inputStr -> do
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
settop StackIndex
0  -- reset stack
      let input :: ByteString
input = FilePath -> ByteString
UTF8.fromString FilePath
inputStr
      ByteString -> LuaE e ()
forall e. LuaError e => ByteString -> LuaE e ()
loadExpression ByteString
input LuaE e () -> LuaE e () -> LuaE e ()
forall a. LuaE e a -> LuaE e a -> LuaE e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ByteString] -> LuaE e ()
forall e. LuaError e => [ByteString] -> LuaE e ()
loadStatement [ByteString
input]
      -- take env (if any) and set it as the first upvalue of the loaded
      -- thunk.
      case Maybe Reference
mEnvRef of
        Maybe Reference
Nothing -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Reference
envRef -> do
          StackIndex -> Reference -> LuaE e Type
forall e. LuaError e => StackIndex -> Reference -> LuaE e Type
getref StackIndex
registryindex Reference
envRef LuaE e Type -> (Type -> 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
            Type
TypeTable -> LuaE e (Maybe Name) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Maybe Name) -> LuaE e ())
-> LuaE e (Maybe Name) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Int -> LuaE e (Maybe Name)
forall e. StackIndex -> Int -> LuaE e (Maybe Name)
setupvalue (CInt -> StackIndex
nth CInt
2) Int
1
            Type
_ -> Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
      -- run loaded input
      NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
0 NumResults
multret
      StackIndex
nvalues <- LuaE e StackIndex
forall e. LuaE e StackIndex
gettop
      -- duplicate everything and call print on the results
      Int -> FilePath -> LuaE e ()
forall e. LuaError e => Int -> FilePath -> LuaE e ()
checkstack' (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StackIndex -> CInt
fromStackIndex StackIndex
nvalues) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) FilePath
"repl'"
      Bool -> LuaE e () -> LuaE e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StackIndex
nvalues StackIndex -> StackIndex -> Bool
forall a. Ord a => a -> a -> Bool
> StackIndex
0) (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
        LuaE e Type -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Type -> LuaE e ()) -> LuaE e Type -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Name -> LuaE e Type
forall e. LuaError e => Name -> LuaE e Type
getglobal Name
"print"
        (StackIndex -> LuaE e ()) -> [StackIndex] -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue [StackIndex
1..StackIndex
nvalues]
        NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call (CInt -> NumArgs
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> NumArgs) -> CInt -> NumArgs
forall a b. (a -> b) -> a -> b
$ StackIndex -> CInt
fromStackIndex StackIndex
nvalues) NumResults
0
      LuaE e NumResults
forall e. LuaError e => LuaE e NumResults
repl'