purescript · kritzcreek · Nov 6, 2018 · Jan 31, 2018 · Feb 2, 2018 · Feb 3, 2018
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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