From 57c791106b0c5ef294c38cbbb08e056a384d71b5 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Wed, 11 Aug 2021 16:19:31 +0200
Subject: [PATCH] Fixup rest of the PR

---
 app/ghcup/Main.hs  | 46 ++++++++++++++++++++++++----------------------
 lib/GHCup/Types.hs | 35 +++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 22 deletions(-)

diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
index 8634d5c..cd25480 100644
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -1317,16 +1317,10 @@ toSettings options = do
          , bShowAllTools = fromMaybe bShowAllTools kShowAllTools
          }
 
-updateSettings :: UTF8.ByteString -> Settings -> IO Settings
+updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
 updateSettings config settings = do
-  settings' <- runE @'[JSONError] $ lE' JSONDecodeError . first show . Y.decodeEither' $ config
-
-  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!"
+  settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
+  pure $ mergeConf settings' settings
   where
    mergeConf :: UserSettings -> Settings -> Settings
    mergeConf UserSettings{..} Settings{..} =
@@ -1372,11 +1366,10 @@ describe_result = $( LitE . StringL <$>
                      )
                    )
 
-formatConfig :: Settings -> KeyBindings -> String
-formatConfig settings keybindings = unlines [formatSettings, formatKeybindings]
+formatConfig :: UserSettings -> String
+formatConfig settings
+  = UTF8.toString . YP.encodePretty yamlConfig $ settings
  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
 
 main :: IO ()
@@ -2087,25 +2080,34 @@ Make sure to clean up #{tmpdir} afterwards.|])
 
             Config InitConfig -> do
               path <- getConfigFilePath
-              writeFile path $ formatConfig settings keybindings
+              writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
               runLogger $ $(logDebug) [i|"config.yaml initialized at #{path}|]
               pure ExitSuccess
 
             Config ShowConfig -> do
-              putStrLn $ formatConfig settings keybindings
+              putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
               pure ExitSuccess
 
             Config (SetConfig k v) -> do
               case v of
-                "" -> die "Empty values are not allowed."
+                "" -> do
+                  runLogger $ $(logError) "Empty values are not allowed"
+                  pure $ ExitFailure 55
                 _  -> do
-                  settings' <- updateSettings [i|#{k}: #{v}\n|] settings
-                  runLogger $ $(logDebug) $ T.pack $ show settings'
+                  r <- runE @'[JSONError] $ do
+                    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
-                  writeFile path $ formatConfig settings' keybindings
-
-                  pure ExitSuccess
+                  case r of
+                      VRight _ -> pure ExitSuccess
+                      VLeft (V (JSONDecodeError e)) -> do
+                        runLogger $ $(logError)
+                          [i|Error decoding config: #{e}|]
+                        pure $ ExitFailure 65
+                      VLeft _ -> pure $ ExitFailure 65
 
             Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) ->
               runLeanWhereIs (do
diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs
index 762cb30..e6089d3 100644
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@@ -304,6 +304,41 @@ data UserSettings = UserSettings
 defaultUserSettings :: UserSettings
 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
   { kUp        :: Maybe Key
   , kDown      :: Maybe Key