Merge branch 'main' into isabelle-functions

app/Commands/Base.hs

@@ -3,6 +3,8 @@ module Commands.Base
     module GlobalOptions,
     module CommonOptions,
     module Juvix.Compiler.Pipeline,
+    module Juvix.Compiler.Pipeline.Run,
+    module Juvix.Compiler.Pipeline.Driver,
     module Juvix.Prelude,
   )
 where
@@ -11,4 +13,6 @@ import App
 import CommonOptions hiding (ensureLn, writeFileEnsureLn)
 import GlobalOptions
 import Juvix.Compiler.Pipeline
+import Juvix.Compiler.Pipeline.Driver
+import Juvix.Compiler.Pipeline.Run
 import Juvix.Prelude

app/Commands/Dev/Highlight.hs

@@ -3,7 +3,6 @@ module Commands.Dev.Highlight where
 import Commands.Base
 import Commands.Dev.Highlight.Options
 import Juvix.Compiler.Concrete.Data.Highlight qualified as Highlight
-import Juvix.Compiler.Pipeline.Run
 
 runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => HighlightOptions -> Sem r ()
 runCommand HighlightOptions {..} = ignoreProgressLog . runPipelineOptions $ do

app/Commands/Format.hs

@@ -3,9 +3,7 @@ module Commands.Format where
 import Commands.Base
 import Commands.Format.Options
 import Data.Text qualified as Text
-import Juvix.Compiler.Pipeline.Driver (processModule)
 import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree.Base
-import Juvix.Compiler.Pipeline.ModuleInfoCache
 import Juvix.Compiler.Store.Language (ModuleInfo)
 import Juvix.Formatter
 
@@ -55,11 +53,7 @@ formatProject ::
   Sem r FormatResult
 formatProject = runPipelineOptions . runPipelineSetup $ do
   pkg <- askPackage
-  root <- (^. rootRootDir) <$> askRoot
-  nodes <- toList <$> asks (importTreeProjectNodes root)
-  res :: [(ImportNode, PipelineResult ModuleInfo)] <- forM nodes $ \node -> do
-    res <- mkEntryIndex node >>= processModule
-    return (node, res)
+  res :: [(ImportNode, PipelineResult ModuleInfo)] <- processProject
   res' :: [(ImportNode, SourceCode)] <- runReader pkg . forM res $ \(node, nfo) -> do
     src <- formatModuleInfo node nfo
     return (node, src)

app/Commands/Repl.hs

@@ -27,7 +27,6 @@ import Juvix.Compiler.Core.Pretty qualified as Core
 import Juvix.Compiler.Internal.Language qualified as Internal
 import Juvix.Compiler.Internal.Pretty qualified as Internal
 import Juvix.Compiler.Pipeline.Repl
-import Juvix.Compiler.Pipeline.Run
 import Juvix.Compiler.Store.Extra
 import Juvix.Data.CodeAnn (Ann)
 import Juvix.Data.Error.GenericError qualified as Error

app/Commands/Typecheck.hs

@@ -5,5 +5,7 @@ import Commands.Typecheck.Options
 
 runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => TypecheckOptions -> Sem r ()
 runCommand localOpts = do
-  void (runPipelineNoOptions (localOpts ^. typecheckInputFile) upToCoreTypecheck)
+  case localOpts ^. typecheckInputFile of
+    Just _inputFile -> void (runPipelineNoOptions (localOpts ^. typecheckInputFile) upToCoreTypecheck)
+    Nothing -> void (runPipelineOptions . runPipelineSetup $ processProject)
   say "Well done! It type checks"

src/Juvix/Compiler/Pipeline/Driver.hs

@@ -4,6 +4,7 @@ module Juvix.Compiler.Pipeline.Driver
     JvoCache,
     evalJvoCache,
     processFileUpTo,
+    processProject,
     evalModuleInfoCache,
     evalModuleInfoCacheSetup,
     processFileToStoredCore,
@@ -37,6 +38,7 @@ import Juvix.Compiler.Pipeline.Loader.PathResolver
 import Juvix.Compiler.Pipeline.ModuleInfoCache
 import Juvix.Compiler.Store.Core.Extra
 import Juvix.Compiler.Store.Extra qualified as Store
+import Juvix.Compiler.Store.Language
 import Juvix.Compiler.Store.Language qualified as Store
 import Juvix.Compiler.Store.Options qualified as StoredModule
 import Juvix.Compiler.Store.Options qualified as StoredOptions
@@ -123,6 +125,12 @@ processModuleCacheMiss entryIx = do
       Serialize.saveToFile absPath (res ^. pipelineResult)
       return res
 
+processProject :: (Members '[ModuleInfoCache, Reader EntryPoint, Reader ImportTree] r) => Sem r [(ImportNode, PipelineResult ModuleInfo)]
+processProject = do
+  rootDir <- asks (^. entryPointRoot)
+  nodes <- toList <$> asks (importTreeProjectNodes rootDir)
+  forWithM nodes (mkEntryIndex >=> processModule)
+
 processRecursiveUpToTyped ::
   forall r.
   ( Members

src/Juvix/Prelude/Base/Foundation.hs

@@ -250,6 +250,18 @@ traverseM ::
   f (m a2)
 traverseM f = fmap join . traverse f
 
+forWith :: (Functor f) => f key -> (key -> val) -> f (key, val)
+forWith = flip mapWith
+
+forWithM :: (Traversable l, Applicative f) => l key -> (key -> f val) -> f (l (key, val))
+forWithM = flip mapWithM
+
+mapWith :: (Functor f) => (key -> val) -> f key -> f (key, val)
+mapWith f = fmap (\x -> (x, f x))
+
+mapWithM :: (Traversable l, Applicative f) => (key -> f val) -> l key -> f (l (key, val))
+mapWithM f = traverse (\x -> (x,) <$> f x)
+
 composeM :: (Monad m) => Int -> (a -> m a) -> a -> m a
 composeM 0 _ a = return a
 composeM n f a = composeM (n - 1) f a >>= f