Reset config

ghcup.cabal

@@ -331,6 +331,7 @@ library ghcup-optparse
     GHCup.OptParse.List
     GHCup.OptParse.Nuke
     GHCup.OptParse.Prefetch
+    GHCup.OptParse.Reset
     GHCup.OptParse.Rm
     GHCup.OptParse.Run
     GHCup.OptParse.Set

lib-opt/GHCup/OptParse.hs

@@ -57,7 +57,6 @@ import           GHCup.Utils.Parsers (gpgParser, downloaderParser, keepOnParser,
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
-import           Control.Monad.Reader
 import           Data.Either
 import           Data.Functor
 import           Data.Maybe

lib-opt/GHCup/OptParse/Config.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -19,6 +18,7 @@ import           GHCup.Prelude
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
 import           GHCup.OptParse.Common
+import           GHCup.OptParse.Reset (resetUserConfig, toUserSettingsKey)
 import           GHCup.Version
 
 #if !MIN_VERSION_base(4,13,0)
@@ -28,6 +28,7 @@ import           Control.Monad (when)
 import           Control.Exception              ( displayException )
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
+import           Data.Foldable (foldl')
 import           Data.Functor
 import           Data.Maybe
 import           Data.Variant.Excepts
@@ -52,10 +53,13 @@ import Control.Exception.Safe (MonadMask)
 data ConfigCommand
   = ShowConfig
   | SetConfig String (Maybe String)
+  | ResetConfig ResetCommand
   | InitConfig
   | AddReleaseChannel Bool NewURLSource
   deriving (Eq, Show)
 
+data ResetCommand = ResetKeys [String] | ResetAll
+  deriving (Eq, Show)
 
 
     ---------------
@@ -67,22 +71,32 @@ configP :: Parser ConfigCommand
 configP = subparser
       (  command "init" initP
       <> command "set"  setP -- [set] KEY VALUE at help lhs
+      <> command "reset" resetP
       <> command "show" showP
       <> command "add-release-channel" addP
       )
     <|> pure ShowConfig
  where
   initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
   showP = info (pure ShowConfig) (progDesc "Show current config (default)")
-  setP  = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
-  argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
+  setP  = info setArgsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
+  setArgsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
+  resetP = info resetArgsP
+    (progDesc "Reset the whole config or just specific keys" <> footerDoc (Just $ text configResetFooter))
+  resetArgsP = ResetConfig <$> subparser
+       ( command "all"
+         (info (pure ResetAll) (progDesc "Reset the whole config"))
+      <> command "keys"
+         (info resetKeysP (progDesc "Reset specific keys of the config"))
+       )
+  resetKeysP = ResetKeys <$> some (strArgument
+    (  metavar "YAML_KEY"
+    <> help "Specify key(s)" ))
   addP  = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing")
                 <*> argument (eitherReader parseNewUrlSource) (metavar "<URL_SOURCE|cross|prereleases|vanilla>" <> completer urlSourceCompleter))
     (progDesc "Add a release channel, e.g. from a URI or using alias")
 
 
-
-
     --------------
     --[ Footer ]--
     --------------
@@ -100,6 +114,9 @@ configFooter = [s|Examples:
   # set <key> <value> configuration pair
   ghcup config set <key> <value>
 
+  # reset config key(s)
+  ghcup config reset keys <key> <key> ...
+
   # add a release channel
   ghcup config add-release-channel prereleases|]
 
@@ -120,6 +137,16 @@ configSetFooter = [s|Examples:
   # set mirror for ghcup metadata
   ghcup config set '{url-source: { OwnSource: "<url>"}}'|]
 
+configResetFooter :: String
+configResetFooter = [s|Examples:
+  # reset the whole config
+  ghcup config reset all
+
+  # reset one key (cache)
+  ghcup config reset keys cache
+
+  # reset some keys (cache, url-source and downloader)
+  ghcup config reset keys cache url-source downloader|]
 
 
     -----------------
@@ -224,6 +251,29 @@ config configCommand settings userConf keybindings runLogger = case configComman
       VLeft e -> do
         runLogger (logError $ T.pack $ prettyHFError e)
         pure $ ExitFailure 65
+  (ResetConfig resetCommand) -> do
+    r <- runE @'[ParseError] $ do
+      case resetCommand of
+        ResetAll -> do
+          lift $ doReset defaultUserSettings
+          pure ()
+        ResetKeys stringKeys -> do
+          lift $ runLogger $ logDebug $ "Raw keys: " <> T.pack (show stringKeys)
+          let eKeys = traverse toUserSettingsKey stringKeys
+          lift $ runLogger $ logDebug $ "Handled keys: " <> T.pack (show eKeys)
+          case eKeys of
+            Left invalidString -> do
+              throwE $ ParseError $ "Key <<" <> invalidString <> ">> is invalid"
+            Right keys -> do
+              lift $ runLogger $ logDebug $ "userConf: " <> T.pack (show userConf)
+              let newUserConf = foldl' (\conf key -> resetUserConfig conf key ) userConf keys
+              lift $ doReset newUserConf
+              pure ()
+    case r of
+      VRight _ -> pure ExitSuccess
+      VLeft e -> do
+        runLogger (logError $ T.pack $ prettyHFError e)
+        pure $ ExitFailure 65
 
   AddReleaseChannel force new -> do
     r <- runE @'[DuplicateReleaseChannel] $ do
@@ -260,4 +310,11 @@ config configCommand settings userConf keybindings runLogger = case configComman
     runLogger $ logDebug $ T.pack $ show settings'
     pure ()
 
+  doReset :: MonadIO m => UserSettings -> m ()
+  doReset resetUserSettings = do
+    path <- liftIO getConfigFilePath
+    liftIO $ writeFile path $ formatConfig $ resetUserSettings
+    runLogger $ logDebug $ "reset to config: " <> T.pack (show resetUserSettings)
+    pure ()
+
   decodeSettings = lE' (JSONDecodeError . displayException) . Y.decodeEither' . UTF8.fromString

lib-opt/GHCup/OptParse/Reset.hs

@@ -0,0 +1,65 @@
+module GHCup.OptParse.Reset where
+
+import GHCup.Types (UserSettings(..))
+
+-- UserSettingsKey constructors correspond to UserSettings fields
+data UserSettingsKey
+    = Cache
+    | MetaCache
+    | MetaMode
+    | NoVerify
+    | Verbose
+    | KeepDirs
+    | Downloader
+    | KeyBindings
+    | UrlSource
+    | NoNetwork
+    | GPGSetting
+    | PlatformOverride
+    | Mirrors
+    | DefGHCConfOptions
+    | Pager
+    | GuessVersion
+    deriving (Show, Eq)
+
+toUserSettingsKey :: String -> Either String UserSettingsKey
+toUserSettingsKey = \case
+    "cache" -> Right Cache
+    "meta-cache" -> Right MetaCache
+    "meta-mode" -> Right MetaMode
+    "no-verify" -> Right NoVerify
+    "verbose" -> Right Verbose
+    "keep-dirs" -> Right KeepDirs
+    "downloader" -> Right Downloader
+    "key-bindings" -> Right KeyBindings
+    "url-source" -> Right UrlSource
+    "no-network" -> Right NoNetwork
+    "gpg-setting" -> Right GPGSetting
+    "platform-override" -> Right PlatformOverride
+    "mirrors" -> Right Mirrors
+    "def-ghc-conf-options" -> Right DefGHCConfOptions
+    "pager" -> Right Pager
+    "guess-version" -> Right GuessVersion
+    invalidString -> Left invalidString
+
+resetUserConfig ::
+    UserSettings -> UserSettingsKey -> UserSettings
+resetUserConfig settings key = case key of
+    Cache -> settings { uCache = Nothing }
+    MetaCache -> settings { uMetaCache = Nothing }
+    MetaMode -> settings { uMetaMode = Nothing }
+    NoVerify -> settings { uNoVerify = Nothing }
+    Verbose -> settings { uVerbose = Nothing }
+    KeepDirs -> settings { uKeepDirs = Nothing }
+    Downloader -> settings { uDownloader = Nothing }
+    KeyBindings -> settings { uKeyBindings = Nothing }
+    UrlSource -> settings { uUrlSource = Nothing }
+    NoNetwork -> settings { uNoNetwork = Nothing }
+    GPGSetting -> settings { uGPGSetting = Nothing }
+    PlatformOverride -> settings { uPlatformOverride = Nothing }
+    Mirrors -> settings { uMirrors = Nothing }
+    DefGHCConfOptions -> settings { uDefGHCConfOptions = Nothing }
+    Pager -> settings { uPager = Nothing }
+    GuessVersion -> settings { uGuessVersion = Nothing }
+
+

lib/GHCup/Types.hs

@@ -400,6 +400,8 @@ data MetaMode = Strict
 
 instance NFData MetaMode
 
+-- If you add, remove, or rename any fields,
+-- make sure to update the GHCup.OptParse.Reset module as well.
 data UserSettings = UserSettings
   { uCache             :: Maybe Bool
   , uMetaCache         :: Maybe Integer

test/optparse-test/ConfigTest.hs

@@ -48,6 +48,24 @@ checkList =
     , AddReleaseChannel False (NewChannelAlias VanillaChannel)
     )
   , ("config set cache true", SetConfig "cache" (Just "true"))
+  , ("config reset all", ResetConfig ResetAll)
+  , ("config reset keys cache downloader", ResetConfig (ResetKeys ["cache", "downloader"]))
+  , ("config reset keys cache", ResetConfig (ResetKeys ["cache"]))
+  , ("config reset keys meta-cache", ResetConfig (ResetKeys ["meta-cache"]))
+  , ("config reset keys meta-mode", ResetConfig (ResetKeys ["meta-mode"]))
+  , ("config reset keys no-verify", ResetConfig (ResetKeys ["no-verify"]))
+  , ("config reset keys verbose", ResetConfig (ResetKeys ["verbose"]))
+  , ("config reset keys keep-dirs", ResetConfig (ResetKeys ["keep-dirs"]))
+  , ("config reset keys downloader", ResetConfig (ResetKeys ["downloader"]))
+  , ("config reset keys key-bindings", ResetConfig (ResetKeys ["key-bindings"]))
+  , ("config reset keys url-source", ResetConfig (ResetKeys ["url-source"]))
+  , ("config reset keys no-network", ResetConfig (ResetKeys ["no-network"]))
+  , ("config reset keys gpg-setting", ResetConfig (ResetKeys ["gpg-setting"]))
+  , ("config reset keys platform-override", ResetConfig (ResetKeys ["platform-override"]))
+  , ("config reset keys mirrors", ResetConfig (ResetKeys ["mirrors"]))
+  , ("config reset keys def-ghc-conf-options", ResetConfig (ResetKeys ["def-ghc-conf-options"]))
+  , ("config reset keys pager", ResetConfig (ResetKeys ["pager"]))
+  , ("config reset keys guess-version", ResetConfig (ResetKeys ["guess-version"]))
   ]
 
 configParseWith :: [String] -> IO ConfigCommand