Support HLS dynamic builds

2022-02-05 01:53:04 +01:00 · 2022-02-05 01:53:04 +01:00 · 51690d1df3
commit 51690d1df3
parent 72a06e964c
8 changed files with 277 additions and 126 deletions
--- a/app/ghcup/BrickMain.hs
+++ b/app/ghcup/BrickMain.hs
@ -495,7 +495,7 @@ set' _ (_, ListResult {..}) = do
      case lTool of
        GHC   -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
        Cabal -> liftE $ setCabal lVer $> ()
-        HLS   -> liftE $ setHLS lVer $> ()
+        HLS   -> liftE $ setHLS lVer SetHLSOnly $> ()
        Stack -> liftE $ setStack lVer $> ()
        GHCup -> pure ()
    )
--- a/app/ghcup/GHCup/OptParse/Compile.hs
+++ b/app/ghcup/GHCup/OptParse/Compile.hs
@ -466,7 +466,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
        GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
        let vi = getVersionInfo targetVer HLS dls
        when setCompile $ void $ liftE $
-          setHLS targetVer
+          setHLS targetVer SetHLSOnly
        pure (vi, targetVer)
        )
        >>= \case
--- a/app/ghcup/GHCup/OptParse/Install.hs
+++ b/app/ghcup/GHCup/OptParse/Install.hs
@ -469,8 +469,9 @@ install installCommand settings getAppState' runLogger = case installCommand of
       Just uri -> do
         runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
           (v, vi) <- liftE $ fromVersion instVer HLS
+           -- TODO: support legacy
           liftE $ installHLSBindist
-                     (DownloadInfo uri Nothing "")
+                     (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
                     (_tvVersion v)
                     isolateDir
                     forceInstall
--- a/app/ghcup/GHCup/OptParse/Set.hs
+++ b/app/ghcup/GHCup/OptParse/Set.hs
@ -311,10 +311,10 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
          -> m ExitCode
  setHLS' SetOptions{ sToolVer } =
    case sToolVer of
-      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) >> pure v)
+      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly >> pure v)
      _ -> runSetHLS runAppState (do
          v <- liftE $ fst <$> fromVersion' sToolVer HLS
-          liftE $ setHLS (_tvVersion v)
+          liftE $ setHLS (_tvVersion v) SetHLSOnly
          pure v
        )
      >>= \case
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@ -6,7 +6,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE QuasiQuotes           #-}

 {-|
 Module      : GHCup
@ -301,22 +300,6 @@ installPackedGHC dl msubdir inst ver forceInstall = do
  liftE $ runBuildAction tmpUnpack
                         (Just inst)
                         (installUnpackedGHC workdir inst ver)
- where
-  -- | Does basic checks for isolated installs
-  -- Isolated Directory:
-  --   1. if it doesn't exist -> proceed
-  --   2. if it exists and is empty -> proceed
-  --   3. if it exists and is non-empty -> panic and leave the house
-  installDestSanityCheck :: ( MonadIO m
-                            , MonadCatch m
-                            ) =>
-                            FilePath ->
-                            Excepts '[DirNotEmpty] m ()
-  installDestSanityCheck isoDir = do
-    hideErrorDef [doesNotExistErrorType] () $ do
-      contents <- liftIO $ getDirectoryContentsRecursive isoDir
-      unless (null contents) (throwE $ DirNotEmpty isoDir)
-


 -- | Install an unpacked GHC distribution. This only deals with the GHC
@ -582,6 +565,8 @@ installHLSBindist :: ( MonadMask m
                        , TarDirDoesNotExist
                        , ArchiveResult
                        , FileAlreadyExistsError
+                        , ProcessError
+                        , DirNotEmpty
                        ]
                       m
                       ()
@ -617,26 +602,55 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do

  -- the subdir of the archive where we do the work
  workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
+  legacy <- liftIO $ isLegacyHLSBindist workdir
+
+  if
+    | not forceInstall
+    , not legacy
+    , (Just fp) <- isoFilepath -> liftE $ installDestSanityCheck fp
+    | otherwise -> pure ()

  case isoFilepath of
    Just isoDir -> do
      lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
-      liftE $ installHLSUnpacked workdir isoDir Nothing forceInstall
+      if legacy
+      then liftE $ installHLSUnpackedLegacy workdir isoDir Nothing forceInstall
+      else liftE $ installHLSUnpacked workdir isoDir ver

    Nothing -> do
-      liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall
+      if legacy
+      then liftE $ installHLSUnpackedLegacy workdir binDir (Just ver) forceInstall
+      else do
+        inst <- ghcupHLSDir ver
+        liftE $ installHLSUnpacked workdir inst ver
+        liftE $ setHLS ver SetHLS_XYZ

  liftE $ installHLSPostInst isoFilepath ver

+isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
+                   -> IO Bool
+isLegacyHLSBindist path = do
+  not <$> doesFileExist (path </> "GNUmakefile")

 -- | Install an unpacked hls distribution.
-installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
-              => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
-              -> FilePath      -- ^ Path to install to
-              -> Maybe Version -- ^ Nothing for isolated install
-              -> Bool          -- ^ is it a force install
-              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
-installHLSUnpacked path inst mver' forceInstall = do
+installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m)
+                   => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
+                   -> FilePath      -- ^ Path to install to
+                   -> Version
+                   -> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
+installHLSUnpacked path inst _ = do
+  lift $ logInfo "Installing HLS"
+  liftIO $ createDirRecursive' inst
+  lEM $ make ["PREFIX=" <> inst, "install"] (Just path)
+
+-- | Install an unpacked hls distribution (legacy).
+installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
+                         => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
+                         -> FilePath      -- ^ Path to install to
+                         -> Maybe Version -- ^ Nothing for isolated install
+                         -> Bool          -- ^ is it a force install
+                         -> Excepts '[CopyError, FileAlreadyExistsError] m ()
+installHLSUnpackedLegacy path inst mver' forceInstall = do
  lift $ logInfo "Installing HLS"
  liftIO $ createDirRecursive' inst

@ -692,7 +706,7 @@ installHLSPostInst isoFilepath ver =
      -- create symlink if this is the latest version in a regular install
      hlsVers <- lift $ fmap rights getInstalledHLSs
      let lInstHLS = headMay . reverse . sort $ hlsVers
-      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
+      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver SetHLSOnly


 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
@ -725,6 +739,8 @@ installHLSBin :: ( MonadMask m
                    , TarDirDoesNotExist
                    , ArchiveResult
                    , FileAlreadyExistsError
+                    , ProcessError
+                    , DirNotEmpty
                    ]
                   m
                   ()
@ -894,9 +910,9 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
      case isolateDir of
        Just isoDir -> do
          lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
-          liftE $ installHLSUnpacked installDir isoDir Nothing True
+          liftE $ installHLSUnpackedLegacy installDir isoDir Nothing True
        Nothing -> do
-          liftE $ installHLSUnpacked installDir binDir (Just installVer) True
+          liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
    )

  liftE $ installHLSPostInst isolateDir installVer
@ -1088,9 +1104,9 @@ setGHC ver sghc = do
  -- first delete the old symlinks (this fixes compatibility issues
  -- with old ghcup)
  case sghc of
-    SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
-    SetGHC_XY  -> liftE $ rmMajorSymlinks ver
-    SetGHC_XYZ -> liftE $ rmMinorSymlinks ver
+    SetGHCOnly -> liftE $ rmPlainGHC (_tvTarget ver)
+    SetGHC_XY  -> liftE $ rmMajorGHCSymlinks ver
+    SetGHC_XYZ -> liftE $ rmMinorGHCSymlinks ver

  -- for ghc tools (ghc, ghci, haddock, ...)
  verfiles <- ghcToolFiles ver
@ -1170,7 +1186,7 @@ unsetGHC :: ( MonadReader env m
            )
         => Maybe Text
         -> Excepts '[NotInstalled] m ()
-unsetGHC = rmPlain
+unsetGHC = rmPlainGHC


 -- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
@ -1222,35 +1238,54 @@ setHLS :: ( MonadReader env m
          , MonadUnliftIO m
          )
       => Version
+       -> SetHLS -- Nothing for legacy
       -> Excepts '[NotInstalled] m ()
-setHLS ver = do
+setHLS ver shls = do
+  whenM (lift $ not <$> hlsInstalled ver) (throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)))
+
+  -- symlink destination
  Dirs {..} <- lift getDirs

-  -- Delete old symlinks, since these might have different ghc versions than the
-  -- selected version, so we could end up with stray or incorrect symlinks.
-  oldSyms <- lift hlsSymlinks
-  forM_ oldSyms $ \f -> do
-    lift $ logDebug $ "rm " <> T.pack (binDir </> f)
-    lift $ rmLink (binDir </> f)
+  -- first delete the old symlinks
+  case shls of
+    -- not for legacy
+    SetHLS_XYZ -> liftE $ rmMinorHLSSymlinks ver
+    -- legacy and new
+    SetHLSOnly -> liftE $ rmPlainHLS

-  -- set haskell-language-server-<ghcver> symlinks
-  bins <- lift $ hlsServerBinaries ver Nothing
-  when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
+  case shls of
+    -- not for legacy
+    SetHLS_XYZ -> do
+      bins <- lift $ hlsInternalServerBinaries ver

-  forM_ bins $ \f -> do
-    let destL = f
-    let target = (<> exeExt) . head . splitOn "~" $ f
-    lift $ createLink destL (binDir </> target)
+      forM_ bins $ \f -> do
+        destL <- hlsLinkDestination f ver
+        let target = if "haskell-language-server-wrapper" `isPrefixOf` f
+                     then f <> "-" <> T.unpack (prettyVer ver) <> exeExt
+                     else f <> "~" <> T.unpack (prettyVer ver) <> exeExt
+        lift $ createLink destL (binDir </> target)

-  -- set haskell-language-server-wrapper symlink
-  let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
-  let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
+      pure ()
+    -- legacy and new
+    SetHLSOnly -> do
+      -- set haskell-language-server-<ghcver> symlinks
+      bins <- lift $ hlsServerBinaries ver Nothing
+      when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)

-  lift $ createLink destL wrapper
+      forM_ bins $ \f -> do
+        let destL = f
+        let target = (<> exeExt) . head . splitOn "~" $ f
+        lift $ createLink destL (binDir </> target)

-  lift warnAboutHlsCompatibility
+      -- set haskell-language-server-wrapper symlink
+      let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
+      let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt

-  pure ()
+      lift $ createLink destL wrapper
+
+      lift warnAboutHlsCompatibility
+
+      pure ()


 unsetHLS :: ( MonadMask m
@ -1720,14 +1755,14 @@ rmGHCVer ver = do
  -- this isn't atomic, order matters
  when isSetGHC $ do
    lift $ logInfo "Removing ghc symlinks"
-    liftE $ rmPlain (_tvTarget ver)
+    liftE $ rmPlainGHC (_tvTarget ver)

  lift $ logInfo "Removing ghc-x.y.z symlinks"
-  liftE $ rmMinorSymlinks ver
+  liftE $ rmMinorGHCSymlinks ver

  lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
  -- first remove
-  handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
+  handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorGHCSymlinks ver
  -- then fix them (e.g. with an earlier version)

  lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
@ -1794,24 +1829,19 @@ rmHLSVer :: ( MonadMask m
 rmHLSVer ver = do
  whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))

-  isHlsSet      <- lift hlsSet
+  isHlsSet <- lift hlsSet

-  Dirs {..} <- lift getDirs
-
-  bins <- lift $ hlsAllBinaries ver
-  forM_ bins $ \f -> lift $ recycleFile (binDir </> f)
+  liftE $ rmMinorHLSSymlinks ver
+  hlsDir <- ghcupHLSDir ver
+  recyclePathForcibly hlsDir

  when (Just ver == isHlsSet) $ do
    -- delete all set symlinks
-    oldSyms <- lift hlsSymlinks
-    forM_ oldSyms $ \f -> do
-      let fullF = binDir </> f
-      lift $ logDebug $ "rm " <> T.pack fullF
-      lift $ rmLink fullF
+    rmPlainHLS
    -- set latest hls
    hlsVers <- lift $ fmap rights getInstalledHLSs
    case headMay . reverse . sort $ hlsVers of
-      Just latestver -> setHLS latestver
+      Just latestver -> setHLS latestver SetHLSOnly
      Nothing        -> pure ()


@ -2687,7 +2717,11 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
    HLS -> do
      whenM (lift $ fmap not $ hlsInstalled _tvVersion)
        $ throwE (NotInstalled HLS (GHCTargetVersion Nothing _tvVersion))
-      pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt)
+      bdir <- lift $ ghcupHLSDir _tvVersion
+      liftIO $ doesDirectoryExist bdir >>= \case
+        True -> pure (bdir </> "bin" </> "haskell-language-server-wrapper" <> exeExt)
+        -- legacy
+        False -> pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt)

    Stack -> do
      whenM (lift $ fmap not $ stackInstalled _tvVersion)
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@ -484,6 +484,10 @@ data SetGHC = SetGHCOnly  -- ^ unversioned 'ghc'
            | SetGHC_XYZ  -- ^ ghc-x.y.z
            deriving (Eq, Show)

+data SetHLS = SetHLSOnly  -- ^ unversioned 'hls'
+            | SetHLS_XYZ  -- ^ haskell-language-server-a.b.c~x.y.z, where a.b.c is GHC version and x.y.z is HLS version
+            deriving (Eq, Show)
+

 data PlatformResult = PlatformResult
  { _platform      :: Platform
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@ -128,7 +128,9 @@ import qualified Data.List.NonEmpty            as NE
 -- | The symlink destination of a ghc tool.
 ghcLinkDestination :: ( MonadReader env m
                      , HasDirs env
-                      , MonadThrow m, MonadIO m)
+                      , MonadThrow m
+                      , MonadIO m
+                      )
                   => FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
                   -> GHCTargetVersion
                   -> m FilePath
@ -138,18 +140,33 @@ ghcLinkDestination tool ver = do
  pure (relativeSymlink binDir (ghcd </> "bin" </> tool))


+-- | The symlink destination of a hls binary.
+hlsLinkDestination :: ( MonadReader env m
+                      , HasDirs env
+                      , MonadThrow m
+                      , MonadIO m
+                      )
+                   => FilePath -- ^ the binary
+                   -> Version
+                   -> m FilePath
+hlsLinkDestination tool ver = do
+  Dirs {..}  <- getDirs
+  hlsd <- ghcupHLSDir ver
+  pure (relativeSymlink binDir (hlsd </> "bin" </> tool))
+
+
 -- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
-rmMinorSymlinks :: ( MonadReader env m
-                   , HasDirs env
-                   , MonadIO m
-                   , HasLog env
-                   , MonadThrow m
-                   , MonadFail m
-                   , MonadMask m
-                   )
-                => GHCTargetVersion
-                -> Excepts '[NotInstalled] m ()
-rmMinorSymlinks tv@GHCTargetVersion{..} = do
+rmMinorGHCSymlinks :: ( MonadReader env m
+                      , HasDirs env
+                      , MonadIO m
+                      , HasLog env
+                      , MonadThrow m
+                      , MonadFail m
+                      , MonadMask m
+                      )
+                   => GHCTargetVersion
+                   -> Excepts '[NotInstalled] m ()
+rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
  Dirs {..}  <- lift getDirs

  files                         <- liftE $ ghcToolFiles tv
@ -161,17 +178,17 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do


 -- | Removes the set ghc version for the given target, if any.
-rmPlain :: ( MonadReader env m
-           , HasDirs env
-           , HasLog env
-           , MonadThrow m
-           , MonadFail m
-           , MonadIO m
-           , MonadMask m
-           )
-        => Maybe Text -- ^ target
-        -> Excepts '[NotInstalled] m ()
-rmPlain target = do
+rmPlainGHC :: ( MonadReader env m
+              , HasDirs env
+              , HasLog env
+              , MonadThrow m
+              , MonadFail m
+              , MonadIO m
+              , MonadMask m
+              )
+           => Maybe Text -- ^ target
+           -> Excepts '[NotInstalled] m ()
+rmPlainGHC target = do
  Dirs {..}  <- lift getDirs
  mtv                           <- lift $ ghcSet target
  forM_ mtv $ \tv -> do
@ -187,17 +204,17 @@ rmPlain target = do


 -- | Remove the major GHC symlink, e.g. ghc-8.6.
-rmMajorSymlinks :: ( MonadReader env m
-                   , HasDirs env
-                   , MonadIO m
-                   , HasLog env
-                   , MonadThrow m
-                   , MonadFail m
-                   , MonadMask m
-                   )
-                => GHCTargetVersion
-                -> Excepts '[NotInstalled] m ()
-rmMajorSymlinks tv@GHCTargetVersion{..} = do
+rmMajorGHCSymlinks :: ( MonadReader env m
+                      , HasDirs env
+                      , MonadIO m
+                      , HasLog env
+                      , MonadThrow m
+                      , MonadFail m
+                      , MonadMask m
+                      )
+                   => GHCTargetVersion
+                   -> Excepts '[NotInstalled] m ()
+rmMajorGHCSymlinks tv@GHCTargetVersion{..} = do
  Dirs {..}  <- lift getDirs
  (mj, mi) <- getMajorMinorV _tvVersion
  let v' = intToText mj <> "." <> intToText mi
@ -210,6 +227,62 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
    lift $ hideError doesNotExistErrorType $ rmLink fullF


+-- | Removes the minor HLS files, e.g. 'haskell-language-server-8.10.7~1.6.1.0'
+-- and 'haskell-language-server-wrapper-1.6.1.0'.
+rmMinorHLSSymlinks :: ( MonadReader env m
+                      , HasDirs env
+                      , MonadIO m
+                      , HasLog env
+                      , MonadThrow m
+                      , MonadFail m
+                      , MonadMask m
+                      )
+                   => Version
+                   -> Excepts '[NotInstalled] m ()
+rmMinorHLSSymlinks ver = do
+  Dirs {..}  <- lift getDirs
+
+  hlsBins <- hlsAllBinaries ver
+  forM_ hlsBins $ \f -> do
+    let fullF = binDir </> f <> exeExt
+    lift $ logDebug ("rm -f " <> T.pack fullF)
+    -- on unix, this may be either a file (legacy) or a symlink
+    -- on windows, this is always a file... hence 'rmFile'
+    -- works consistently across platforms
+    lift $ rmFile fullF
+
+-- | Removes the set HLS version, if any.
+rmPlainHLS :: ( MonadReader env m
+              , HasDirs env
+              , HasLog env
+              , MonadThrow m
+              , MonadFail m
+              , MonadIO m
+              , MonadMask m
+              )
+           => Excepts '[NotInstalled] m ()
+rmPlainHLS = do
+  Dirs {..}  <- lift getDirs
+
+  -- delete 'haskell-language-server-8.10.7'
+  hlsBins <- fmap (filter (\f -> not ("haskell-language-server-wrapper" `isPrefixOf` f) && not ('~' `elem` f)))
+    $ liftIO $ handleIO (\_ -> pure []) $ findFiles
+      binDir
+      (makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString))
+  forM_ hlsBins $ \f -> do
+    let fullF = binDir </> f
+    lift $ logDebug ("rm -f " <> T.pack fullF)
+    if isWindows
+    then lift $ rmLink fullF
+    else lift $ rmFile fullF
+
+  -- 'haskell-language-server-wrapper'
+  let hlswrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
+  lift $ logDebug ("rm -f " <> T.pack hlswrapper)
+  if isWindows
+  then lift $ hideError doesNotExistErrorType $ rmLink hlswrapper
+  else lift $ hideError doesNotExistErrorType $ rmFile hlswrapper
+


    -----------------------------------
@ -353,7 +426,8 @@ cabalSet = do


 -- | Get all installed hls, by matching on
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
+-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
+-- as well as @~\/.ghcup\/hls\/<\hlsver\>@
 getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
                 => m [Either FilePath Version]
 getInstalledHLSs = do
@ -364,7 +438,7 @@ getInstalledHLSs = do
                   execBlank
                   ([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
    )
-  forM bins $ \f ->
+  legacy <- forM bins $ \f ->
    case
          version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
      of
@ -372,6 +446,14 @@ getInstalledHLSs = do
        Just (Left  _) -> pure $ Left f
        Nothing        -> pure $ Left f

+  hlsdir <- ghcupHLSBaseDir
+  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory hlsdir
+  new <- forM fs $ \f -> case parseGHCupHLSDir f of
+    Right r -> pure $ Right r
+    Left  _ -> pure $ Left f
+  pure (nub (new <> legacy))
+
+
 -- | Get all installed stacks, by matching on
 -- @~\/.ghcup\/bin/stack-<\stackver\>@.
 getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
@ -518,7 +600,7 @@ hlsGHCVersions' v' = do
  pure . sortBy (flip compare) . rights $ vers


-- | Get all server binaries for an hls version, if any.
+-- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
 hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
                  => Version
                  -> Maybe Version   -- ^ optional GHC version
@ -539,6 +621,14 @@ hlsServerBinaries ver mghcVer = do
      )
    )

+-- | Get all binaries for an hls version from the ~/.ghcup/hls/<ver>/bin directory, if any.
+hlsInternalServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
+                          => Version
+                          -> m [FilePath]
+hlsInternalServerBinaries ver = do
+  dir <- ghcupHLSDir ver
+  liftIO $ listDirectory (dir </> "bin")
+

 -- | Get the wrapper binary for an hls version, if any.
 hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
@ -569,22 +659,6 @@ hlsAllBinaries ver = do
  pure (maybeToList wrapper ++ hls)


-- | Get the active symlinks for hls.
-hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
-hlsSymlinks = do
-  Dirs {..}  <- getDirs
-  oldSyms                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
-    binDir
-    (makeRegexOpts compExtended
-                   execBlank
-                   ([s|^haskell-language-server-.*$|] :: ByteString)
-    )
-  filterM
-    ( liftIO
-    . pathIsLink
-    . (binDir </>)
-    )
-    oldSyms



@ -1157,3 +1231,19 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
 ghcBinaryName :: GHCTargetVersion -> String
 ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
 ghcBinaryName (GHCTargetVersion Nothing  _) = T.unpack ("ghc" <> T.pack exeExt)
+
+
+-- | Does basic checks for isolated installs
+-- Isolated Directory:
+--   1. if it doesn't exist -> proceed
+--   2. if it exists and is empty -> proceed
+--   3. if it exists and is non-empty -> panic and leave the house
+installDestSanityCheck :: ( MonadIO m
+                          , MonadCatch m
+                          ) =>
+                          FilePath ->
+                          Excepts '[DirNotEmpty] m ()
+installDestSanityCheck isoDir = do
+  hideErrorDef [doesNotExistErrorType] () $ do
+    contents <- liftIO $ getDirectoryContentsRecursive isoDir
+    unless (null contents) (throwE $ DirNotEmpty isoDir)
--- a/lib/GHCup/Utils/Dirs.hs
+++ b/lib/GHCup/Utils/Dirs.hs
@ -20,8 +20,11 @@ module GHCup.Utils.Dirs
  , ghcupCacheDir
  , ghcupGHCBaseDir
  , ghcupGHCDir
+  , ghcupHLSBaseDir
+  , ghcupHLSDir
  , mkGhcupTmpDir
  , parseGHCupGHCDir
+  , parseGHCupHLSDir
  , relativeSymlink
  , withGHCupTmpDir
  , getConfigFilePath
@ -46,6 +49,7 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource hiding (throwM)
 import           Data.Bifunctor
 import           Data.Maybe
+import           Data.Versions
 import           GHC.IO.Exception               ( IOErrorType(NoSuchThing) )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
@ -244,6 +248,24 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
 parseGHCupGHCDir (T.pack -> fp) =
  throwEither $ MP.parse ghcTargetVerP "" fp

+parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
+parseGHCupHLSDir (T.pack -> fp) =
+  throwEither $ MP.parse version' "" fp
+
+-- | ~/.ghcup/hls by default, for new-style installs.
+ghcupHLSBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
+ghcupHLSBaseDir = do
+  Dirs {..}  <- getDirs
+  pure (baseDir </> "hls")
+
+-- | Gets '~/.ghcup/hls/<hls-ver>' for new-style installs.
+ghcupHLSDir :: (MonadReader env m, HasDirs env, MonadThrow m)
+            => Version
+            -> m FilePath
+ghcupHLSDir ver = do
+  basedir <- ghcupHLSBaseDir
+  let verdir = T.unpack $ prettyVer ver
+  pure (basedir </> verdir)

 mkGhcupTmpDir :: ( MonadReader env m
                 , HasDirs env