Add uninstall command (#1111)

* Add uninstall command

* Add initial round of tests

* Modify doc more correctly

---------

Co-authored-by: Fabrizio Ferrai <fabrizio.ferrai@gmail.com>

bin/src/Flags.purs

@@ -234,6 +234,14 @@ packages =
           <> O.help "Package name to add as dependency"
       )
 
+packagesToRemove :: Parser (List String)
+packagesToRemove =
+  O.many $
+    O.strArgument
+      ( O.metavar "PACKAGE"
+          <> O.help "Package name to remove from dependencies"
+      )
+
 package :: Parser String
 package =
   O.strArgument

bin/src/Main.purs

@@ -11,6 +11,7 @@ import Data.Foldable as Foldable
 import Data.List as List
 import Data.Map as Map
 import Data.Maybe as Maybe
+import Data.Set as Set
 import Data.String as String
 import Effect.Aff as Aff
 import Effect.Now as Now
@@ -29,6 +30,7 @@ import Spago.Bin.Flags as Flags
 import Spago.Command.Build as Build
 import Spago.Command.Bundle as Bundle
 import Spago.Command.Docs as Docs
+import Spago.Command.Uninstall as Uninstall
 import Spago.Command.Fetch as Fetch
 import Spago.Command.Graph (GraphModulesArgs, GraphPackagesArgs)
 import Spago.Command.Graph as Graph
@@ -90,6 +92,12 @@ type InstallArgs =
   , testDeps :: Boolean
   }
 
+type UninstallArgs =
+  { packagesToRemove :: List String
+  , selectedPackage :: Maybe String
+  , testDeps :: Boolean
+  }
+
 type BuildArgs a =
   { selectedPackage :: Maybe String
   , pursArgs :: List String
@@ -177,6 +185,7 @@ data Command a
   | Fetch FetchArgs
   | Init InitArgs
   | Install InstallArgs
+  | Uninstall UninstallArgs
   | LsPaths LsPathsArgs
   | LsDeps LsDepsArgs
   | LsPackages LsPackagesArgs
@@ -206,6 +215,7 @@ argParser =
     [ commandParser "init" (Init <$> initArgsParser) "Initialise a new project"
     , commandParser "fetch" (Fetch <$> fetchArgsParser) "Downloads all of the project's dependencies"
     , commandParser "install" (Install <$> installArgsParser) "Compile the project's dependencies"
+    , commandParser "uninstall" (Uninstall <$> uninstallArgsParser) "Remove dependencies from a package"
     , commandParser "build" (Build <$> buildArgsParser) "Compile the project"
     , commandParser "run" (Run <$> runArgsParser) "Run the project"
     , commandParser "test" (Test <$> testArgsParser) "Test the project"
@@ -304,6 +314,14 @@ installArgsParser =
     , testDeps: Flags.testDeps
     }
 
+uninstallArgsParser :: Parser UninstallArgs
+uninstallArgsParser =
+  Optparse.fromRecord
+    { packagesToRemove: Flags.packagesToRemove
+    , selectedPackage: Flags.selectedPackage
+    , testDeps: Flags.testDeps
+    }
+
 buildArgsParser :: Parser (BuildArgs ())
 buildArgsParser = Optparse.fromRecord
   { selectedPackage: Flags.selectedPackage
@@ -536,6 +554,10 @@ main = do
             env' <- runSpago env (mkBuildEnv buildArgs dependencies)
             let options = { depsOnly: true, pursArgs: List.toUnfoldable args.pursArgs, jsonErrors: false }
             runSpago env' (Build.run options)
+          Uninstall { packagesToRemove, selectedPackage, testDeps } -> do
+            { env, fetchOpts } <- mkFetchEnv offline { packages: packagesToRemove, selectedPackage, ensureRanges: false, testDeps: false }
+            let options = { testDeps, dependenciesToRemove: Set.fromFoldable fetchOpts.packages }
+            runSpago { workspace: env.workspace, logOptions: env.logOptions } (Uninstall.run options)
           Build args@{ selectedPackage, ensureRanges, jsonErrors } -> do
             { env, fetchOpts } <- mkFetchEnv offline { packages: mempty, selectedPackage, ensureRanges, testDeps: false }
             -- TODO: --no-fetch flag

src/Spago/Command/Uninstall.purs

@@ -0,0 +1,120 @@
+module Spago.Command.Uninstall
+  ( run
+  , UninstallEnv
+  , UninstallArgs
+  ) where
+
+import Spago.Prelude
+
+import Data.Array as Array
+import Data.Array.NonEmpty as NEA
+import Data.FoldableWithIndex (foldlWithIndex)
+import Data.Map as Map
+import Data.Set.NonEmpty as NonEmptySet
+import Node.Path as Path
+import Registry.PackageName as PackageName
+import Spago.Config (Dependencies, PackageConfig, Workspace)
+import Spago.Config as Config
+import Spago.Config as Core
+import Spago.FS as FS
+
+type UninstallArgs =
+  { dependenciesToRemove :: Set PackageName
+  , testDeps :: Boolean
+  }
+
+type UninstallEnv =
+  { workspace :: Workspace
+  , logOptions :: LogOptions
+  }
+
+run :: UninstallArgs -> Spago UninstallEnv Unit
+run args = do
+  logDebug "Running `spago uninstall`"
+  { workspace } <- ask
+  let
+    modifyConfig
+      :: FilePath
+      -> YamlDoc Core.Config
+      -> String
+      -> NonEmptyArray PackageName
+      -> Spago UninstallEnv Unit
+    modifyConfig configPath yamlDoc sourceOrTestString = \removedPackages -> do
+      logInfo
+        [ "Removing the following " <> sourceOrTestString <> " dependencies:"
+        , "  " <> intercalateMap ", " PackageName.print removedPackages
+        ]
+      logDebug $ "Editing config file at path: " <> configPath
+      liftEffect $ Config.removePackagesFromConfig yamlDoc args.testDeps $ NonEmptySet.fromFoldable1 removedPackages
+      liftAff $ FS.writeYamlDocFile configPath yamlDoc
+      where
+      intercalateMap sep f = _.val <<< foldl go { init: true, val: "" }
+        where
+        go acc next = { init: false, val: if acc.init then f next else acc.val <> sep <> f next }
+
+    toContext
+      :: FilePath
+      -> YamlDoc Core.Config
+      -> PackageConfig
+      -> Either
+           PackageName
+           { name :: PackageName
+           , deps :: Dependencies
+           , sourceOrTestString :: String
+           , modifyDoc :: NonEmptyArray PackageName -> Spago UninstallEnv Unit
+           }
+    toContext configPath yamlDoc pkgConfig
+      | args.testDeps = case pkgConfig.test of
+          Nothing ->
+            Left pkgConfig.name
+          Just { dependencies } -> do
+            let sourceOrTestString = "test"
+            Right
+              { name: pkgConfig.name
+              , deps: dependencies
+              , sourceOrTestString
+              , modifyDoc: modifyConfig configPath yamlDoc sourceOrTestString
+              }
+      | otherwise = do
+          let sourceOrTestString = "source"
+          Right
+            { name: pkgConfig.name
+            , deps: pkgConfig.dependencies
+            , sourceOrTestString
+            , modifyDoc: modifyConfig configPath yamlDoc sourceOrTestString
+            }
+  missingTestConfigOrContext <- case workspace.selected of
+    Just p ->
+      pure $ toContext (Path.concat [ p.path, "spago.yaml" ]) p.doc p.package
+    Nothing -> do
+      case workspace.rootPackage of
+        Nothing ->
+          die "No package was selected. Please select a package."
+        Just p ->
+          pure $ toContext "spago.yaml" workspace.doc p
+  case missingTestConfigOrContext of
+    Left pkgName ->
+      logWarn $ "Could not uninstall test dependencies for " <> PackageName.print pkgName <> " because it does not have a test configuration."
+    Right context -> do
+      logDebug $ "Existing " <> context.sourceOrTestString <> " dependencies are: " <> (Array.intercalate ", " $ foldlWithIndex (\k a _ -> Array.snoc a $ PackageName.print k) [] $ unwrap context.deps)
+      let
+        { warn, removed } = foldl separate init args.dependenciesToRemove
+          where
+          init = { warn: [], removed: [] }
+
+          separate :: _ -> PackageName -> _
+          separate acc next
+            | Map.member next $ unwrap context.deps = acc { removed = Array.snoc acc.removed next }
+            | otherwise = acc { warn = Array.snoc acc.warn next }
+      for_ (NEA.fromArray warn) \undeclaredPkgs ->
+        logWarn
+          [ "The following packages cannot be uninstalled because they are not declared in the package's " <> context.sourceOrTestString <> " dependencies:"
+          , "  " <> NEA.intercalate ", " (map PackageName.print undeclaredPkgs)
+          ]
+
+      case NEA.fromArray removed of
+        Nothing ->
+          logInfo $ "The package config for " <> PackageName.print context.name <> " was not updated."
+        Just removed' ->
+          context.modifyDoc removed'
+

src/Spago/Config.js

@@ -56,6 +56,24 @@ export function addPackagesToConfigImpl(doc, isTest, newPkgs) {
   deps.items = newItems;
 }
 
+export function removePackagesFromConfigImpl(doc, isTest, shouldRemove) {
+  const pkg = doc.get("package");
+
+  const deps = isTest ? pkg.get("test").get("dependencies") : pkg.get("dependencies");
+  let newItems = [];
+  for (const el of deps.items) {
+    if (
+      (Yaml.isScalar(el) && shouldRemove(el.value)) || 
+        (Yaml.isMap(el) && shouldRemove(el.items[0].key))
+    ) {
+      continue;
+    }
+    newItems.push(el);
+  }
+  newItems.sort();
+  deps.items = newItems;
+}
+
 export function addRangesToConfigImpl(doc, rangesMap) {
   const deps = doc.get("package").get("dependencies");
 

src/Spago/Config.purs

@@ -9,6 +9,7 @@ module Spago.Config
   , WorkspacePackage
   , addPackagesToConfig
   , addRangesToConfig
+  , removePackagesFromConfig
   , rootPackageToWorkspacePackage
   , getPackageLocation
   , fileSystemCharEscape
@@ -36,6 +37,8 @@ import Data.Int as Int
 import Data.Map as Map
 import Data.Profunctor as Profunctor
 import Data.Set as Set
+import Data.Set.NonEmpty (NonEmptySet)
+import Data.Set.NonEmpty as NonEmptySet
 import Data.String (CodePoint, Pattern(..))
 import Data.String as String
 import Dodo as Log
@@ -535,6 +538,11 @@ foreign import addPackagesToConfigImpl :: EffectFn3 (YamlDoc Core.Config) Boolea
 addPackagesToConfig :: YamlDoc Core.Config -> Boolean -> Array PackageName -> Effect Unit
 addPackagesToConfig doc isTest pkgs = runEffectFn3 addPackagesToConfigImpl doc isTest (map PackageName.print pkgs)
 
+foreign import removePackagesFromConfigImpl :: EffectFn3 (YamlDoc Core.Config) Boolean (PackageName -> Boolean) Unit
+
+removePackagesFromConfig :: YamlDoc Core.Config -> Boolean -> NonEmptySet PackageName -> Effect Unit
+removePackagesFromConfig doc isTest pkgs = runEffectFn3 removePackagesFromConfigImpl doc isTest (flip NonEmptySet.member pkgs)
+
 foreign import addRangesToConfigImpl :: EffectFn2 (YamlDoc Core.Config) (Foreign.Object String) Unit
 
 addRangesToConfig :: YamlDoc Core.Config -> Map PackageName Range -> Effect Unit

test-fixtures/uninstall-deps-undeclared-src-deps.txt

@@ -0,0 +1,8 @@
+Reading Spago workspace configuration...
+Read the package set from the registry
+
+✅ Selecting package to build: uninstall-tests
+
+⚠️ The following packages cannot be uninstalled because they are not declared in the package's source dependencies:
+  either
+The package config for uninstall-tests was not updated.

test-fixtures/uninstall-deps-undeclared-test-deps.txt

@@ -0,0 +1,8 @@
+Reading Spago workspace configuration...
+Read the package set from the registry
+
+✅ Selecting package to build: uninstall-tests
+
+⚠️ The following packages cannot be uninstalled because they are not declared in the package's test dependencies:
+  either
+The package config for uninstall-tests was not updated.

test-fixtures/uninstall-no-package-selection.txt

@@ -0,0 +1,9 @@
+Reading Spago workspace configuration...
+Read the package set from the registry
+
+✅ Selecting 2 packages to build:
+    bar
+    foo
+
+
+❌ No package was selected. Please select a package.

test-fixtures/uninstall-no-test-config.txt

@@ -0,0 +1,6 @@
+Reading Spago workspace configuration...
+Read the package set from the registry
+
+✅ Selecting package to build: uninstall-tests
+
+⚠️ Could not uninstall test dependencies for uninstall-tests because it does not have a test configuration.

test-fixtures/uninstall-remove-src-deps.txt

@@ -0,0 +1,7 @@
+Reading Spago workspace configuration...
+Read the package set from the registry
+
+✅ Selecting package to build: uninstall-tests
+
+Removing the following source dependencies:
+  either

test-fixtures/uninstall-remove-test-deps.txt

@@ -0,0 +1,7 @@
+Reading Spago workspace configuration...
+Read the package set from the registry
+
+✅ Selecting package to build: uninstall-tests
+
+Removing the following test dependencies:
+  either

test/Prelude.purs

@@ -209,6 +209,18 @@ writePursFile { moduleName, rest } =
   where
   modNameLine = "module " <> moduleName <> " where"
 
+editSpagoYaml :: (Config -> Config) -> Aff Unit
+editSpagoYaml = editSpagoYaml' "spago.yaml"
+
+editSpagoYaml' :: FilePath -> (Config -> Config) -> Aff Unit
+editSpagoYaml' configPath f = do
+  content <- liftAff $ FS.readYamlDocFile Config.configCodec configPath
+  case content of
+    Left err ->
+      Assert.fail $ "Failed to decode spago.yaml file at path " <> configPath <> "\n" <> err
+    Right { yaml: config } ->
+      liftAff $ FS.writeYamlFile Config.configCodec configPath $ f config
+
 mkDependencies :: Array String -> Config.Dependencies
 mkDependencies = Config.Dependencies <<< Map.fromFoldable <<< map (flip Tuple Nothing <<< mkPackageName)
 

test/Spago.purs

@@ -21,6 +21,7 @@ import Test.Spago.Registry as Registry
 import Test.Spago.Run as Run
 import Test.Spago.Sources as Sources
 import Test.Spago.Test as Test
+import Test.Spago.Uninstall as Uninstall
 import Test.Spago.Unit as Unit
 import Test.Spago.Upgrade as Upgrade
 import Test.Spec as Spec
@@ -41,6 +42,7 @@ main = Aff.launchAff_ $ void $ un Identity $ Spec.Runner.runSpecT testConfig [ S
     Init.spec
     Sources.spec
     Install.spec
+    Uninstall.spec
     Ls.spec
     Build.spec
     Run.spec

test/Spago/Build/Pedantic.purs

@@ -6,11 +6,9 @@ import Data.Array as Array
 import Data.Map as Map
 import Node.Path as Path
 import Spago.Core.Config (Dependencies(..), Config)
-import Spago.Core.Config as Core
 import Spago.FS as FS
 import Test.Spec (SpecT)
 import Test.Spec as Spec
-import Test.Spec.Assertions as Assert
 
 spec :: SpecT Aff TestDirs Identity Unit
 spec =
@@ -189,15 +187,6 @@ spec =
       editSpagoYaml (addPedanticFlagToSrc >>> addPedanticFlagToTest)
       spago [ "build" ] >>= shouldBeFailureErr (fixture "pedantic/check-pedantic-packages.txt")
 
-editSpagoYaml :: (Config -> Config) -> Aff Unit
-editSpagoYaml f = do
-  content <- FS.readYamlDocFile Core.configCodec "spago.yaml"
-  case content of
-    Left err ->
-      Assert.fail $ "Failed to decode spago.yaml file\n" <> err
-    Right { yaml: config } ->
-      FS.writeYamlFile Core.configCodec "spago.yaml" $ f config
-
 addPedanticFlagToSrc :: Config -> Config
 addPedanticFlagToSrc config = config
   { package = config.package <#> \r -> r