Skip to content

Commit

Permalink
Never rebuild the Prelude. Always rebuild temporary modules in PSCI.
Browse files Browse the repository at this point in the history
  • Loading branch information
paf31 committed Nov 9, 2014
1 parent 9bd4e3e commit 38db2c6
Show file tree
Hide file tree
Showing 8 changed files with 41 additions and 29 deletions.
3 changes: 2 additions & 1 deletion psc-docs/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
8 changes: 4 additions & 4 deletions psc-make/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion psc/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
20 changes: 10 additions & 10 deletions psci/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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]
}

Expand All @@ -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 }

-- |
Expand Down Expand Up @@ -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


-- |
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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' ->
Expand Down Expand Up @@ -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' ->
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion purescript.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: purescript
version: 0.6.0
version: 0.6.0.1
cabal-version: >=1.8
build-type: Simple
license: MIT
Expand Down
20 changes: 15 additions & 5 deletions src/Language/PureScript.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)

Expand All @@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/Language/PureScript/Parser/Declarations.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)]
Expand Down
8 changes: 4 additions & 4 deletions tests/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down

0 comments on commit 38db2c6

Please sign in to comment.