Fix package-base interaction (#3139)

- Fixes #3009 
- Fixes #2877
- TODO think if this makes #2985
slightly easier to fix

app/Commands/Format.hs

@@ -52,10 +52,10 @@ formatProject ::
   (Members '[App, EmbedIO, TaggedLock, Logger, Files, Output FormattedFileInfo] r) =>
   Sem r FormatResult
 formatProject = silenceProgressLog . runPipelineOptions . runPipelineSetup $ do
-  pkg <- askPackage
   res :: [(ImportNode, PipelineResult ModuleInfo)] <- processProject
-  res' :: [(ImportNode, SourceCode)] <- runReader pkg . forM res $ \(node, nfo) -> do
-    src <- formatModuleInfo node nfo
+  res' :: [(ImportNode, SourceCode)] <- forM res $ \(node, nfo) -> do
+    pkgId :: PackageId <- (^. entryPointPackageId) <$> ask
+    src <- runReader pkgId (formatModuleInfo node nfo)
     return (node, src)
   formatProjectSourceCode res'
 

app/Commands/Repl.hs

@@ -190,7 +190,7 @@ replCommand opts input_ = catchAll $ do
 
         compileString :: Repl (Maybe Core.Node)
         compileString = do
-          (artifacts, res) <- liftIO $ compileReplInputIO' ctx (strip (pack s))
+          (artifacts, res) <- compileReplInputIO' ctx (strip (pack s))
           res' <- replFromEither res
           State.modify (over (replStateContext . _Just) (set replContextArtifacts artifacts))
           return res'
@@ -199,7 +199,7 @@ core :: String -> Repl ()
 core input_ = do
   ctx <- replGetContext
   opts <- Reader.asks (^. replOptions)
-  compileRes <- liftIO (compileReplInputIO' ctx (strip (pack input_))) >>= replFromEither . snd
+  compileRes <- compileReplInputIO' ctx (strip (pack input_)) >>= replFromEither . snd
   whenJust compileRes (renderOutLn . Core.ppOut opts)
 
 dev :: String -> Repl ()
@@ -484,7 +484,7 @@ replTabComplete = Prefix (wordCompleter optsCompleter) defaultMatcher
 printRoot :: String -> Repl ()
 printRoot _ = do
   r <- State.gets (^. replStateRoot . rootRootDir)
-  liftIO $ putStrLn (pack (toFilePath r))
+  putStrLn (pack (toFilePath r))
 
 runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => ReplOptions -> Sem r ()
 runCommand opts = do
@@ -570,7 +570,7 @@ replExpressionUpToTyped txt = do
       $ expressionUpToTyped P.replPath txt
   replFromEither x
 
-compileReplInputIO' :: ReplContext -> Text -> IO (Artifacts, (Either JuvixError (Maybe Core.Node)))
+compileReplInputIO' :: (MonadIO m) => ReplContext -> Text -> m (Artifacts, (Either JuvixError (Maybe Core.Node)))
 compileReplInputIO' ctx txt =
   runM
     . runState (ctx ^. replContextArtifacts)

app/GlobalOptions.hs

@@ -8,7 +8,7 @@ import CommonOptions
 import Juvix.Compiler.Core.Options qualified as Core
 import Juvix.Compiler.Internal.Pretty.Options qualified as Internal
 import Juvix.Compiler.Pipeline
-import Juvix.Compiler.Pipeline.Root
+import Juvix.Compiler.Pipeline.EntryPoint.IO
 import Juvix.Data.Effect.TaggedLock
 import Juvix.Data.Error.GenericError qualified as E
 import Juvix.Data.Field
@@ -197,9 +197,7 @@ entryPointFromGlobalOptions ::
   Sem r EntryPoint
 entryPointFromGlobalOptions root mainFile opts = do
   mabsBuildDir :: Maybe (Path Abs Dir) <- liftIO (mapM (prepathToAbsDir cwd) optBuildDir)
-  pkg <- readPackageRootIO root
-  let def :: EntryPoint
-      def = defaultEntryPoint pkg root mainFile
+  def <- defaultEntryPointIO (root ^. rootRootDir) mainFile
   return
     def
       { _entryPointNoTermination = opts ^. globalNoTermination,
@@ -220,9 +218,7 @@ entryPointFromGlobalOptions root mainFile opts = do
 entryPointFromGlobalOptionsNoFile :: (Members '[EmbedIO, TaggedLock] r, MonadIO (Sem r)) => Root -> GlobalOptions -> Sem r EntryPoint
 entryPointFromGlobalOptionsNoFile root opts = do
   mabsBuildDir :: Maybe (Path Abs Dir) <- mapM (prepathToAbsDir cwd) optBuildDir
-  pkg <- readPackageRootIO root
-  let def :: EntryPoint
-      def = defaultEntryPointNoFile pkg root
+  def <- defaultEntryPointIO (root ^. rootRootDir) Nothing
   return
     def
       { _entryPointNoTermination = opts ^. globalNoTermination,

src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs

@@ -251,8 +251,8 @@ topTemplate rightMenu' content' = do
 
       packageHeader :: Sem r Html
       packageHeader = do
-        pkgName' <- toHtml <$> asks (^. entryPointPackage . packageName)
-        version' <- toHtml <$> asks (^. entryPointPackage . packageVersion . to prettySemVer)
+        pkgName' <- toHtml <$> asks (^. entryPointPackageId . packageIdName)
+        version' <- toHtml <$> asks (^. entryPointPackageId . packageIdVersion . to prettySemVer)
         return
           $ Html.div
             ! Attr.id "package-header"

src/Juvix/Compiler/Concrete/Translation/FromParsed.hs

@@ -18,7 +18,7 @@ import Juvix.Prelude
 fromParsed ::
   ( Members
       '[ HighlightBuilder,
-         Reader Package,
+         Reader PackageId,
          Reader ModuleTable,
          Reader Parsed.ParserResult,
          Error JuvixError,
@@ -28,7 +28,7 @@ fromParsed ::
   ) =>
   Sem r ScoperResult
 fromParsed = do
-  e <- ask
+  pkg <- ask
   tab <- ask
   r <- ask
-  scopeCheck e (getScopedModuleTable tab) r
+  scopeCheck pkg (getScopedModuleTable tab) r