328eea1 · rowtype-yoga/purescript-native

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

on golang help sign in

More minor tidying

328eea1Phil Freeman11 years ago

src/Language/PureScript/Make.hs+14−6

compare with golang

unifiedsplit

@@ -24,6 +24,7 @@ module Language.PureScript.Make

24 (

25 -- * Make API

26 RebuildPolicy(..)

27+ , ProgressMessage(..), renderProgressMessage

27 , MakeActions(..)

28 , MakeActions(..)

28 , Externs()

29 , Externs()

29 , make

30 , make

@@ -77,6 +78,15 @@ import qualified Language.PureScript.CodeGen.JS as J

77import qualified Language.PureScript.CoreFn as CF

78import qualified Language.PureScript.CoreFn as CF

78import qualified Paths_purescript as Paths

79import qualified Paths_purescript as Paths

81+-- | Progress messages from the make process

82+data ProgressMessage

83+ = CompilingModule ModuleName

84+ deriving (Show, Eq, Ord)

85+

86+-- | Render a progress message

87+renderProgressMessage :: ProgressMessage -> String

88+renderProgressMessage (CompilingModule mn) = "Compiling " ++ runModuleName mn

89+

80-- | Actions that require implementations when running in "make" mode.

90-- | Actions that require implementations when running in "make" mode.

81--

91--

82-- This type exists to make two things abstract:

92-- This type exists to make two things abstract:

@@ -109,7 +119,7 @@ data MakeActions m = MakeActions {

109 -- |

119 -- |

110 -- Respond to a progress update.

120 -- Respond to a progress update.

111 --

121 --

112− , progress :: String -> m ()

122+ , progress :: ProgressMessage -> m ()

113 }

123 }

114

124

115-- |

125-- |

@@ -158,7 +168,7 @@ make MakeActions{..} ms = do

158 (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m

168 (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m

159 go env' ms'

169 go env' ms'

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

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

161− lift $ progress $ "Compiling " ++ runModuleName moduleName'

171+ lift . progress $ CompilingModule moduleName'

162 (checked@(Module _ _ elaborated _), env') <- lift . runCheck' env $ typeCheckModule Nothing m

172 (checked@(Module _ _ elaborated _), env') <- lift . runCheck' env $ typeCheckModule Nothing m

163 checkExhaustiveModule env' checked

173 checkExhaustiveModule env' checked

164 regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated

174 regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated

@@ -279,9 +289,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

279 foreignFile = outputDir </> filePath </> "foreign.js"

289 foreignFile = outputDir </> filePath </> "foreign.js"

280 prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]

290 prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]

281 js = unlines $ map ("// " ++) prefix ++ [pjs]

291 js = unlines $ map ("// " ++) prefix ++ [pjs]

282− verboseErrorsEnabled <- asks optionsVerboseErrors

283 lift $ do

292 lift $ do

284− when verboseErrorsEnabled $ progress $ "Writing " ++ jsFile

285 writeTextFile jsFile js

293 writeTextFile jsFile js

286 maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns

294 maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns

287 writeTextFile externsFile exts

295 writeTextFile externsFile exts

@@ -305,5 +313,5 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

305 mkdirp :: FilePath -> IO ()

313 mkdirp :: FilePath -> IO ()

306 mkdirp = createDirectoryIfMissing True . takeDirectory

314 mkdirp = createDirectoryIfMissing True . takeDirectory

307

315

308− progress :: String -> Make ()

316+ progress :: ProgressMessage -> Make ()

309− progress = liftIO . putStrLn

317+ progress = liftIO . putStrLn . renderProgressMessage

tests/Main.hs+9−8

@@ -96,22 +96,23 @@ makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readEx

96 let filePath = modulesDir </> P.runModuleName mn </> "externs.purs"

97 (filePath, ) <$> readTextFile filePath

99− codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Test ()

99+ codegen :: CF.Module CF.Ann -> P.Environment -> P.Externs -> P.SupplyT Test ()

100− codegen m _ nextVar exts = do

100+ codegen m _ exts = do

101 let mn = CF.moduleName m

102 foreignInclude <- case (CF.moduleName m `M.lookup` foreigns, CF.moduleForeign m) of

103 (Just _, []) -> error "Unnecessary foreign module"

104 (Just path, _) -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]

105 (Nothing, []) -> return Nothing

106 (Nothing, _) -> error "Missing foreign module"

107− pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude

107+ pjs <- P.prettyPrintJS <$> J.moduleToJs m foreignInclude

108 let filePath = P.runModuleName $ CF.moduleName m

109 jsFile = modulesDir </> filePath </> "index.js"

110 externsFile = modulesDir </> filePath </> "externs.purs"

111 foreignFile = modulesDir </> filePath </> "foreign.js"

112+ lift $ do

112− writeTextFile jsFile pjs

113+ writeTextFile jsFile pjs

113− maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns

114+ maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns

114− writeTextFile externsFile exts

115+ writeTextFile externsFile exts

115

116

116 readTextFile :: FilePath -> Test String

117 readTextFile :: FilePath -> Test String

117 readTextFile path = liftIO $ readFile path

118 readTextFile path = liftIO $ readFile path

@@ -121,8 +122,8 @@ makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readEx

121 createDirectoryIfMissing True (takeDirectory path)

122 createDirectoryIfMissing True (takeDirectory path)

122 writeFile path text

123 writeFile path text

123

124

124− progress :: String -> Test ()

125+ progress :: P.ProgressMessage -> Test ()

125− progress = liftIO . putStrLn

126+ progress = liftIO . putStrLn . P.renderProgressMessage

126

127

127readInput :: [FilePath] -> IO [(FilePath, String)]

128readInput :: [FilePath] -> IO [(FilePath, String)]

128readInput inputFiles = forM inputFiles $ \inputFile -> do

129readInput inputFiles = forM inputFiles $ \inputFile -> do