refactor to run TaggedLock globally

app/App.hs

@@ -43,7 +43,7 @@ data RunAppIOArgs = RunAppIOArgs
 
 runAppIO ::
   forall r a.
-  (Member (Embed IO) r) =>
+  (Members '[Embed IO, TaggedLock] r) =>
   RunAppIOArgs ->
   Sem (App ': r) a ->
   Sem r a
@@ -52,26 +52,26 @@ runAppIO args@RunAppIOArgs {..} =
     AskPackageGlobal -> return (_runAppIOArgsRoot ^. rootPackageType `elem` [GlobalStdlib, GlobalPackageDescription, GlobalPackageBase])
     FromAppPathFile p -> embed (prepathToAbsFile invDir (p ^. pathPath))
     GetMainFile m -> getMainFile' m
-    FromAppPathDir p -> embed (prepathToAbsDir invDir (p ^. pathPath))
+    FromAppPathDir p -> liftIO (prepathToAbsDir invDir (p ^. pathPath))
     RenderStdOut t
       | _runAppIOArgsGlobalOptions ^. globalOnlyErrors -> return ()
       | otherwise -> embed $ do
           sup <- Ansi.hSupportsANSIColor stdout
           renderIO (not (_runAppIOArgsGlobalOptions ^. globalNoColors) && sup) t
     AskGlobalOptions -> return _runAppIOArgsGlobalOptions
-    AskPackage -> return (_runAppIOArgsRoot ^. rootPackage)
+    AskPackage -> getPkg
     AskRoot -> return _runAppIOArgsRoot
     AskInvokeDir -> return invDir
     AskPkgDir -> return (_runAppIOArgsRoot ^. rootRootDir)
     AskBuildDir -> return (resolveAbsBuildDir (_runAppIOArgsRoot ^. rootRootDir) (_runAppIOArgsRoot ^. rootBuildDir))
     RunCorePipelineEither input -> do
-      entry <- embed (getEntryPoint' args input)
+      entry <- getEntryPoint' args input
       embed (corePipelineIOEither entry)
     RunPipelineEither input p -> do
-      entry <- embed (getEntryPoint' args input)
+      entry <- getEntryPoint' args input
       embed (runIOEither entry p)
     RunPipelineNoFileEither p -> do
-      entry <- embed (getEntryPointStdin' args)
+      entry <- getEntryPointStdin' args
       embed (runIOEither entry p)
     Say t
       | g ^. globalOnlyErrors -> return ()
@@ -84,14 +84,19 @@ runAppIO args@RunAppIOArgs {..} =
     ExitMsg exitCode t -> exitMsg' exitCode t
     SayRaw b -> embed (ByteString.putStr b)
   where
+    getPkg :: Sem r Package
+    getPkg = undefined
     exitMsg' :: ExitCode -> Text -> Sem r x
     exitMsg' exitCode t = embed (putStrLn t >> hFlush stdout >> exitWith exitCode)
     getMainFile' :: Maybe (AppPath File) -> Sem r (Path Abs File)
     getMainFile' = \case
       Just p -> embed (prepathToAbsFile invDir (p ^. pathPath))
-      Nothing -> case pkg ^. packageMain of
-        Just p -> embed (prepathToAbsFile invDir p)
-        Nothing -> missingMainErr
+      -- Nothing -> case pkg ^. packageMain of
+      Nothing -> do
+        pkg <- getPkg
+        case pkg ^. packageMain of
+          Just p -> embed (prepathToAbsFile invDir p)
+          Nothing -> missingMainErr
     missingMainErr :: Sem r x
     missingMainErr =
       exitMsg'
@@ -101,30 +106,28 @@ runAppIO args@RunAppIOArgs {..} =
             <> " file"
         )
     invDir = _runAppIOArgsRoot ^. rootInvokeDir
-    pkg :: Package
-    pkg = _runAppIOArgsRoot ^. rootPackage
     g :: GlobalOptions
     g = _runAppIOArgsGlobalOptions
     printErr e =
       embed $ hPutStrLn stderr $ run $ runReader (project' @GenericOptions g) $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalOnlyErrors) e
 
-getEntryPoint' :: RunAppIOArgs -> AppPath File -> IO EntryPoint
+getEntryPoint' :: (Members '[Embed IO, TaggedLock] r) => RunAppIOArgs -> AppPath File -> Sem r EntryPoint
 getEntryPoint' RunAppIOArgs {..} inputFile = do
   let opts = _runAppIOArgsGlobalOptions
       root = _runAppIOArgsRoot
   estdin <-
     if
-        | opts ^. globalStdin -> Just <$> getContents
+        | opts ^. globalStdin -> Just <$> liftIO getContents
         | otherwise -> return Nothing
   set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root (inputFile ^. pathPath) opts
 
-getEntryPointStdin' :: RunAppIOArgs -> IO EntryPoint
+getEntryPointStdin' :: (Members '[Embed IO, TaggedLock] r) => RunAppIOArgs -> Sem r EntryPoint
 getEntryPointStdin' RunAppIOArgs {..} = do
   let opts = _runAppIOArgsGlobalOptions
       root = _runAppIOArgsRoot
   estdin <-
     if
-        | opts ^. globalStdin -> Just <$> getContents
+        | opts ^. globalStdin -> Just <$> liftIO getContents
         | otherwise -> return Nothing
   set entryPointStdin estdin <$> entryPointFromGlobalOptionsNoFile root opts
 
@@ -141,11 +144,11 @@ filePathToAbs fp = do
 askGenericOptions :: (Members '[App] r) => Sem r GenericOptions
 askGenericOptions = project <$> askGlobalOptions
 
-getEntryPoint :: (Members '[Embed IO, App] r) => AppPath File -> Sem r EntryPoint
+getEntryPoint :: (Members '[Embed IO, App, TaggedLock] r) => AppPath File -> Sem r EntryPoint
 getEntryPoint inputFile = do
   _runAppIOArgsGlobalOptions <- askGlobalOptions
   _runAppIOArgsRoot <- askRoot
-  embed (getEntryPoint' (RunAppIOArgs {..}) inputFile)
+  getEntryPoint' (RunAppIOArgs {..}) inputFile
 
 runPipelineTermination :: (Member App r) => AppPath File -> Sem (Termination ': PipelineEff) a -> Sem r a
 runPipelineTermination input p = do

app/Commands/Compile.hs

@@ -9,7 +9,7 @@ import Juvix.Compiler.Core qualified as Core
 import Juvix.Compiler.Core.Pretty qualified as Core
 import Juvix.Compiler.Core.Transformation.DisambiguateNames qualified as Core
 
-runCommand :: (Members '[Embed IO, App] r) => CompileOptions -> Sem r ()
+runCommand :: (Members '[Embed IO, App, TaggedLock] r) => CompileOptions -> Sem r ()
 runCommand opts@CompileOptions {..} = do
   inputFile <- getMainFile _compileInputFile
   Core.CoreResult {..} <- runPipeline (AppPath (preFileFromAbs inputFile) True) upToCore
@@ -27,7 +27,7 @@ runCommand opts@CompileOptions {..} = do
     TargetCore -> writeCoreFile arg
     TargetAsm -> Compile.runAsmPipeline arg
 
-writeCoreFile :: (Members '[Embed IO, App] r) => Compile.PipelineArg -> Sem r ()
+writeCoreFile :: (Members '[Embed IO, App, TaggedLock] r) => Compile.PipelineArg -> Sem r ()
 writeCoreFile pa@Compile.PipelineArg {..} = do
   entryPoint <- Compile.getEntry pa
   coreFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile

app/Commands/Dev.hs

@@ -19,7 +19,7 @@ import Commands.Dev.Scope qualified as Scope
 import Commands.Dev.Termination qualified as Termination
 import Commands.Repl qualified as Repl
 
-runCommand :: (Members '[Embed IO, App] r) => DevCommand -> Sem r ()
+runCommand :: (Members '[Embed IO, App, TaggedLock] r) => DevCommand -> Sem r ()
 runCommand = \case
   Highlight opts -> Highlight.runCommand opts
   Parse opts -> Parse.runCommand opts

app/Commands/Dev/Asm.hs

@@ -6,7 +6,7 @@ import Commands.Dev.Asm.Options
 import Commands.Dev.Asm.Run as Run
 import Commands.Dev.Asm.Validate as Validate
 
-runCommand :: forall r. (Members '[Embed IO, App] r) => AsmCommand -> Sem r ()
+runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => AsmCommand -> Sem r ()
 runCommand = \case
   Run opts -> Run.runCommand opts
   Validate opts -> Validate.runCommand opts

app/Commands/Dev/Asm/Compile.hs

@@ -8,7 +8,7 @@ import Juvix.Compiler.Asm.Translation.FromSource qualified as Asm
 import Juvix.Compiler.Backend qualified as Backend
 import Juvix.Compiler.Backend.C qualified as C
 
-runCommand :: forall r. (Members '[Embed IO, App] r) => AsmCompileOptions -> Sem r ()
+runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => AsmCompileOptions -> Sem r ()
 runCommand opts = do
   file <- getFile
   ep <- getEntryPoint (AppPath (preFileFromAbs file) True)

app/Commands/Dev/Core.hs

@@ -11,7 +11,7 @@ import Commands.Dev.Core.Read as Read
 import Commands.Dev.Core.Repl as Repl
 import Commands.Dev.Core.Strip as Strip
 
-runCommand :: forall r. (Members '[Embed IO, App] r) => CoreCommand -> Sem r ()
+runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => CoreCommand -> Sem r ()
 runCommand = \case
   Repl opts -> Repl.runCommand opts
   Eval opts -> Eval.runCommand opts

app/Commands/Dev/Core/Compile.hs

@@ -6,7 +6,7 @@ import Commands.Dev.Core.Compile.Options
 import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Core.Translation.FromSource qualified as Core
 
-runCommand :: forall r. (Members '[Embed IO, App] r) => CompileOptions -> Sem r ()
+runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => CompileOptions -> Sem r ()
 runCommand opts = do
   file <- getFile
   s <- readFile (toFilePath file)

app/Commands/Dev/Core/Compile/Base.hs

@@ -18,7 +18,7 @@ data PipelineArg = PipelineArg
     _pipelineArgInfoTable :: Core.InfoTable
   }
 
-getEntry :: (Members '[Embed IO, App] r) => PipelineArg -> Sem r EntryPoint
+getEntry :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint
 getEntry PipelineArg {..} = do
   ep <- getEntryPoint (AppPath (preFileFromAbs _pipelineArgFile) True)
   return $
@@ -46,7 +46,7 @@ getEntry PipelineArg {..} = do
 
 runCPipeline ::
   forall r.
-  (Members '[Embed IO, App] r) =>
+  (Members '[Embed IO, App, TaggedLock] r) =>
   PipelineArg ->
   Sem r ()
 runCPipeline pa@PipelineArg {..} = do
@@ -69,7 +69,7 @@ runCPipeline pa@PipelineArg {..} = do
 
 runGebPipeline ::
   forall r.
-  (Members '[Embed IO, App] r) =>
+  (Members '[Embed IO, App, TaggedLock] r) =>
   PipelineArg ->
   Sem r ()
 runGebPipeline pa@PipelineArg {..} = do
@@ -89,7 +89,7 @@ runGebPipeline pa@PipelineArg {..} = do
 
 runVampIRPipeline ::
   forall r.
-  (Members '[Embed IO, App] r) =>
+  (Members '[Embed IO, App, TaggedLock] r) =>
   PipelineArg ->
   Sem r ()
 runVampIRPipeline pa@PipelineArg {..} = do
@@ -98,7 +98,7 @@ runVampIRPipeline pa@PipelineArg {..} = do
   VampIR.Result {..} <- getRight (run (runReader entryPoint (runError (coreToVampIR _pipelineArgInfoTable :: Sem '[Error JuvixError, Reader EntryPoint] VampIR.Result))))
   embed $ TIO.writeFile (toFilePath vampirFile) _resultCode
 
-runAsmPipeline :: (Members '[Embed IO, App] r) => PipelineArg -> Sem r ()
+runAsmPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r ()
 runAsmPipeline pa@PipelineArg {..} = do
   entryPoint <- getEntry pa
   asmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile

app/Commands/Dev/Geb/Repl.hs

@@ -43,7 +43,7 @@ runCommand replOpts = do
         gopts <- State.gets (^. replStateGlobalOptions)
         absInputFile :: Path Abs File <- replMakeAbsolute inputFile
         set entryPointTarget Backend.TargetGeb
-          <$> liftIO (entryPointFromGlobalOptions root absInputFile gopts)
+          <$> liftIO (runM (runTaggedLockPermissive (entryPointFromGlobalOptions root absInputFile gopts)))
   embed
     ( State.evalStateT
         (replAction replOpts getReplEntryPoint)

app/Commands/Dev/Highlight.hs

@@ -5,7 +5,7 @@ import Commands.Dev.Highlight.Options
 import Juvix.Compiler.Concrete.Data.Highlight qualified as Highlight
 import Juvix.Compiler.Pipeline.Run
 
-runCommand :: (Members '[Embed IO, App] r) => HighlightOptions -> Sem r ()
+runCommand :: (Members '[Embed IO, App, TaggedLock] r) => HighlightOptions -> Sem r ()
 runCommand HighlightOptions {..} = do
   entry <- getEntryPoint _highlightInputFile
   inputFile <- fromAppPathFile _highlightInputFile

app/Commands/Repl.hs

@@ -39,7 +39,6 @@ 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
@@ -172,10 +171,10 @@ getReplEntryPoint f inputFile = do
   liftIO (set entryPointSymbolPruningMode KeepAll <$> f root inputFile gopts)
 
 getReplEntryPointFromPrepath :: Prepath File -> Repl EntryPoint
-getReplEntryPointFromPrepath = getReplEntryPoint entryPointFromGlobalOptionsPre
+getReplEntryPointFromPrepath = getReplEntryPoint (\r x -> runM . runTaggedLockPermissive . entryPointFromGlobalOptionsPre r x)
 
 getReplEntryPointFromPath :: Path Abs File -> Repl EntryPoint
-getReplEntryPointFromPath = getReplEntryPoint entryPointFromGlobalOptions
+getReplEntryPointFromPath = getReplEntryPoint (\r a -> runM . runTaggedLockPermissive . entryPointFromGlobalOptions r a)
 
 displayVersion :: String -> Repl ()
 displayVersion _ = liftIO (putStrLn versionTag)
@@ -495,9 +494,10 @@ printRoot _ = do
   r <- State.gets (^. replStateRoot . rootRootDir)
   liftIO $ putStrLn (pack (toFilePath r))
 
-runCommand :: (Members '[Embed IO, App] r) => ReplOptions -> Sem r ()
+runCommand :: (Members '[Embed IO, App, TaggedLock] r) => ReplOptions -> Sem r ()
 runCommand opts = do
   root <- askRoot
+  pkg <- askPackage
   let replAction :: ReplS ()
       replAction = do
         evalReplOpts
@@ -515,7 +515,8 @@ runCommand opts = do
   let env =
         ReplEnv
           { _replRoot = root,
-            _replOptions = opts
+            _replOptions = opts,
+            _replPackage = pkg
           }
       iniState =
         ReplState
@@ -539,7 +540,7 @@ defaultPreludeEntryPoint = do
   root <- State.gets (^. replStateRoot)
   let buildRoot = root ^. rootRootDir
       buildDir = resolveAbsBuildDir buildRoot (root ^. rootBuildDir)
-      pkg = root ^. rootPackage
+  pkg <- Reader.asks (^. replPackage)
   mstdlibPath <- liftIO (runM (runFilesIO (packageStdlib buildRoot buildDir (pkg ^. packageDependencies))))
   case mstdlibPath of
     Just stdlibPath ->

app/Commands/Repl/Base.hs

@@ -20,6 +20,7 @@ data ReplContext = ReplContext
 
 data ReplEnv = ReplEnv
   { _replRoot :: Root,
+    _replPackage :: Package,
     _replOptions :: ReplOptions
   }
 

app/GlobalOptions.hs

@@ -1,12 +1,15 @@
 module GlobalOptions
   ( module GlobalOptions,
+    module Juvix.Data.Effect.TaggedLock,
   )
 where
 
 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.Package (readPackageRootIO)
+import Juvix.Data.Effect.TaggedLock
 import Juvix.Data.Error.GenericError qualified as E
 
 data GlobalOptions = GlobalOptions
@@ -139,16 +142,17 @@ parseBuildDir m = do
       )
   pure AppPath {_pathIsInput = False, ..}
 
-entryPointFromGlobalOptionsPre :: Root -> Prepath File -> GlobalOptions -> IO EntryPoint
+entryPointFromGlobalOptionsPre :: (Members '[TaggedLock, Embed IO] r) => Root -> Prepath File -> GlobalOptions -> Sem r EntryPoint
 entryPointFromGlobalOptionsPre root premainFile opts = do
-  mainFile <- prepathToAbsFile (root ^. rootInvokeDir) premainFile
+  mainFile <- liftIO (prepathToAbsFile (root ^. rootInvokeDir) premainFile)
   entryPointFromGlobalOptions root mainFile opts
 
-entryPointFromGlobalOptions :: Root -> Path Abs File -> GlobalOptions -> IO EntryPoint
+entryPointFromGlobalOptions :: (Members '[TaggedLock, Embed IO] r) => Root -> Path Abs File -> GlobalOptions -> Sem r EntryPoint
 entryPointFromGlobalOptions root mainFile opts = do
-  mabsBuildDir :: Maybe (Path Abs Dir) <- mapM (prepathToAbsDir cwd) optBuildDir
+  mabsBuildDir :: Maybe (Path Abs Dir) <- liftIO (mapM (prepathToAbsDir cwd) optBuildDir)
+  pkg <- readPackageRootIO root
   let def :: EntryPoint
-      def = defaultEntryPoint root mainFile
+      def = defaultEntryPoint pkg root mainFile
   return
     def
       { _entryPointNoTermination = opts ^. globalNoTermination,
@@ -165,11 +169,12 @@ entryPointFromGlobalOptions root mainFile opts = do
     optBuildDir = fmap (^. pathPath) (opts ^. globalBuildDir)
     cwd = root ^. rootInvokeDir
 
-entryPointFromGlobalOptionsNoFile :: Root -> GlobalOptions -> IO EntryPoint
+entryPointFromGlobalOptionsNoFile :: (Members '[Embed IO, 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 root
+      def = defaultEntryPointNoFile pkg root
   return
     def
       { _entryPointNoTermination = opts ^. globalNoTermination,

app/Main.hs

@@ -7,7 +7,6 @@ import CommonOptions
 import Data.String.Interpolate (i)
 import GlobalOptions
 import Juvix.Compiler.Pipeline.Root
-import Juvix.Data.Effect.TaggedLock
 import TopCommand
 import TopCommand.Options
 
@@ -19,12 +18,13 @@ main = do
   mbuildDir <- mapM (prepathToAbsDir invokeDir) (_runAppIOArgsGlobalOptions ^? globalBuildDir . _Just . pathPath)
   mainFile <- topCommandInputPath cli
   mapM_ checkMainFile mainFile
-  _runAppIOArgsRoot <- findRootAndChangeDir LockModePermissive (containingDir <$> mainFile) mbuildDir invokeDir
   runFinal
     . resourceToIOFinal
     . embedToFinal @IO
-    . runAppIO RunAppIOArgs {..}
-    $ runTopCommand cli
+    . runTaggedLockPermissive
+    $ do
+      _runAppIOArgsRoot <- findRootAndChangeDir (containingDir <$> mainFile) mbuildDir invokeDir
+      runAppIO RunAppIOArgs {..} (runTopCommand cli)
   where
     checkMainFile :: SomePath b -> IO ()
     checkMainFile p = unlessM (doesSomePathExist p) err

app/TopCommand.hs

@@ -25,7 +25,7 @@ showHelpText = do
       (msg, _) = renderFailure helpText progn
   putStrLn (pack msg)
 
-runTopCommand :: forall r. (Members '[Embed IO, App, Resource] r) => TopCommand -> Sem r ()
+runTopCommand :: forall r. (Members '[Embed IO, App, Resource, TaggedLock] r) => TopCommand -> Sem r ()
 runTopCommand = \case
   DisplayVersion -> embed runDisplayVersion
   DisplayNumericVersion -> embed runDisplayNumericVersion