From 787c927de6cd49f83e53d34dbd31c8c16accfae4 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Mon, 6 Sep 2021 22:31:07 +0200 Subject: [PATCH] Improve logging, fixes #228 --- lib/GHCup/Download.hs | 26 ++++++++++++++++++-------- lib/GHCup/Errors.hs | 18 ++++++++++++------ lib/GHCup/Utils.hs | 2 ++ lib/GHCup/Utils/File/Common.hs | 6 +++--- stack.yaml | 16 ++++++++++++---- 5 files changed, 47 insertions(+), 21 deletions(-) diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 1bff833..5975bf1 100644 --- a/lib/GHCup/Download.hs +++ b/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 diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs index f29c223..d83d7f6 100644 --- a/lib/GHCup/Errors.hs +++ b/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 diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index cc4ea5f..ad21d46 100644 --- a/lib/GHCup/Utils.hs +++ b/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 diff --git a/lib/GHCup/Utils/File/Common.hs b/lib/GHCup/Utils/File/Common.hs index 3aac1ea..1fd0447 100644 --- a/lib/GHCup/Utils/File/Common.hs +++ b/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 "." diff --git a/stack.yaml b/stack.yaml index 3da1699..2316a4a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,18 +10,18 @@ extra-deps: - git: https://github.com/hasufell/libarchive commit: 8587aab78dd515928024ecd82c8f215e06db85cd - - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530 - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445 - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582 - base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231 + - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530 - brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964 - brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331 - chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153 - chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496 - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216 - - haskus-utils-data-1.3@sha256:f62c4e49021b463185d043f7b69c727b63af641a71d7edd582d9f4f98e80e500,1466 + - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466 - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298 - - haskus-utils-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159 + - haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159 - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269 - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615 - hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712 @@ -30,11 +30,11 @@ extra-deps: - hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179 - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582 - lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308 - - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716 - optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568 - optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995 - optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432 - optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009 + - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716 - primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728 - regex-posix-clib-2.7 - streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421 @@ -63,3 +63,11 @@ ghc-options: "$locals": -O2 streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 ghcup: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 + +build: + test: true + test-arguments: + no-run-tests: true + bench: true + benchmark-opts: + no-run-benchmarks: true