Fixup rest of the PR

This commit is contained in:
Julian Ospald 2021-08-11 16:19:31 +02:00
parent fcba151fad
commit 57c791106b
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
2 changed files with 59 additions and 22 deletions

View File

@ -1317,16 +1317,10 @@ toSettings options = do
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools , bShowAllTools = fromMaybe bShowAllTools kShowAllTools
} }
updateSettings :: UTF8.ByteString -> Settings -> IO Settings updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
updateSettings config settings = do updateSettings config settings = do
settings' <- runE @'[JSONError] $ lE' JSONDecodeError . first show . Y.decodeEither' $ config settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
pure $ mergeConf settings' settings
case settings' of
VRight r -> pure $ mergeConf r settings
VLeft (V (JSONDecodeError e)) -> do
B.hPut stderr ("Error decoding config: " <> (E.encodeUtf8 . T.pack . show $ e))
die ""
_ -> die "Unexpected error!"
where where
mergeConf :: UserSettings -> Settings -> Settings mergeConf :: UserSettings -> Settings -> Settings
mergeConf UserSettings{..} Settings{..} = mergeConf UserSettings{..} Settings{..} =
@ -1372,11 +1366,10 @@ describe_result = $( LitE . StringL <$>
) )
) )
formatConfig :: Settings -> KeyBindings -> String formatConfig :: UserSettings -> String
formatConfig settings keybindings = unlines [formatSettings, formatKeybindings] formatConfig settings
= UTF8.toString . YP.encodePretty yamlConfig $ settings
where where
formatKeybindings = unlines . ("key-bindings:":) . map (" "++) . lines . UTF8.toString . YP.encodePretty yamlConfig $ keybindings
formatSettings = UTF8.toString . YP.encodePretty yamlConfig $ settings
yamlConfig = YP.setConfCompare compare YP.defConfig yamlConfig = YP.setConfCompare compare YP.defConfig
main :: IO () main :: IO ()
@ -2087,25 +2080,34 @@ Make sure to clean up #{tmpdir} afterwards.|])
Config InitConfig -> do Config InitConfig -> do
path <- getConfigFilePath path <- getConfigFilePath
writeFile path $ formatConfig settings keybindings writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
runLogger $ $(logDebug) [i|"config.yaml initialized at #{path}|] runLogger $ $(logDebug) [i|"config.yaml initialized at #{path}|]
pure ExitSuccess pure ExitSuccess
Config ShowConfig -> do Config ShowConfig -> do
putStrLn $ formatConfig settings keybindings putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
pure ExitSuccess pure ExitSuccess
Config (SetConfig k v) -> do Config (SetConfig k v) -> do
case v of case v of
"" -> die "Empty values are not allowed." "" -> do
runLogger $ $(logError) "Empty values are not allowed"
pure $ ExitFailure 55
_ -> do _ -> do
settings' <- updateSettings [i|#{k}: #{v}\n|] settings r <- runE @'[JSONError] $ do
runLogger $ $(logDebug) $ T.pack $ show settings' settings' <- updateSettings [i|#{k}: #{v}\n|] settings
path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
runLogger $ $(logDebug) $ T.pack $ show settings'
pure ()
path <- getConfigFilePath case r of
writeFile path $ formatConfig settings' keybindings VRight _ -> pure ExitSuccess
VLeft (V (JSONDecodeError e)) -> do
pure ExitSuccess runLogger $ $(logError)
[i|Error decoding config: #{e}|]
pure $ ExitFailure 65
VLeft _ -> pure $ ExitFailure 65
Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) -> Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) ->
runLeanWhereIs (do runLeanWhereIs (do

View File

@ -304,6 +304,41 @@ data UserSettings = UserSettings
defaultUserSettings :: UserSettings defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
UserSettings {
uCache = Just cache
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
, uDownloader = Just downloader
, uNoNetwork = Just noNetwork
, uKeyBindings = Nothing
, uUrlSource = Just urlSource
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
{ kUp = Just bUp
, kDown = Just bDown
, kQuit = Just bQuit
, kInstall = Just bInstall
, kUninstall = Just bUninstall
, kSet = Just bSet
, kChangelog = Just bChangelog
, kShowAll = Just bShowAllVersions
, kShowAllTools = Just bShowAllTools
}
in UserSettings {
uCache = Just cache
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
, uDownloader = Just downloader
, uNoNetwork = Just noNetwork
, uKeyBindings = Just ukb
, uUrlSource = Just urlSource
}
data UserKeyBindings = UserKeyBindings data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe Key { kUp :: Maybe Key
, kDown :: Maybe Key , kDown :: Maybe Key