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

Embeddable Lua interpreter interface.
-}
module HsLua.REPL
  ( -- * Run scripts as program
    repl
  , 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 = 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
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> IO ()
setHistory FilePath
histfile Int
200
    Maybe FilePath
Nothing -> 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 <- forall e. LuaError e => StackIndex -> LuaE e ByteString
tostring' StackIndex
top
  if ByteString
eofmark ByteString -> ByteString -> Bool
`Char8.isSuffixOf` ByteString
msg
    then Bool
True  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e. Int -> LuaE e ()
pop Int
2  -- error message (duplicated by tostring')
    else Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 = 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 = forall e. ByteString -> LuaE e Status
loadinput (ByteString
"return " forall a. Semigroup a => a -> a -> a
<> ByteString
input) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Status
OK -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()  -- yep, that worked
  Status
_err   -> 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
  forall e. ByteString -> LuaE e Status
loadinput ([ByteString] -> ByteString
Char8.unlines forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [ByteString]
lns) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Status
OK -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Status
ErrSyntax -> forall e. LuaError e => LuaE e Bool
incomplete forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
isincmplt ->
      if Bool
isincmplt
      then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
readlineMaybe FilePath
">") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe FilePath
Nothing    -> forall e a. LuaError e => FilePath -> LuaE e a
failLua FilePath
"Multiline input aborted"
        Just FilePath
input -> forall e. LuaError e => [ByteString] -> LuaE e ()
loadStatement (FilePath -> ByteString
UTF8.fromString FilePath
input forall a. a -> [a] -> [a]
: [ByteString]
lns)
      else forall e a. LuaError e => LuaE e a
throwErrorAsException
    Status
_ -> 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 = forall e a. Exception e => LuaE e a -> LuaE e (Either e a)
try forall e. LuaError e => LuaE e NumResults
repl' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right NumResults
n  -> 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
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Name -> LuaE e Type
getglobal Name
"print"
    forall e. LuaError e => e -> LuaE e ()
pushException e
err
    forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call NumArgs
1 NumResults
0
    forall e. StackIndex -> LuaE e ()
settop StackIndex
0
    forall e. LuaError e => LuaE e NumResults
repl
 where
  repl' :: LuaError e => LuaE e NumResults
  repl' :: forall e. LuaError e => LuaE e NumResults
repl' = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
readlineMaybe FilePath
"") 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
fromStackIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. LuaE e StackIndex
gettop
    Just FilePath
inputStr -> do
      forall e. StackIndex -> LuaE e ()
settop StackIndex
0  -- reset stack
      let input :: ByteString
input = FilePath -> ByteString
UTF8.fromString FilePath
inputStr
      forall e. LuaError e => ByteString -> LuaE e ()
loadExpression ByteString
input forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e. LuaError e => [ByteString] -> LuaE e ()
loadStatement [ByteString
input]
      -- run loaded input
      forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
0 NumResults
multret
      StackIndex
nvalues <- forall e. LuaE e StackIndex
gettop
      -- duplicate everything and call print on the results
      forall e. LuaError e => Int -> FilePath -> LuaE e ()
checkstack' (forall a b. (Integral a, Num b) => a -> b
fromIntegral (StackIndex -> CInt
fromStackIndex StackIndex
nvalues) forall a. Num a => a -> a -> a
+ Int
1) FilePath
"repl'"
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StackIndex
nvalues forall a. Ord a => a -> a -> Bool
> StackIndex
0) forall a b. (a -> b) -> a -> b
$ do
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Name -> LuaE e Type
getglobal Name
"print"
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall e. StackIndex -> LuaE e ()
pushvalue [StackIndex
1..StackIndex
nvalues]
        forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ StackIndex -> CInt
fromStackIndex StackIndex
nvalues) NumResults
0
      forall e. LuaError e => LuaE e NumResults
repl'