hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improve logging on broken symlinks wrt #880

Browse Source
This commit is contained in:
Julian Ospald 2023-09-02 16:16:15 +08:00
parent c914a284de
commit fbb648d984
No known key found for this signature in database
GPG Key ID: 4275CDA6A29BED43
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lib/GHCup/Utils.hs
View File

@ -369,7 +369,9 @@ cabalSet = do
handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- liftIO $ isBrokenSymlink cabalbin broken <- liftIO $ isBrokenSymlink cabalbin
if broken if broken
then pure Nothing then do
logWarn $ "Broken symlink at " <> T.pack cabalbin
pure Nothing
else do else do
link <- liftIO link <- liftIO
$ handleIO' InvalidArgument $ handleIO' InvalidArgument
@ -466,7 +468,9 @@ stackSet = do
handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- liftIO $ isBrokenSymlink stackBin broken <- liftIO $ isBrokenSymlink stackBin
if broken if broken
then pure Nothing then do
logWarn $ "Broken symlink at " <> T.pack stackBin
pure Nothing
else do else do
link <- liftIO link <- liftIO
$ handleIO' InvalidArgument $ handleIO' InvalidArgument
@ -520,15 +524,17 @@ isLegacyHLS ver = do
-- Return the currently set hls version, if any. -- Return the currently set hls version, if any.
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) hlsSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet = do hlsSet = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- isBrokenSymlink hlsBin broken <- liftIO $ isBrokenSymlink hlsBin
if broken if broken
then pure Nothing then do
logWarn $ "Broken symlink at " <> T.pack hlsBin
pure Nothing
else do else do
link <- liftIO $ getLinkTarget hlsBin link <- liftIO $ getLinkTarget hlsBin
Just <$> linkVersion link Just <$> linkVersion link
@ -556,6 +562,7 @@ hlsSet = do
-- | Return the GHC versions the currently selected HLS supports. -- | Return the GHC versions the currently selected HLS supports.
hlsGHCVersions :: ( MonadReader env m hlsGHCVersions :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasLog env
, MonadIO m , MonadIO m
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m