@@ -14,6 +14,7 @@ module Build
1414import Control.Concurrent (forkIO)
1515import Control.Concurrent.MVar
1616import Control.Monad (filterM, mapM_, sequence_)
17+import qualified Data.ByteString as B
1718import qualified Data.Char as Char
1819import qualified Data.Either as Either
1920import qualified Data.Graph as Graph
@@ -187,9 +188,9 @@ type StatusDict =
187188
188189data Status
189190 = SCached Details.Local
190− | SChanged Details.Local Src.Module
191− | SNotFound Problem.Find
192− | SNotValid Problem.Syntax
191+ | SChanged Details.Local B.ByteString Src.Module
192+ | SBadImport Problem.Import
193+ | SBadSyntax Problem.Syntax
193194 | SForeign Pkg.Name
194195 | SKernel
195196
@@ -218,7 +219,7 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
218219 [path] ->
219220 case Map.lookup name foreigns of
220221 Just (Details.Foreign dep deps) ->
221− return $ SNotFound $ Problem.Ambiguous path [] dep deps
222+ return $ SBadImport $ Import.Ambiguous name path [] dep deps
222223
223224 Nothing ->
224225 case Map.lookup name locals of
@@ -235,7 +236,7 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
235236 else crawlDeps env mvar deps (SCached local)
236237
237238 p1:p2:ps ->
238− return $ SNotFound $ Problem.AmbiguousLocal p1 p2 ps
239+ return $ SBadImport $ Import.AmbiguousLocal name p1 p2 ps
239240
240241 [] ->
241242 case Map.lookup name foreigns of
@@ -245,22 +246,22 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
245246 return $ SForeign dep
246247
247248 d:ds ->
248− return $ SNotFound $ Problem.AmbiguousForeign dep d ds
249+ return $ SBadImport $ Import.AmbiguousForeign name dep d ds
249250
250251 Nothing ->
251252 if Name.isKernel name && Pkg.isKernel pkg then
252253 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
253− return $ if exists then SKernel else SNotFound Problem.NotFound
254+ return $ if exists then SKernel else SBadImport (Import.NotFound name)
254255 else
255− return $ SNotFound Problem.NotFound
256+ return $ SBadImport (Import.NotFound name)
256257
257258
258259crawlFile :: Env -> MVar StatusDict -> ModuleName.Raw -> FilePath -> IO Status
259260crawlFile env@(Env _ root pkg _ _ _) mvar expectedName path =
260261 do time <- File.getTime path
261− bytes <- File.readUtf8 (root </> path)
262+ source <- File.readUtf8 (root </> path)
262263
263− case Parse.fromByteString pkg bytes of
264+ case Parse.fromByteString pkg source of
264265 Right modul@(Src.Module maybeActualName _ imports values _ _ _ _) ->
265266 case maybeActualName of
266267 Just actualName ->
@@ -269,15 +270,15 @@ crawlFile env@(Env _ root pkg _ _ _) mvar expectedName path =
269270 deps = map Src.getImportName imports
270271 local = Details.Local path time deps (any isMain values)
271272 in
272− crawlDeps env mvar deps (SChanged local modul)
273+ crawlDeps env mvar deps (SChanged local source modul)
273274 else
274− return $ SNotValid $ Problem.BadModuleName_Mismatch expectedName actualName
275+ return $ SBadSyntax $ Problem.ModuleNameMismatch expectedName actualName
275276
276277 Nothing ->
277− return $ SNotValid $ Problem.BadModuleName_Unspecified expectedName
278+ return $ SBadSyntax $ Problem.ModuleNameUnspecified expectedName
278279
279280 Left syntaxError ->
280− return $ SNotValid $ Problem.SyntaxProblem path time syntaxError
281+ return $ SBadSyntax $ Problem.SyntaxProblem path time syntaxError
281282
282283
283284isMain :: A.Located Src.Value -> Bool
@@ -297,6 +298,7 @@ data Result
297298 = RNew Details.Local I.Interface Opt.LocalGraph
298299 | RSame Details.Local I.Interface Opt.LocalGraph
299300 | RCached Bool (MVar CachedInterface)
301+ | RNotFound Problem.Import
300302 | RProblem Problem.Problem
301303 | RBlocked
302304 | RForeign I.Interface
@@ -317,9 +319,9 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
317319 depsStatus <- checkDeps root results deps
318320 case depsStatus of
319321 DepsChange ifaces ->
320− do bytes <- File.readUtf8 path
321− case Parse.fromByteString pkg bytes of
322− Right modul -> compile env local ifaces modul
322+ do source <- File.readUtf8 path
323+ case Parse.fromByteString pkg source of
324+ Right modul -> compile env local source ifaces modul
323325 Left syntaxError ->
324326 return $ RProblem $ Problem.BadSyntax $
325327 Problem.SyntaxProblem path time syntaxError
@@ -331,12 +333,15 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
331333 DepsBlock ->
332334 return RBlocked
333335
334− SChanged local@(Details.Local _ _ deps _) modul ->
336+ DepsNotFound name1 problem1 others ->
337+ return (RProblem (Problem.BadImports name1 problem1 others))
338+
339+ SChanged local@(Details.Local _ _ deps _) source modul ->
335340 do results <- readMVar resultsMVar
336341 depsStatus <- checkDeps root results deps
337342 case depsStatus of
338343 DepsChange ifaces ->
339− compile env local ifaces modul
344+ compile env local source ifaces modul
340345
341346 DepsSame same cached ->
342347 do maybeLoaded <- checkCachedInterfaces root cached
@@ -346,15 +351,18 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
346351
347352 Just loaded ->
348353 do let ifaces = Map.union loaded (Map.fromList same)
349− compile env local ifaces modul
354+ compile env local source ifaces modul
350355
351356 DepsBlock ->
352357 return RBlocked
353358
354− SNotFound findProblem ->
355− return (RProblem (Problem.BadFind findProblem))
359+ DepsNotFound name1 problem1 others ->
360+ return (RProblem (Problem.BadImports name1 problem1 others))
361+
362+ SBadImport importProblem ->
363+ return (RNotFound importProblem)
356364
357− SNotValid syntaxProblem ->
365+ SBadSyntax syntaxProblem ->
358366 return (RProblem (Problem.BadSyntax syntaxProblem))
359367
360368 SForeign home ->
@@ -374,56 +382,54 @@ data DepsStatus
374382 = DepsChange (Map.Map ModuleName.Raw I.Interface)
375383 | DepsSame [Dep] [CDep]
376384 | DepsBlock
385+ | DepsNotFound ModuleName.Raw Problem.Import [(ModuleName.Raw, Problem.Import)]
377386
378387
379388checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus
380389checkDeps root results deps =
381− checkDepsHelp root results deps [] [] []
390+ checkDepsHelp root results deps [] [] [] [] False
382391
383392
384393type Dep = (ModuleName.Raw, I.Interface)
385394type CDep = (ModuleName.Raw, MVar CachedInterface)
386395
387396
388−checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> IO DepsStatus
389−checkDepsHelp root results deps new same cached =
397+checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw, Problem.Import)] -> Bool -> IO DepsStatus
398+checkDepsHelp root results deps new same cached badImports isBlocked =
390399 case deps of
391− [] ->
392− if null new
393− then return (DepsSame same cached)
394− else
395− do maybeLoaded <- checkCachedInterfaces root cached
396− case maybeLoaded of
397− Nothing ->
398− return DepsBlock
399−
400− Just loaded ->
401− return $ DepsChange $
402− Map.union loaded (Map.union (Map.fromList new) (Map.fromList same))
403−
404400 dep:otherDeps ->
405401 do result <- readMVar (results ! dep)
406402 case result of
407− RNew _ iface _ ->
408− checkDepsHelp root results otherDeps ((dep,iface) : new) same cached
409−
410− RSame _ iface _ ->
411− checkDepsHelp root results otherDeps new ((dep,iface) : same) cached
403+ RNew _ iface _ -> checkDepsHelp root results otherDeps ((dep,iface) : new) same cached badImports isBlocked
404+ RSame _ iface _ -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached badImports isBlocked
405+ RCached _ mvar -> checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) badImports isBlocked
406+ RNotFound prob -> checkDepsHelp root results otherDeps new same cached ((dep,prob) : badImports) True
407+ RProblem _ -> checkDepsHelp root results otherDeps new same cached badImports True
408+ RBlocked -> checkDepsHelp root results otherDeps new same cached badImports True
409+ RForeign iface -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached badImports isBlocked
410+ RKernel -> checkDepsHelp root results otherDeps new same cached badImports isBlocked
412411
413− RCached _ mvar ->
414− checkDepsHelp root results otherDeps new same ((dep,mvar) : cached)
412+ [] ->
413+ case badImports of
414+ (name, problem) : otherBadImports ->
415+ return $ DepsNotFound name problem otherBadImports
415416
416− RProblem _ ->
417− return DepsBlock
417+ [] ->
418+ if isBlocked then
419+ return $ DepsBlock
418420
419− RBlocked ->
420− return DepsBlock
421+ else if null new then
422+ return $ DepsSame same cached
421423
422− RForeign iface ->
423− checkDepsHelp root results otherDeps new ((dep,iface) : same) cached
424+ else
425+ do maybeLoaded <- checkCachedInterfaces root cached
426+ case maybeLoaded of
427+ Nothing ->
428+ return DepsBlock
424429
425− RKernel ->
426− checkDepsHelp root results otherDeps new same cached
430+ Just loaded ->
431+ return $ DepsChange $
432+ Map.union loaded (Map.union (Map.fromList new) (Map.fromList same))
427433
428434
429435
@@ -534,12 +540,12 @@ addToGraph name status graph =
534540 let
535541 dependencies =
536542 case status of
537− SCached (Details.Local _ _ deps _) -> deps
538− SChanged (Details.Local _ _ deps _) _ -> deps
539− SNotFound _ -> []
540− SNotValid _ -> []
541− SForeign _ -> []
542− SKernel -> []
543+ SCached (Details.Local _ _ deps _) -> deps
544+ SChanged (Details.Local _ _ deps _) _ _ -> deps
545+ SBadImport _ -> []
546+ SBadSyntax _ -> []
547+ SForeign _ -> []
548+ SKernel -> []
543549 in
544550 (name, name, dependencies) : graph
545551
@@ -567,9 +573,9 @@ checkUniqueMains insides smains =
567573mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
568574mainStatusToNamePathPair smain =
569575 case smain of
570− SInside _ -> Nothing
571− SOutsideOk (Details.Local path _ _ _) modul -> Just (Src.getName modul, OneOrMore.one path)
572− SOutsideErr _ -> Nothing
576+ SInside _ -> Nothing
577+ SOutsideOk (Details.Local path _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
578+ SOutsideErr _ -> Nothing
573579
574580
575581checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath
@@ -582,20 +588,20 @@ checkOutside name paths =
582588checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
583589checkInside name p1 status =
584590 case status of
585− SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
586− SChanged (Details.Local p2 _ _ _) _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
587− SNotFound _ -> Right ()
588− SNotValid _ -> Right ()
589− SForeign _ -> Right ()
590− SKernel -> Right ()
591+ SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
592+ SChanged (Details.Local p2 _ _ _) _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
593+ SBadImport _ -> Right ()
594+ SBadSyntax _ -> Right ()
595+ SForeign _ -> Right ()
596+ SKernel -> Right ()
591597
592598
593599
594600-- COMPILE MODULE
595601
596602
597−compile :: Env -> Details.Local -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
598−compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) ifaces modul =
603+compile :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
604+compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) source ifaces modul =
599605 case Compile.compile pkg ifaces modul of
600606 Right (Compile.Artifacts canonical annotations objects) ->
601607 do let name = Src.getName modul
@@ -618,7 +624,7 @@ compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) ifaces modu
618624 Left errors ->
619625 do Reporting.report key Reporting.BDone
620626 return $ RProblem $ Problem.BadContent $
621− Problem.Module (Src.getName modul) path time errors (Localizer.fromModule modul)
627+ Problem.Module (Src.getName modul) path time source errors (Localizer.fromModule modul)
622628
623629
624630
@@ -637,6 +643,7 @@ addNewLocal name result locals =
637643 RNew local _ _ -> Map.insert name local locals
638644 RSame local _ _ -> Map.insert name local locals
639645 RCached _ _ -> locals
646+ RNotFound _ -> locals
640647 RProblem _ -> locals
641648 RBlocked -> locals
642649 RForeign _ -> locals
@@ -660,6 +667,7 @@ addProblem result problems =
660667 RNew _ _ _ -> problems
661668 RSame _ _ _ -> problems
662669 RCached _ _ -> problems
670+ RNotFound _ -> problems
663671 RProblem p -> p:problems
664672 RBlocked -> problems
665673 RForeign _ -> problems
@@ -795,7 +803,7 @@ dropPrefix roots paths =
795803
796804data MainStatus
797805 = SInside ModuleName.Raw
798− | SOutsideOk Details.Local Src.Module
806+ | SOutsideOk Details.Local B.ByteString Src.Module
799807 | SOutsideErr Problem.Syntax
800808
801809
@@ -811,12 +819,12 @@ crawlMain env@(Env _ _ pkg _ _ _) mvar given =
811819
812820 LOutside path ->
813821 do time <- File.getTime path
814− bytes <- File.readUtf8 path
815− case Parse.fromByteString pkg bytes of
822+ source <- File.readUtf8 path
823+ case Parse.fromByteString pkg source of
816824 Right modul@(Src.Module _ _ imports values _ _ _ _) ->
817825 do let deps = map Src.getImportName imports
818826 let local = Details.Local path time deps (any isMain values)
819− crawlDeps env mvar deps (SOutsideOk local modul)
827+ crawlDeps env mvar deps (SOutsideOk local source modul)
820828
821829 Left syntaxError ->
822830 return (SOutsideErr (Problem.SyntaxProblem path time syntaxError))
@@ -842,11 +850,11 @@ checkMain env@(Env _ root _ _ _ _) results pendingMain =
842850 SOutsideErr syntaxProblem ->
843851 return (ROutsideErr (Problem.BadSyntax syntaxProblem))
844852
845− SOutsideOk local@(Details.Local _ _ deps _) modul ->
853+ SOutsideOk local@(Details.Local _ _ deps _) source modul ->
846854 do depsStatus <- checkDeps root results deps
847855 case depsStatus of
848856 DepsChange ifaces ->
849− return $ compileOutside env local ifaces modul
857+ return $ compileOutside env local source ifaces modul
850858
851859 DepsSame same cached ->
852860 do maybeLoaded <- checkCachedInterfaces root cached
@@ -856,14 +864,17 @@ checkMain env@(Env _ root _ _ _ _) results pendingMain =
856864
857865 Just loaded ->
858866 do let ifaces = Map.union loaded (Map.fromList same)
859− return $ compileOutside env local ifaces modul
867+ return $ compileOutside env local source ifaces modul
860868
861869 DepsBlock ->
862870 return ROutsideBlocked
863871
872+ DepsNotFound name1 problem1 others ->
873+ return (ROutsideErr (Problem.BadImports name1 problem1 others))
874+
864875
865−compileOutside :: Env -> Details.Local -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> MainResult
866−compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) ifaces modul =
876+compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> MainResult
877+compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) source ifaces modul =
867878 let
868879 name = Src.getName modul
869880 in
@@ -873,7 +884,7 @@ compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) ifaces modul =
873884
874885 Left errors ->
875886 ROutsideErr $ Problem.BadContent $
876− Problem.Module name path time errors (Localizer.fromModule modul)
887+ Problem.Module name path time source errors (Localizer.fromModule modul)
877888
878889
879890
@@ -924,12 +935,18 @@ addInside name result modules =
924935 RNew _ iface objs -> Fresh name iface objs : modules
925936 RSame _ iface objs -> Fresh name iface objs : modules
926937 RCached main mvar -> Cached name main mvar : modules
927− RProblem _ -> error ("I missed the error in `" ++ Name.toChars name ++ "` module.")
928− RBlocked -> error ("I missed the error in `" ++ Name.toChars name ++ "` module.")
938+ RNotFound _ -> error (badInside name)
939+ RProblem _ -> error (badInside name)
940+ RBlocked -> error (badInside name)
929941 RForeign _ -> modules
930942 RKernel -> modules
931943
932944
945+badInside :: ModuleName.Raw -> [Char]
946+badInside name =
947+ "Error from `" ++ Name.toChars name ++ "` should have been reported already."
948+
949+
933950addOutside :: MainResult -> [Module] -> [Module]
934951addOutside main modules =
935952 case main of