@@ -3,10 +3,12 @@
33module Build
44 ( fromExposed
55 , fromMains
6+ , fromRepl
67 , Artifacts(..)
78 , Main(..)
89 , Module(..)
910 , CachedInterface(..)
11+ , ReplArtifacts(..)
1012 , DocsGoal(..)
1113 , getMainNames
1214 )
@@ -51,6 +53,7 @@ import qualified Reporting.Error as Error
5153import qualified Reporting.Error.Syntax as Syntax
5254import qualified Reporting.Error.Import as Import
5355import qualified Reporting.Exit as Exit
56+import qualified Reporting.Render.Type.Localizer as L
5457import qualified Stuff
5558
5659
@@ -115,7 +118,7 @@ fromExposed style root details docsGoal exposed@(NE.List e es) =
115118 statuses <- traverse readMVar =<< readMVar mvar
116119
117120 -- compile
118− midpoint <- checkExposedMidpoint dmvar statuses
121+ midpoint <- checkMidpoint dmvar statuses
119122 case midpoint of
120123 Left problem ->
121124 return (Left (Exit.BuildProjectProblem problem))
@@ -374,14 +377,10 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
374377 compile env docsNeed local source ifaces modul
375378
376379 DepsSame same cached ->
377− do maybeLoaded <- checkCachedInterfaces root cached
380+ do maybeLoaded <- loadInterfaces root same cached
378381 case maybeLoaded of
379− Nothing ->
380− return RBlocked
381−
382− Just loaded ->
383− do let ifaces = Map.union loaded (Map.fromList same)
384− compile env docsNeed local source ifaces modul
382+ Nothing -> return RBlocked
383+ Just ifaces -> compile env docsNeed local source ifaces modul
385384
386385 DepsBlock ->
387386 return RBlocked
@@ -454,14 +453,10 @@ checkDepsHelp root results deps new same cached importProblems isBlocked =
454453 return $ DepsSame same cached
455454
456455 else
457− do maybeLoaded <- checkCachedInterfaces root cached
456+ do maybeLoaded <- loadInterfaces root same cached
458457 case maybeLoaded of
459− Nothing ->
460− return DepsBlock
461−
462− Just loaded ->
463− return $ DepsChange $
464− Map.union loaded (Map.union (Map.fromList new) (Map.fromList same))
458+ Nothing -> return DepsBlock
459+ Just ifaces -> return $ DepsChange $ Map.union (Map.fromList new) ifaces
465460
466461
467462
@@ -491,18 +486,23 @@ toImportErrors (Env _ _ _ _ locals foreigns) results imports problems =
491486
492487
493488
494−-- CACHED INTERFACE
489+-- LOAD CACHED INTERFACES
495490
496491
497−checkCachedInterfaces :: FilePath -> [(ModuleName.Raw, MVar CachedInterface)] -> IO (Maybe (Map.Map ModuleName.Raw I.Interface))
498−checkCachedInterfaces root deps =
499− do loading <- traverse (fork . checkCache root) deps
500− loaded <- traverse readMVar loading
501− return $ Map.fromList <$> sequence loaded
492+loadInterfaces :: FilePath -> [Dep] -> [CDep] -> IO (Maybe (Map.Map ModuleName.Raw I.Interface))
493+loadInterfaces root same cached =
494+ do loading <- traverse (fork . loadInterface root) cached
495+ maybeLoaded <- traverse readMVar loading
496+ case sequence maybeLoaded of
497+ Nothing ->
498+ return Nothing
499+
500+ Just loaded ->
501+ return $ Just $ Map.union (Map.fromList loaded) (Map.fromList same)
502502
503503
504−checkCache :: FilePath -> (ModuleName.Raw, MVar CachedInterface) -> IO (Maybe Dep)
505−checkCache root (name, ciMvar) =
504+loadInterface :: FilePath -> CDep -> IO (Maybe Dep)
505+loadInterface root (name, ciMvar) =
506506 do cachedInterface <- takeMVar ciMvar
507507 case cachedInterface of
508508 Corrupted ->
@@ -529,8 +529,8 @@ checkCache root (name, ciMvar) =
529529-- CHECK PROJECT
530530
531531
532−checkExposedMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> IO (Either Exit.BuildProjectProblem Dependencies)
533−checkExposedMidpoint dmvar statuses =
532+checkMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> IO (Either Exit.BuildProjectProblem Dependencies)
533+checkMidpoint dmvar statuses =
534534 case checkForCycles statuses of
535535 Nothing ->
536536 do maybeForeigns <- readMVar dmvar
@@ -722,7 +722,7 @@ finalizeExposed docsGoal exposed results =
722722 [] ->
723723 case Map.foldr addErrors [] results of
724724 [] -> Right <$> finalizeDocs docsGoal results
725− e:es -> return $ Left $ Exit.BuildModuleProblems e es
725+ e:es -> return $ Left $ Exit.BuildBadModules e es
726726
727727
728728addErrors :: Result -> [Error.Module] -> [Error.Module]
@@ -810,6 +810,93 @@ toDocs result =
810810
811811
812812
813+--------------------------------------------------------------------------------
814+------ NOW FOR SOME REPL STUFF -------------------------------------------------
815+--------------------------------------------------------------------------------
816+
817+
818+-- FROM REPL
819+
820+
821+data ReplArtifacts =
822+ ReplArtifacts
823+ { _repl_home :: ModuleName.Canonical
824+ , _repl_modules :: [Module]
825+ , _repl_localizer :: L.Localizer
826+ , _repl_annotations :: Map.Map Name.Name Can.Annotation
827+ }
828+
829+
830+fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)
831+fromRepl root details source =
832+ let
833+ env@(Env _ _ pkg _ _ _) = makeEnv Reporting.ignorer root details
834+ in
835+ case Parse.fromByteString pkg source of
836+ Left syntaxError ->
837+ return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
838+
839+ Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
840+ do dmvar <- Details.loadInterfaces root details
841+
842+ let deps = map Src.getImportName imports
843+ mvar <- newMVar Map.empty
844+ crawlDeps env mvar deps ()
845+
846+ statuses <- traverse readMVar =<< readMVar mvar
847+ midpoint <- checkMidpoint dmvar statuses
848+
849+ case midpoint of
850+ Left problem ->
851+ return $ Left $ Exit.ReplProjectProblem problem
852+
853+ Right foreigns ->
854+ do rmvar <- newEmptyMVar
855+ resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
856+ putMVar rmvar resultMVars
857+ results <- traverse readMVar resultMVars
858+ writeDetails root details results
859+ depsStatus <- checkDeps root resultMVars deps
860+ finalizeReplArtifacts env source modul depsStatus resultMVars results
861+
862+
863+finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
864+finalizeReplArtifacts env@(Env _ root pkg _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
865+ let
866+ compileInput ifaces =
867+ case Compile.compile pkg ifaces modul of
868+ Right (Compile.Artifacts canonical annotations objects) ->
869+ let
870+ h = Can._name canonical
871+ m = Fresh (Src.getName modul) (I.fromModule pkg canonical annotations) objects
872+ ms = Map.foldrWithKey addInside [] results
873+ in
874+ return $ Right $ ReplArtifacts h (m:ms) (L.fromModule modul) annotations
875+
876+ Left errors ->
877+ return $ Left $ Exit.ReplBadInput source errors
878+ in
879+ case depsStatus of
880+ DepsChange ifaces ->
881+ compileInput ifaces
882+
883+ DepsSame same cached ->
884+ do maybeLoaded <- loadInterfaces root same cached
885+ case maybeLoaded of
886+ Just ifaces -> compileInput ifaces
887+ Nothing -> return $ Left $ Exit.ReplBadCache
888+
889+ DepsBlock ->
890+ case Map.foldr addErrors [] results of
891+ [] -> return $ Left $ Exit.ReplBlocked
892+ e:es -> return $ Left $ Exit.ReplBadLocalDeps e es
893+
894+ DepsNotFound problems ->
895+ return $ Left $ Exit.ReplBadInput source $ Error.BadImports $
896+ toImportErrors env resultMVars imports problems
897+
898+
899+
813900--------------------------------------------------------------------------------
814901--------------------------------------------------------------------------------
815902------ AFTER THIS, EVERYTHING IS ABOUT HANDLING MODULES GIVEN BY FILEPATH ------
@@ -994,14 +1081,10 @@ checkMain env@(Env _ root _ _ _ _) results pendingMain =
9941081 return $ compileOutside env local source ifaces modul
9951082
9961083 DepsSame same cached ->
997− do maybeLoaded <- checkCachedInterfaces root cached
1084+ do maybeLoaded <- loadInterfaces root same cached
9981085 case maybeLoaded of
999− Nothing ->
1000− return ROutsideBlocked
1001−
1002− Just loaded ->
1003− do let ifaces = Map.union loaded (Map.fromList same)
1004− return $ compileOutside env local source ifaces modul
1086+ Nothing -> return ROutsideBlocked
1087+ Just ifaces -> return $ compileOutside env local source ifaces modul
10051088
10061089 DepsBlock ->
10071090 return ROutsideBlocked
@@ -1038,7 +1121,7 @@ toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List M
10381121toArtifacts (Env _ _ pkg _ _ _) foreigns results mainResults =
10391122 case gatherProblemsOrMains results mainResults of
10401123 Left (NE.List e es) ->
1041− Left (Exit.BuildModuleProblems e es)
1124+ Left (Exit.BuildBadModules e es)
10421125
10431126 Right mains ->
10441127 Right $ Artifacts pkg foreigns mains $