git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Minor tweak to MakeActions
7362c4aPhil Freeman
src/Language/PureScript/Make.hs+10−17
compare with golang
unifiedsplit
@@ -25,7 +25,6 @@ module Language.PureScript.Make
25 -- * Make API
25 -- * Make API
26 RebuildPolicy(..)
26 RebuildPolicy(..)
27 , MakeActions(..)
27 , MakeActions(..)
28− , SupplyVar()
29 , Externs()
28 , Externs()
30 , make
29 , make
31
30
@@ -43,7 +42,6 @@ import Control.Monad.Trans.Except
43import Control.Monad.Reader
42import Control.Monad.Reader
44import Control.Monad.Writer
43import Control.Monad.Writer
45import Control.Monad.Supply
44import Control.Monad.Supply
46−import Control.Monad.Supply.Class (fresh)
47
45
48import Data.Function (on)
46import Data.Function (on)
49import Data.List (sortBy, groupBy)
47import Data.List (sortBy, groupBy)
@@ -102,7 +100,7 @@ data MakeActions m = MakeActions {
102 -- |
100 -- |
103 -- Run the code generator for the module and write any required output files.
101 -- Run the code generator for the module and write any required output files.
104 --
102 --
105− , codegen :: CF.Module CF.Ann -> Environment -> SupplyVar -> Externs -> m ()
103+ , codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT m ()
106 -- |
104 -- |
107 -- Respond to a progress update.
105 -- Respond to a progress update.
108 --
106 --
@@ -114,11 +112,6 @@ data MakeActions m = MakeActions {
114--
112--
115type Externs = String
113type Externs = String
116
114
117−-- |
118−-- A value to be used in the Supply monad.
119−--
120−type SupplyVar = Integer
121−
122-- |
115-- |
123-- Determines when to rebuild a module
116-- Determines when to rebuild a module
124--
117--
@@ -168,8 +161,7 @@ make MakeActions{..} ms = do
168 corefn = CF.moduleToCoreFn env' mod'
161 corefn = CF.moduleToCoreFn env' mod'
169 [renamed] = renameInModules [corefn]
162 [renamed] = renameInModules [corefn]
170 exts = moduleToPs mod' env'
163 exts = moduleToPs mod' env'
171− nextVar <- fresh
172− lift $ codegen renamed env' nextVar exts
164+ codegen renamed env' exts
173 go env' ms'
165 go env' ms'
174
166
175 rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]
167 rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]
@@ -264,8 +256,8 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
264 let path = outputDir </> runModuleName mn </> "externs.purs"
256 let path = outputDir </> runModuleName mn </> "externs.purs"
265 (path, ) <$> readTextFile path
257 (path, ) <$> readTextFile path
266
258
267− codegen :: CF.Module CF.Ann -> Environment -> SupplyVar -> Externs -> Make ()
259+ codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT Make ()
268− codegen m _ nextVar exts = do
260+ codegen m _ exts = do
269 let mn = CF.moduleName m
261 let mn = CF.moduleName m
270 foreignInclude <- case mn `M.lookup` foreigns of
262 foreignInclude <- case mn `M.lookup` foreigns of
271 Just (path, _)
263 Just (path, _)
@@ -275,7 +267,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
275 | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
267 | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
276 Nothing | requiresForeign m -> throwError . errorMessage $ MissingFFIModule mn
268 Nothing | requiresForeign m -> throwError . errorMessage $ MissingFFIModule mn
277 | otherwise -> return Nothing
269 | otherwise -> return Nothing
278− pjs <- evalSupplyT nextVar $ prettyPrintJS <$> J.moduleToJs m foreignInclude
270+ pjs <- prettyPrintJS <$> J.moduleToJs m foreignInclude
279 let filePath = runModuleName mn
271 let filePath = runModuleName mn
280 jsFile = outputDir </> filePath </> "index.js"
272 jsFile = outputDir </> filePath </> "index.js"
281 externsFile = outputDir </> filePath </> "externs.purs"
273 externsFile = outputDir </> filePath </> "externs.purs"
@@ -283,10 +275,11 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
283 prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
275 prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
284 js = unlines $ map ("// " ++) prefix ++ [pjs]
276 js = unlines $ map ("// " ++) prefix ++ [pjs]
285 verboseErrorsEnabled <- asks optionsVerboseErrors
277 verboseErrorsEnabled <- asks optionsVerboseErrors
278+ lift $ do
286− when verboseErrorsEnabled $ progress $ "Writing " ++ jsFile
279+ when verboseErrorsEnabled $ progress $ "Writing " ++ jsFile
287− writeTextFile jsFile js
280+ writeTextFile jsFile js
288− maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns
281+ maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns
289− writeTextFile externsFile exts
282+ writeTextFile externsFile exts
290
283
291 requiresForeign :: CF.Module a -> Bool
284 requiresForeign :: CF.Module a -> Bool
292 requiresForeign = not . null . CF.moduleForeign
285 requiresForeign = not . null . CF.moduleForeign