Skip to content

PSCi: Support multiple command types in paste-mode #3471

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
LiamGoodacre merged 1 commit into from
Dec 15, 2018
Merged

PSCi: Support multiple command types in paste-mode #3471

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
35 changes: 19 additions & 16 deletions app/Command/REPL.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,15 +96,15 @@ psciOptions = PSCiOptions <$> many inputFile
<*> backend

-- | Parses the input and returns either a command, or an error as a 'String'.
getCommand :: forall m. MonadException m => InputT m (Either String (Maybe Command))
getCommand = handleInterrupt (return (Right Nothing)) $ do
getCommand :: forall m. MonadException m => InputT m (Either String [Command])
getCommand = handleInterrupt (return (Right [])) $ do
line <- withInterrupt $ getInputLine "> "
case line of
Nothing -> return (Right (Just QuitPSCi)) -- Ctrl-D when input is empty
Just "" -> return (Right Nothing)
Just s -> return . fmap Just $ parseCommand s
Nothing -> return (Right [QuitPSCi]) -- Ctrl-D when input is empty
Just "" -> return (Right [])
Just s -> return (parseCommand s)

pasteMode :: forall m. MonadException m => InputT m (Either String Command)
pasteMode :: forall m. MonadException m => InputT m (Either String [Command])
pasteMode =
parseCommand <$> go []
where
Expand Down Expand Up @@ -343,16 +343,20 @@ command = loop <$> options
c <- getCommand
case c of
Left err -> outputStrLn err >> go state
Right Nothing -> go state
Right (Just PasteLines) -> do
Right xs -> goExec xs
where
goExec :: [Command] -> InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()
goExec xs = case xs of
[] -> go state
(PasteLines : rest) -> do
c' <- pasteMode
case c' of
Left err -> outputStrLn err >> go state
Right c'' -> handleCommandWithInterrupts state c''
Right (Just QuitPSCi) -> do
Left err -> outputStrLn err >> goExec rest
Right c'' -> handleCommandWithInterrupts state c'' >> goExec rest
(QuitPSCi : _) -> do
outputStrLn quitMessage
liftIO $ shutdown state
Right (Just c') -> handleCommandWithInterrupts state c'
(c' : rest) -> handleCommandWithInterrupts state [c'] >> goExec rest

loadUserConfig :: state -> StateT PSCiState (ReaderT PSCiConfig IO) ()
loadUserConfig state = do
Expand All @@ -366,12 +370,11 @@ command = loop <$> options

handleCommandWithInterrupts
:: state
-> Command
-> [Command]
-> InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()
handleCommandWithInterrupts state cmd = do
handleCommandWithInterrupts state cmds = do
handleInterrupt (outputStrLn "Interrupted.")
(withInterrupt (lift (handleCommand' state cmd)))
go state
(withInterrupt (lift (for_ cmds (handleCommand' state))))

putStrLn prologueMessage
backendState <- setup
Expand Down
6 changes: 3 additions & 3 deletions src/Language/PureScript/Interactive/Parser.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,11 +33,11 @@ parseDotFile filePath s = first show $ do
-- |
-- Parses PSCI metacommands or expressions input from the user.
--
parseCommand :: String -> Either String Command
parseCommand :: String -> Either String [Command]
parseCommand cmdString =
case cmdString of
(':' : cmd) -> parseDirective cmd
_ -> parseRest psciCommand cmdString
(':' : cmd) -> pure <$> parseDirective cmd
_ -> parseRest (many1 psciCommand) cmdString

parseRest :: P.TokenParser a -> String -> Either String a
parseRest p s = first show $ do
Expand Down
5 changes: 3 additions & 2 deletions tests/TestPsci/TestEnv.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ import Control.Exception.Lifted (bracket_)
import Control.Monad (void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.RWS.Strict (evalRWST, asks, local, RWST)
import Data.Foldable (traverse_)
import Data.List (isSuffixOf)
import qualified Data.Text as T
import qualified Language.PureScript as P
Expand Down Expand Up @@ -70,10 +71,10 @@ runAndEval :: String -> TestPSCi () -> (String -> TestPSCi ()) -> TestPSCi ()
runAndEval comm jsOutputEval textOutputEval =
case parseCommand comm of
Left errStr -> liftIO $ putStrLn errStr >> exitFailure
Right command ->
Right commands ->
-- The JS result is ignored, as it's already written in a JS source file.
-- For the detail, please refer to Interactive.hs
handleCommand (\_ -> jsOutputEval) (return ()) textOutputEval command
traverse_ (handleCommand (\_ -> jsOutputEval) (return ()) textOutputEval) commands

-- | Run a PSCi command, evaluate compiled JS, and ignore evaluation output and printed output
run :: String -> TestPSCi ()
Expand Down
2 changes: 2 additions & 0 deletions tests/purs/psci/Multiline.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
-- @paste
import Prelude
import Data.Array
-- @paste

-- @paste
fac :: Int -> Int
Expand Down