git.iko.soy/elk
on master help sign in
Associate bad imports with their modules of origin
0358ed9Evan Czaplicki
builder/src/Build.hs+101−84
compare with master
unifiedsplit
@@ -14,6 +14,7 @@ module Build
14import Control.Concurrent (forkIO)
14import Control.Concurrent (forkIO)
15import Control.Concurrent.MVar
15import Control.Concurrent.MVar
16import Control.Monad (filterM, mapM_, sequence_)
16import Control.Monad (filterM, mapM_, sequence_)
17+import qualified Data.ByteString as B
17import qualified Data.Char as Char
18import qualified Data.Char as Char
18import qualified Data.Either as Either
19import qualified Data.Either as Either
19import qualified Data.Graph as Graph
20import qualified Data.Graph as Graph
@@ -187,9 +188,9 @@ type StatusDict =
187
188
188data Status
189data Status
189 = SCached Details.Local
190 = SCached Details.Local
190− | SChanged Details.Local Src.Module
191+ | SChanged Details.Local B.ByteString Src.Module
191− | SNotFound Problem.Find
192+ | SBadImport Problem.Import
192− | SNotValid Problem.Syntax
193+ | SBadSyntax Problem.Syntax
193 | SForeign Pkg.Name
194 | SForeign Pkg.Name
194 | SKernel
195 | SKernel
195
196
@@ -218,7 +219,7 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
218 [path] ->
219 [path] ->
219 case Map.lookup name foreigns of
220 case Map.lookup name foreigns of
220 Just (Details.Foreign dep deps) ->
221 Just (Details.Foreign dep deps) ->
221− return $ SNotFound $ Problem.Ambiguous path [] dep deps
222+ return $ SBadImport $ Import.Ambiguous name path [] dep deps
222
223
223 Nothing ->
224 Nothing ->
224 case Map.lookup name locals of
225 case Map.lookup name locals of
@@ -235,7 +236,7 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
235 else crawlDeps env mvar deps (SCached local)
236 else crawlDeps env mvar deps (SCached local)
236
237
237 p1:p2:ps ->
238 p1:p2:ps ->
238− return $ SNotFound $ Problem.AmbiguousLocal p1 p2 ps
239+ return $ SBadImport $ Import.AmbiguousLocal name p1 p2 ps
239
240
240 [] ->
241 [] ->
241 case Map.lookup name foreigns of
242 case Map.lookup name foreigns of
@@ -245,22 +246,22 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
245 return $ SForeign dep
246 return $ SForeign dep
246
247
247 d:ds ->
248 d:ds ->
248− return $ SNotFound $ Problem.AmbiguousForeign dep d ds
249+ return $ SBadImport $ Import.AmbiguousForeign name dep d ds
249
250
250 Nothing ->
251 Nothing ->
251 if Name.isKernel name && Pkg.isKernel pkg then
252 if Name.isKernel name && Pkg.isKernel pkg then
252 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
253 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)
254 else
255 else
255− return $ SNotFound Problem.NotFound
256+ return $ SBadImport (Import.NotFound name)
256
257
257
258
258crawlFile :: Env -> MVar StatusDict -> ModuleName.Raw -> FilePath -> IO Status
259crawlFile :: Env -> MVar StatusDict -> ModuleName.Raw -> FilePath -> IO Status
259crawlFile env@(Env _ root pkg _ _ _) mvar expectedName path =
260crawlFile env@(Env _ root pkg _ _ _) mvar expectedName path =
260 do time <- File.getTime path
261 do time <- File.getTime path
261− bytes <- File.readUtf8 (root </> path)
262+ source <- File.readUtf8 (root </> path)
262
263
263− case Parse.fromByteString pkg bytes of
264+ case Parse.fromByteString pkg source of
264 Right modul@(Src.Module maybeActualName _ imports values _ _ _ _) ->
265 Right modul@(Src.Module maybeActualName _ imports values _ _ _ _) ->
265 case maybeActualName of
266 case maybeActualName of
266 Just actualName ->
267 Just actualName ->
@@ -269,15 +270,15 @@ crawlFile env@(Env _ root pkg _ _ _) mvar expectedName path =
269 deps = map Src.getImportName imports
270 deps = map Src.getImportName imports
270 local = Details.Local path time deps (any isMain values)
271 local = Details.Local path time deps (any isMain values)
271 in
272 in
272− crawlDeps env mvar deps (SChanged local modul)
273+ crawlDeps env mvar deps (SChanged local source modul)
273 else
274 else
274− return $ SNotValid $ Problem.BadModuleName_Mismatch expectedName actualName
275+ return $ SBadSyntax $ Problem.ModuleNameMismatch expectedName actualName
275
276
276 Nothing ->
277 Nothing ->
277− return $ SNotValid $ Problem.BadModuleName_Unspecified expectedName
278+ return $ SBadSyntax $ Problem.ModuleNameUnspecified expectedName
278
279
279 Left syntaxError ->
280 Left syntaxError ->
280− return $ SNotValid $ Problem.SyntaxProblem path time syntaxError
281+ return $ SBadSyntax $ Problem.SyntaxProblem path time syntaxError
281
282
282
283
283isMain :: A.Located Src.Value -> Bool
284isMain :: A.Located Src.Value -> Bool
@@ -297,6 +298,7 @@ data Result
297 = RNew Details.Local I.Interface Opt.LocalGraph
298 = RNew Details.Local I.Interface Opt.LocalGraph
298 | RSame Details.Local I.Interface Opt.LocalGraph
299 | RSame Details.Local I.Interface Opt.LocalGraph
299 | RCached Bool (MVar CachedInterface)
300 | RCached Bool (MVar CachedInterface)
301+ | RNotFound Problem.Import
300 | RProblem Problem.Problem
302 | RProblem Problem.Problem
301 | RBlocked
303 | RBlocked
302 | RForeign I.Interface
304 | RForeign I.Interface
@@ -317,9 +319,9 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
317 depsStatus <- checkDeps root results deps
319 depsStatus <- checkDeps root results deps
318 case depsStatus of
320 case depsStatus of
319 DepsChange ifaces ->
321 DepsChange ifaces ->
320− do bytes <- File.readUtf8 path
322+ do source <- File.readUtf8 path
321− case Parse.fromByteString pkg bytes of
323+ case Parse.fromByteString pkg source of
322− Right modul -> compile env local ifaces modul
324+ Right modul -> compile env local source ifaces modul
323 Left syntaxError ->
325 Left syntaxError ->
324 return $ RProblem $ Problem.BadSyntax $
326 return $ RProblem $ Problem.BadSyntax $
325 Problem.SyntaxProblem path time syntaxError
327 Problem.SyntaxProblem path time syntaxError
@@ -331,12 +333,15 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
331 DepsBlock ->
333 DepsBlock ->
332 return RBlocked
334 return RBlocked
333
335
336+ DepsNotFound name1 problem1 others ->
337+ return (RProblem (Problem.BadImports name1 problem1 others))
338+
334− SChanged local@(Details.Local _ _ deps _) modul ->
339+ SChanged local@(Details.Local _ _ deps _) source modul ->
335 do results <- readMVar resultsMVar
340 do results <- readMVar resultsMVar
336 depsStatus <- checkDeps root results deps
341 depsStatus <- checkDeps root results deps
337 case depsStatus of
342 case depsStatus of
338 DepsChange ifaces ->
343 DepsChange ifaces ->
339− compile env local ifaces modul
344+ compile env local source ifaces modul
340
345
341 DepsSame same cached ->
346 DepsSame same cached ->
342 do maybeLoaded <- checkCachedInterfaces root cached
347 do maybeLoaded <- checkCachedInterfaces root cached
@@ -346,15 +351,18 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
346
351
347 Just loaded ->
352 Just loaded ->
348 do let ifaces = Map.union loaded (Map.fromList same)
353 do let ifaces = Map.union loaded (Map.fromList same)
349− compile env local ifaces modul
354+ compile env local source ifaces modul
350
355
351 DepsBlock ->
356 DepsBlock ->
352 return RBlocked
357 return RBlocked
353
358
354− SNotFound findProblem ->
359+ DepsNotFound name1 problem1 others ->
355− return (RProblem (Problem.BadFind findProblem))
360+ return (RProblem (Problem.BadImports name1 problem1 others))
361+
362+ SBadImport importProblem ->
363+ return (RNotFound importProblem)
356
364
357− SNotValid syntaxProblem ->
365+ SBadSyntax syntaxProblem ->
358 return (RProblem (Problem.BadSyntax syntaxProblem))
366 return (RProblem (Problem.BadSyntax syntaxProblem))
359
367
360 SForeign home ->
368 SForeign home ->
@@ -374,56 +382,54 @@ data DepsStatus
374 = DepsChange (Map.Map ModuleName.Raw I.Interface)
382 = DepsChange (Map.Map ModuleName.Raw I.Interface)
375 | DepsSame [Dep] [CDep]
383 | DepsSame [Dep] [CDep]
376 | DepsBlock
384 | DepsBlock
385+ | DepsNotFound ModuleName.Raw Problem.Import [(ModuleName.Raw, Problem.Import)]
377
386
378
387
379checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus
388checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus
380checkDeps root results deps =
389checkDeps root results deps =
381− checkDepsHelp root results deps [] [] []
390+ checkDepsHelp root results deps [] [] [] [] False
382
391
383
392
384type Dep = (ModuleName.Raw, I.Interface)
393type Dep = (ModuleName.Raw, I.Interface)
385type CDep = (ModuleName.Raw, MVar CachedInterface)
394type CDep = (ModuleName.Raw, MVar CachedInterface)
386
395
387
396
388−checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> IO DepsStatus
397+checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw, Problem.Import)] -> Bool -> IO DepsStatus
389−checkDepsHelp root results deps new same cached =
398+checkDepsHelp root results deps new same cached badImports isBlocked =
390 case deps of
399 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−
404 dep:otherDeps ->
400 dep:otherDeps ->
405 do result <- readMVar (results ! dep)
401 do result <- readMVar (results ! dep)
406 case result of
402 case result of
407− RNew _ iface _ ->
408− checkDepsHelp root results otherDeps ((dep,iface) : new) same cached
403+ RNew _ iface _ -> checkDepsHelp root results otherDeps ((dep,iface) : new) same cached badImports isBlocked
409−
404+ RSame _ iface _ -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached badImports isBlocked
410− RSame _ iface _ ->
405+ RCached _ mvar -> checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) badImports isBlocked
411− checkDepsHelp root results otherDeps new ((dep,iface) : same) cached
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
412
411
413− RCached _ mvar ->
412+ [] ->
414− checkDepsHelp root results otherDeps new same ((dep,mvar) : cached)
413+ case badImports of
414+ (name, problem) : otherBadImports ->
415+ return $ DepsNotFound name problem otherBadImports
415
416
416− RProblem _ ->
417+ [] ->
418+ if isBlocked then
417− return DepsBlock
419+ return $ DepsBlock
418
420
419− RBlocked ->
421+ else if null new then
420− return DepsBlock
422+ return $ DepsSame same cached
421
423
422− RForeign iface ->
424+ else
423− checkDepsHelp root results otherDeps new ((dep,iface) : same) cached
425+ do maybeLoaded <- checkCachedInterfaces root cached
426+ case maybeLoaded of
427+ Nothing ->
428+ return DepsBlock
424
429
425− RKernel ->
430+ Just loaded ->
426− checkDepsHelp root results otherDeps new same cached
431+ return $ DepsChange $
432+ Map.union loaded (Map.union (Map.fromList new) (Map.fromList same))
427
433
428
434
429
435
@@ -534,12 +540,12 @@ addToGraph name status graph =
534 let
540 let
535 dependencies =
541 dependencies =
536 case status of
542 case status of
537− SCached (Details.Local _ _ deps _) -> deps
543+ SCached (Details.Local _ _ deps _) -> deps
538− SChanged (Details.Local _ _ deps _) _ -> deps
544+ SChanged (Details.Local _ _ deps _) _ _ -> deps
539− SNotFound _ -> []
545+ SBadImport _ -> []
540− SNotValid _ -> []
546+ SBadSyntax _ -> []
541− SForeign _ -> []
547+ SForeign _ -> []
542− SKernel -> []
548+ SKernel -> []
543 in
549 in
544 (name, name, dependencies) : graph
550 (name, name, dependencies) : graph
545
551
@@ -567,9 +573,9 @@ checkUniqueMains insides smains =
567mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
573mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
568mainStatusToNamePathPair smain =
574mainStatusToNamePathPair smain =
569 case smain of
575 case smain of
570− SInside _ -> Nothing
576+ SInside _ -> Nothing
571− SOutsideOk (Details.Local path _ _ _) modul -> Just (Src.getName modul, OneOrMore.one path)
577+ SOutsideOk (Details.Local path _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
572− SOutsideErr _ -> Nothing
578+ SOutsideErr _ -> Nothing
573
579
574
580
575checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath
581checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath
@@ -582,20 +588,20 @@ checkOutside name paths =
582checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
588checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
583checkInside name p1 status =
589checkInside name p1 status =
584 case status of
590 case status of
585− SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
591+ SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
586− SChanged (Details.Local p2 _ _ _) _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
592+ SChanged (Details.Local p2 _ _ _) _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
587− SNotFound _ -> Right ()
593+ SBadImport _ -> Right ()
588− SNotValid _ -> Right ()
594+ SBadSyntax _ -> Right ()
589− SForeign _ -> Right ()
595+ SForeign _ -> Right ()
590− SKernel -> Right ()
596+ SKernel -> Right ()
591
597
592
598
593
599
594-- COMPILE MODULE
600-- COMPILE MODULE
595
601
596
602
597−compile :: Env -> Details.Local -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
603+compile :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
598−compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) ifaces modul =
604+compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) source ifaces modul =
599 case Compile.compile pkg ifaces modul of
605 case Compile.compile pkg ifaces modul of
600 Right (Compile.Artifacts canonical annotations objects) ->
606 Right (Compile.Artifacts canonical annotations objects) ->
601 do let name = Src.getName modul
607 do let name = Src.getName modul
@@ -618,7 +624,7 @@ compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) ifaces modu
618 Left errors ->
624 Left errors ->
619 do Reporting.report key Reporting.BDone
625 do Reporting.report key Reporting.BDone
620 return $ RProblem $ Problem.BadContent $
626 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)
622
628
623
629
624
630
@@ -637,6 +643,7 @@ addNewLocal name result locals =
637 RNew local _ _ -> Map.insert name local locals
643 RNew local _ _ -> Map.insert name local locals
638 RSame local _ _ -> Map.insert name local locals
644 RSame local _ _ -> Map.insert name local locals
639 RCached _ _ -> locals
645 RCached _ _ -> locals
646+ RNotFound _ -> locals
640 RProblem _ -> locals
647 RProblem _ -> locals
641 RBlocked -> locals
648 RBlocked -> locals
642 RForeign _ -> locals
649 RForeign _ -> locals
@@ -660,6 +667,7 @@ addProblem result problems =
660 RNew _ _ _ -> problems
667 RNew _ _ _ -> problems
661 RSame _ _ _ -> problems
668 RSame _ _ _ -> problems
662 RCached _ _ -> problems
669 RCached _ _ -> problems
670+ RNotFound _ -> problems
663 RProblem p -> p:problems
671 RProblem p -> p:problems
664 RBlocked -> problems
672 RBlocked -> problems
665 RForeign _ -> problems
673 RForeign _ -> problems
@@ -795,7 +803,7 @@ dropPrefix roots paths =
795
803
796data MainStatus
804data MainStatus
797 = SInside ModuleName.Raw
805 = SInside ModuleName.Raw
798− | SOutsideOk Details.Local Src.Module
806+ | SOutsideOk Details.Local B.ByteString Src.Module
799 | SOutsideErr Problem.Syntax
807 | SOutsideErr Problem.Syntax
800
808
801
809
@@ -811,12 +819,12 @@ crawlMain env@(Env _ _ pkg _ _ _) mvar given =
811
819
812 LOutside path ->
820 LOutside path ->
813 do time <- File.getTime path
821 do time <- File.getTime path
814− bytes <- File.readUtf8 path
822+ source <- File.readUtf8 path
815− case Parse.fromByteString pkg bytes of
823+ case Parse.fromByteString pkg source of
816 Right modul@(Src.Module _ _ imports values _ _ _ _) ->
824 Right modul@(Src.Module _ _ imports values _ _ _ _) ->
817 do let deps = map Src.getImportName imports
825 do let deps = map Src.getImportName imports
818 let local = Details.Local path time deps (any isMain values)
826 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)
820
828
821 Left syntaxError ->
829 Left syntaxError ->
822 return (SOutsideErr (Problem.SyntaxProblem path time syntaxError))
830 return (SOutsideErr (Problem.SyntaxProblem path time syntaxError))
@@ -842,11 +850,11 @@ checkMain env@(Env _ root _ _ _ _) results pendingMain =
842 SOutsideErr syntaxProblem ->
850 SOutsideErr syntaxProblem ->
843 return (ROutsideErr (Problem.BadSyntax syntaxProblem))
851 return (ROutsideErr (Problem.BadSyntax syntaxProblem))
844
852
845− SOutsideOk local@(Details.Local _ _ deps _) modul ->
853+ SOutsideOk local@(Details.Local _ _ deps _) source modul ->
846 do depsStatus <- checkDeps root results deps
854 do depsStatus <- checkDeps root results deps
847 case depsStatus of
855 case depsStatus of
848 DepsChange ifaces ->
856 DepsChange ifaces ->
849− return $ compileOutside env local ifaces modul
857+ return $ compileOutside env local source ifaces modul
850
858
851 DepsSame same cached ->
859 DepsSame same cached ->
852 do maybeLoaded <- checkCachedInterfaces root cached
860 do maybeLoaded <- checkCachedInterfaces root cached
@@ -856,14 +864,17 @@ checkMain env@(Env _ root _ _ _ _) results pendingMain =
856
864
857 Just loaded ->
865 Just loaded ->
858 do let ifaces = Map.union loaded (Map.fromList same)
866 do let ifaces = Map.union loaded (Map.fromList same)
859− return $ compileOutside env local ifaces modul
867+ return $ compileOutside env local source ifaces modul
860
868
861 DepsBlock ->
869 DepsBlock ->
862 return ROutsideBlocked
870 return ROutsideBlocked
863
871
872+ DepsNotFound name1 problem1 others ->
873+ return (ROutsideErr (Problem.BadImports name1 problem1 others))
874+
864
875
865−compileOutside :: Env -> Details.Local -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> MainResult
876+compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> MainResult
866−compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) ifaces modul =
877+compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) source ifaces modul =
867 let
878 let
868 name = Src.getName modul
879 name = Src.getName modul
869 in
880 in
@@ -873,7 +884,7 @@ compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) ifaces modul =
873
884
874 Left errors ->
885 Left errors ->
875 ROutsideErr $ Problem.BadContent $
886 ROutsideErr $ Problem.BadContent $
876− Problem.Module name path time errors (Localizer.fromModule modul)
887+ Problem.Module name path time source errors (Localizer.fromModule modul)
877
888
878
889
879
890
@@ -924,12 +935,18 @@ addInside name result modules =
924 RNew _ iface objs -> Fresh name iface objs : modules
935 RNew _ iface objs -> Fresh name iface objs : modules
925 RSame _ iface objs -> Fresh name iface objs : modules
936 RSame _ iface objs -> Fresh name iface objs : modules
926 RCached main mvar -> Cached name main mvar : modules
937 RCached main mvar -> Cached name main mvar : modules
938+ RNotFound _ -> error (badInside name)
927− RProblem _ -> error ("I missed the error in `" ++ Name.toChars name ++ "` module.")
939+ RProblem _ -> error (badInside name)
928− RBlocked -> error ("I missed the error in `" ++ Name.toChars name ++ "` module.")
940+ RBlocked -> error (badInside name)
929 RForeign _ -> modules
941 RForeign _ -> modules
930 RKernel -> modules
942 RKernel -> modules
931
943
932
944
945+badInside :: ModuleName.Raw -> [Char]
946+badInside name =
947+ "Error from `" ++ Name.toChars name ++ "` should have been reported already."
948+
949+
933addOutside :: MainResult -> [Module] -> [Module]
950addOutside :: MainResult -> [Module] -> [Module]
934addOutside main modules =
951addOutside main modules =
935 case main of
952 case main of