hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Allow to specify config value as JSON

Browse Source
This commit is contained in:
Julian Ospald 2021-10-19 20:38:53 +02:00
parent 69df100b18
commit 2a11e85a95
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 36 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
app/ghcup/GHCup/OptParse/Config.hs
View File

@ -28,6 +28,7 @@ import Data.Functor
import Data.Maybe import Data.Maybe
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
@ -46,7 +47,7 @@ import Control.Exception.Safe (MonadMask)
data ConfigCommand data ConfigCommand
= ShowConfig = ShowConfig
| SetConfig String String | SetConfig String (Maybe String)
| InitConfig | InitConfig
@ -67,8 +68,8 @@ configP = subparser
where where
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml") initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
showP = info (pure ShowConfig) (progDesc "Show current config (default)") showP = info (pure ShowConfig) (progDesc "Show current config (default)")
setP = info argsP (progDesc "Set config KEY to VALUE") setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
argsP = SetConfig <$> argument str (metavar "KEY") <*> argument str (metavar "VALUE") argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
@ -88,7 +89,19 @@ configFooter = [s|Examples:
ghcup config init ghcup config init
# set <key> <value> configuration pair # set <key> <value> configuration pair
ghcup config <key> <value>|] ghcup config set <key> <value>|]
configSetFooter :: String
configSetFooter = [s|Examples:
# disable caching
ghcup config set cache false
# switch downloader to wget
ghcup config set downloader Wget
# set mirror for ghcup metadata
ghcup config set '{url-source: { OwnSource: "<url>"}}'|]
@ -147,14 +160,19 @@ config configCommand settings keybindings runLogger = case configCommand of
liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings) liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
pure ExitSuccess pure ExitSuccess
(SetConfig k v) -> do (SetConfig k (Just v)) ->
case v of case v of
"" -> do "" -> do
runLogger $ logError "Empty values are not allowed" runLogger $ logError "Empty values are not allowed"
pure $ ExitFailure 55 pure $ ExitFailure 55
_ -> do _ -> doConfig (k <> ": " <> v <> "\n")
(SetConfig json Nothing) -> doConfig json
where
doConfig val = do
r <- runE @'[JSONError] $ do r <- runE @'[JSONError] $ do
settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings settings' <- updateSettings (UTF8.fromString val) settings
path <- liftIO getConfigFilePath path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings) liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
lift $ runLogger $ logDebug $ T.pack $ show settings' lift $ runLogger $ logDebug $ T.pack $ show settings'