diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 78a5abc8ee..98be205c49 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -93,7 +93,7 @@ If you would prefer to use different terms, please use the section below instead | [@pseudonom](https://github.com/pseudonom) | Eric Easley | [MIT license](http://opensource.org/licenses/MIT) | | [@quesebifurcan](https://github.com/quesebifurcan) | Fredrik Wallberg | [MIT license](http://opensource.org/licenses/MIT) | | [@rightfold](https://github.com/rightfold) | rightfold | [MIT license](https://opensource.org/licenses/MIT) | -| [@rndnoise](https://github.com/rndnoise) | rndnoise | [MIT license](http://opensource.org/licenses/MIT) | +| [@rndnoise](https://www.github.com/rndnoise) | rndnoise | [MIT license](http://opensource.org/licenses/MIT) | | [@robdaemon](https://github.com/robdaemon) | Robert Roland | [MIT license](http://opensource.org/licenses/MIT) | | [@RossMeikleham](https://github.com/RossMeikleham) | Ross Meikleham | [MIT license](http://opensource.org/licenses/MIT) | | [@Rufflewind](https://github.com/Rufflewind) | Phil Ruffwind | [MIT license](https://opensource.org/licenses/MIT) | diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index 1093733c7b..c2ddb695f9 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -318,19 +318,19 @@ command = loop <$> options unless (supportModuleIsDefined (map snd modules)) . liftIO $ do putStr supportModuleMessage exitFailure - (externs, env) <- ExceptT . runMake . make $ modules - return (modules, externs, env) + (externs, _) <- ExceptT . runMake . make $ modules + return (modules, externs) case psciBackend of Backend setup eval reload (shutdown :: state -> IO ()) -> case e of Left errs -> do pwd <- getCurrentDirectory putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions {P.ppeRelativeDirectory = pwd} errs) >> exitFailure - Right (modules, externs, env) -> do + Right (modules, externs) -> do historyFilename <- getHistoryFilename let settings = defaultSettings { historyFile = Just historyFilename } initialState = updateLoadedExterns (const (zip (map snd modules) externs)) initialPSCiState - config = PSCiConfig psciInputGlob env + config = PSCiConfig psciInputGlob runner = flip runReaderT config . flip evalStateT initialState . runInputT (setComplete completion settings) diff --git a/package.yaml b/package.yaml index 96793c44e9..b5393b3ac4 100644 --- a/package.yaml +++ b/package.yaml @@ -22,7 +22,8 @@ extra-source-files: - tests/purs/**/*.json - tests/support/*.json - tests/support/setup-win.cmd - - tests/support/psci/*.purs + - tests/support/psci/**.purs + - tests/support/psci/**.edit - tests/support/pscide/src/**/*.purs - tests/support/pscide/src/**/*.js - tests/support/pscide/src/**/*.fail diff --git a/src/Language/PureScript/Interactive.hs b/src/Language/PureScript/Interactive.hs index efc7a1e44f..3205316a44 100644 --- a/src/Language/PureScript/Interactive.hs +++ b/src/Language/PureScript/Interactive.hs @@ -291,7 +291,7 @@ handleBrowse -> m () handleBrowse print' moduleName = do st <- get - env <- asks psciEnvironment + let env = psciEnvironment st case findMod moduleName (psciLoadedExterns st) (psciImportedModules st) of Just qualName -> print' $ printModuleSignatures qualName env Nothing -> failNotInEnv moduleName diff --git a/src/Language/PureScript/Interactive/Types.hs b/src/Language/PureScript/Interactive/Types.hs index 15e1427024..521b61dd8a 100644 --- a/src/Language/PureScript/Interactive/Types.hs +++ b/src/Language/PureScript/Interactive/Types.hs @@ -3,6 +3,7 @@ -- module Language.PureScript.Interactive.Types ( PSCiConfig(..) + , psciEnvironment , PSCiState -- constructor is not exported, to prevent psciImports and psciExports from -- becoming inconsistent with importedModules, letBindings and loadedExterns , ImportedModule @@ -29,6 +30,7 @@ import Prelude.Compat import qualified Language.PureScript as P import qualified Data.Map as M +import Data.List (foldl') import Language.PureScript.Sugar.Names.Env (nullImports, primExports) import Control.Monad.Trans.Except (runExceptT) import Control.Monad.Writer.Strict (runWriterT) @@ -38,9 +40,8 @@ import Control.Monad.Writer.Strict (runWriterT) -- -- These configuration values do not change during execution. -- -data PSCiConfig = PSCiConfig - { psciFileGlobs :: [String] - , psciEnvironment :: P.Environment +newtype PSCiConfig = PSCiConfig + { psciFileGlobs :: [String] } deriving Show -- | The PSCI state. @@ -78,6 +79,10 @@ psciExports (PSCiState _ _ _ _ x) = x initialPSCiState :: PSCiState initialPSCiState = PSCiState [] [] [] nullImports primExports +psciEnvironment :: PSCiState -> P.Environment +psciEnvironment st = foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment externs + where externs = map snd (psciLoadedExterns st) + -- | All of the data that is contained by an ImportDeclaration in the AST. -- That is: -- @@ -137,7 +142,7 @@ updateImportedModules f (PSCiState x a b c d) = -- | Updates the loaded externs files in the state record. updateLoadedExterns :: ([(P.Module, P.ExternsFile)] -> [(P.Module, P.ExternsFile)]) -> PSCiState -> PSCiState updateLoadedExterns f (PSCiState a b x c d) = - PSCiState a b (f x) c d + updateImportExports (PSCiState a b (f x) c d) -- | Updates the let bindings in the state record. updateLets :: ([P.Declaration] -> [P.Declaration]) -> PSCiState -> PSCiState diff --git a/tests/TestPsci/CommandTest.hs b/tests/TestPsci/CommandTest.hs index a84fdcaf16..7de6412968 100644 --- a/tests/TestPsci/CommandTest.hs +++ b/tests/TestPsci/CommandTest.hs @@ -1,10 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} + module TestPsci.CommandTest where import Prelude () import Prelude.Compat +import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS.Strict (get) +import Language.PureScript (moduleNameFromString) import Language.PureScript.Interactive +import System.FilePath (()) +import System.Directory (getCurrentDirectory) import Test.Hspec import TestPsci.TestEnv @@ -42,5 +48,20 @@ commandTests = context "commandTests" $ do ":complete M.a" `prints` unlines ["M.ap", "M.apply"] specPSCi ":browse" $ do + ":browse Data.Void" `printed` flip shouldContain "data Void" + ":browse Data.Void" `printed` flip shouldContain "absurd ::" + + specPSCi ":reload, :browse" $ do + cwd <- liftIO getCurrentDirectory + let new = cwd "tests" "support" "psci" "Reload.edit" + + ":browse Reload" `printed` flip shouldContain "reload ::" + ":browse Reload" `printed` flip shouldNotContain "edited ::" + + simulateModuleEdit (moduleNameFromString "Reload") new $ do + run ":reload" + ":browse Reload" `printed` flip shouldNotContain "reload ::" + ":browse Reload" `printed` flip shouldContain "edited ::" + ":browse Mirp" `printed` flip shouldContain "is not valid" ":browse Prim" `printed` flip shouldContain "class Partial" diff --git a/tests/TestPsci/TestEnv.hs b/tests/TestPsci/TestEnv.hs index a41c018871..84cb90fba5 100644 --- a/tests/TestPsci/TestEnv.hs +++ b/tests/TestPsci/TestEnv.hs @@ -1,16 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} + module TestPsci.TestEnv where import Prelude () import Prelude.Compat -import Control.Monad (void) +import Control.Exception.Lifted (bracket_) +import Control.Monad (void, when) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.RWS.Strict (evalRWST, RWST) +import Control.Monad.Trans.RWS.Strict (evalRWST, asks, local, RWST) +import Data.List (isSuffixOf) +import qualified Data.Text as T import qualified Language.PureScript as P import Language.PureScript.Interactive -import System.Directory (getCurrentDirectory) +import System.Directory (getCurrentDirectory, doesPathExist, removeFile) import System.Exit -import System.FilePath (()) +import System.FilePath ((), pathSeparator) import qualified System.FilePath.Glob as Glob import System.Process (readProcessWithExitCode) import Test.Hspec (shouldBe, Expectation) @@ -23,9 +28,10 @@ initTestPSCiEnv :: IO (PSCiState, PSCiConfig) initTestPSCiEnv = do -- Load test support packages cwd <- getCurrentDirectory - let supportDir = cwd "tests" "support" "bower_components" - let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/src/**/*." ++ ext)) supportDir - pursFiles <- supportFiles "purs" + let supportDir = cwd "tests" "support" + psciFiles <- Glob.globDir1 (Glob.compile "**/*.purs") (supportDir "psci") + libraries <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") (supportDir "bower_components") + let pursFiles = psciFiles ++ libraries modulesOrError <- loadAllModules pursFiles case modulesOrError of Left err -> @@ -35,8 +41,8 @@ initTestPSCiEnv = do makeResultOrError <- runMake . make $ modules case makeResultOrError of Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure - Right (externs, env) -> - return (updateLoadedExterns (const (zip (map snd modules) externs)) initialPSCiState, PSCiConfig pursFiles env) + Right (externs, _) -> + return (updateLoadedExterns (const (zip (map snd modules) externs)) initialPSCiState, PSCiConfig pursFiles) -- | Execute a TestPSCi, returning IO execTestPSCi :: TestPSCi a -> IO a @@ -71,9 +77,8 @@ runAndEval comm jsOutputEval textOutputEval = -- | Run a PSCi command, evaluate compiled JS, and ignore evaluation output and printed output run :: String -> TestPSCi () -run comm = runAndEval comm evalJsAndIgnore ignorePrinted +run comm = runAndEval comm (void jsEval) ignorePrinted where - evalJsAndIgnore = jsEval *> return () ignorePrinted _ = return () -- | A lifted evaluation of Hspec 'shouldBe' for the TestPSCi @@ -95,3 +100,29 @@ prints command expected = printed command (`shouldBe` expected) printed :: String -> (String -> Expectation) -> TestPSCi () printed command f = runAndEval command (void jsEval) (liftIO . f) + +simulateModuleEdit :: P.ModuleName -> FilePath -> TestPSCi a -> TestPSCi a +simulateModuleEdit mn newPath action = do + ms <- asks psciFileGlobs + case replacePath ms of + Nothing -> fail $ "Did not find " ++ inputPath ++ " in psciFileGlobs" + Just xs' -> local (\c -> c { psciFileGlobs = xs' }) temporarily <* rebuild + + where + outputPath = modulesDir T.unpack (P.runModuleName mn) "index.js" + inputPath = T.unpack (T.replace "." slash (P.runModuleName mn)) ++ ".purs" + slash = T.singleton pathSeparator + + replacePath :: [String] -> Maybe [String] + replacePath (x:xs) + | inputPath `isSuffixOf` x = Just (newPath : xs) + | otherwise = fmap (x:) (replacePath xs) + replacePath [] = Nothing + + -- Simply adding the file to `PSCiConfig.fileGlobs` isn't sufficient; running + -- ":reload" might not rebuild because the compiled JS artifact has a more + -- recent timestamp than the "new" source file `newPath`. + temporarily = bracket_ enableRebuild enableRebuild action + enableRebuild = liftIO $ do { b <- doesPathExist outputPath; when b (removeFile outputPath) } + rebuild = handleCommand discard (return ()) discard ReloadState + discard _ = return () diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs index 9c3a69278f..6c7080705b 100644 --- a/tests/TestUtils.hs +++ b/tests/TestUtils.hs @@ -66,10 +66,12 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do getSupportModuleTuples :: IO [(FilePath, P.Module)] getSupportModuleTuples = do cd <- getCurrentDirectory - let supportDir = cd "tests" "support" "bower_components" - supportPurs <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") supportDir - supportPursFiles <- readInput supportPurs - modules <- runExceptT $ ExceptT . return $ P.parseModulesFromFiles id supportPursFiles + let supportDir = cd "tests" "support" + psciFiles <- Glob.globDir1 (Glob.compile "**/*.purs") (supportDir "psci") + libraries <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") (supportDir "bower_components") + let pursFiles = psciFiles ++ libraries + fileContents <- readInput pursFiles + modules <- runExceptT $ ExceptT . return $ P.parseModulesFromFiles id fileContents case modules of Right ms -> return ms Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) diff --git a/tests/support/psci/Reload.edit b/tests/support/psci/Reload.edit new file mode 100644 index 0000000000..21e897862a --- /dev/null +++ b/tests/support/psci/Reload.edit @@ -0,0 +1,4 @@ +module Reload where + +edited :: String +edited = "reload" diff --git a/tests/support/psci/Reload.purs b/tests/support/psci/Reload.purs new file mode 100644 index 0000000000..dae46c4680 --- /dev/null +++ b/tests/support/psci/Reload.purs @@ -0,0 +1,4 @@ +module Reload where + +reload :: Int +reload = 0 diff --git a/tests/support/psci/Sample.purs b/tests/support/psci/Sample.purs deleted file mode 100644 index e69de29bb2..0000000000