From 54e8e3efb051a2f9de805c8a6ea6ead6439a0c38 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 12 Jun 2021 22:27:31 +0200
Subject: [PATCH] Gracefully handle stack binary not installed by ghcup
---
lib/GHCup/Utils.hs | 17 ++++++++++++-----
1 file changed, 12 insertions(+), 5 deletions(-)
diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs
index aaedb9ba..b3bd570f 100644
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@@ -355,18 +355,25 @@ getInstalledStacks = do
-- Return the currently set stack version, if any.
-- TODO: there's a lot of code duplication here :>
-stackSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+stackSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
stackSet = do
AppState {dirs = Dirs {..}} <- ask
let stackBin = binDir </> "stack" <> exeExt
- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
- broken <- isBrokenSymlink stackBin
+ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
+ broken <- liftIO $ isBrokenSymlink stackBin
if broken
then pure Nothing
else do
- link <- liftIO $ getLinkTarget stackBin
- Just <$> linkVersion link
+ link <- liftIO
+ $ handleIO' InvalidArgument
+ (\e -> pure $ Left (toException e))
+ $ fmap Right $ getLinkTarget stackBin
+ case linkVersion =<< link of
+ Right v -> pure $ Just v
+ Left err -> do
+ $(logWarn) [i|Failed to parse stack symlink target with: "#{err}". The symlink #{stackBin} needs to point to valid stack binary, such as 'stack-2.7.1'.|]
+ pure Nothing
where
linkVersion :: MonadThrow m => FilePath -> m Version
linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
--
GitLab