Use Package.juvix in the global project (#2499)

## Global package configuration This PR updates the global-project to use `Package.juvix` instead of `juvix.yaml`. The global package gets the following `Package.juvix`: ``` module Package; import PackageDescription.V1 open; package : Package := defaultPackage {name := "global-juvix-package"; version := mkVersion 0 0 0; dependencies := [defaultStdlib]}; ``` ## juvix clean --global This PR also adds an option `-g/--global` to `juvix clean` that removes the `$XDG_CONFIG_HOME/juvix/VERSION` directory. ## Testing notes If you've already run Juvix 0.5.3 you'll need to run `juvix clean -g` before you'll use the new global project. This will not be an issue for users of Juvix 0.5.4 (as this version of Juvix will never generate juvix.yaml in the global project). Part of: * https://github.com/anoma/juvix/issues/2487
2025-01-05 22:46:08 +03:00 · 2023-11-06 11:49:43 +00:00 · 2023-11-06 11:49:43 +00:00 · 511e99f217
commit 511e99f217
parent 9d75dcac96
11 changed files with 116 additions and 40 deletions
--- a/app/Commands/Clean.hs
+++ b/app/Commands/Clean.hs
@ -1,8 +1,13 @@
 module Commands.Clean where

 import Commands.Base
+import Commands.Clean.Options

-runCommand :: (Members '[Files, App] r) => Sem r ()
-runCommand = do
-  buildDir <- askBuildDir
-  whenM (directoryExists' buildDir) (removeDirectoryRecursive' buildDir)
+runCommand :: (Members '[Files, App] r) => CleanOptions -> Sem r ()
+runCommand opts
+  | opts ^. cleanOptionsGlobal = do
+      configDir <- juvixConfigDir
+      whenM (directoryExists' configDir) (removeDirectoryRecursive' configDir)
+  | otherwise = do
+      buildDir <- askBuildDir
+      whenM (directoryExists' buildDir) (removeDirectoryRecursive' buildDir)
--- a/app/Commands/Clean/Options.hs
+++ b/app/Commands/Clean/Options.hs
@ -0,0 +1,20 @@
+module Commands.Clean.Options where
+
+import CommonOptions
+import Juvix.Extra.Version
+
+newtype CleanOptions = CleanOptions
+  {_cleanOptionsGlobal :: Bool}
+  deriving stock (Data)
+
+makeLenses ''CleanOptions
+
+parseCleanOptions :: Parser CleanOptions
+parseCleanOptions = do
+  _cleanOptionsGlobal <-
+    switch
+      ( long "global"
+          <> short 'g'
+          <> help ("Remove $XDG_CONFIG_HOME/juvix/" <> unpack versionDoc)
+      )
+  pure CleanOptions {..}
--- a/app/Commands/Init.hs
+++ b/app/Commands/Init.hs
@ -3,7 +3,6 @@ module Commands.Init where
 import Data.Text qualified as Text
 import Data.Text.IO.Utf8 qualified as Utf8
 import Data.Versions
-import Juvix.Compiler.Concrete.Print (ppOutDefaultNoComments)
 import Juvix.Compiler.Pipeline.Package
 import Juvix.Compiler.Pipeline.Package.Loader
 import Juvix.Data.Effect.Fail.Extra qualified as Fail
@ -29,12 +28,9 @@ init = do
  say "I will help you set it up"
  pkg <- getPackage
  say ("creating " <> pack (toFilePath packageFilePath))
-  embed (Utf8.writeFile @IO (toFilePath packageFilePath) (renderPackage pkg))
+  embed (Utf8.writeFile @IO (toFilePath packageFilePath) (renderPackageVersion PackageVersion1 pkg))
  checkPackage
  say "you are all set"
-  where
-    renderPackage :: Package -> Text
-    renderPackage pkg = toPlainText (ppOutDefaultNoComments (toConcrete v1PackageDescriptionType pkg))

 checkNotInProject :: forall r. (Members '[Embed IO] r) => Sem r ()
 checkNotInProject =
--- a/app/TopCommand.hs
+++ b/app/TopCommand.hs
@ -34,7 +34,7 @@ runTopCommand = \case
  Dev opts -> Dev.runCommand opts
  Typecheck opts -> Typecheck.runCommand opts
  Compile opts -> Compile.runCommand opts
-  Clean -> runFilesIO Clean.runCommand
+  Clean opts -> runFilesIO (Clean.runCommand opts)
  Eval opts -> Eval.runCommand opts
  Html opts -> Html.runCommand opts
  JuvixRepl opts -> Repl.runCommand opts
--- a/app/TopCommand/Options.hs
+++ b/app/TopCommand/Options.hs
@ -1,5 +1,6 @@
 module TopCommand.Options where

+import Commands.Clean.Options
 import Commands.Compile.Options
 import Commands.Dependencies.Options qualified as Dependencies
 import Commands.Dev.Options qualified as Dev
@ -20,7 +21,7 @@ data TopCommand
  | DisplayHelp
  | Typecheck TypecheckOptions
  | Compile CompileOptions
-  | Clean
+  | Clean CleanOptions
  | Eval EvalOptions
  | Html HtmlOptions
  | Dev Dev.DevCommand
@ -150,7 +151,7 @@ parseUtility =
    commandClean =
      command
        "clean"
-        (info (pure Clean) (progDesc "Delete build artifacts"))
+        (info (Clean <$> parseCleanOptions) (progDesc "Delete build artifacts"))

    commandDependencies :: Mod CommandFields TopCommand
    commandDependencies =
--- a/src/Juvix/Compiler/Pipeline/Package.hs
+++ b/src/Juvix/Compiler/Pipeline/Package.hs
@ -151,12 +151,12 @@ readGlobalPackageIO =

 readGlobalPackage :: (Members '[Error JuvixError, EvalFileEff, Files] r) => Sem r Package
 readGlobalPackage = do
-  yamlPath <- globalYaml
-  unlessM (fileExists' yamlPath) writeGlobalPackage
-  readPackage (parent yamlPath) DefaultBuildDir
+  packagePath <- globalPackageJuvix
+  unlessM (fileExists' packagePath) writeGlobalPackage
+  readPackage (parent packagePath) DefaultBuildDir

 writeGlobalPackage :: (Members '[Files] r) => Sem r ()
 writeGlobalPackage = do
-  yamlPath <- globalYaml
-  ensureDir' (parent yamlPath)
-  writeFileBS yamlPath (encode globalPackage)
+  packagePath <- globalPackageJuvix
+  ensureDir' (parent packagePath)
+  writeFile' packagePath (renderPackageVersion PackageVersion1 (globalPackage packagePath))
--- a/src/Juvix/Compiler/Pipeline/Package/Base.hs
+++ b/src/Juvix/Compiler/Pipeline/Package/Base.hs
@ -136,15 +136,15 @@ defaultStdlibDep buildDir = mkPathDependency (fromSomeDir (resolveBuildDir build
 defaultPackageName :: Text
 defaultPackageName = "my-project"

-globalPackage :: RawPackage
-globalPackage =
+globalPackage :: Path Abs File -> Package
+globalPackage p =
  Package
-    { _packageDependencies = Just [defaultStdlibDep DefaultBuildDir],
-      _packageName = Just "global-juvix-package",
-      _packageVersion = Just (prettySemVer defaultVersion),
+    { _packageDependencies = [defaultStdlibDep DefaultBuildDir],
+      _packageName = "global-juvix-package",
+      _packageVersion = defaultVersion,
      _packageMain = Nothing,
      _packageBuildDir = Nothing,
-      _packageFile = Nothing,
+      _packageFile = p,
      _packageLockfile = Nothing
    }

--- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs
+++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs
@ -8,6 +8,7 @@ import Data.FileEmbed qualified as FE
 import Data.Versions
 import Juvix.Compiler.Concrete.Gen
 import Juvix.Compiler.Concrete.Language
+import Juvix.Compiler.Concrete.Print (ppOutDefaultNoComments)
 import Juvix.Compiler.Concrete.Translation.FromSource hiding (symbol)
 import Juvix.Compiler.Core.Language qualified as Core
 import Juvix.Compiler.Core.Language.Value
@ -18,6 +19,7 @@ import Juvix.Compiler.Pipeline.Package.Loader.Versions
 import Juvix.Extra.Paths
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
+import Juvix.Prelude.Pretty
 import Language.Haskell.TH.Syntax hiding (Module)
 import System.FilePath qualified as FP

@ -33,6 +35,13 @@ acceptableTypes = mapM go packageDescriptionTypes
            _typeSpecFile = globalPackageDir <//> (t ^. packageDescriptionTypePath)
          }

+renderPackageVersion :: PackageVersion -> Package -> Text
+renderPackageVersion v pkg = toPlainText (ppOutDefaultNoComments (toConcrete packageType pkg))
+  where
+    packageType :: PackageDescriptionType
+    packageType = case v of
+      PackageVersion1 -> v1PackageDescriptionType
+
 -- | Load a package file in the context of the PackageDescription module and the global package stdlib.
 loadPackage :: (Members '[Files, EvalFileEff, Error PackageLoaderError] r) => BuildDir -> Path Abs File -> Sem r Package
 loadPackage buildDir packagePath = do
--- a/src/Juvix/Compiler/Pipeline/Package/Loader/Versions.hs
+++ b/src/Juvix/Compiler/Pipeline/Package/Loader/Versions.hs
@ -18,6 +18,8 @@ data PackageDescriptionType = PackageDescriptionType

 makeLenses ''PackageDescriptionType

+data PackageVersion = PackageVersion1
+
 -- | The names of the Package type name in every version of the PackageDescription module
 packageDescriptionTypes :: [PackageDescriptionType]
 packageDescriptionTypes = [v1PackageDescriptionType]
@ -57,22 +59,24 @@ v1PackageDescriptionType = PackageDescriptionType v1PackageDescriptionFile "Pack
              namedArgument "dependencies" (deps :| [])
              where
                mkDependencyArg :: Dependency -> Sem r (NonEmpty (ExpressionAtom 'Parsed))
-                mkDependencyArg = \case
-                  DependencyPath x ->
-                    sequence
-                      ( identifier "path"
-                          :| [literalString (pack (unsafePrepathToFilePath (x ^. pathDependencyPath)))]
-                      )
-                  DependencyGit x ->
-                    sequence
-                      ( identifier "git"
-                          :| ( literalString
-                                 <$> [ x ^. gitDependencyName,
-                                       x ^. gitDependencyUrl,
-                                       x ^. gitDependencyRef
-                                     ]
-                             )
-                      )
+                mkDependencyArg d
+                  | d == defaultStdlibDep DefaultBuildDir = NEL.singleton <$> identifier "defaultStdlib"
+                  | otherwise = case d of
+                      DependencyPath x ->
+                        sequence
+                          ( identifier "path"
+                              :| [literalString (pack (unsafePrepathToFilePath (x ^. pathDependencyPath)))]
+                          )
+                      DependencyGit x ->
+                        sequence
+                          ( identifier "git"
+                              :| ( literalString
+                                     <$> [ x ^. gitDependencyName,
+                                           x ^. gitDependencyUrl,
+                                           x ^. gitDependencyRef
+                                         ]
+                                 )
+                          )

            mkMainArg :: Sem r (Maybe (NamedArgument 'Parsed))
            mkMainArg = do
--- a/src/Juvix/Data/Effect/Files.hs
+++ b/src/Juvix/Data/Effect/Files.hs
@ -98,6 +98,9 @@ restoreFileOnError p action = do
 globalYaml :: (Members '[Files] r) => Sem r (Path Abs File)
 globalYaml = (<//> juvixYamlFile) <$> globalRoot

+globalPackageJuvix :: (Members '[Files] r) => Sem r (Path Abs File)
+globalPackageJuvix = (<//> packageFilePath) <$> globalRoot
+
 globalRoot :: (Members '[Files] r) => Sem r (Path Abs Dir)
 globalRoot = (<//> $(mkRelDir "global-project")) <$> juvixConfigDir

--- a/tests/smoke/Commands/clean.smoke.yaml
+++ b/tests/smoke/Commands/clean.smoke.yaml
@ -13,6 +13,44 @@ tests:
    stdout: ""
    exit-status: 0

+  - name: global-clean-with-no-config-dir
+    command:
+      shell:
+        - bash
+      script: |
+        temp=$(mktemp -d)
+        trap 'rm -rf -- "$temp"' EXIT
+        config=$(mktemp -d)
+        rm -rf "$config"
+        export XDG_CONFIG_HOME=$config
+        cd $temp
+        juvix clean -g
+    stdout: ""
+    exit-status: 0
+
+  - name: global-clean-xdg-config-dir
+    command:
+      shell:
+        - bash
+      script: |
+        baseDir=$PWD
+        temp=$(mktemp -d)
+        trap 'rm -rf -- "$temp"' EXIT
+        config=$(mktemp -d)
+        export XDG_CONFIG_HOME=$config
+        version=$(juvix --numeric-version)
+        configDir="$config/juvix/$version"
+        cd $temp
+        cp "$baseDir/examples/milestone/HelloWorld/HelloWorld.juvix" .
+        juvix compile HelloWorld.juvix
+        [ -d $configDir ]
+        juvix clean
+        [ -d $configDir ]
+        juvix clean -g
+        [ ! -d $configDir ]
+    stdout: ""
+    exit-status: 0
+
  - name: clean-with-default-build-dir
    command:
      shell: