9525739 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Separate compilation for psci, provide output directory option in psc-mkae

9525739Phil Freeman13 years ago

psc-make/Main.hs+10−9

compare with golang

unifiedsplit

@@ -67,16 +67,17 @@ instance P.MonadMake Make where

67 U.putStrLn $ "Writing " ++ path

68 U.writeFile path text

69 liftError = either throwError return

70+ progress = makeIO . U.putStrLn

71−compile :: P.Options -> [FilePath] -> IO ()

72+compile :: FilePath -> P.Options -> [FilePath] -> IO ()

72−compile opts input = do

73+compile outputDir opts input = do

73 modules <- readInput input

74 modules <- readInput input

74 case modules of

75 case modules of

75 Left err -> do

76 Left err -> do

76 U.print err

77 U.print err

77 exitFailure

78 exitFailure

78 Right ms -> do

79 Right ms -> do

79− e <- runMake $ P.make opts ms

80+ e <- runMake $ P.make outputDir opts ms

80 case e of

81 case e of

81 Left err -> do

82 Left err -> do

82 U.putStrLn err

83 U.putStrLn err

@@ -91,6 +92,10 @@ inputFiles :: Term [FilePath]

91inputFiles = value $ posAny [] $ posInfo

92inputFiles = value $ posAny [] $ posInfo

92 { posDoc = "The input .ps files" }

93 { posDoc = "The input .ps files" }

95+outputDirectory :: Term FilePath

96+outputDirectory = value $ opt "output" $ (optInfo [ "o", "output" ])

97+ { optDoc = "The output directory" }

98+

94noTco :: Term Bool

99noTco :: Term Bool

95noTco = value $ flag $ (optInfo [ "no-tco" ])

100noTco = value $ flag $ (optInfo [ "no-tco" ])

96 { optDoc = "Disable tail call optimizations" }

101 { optDoc = "Disable tail call optimizations" }

@@ -111,16 +116,12 @@ noOpts :: Term Bool

111noOpts = value $ flag $ (optInfo [ "no-opts" ])

116noOpts = value $ flag $ (optInfo [ "no-opts" ])

112 { optDoc = "Skip the optimization phase." }

117 { optDoc = "Skip the optimization phase." }

113

118

114−browserNamespace :: Term String

115−browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])

116− { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }

117−

118verboseErrors :: Term Bool

119verboseErrors :: Term Bool

119verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])

120verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])

120 { optDoc = "Display verbose error messages" }

121 { optDoc = "Display verbose error messages" }

121

122

122options :: Term P.Options

123options :: Term P.Options

123−options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> pure Nothing <*> noOpts <*> browserNamespace <*> pure [] <*> pure [] <*> verboseErrors

124+options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> pure Nothing <*> noOpts <*> pure Nothing <*> pure [] <*> pure [] <*> verboseErrors

124

125

125inputFilesAndPrelude :: FilePath -> Term [FilePath]

126inputFilesAndPrelude :: FilePath -> Term [FilePath]

126inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles

127inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles

@@ -129,7 +130,7 @@ inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles

129 combine False input = input

130 combine False input = input

130

131

131term :: FilePath -> Term (IO ())

132term :: FilePath -> Term (IO ())

132−term prelude = compile <$> options <*> inputFilesAndPrelude prelude

133+term prelude = compile <$> outputDirectory <*> options <*> inputFilesAndPrelude prelude

133

134

134termInfo :: TermInfo

135termInfo :: TermInfo

135termInfo = defTI

136termInfo = defTI

psc/Main.hs+2−1

@@ -127,7 +127,7 @@ verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])

127 { optDoc = "Display verbose error messages" }

128

129options :: Term P.Options

130−options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules <*> codeGenModules <*> verboseErrors

130+options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> runMain <*> noOpts <*> (Just <$> browserNamespace) <*> dceModules <*> codeGenModules <*> verboseErrors

131

132stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])

133stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles

@@ -150,3 +150,4 @@ main :: IO ()

150main = do

151 prelude <- preludeFilename

152 run (term prelude, termInfo)

153+

psci/Main.hs+101−47

@@ -13,7 +13,7 @@

13--

14-----------------------------------------------------------------------------

16−{-# LANGUAGE DoAndIfThenElse, FlexibleContexts #-}

16+{-# LANGUAGE DoAndIfThenElse, FlexibleContexts, GeneralizedNewtypeDeriving #-}

18module Main where

@@ -24,29 +24,36 @@ import Control.Monad

24import Control.Monad.Trans.Class

25import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

26import Control.Monad.Trans.State.Strict

27+import Control.Monad.Error (ErrorT(..), MonadError)

28+import Control.Monad.Error.Class (MonadError(..))

28import Data.List (intercalate, isPrefixOf, nub, sortBy)

30import Data.List (intercalate, isPrefixOf, nub, sortBy)

29import Data.Maybe (mapMaybe)

31import Data.Maybe (mapMaybe)

30import Data.Foldable (traverse_)

32import Data.Foldable (traverse_)

31−import Data.Traversable (traverse)

32import Data.Version (showVersion)

33import Data.Version (showVersion)

34+import Data.Traversable (traverse)

34import Parser

36import Parser

38+import System.IO.Error (tryIOError)

36import System.Console.Haskeline

39import System.Console.Haskeline

40+import System.Directory

41+ (createDirectoryIfMissing, getModificationTime, doesFileExist,

37−import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)

42+ findExecutable, getHomeDirectory, getCurrentDirectory)

43+import System.Process (readProcessWithExitCode)

38import System.Exit

44import System.Exit

39import System.Environment.XDG.BaseDir

45import System.Environment.XDG.BaseDir

40−import System.FilePath ((</>), isPathSeparator)

46+import System.FilePath

47+ (pathSeparator, takeDirectory, (</>), isPathSeparator)

41import qualified System.Console.CmdTheLine as Cmd

48import qualified System.Console.CmdTheLine as Cmd

42−import System.Process

44import Text.Parsec (ParseError)

50import Text.Parsec (ParseError)

46import qualified Data.Map as M

52import qualified Data.Map as M

47import qualified Language.PureScript as P

53import qualified Language.PureScript as P

48import qualified Paths_purescript as Paths

54import qualified Paths_purescript as Paths

49−import qualified System.IO.UTF8 as U (print, readFile)

55+import qualified System.IO.UTF8 as U

56+ (writeFile, putStrLn, print, readFile)

51-- |

58-- |

52-- The PSCI state.

59-- The PSCI state.

@@ -57,7 +64,7 @@ import qualified System.IO.UTF8 as U (print, readFile)

57data PSCiState = PSCiState

64data PSCiState = PSCiState

58 { psciImportedFilenames :: [FilePath]

65 { psciImportedFilenames :: [FilePath]

59 , psciImportedModuleNames :: [P.ModuleName]

66 , psciImportedModuleNames :: [P.ModuleName]

60− , psciLoadedModules :: [P.Module]

67+ , psciLoadedModules :: [(FilePath, P.Module)]

61 , psciLetBindings :: [P.Value -> P.Value]

68 , psciLetBindings :: [P.Value -> P.Value]

62 }

69 }

@@ -78,7 +85,7 @@ updateImports name st = st { psciImportedModuleNames = name : psciImportedModule

78-- |

85-- |

79-- Updates the state to have more loaded files.

86-- Updates the state to have more loaded files.

80--

87--

81−updateModules :: [P.Module] -> PSCiState -> PSCiState

88+updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState

82updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }

89updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }

84-- |

91-- |

@@ -168,7 +175,7 @@ completion = completeWord Nothing " \t\n\r" findCompletions

168 where

175 where

169 findCompletions :: String -> StateT PSCiState IO [Completion]

176 findCompletions :: String -> StateT PSCiState IO [Completion]

170 findCompletions str = do

177 findCompletions str = do

171− ms <- psciLoadedModules <$> get

178+ ms <- map snd . psciLoadedModules <$> get

172 files <- listFiles str

179 files <- listFiles str

173 let matches = filter (isPrefixOf str) (names ms)

180 let matches = filter (isPrefixOf str) (names ms)

174 return $ sortBy sorter $ map simpleCompletion matches ++ files

181 return $ sortBy sorter $ map simpleCompletion matches ++ files

@@ -197,7 +204,39 @@ completion = completeWord Nothing " \t\n\r" findCompletions

197-- | Compilation options.

204-- | Compilation options.

198--

205--

199options :: P.Options

206options :: P.Options

200−options = P.Options False True False True (Just "Main") True "PS" [] [] False

207+options = P.Options False True False True Nothing True (Just "PS") [] [] False

208+

209+-- |

210+-- PSCI monad

211+--

212+newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)

213+

214+psciIO :: IO a -> PSCI a

215+psciIO io = PSCI (lift (lift io))

216+

217+newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadError String)

218+

219+runMake :: Make a -> IO (Either String a)

220+runMake = runErrorT . unMake

221+

222+makeIO :: IO a -> Make a

223+makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError

224+

225+instance P.MonadMake Make where

226+ getTimestamp path = makeIO $ do

227+ exists <- doesFileExist path

228+ case exists of

229+ True -> Just <$> getModificationTime path

230+ False -> return Nothing

231+ readTextFile path = makeIO $ U.readFile path

232+ writeTextFile path text = makeIO $ do

233+ mkdirp path

234+ U.writeFile path text

235+ liftError = either throwError return

236+ progress s = unless (s == "Compiling Main") $ makeIO . U.putStrLn $ s

237+

238+mkdirp :: FilePath -> IO ()

239+mkdirp = createDirectoryIfMissing True . takeDirectory

201

240

202-- |

241-- |

203-- Makes a volatile module to execute the current expression.

242-- Makes a volatile module to execute the current expression.

@@ -217,34 +256,45 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB

217 in

256 in

218 P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing

257 P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing

219

258

259+modulesDir :: FilePath

260+modulesDir = "psci_modules" ++ pathSeparator : "node_modules"

261+

262+indexFile :: FilePath

263+indexFile = "psci_modules" ++ pathSeparator : "index.js"

264+

220-- |

265-- |

221-- Takes a value declaration and evaluates it with the current state.

266-- Takes a value declaration and evaluates it with the current state.

222--

267--

223−handleDeclaration :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

268+handleDeclaration :: P.Value -> PSCI ()

224−handleDeclaration value st = do

269+handleDeclaration value = do

270+ st <- PSCI $ lift get

225 let m = createTemporaryModule True st value

271 let m = createTemporaryModule True st value

226− case P.compile options (psciLoadedModules st ++ [m]) of

272+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])

273+ case e of

227− Left err -> outputStrLn err

274+ Left err -> PSCI $ outputStrLn err

228− Right (js, _, _) -> do

275+ Right _ -> do

276+ psciIO $ writeFile indexFile $ "require('Main').main();"

229− process <- lift . lift $ findNodeProcess

277+ process <- psciIO findNodeProcess

230− result <- lift . lift $ traverse (\node -> readProcessWithExitCode node [] js) process

278+ result <- psciIO $ traverse (\node -> readProcessWithExitCode node [indexFile] "") process

231 case result of

279 case result of

232− Just (ExitSuccess, out, _) -> outputStrLn out

280+ Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out

233− Just (ExitFailure _, _, err) -> outputStrLn err

281+ Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err

234− Nothing -> outputStrLn "Couldn't find node.js"

282+ Nothing -> PSCI $ outputStrLn "Couldn't find node.js"

235

283

236-- |

284-- |

237-- Takes a value and prints its type

285-- Takes a value and prints its type

238--

286--

239−handleTypeOf :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

287+handleTypeOf :: P.Value -> PSCI ()

240−handleTypeOf value st = do

288+handleTypeOf value = do

289+ st <- PSCI $ lift get

241 let m = createTemporaryModule False st value

290 let m = createTemporaryModule False st value

242− case P.compile options { P.optionsMain = Nothing } (psciLoadedModules st ++ [m]) of

291+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])

292+ case e of

243− Left err -> outputStrLn err

293+ Left err -> PSCI $ outputStrLn err

244− Right (_, _, env') ->

294+ Right env' ->

245 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of

295 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of

246− Just (ty, _) -> outputStrLn . P.prettyPrintType $ ty

296+ Just (ty, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty

247− Nothing -> outputStrLn "Could not find type"

297+ Nothing -> PSCI $ outputStrLn "Could not find type"

248

298

249-- Commands

299-- Commands

250

300

@@ -265,27 +315,31 @@ getCommand = do

265-- |

315-- |

266-- Performs an action for each meta-command given, and also for expressions..

316-- Performs an action for each meta-command given, and also for expressions..

267--

317--

268−handleCommand :: Command -> InputT (StateT PSCiState IO) ()

318+handleCommand :: Command -> PSCI ()

269−handleCommand (Expression val) = lift get >>= handleDeclaration val

319+handleCommand (Expression val) = handleDeclaration val

270−handleCommand Help = outputStrLn helpMessage

320+handleCommand Help = PSCI $ outputStrLn helpMessage

271−handleCommand (Import moduleName) = lift $ modify (updateImports moduleName)

321+handleCommand (Import moduleName) = PSCI $ lift $ modify (updateImports moduleName)

272−handleCommand (Let l) = lift $ modify (updateLets l)

322+handleCommand (Let l) = PSCI $ lift $ modify (updateLets l)

273handleCommand (LoadFile filePath) = do

323handleCommand (LoadFile filePath) = do

274− absPath <- lift . lift $ expandTilde filePath

324+ absPath <- psciIO $ expandTilde filePath

275− exists <- lift . lift $ doesFileExist absPath

325+ exists <- psciIO $ doesFileExist absPath

276 if exists then do

326 if exists then do

277− lift $ modify (updateImportedFiles absPath)

327+ PSCI . lift $ modify (updateImportedFiles absPath)

278− either outputStrLn (lift . modify . updateModules) =<< (lift . lift $ loadModule absPath)

328+ m <- psciIO $ loadModule absPath

329+ case m of

330+ Left err -> PSCI $ outputStrLn err

331+ Right mods -> PSCI . lift $ modify (updateModules (map ((,) absPath) mods))

279 else

332 else

280− outputStrLn $ "Couldn't locate: " ++ filePath

333+ PSCI . outputStrLn $ "Couldn't locate: " ++ filePath

281handleCommand Reset = do

334handleCommand Reset = do

282− files <- psciImportedFilenames <$> lift get

335+ files <- psciImportedFilenames <$> PSCI (lift get)

336+ filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . psciIO . loadModule $ file) files

283− modulesOrFirstError <- fmap concat . sequence <$> mapM (lift . lift . loadModule) files

337+ let modulesOrFirstError = fmap concat $ sequence filesAndModules

284 case modulesOrFirstError of

338 case modulesOrFirstError of

285− Left err -> lift . lift $ putStrLn err >> exitFailure

339+ Left err -> psciIO $ putStrLn err >> exitFailure

286− Right modules -> lift $ put (PSCiState files defaultImports modules [])

340+ Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])

287−handleCommand (TypeOf val) = lift get >>= handleTypeOf val

341+handleCommand (TypeOf val) = handleTypeOf val

288−handleCommand _ = outputStrLn "Unknown command"

342+handleCommand _ = PSCI $ outputStrLn "Unknown command"

289

343

290inputFiles :: Cmd.Term [FilePath]

344inputFiles :: Cmd.Term [FilePath]

291inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posName = "file(s)"

345inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posName = "file(s)"

@@ -311,7 +365,8 @@ loop :: [FilePath] -> IO ()

311loop files = do

365loop files = do

312 config <- loadUserConfig

366 config <- loadUserConfig

313 preludeFilename <- getPreludeFilename

367 preludeFilename <- getPreludeFilename

314− modulesOrFirstError <- fmap concat . sequence <$> mapM loadModule (preludeFilename : files)

368+ filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . loadModule $ file) (preludeFilename : files)

369+ let modulesOrFirstError = fmap concat $ sequence filesAndModules

315 case modulesOrFirstError of

370 case modulesOrFirstError of

316 Left err -> putStrLn err >> exitFailure

371 Left err -> putStrLn err >> exitFailure

317 Right modules -> do

372 Right modules -> do

@@ -319,7 +374,7 @@ loop files = do

319 let settings = defaultSettings {historyFile = Just historyFilename}

374 let settings = defaultSettings {historyFile = Just historyFilename}

320 flip evalStateT (PSCiState (preludeFilename : files) defaultImports modules []) . runInputT (setComplete completion settings) $ do

375 flip evalStateT (PSCiState (preludeFilename : files) defaultImports modules []) . runInputT (setComplete completion settings) $ do

321 outputStrLn prologueMessage

376 outputStrLn prologueMessage

322− traverse_ (mapM_ handleCommand) config

377+ traverse_ (mapM_ (runPSCI . handleCommand)) config

323 go

378 go

324 where

379 where

325 go :: InputT (StateT PSCiState IO) ()

380 go :: InputT (StateT PSCiState IO) ()

@@ -329,7 +384,7 @@ loop files = do

329 Left err -> outputStrLn (show err) >> go

384 Left err -> outputStrLn (show err) >> go

330 Right Nothing -> go

385 Right Nothing -> go

331 Right (Just Quit) -> outputStrLn quitMessage

386 Right (Just Quit) -> outputStrLn quitMessage

332− Right (Just c') -> handleCommand c' >> go

387+ Right (Just c') -> runPSCI (handleCommand c') >> go

333

388

334term :: Cmd.Term (IO ())

389term :: Cmd.Term (IO ())

335term = loop <$> inputFiles

390term = loop <$> inputFiles

@@ -343,4 +398,3 @@ termInfo = Cmd.defTI

343

398

344main :: IO ()

399main :: IO ()

345main = Cmd.run (term, termInfo)

400main = Cmd.run (term, termInfo)

346−

src/Language/PureScript.hs+31−28

@@ -37,7 +37,7 @@ import Data.List (find, sortBy, groupBy, intercalate)

37import Data.Time.Clock

38import Data.Function (on)

39import Data.Generics (mkQ, everything)

40−import Data.Maybe (fromMaybe)

40+import Data.Maybe (fromJust, fromMaybe)

41import Control.Monad.Error

42import Control.Monad.State.Lazy

43import Control.Arrow ((&&&))

@@ -78,7 +78,7 @@ compile' env opts ms = do

78 let elim = if null entryPoints then regrouped else eliminateDeadCode entryPoints regrouped

79 let codeGenModules = moduleNameFromString `map` optionsCodeGenModules opts

80 let modulesToCodeGen = if null codeGenModules then elim else filter (\(Module mn _ _) -> mn `elem` codeGenModules) elim

81− let js = JSVariableIntroduction (optionsBrowserNamespace opts) (Just (JSObjectLiteral []))

81+ let js = JSVariableIntroduction (fromJust (optionsBrowserNamespace opts)) (Just (JSObjectLiteral []))

82 : concatMap (\m -> moduleToJs Globals opts m env') modulesToCodeGen

83 let exts = intercalate "\n" . map (`moduleToPs` env') $ modulesToCodeGen

84 js' <- generateMain env' opts js

@@ -156,6 +156,10 @@ class MonadMake m where

156 --

157 liftError :: Either String a -> m a

158

159+ -- |

160+ -- Respond to a progress update

161+ --

162+ progress :: String -> m ()

159

163

160-- |

164-- |

161-- Compiles in "make" mode, compiling each module separately to a js files and an externs file

165-- Compiles in "make" mode, compiling each module separately to a js files and an externs file

@@ -163,17 +167,17 @@ class MonadMake m where

163-- If timestamps have not changed, the externs file can be used to provide the module's types without

167-- If timestamps have not changed, the externs file can be used to provide the module's types without

164-- having to typecheck the module again.

168-- having to typecheck the module again.

165--

169--

166−make :: (Functor m, Monad m, MonadMake m) => Options -> [(FilePath, Module)] -> m ()

170+make :: (Functor m, Monad m, MonadMake m) => FilePath -> Options -> [(FilePath, Module)] -> m Environment

167−make opts ms = do

171+make outputDir opts ms = do

168 let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)

172 let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)

169

173

170 (sorted, graph) <- liftError $ sortModules $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)

174 (sorted, graph) <- liftError $ sortModules $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)

171

175

172 toRebuild <- foldM (\s (Module moduleName' _ _) -> do

176 toRebuild <- foldM (\s (Module moduleName' _ _) -> do

173− let filePath = toFileName moduleName'

177+ let filePath = runModuleName moduleName'

174

178

175− jsFile = "js" ++ pathSeparator : filePath ++ ".js"

179+ jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"

176− externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"

180+ externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"

177 inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap

181 inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap

178

182

179 jsTimestamp <- getTimestamp jsFile

183 jsTimestamp <- getTimestamp jsFile

@@ -191,16 +195,18 @@ make opts ms = do

191 go initEnvironment desugared

195 go initEnvironment desugared

192

196

193 where

197 where

194− go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m ()

198+ go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m Environment

195− go _ [] = return ()

199+ go env [] = return env

196 go env ((False, m) : ms') = do

200 go env ((False, m) : ms') = do

197 (_, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m

201 (_, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m

198

202

199 go env' ms'

203 go env' ms'

200 go env ((True, m@(Module moduleName' _ exps)) : ms') = do

204 go env ((True, m@(Module moduleName' _ exps)) : ms') = do

201− let filePath = toFileName moduleName'

205+ let filePath = runModuleName moduleName'

202− jsFile = "js" ++ pathSeparator : filePath ++ ".js"

206+ jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"

203− externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"

207+ externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"

208+

209+ progress $ "Compiling " ++ runModuleName moduleName'

204

210

205 (Module _ elaborated _, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m

211 (Module _ elaborated _, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m

206

212

@@ -215,22 +221,19 @@ make opts ms = do

215

221

216 go env' ms'

222 go env' ms'

217

223

218−toFileName :: ModuleName -> FilePath

219−toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps

220−

221−rebuildIfNecessary :: (Functor m, Monad m, MonadMake m) => M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

224+ rebuildIfNecessary :: (Functor m, Monad m, MonadMake m) => M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

222−rebuildIfNecessary _ _ [] = return []

225+ rebuildIfNecessary _ _ [] = return []

223−rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms) | moduleName' `S.member` toRebuild = do

226+ rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do

224− let deps = fromMaybe [] $ moduleName' `M.lookup` graph

227+ let deps = fromMaybe [] $ moduleName' `M.lookup` graph

225− toRebuild' = toRebuild `S.union` S.fromList deps

228+ toRebuild' = toRebuild `S.union` S.fromList deps

226− (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms

229+ (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'

227−rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms) = do

230+ rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do

228− let externsFile = "externs" ++ pathSeparator : toFileName moduleName' ++ ".externs"

231+ let externsFile = outputDir ++ pathSeparator : runModuleName moduleName' ++ pathSeparator : "externs.purs"

229− externs <- readTextFile externsFile

232+ externs <- readTextFile externsFile

230− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs

233+ externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs

231− case externsModules of

234+ case externsModules of

232− [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms

235+ [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'

233− _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"

236+ _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"

234

237

235reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]

238reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]

236reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

239reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

src/Language/PureScript/CodeGen/JS.hs+3−3

@@ -23,7 +23,7 @@ module Language.PureScript.CodeGen.JS (

23 isIdent

24) where

26−import Data.Maybe (fromMaybe, mapMaybe)

26+import Data.Maybe (fromJust, fromMaybe, mapMaybe)

27import Data.Function (on)

28import Data.List (nub, (\\))

29import Data.Generics (mkQ, everything)

@@ -57,7 +57,7 @@ moduleToJs :: ModuleType -> Options -> Module -> Environment -> [JS]

57moduleToJs mt opts (Module name decls (Just exps)) env = case mt of

58 CommonJS -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) moduleExports]

59 Globals ->

60− [ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar (optionsBrowserNamespace opts))) (

60+ [ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar (fromJust (optionsBrowserNamespace opts)))) (

61 JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn moduleExports]))) []

62 )

63 ]

@@ -73,7 +73,7 @@ importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleB

73 where

74 moduleBody = case mt of

75 CommonJS -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]

76− Globals -> JSAccessor (runModuleName mn) (JSVar (optionsBrowserNamespace opts))

76+ Globals -> JSAccessor (runModuleName mn) (JSVar (fromJust (optionsBrowserNamespace opts)))

78imports :: Declaration -> [ModuleName]

79imports = everything (++) (mkQ [] collect)

src/Language/PureScript/Options.hs+2−2

@@ -48,7 +48,7 @@ data Options = Options {

48 -- Specify the namespace that PureScript modules will be exported to when running in the

49 -- browser.

50 --

51− , optionsBrowserNamespace :: String

51+ , optionsBrowserNamespace :: Maybe String

52 -- |

53 -- The modules to keep while enabling dead code elimination

54 --

@@ -67,4 +67,4 @@ data Options = Options {

67-- Default compiler options

68--

69defaultOptions :: Options

70−defaultOptions = Options False False False False Nothing False "PS" [] [] False

70+defaultOptions = Options False False False False Nothing False Nothing [] [] False