{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HsLua.REPL
(
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
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 :: 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 ()
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
else Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e. Int -> LuaE e ()
pop Int
1
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"
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 ()
Status
_err -> forall e a. LuaError e => LuaE e a
throwErrorAsException
loadStatement :: LuaError e
=> [ByteString]
-> 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
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
Left e
err -> 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 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 ->
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
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]
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
0 NumResults
multret
StackIndex
nvalues <- forall e. LuaE e StackIndex
gettop
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'