From 66a62c170c88e1ce007faff287b18b9fba09b372 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Thu, 10 Feb 2022 20:35:09 +0100 Subject: [PATCH] Fix 'ghcup run' for legacy HLS --- app/ghcup/GHCup/OptParse/Run.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/app/ghcup/GHCup/OptParse/Run.hs b/app/ghcup/GHCup/OptParse/Run.hs index 2518e32..4433a89 100644 --- a/app/ghcup/GHCup/OptParse/Run.hs +++ b/app/ghcup/GHCup/OptParse/Run.hs @@ -15,6 +15,7 @@ import GHCup.Utils.File import GHCup.OptParse.Common import GHCup.Errors import GHCup.Types +import GHCup.Types.Optics ( getDirs ) import GHCup.Utils.Logger import GHCup.Utils.String.QQ @@ -309,8 +310,22 @@ run RunOptions{..} runAppState leanAppstate runLogger = do cbin <- liftIO $ canonicalizePath bin lift $ createLink (relativeSymlink tmp cbin) (tmp "stack") HLS -> do - liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp) - liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp) + Dirs {..} <- getDirs + let v' = _tvVersion v + legacy <- isLegacyHLS v' + if legacy + then do + -- TODO: factor this out + (Just hlsWrapper) <- hlsWrapperBinary v' + cw <- liftIO $ canonicalizePath (binDir hlsWrapper) + lift $ createLink (relativeSymlink tmp cw) (tmp takeFileName cw) + hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir )) + forM_ hlsBins $ \bin -> + lift $ createLink (relativeSymlink tmp bin) (tmp takeFileName bin) + liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp) + else do + liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp) + liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp) GHCup -> pure () addToPath path = do