Gracefully handle stack binary not installed by ghcup
This commit is contained in:
parent
4dcc63606e
commit
54e8e3efb0
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user