Improve logging, fixes #228

lib/GHCup/Download.hs

@@ -165,17 +165,17 @@ getBase :: ( MonadReader env m
            , MonadMask m
            )
         => URI
-        -> Excepts '[JSONError] m GHCupInfo
+        -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
 getBase uri = do
-  Settings { noNetwork } <- lift getSettings
+  Settings { noNetwork, downloader } <- lift getSettings
 
   -- try to download yaml... usually this writes it into cache dir,
   -- but in some cases not (e.g. when using file://), so we honour
   -- the return filepath, if any
   mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
            then pure Nothing
-           else handleIO (\e -> warnCache (displayException e) >> pure Nothing)
-               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e) >> pure Nothing)
+           else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
+               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
                . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
                . fmap Just
                . smartDl
@@ -183,7 +183,7 @@ getBase uri = do
 
   -- if we didn't get a filepath from the download, use the cached yaml
   actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
-  yamlContents <- liftIO $ L.readFile actualYaml
+  yamlContents <- liftIOException doesNotExistErrorType (FileDoesNotExistError actualYaml) $ liftIO $ L.readFile actualYaml
   lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
 
   liftE
@@ -201,9 +201,19 @@ getBase uri = do
     handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
       (hideError doesNotExistErrorType $ rmFile efp)
     liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
-  warnCache s = do
-    lift $ logWarn "Could not get download info, trying cached version (this may not be recent!)"
-    lift $ logDebug $ "Error was: " <> T.pack s
+
+  warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
+  warnCache s downloader' = do
+    let tryDownloder = case downloader' of
+                         Curl -> "Wget"
+                         Wget -> "Curl"
+#if defined(INTERNAL_DOWNLOADER)
+                         Internal -> "Curl"
+#endif
+    logWarn $ "Could not get download info, trying cached version (this may not be recent!)" <> "\n" <>
+      "If this problem persists, consider switching downloader via: " <> "\n    " <>
+      "ghcup config set downloader " <> tryDownloder
+    logDebug $ "Error was: " <> T.pack s
 
   -- First check if the json file is in the ~/.ghcup/cache dir
   -- and check it's access time. If it has been accessed within the

lib/GHCup/Errors.hs

@@ -285,31 +285,37 @@ instance Pretty HadrianNotFound where
     -------------------------
 
 -- | A download failed. The underlying error is encapsulated.
-data DownloadFailed = forall x xs . (Show x, Show (V xs), Pretty x, Pretty (V xs)) => DownloadFailed (V (x ': xs))
+data DownloadFailed = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
 
 instance Pretty DownloadFailed where
   pPrint (DownloadFailed reason) =
-    text "Download failed:" <+> pPrint reason
+    case reason of
+      VMaybe (_ :: DownloadFailed) -> pPrint reason
+      _ -> text "Download failed:" <+> pPrint reason
 
 deriving instance Show DownloadFailed
 
 
 -- | A build failed.
-data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
+data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
 
 instance Pretty BuildFailed where
   pPrint (BuildFailed path reason) =
-    text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
+    case reason of
+      VMaybe (_ :: BuildFailed) -> pPrint reason
+      _ -> text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
 
 deriving instance Show BuildFailed
 
 
 -- | Setting the current GHC version failed.
-data GHCupSetError = forall es . (Show (V es), Pretty (V es)) => GHCupSetError (V es)
+data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es)) => GHCupSetError (V es)
 
 instance Pretty GHCupSetError where
   pPrint (GHCupSetError reason) =
-    text "Setting the current GHC version failed:" <+> pPrint reason
+    case reason of
+      VMaybe (_ :: GHCupSetError) -> pPrint reason
+      _ -> text "Setting the current GHC version failed:" <+> pPrint reason
 
 deriving instance Show GHCupSetError
 

lib/GHCup/Utils.hs

@@ -834,6 +834,8 @@ getChangeLog dls tool (Right tag) =
 --   2. the install destination, depending on whether the build failed
 runBuildAction :: ( Pretty (V e)
                   , Show (V e)
+                  , PopVariant BuildFailed e
+                  , ToVariantMaybe BuildFailed e
                   , MonadReader env m
                   , HasDirs env
                   , HasSettings env

lib/GHCup/Utils/File/Common.hs

@@ -28,11 +28,11 @@ data ProcessError = NonZeroExit Int FilePath [String]
 
 instance Pretty ProcessError where
   pPrint (NonZeroExit e exe args) =
-    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " failed with exit code " <+> text (show e) <+> "."
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
   pPrint (PTerminated exe args) =
-    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " terminated."
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
   pPrint (PStopped exe args) =
-    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " stopped."
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
   pPrint (NoSuchPid exe args) =
     text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."