Gracefully handle stack binary not installed by ghcup

This commit is contained in:
Julian Ospald 2021-06-12 22:27:31 +02:00
parent 4dcc63606e
commit 54e8e3efb0
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F

View File

@ -355,18 +355,25 @@ getInstalledStacks = do
-- Return the currently set stack version, if any. -- Return the currently set stack version, if any.
-- TODO: there's a lot of code duplication here :> -- 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 stackSet = do
AppState {dirs = Dirs {..}} <- ask AppState {dirs = Dirs {..}} <- ask
let stackBin = binDir </> "stack" <> exeExt let stackBin = binDir </> "stack" <> exeExt
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- isBrokenSymlink stackBin broken <- liftIO $ isBrokenSymlink stackBin
if broken if broken
then pure Nothing then pure Nothing
else do else do
link <- liftIO $ getLinkTarget stackBin link <- liftIO
Just <$> linkVersion link $ 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 where
linkVersion :: MonadThrow m => FilePath -> m Version linkVersion :: MonadThrow m => FilePath -> m Version
linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt