use PackageId

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/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/Pipeline/Driver.hs

@@ -301,7 +301,7 @@ processRecursiveUpToTyped = do
   let imports = HashMap.keys (_pipelineResultImports ^. Store.moduleTable)
   ms <- forM imports $ \imp ->
     withPathFile imp goImport
-  let pkg = entry ^. entryPointPackage
+  let pkg = entry ^. entryPointPackageId
   mid <- runReader pkg (getModuleId (_pipelineResult ^. Parser.resultModule . modulePath . to topModulePathKey))
   a <-
     evalTopNameIdGen mid
@@ -361,7 +361,7 @@ processFileUpTo ::
 processFileUpTo a = do
   entry <- ask
   res <- processFileUpToParsing entry
-  let pkg = entry ^. entryPointPackage
+  let pkg = entry ^. entryPointPackageId
   mid <- runReader pkg (getModuleId (res ^. pipelineResult . Parser.resultModule . modulePath . to topModulePathKey))
   a' <-
     evalTopNameIdGen mid
@@ -416,7 +416,7 @@ processFileToStoredCore ::
   Sem r (PipelineResult Core.CoreResult)
 processFileToStoredCore entry = runReader entry $ do
   res <- processFileUpToParsing entry
-  let pkg = entry ^. entryPointPackage
+  let pkg = entry ^. entryPointPackageId
   mid <- runReader pkg (getModuleId (res ^. pipelineResult . Parser.resultModule . modulePath . to topModulePathKey))
   r <-
     evalTopNameIdGen mid

src/Juvix/Compiler/Pipeline/EntryPoint/IO.hs

@@ -5,14 +5,14 @@ import Juvix.Compiler.Pipeline.Root
 import Juvix.Data.Effect.TaggedLock
 import Juvix.Prelude
 
-defaultEntryPointIO :: (Members '[EmbedIO, TaggedLock, EmbedIO] r) => Path Abs Dir -> Path Abs File -> Sem r EntryPoint
+defaultEntryPointIO :: forall r. (Members '[EmbedIO, TaggedLock, EmbedIO] r) => Path Abs Dir -> Maybe (Path Abs File) -> Sem r EntryPoint
 defaultEntryPointIO cwd mainFile = do
-  root <- findRootAndChangeDir (Just (parent mainFile)) Nothing cwd
-  pkg <- readPackageRootIO root
-  return (defaultEntryPoint pkg root (Just mainFile))
-
-defaultEntryPointNoFileIO :: (Members '[EmbedIO, TaggedLock, EmbedIO] r) => Path Abs Dir -> Sem r EntryPoint
-defaultEntryPointNoFileIO cwd = do
-  root <- findRootAndChangeDir Nothing Nothing cwd
-  pkg <- readPackageRootIO root
-  return (defaultEntryPointNoFile pkg root)
+  root <- findRootAndChangeDir (parent <$> mainFile) Nothing cwd
+  let pkgIdFromPackageFile :: Sem r PackageId
+      pkgIdFromPackageFile = (^. packageId) <$> readPackageRootIO root
+  pkgId <- case root ^. rootSomeRoot . someRootType of
+    GlobalStdlib -> pkgIdFromPackageFile
+    GlobalPackageDescription -> pkgIdFromPackageFile
+    LocalPackage -> pkgIdFromPackageFile
+    GlobalPackageBase -> return packageBaseId
+  return (defaultEntryPoint pkgId root mainFile)

src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs

@@ -28,7 +28,7 @@ import Juvix.Compiler.Pipeline.Loader.PathResolver.Paths
 import Juvix.Compiler.Pipeline.Lockfile
 import Juvix.Compiler.Pipeline.Package
 import Juvix.Compiler.Pipeline.Package.Loader.EvalEff
-import Juvix.Compiler.Pipeline.Root.Base (PackageType (..))
+import Juvix.Compiler.Pipeline.Root.Base hiding (rootBuildDir)
 import Juvix.Data.SHA256 qualified as SHA256
 import Juvix.Extra.Files
 import Juvix.Extra.PackageFiles
@@ -39,22 +39,12 @@ import Juvix.Prelude
 mkPackage ::
   forall r.
   (Members '[Files, Error JuvixError, Reader ResolverEnv, DependencyResolver, EvalFileEff] r) =>
-  Maybe EntryPoint ->
+  Maybe BuildDir ->
   Path Abs Dir ->
   Sem r Package
-mkPackage mpackageEntry _packageRoot = do
-  let buildDirDep = case mpackageEntry of
-        Just packageEntry -> rootedBuildDir _packageRoot (packageEntry ^. entryPointBuildDir)
-        Nothing -> DefaultBuildDir
-  maybe (readPackage _packageRoot buildDirDep) (return . (^. entryPointPackage)) mpackageEntry
-
-mkPackageLike ::
-  forall r.
-  (Members '[Files, Error JuvixError, Reader ResolverEnv, DependencyResolver, EvalFileEff] r) =>
-  Maybe EntryPoint ->
-  Path Abs Dir ->
-  Sem r PackageLike
-mkPackageLike mpackageEntry _packageRoot = undefined
+mkPackage mpackageBuildDir _packageRoot = do
+  let buildDirDep = fromMaybe DefaultBuildDir mpackageBuildDir
+  readPackage _packageRoot buildDirDep
 
 findPackageJuvixFiles :: (Members '[Files] r) => Path Abs Dir -> Sem r [Path Rel File]
 findPackageJuvixFiles pkgRoot = map (fromJust . stripProperPrefix pkgRoot) <$> walkDirRelAccum juvixAccum pkgRoot []
@@ -190,7 +180,8 @@ registerDependencies' conf = do
       LocalPackage -> do
         lockfile <- addRootDependency conf e (e ^. entryPointRoot)
         whenM shouldWriteLockfile $ do
-          packageFileChecksum <- SHA256.digestFile (e ^. entryPointPackage . packageFile)
+          let packagePath :: Path Abs File = mkPackagePath (e ^. entryPointSomeRoot . someRootDir)
+          packageFileChecksum <- SHA256.digestFile packagePath
           lockfilePath' <- lockfilePath
           writeLockfile lockfilePath' packageFileChecksum lockfile
   where
@@ -224,7 +215,7 @@ addRootDependency conf e root = do
   checkRemoteDependency resolvedDependency
   let p = resolvedDependency ^. resolvedDependencyPath
   withEnvInitialRoot p $ do
-    pkg <- mkPackage (Just e) p
+    pkg <- mkPackage (Just (e ^. entryPointBuildDir)) p
     shouldUpdateLockfile' <- shouldUpdateLockfile pkg
     when shouldUpdateLockfile' setShouldUpdateLockfile
     let resolvedPkg :: Package
@@ -253,7 +244,7 @@ addDependency me d = do
   case cached of
     Just cachedDep -> return cachedDep
     Nothing -> withEnvRoot p $ do
-      pkg <- mkPackage me p
+      pkg <- mkPackage ((^. entryPointBuildDir) <$> me) p
       addDependency' pkg me resolvedDependency
 
 addPackageRelativeFiles :: (Member (State ResolverState) r) => PackageInfo -> Sem r ()

src/Juvix/Compiler/Pipeline/Loader/PathResolver/Base.hs

@@ -46,6 +46,17 @@ makeLenses ''RootInfo
 makeLenses ''PathInfoTopModule
 makeSem ''PathResolver
 
+-- getCurrentPackageInfo :: (Members '[PathResolver] r) => Sem r PackageInfo
+-- getCurrentPackageInfo = do
+--   tbl <- getPackageInfos
+--   r <- resolverRoot
+--   let err =
+--         impossibleError
+--           ( "The current root has not been registered as a package.\nCurrent root = "
+--               <> show r
+--           )
+--   return (fromMaybe err (tbl ^. at r))
+
 withPathFile ::
   (Members '[PathResolver] r) =>
   TopModulePath ->

src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs

@@ -9,6 +9,7 @@ import Data.Versions
 import Juvix.Compiler.Concrete.Translation.ImportScanner.Base
 import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Data.CodeAnn
+import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
 
 data PackageLike
@@ -46,11 +47,11 @@ packageLikeName :: SimpleGetter PackageLike Text
 packageLikeName = to $ \case
   PackageReal r -> r ^. packageName
   PackageGlobalStdlib -> "global-stdlib"
-  PackageBase -> "package-base"
+  PackageBase -> Str.packageBase
   PackageType -> "package-type"
   PackageDotJuvix -> "package-dot-juvix"
 
--- | TODO perhaps we could versions for the non-real packages
+-- | FIXME all PackageLike should have versions
 packageLikeVersion :: SimpleGetter PackageLike (Maybe SemVer)
 packageLikeVersion = to $ \case
   PackageReal pkg -> Just (pkg ^. packageVersion)

src/Juvix/Compiler/Pipeline/Package/Base.hs

@@ -11,6 +11,7 @@ import Data.Versions hiding (Lens')
 import Juvix.Compiler.Pipeline.Lockfile
 import Juvix.Compiler.Pipeline.Package.Dependency
 import Juvix.Extra.Paths
+import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
 
 data BuildDir
@@ -47,7 +48,7 @@ data PackageId = PackageId
   { _packageIdName :: Text,
     _packageIdVersion :: SemVer
   }
-  deriving stock (Eq, Show)
+  deriving stock (Show, Eq)
 
 data Package' (s :: IsProcessed) = Package
   { _packageName :: NameType s,
@@ -76,7 +77,20 @@ deriving stock instance Show RawPackage
 deriving stock instance Show Package
 
 packageId :: Lens' Package PackageId
-packageId = undefined
+packageId (g :: PackageId -> f PackageId) pkg =
+  let pkgId =
+        PackageId
+          { _packageIdName = pkg ^. packageName,
+            _packageIdVersion = pkg ^. packageVersion
+          }
+   in toPackage <$> g pkgId
+  where
+    toPackage :: PackageId -> Package
+    toPackage pkgid =
+      pkg
+        { _packageName = pkgid ^. packageIdName,
+          _packageVersion = pkgid ^. packageIdVersion
+        }
 
 rawPackageOptions :: Options
 rawPackageOptions =
@@ -169,6 +183,13 @@ globalPackage p =
       _packageLockfile = Nothing
     }
 
+packageBaseId :: PackageId
+packageBaseId =
+  PackageId
+    { _packageIdName = Str.packageBase,
+      _packageIdVersion = defaultVersion
+    }
+
 mkPackageFilePath :: Path Abs Dir -> Path Abs File
 mkPackageFilePath = (<//> juvixYamlFile)
 

src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs

@@ -152,23 +152,24 @@ loadPackage' packagePath = do
     packageEntryPoint :: EntryPoint
     packageEntryPoint = defaultEntryPoint rootPkg root (Just packagePath)
       where
+        sroot :: SomeRoot
+        sroot =
+          SomeRoot
+            { _someRootDir = rootPath,
+              _someRootType = GlobalPackageDescription
+            }
+
         root :: Root
         root =
           Root
-            { _rootRootDir = rootPath,
-              _rootPackageType = GlobalPackageDescription,
+            { _rootSomeRoot = sroot,
               _rootInvokeDir = rootPath,
               _rootBuildDir = DefaultBuildDir
             }
 
-        rootPkg :: Package
+        rootPkg :: PackageId
         rootPkg =
-          Package
-            { _packageVersion = defaultVersion,
-              _packageName = "Package",
-              _packageMain = Nothing,
-              _packageLockfile = Nothing,
-              _packageFile = packagePath,
-              _packageDependencies = [],
-              _packageBuildDir = Nothing
+          PackageId
+            { _packageIdVersion = defaultVersion,
+              _packageIdName = "Package"
             }

src/Juvix/Compiler/Pipeline/Repl.hs

@@ -37,7 +37,7 @@ upToInternalExpression ::
 upToInternalExpression p = do
   scopeTable <- gets (^. artifactScopeTable)
   mtab <- gets (^. artifactModuleTable)
-  pkg <- asks (^. entryPointPackage)
+  pkg <- asks (^. entryPointPackageId)
   runScoperScopeArtifacts
     . runStateArtifacts artifactScoperState
     . runReader pkg
@@ -63,7 +63,7 @@ expressionUpToAtomsScoped ::
 expressionUpToAtomsScoped fp txt = do
   scopeTable <- gets (^. artifactScopeTable)
   mtab <- gets (^. artifactModuleTable)
-  pkg <- asks (^. entryPointPackage)
+  pkg <- asks (^. entryPointPackageId)
   runScoperScopeArtifacts
     . runStateArtifacts artifactScoperState
     . runNameIdGenArtifacts
@@ -78,7 +78,7 @@ scopeCheckExpression ::
 scopeCheckExpression p = do
   scopeTable <- gets (^. artifactScopeTable)
   mtab <- gets (^. artifactModuleTable)
-  pkg <- asks (^. entryPointPackage)
+  pkg <- asks (^. entryPointPackageId)
   runNameIdGenArtifacts
     . runScoperScopeArtifacts
     . runStateArtifacts artifactScoperState
@@ -129,7 +129,7 @@ registerImport i = do
   modify' (appendArtifactsModuleTable mtab')
   scopeTable <- gets (^. artifactScopeTable)
   mtab'' <- gets (^. artifactModuleTable)
-  pkg <- asks (^. entryPointPackage)
+  pkg <- asks (^. entryPointPackageId)
   void
     . runNameIdGenArtifacts
     . runScoperScopeArtifacts

src/Juvix/Compiler/Pipeline/Root.hs

@@ -50,22 +50,35 @@ findRootAndChangeDir minputFileDir mbuildDir _rootInvokeDir = do
         Nothing -> do
           let cwd = fromMaybe _rootInvokeDir minputFileDir
           packageBaseRootDir <- runFilesIO globalPackageBaseRoot
-          (_rootRootDir, _rootPackageType) <-
+          _rootSomeRoot <-
             if
                 | isPathPrefix packageBaseRootDir cwd ->
-                    return (packageBaseRootDir, GlobalPackageBase)
+                    return
+                      SomeRoot
+                        { _someRootDir = packageBaseRootDir,
+                          _someRootType = GlobalPackageBase
+                        }
                 | otherwise -> do
                     r <- runFilesIO globalRoot
-                    return (r, GlobalStdlib)
+                    return
+                      SomeRoot
+                        { _someRootDir = r,
+                          _someRootType = GlobalStdlib
+                        }
           let _rootBuildDir = getBuildDir mbuildDir
           return Root {..}
         Just pkgPath -> do
           packageDescriptionRootDir <- runFilesIO globalPackageDescriptionRoot
-          let _rootRootDir = parent pkgPath
-              _rootPackageType
-                | isPathPrefix packageDescriptionRootDir _rootRootDir = GlobalPackageDescription
-                | otherwise = LocalPackage
-              _rootBuildDir = getBuildDir mbuildDir
+          let _rootBuildDir = getBuildDir mbuildDir
+              rootdir = parent pkgPath
+              _rootSomeRoot =
+                SomeRoot
+                  { _someRootDir = rootdir,
+                    _someRootType =
+                      if
+                          | isPathPrefix packageDescriptionRootDir rootdir -> GlobalPackageDescription
+                          | otherwise -> LocalPackage
+                  }
           return Root {..}
 
 getBuildDir :: Maybe (Path Abs Dir) -> BuildDir