@@ -119,54 +119,65 @@ class MonadMake m where
119119-- If timestamps have not changed, the externs file can be used to provide the module's types without
120120-- having to typecheck the module again.
121121--
122−make :: (Monad m, MonadMake m) => Options -> [(FilePath, Module)] -> m ()
122+make :: (Functor m, Monad m, MonadMake m) => Options -> [(FilePath, Module)] -> m ()
123123make opts ms = do
124124 let filePathMap = M.fromList (map (\(fp, (Module mn _ _)) -> (mn, fp)) ms)
125125
126− desugared <- liftError $ do
127− sorted <- sortModules (map snd ms)
128− desugar sorted
129− go initEnvironment filePathMap desugared
126+ sorted <- liftError $ sortModules (map snd ms)
130127
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
135129 let filePath = toFileName moduleName'
136− let jsFile = "js" ++ pathSeparator : filePath ++ ".js"
130+
131+ jsFile = "js" ++ pathSeparator : filePath ++ ".js"
137132 externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"
133+ inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap
138134
139135 jsTimestamp <- getTimestamp jsFile
140136 externsTimestamp <- getTimestamp externsFile
141−
142− let inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap
143137 inputTimestamp <- getTimestamp inputFile
144138
145− env' <- case () of
146− _ | inputTimestamp < min jsTimestamp externsTimestamp -> do
147− externs <- readTextFile externsFile
148− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
149− case externsModules of
150− [m@(Module moduleName'' _ _)] | moduleName' == moduleName'' -> do
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"
157− | otherwise -> do
158− (elaborated, env') <- liftError . runCheck' env $ do
159− modify (\s -> s { checkCurrentModule = Just moduleName' })
160− typeCheckAll Nothing moduleName' decls
161− regrouped <- liftError . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
162− let mod' = Module moduleName' regrouped exps
163− js = moduleToJs opts mod' env'
164− exts = moduleToPs mod' env'
165− js' = maybe "" (prettyPrintJS . return . wrapExportsContainer opts . return) js
166− writeTextFile jsFile js'
167− writeTextFile externsFile exts
168− return env'
169− go env' filePathMap ms'
139+ case inputTimestamp < min jsTimestamp externsTimestamp of
140+ True -> do
141+ externs <- readTextFile externsFile
142+ externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
143+ case externsModules of
144+ [m'@(Module moduleName'' _ _)] | moduleName' == moduleName'' -> return (True, m')
145+ _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"
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+
166+ (elaborated, env') <- liftError . runCheck' env $ do
167+ modify (\s -> s { checkCurrentModule = Just moduleName' })
168+ typeCheckAll Nothing moduleName' decls
169+
170+ regrouped <- liftError . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
171+
172+ let mod' = Module moduleName' regrouped exps
173+ js = moduleToJs opts mod' env'
174+ exts = moduleToPs mod' env'
175+ js' = maybe "" (prettyPrintJS . return . wrapExportsContainer opts . return) js
176+
177+ writeTextFile jsFile js'
178+ writeTextFile externsFile exts
179+
180+ go env' ms'
170181
171182 toFileName :: ModuleName -> FilePath
172183 toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps