Check package name conflicts (#3352)

- Progress towards #3331

This pr adds a check that ensures no two packages in the dependency tree
have the same name but different versions. Example error message:
```
/home/jan/projects/juvix/tests/negative/PackageNameConflict/dep2/Package.juvix:1:1: error:
The package dep is used with different versions:
• version 0.11.0-5075d2e2d2ea0ceedb49a53ad8daf559c89cb9c3f86b11853bcc1586907cf3d1
  • at /home/jan/projects/juvix/tests/negative/PackageNameConflict/dep2/
• version 1.0.0-5075d2e2d2ea0ceedb49a53ad8daf559c89cb9c3f86b11853bcc1586907cf3d1
  • at /home/jan/projects/juvix/tests/negative/PackageNameConflict/dep1/
```

I've added a global flag that disables this check:
`--unsafe-ignore-package-name-conflicts`. I've added this flag just in
case some existing Juvix project relied on the existing behaviour. We
should probably remove it in the near future.

Author: janmasrovira

app/App.hs

@@ -298,16 +298,6 @@ runPipeline opts input_ =
   runPipelineLogger opts input_
     . inject
 
-runPipelineRecursive ::
-  forall r.
-  (Members '[App, EmbedIO, Logger, TaggedLock] r) =>
-  Maybe (AppPath File) ->
-  Sem r (InternalTypedResult, [InternalTypedResult])
-runPipelineRecursive input_ = do
-  args <- askArgs
-  entry <- getEntryPoint' args input_
-  runReader defaultPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError
-
 runPipelineHtml ::
   (Members '[App, EmbedIO, Logger, TaggedLock] r) =>
   Bool ->
@@ -320,16 +310,15 @@ runPipelineHtml bNonRecursive input_
   | otherwise = do
       args <- askArgs
       entry <- getEntryPoint' args input_
-      runReader defaultPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError
+      runPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError
 
 runPipelineOptions :: (Members '[App] r) => Sem (Reader PipelineOptions ': r) a -> Sem r a
 runPipelineOptions m = do
   g <- askGlobalOptions
-  let opt =
-        defaultPipelineOptions
-          { _pipelineNumThreads = g ^. globalNumThreads,
-            _pipelineShowThreadId = g ^. globalDevShowThreadIds
-          }
+  let opt = run . execState defaultPipelineOptions $ do
+        modify (set pipelineNumThreads (g ^. globalNumThreads))
+        modify (set (pipelineDependenciesConfig . dependenciesConfigIgnorePackageNameConflicts) (g ^. globalUnsafeIgnorePackageNameConflicts))
+        modify (set pipelineShowThreadId (g ^. globalDevShowThreadIds))
   runReader opt m
 
 runPipelineEntry :: (Members '[App, Logger, EmbedIO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a

app/Commands/Doctor.hs

@@ -7,7 +7,6 @@ import Data.Aeson.TH
 import Juvix.Extra.Clang
 import Juvix.Extra.Version qualified as V
 import Network.HTTP.Simple
-import Safe (headMay)
 import System.Environment qualified as E
 import System.Process qualified as P
 import Text.Read (readMaybe)

app/GlobalOptions.hs

@@ -29,6 +29,7 @@ data GlobalOptions = GlobalOptions
     _globalFieldSize :: Maybe Natural,
     _globalOffline :: Bool,
     _globalLogLevel :: LogLevel,
+    _globalUnsafeIgnorePackageNameConflicts :: Bool,
     _globalDevShowThreadIds :: Bool
   }
   deriving stock (Eq, Show)
@@ -75,6 +76,7 @@ defaultGlobalOptions =
       _globalNoCheck = False,
       _globalFieldSize = Nothing,
       _globalDevShowThreadIds = False,
+      _globalUnsafeIgnorePackageNameConflicts = False,
       _globalOffline = False
     }
 
@@ -155,6 +157,12 @@ parseGlobalFlags = do
                 <> intercalate " < " [show l | l <- allElements @LogLevel]
             )
       )
+  _globalUnsafeIgnorePackageNameConflicts <-
+    switch
+      ( long "unsafe-ignore-package-name-conflicts"
+          <> help "[UNSAFE] Allow the same package to be used with different versions"
+      )
+
   _globalNoCheck <-
     switch
       ( long "dev-no-check"

src/Juvix/Compiler/Core/Transformation/IntToPrimInt.hs

@@ -3,7 +3,6 @@ module Juvix.Compiler.Core.Transformation.IntToPrimInt where
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Transformation.Base
-import Safe (headMay)
 
 data BuiltinIntCtor
   = BuiltinIntCtorOfNat

src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/FunctionCall.hs

@@ -7,7 +7,6 @@ import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Internal.Extra
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination.Data
 import Juvix.Prelude
-import Safe (headMay)
 
 viewCall ::
   forall r.

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

@@ -12,7 +12,7 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver
     findPackageJuvixFiles,
     importNodePackageId,
     mkPackageInfoPackageId,
-    checkConflicts,
+    checkPackageNameConflicts,
   )
 where
 
@@ -41,22 +41,30 @@ import Juvix.Extra.Paths
 import Juvix.Extra.Stdlib (ensureStdlib)
 import Juvix.Prelude
 
-checkConflicts :: forall r'. (Members '[Error JuvixError] r') => [PackageInfo] -> Sem r' ()
-checkConflicts pkgs = do
-  let reps = findRepeatedOn (^. packageInfoPackageId) pkgs
-  case nonEmpty reps of
-    Just (rep :| _) -> errRep rep
-    Nothing -> return ()
+-- | Checks that a package (identified by name) does not appear with different
+-- versions
+checkPackageNameConflicts :: forall r'. (Members '[Error JuvixError] r') => [PackageInfo] -> Sem r' ()
+checkPackageNameConflicts pkgs = do
+  let byname = map fst (findRepeatedOn (^. packageInfoPackageId . packageIdName) pkgs)
+  forM_ byname checkPackageName
   where
-    errRep :: ((PackageInfo, NonEmpty PackageInfo), PackageId) -> Sem r' ()
-    errRep ((p, ps), pid) =
-      throw
-        . JuvixError
-        $ ErrAmbiguousPackageId
-          AmbiguousPackageId
-            { _ambiguousPackageId = pid,
-              _ambiguousPackageIdPackages = NonEmpty.cons p ps
-            }
+    checkPackageName :: (PackageInfo, NonEmpty PackageInfo) -> Sem r' ()
+    checkPackageName (pkg, others) = ignoreFail $ do
+      pkgsDiffVer :: NonEmpty PackageInfo <- failMaybe (nonEmpty (filter ((/= ver) . getVer) (toList others)))
+      let indexedByVer :: HashMap SemVer (NonEmpty PackageInfo) = indexedByHashList getVer pkgsDiffVer
+      diffVers :: NonEmpty (SemVer, NonEmpty PackageInfo) <- failMaybe (nonEmpty (HashMap.toList indexedByVer))
+      let diffVers' :: NonEmpty (SemVer, NonEmpty (Path Abs Dir)) =
+            over (each . _2 . each) (^. packageRoot) diffVers
+      throw . JuvixError . ErrPackageNameConflict $
+        PackageNameConflict
+          { _packageNameConflictPackage = pkg,
+            _packageNameConflictVersions = NonEmpty.cons (ver, pure (pkg ^. packageRoot)) diffVers'
+          }
+      where
+        getVer = (^. packageInfoPackageId . packageIdVersion)
+
+        ver :: SemVer
+        ver = getVer pkg
 
 mkPackage ::
   forall r.
@@ -470,9 +478,8 @@ runPathResolver2 st topEnv arg = do
       handler
     )
     $ do
-      _pkgs <- toList <$> getPackageInfos
-      -- I think we should not check for conflicts
-      -- checkConflicts pkgs
+      pkgs <- toList <$> getPackageInfos
+      unless (depsConfig ^. dependenciesConfigIgnorePackageNameConflicts) (checkPackageNameConflicts pkgs)
       arg
   where
     handler ::

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

@@ -2,11 +2,16 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver.DependenciesConfig where
 
 import Juvix.Prelude.Base
 
-newtype DependenciesConfig = DependenciesConfig
-  { _dependenciesConfigForceUpdateLockfile :: Bool
+data DependenciesConfig = DependenciesConfig
+  { _dependenciesConfigForceUpdateLockfile :: Bool,
+    _dependenciesConfigIgnorePackageNameConflicts :: Bool
   }
 
 defaultDependenciesConfig :: DependenciesConfig
-defaultDependenciesConfig = DependenciesConfig {_dependenciesConfigForceUpdateLockfile = False}
+defaultDependenciesConfig =
+  DependenciesConfig
+    { _dependenciesConfigForceUpdateLockfile = False,
+      _dependenciesConfigIgnorePackageNameConflicts = False
+    }
 
 makeLenses ''DependenciesConfig

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

@@ -94,9 +94,7 @@ data PathResolverError
   = ErrDependencyConflict DependencyConflict
   | ErrMissingModule MissingModule
   | ErrPackageInvalidImport PackageInvalidImport
-  | -- | The ErrAmbiguousPackageId error is unused at the moment. We append the
-    -- hash of all project files to the pre-release tag of the package version.
-    ErrAmbiguousPackageId AmbiguousPackageId
+  | ErrPackageNameConflict PackageNameConflict
   deriving stock (Show)
 
 instance ToGenericError PathResolverError where
@@ -118,14 +116,14 @@ instance HasLoc PathResolverError where
       getLoc _missingModule
     ErrPackageInvalidImport PackageInvalidImport {..} ->
       getLoc _packageInvalidImport
-    ErrAmbiguousPackageId a -> getLoc a
+    ErrPackageNameConflict a -> getLoc a
 
 instance PrettyCodeAnn PathResolverError where
   ppCodeAnn = \case
     ErrDependencyConflict e -> ppCodeAnn e
     ErrMissingModule e -> ppCodeAnn e
     ErrPackageInvalidImport e -> ppCodeAnn e
-    ErrAmbiguousPackageId e -> ppCodeAnn e
+    ErrPackageNameConflict e -> ppCodeAnn e
 
 data DependencyConflict = DependencyConflict
   { _conflictPackages :: NonEmpty PackageInfo,
@@ -191,21 +189,28 @@ instance PrettyCodeAnn PackageInvalidImport where
         <> line
         <> "Package files may only import modules from the Juvix standard library, Juvix.Builtin modules, or from the PackageDescription module."
 
-data AmbiguousPackageId = AmbiguousPackageId
-  { _ambiguousPackageId :: PackageId,
-    _ambiguousPackageIdPackages :: NonEmpty PackageInfo
+data PackageNameConflict = PackageNameConflict
+  { _packageNameConflictPackage :: PackageInfo,
+    -- | Must contain at least two elements
+    _packageNameConflictVersions :: NonEmpty (SemVer, NonEmpty (Path Abs Dir))
   }
   deriving stock (Show)
 
-instance HasLoc AmbiguousPackageId where
-  getLoc AmbiguousPackageId {..} = intervalFromFile ((head _ambiguousPackageIdPackages) ^. packageRoot <//> packageFilePath)
+instance HasLoc PackageNameConflict where
+  getLoc PackageNameConflict {..} = intervalFromFile (_packageNameConflictPackage ^. packageRoot <//> packageFilePath)
 
-instance PrettyCodeAnn AmbiguousPackageId where
-  ppCodeAnn AmbiguousPackageId {..} = do
-    "Ambiguous package id:"
-      <> line
-      <> ppCodeAnn _ambiguousPackageId
-      <> line
-      <> "The above package id is the same for the following packages"
-      <> line
-      <> itemize ((pretty . (^. packageRoot)) <$> _ambiguousPackageIdPackages)
+instance PrettyCodeAnn PackageNameConflict where
+  ppCodeAnn PackageNameConflict {..} = do
+    "The package"
+      <+> important (pretty pkgName)
+      <+> "is used with different versions:"
+        <> line
+        <> itemize
+          [ "version"
+              <+> (important . pretty . prettySemVer $ ver)
+                <> line
+                <> indent' (itemize ["at" <+> important (pretty p) | p <- toList paths])
+            | (ver, paths) <- toList _packageNameConflictVersions
+          ]
+    where
+      pkgName = _packageNameConflictPackage ^. packageInfoPackageId . packageIdName

src/Juvix/Compiler/Pipeline/Repl.hs

@@ -20,9 +20,10 @@ import Juvix.Compiler.Pipeline.Driver
 import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Compiler.Pipeline.Loader.PathResolver
 import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree (withImportTree)
+import Juvix.Compiler.Pipeline.Options
 import Juvix.Compiler.Pipeline.Package.Loader.Error
 import Juvix.Compiler.Pipeline.Package.Loader.EvalEff.IO
-import Juvix.Compiler.Pipeline.Run (defaultPipelineOptions, evalModuleInfoCacheHelper)
+import Juvix.Compiler.Pipeline.Run (evalModuleInfoCacheHelper)
 import Juvix.Compiler.Store.Extra qualified as Store
 import Juvix.Data.Effect.Git
 import Juvix.Data.Effect.Process (runProcessIO)
@@ -183,7 +184,7 @@ compileReplInputIO fp txt = do
     . mapError (JuvixError @PackageLoaderError)
     . runEvalFileEffIO
     . runDependencyResolver
-    . runReader defaultDependenciesConfig
+    . mapReader (^. pipelineDependenciesConfig)
     . runPathResolverArtifacts
     . runTopModuleNameChecker
     . runReader defaultImportScanStrategy

src/Juvix/Compiler/Pipeline/Run.hs

@@ -10,7 +10,7 @@ import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper
 import Juvix.Compiler.Concrete.Translation.FromSource qualified as P
 import Juvix.Compiler.Concrete.Translation.FromSource.TopModuleNameChecker (TopModuleNameChecker, runTopModuleNameChecker)
-import Juvix.Compiler.Concrete.Translation.ImportScanner (ImportScanStrategy, defaultImportScanStrategy)
+import Juvix.Compiler.Concrete.Translation.ImportScanner (ImportScanStrategy)
 import Juvix.Compiler.Core.Data.Module qualified as Core
 import Juvix.Compiler.Core.Translation.FromInternal.Data qualified as Core
 import Juvix.Compiler.Internal.Translation qualified as Internal
@@ -213,7 +213,7 @@ runReplPipelineIOEither' lockMode entry = do
       . runReader defaultPipelineOptions
       . runLoggerIO replLoggerOptions
       . runConcurrent
-      . runReader defaultNumThreads
+      . mapReader (^. pipelineNumThreads)
       . evalInternet hasInternet
       . evalHighlightBuilder
       . runError
@@ -229,10 +229,10 @@ runReplPipelineIOEither' lockMode entry = do
       . mapError (JuvixError @PackageLoaderError)
       . runEvalFileEffIO
       . runDependencyResolver
-      . runReader defaultDependenciesConfig
+      . mapReader (^. pipelineDependenciesConfig)
       . runPathResolver'
       . runTopModuleNameChecker
-      . runReader defaultImportScanStrategy
+      . mapReader (^. pipelineImportStrategy)
       . withImportTree (entry ^. entryPointModulePath)
       . runMigration
       . evalModuleInfoCacheHelper

src/Juvix/Data/CodeAnn.hs

@@ -3,6 +3,7 @@ module Juvix.Data.CodeAnn
     module Juvix.Data.NameKind,
     module Juvix.Prelude.Pretty,
     module Juvix.Data.CodeReference,
+    module Data.Versions,
   )
 where
 
@@ -258,6 +259,9 @@ kwDot = delimiter "."
 kwAt :: Doc Ann
 kwAt = keyword Str.at_
 
+important :: Doc Ann -> Doc Ann
+important = annotate AnnImportant
+
 code :: Doc Ann -> Doc Ann
 code = annotate AnnCode