Run test suite in parallel

Makefile

@@ -23,7 +23,7 @@ METAFILES:=README.md \
 			 LICENSE.md
 
 STACKFLAGS?=--jobs $(THREADS)
-STACKTESTFLAGS?=--ta --hide-successes --ta --ansi-tricks=false
+STACKTESTFLAGS?=--ta --hide-successes --ta --ansi-tricks=false --ta "+RTS -N -RTS"
 SMOKEFLAGS?=--color --diff=git
 STACK?=stack
 

app/Commands/Init.hs

@@ -6,6 +6,7 @@ import Data.Text qualified as Text
 import Data.Versions
 import Juvix.Compiler.Pipeline.Package
 import Juvix.Data.Effect.Fail.Extra qualified as Fail
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Extra.Paths
 import Juvix.Prelude
 import Juvix.Prelude.Pretty
@@ -60,7 +61,7 @@ checkNotInProject =
 checkPackage :: forall r. (Members '[Embed IO] r) => Sem r ()
 checkPackage = do
   cwd <- getCurrentDir
-  ep <- runError @JuvixError (loadPackageFileIO cwd DefaultBuildDir)
+  ep <- runError @JuvixError (runTaggedLockPermissive (loadPackageFileIO cwd DefaultBuildDir))
   case ep of
     Left {} -> do
       say "Package.juvix is invalid. Please raise an issue at https://github.com/anoma/juvix/issues"

app/Commands/Repl.hs

@@ -39,6 +39,7 @@ import Juvix.Compiler.Pipeline.Setup (entrySetup)
 import Juvix.Data.CodeAnn (Ann)
 import Juvix.Data.Effect.Git
 import Juvix.Data.Effect.Process
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Data.Error.GenericError qualified as Error
 import Juvix.Data.NameKind
 import Juvix.Extra.Paths qualified as P
@@ -152,6 +153,7 @@ loadDefaultPrelude = whenJustM defaultPreludeEntryPoint $ \e -> do
     . runFilesIO
     . runError @JuvixError
     . runReader e
+    . runTaggedLockPermissive
     . runLogIO
     . runProcessIO
     . runError @GitProcessError

app/Main.hs

@@ -7,6 +7,7 @@ import CommonOptions
 import Data.String.Interpolate (i)
 import GlobalOptions
 import Juvix.Compiler.Pipeline.Root
+import Juvix.Data.Effect.TaggedLock
 import TopCommand
 import TopCommand.Options
 
@@ -18,7 +19,7 @@ main = do
   mbuildDir <- mapM (prepathToAbsDir invokeDir) (_runAppIOArgsGlobalOptions ^? globalBuildDir . _Just . pathPath)
   mainFile <- topCommandInputPath cli
   mapM_ checkMainFile mainFile
-  _runAppIOArgsRoot <- findRootAndChangeDir (containingDir <$> mainFile) mbuildDir invokeDir
+  _runAppIOArgsRoot <- findRootAndChangeDir LockModePermissive (containingDir <$> mainFile) mbuildDir invokeDir
   runFinal
     . resourceToIOFinal
     . embedToFinal @IO

package.yaml

@@ -54,6 +54,7 @@ dependencies:
   - exceptions == 0.10.*
   - extra == 1.7.*
   - file-embed == 0.0.*
+  - filelock == 0.1.*
   - filepath == 1.4.*
   - githash == 0.1.*
   - hashable == 1.4.*
@@ -174,6 +175,8 @@ tests:
       - juvix
     verbatim:
       default-language: GHC2021
+    ghc-options:
+      - -threaded
 
 benchmarks:
   juvix-bench:

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

@@ -25,6 +25,7 @@ import Juvix.Compiler.Pipeline.Lockfile
 import Juvix.Compiler.Pipeline.Package
 import Juvix.Compiler.Pipeline.Package.Loader.EvalEff
 import Juvix.Data.Effect.Git
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Extra.Paths
 import Juvix.Extra.Stdlib (ensureStdlib)
 import Juvix.Prelude
@@ -43,7 +44,7 @@ mkPackage mpackageEntry _packageRoot = do
 
 mkPackageInfo ::
   forall r.
-  (Members '[Files, Error JuvixError, Reader ResolverEnv, Error DependencyError, GitClone] r) =>
+  (Members '[TaggedLock, Files, Error JuvixError, Reader ResolverEnv, Error DependencyError, GitClone] r) =>
   Maybe EntryPoint ->
   Path Abs Dir ->
   Package ->
@@ -162,7 +163,7 @@ resolveDependency i = case i ^. packageDepdendencyInfoDependency of
 
 registerDependencies' ::
   forall r.
-  (Members '[Reader EntryPoint, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, Reader EntryPoint, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
   DependenciesConfig ->
   Sem r ()
 registerDependencies' conf = do
@@ -186,7 +187,7 @@ registerDependencies' conf = do
 
 addRootDependency ::
   forall r.
-  (Members '[State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
   DependenciesConfig ->
   EntryPoint ->
   Path Abs Dir ->
@@ -207,7 +208,7 @@ addRootDependency conf e root = do
 
 addDependency ::
   forall r.
-  (Members '[State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
   Maybe EntryPoint ->
   PackageDependencyInfo ->
   Sem r LockfileDependency
@@ -224,7 +225,7 @@ addDependency me d = do
 
 addDependency' ::
   forall r.
-  (Members '[State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
   Package ->
   Maybe EntryPoint ->
   ResolvedDependency ->
@@ -314,7 +315,7 @@ expectedPath' actualPath m = do
 
 re ::
   forall r a.
-  (Members '[Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
   Sem (PathResolver ': r) a ->
   Sem (Reader ResolverEnv ': State ResolverState ': r) a
 re = reinterpret2H helper
@@ -337,13 +338,13 @@ re = reinterpret2H helper
               Right (r, _) -> r
         raise (evalPathResolver' st' root' (a' x'))
 
-evalPathResolver' :: (Members '[Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => ResolverState -> Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
+evalPathResolver' :: (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => ResolverState -> Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
 evalPathResolver' st root = fmap snd . runPathResolver' st root
 
-runPathResolver :: (Members '[Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPathResolver :: (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPathResolver = runPathResolver' iniResolverState
 
-runPathResolver' :: (Members '[Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => ResolverState -> Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPathResolver' :: (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => ResolverState -> Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPathResolver' st root x = do
   e <- ask
   let _envSingleFile :: Maybe (Path Abs File)
@@ -359,15 +360,15 @@ runPathResolver' st root x = do
           }
   runState st (runReader env (re x))
 
-runPathResolverPipe' :: (Members '[Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => ResolverState -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPathResolverPipe' :: (Members '[TaggedLock, Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => ResolverState -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPathResolverPipe' iniState a = do
   r <- asks (^. entryPointResolverRoot)
   runPathResolver' iniState r a
 
-runPathResolverPipe :: (Members '[Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPathResolverPipe :: (Members '[TaggedLock, Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPathResolverPipe a = do
   r <- asks (^. entryPointResolverRoot)
   runPathResolver r a
 
-evalPathResolverPipe :: (Members '[Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r a
+evalPathResolverPipe :: (Members '[TaggedLock, Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r a
 evalPathResolverPipe = fmap snd . runPathResolverPipe

src/Juvix/Compiler/Pipeline.hs

@@ -37,11 +37,12 @@ import Juvix.Compiler.Reg.Data.InfoTable qualified as Reg
 import Juvix.Compiler.Reg.Translation.FromAsm qualified as Reg
 import Juvix.Data.Effect.Git
 import Juvix.Data.Effect.Process
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Prelude
 
-type PipelineEff = '[PathResolver, EvalFileEff, Error PackageLoaderError, Error DependencyError, GitClone, Error GitProcessError, Process, Log, Reader EntryPoint, Files, NameIdGen, Builtins, Error JuvixError, HighlightBuilder, Internet, Embed IO]
+type PipelineEff = '[PathResolver, EvalFileEff, Error PackageLoaderError, Error DependencyError, GitClone, Error GitProcessError, Process, Log, TaggedLock, Reader EntryPoint, Files, NameIdGen, Builtins, Error JuvixError, HighlightBuilder, Internet, Embed IO, Resource, Final IO]
 
-type TopPipelineEff = '[PathResolver, EvalFileEff, Error PackageLoaderError, Error DependencyError, GitClone, Error GitProcessError, Process, Log, Reader EntryPoint, Files, NameIdGen, Builtins, State Artifacts, Error JuvixError, HighlightBuilder, Embed IO]
+type TopPipelineEff = '[PathResolver, EvalFileEff, Error PackageLoaderError, Error DependencyError, GitClone, Error GitProcessError, Process, Log, TaggedLock, Reader EntryPoint, Files, NameIdGen, Builtins, State Artifacts, Error JuvixError, HighlightBuilder, Embed IO, Resource, Final IO]
 
 --------------------------------------------------------------------------------
 -- Workflows

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

@@ -6,10 +6,11 @@ import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Compiler.Pipeline.Package.Loader.EvalEff
 import Juvix.Compiler.Pipeline.Package.Loader.PathResolver
 import Juvix.Data.Effect.Git
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Prelude
 
-runPathResolverArtifacts :: (Members '[Files, Reader EntryPoint, State Artifacts, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r a
+runPathResolverArtifacts :: (Members '[TaggedLock, Files, Reader EntryPoint, State Artifacts, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r a
 runPathResolverArtifacts = runStateLikeArtifacts runPathResolverPipe' artifactResolver
 
-runPackagePathResolverArtifacts :: (Members '[Files, Reader EntryPoint, State Artifacts, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
+runPackagePathResolverArtifacts :: (Members '[TaggedLock, Files, Reader EntryPoint, State Artifacts, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
 runPackagePathResolverArtifacts root = runStateLikeArtifacts (runPackagePathResolver'' root) artifactResolver

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

@@ -2,16 +2,21 @@ module Juvix.Compiler.Pipeline.EntryPoint.IO where
 
 import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Compiler.Pipeline.Root
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Prelude
 
-defaultEntryPointCwdIO :: Path Abs File -> IO EntryPoint
-defaultEntryPointCwdIO mainFile = do
-  cwd <- getCurrentDir
-  root <- findRootAndChangeDir (Just (parent mainFile)) Nothing cwd
+defaultEntryPointIO :: Path Abs Dir -> Path Abs File -> IO EntryPoint
+defaultEntryPointIO = defaultEntryPointIO' LockModePermissive
+
+defaultEntryPointIO' :: LockMode -> Path Abs Dir -> Path Abs File -> IO EntryPoint
+defaultEntryPointIO' lockMode cwd mainFile = do
+  root <- findRootAndChangeDir lockMode (Just (parent mainFile)) Nothing cwd
   return (defaultEntryPoint root mainFile)
 
-defaultEntryPointNoFileCwdIO :: IO EntryPoint
-defaultEntryPointNoFileCwdIO = do
-  cwd <- getCurrentDir
-  root <- findRootAndChangeDir Nothing Nothing cwd
+defaultEntryPointNoFileIO :: Path Abs Dir -> IO EntryPoint
+defaultEntryPointNoFileIO = defaultEntryPointNoFileIO' LockModePermissive
+
+defaultEntryPointNoFileIO' :: LockMode -> Path Abs Dir -> IO EntryPoint
+defaultEntryPointNoFileIO' lockMode cwd = do
+  root <- findRootAndChangeDir lockMode Nothing Nothing cwd
   return (defaultEntryPointNoFile root)

src/Juvix/Compiler/Pipeline/Package.hs

@@ -18,6 +18,7 @@ import Juvix.Compiler.Pipeline.Package.Loader
 import Juvix.Compiler.Pipeline.Package.Loader.Error
 import Juvix.Compiler.Pipeline.Package.Loader.EvalEff
 import Juvix.Compiler.Pipeline.Package.Loader.EvalEff.IO
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Extra.Paths
 import Juvix.Prelude
 
@@ -124,35 +125,41 @@ readPackageFile root buildDir f = mapError (JuvixError @PackageLoaderError) $ do
   checkNoDuplicateDepNames f (pkg ^. packageDependencies)
   return (pkg {_packageLockfile = mLockfile})
 
-loadPackageFileIO :: (Members '[Error JuvixError, Embed IO] r) => Path Abs Dir -> BuildDir -> Sem r Package
+loadPackageFileIO :: (Members '[TaggedLock, Error JuvixError, Embed IO] r) => Path Abs Dir -> BuildDir -> Sem r Package
 loadPackageFileIO root buildDir =
   runFilesIO
     . mapError (JuvixError @PackageLoaderError)
     . runEvalFileEffIO
     $ loadPackage buildDir (mkPackagePath root)
 
-readPackageIO :: Path Abs Dir -> BuildDir -> IO Package
-readPackageIO root buildDir =
-  runM
+readPackageIO :: LockMode -> Path Abs Dir -> BuildDir -> IO Package
+readPackageIO lockMode root buildDir =
+  runFinal
+    . resourceToIOFinal
+    . embedToFinal @IO
     . runFilesIO
     . runErrorIO' @JuvixError
     . mapError (JuvixError @PackageLoaderError)
+    . runTaggedLock lockMode
     . runEvalFileEffIO
     $ readPackage root buildDir
 
-readGlobalPackageIO :: IO Package
-readGlobalPackageIO =
-  runM
+readGlobalPackageIO :: LockMode -> IO Package
+readGlobalPackageIO lockMode =
+  runFinal
+    . resourceToIOFinal
+    . embedToFinal @IO
     . runFilesIO
     . runErrorIO' @JuvixError
     . mapError (JuvixError @PackageLoaderError)
+    . runTaggedLock lockMode
     . runEvalFileEffIO
     $ readGlobalPackage
 
-readGlobalPackage :: (Members '[Error JuvixError, EvalFileEff, Files] r) => Sem r Package
+readGlobalPackage :: (Members '[TaggedLock, Error JuvixError, EvalFileEff, Files] r) => Sem r Package
 readGlobalPackage = do
   packagePath <- globalPackageJuvix
-  unlessM (fileExists' packagePath) writeGlobalPackage
+  withTaggedLockDir (parent packagePath) (unlessM (fileExists' packagePath) writeGlobalPackage)
   readPackage (parent packagePath) DefaultBuildDir
 
 writeGlobalPackage :: (Members '[Files] r) => Sem r ()

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

@@ -18,6 +18,7 @@ import Juvix.Compiler.Pipeline.Package.Loader.EvalEff
 import Juvix.Compiler.Pipeline.Package.Loader.PathResolver
 import Juvix.Data.Effect.Git
 import Juvix.Data.Effect.Process
+import Juvix.Data.Effect.TaggedLock
 
 data LoaderResource = LoaderResource
   { _loaderResourceResult :: CoreResult,
@@ -26,7 +27,7 @@ data LoaderResource = LoaderResource
 
 makeLenses ''LoaderResource
 
-runEvalFileEffIO :: forall r a. (Members '[Embed IO, Error PackageLoaderError] r) => Sem (EvalFileEff ': r) a -> Sem r a
+runEvalFileEffIO :: forall r a. (Members '[TaggedLock, Embed IO, Error PackageLoaderError] r) => Sem (EvalFileEff ': r) a -> Sem r a
 runEvalFileEffIO = interpretScopedAs allocator handler
   where
     allocator :: Path Abs File -> Sem r LoaderResource
@@ -114,7 +115,7 @@ runEvalFileEffIO = interpretScopedAs allocator handler
                   Just l -> l ^. intervalFile == f
                   Nothing -> False
 
-loadPackage' :: (Members '[Embed IO, Error PackageLoaderError] r) => Path Abs File -> Sem r CoreResult
+loadPackage' :: (Members '[TaggedLock, Embed IO, Error PackageLoaderError] r) => Path Abs File -> Sem r CoreResult
 loadPackage' packagePath = do
   ( mapError
       ( \e ->

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

@@ -7,13 +7,14 @@ import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver.Data
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver.Error
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver.Paths
 import Juvix.Compiler.Core.Language
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Extra.PackageFiles
 import Juvix.Extra.Paths
 import Juvix.Extra.Stdlib
 
 -- | A PackageResolver interpreter intended to be used to load a Package file.
 -- It aggregates files at `rootPath` and files from the global package stdlib.
-runPackagePathResolver :: forall r a. (Members '[Files] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
+runPackagePathResolver :: forall r a. (Members '[TaggedLock, Files] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
 runPackagePathResolver rootPath sem = do
   globalStdlib <- juvixStdlibDir . rootBuildDir <$> globalRoot
   globalPackageDir <- globalPackageDescriptionRoot
@@ -43,10 +44,10 @@ runPackagePathResolver rootPath sem = do
       | relPath == packageFilePath = Just rootPath
       | otherwise = Nothing
 
-runPackagePathResolver' :: (Members '[Files] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPackagePathResolver' :: (Members '[TaggedLock, Files] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPackagePathResolver' root eff = do
   res <- runPackagePathResolver root eff
   return (iniResolverState, res)
 
-runPackagePathResolver'' :: (Members '[Files] r) => Path Abs Dir -> ResolverState -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPackagePathResolver'' :: (Members '[TaggedLock, Files] r) => Path Abs Dir -> ResolverState -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPackagePathResolver'' root _ eff = runPackagePathResolver' root eff

src/Juvix/Compiler/Pipeline/Repl.hs

@@ -20,6 +20,7 @@ import Juvix.Compiler.Pipeline.Package.Loader.EvalEff.IO
 import Juvix.Data.Effect.Git.Process
 import Juvix.Data.Effect.Git.Process.Error
 import Juvix.Data.Effect.Process (runProcessIO)
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Prelude
 
 arityCheckExpression ::
@@ -196,6 +197,7 @@ compileReplInputIO fp txt = do
   hasInternet <- not <$> asks (^. entryPointOffline)
   runError
     . evalInternet hasInternet
+    . runTaggedLockPermissive
     . runLogIO
     . runFilesIO
     . mapError (JuvixError @GitProcessError)