diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs
index 1bff8338d2c44dfba6bcf3fd4b458c74aa8d7369..5975bf10ee0cf22fffff0a614ebc4bc65842869e 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 f29c223eae8a7af98c70b0cef20cc40db02525e6..d83d7f63453b8059669e5a77b02bc5f57b181e69 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 cc4ea5f5048d79975b284b308b25869bf1b8bf6c..ad21d46fec317edac90bccf4a0894a7f1674669e 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 3aac1ea587400cc2b2c40ce08e33562347444e51..1fd0447e7aba4e8e26b164a2fcae7b75efaf81ad 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 3da16994b2852fa8c36e9a45ea38d18f36355905..2316a4a7f93bc16ba68427d38592bf2e1a42dea3 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