Fixup rest of the PR
This commit is contained in:
parent
fcba151fad
commit
57c791106b
@ -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
|
||||||
|
r <- runE @'[JSONError] $ do
|
||||||
settings' <- updateSettings [i|#{k}: #{v}\n|] 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'
|
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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user