Skip to content

Commit

Permalink
Run test suite in parallel (#2507)
Browse files Browse the repository at this point in the history
## Overview

This PR makes the compiler pipeline thread-safe so that the test suite
can be run in parallel.

This is achieved by:
* Removing use of `{get, set, with}CurrentDir` functions.
* Adding locking around shared file resources like the the
global-project and internal build directory.

NB: **Locking is disabled for the main compiler target**, as it is
single threaded they are not required.

## Run test suite in parallel

To run the test suite in parallel you must add `--ta '+RTS -N -RTS'` to
your stack test arguments. For example:

```
stack test --fast --ta '+RTS -N -RTS'
```

The `-N` instructs the Haskell runtime to choose the number of threads
to use based on how many processors there are on your machine. You can
use `-Nn` to see the number of threads to `n`.

These flags are already [set in the
Makefile](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/Makefile#L26)
when you or CI uses `stack test`.

## Locking

The Haskell package
[filelock](https://hackage.haskell.org/package/filelock) is used for
locking. File locks are used instead of MVars because Juvix code does
not control when new threads are created, they are created by the test
suite. This means that MVars created by Juvix code will have no effect,
because they are created independently on each test-suite thread.
Additionally the resources we're locking live on the filesystem and so
can be conveniently tagged by path.

### FileLock

The filelock library is wrapped in a FileLock effect:


https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/Base.hs#L6-L8

There is an [IO
interpreter](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/IO.hs#L8)
that uses filelock and an [no-op
interpreter](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/Permissive.hs#L7)
that just runs actions unconditionally.

### TaggedLock

To make the file locks simpler to use a TaggedLock effect is introduced:


https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/TaggedLock/Base.hs#L5-L11

And convenience function:


https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/TaggedLock.hs#L28

This allows an action to be locked, tagged by a directory that may or
may not exist. For example in the following code, an action is performed
on a directory `root` that may delete the directory before repopulating
the files. So the lockfile cannot be stored in the `root` itself.


https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Extra/Files.hs#L55-L60

## Pipeline

As noted above, we only use locking in the test suite. The main app
target pipeline is single threaded and so locking is unnecessary. So the
interpretation of locks is parameterised so that locking can be disabled
https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Compiler/Pipeline/Run.hs#L64
  • Loading branch information
paulcadman authored Nov 16, 2023
1 parent 8616370 commit 2f4a3f8
Show file tree
Hide file tree
Showing 63 changed files with 395 additions and 152 deletions.
2 changes: 1 addition & 1 deletion Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
3 changes: 2 additions & 1 deletion app/Commands/Init.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down
2 changes: 2 additions & 0 deletions app/Commands/Repl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -152,6 +153,7 @@ loadDefaultPrelude = whenJustM defaultPreludeEntryPoint $ \e -> do
. runFilesIO
. runError @JuvixError
. runReader e
. runTaggedLockPermissive
. runLogIO
. runProcessIO
. runError @GitProcessError
Expand Down
3 changes: 2 additions & 1 deletion app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down
3 changes: 3 additions & 0 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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.*
Expand Down Expand Up @@ -174,6 +175,8 @@ tests:
- juvix
verbatim:
default-language: GHC2021
ghc-options:
- -threaded

benchmarks:
juvix-bench:
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ->
Expand Down Expand Up @@ -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
Expand All @@ -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 ->
Expand All @@ -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
Expand All @@ -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 ->
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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
5 changes: 3 additions & 2 deletions src/Juvix/Compiler/Pipeline.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 3 additions & 2 deletions src/Juvix/Compiler/Pipeline/Artifacts/PathResolver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
21 changes: 13 additions & 8 deletions src/Juvix/Compiler/Pipeline/EntryPoint/IO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
25 changes: 16 additions & 9 deletions src/Juvix/Compiler/Pipeline/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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 ()
Expand Down
5 changes: 3 additions & 2 deletions src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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
Expand Down Expand Up @@ -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 ->
Expand Down
7 changes: 4 additions & 3 deletions src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
2 changes: 2 additions & 0 deletions src/Juvix/Compiler/Pipeline/Repl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ::
Expand Down Expand Up @@ -196,6 +197,7 @@ compileReplInputIO fp txt = do
hasInternet <- not <$> asks (^. entryPointOffline)
runError
. evalInternet hasInternet
. runTaggedLockPermissive
. runLogIO
. runFilesIO
. mapError (JuvixError @GitProcessError)
Expand Down
Loading

0 comments on commit 2f4a3f8

Please sign in to comment.