Skip to content
Snippets Groups Projects

Fix disappearing HLS symlinks wrt #91

Merged Julian Ospald requested to merge fix-hls-symlinks-disappearing into master
3 files
+ 47
38
Compare changes
  • Side-by-side
  • Inline
Files
3
+ 38
31
@@ -112,33 +112,40 @@ ghcLinkDestination tool ver = do
@@ -112,33 +112,40 @@ ghcLinkDestination tool ver = do
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
rmMinorSymlinks :: (MonadReader AppState m, MonadIO m, MonadLogger m) => GHCTargetVersion -> m ()
rmMinorSymlinks :: ( MonadReader AppState m
rmMinorSymlinks GHCTargetVersion {..} = do
, MonadIO m
AppState { dirs = Dirs {..} } <- ask
, MonadLogger m
, MonadThrow m
files <- liftIO $ findFiles'
, MonadFail m
binDir
, MonadReader AppState m
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
)
*> parseUntil1 (MP.chunk $ prettyVer _tvVersion)
=> GHCTargetVersion
*> (MP.chunk $ prettyVer _tvVersion)
-> Excepts '[NotInstalled] m ()
*> MP.eof
rmMinorSymlinks tv@(GHCTargetVersion {..}) = do
)
AppState { dirs = Dirs {..} } <- lift ask
 
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
forM_ files $ \f -> do
let fullF = (binDir </> f)
f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> verToBS _tvVersion)
$(logDebug) [i|rm -f #{toFilePath fullF}|]
let fullF = (binDir </> f_xyz)
 
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
-- | Removes the set ghc version for the given target, if any.
-- | Removes the set ghc version for the given target, if any.
rmPlain :: (MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
rmPlain :: ( MonadReader AppState m
=> Maybe Text -- ^ target
, MonadLogger m
 
, MonadThrow m
 
, MonadFail m
 
, MonadIO m
 
)
 
=> Maybe Text -- ^ target
-> Excepts '[NotInstalled] m ()
-> Excepts '[NotInstalled] m ()
rmPlain target = do
rmPlain target = do
AppState { dirs = Dirs {..} } <- lift ask
AppState { dirs = Dirs {..} } <- lift ask
mtv <- lift $ ghcSet target
mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do
forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
forM_ files $ \f -> do
let fullF = (binDir </> f)
let fullF = (binDir </> f)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
@@ -150,25 +157,25 @@ rmPlain target = do
@@ -150,25 +157,25 @@ rmPlain target = do
-- | Remove the major GHC symlink, e.g. ghc-8.6.
-- | Remove the major GHC symlink, e.g. ghc-8.6.
rmMajorSymlinks :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m)
rmMajorSymlinks :: ( MonadReader AppState m
 
, MonadIO m
 
, MonadLogger m
 
, MonadThrow m
 
, MonadFail m
 
, MonadReader AppState m
 
)
=> GHCTargetVersion
=> GHCTargetVersion
-> m ()
-> Excepts '[NotInstalled] m ()
rmMajorSymlinks GHCTargetVersion {..} = do
rmMajorSymlinks tv@(GHCTargetVersion {..}) = do
AppState { dirs = Dirs {..} } <- ask
AppState { dirs = Dirs {..} } <- lift ask
(mj, mi) <- getMajorMinorV _tvVersion
(mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi
let v' = intToText mj <> "." <> intToText mi
files <- liftIO $ findFiles'
files <- liftE $ ghcToolFiles tv
binDir
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk v')
*> MP.chunk v'
*> MP.eof
)
forM_ files $ \f -> do
forM_ files $ \f -> do
let fullF = (binDir </> f)
f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> E.encodeUtf8 v')
$(logDebug) [i|rm -f #{toFilePath fullF}|]
let fullF = (binDir </> f_xyz)
 
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
Loading