Never rebuild the Prelude. Always rebuild temporary modules in PSCI.

paf31 · paf31 · commit 38db2c61bc3c · 2014-11-09T11:05:45.000-08:00
diff --git a/psc-docs/Main.hs b/psc-docs/Main.hs
@@ -20,6 +20,7 @@ import Control.Monad.Writer
 import Control.Arrow (first)
 import Data.Function (on)
 import Data.List
+import Data.Maybe (fromMaybe)
 import Data.Version (showVersion)
 import qualified Language.PureScript as P
 import qualified Paths_purescript as Paths
@@ -30,7 +31,7 @@ import System.IO (stderr)
 
 docgen :: Bool -> [FilePath] -> IO ()
 docgen showHierarchy input = do
-  e <- P.parseModulesFromFiles <$> mapM (fmap (first Just) . parseFile) (nub input)
+  e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
   case e of
     Left err -> do
       U.hPutStr stderr $ show err
diff --git a/psc-make/Main.hs b/psc-make/Main.hs
@@ -38,10 +38,10 @@ data InputOptions = InputOptions
   , ioInputFiles  :: [FilePath]
   }
 
-readInput :: InputOptions -> IO [(Maybe FilePath, String)]
+readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
 readInput InputOptions{..} = do
-  content <- forM ioInputFiles $ \inputFile -> (Just inputFile, ) <$> U.readFile inputFile
-  return $ bool ((Nothing, P.prelude) :) id ioNoPrelude content
+  content <- forM ioInputFiles $ \inputFile -> (Right inputFile, ) <$> U.readFile inputFile
+  return $ bool ((Left P.RebuildNever, P.prelude) :) id ioNoPrelude content
 
 newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String)
 
@@ -69,7 +69,7 @@ instance P.MonadMake Make where
 
 compile :: [FilePath] -> FilePath -> P.Options P.Make -> Bool -> IO ()
 compile input outputDir opts usePrefix = do
-  modules <- P.parseModulesFromFiles <$> readInput (InputOptions (P.optionsNoPrelude opts) input)
+  modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)
   case modules of
     Left err -> do
       U.print err
diff --git a/psc/Main.hs b/psc/Main.hs
@@ -20,6 +20,7 @@ import Control.Applicative
 import Control.Monad.Error
 
 import Data.Bool (bool)
+import Data.Maybe (fromMaybe)
 import Data.Version (showVersion)
 
 import System.Console.CmdTheLine
@@ -46,7 +47,7 @@ readInput InputOptions{..}
 
 compile :: P.Options P.Compile -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()
 compile opts stdin input output externs usePrefix = do
-  modules <- P.parseModulesFromFiles <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
+  modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
   case modules of
     Left err -> do
       U.hPutStr stderr $ show err
diff --git a/psci/Main.hs b/psci/Main.hs
@@ -66,7 +66,7 @@ import qualified Language.PureScript.Declarations as D
 data PSCiState = PSCiState
   { psciImportedFilenames   :: [FilePath]
   , psciImportedModuleNames :: [P.ModuleName]
-  , psciLoadedModules       :: [(Maybe FilePath, P.Module)]
+  , psciLoadedModules       :: [(Either P.RebuildPolicy FilePath, P.Module)]
   , psciLetBindings         :: [P.Expr -> P.Expr]
   }
 
@@ -87,7 +87,7 @@ updateImports name st = st { psciImportedModuleNames = name : psciImportedModule
 -- |
 -- Updates the state to have more loaded files.
 --
-updateModules :: [(Maybe FilePath, P.Module)] -> PSCiState -> PSCiState
+updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
 updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
 
 -- |
@@ -130,12 +130,12 @@ loadModule filename = either (Left . show) Right . P.runIndentParser filename P.
 -- |
 -- Load all modules, including the Prelude
 --
-loadAllModules :: [FilePath] -> IO (Either ParseError [(Maybe FilePath, P.Module)])
+loadAllModules :: [FilePath] -> IO (Either ParseError [(Either P.RebuildPolicy FilePath, P.Module)])
 loadAllModules files = do
   filesAndContent <- forM files $ \filename -> do 
     content <- U.readFile filename
-    return (Just filename, content)
-  return $ P.parseModulesFromFiles $ (Nothing, P.prelude) : filesAndContent
+    return (Right filename, content)
+  return $ P.parseModulesFromFiles (either (const "") id) $ (Left P.RebuildNever, P.prelude) : filesAndContent
 
 
 -- |
@@ -303,7 +303,7 @@ handleDeclaration :: P.Expr -> PSCI ()
 handleDeclaration value = do
   st <- PSCI $ lift get
   let m = createTemporaryModule True st value
-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []
+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
   case e of
     Left err -> PSCI $ outputStrLn err
     Right _ -> do
@@ -343,7 +343,7 @@ handleImport :: P.ModuleName -> PSCI ()
 handleImport moduleName = do
    st <- updateImports moduleName <$> PSCI (lift get)
    let m = createTemporaryModuleForImports st
-   e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []
+   e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
    case e of
      Left err -> PSCI $ outputStrLn err
      Right _  -> do
@@ -357,7 +357,7 @@ handleTypeOf :: P.Expr -> PSCI ()
 handleTypeOf value = do
   st <- PSCI $ lift get
   let m = createTemporaryModule False st value
-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []
+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
   case e of
     Left err -> PSCI $ outputStrLn err
     Right env' ->
@@ -407,7 +407,7 @@ handleKindOf typ = do
   st <- PSCI $ lift get
   let m = createTemporaryModuleForKind st typ
       mName = P.ModuleName [P.ProperName "$PSCI"]
-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []
+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
   case e of
     Left err -> PSCI $ outputStrLn err
     Right env' ->
@@ -453,7 +453,7 @@ handleCommand (LoadFile filePath) = do
     m <- psciIO $ loadModule absPath
     case m of
       Left err -> PSCI $ outputStrLn err
-      Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Just absPath)) mods))
+      Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))
   else
     PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
 handleCommand Reset = do
diff --git a/purescript.cabal b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.6.0
+version: 0.6.0.1
 cabal-version: >=1.8
 build-type: Simple 
 license: MIT
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
@@ -15,7 +15,7 @@
 
 {-# LANGUAGE DataKinds, QuasiQuotes, TemplateHaskell #-}
 
-module Language.PureScript (module P, compile, compile', MonadMake(..), make, prelude) where
+module Language.PureScript (module P, compile, compile', RebuildPolicy(..), MonadMake(..), make, prelude) where
 
 import Language.PureScript.Types as P
 import Language.PureScript.Kinds as P
@@ -133,13 +133,22 @@ class MonadMake m where
   --
   progress :: String -> m ()
 
+-- |
+-- Determines when to rebuild a module
+--
+data RebuildPolicy
+  -- | Never rebuild this module
+  = RebuildNever
+  -- | Always rebuild this module 
+  | RebuildAlways deriving (Show, Eq, Ord)
+
 -- |
 -- Compiles in "make" mode, compiling each module separately to a js files and an externs file
 --
 -- If timestamps have not changed, the externs file can be used to provide the module's types without
 -- having to typecheck the module again.
 --
-make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options Make -> [(Maybe FilePath, Module)] -> [String] -> m Environment
+make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options Make -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment
 make outputDir opts ms prefix = do
   let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)
 
@@ -150,14 +159,15 @@ make outputDir opts ms prefix = do
 
         jsFile = outputDir </> filePath </> "index.js"
         externsFile = outputDir </> filePath </> "externs.purs"
-        inputFile = join $ M.lookup moduleName' filePathMap
+        inputFile = fromMaybe (error "Module has no filename in 'make'") $ M.lookup moduleName' filePathMap
 
     jsTimestamp <- getTimestamp jsFile
     externsTimestamp <- getTimestamp externsFile
-    inputTimestamp <- join <$> traverse getTimestamp inputFile 
+    inputTimestamp <- traverse getTimestamp inputFile 
 
     return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of
-      (Just t1, Just t2, Just t3) | t1 < min t2 t3 -> s
+      (Right (Just t1), Just t2, Just t3) | t1 < min t2 t3 -> s
+      (Left RebuildNever, Just _, Just _) -> s
       _ -> S.insert moduleName' s) S.empty sorted
 
   marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
@@ -235,10 +235,10 @@ parseModule = do
 -- |
 -- Parse a collection of modules 
 --
-parseModulesFromFiles :: [(Maybe FilePath, String)] -> Either P.ParseError [(Maybe FilePath, Module)]
-parseModulesFromFiles input = 
+parseModulesFromFiles :: (k -> String) -> [(k, String)] -> Either P.ParseError [(k, Module)]
+parseModulesFromFiles toFilePath input = 
   fmap collect . forM input $ \(filename, content) -> do
-    ms <- runIndentParser (fromMaybe "" filename) parseModules content
+    ms <- runIndentParser (toFilePath filename) parseModules content
     return (filename, ms)
   where
   collect :: [(k, [v])] -> [(k, v)]
diff --git a/tests/Main.hs b/tests/Main.hs
@@ -30,20 +30,20 @@ import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirector
 import Text.Parsec (ParseError)
 import qualified System.IO.UTF8 as U
 
-readInput :: [FilePath] -> IO [(Maybe FilePath, String)]
+readInput :: [FilePath] -> IO [(FilePath, String)]
 readInput inputFiles = forM inputFiles $ \inputFile -> do
   text <- U.readFile inputFile
-  return (Just inputFile, text)
+  return (inputFile, text)
 
 loadPrelude :: Either String (String, String, P.Environment)
 loadPrelude = 
-  case P.parseModulesFromFiles [(Nothing, P.prelude)] of
+  case P.parseModulesFromFiles id [("", P.prelude)] of
     Left parseError -> Left (show parseError)
     Right ms -> P.compile (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) (map snd ms) []
 
 compile :: P.Options P.Compile -> [FilePath] -> IO (Either String (String, String, P.Environment))
 compile opts inputFiles = do
-  modules <- P.parseModulesFromFiles <$> readInput inputFiles
+  modules <- P.parseModulesFromFiles id <$> readInput inputFiles
   case modules of
     Left parseError ->
       return (Left $ show parseError)
