diff options
author | PhilFreeman <> | 2014-11-09 22:45:00 (GMT) |
---|---|---|
committer | hdiff <hdiff@hdiff.luite.com> | 2014-11-09 22:45:00 (GMT) |
commit | 254c97a5f26fdaf5d48b5b79024f1056703f32b7 (patch) | |
tree | dd2fda7ce5c18022d6aa676577197a2ba4cf0d47 | |
parent | 88fe21af7aabeb80065badddd09be9ce397542d0 (diff) |
version 0.6.0.20.6.0.2
-rw-r--r-- | psc-docs/Main.hs | 3 | ||||
-rw-r--r-- | psc-make/Main.hs | 8 | ||||
-rw-r--r-- | psc/Main.hs | 3 | ||||
-rw-r--r-- | psci/Main.hs | 20 | ||||
-rw-r--r-- | purescript.cabal | 2 | ||||
-rw-r--r-- | src/Language/PureScript.hs | 20 | ||||
-rw-r--r-- | src/Language/PureScript/Parser/Declarations.hs | 6 | ||||
-rw-r--r-- | tests/Main.hs | 8 |
8 files changed, 41 insertions, 29 deletions
diff --git a/psc-docs/Main.hs b/psc-docs/Main.hs index a9f5c00..7a2b7de 100644 --- 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 index 67f0238..3753377 100644 --- 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 index 713bcce..b6a7a12 100644 --- 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 index 87b9adf..52d7dae 100644 --- 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 index c5efaeb..80f68be 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -1,5 +1,5 @@ name: purescript -version: 0.6.0.1 +version: 0.6.0.2 cabal-version: >=1.8 build-type: Simple license: MIT diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs index c8bc10c..7ddf4c5 100644 --- 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 @@ -134,12 +134,21 @@ 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 index fc62868..6adfea9 100644 --- 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 index 8bbdcd5..0fa63d5 100644 --- 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) |