git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix issue with desugar in make mode
4a8c0dcPhil Freeman
src/Language/PureScript.hs+48−37
compare with golang
unifiedsplit
@@ -119,54 +119,65 @@ class MonadMake m where
119-- If timestamps have not changed, the externs file can be used to provide the module's types without
119-- If timestamps have not changed, the externs file can be used to provide the module's types without
120-- having to typecheck the module again.
120-- having to typecheck the module again.
121--
121--
122−make :: (Monad m, MonadMake m) => Options -> [(FilePath, Module)] -> m ()
122+make :: (Functor m, Monad m, MonadMake m) => Options -> [(FilePath, Module)] -> m ()
123make opts ms = do
123make opts ms = do
124 let filePathMap = M.fromList (map (\(fp, (Module mn _ _)) -> (mn, fp)) ms)
124 let filePathMap = M.fromList (map (\(fp, (Module mn _ _)) -> (mn, fp)) ms)
125
125
126− desugared <- liftError $ do
127− sorted <- sortModules (map snd ms)
126+ sorted <- liftError $ sortModules (map snd ms)
128− desugar sorted
129− go initEnvironment filePathMap desugared
130
127
131− where
132− go :: (Monad m, MonadMake m) => Environment -> M.Map ModuleName FilePath -> [Module] -> m ()
133− go _ _ [] = return ()
134− go env filePathMap (Module moduleName' decls exps : ms') = do
128+ marked <- forM sorted $ \m@(Module moduleName' _ _) -> do
135 let filePath = toFileName moduleName'
129 let filePath = toFileName moduleName'
130+
136− let jsFile = "js" ++ pathSeparator : filePath ++ ".js"
131+ jsFile = "js" ++ pathSeparator : filePath ++ ".js"
137 externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"
132 externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"
133+ inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap
138
134
139 jsTimestamp <- getTimestamp jsFile
135 jsTimestamp <- getTimestamp jsFile
140 externsTimestamp <- getTimestamp externsFile
136 externsTimestamp <- getTimestamp externsFile
141−
142− let inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap
143 inputTimestamp <- getTimestamp inputFile
137 inputTimestamp <- getTimestamp inputFile
144
138
145− env' <- case () of
146− _ | inputTimestamp < min jsTimestamp externsTimestamp -> do
139+ case inputTimestamp < min jsTimestamp externsTimestamp of
140+ True -> do
147− externs <- readTextFile externsFile
141+ externs <- readTextFile externsFile
148− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
142+ externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
149− case externsModules of
143+ case externsModules of
150− [m@(Module moduleName'' _ _)] | moduleName' == moduleName'' -> do
144+ [m'@(Module moduleName'' _ _)] | moduleName' == moduleName'' -> return (True, m')
151− [Module _ typings _] <- liftError $ desugar [m]
152− (_, env') <- liftError . runCheck' env $ do
153− modify (\s -> s { checkCurrentModule = Just moduleName' })
154− typeCheckAll Nothing moduleName' typings
155− return env'
156− _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"
145+ _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"
157− | otherwise -> do
146+ False -> return (False, m)
147+
148+ desugared <- liftError $ zip (map fst marked) <$> desugar (map snd marked)
149+
150+ go initEnvironment desugared
151+
152+ where
153+ go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m ()
154+ go _ [] = return ()
155+ go env ((True, Module moduleName' typings _) : ms') = do
156+ (_, env') <- liftError . runCheck' env $ do
157+ modify (\s -> s { checkCurrentModule = Just moduleName' })
158+ typeCheckAll Nothing moduleName' typings
159+
160+ go env' ms'
161+ go env ((False, Module moduleName' decls exps) : ms') = do
162+ let filePath = toFileName moduleName'
163+ jsFile = "js" ++ pathSeparator : filePath ++ ".js"
164+ externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"
165+
158− (elaborated, env') <- liftError . runCheck' env $ do
166+ (elaborated, env') <- liftError . runCheck' env $ do
159− modify (\s -> s { checkCurrentModule = Just moduleName' })
167+ modify (\s -> s { checkCurrentModule = Just moduleName' })
160− typeCheckAll Nothing moduleName' decls
168+ typeCheckAll Nothing moduleName' decls
169+
161− regrouped <- liftError . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
170+ regrouped <- liftError . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
171+
162− let mod' = Module moduleName' regrouped exps
172+ let mod' = Module moduleName' regrouped exps
163− js = moduleToJs opts mod' env'
173+ js = moduleToJs opts mod' env'
164− exts = moduleToPs mod' env'
174+ exts = moduleToPs mod' env'
165− js' = maybe "" (prettyPrintJS . return . wrapExportsContainer opts . return) js
175+ js' = maybe "" (prettyPrintJS . return . wrapExportsContainer opts . return) js
176+
166− writeTextFile jsFile js'
177+ writeTextFile jsFile js'
167− writeTextFile externsFile exts
178+ writeTextFile externsFile exts
168− return env'
179+
169− go env' filePathMap ms'
180+ go env' ms'
170
181
171 toFileName :: ModuleName -> FilePath
182 toFileName :: ModuleName -> FilePath
172 toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps
183 toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps