@@ -1,5 +1,5 @@
11{-# OPTIONS_GHC -Wno-unused-do-bind #-}
2−{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
33module Build
44 ( fromExposed
55 , fromMains
@@ -26,6 +26,7 @@ import qualified Data.Maybe as Maybe
2626import qualified Data.Name as Name
2727import qualified Data.NonEmptyList as NE
2828import qualified Data.OneOrMore as OneOrMore
29+import qualified Data.Set as Set
2930import qualified System.Directory as Dir
3031import qualified System.FilePath as FP
3132import System.FilePath ((</>), (<.>))
@@ -42,9 +43,10 @@ import qualified File
4243import qualified Parse.Module as Parse
4344import qualified Reporting
4445import qualified Reporting.Annotation as A
46+import qualified Reporting.Error as Error
47+import qualified Reporting.Error.Syntax as Syntax
48+import qualified Reporting.Error.Import as Import
4549import qualified Reporting.Exit as Exit
46−import qualified Reporting.Problem as Problem
47−import qualified Reporting.Render.Type.Localizer as Localizer
4850import qualified Stuff
4951
5052
@@ -172,7 +174,7 @@ fromMains style root details paths =
172174 rmvar <- newEmptyMVar
173175 resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
174176 putMVar rmvar resultsMVars
175− rmainMVars <- traverse (fork . checkMain env resultsMVars) smains
177+ rmainMVars <- traverse (fork . checkMain env foreigns resultsMVars) smains
176178 results <- traverse readMVar resultsMVars
177179 writeDetails root details results
178180 toArtifacts env foreigns results <$> traverse readMVar rmainMVars
@@ -189,8 +191,8 @@ type StatusDict =
189191data Status
190192 = SCached Details.Local
191193 | SChanged Details.Local B.ByteString Src.Module
192− | SBadImport Problem.Import
193− | SBadSyntax Problem.Syntax
194+ | SBadImport Import.Problem
195+ | SBadSyntax FilePath File.Time B.ByteString Syntax.Error
194196 | SForeign Pkg.Name
195197 | SKernel
196198
@@ -219,7 +221,7 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
219221 [path] ->
220222 case Map.lookup name foreigns of
221223 Just (Details.Foreign dep deps) ->
222− return $ SBadImport $ Import.Ambiguous name path [] dep deps
224+ return $ SBadImport $ Import.Ambiguous path [] dep deps
223225
224226 Nothing ->
225227 case Map.lookup name locals of
@@ -236,7 +238,7 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
236238 else crawlDeps env mvar deps (SCached local)
237239
238240 p1:p2:ps ->
239− return $ SBadImport $ Import.AmbiguousLocal name p1 p2 ps
241+ return $ SBadImport $ Import.AmbiguousLocal p1 p2 ps
240242
241243 [] ->
242244 case Map.lookup name foreigns of
@@ -246,14 +248,14 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar name =
246248 return $ SForeign dep
247249
248250 d:ds ->
249− return $ SBadImport $ Import.AmbiguousForeign name dep d ds
251+ return $ SBadImport $ Import.AmbiguousForeign dep d ds
250252
251253 Nothing ->
252254 if Name.isKernel name && Pkg.isKernel pkg then
253255 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
254− return $ if exists then SKernel else SBadImport (Import.NotFound name)
256+ return $ if exists then SKernel else SBadImport Import.NotFound
255257 else
256− return $ SBadImport (Import.NotFound name)
258+ return $ SBadImport Import.NotFound
257259
258260
259261crawlFile :: Env -> MVar StatusDict -> ModuleName.Raw -> FilePath -> IO Status
@@ -262,9 +264,15 @@ crawlFile env@(Env _ root pkg _ _ _) mvar expectedName path =
262264 source <- File.readUtf8 (root </> path)
263265
264266 case Parse.fromByteString pkg source of
267+ Left err ->
268+ return $ SBadSyntax path time source err
269+
265270 Right modul@(Src.Module maybeActualName _ imports values _ _ _ _) ->
266271 case maybeActualName of
267− Just actualName ->
272+ Nothing ->
273+ return $ SBadSyntax path time source (Syntax.ModuleNameUnspecified expectedName)
274+
275+ Just name@(A.At _ actualName) ->
268276 if expectedName == actualName then
269277 let
270278 deps = map Src.getImportName imports
@@ -272,13 +280,7 @@ crawlFile env@(Env _ root pkg _ _ _) mvar expectedName path =
272280 in
273281 crawlDeps env mvar deps (SChanged local source modul)
274282 else
275− return $ SBadSyntax $ Problem.ModuleNameMismatch expectedName actualName
276−
277− Nothing ->
278− return $ SBadSyntax $ Problem.ModuleNameUnspecified expectedName
279−
280− Left syntaxError ->
281− return $ SBadSyntax $ Problem.SyntaxProblem path time syntaxError
283+ return $ SBadSyntax path time source (Syntax.ModuleNameMismatch expectedName name)
282284
283285
284286isMain :: A.Located Src.Value -> Bool
@@ -298,8 +300,8 @@ data Result
298300 = RNew Details.Local I.Interface Opt.LocalGraph
299301 | RSame Details.Local I.Interface Opt.LocalGraph
300302 | RCached Bool (MVar CachedInterface)
301− | RNotFound Problem.Import
302− | RProblem Problem.Problem
303+ | RNotFound Import.Problem
304+ | RProblem Error.Module
303305 | RBlocked
304306 | RForeign I.Interface
305307 | RKernel
@@ -322,9 +324,9 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
322324 do source <- File.readUtf8 path
323325 case Parse.fromByteString pkg source of
324326 Right modul -> compile env local source ifaces modul
325− Left syntaxError ->
326− return $ RProblem $ Problem.BadSyntax $
327− Problem.SyntaxProblem path time syntaxError
327+ Left err ->
328+ return $ RProblem $
329+ Error.Module name path time source (Error.BadSyntax err)
328330
329331 DepsSame _ _ ->
330332 do mvar <- newMVar Unneeded
@@ -333,10 +335,17 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
333335 DepsBlock ->
334336 return RBlocked
335337
336− DepsNotFound name1 problem1 others ->
337− return (RProblem (Problem.BadImports name1 problem1 others))
338+ DepsNotFound problems ->
339+ do source <- File.readUtf8 path
340+ return $ RProblem $ Error.Module name path time source $
341+ case Parse.fromByteString pkg source of
342+ Right (Src.Module _ _ imports _ _ _ _ _) ->
343+ Error.BadImports (toImportErrors foreigns results imports problems)
344+
345+ Left err ->
346+ Error.BadSyntax err
338347
339− SChanged local@(Details.Local _ _ deps _) source modul ->
348+ SChanged local@(Details.Local path time deps _) source modul@(Src.Module _ _ imports _ _ _ _ _) ->
340349 do results <- readMVar resultsMVar
341350 depsStatus <- checkDeps root results deps
342351 case depsStatus of
@@ -356,14 +365,16 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
356365 DepsBlock ->
357366 return RBlocked
358367
359− DepsNotFound name1 problem1 others ->
360− return (RProblem (Problem.BadImports name1 problem1 others))
368+ DepsNotFound problems ->
369+ return $ RProblem $ Error.Module name path time source $
370+ Error.BadImports (toImportErrors foreigns results imports problems)
361371
362372 SBadImport importProblem ->
363373 return (RNotFound importProblem)
364374
365− SBadSyntax syntaxProblem ->
366− return (RProblem (Problem.BadSyntax syntaxProblem))
375+ SBadSyntax path time source err ->
376+ return $ RProblem $ Error.Module name path time source $
377+ Error.BadSyntax err
367378
368379 SForeign home ->
369380 case foreigns ! ModuleName.Canonical home name of
@@ -382,7 +393,7 @@ data DepsStatus
382393 = DepsChange (Map.Map ModuleName.Raw I.Interface)
383394 | DepsSame [Dep] [CDep]
384395 | DepsBlock
385− | DepsNotFound ModuleName.Raw Problem.Import [(ModuleName.Raw, Problem.Import)]
396+ | DepsNotFound (NE.List (ModuleName.Raw, Import.Problem))
386397
387398
388399checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus
@@ -394,25 +405,25 @@ type Dep = (ModuleName.Raw, I.Interface)
394405type CDep = (ModuleName.Raw, MVar CachedInterface)
395406
396407
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 =
408+checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw,Import.Problem)] -> Bool -> IO DepsStatus
409+checkDepsHelp root results deps new same cached importProblems isBlocked =
399410 case deps of
400411 dep:otherDeps ->
401412 do result <- readMVar (results ! dep)
402413 case result of
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
414+ RNew _ iface _ -> checkDepsHelp root results otherDeps ((dep,iface) : new) same cached importProblems isBlocked
415+ RSame _ iface _ -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked
416+ RCached _ mvar -> checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) importProblems isBlocked
417+ RNotFound prob -> checkDepsHelp root results otherDeps new same cached ((dep,prob) : importProblems) True
418+ RProblem _ -> checkDepsHelp root results otherDeps new same cached importProblems True
419+ RBlocked -> checkDepsHelp root results otherDeps new same cached importProblems True
420+ RForeign iface -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked
421+ RKernel -> checkDepsHelp root results otherDeps new same cached importProblems isBlocked
411422
412423 [] ->
413− case badImports of
414− (name, problem) : otherBadImports ->
415− return $ DepsNotFound name problem otherBadImports
424+ case importProblems of
425+ p:ps ->
426+ return $ DepsNotFound (NE.List p ps)
416427
417428 [] ->
418429 if isBlocked then
@@ -433,6 +444,27 @@ checkDepsHelp root results deps new same cached badImports isBlocked =
433444
434445
435446
447+-- TO IMPORT ERROR
448+
449+
450+toImportErrors :: Dependencies -> ResultDict -> [Src.Import] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error
451+toImportErrors foreigns results imports problems =
452+ let
453+ knownModules =
454+ Set.union
455+ (Set.fromList (map ModuleName._module (Map.keys foreigns)))
456+ (Map.keysSet results)
457+
458+ regionDict =
459+ Map.fromList (map (\(Src.Import (A.At region name) _ _) -> (name, region)) imports)
460+
461+ toError (name, problem) =
462+ Import.Error (regionDict ! name) name knownModules problem
463+ in
464+ fmap toError problems
465+
466+
467+
436468-- CACHED INTERFACE
437469
438470
@@ -543,7 +575,7 @@ addToGraph name status graph =
543575 SCached (Details.Local _ _ deps _) -> deps
544576 SChanged (Details.Local _ _ deps _) _ _ -> deps
545577 SBadImport _ -> []
546− SBadSyntax _ -> []
578+ SBadSyntax _ _ _ _ -> []
547579 SForeign _ -> []
548580 SKernel -> []
549581 in
@@ -591,7 +623,7 @@ checkInside name p1 status =
591623 SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
592624 SChanged (Details.Local p2 _ _ _) _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
593625 SBadImport _ -> Right ()
594− SBadSyntax _ -> Right ()
626+ SBadSyntax _ _ _ _ -> Right ()
595627 SForeign _ -> Right ()
596628 SKernel -> Right ()
597629
@@ -621,10 +653,10 @@ compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) source ifac
621653 Reporting.report key Reporting.BDone
622654 return (RNew local iface objects)
623655
624− Left errors ->
656+ Left err ->
625657 do Reporting.report key Reporting.BDone
626− return $ RProblem $ Problem.BadContent $
627− Problem.Module (Src.getName modul) path time source errors (Localizer.fromModule modul)
658+ return $ RProblem $
659+ Error.Module (Src.getName modul) path time source err
628660
629661
630662
@@ -656,22 +688,22 @@ addNewLocal name result locals =
656688
657689detectProblems :: Map.Map ModuleName.Raw Result -> Either Exit.BuildProblem ()
658690detectProblems results =
659− case Map.foldr addProblem [] results of
691+ case Map.foldr addErrors [] results of
660692 [] -> Right ()
661− p:ps -> Left (Exit.BuildModuleProblems p ps)
693+ e:es -> Left (Exit.BuildModuleProblems e es)
662694
663695
664−addProblem :: Result -> [Problem.Problem] -> [Problem.Problem]
665−addProblem result problems =
696+addErrors :: Result -> [Error.Module] -> [Error.Module]
697+addErrors result errors =
666698 case result of
667− RNew _ _ _ -> problems
668− RSame _ _ _ -> problems
669− RCached _ _ -> problems
670− RNotFound _ -> problems
671− RProblem p -> p:problems
672− RBlocked -> problems
673− RForeign _ -> problems
674− RKernel -> problems
699+ RNew _ _ _ -> errors
700+ RSame _ _ _ -> errors
701+ RCached _ _ -> errors
702+ RNotFound _ -> errors
703+ RProblem e -> e:errors
704+ RBlocked -> errors
705+ RForeign _ -> errors
706+ RKernel -> errors
675707
676708
677709
@@ -804,7 +836,7 @@ dropPrefix roots paths =
804836data MainStatus
805837 = SInside ModuleName.Raw
806838 | SOutsideOk Details.Local B.ByteString Src.Module
807− | SOutsideErr Problem.Syntax
839+ | SOutsideErr Error.Module
808840
809841
810842crawlMain :: Env -> MVar StatusDict -> MainLocation -> IO MainStatus
@@ -827,7 +859,8 @@ crawlMain env@(Env _ _ pkg _ _ _) mvar given =
827859 crawlDeps env mvar deps (SOutsideOk local source modul)
828860
829861 Left syntaxError ->
830− return (SOutsideErr (Problem.SyntaxProblem path time syntaxError))
862+ return $ SOutsideErr $
863+ Error.Module "???" path time source (Error.BadSyntax syntaxError)
831864
832865
833866
@@ -837,20 +870,20 @@ crawlMain env@(Env _ _ pkg _ _ _) mvar given =
837870data MainResult
838871 = RInside ModuleName.Raw
839872 | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph
840− | ROutsideErr Problem.Problem
873+ | ROutsideErr Error.Module
841874 | ROutsideBlocked
842875
843876
844−checkMain :: Env -> ResultDict -> MainStatus -> IO MainResult
845−checkMain env@(Env _ root _ _ _ _) results pendingMain =
877+checkMain :: Env -> Dependencies -> ResultDict -> MainStatus -> IO MainResult
878+checkMain env@(Env _ root _ _ _ _) foreigns results pendingMain =
846879 case pendingMain of
847880 SInside name ->
848881 return (RInside name)
849882
850− SOutsideErr syntaxProblem ->
851− return (ROutsideErr (Problem.BadSyntax syntaxProblem))
883+ SOutsideErr err ->
884+ return (ROutsideErr err)
852885
853− SOutsideOk local@(Details.Local _ _ deps _) source modul ->
886+ SOutsideOk local@(Details.Local path time deps _) source modul@(Src.Module _ _ imports _ _ _ _ _) ->
854887 do depsStatus <- checkDeps root results deps
855888 case depsStatus of
856889 DepsChange ifaces ->
@@ -869,8 +902,9 @@ checkMain env@(Env _ root _ _ _ _) results pendingMain =
869902 DepsBlock ->
870903 return ROutsideBlocked
871904
872− DepsNotFound name1 problem1 others ->
873− return (ROutsideErr (Problem.BadImports name1 problem1 others))
905+ DepsNotFound problems ->
906+ return $ ROutsideErr $ Error.Module (Src.getName modul) path time source $
907+ Error.BadImports (toImportErrors foreigns results imports problems)
874908
875909
876910compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> MainResult
@@ -883,8 +917,8 @@ compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) source ifaces m
883917 ROutsideOk name (I.fromModule pkg canonical annotations) objects
884918
885919 Left errors ->
886− ROutsideErr $ Problem.BadContent $
887− Problem.Module name path time source errors (Localizer.fromModule modul)
920+ ROutsideErr $
921+ Error.Module name path time source errors
888922
889923
890924
@@ -899,34 +933,34 @@ data Main
899933toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either Exit.BuildProblem Artifacts
900934toArtifacts (Env _ _ pkg _ _ _) foreigns results mainResults =
901935 case gatherProblemsOrMains results mainResults of
902− Left (NE.List p ps) ->
903− Left (Exit.BuildModuleProblems p ps)
936+ Left (NE.List e es) ->
937+ Left (Exit.BuildModuleProblems e es)
904938
905939 Right mains ->
906940 Right $ Artifacts pkg foreigns mains $
907941 Map.foldrWithKey addInside (foldr addOutside [] mainResults) results
908942
909943
910−gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either (NE.List Problem.Problem) (NE.List Main)
944+gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either (NE.List Error.Module) (NE.List Main)
911945gatherProblemsOrMains results (NE.List mainResult mainResults) =
912946 let
913− sortMain result (ps, mains) =
947+ sortMain result (es, mains) =
914948 case result of
915− RInside n -> ( ps, Inside n : mains)
916− ROutsideOk n i o -> ( ps, Outside n i o : mains)
917− ROutsideErr p -> (p:ps, mains)
918− ROutsideBlocked -> ( ps, mains)
949+ RInside n -> ( es, Inside n : mains)
950+ ROutsideOk n i o -> ( es, Outside n i o : mains)
951+ ROutsideErr e -> (e:es, mains)
952+ ROutsideBlocked -> ( es, mains)
919953
920− problems = Map.foldr addProblem [] results
954+ errors = Map.foldr addErrors [] results
921955 in
922− case (mainResult, foldr sortMain (problems, []) mainResults) of
956+ case (mainResult, foldr sortMain (errors, []) mainResults) of
923957 (RInside n , ( [], ms)) -> Right (NE.List (Inside n) ms)
924− (RInside _ , (p:ps, _ )) -> Left (NE.List p ps)
958+ (RInside _ , (e:es, _ )) -> Left (NE.List e es)
925959 (ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)
926− (ROutsideOk _ _ _, (p:ps, _ )) -> Left (NE.List p ps)
927− (ROutsideErr p , ( ps, _ )) -> Left (NE.List p ps)
960+ (ROutsideOk _ _ _, (e:es, _ )) -> Left (NE.List e es)
961+ (ROutsideErr e , ( es, _ )) -> Left (NE.List e es)
928962 (ROutsideBlocked , ( [], _ )) -> error "seems like elm-stuff/ is corrupted"
929− (ROutsideBlocked , (p:ps, _ )) -> Left (NE.List p ps)
963+ (ROutsideBlocked , (e:es, _ )) -> Left (NE.List e es)
930964
931965
932966addInside :: ModuleName.Raw -> Result -> [Module] -> [Module]