Merge branch 'hls' into master

2020-09-22 15:23:10 +02:00 · 2020-09-22 15:23:10 +02:00 · 9276664465
parent a94bcdb92d 5da5fabfef
commit 9276664465
15 changed files with 10537 additions and 8479 deletions
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@ -17,7 +17,7 @@ variables:
    BIT: "64"

 .alpine:64bit:
-  image: "alpine:edge"
+  image: "alpine:3.12"
  tags:
    - x86_64-linux
  variables:
@ -25,7 +25,7 @@ variables:
    BIT: "64"

 .alpine:32bit:
-  image: "i386/alpine:edge"
+  image: "i386/alpine:3.12"
  tags:
    - x86_64-linux
  variables:
--- a/.gitlab/script/ghcup_version.sh
+++ b/.gitlab/script/ghcup_version.sh
@ -93,6 +93,18 @@ eghcup set ${GHC_VERSION}
 eghcup rm 8.4.4
 [ "$(ghc --numeric-version)" = "${ghc_ver}" ]

+# install hls
+if [ "${OS}" = "DARWIN" ] ; then
+	eghcup install hls
+	haskell-language-server-wrapper --version
+elif [ "${OS}" = "LINUX" ] ; then
+	if [ "${BIT}" = "64" ] ; then
+		eghcup install hls
+		haskell-language-server-wrapper --version
+	fi
+fi
+
+
 eghcup rm $(ghc --numeric-version)

 eghcup upgrade
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -2,8 +2,9 @@

 ## 0.1.11 -- ????-??-??

-* Allow to compile over existing version (`ghcup compile ghc -v 8.6.5 -b 8.6.5`) and replace it wrt #59
+* Add support for installing haskell-language-server, wrt #65
 * When compiling GHC from source create a bindist first, store that bindist in `~/.ghcup/cache` and install it, wrt #51
+* Allow to compile over existing version (`ghcup compile ghc -v 8.6.5 -b 8.6.5`) and replace it wrt #59
 * simplify installing from custom bindist wrt #60
  - `ghcup install ghc -u <url> <version>`
 * fix bug when cabal isn't marked executable in bindist
--- a/app/ghcup/BrickMain.hs
+++ b/app/ghcup/BrickMain.hs
@ -71,19 +71,26 @@ ui AppState {..} =
  ( padBottom Max
    $ ( withBorderStyle unicode
      $ borderWithLabel (str "GHCup")
-      $ (center $ renderList renderItem True lr)
+      $ (center $ (header <=> hBorder <=> renderList renderItem True lr))
      )
    )
-    <=> ( withAttr "help"
-        . txtWrap
-        . T.pack
-        . foldr1 (\x y -> x <> "  " <> y)
-        . (++ ["↑↓:Navigation"])
-        $ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
-        )
+    <=> footer

 where
-  renderItem b ListResult {..} =
+  footer =
+    withAttr "help"
+      . txtWrap
+      . T.pack
+      . foldr1 (\x y -> x <> "  " <> y)
+      . (++ ["↑↓:Navigation"])
+      $ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
+  header =
+    (minHSize 2 $ emptyWidget)
+      <+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool")
+      <+> (minHSize 15 $ str "Version")
+      <+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
+      <+> (padLeft (Pad 5) $ str "Notes")
+  renderItem b listResult@(ListResult {..}) =
    let marks = if
          | lSet       -> (withAttr "set" $ str "✔✔")
          | lInstalled -> (withAttr "installed" $ str "✓ ")
@ -94,20 +101,28 @@ ui AppState {..} =
        dim = if lNoBindist
          then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
          else id
+        active = if b then withAttr "active" else id
    in  dim
          (   marks
-          <+> ( padLeft (Pad 2)
-              $ minHSize 20
-              $ ((if b then withAttr "active" else id)
-                  (str $ (fmap toLower . show $ lTool) <> " " <> ver)
-                )
+          <+> (( padLeft (Pad 2)
+               $ active
+               $ minHSize 6
+               $ (str (fmap toLower . show $ lTool))
+               )
              )
-          <+> (padLeft (Pad 1) $ if null lTag
+          <+> (minHSize 15 $ active $ (str ver))
+          <+> (padLeft (Pad 1) $ minHSize 25 $ if null lTag
                then emptyWidget
                else
                  foldr1 (\x y -> x <+> str "," <+> y)
                    $ (fmap printTag $ sort lTag)
              )
+          <+> ( padLeft (Pad 5)
+              $ let notes = printNotes listResult
+                in  if null notes
+                      then emptyWidget
+                      else foldr1 (\x y -> x <+> str "," <+> y) $ notes
+              )
          )

  printTag Recommended        = withAttr "recommended" $ str "recommended"
@ -116,6 +131,13 @@ ui AppState {..} =
  printTag (Base       pvp'') = str ("base-" ++ T.unpack (prettyPVP pvp''))
  printTag (UnknownTag t    ) = str t

+  printNotes ListResult {..} =
+    (if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
+      )
+      ++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
+      ++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
+
+

 minHSize :: Int -> Widget n -> Widget n
 minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
@ -137,8 +159,11 @@ defaultAttributes = attrMap
  , ("set"          , Vty.defAttr `Vty.withForeColor` Vty.green)
  , ("installed"    , Vty.defAttr `Vty.withForeColor` Vty.green)
  , ("recommended"  , Vty.defAttr `Vty.withForeColor` Vty.green)
+  , ("hls-powered"  , Vty.defAttr `Vty.withForeColor` Vty.green)
  , ("latest"       , Vty.defAttr `Vty.withForeColor` Vty.yellow)
  , ("prerelease"   , Vty.defAttr `Vty.withForeColor` Vty.red)
+  , ("compiled"     , Vty.defAttr `Vty.withForeColor` Vty.blue)
+  , ("stray"        , Vty.defAttr `Vty.withForeColor` Vty.blue)
  , ("help"         , Vty.defAttr `Vty.withStyle` Vty.italic)
  ]

@ -223,6 +248,7 @@ install' AppState {..} (_, ListResult {..}) = do
        GHC   -> liftE $ installGHCBin dls lVer pfreq
        Cabal -> liftE $ installCabalBin dls lVer pfreq
        GHCup -> liftE $ upgradeGHCup dls Nothing False pfreq $> ()
+        HLS   -> liftE $ installHLSBin dls lVer pfreq $> ()
    )
    >>= \case
          VRight _                          -> pure $ Right ()
@ -251,6 +277,7 @@ set' _ (_, ListResult {..}) = do
      case lTool of
        GHC   -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
        Cabal -> liftE $ setCabal lVer $> ()
+        HLS   -> liftE $ setHLS lVer $> ()
        GHCup -> pure ()
    )
    >>= \case
@ -270,6 +297,7 @@ del' _ (_, ListResult {..}) = do
      case lTool of
        GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> ()
        Cabal -> liftE $ rmCabalVer lVer $> ()
+        HLS   -> liftE $ rmHLSVer lVer $> ()
        GHCup -> pure ()
    )
    >>= \case
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@ -116,6 +116,7 @@ prettyToolVer (ToolTag t) = show t

 data InstallCommand = InstallGHC InstallOptions
                    | InstallCabal InstallOptions
+                    | InstallHLS InstallOptions

 data InstallOptions = InstallOptions
  { instVer      :: Maybe ToolVersion
@ -125,6 +126,7 @@ data InstallOptions = InstallOptions

 data SetCommand = SetGHC SetOptions
                | SetCabal SetOptions
+                | SetHLS SetOptions

 data SetOptions = SetOptions
  { sToolVer :: Maybe ToolVersion
@ -138,6 +140,7 @@ data ListOptions = ListOptions

 data RmCommand = RmGHC RmOptions
               | RmCabal Version
+               | RmHLS Version

 data RmOptions = RmOptions
  { ghcVer :: GHCTargetVersion
@ -394,10 +397,29 @@ installParser =
                 )
               )
           )
+      <> command
+           "hls"
+           (   InstallHLS
+           <$> (info
+                 (installOpts <**> helper)
+                 (  progDesc "Install haskell-languge-server"
+                 <> footerDoc (Just $ text installHLSFooter)
+                 )
+               )
+           )
      )
    )
    <|> (Right <$> installOpts)
 where
+  installHLSFooter :: String
+  installHLSFooter = [s|Discussion:
+  Installs haskell-language-server binaries and wrapper
+  into "~/.ghcup/bin"
+
+Examples:
+  # install recommended GHC
+  ghcup install hls|]
+
  installGHCFooter :: String
  installGHCFooter = [s|Discussion:
  Installs the specified GHC version (or a recommended default one) into
@ -470,6 +492,16 @@ setParser =
                 )
               )
           )
+      <> command
+           "hls"
+           (   SetHLS
+           <$> (info
+                 (setOpts <**> helper)
+                 (  progDesc "Set haskell-language-server version"
+                 <> footerDoc (Just $ text setHLSFooter)
+                 )
+               )
+           )
      )
    )
    <|> (Right <$> setOpts)
@ -484,6 +516,10 @@ setParser =
  setCabalFooter = [s|Discussion:
    Sets the the current Cabal version.|]

+  setHLSFooter :: String
+  setHLSFooter = [s|Discussion:
+    Sets the the current haskell-language-server version.|]
+

 setOpts :: Parser SetOptions
 setOpts = SetOptions <$> optional toolVersionArgument
@ -526,6 +562,13 @@ rmParser =
                     (progDesc "Remove Cabal version")
               )
           )
+      <> command
+           "hls"
+           (   RmHLS
+           <$> (info (versionParser' <**> helper)
+                     (progDesc "Remove haskell-language-server version")
+               )
+           )
      )
    )
    <|> (Right <$> rmOpts)
@ -976,6 +1019,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                    , TagNotFound
                    ]

+          let
+            runSetHLS =
+              runLogger
+                . flip runReaderT settings
+                . runE
+                  @'[ NotInstalled
+                    , TagNotFound
+                    ]
+
          let runListGHC = runLogger . flip runReaderT settings

          let runRm =
@ -1154,6 +1206,40 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                            $(logError) [i|Also check the logs in #{logsDir}|]
                          pure $ ExitFailure 4

+          let installHLS InstallOptions{..} =
+                (case instBindist of
+                   Nothing -> runInstTool $ do
+                     v <- liftE $ fromVersion dls instVer HLS
+                     liftE $ installHLSBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
+                   Just uri -> runInstTool' settings{noVerify = True} $ do
+                     v <- liftE $ fromVersion dls instVer HLS
+                     liftE $ installHLSBindist
+                         (DownloadInfo uri Nothing "")
+                         (_tvVersion v)
+                         (fromMaybe pfreq instPlatform)
+                  )
+                  >>= \case
+                        VRight _ -> do
+                          runLogger $ $(logInfo) ("HLS installation successful")
+                          pure ExitSuccess
+                        VLeft (V (AlreadyInstalled _ v)) -> do
+                          runLogger $ $(logWarn)
+                            [i|HLS ver #{prettyVer v} already installed, you may want to run 'ghcup rm hls #{prettyVer v}' first|]
+                          pure ExitSuccess
+                        VLeft (V NoDownload) -> do
+
+                          runLogger $ do
+                            case instVer of
+                              Just iver -> $(logError) [i|No available HLS version for #{prettyToolVer iver}|]
+                              Nothing -> $(logError) [i|No available recommended HLS version|]
+                          pure $ ExitFailure 4
+                        VLeft e -> do
+                          runLogger $ do
+                            $(logError) [i|#{e}|]
+                            $(logError) [i|Also check the logs in #{logsDir}|]
+                          pure $ ExitFailure 4
+
+
          let setGHC' SetOptions{..} =
                (runSetGHC $ do
                    v <- liftE $ fromVersion dls sToolVer GHC
@ -1180,6 +1266,17 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                          runLogger ($(logError) [i|#{e}|])
                          pure $ ExitFailure 14

+          let setHLS' SetOptions{..} =
+                (runSetHLS $ do
+                    v <- liftE $ fromVersion dls sToolVer HLS
+                    liftE $ setHLS (_tvVersion v)
+                  )
+                  >>= \case
+                        VRight _ -> pure ExitSuccess
+                        VLeft  e -> do
+                          runLogger ($(logError) [i|#{e}|])
+                          pure $ ExitFailure 14
+
          let rmGHC' RmOptions{..} =
                (runRm $ do
                    liftE $ rmGHCVer ghcVer
@ -1200,6 +1297,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                          runLogger ($(logError) [i|#{e}|])
                          pure $ ExitFailure 15

+          let rmHLS' tv =
+                (runRm $ do
+                    liftE $ rmHLSVer tv
+                  )
+                  >>= \case
+                        VRight _ -> pure ExitSuccess
+                        VLeft  e -> do
+                          runLogger ($(logError) [i|#{e}|])
+                          pure $ ExitFailure 15


          res <- case optCommand of
@ -1211,6 +1317,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
              installGHC iopts
            Install (Left (InstallGHC iopts)) -> installGHC iopts
            Install (Left (InstallCabal iopts)) -> installCabal iopts
+            Install (Left (InstallHLS iopts)) -> installHLS iopts
            InstallCabalLegacy iopts -> do
              runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
              installCabal iopts
@ -1220,6 +1327,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
              setGHC' sopts
            Set (Left (SetGHC sopts)) -> setGHC' sopts
            Set (Left (SetCabal sopts)) -> setCabal' sopts
+            Set (Left (SetHLS sopts)) -> setHLS' sopts

            List (ListOptions {..}) ->
              (runListGHC $ do
@ -1233,6 +1341,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
              rmGHC' rmopts
            Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
            Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
+            Rm (Left (RmHLS rmopts)) -> rmHLS' rmopts

            DInfo ->
              do
@ -1440,7 +1549,8 @@ printListResult raw lr = do
                           Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
                       , intercalate "," $ (fmap printTag $ sort lTag)
                       , intercalate ","
-                       $  (if fromSrc then [color' Blue "compiled"] else mempty)
+                       $  (if hlsPowered then [color' Green "hls-powered"] else mempty)
+                       ++ (if fromSrc then [color' Blue "compiled"] else mempty)
                       ++ (if lStray then [color' Yellow "stray"] else mempty)
                       ++ (if lNoBindist then [color' Red "no-bindist"] else mempty)
                       ]
@ -1482,6 +1592,13 @@ checkForUpdates dls pfreq = do
        $ $(logWarn)
            [i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]

+  forM_ (getLatest dls HLS) $ \l -> do
+    mcabal_ver <- latestInstalled HLS
+    forM mcabal_ver $ \cabal_ver ->
+      when (l > cabal_ver)
+        $ $(logWarn)
+            [i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|]
+
 where
  latestInstalled tool = (fmap lVer . lastMay)
    <$> (listVersions dls (Just tool) (Just ListInstalled) pfreq)
--- a/ghcup-0.0.2.yaml
+++ b/ghcup-0.0.2.yaml
@ -1353,3 +1353,20 @@ ghcupDownloads:
              dlHash: 50ac43199b64bc0724400b0a3db674bef3ec53cf6d41acc04a2c4ca8557e534f
          Linux_Alpine:
            unknown_versioning: *ghcup-32
+
+  HLS:
+    0.4.0:
+      viTags:
+        - Recommended
+        - Latest
+      viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#040
+      viArch:
+        A_64:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://files.hasufell.de/hls/haskell-language-server-Linux-0.4.0.tar.gz
+              dlHash: a132365554a1bfcbdfef7403366854f09e6f05376c6aec6562500f09e32af9ed
+          Darwin:
+            unknown_versioning:
+              dlUri: https://files.hasufell.de/hls/haskell-language-server-macOS-0.4.0.tar.gz
+              dlHash: 8f7ceaf1150774029d45420895546b50fd70605c0ef0b055344a3600e54721ce
--- a/ghcup.cabal
+++ b/ghcup.cabal
@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               ghcup
-version:            0.1.10
+version:            0.1.11
 synopsis:           ghc toolchain installer as an exe/library
 description:
  A rewrite of the shell script ghcup, for providing
--- a/golden/GHCupInfo.json
+++ b/golden/GHCupInfo.json
--- a/hie.yaml
+++ b/hie.yaml
@ -2,3 +2,5 @@ cradle:
  cabal:
    - path: "."
      component: "ghcup:lib:ghcup"
+    - path: "."
+      component: "ghcup:exe:ghcup"
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@ -357,6 +357,130 @@ installCabalBin bDls ver pfreq = do
  installCabalBindist dlinfo ver pfreq


+-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
+-- argument instead of looking it up from 'GHCupDownloads'.
+installHLSBindist :: ( MonadMask m
+                     , MonadCatch m
+                     , MonadReader Settings m
+                     , MonadLogger m
+                     , MonadResource m
+                     , MonadIO m
+                     , MonadFail m
+                     )
+                  => DownloadInfo
+                  -> Version
+                  -> PlatformRequest
+                  -> Excepts
+                       '[ AlreadyInstalled
+                        , CopyError
+                        , DigestError
+                        , DownloadFailed
+                        , NoDownload
+                        , NotInstalled
+                        , UnknownArchive
+                        , TarDirDoesNotExist
+#if !defined(TAR)
+                        , ArchiveResult
+#endif
+                        ]
+                       m
+                       ()
+installHLSBindist dlinfo ver (PlatformRequest {..}) = do
+  lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
+
+  Settings {dirs = Dirs {..}} <- lift ask
+
+  whenM (lift (hlsInstalled ver))
+    $ (throwE $ AlreadyInstalled HLS ver)
+
+  -- download (or use cached version)
+  dl                           <- liftE $ downloadCached dlinfo Nothing
+
+  -- unpack
+  tmpUnpack                    <- lift withGHCupTmpDir
+  liftE $ unpackToDir tmpUnpack dl
+  void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
+
+  -- the subdir of the archive where we do the work
+  workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
+
+  liftE $ installHLS' workdir binDir
+
+  -- create symlink if this is the latest version
+  hlsVers <- lift $ fmap rights $ getInstalledHLSs
+  let lInstHLS = headMay . reverse . sort $ hlsVers
+  when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
+
+  pure ()
+
+ where
+  -- | Install an unpacked hls distribution.
+  installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
+                => Path Abs      -- ^ Path to the unpacked hls bindist (where the executable resides)
+                -> Path Abs      -- ^ Path to install to
+                -> Excepts '[CopyError] m ()
+  installHLS' path inst = do
+    lift $ $(logInfo) "Installing HLS"
+    liftIO $ createDirRecursive' inst
+
+    -- install haskell-language-server-<ghcver>
+    bins@(_:_) <- liftIO $ findFiles
+      path
+      (makeRegexOpts compExtended
+                     execBlank
+                     ([s|^haskell-language-server-[0-9].*$|] :: ByteString)
+      )
+    forM_ bins $ \f -> do
+      toF <- parseRel (toFilePath f <> "~" <> verToBS ver)
+      handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+        (path </> f)
+        (inst </> toF)
+        Overwrite
+      lift $ chmod_777 (inst </> toF)
+
+    -- install haskell-language-server-wrapper
+    let wrapper = [rel|haskell-language-server-wrapper|]
+    toF <- parseRel (toFilePath wrapper <> "-" <> verToBS ver)
+    handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+      (path </> wrapper)
+      (inst </> toF)
+      Overwrite
+    lift $ chmod_777 (inst </> toF)
+
+
+-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
+-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
+installHLSBin :: ( MonadMask m
+                 , MonadCatch m
+                 , MonadReader Settings m
+                 , MonadLogger m
+                 , MonadResource m
+                 , MonadIO m
+                 , MonadFail m
+                 )
+              => GHCupDownloads
+              -> Version
+              -> PlatformRequest
+              -> Excepts
+                   '[ AlreadyInstalled
+                    , CopyError
+                    , DigestError
+                    , DownloadFailed
+                    , NoDownload
+                    , NotInstalled
+                    , UnknownArchive
+                    , TarDirDoesNotExist
+#if !defined(TAR)
+                    , ArchiveResult
+#endif
+                    ]
+                   m
+                   ()
+installHLSBin bDls ver pfreq = do
+  dlinfo <- lE $ getDownloadInfo HLS ver pfreq bDls
+  installHLSBindist dlinfo ver pfreq
+
+


    ---------------------
@ -487,6 +611,55 @@ setCabal ver = do



+-- | Set the haskell-language-server symlinks.
+setHLS :: ( MonadCatch m
+          , MonadReader Settings m
+          , MonadLogger m
+          , MonadThrow m
+          , MonadFail m
+          , MonadIO m
+          )
+       => Version
+       -> Excepts '[NotInstalled] m ()
+setHLS ver = do
+  Settings { dirs = Dirs {..} } <- lift ask
+  liftIO $ createDirRecursive' binDir
+
+  -- 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) [i|rm #{toFilePath (binDir </> f)}|]
+    liftIO $ deleteFile (binDir </> f)
+
+  -- set haskell-language-server-<ghcver> symlinks
+  bins <- lift $ hlsServerBinaries ver
+  when (bins == []) $ throwE $ NotInstalled HLS (prettyVer ver)
+
+  forM_ bins $ \f -> do
+    let destL = toFilePath f
+    target <- parseRel . head . B.split _tilde . toFilePath $ f
+
+    lift $ $(logDebug) [i|rm -f #{toFilePath (binDir </> target)}|]
+    liftIO $ hideError doesNotExistErrorType $ deleteFile (binDir </> target)
+
+    lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath (binDir </> target)}|]
+    liftIO $ createSymlink (binDir </> target) destL
+
+  -- set haskell-language-server-wrapper symlink
+  let destL = "haskell-language-server-wrapper-" <> verToBS ver
+  let wrapper = binDir </> [rel|haskell-language-server-wrapper|]
+
+  lift $ $(logDebug) [i|rm -f #{toFilePath wrapper}|]
+  liftIO $ hideError doesNotExistErrorType $ deleteFile wrapper
+
+  lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath wrapper}|]
+  liftIO $ createSymlink wrapper destL
+
+  pure ()
+
+
+


    ------------------
@ -511,6 +684,7 @@ data ListResult = ListResult
  , fromSrc    :: Bool -- ^ compiled from source
  , lStray     :: Bool -- ^ not in download info
  , lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
+  , hlsPowered :: Bool
  }
  deriving (Eq, Ord, Show)

@ -544,22 +718,25 @@ listVersions av lt criteria pfreq = do
      lr <- filter' <$> forM (Map.toList avTools) (toListResult t)

      case t of
-        -- append stray GHCs
        GHC -> do
          slr <- strayGHCs avTools
          pure $ (sort (slr ++ lr))
        Cabal -> do
          slr <- strayCabals avTools
          pure $ (sort (slr ++ lr))
-        _ -> pure lr
+        HLS -> do
+          slr <- strayHLS avTools
+          pure $ (sort (slr ++ lr))
+        GHCup -> pure lr
    Nothing -> do
      ghcvers   <- listVersions av (Just GHC) criteria pfreq
      cabalvers <- listVersions av (Just Cabal) criteria pfreq
+      hlsvers   <- listVersions av (Just HLS) criteria pfreq
      ghcupvers <- listVersions av (Just GHCup) criteria pfreq
-      pure (ghcvers <> cabalvers <> ghcupvers)
+      pure (ghcvers <> cabalvers <> hlsvers <> ghcupvers)

 where
-  strayGHCs :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m)
+  strayGHCs :: (MonadCatch m, MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m)
            => Map.Map Version [Tag]
            -> m [ListResult]
  strayGHCs avTools = do
@ -571,6 +748,7 @@ listVersions av lt criteria pfreq = do
          Nothing -> do
            lSet    <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
            fromSrc <- ghcSrcInstalled tver
+            hlsPowered <- fmap (elem _tvVersion) $ hlsGHCVersions
            pure $ Just $ ListResult
              { lTool      = GHC
              , lVer       = _tvVersion
@ -584,6 +762,7 @@ listVersions av lt criteria pfreq = do
      Right tver@GHCTargetVersion{ .. } -> do
        lSet    <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
        fromSrc <- ghcSrcInstalled tver
+        hlsPowered <- fmap (elem _tvVersion) $ hlsGHCVersions
        pure $ Just $ ListResult
          { lTool      = GHC
          , lVer       = _tvVersion
@ -619,6 +798,35 @@ listVersions av lt criteria pfreq = do
              , lStray     = maybe True (const False) (Map.lookup ver avTools)
              , lNoBindist = False
              , fromSrc    = False -- actually, we don't know :>
+              , hlsPowered = False
+              , ..
+              }
+      Left e -> do
+        $(logWarn)
+          [i|Could not parse version of stray directory #{toFilePath e}|]
+        pure Nothing
+
+  strayHLS :: (MonadReader Settings m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
+           => Map.Map Version [Tag]
+           -> m [ListResult]
+  strayHLS avTools = do
+    hlss <- getInstalledHLSs
+    fmap catMaybes $ forM hlss $ \case
+      Right ver ->
+        case Map.lookup ver avTools of
+          Just _  -> pure Nothing
+          Nothing -> do
+            lSet    <- fmap (maybe False (== ver)) $ hlsSet
+            pure $ Just $ ListResult
+              { lTool      = HLS
+              , lVer       = ver
+              , lCross     = Nothing
+              , lTag       = []
+              , lInstalled = True
+              , lStray     = maybe True (const False) (Map.lookup ver avTools)
+              , lNoBindist = False
+              , fromSrc    = False -- actually, we don't know :>
+              , hlsPowered = False
              , ..
              }
      Left e -> do
@ -635,6 +843,7 @@ listVersions av lt criteria pfreq = do
      lSet       <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
      lInstalled <- ghcInstalled tver
      fromSrc    <- ghcSrcInstalled tver
+      hlsPowered <- fmap (elem v) $ hlsGHCVersions
      pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
    Cabal -> do
      let lNoBindist = isLeft $ getDownloadInfo Cabal v pfreq av
@ -646,6 +855,7 @@ listVersions av lt criteria pfreq = do
                      , lTool   = t
                      , fromSrc = False
                      , lStray  = False
+                      , hlsPowered = False
                      , ..
                      }
    GHCup -> do
@ -658,6 +868,20 @@ listVersions av lt criteria pfreq = do
                      , fromSrc = False
                      , lStray  = False
                      , lNoBindist = False
+                      , hlsPowered = False
+                      , ..
+                      }
+    HLS -> do
+      let lNoBindist = isLeft $ getDownloadInfo HLS v pfreq av
+      lSet <- fmap (maybe False (== v)) $ hlsSet
+      lInstalled <- hlsInstalled v
+      pure ListResult { lVer    = v
+                      , lCross  = Nothing
+                      , lTag    = tags
+                      , lTool   = t
+                      , fromSrc = False
+                      , lStray  = False
+                      , hlsPowered = False
                      , ..
                      }

@ -749,6 +973,35 @@ rmCabalVer ver = do
        (binDir </> [rel|cabal|])


+-- | Delete a hls version. Will try to fix the hls symlinks
+-- after removal (e.g. setting it to an older version).
+rmHLSVer :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m)
+         => Version
+         -> Excepts '[NotInstalled] m ()
+rmHLSVer ver = do
+  whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (prettyVer ver))
+
+  isHlsSet      <- lift $ hlsSet
+
+  Settings {dirs = Dirs {..}} <- lift ask
+
+  bins <- lift $ hlsAllBinaries ver
+  forM_ bins $ \f -> liftIO $ deleteFile (binDir </> f)
+
+  when (maybe False (== ver) isHlsSet) $ do
+    -- delete all set symlinks
+    oldSyms <- lift hlsSymlinks
+    forM_ oldSyms $ \f -> do
+      lift $ $(logDebug) [i|rm #{toFilePath (binDir </> f)}|]
+      liftIO $ deleteFile (binDir </> f)
+    -- set latest hls
+    hlsVers <- lift $ fmap rights $ getInstalledHLSs
+    case headMay . reverse . sort $ hlsVers of
+      Just latestver -> setHLS latestver
+      Nothing        -> pure ()
+
+
+

    ------------------
    --[ Debug info ]--
--- a/lib/GHCup/Errors.hs
+++ b/lib/GHCup/Errors.hs
@ -152,3 +152,10 @@ data ParseError = ParseError String
  deriving Show

 instance Exception ParseError
+
+
+data UnexpectedListLength = UnexpectedListLength String
+  deriving Show
+
+instance Exception UnexpectedListLength
+
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@ -76,6 +76,7 @@ type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
 data Tool = GHC
          | Cabal
          | GHCup
+          | HLS
  deriving (Eq, GHC.Generic, Ord, Show)


--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@ -301,6 +301,150 @@ cabalSet = do



+-- | Get all installed hls, by matching on
+-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
+getInstalledHLSs :: (MonadReader Settings m, MonadIO m, MonadCatch m)
+                 => m [Either (Path Rel) Version]
+getInstalledHLSs = do
+  Settings { dirs = Dirs {..} } <- ask
+  bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
+    binDir
+    (makeRegexOpts compExtended
+                   execBlank
+                   ([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
+    )
+  vs <- forM bins $ \f ->
+    case
+        fmap
+          version
+          (fmap decUTF8Safe . B.stripPrefix "haskell-language-server-wrapper-" . toFilePath $ f)
+      of
+        Just (Right r) -> pure $ Right r
+        Just (Left  _) -> pure $ Left f
+        Nothing        -> pure $ Left f
+  pure $ vs
+
+
+-- | Whether the given HLS version is installed.
+hlsInstalled :: (MonadIO m, MonadReader Settings m, MonadCatch m) => Version -> m Bool
+hlsInstalled ver = do
+  vers <- fmap rights $ getInstalledHLSs
+  pure $ elem ver $ vers
+
+
+
+-- Return the currently set hls version, if any.
+hlsSet :: (MonadReader Settings m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+hlsSet = do
+  Settings {dirs = Dirs {..}} <- ask
+  let hlsBin = binDir </> [rel|haskell-language-server-wrapper|]
+
+  liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
+    broken <- isBrokenSymlink hlsBin
+    if broken
+      then pure Nothing
+      else do
+        link <- readSymbolicLink $ toFilePath hlsBin
+        Just <$> linkVersion link
+ where
+  linkVersion :: MonadThrow m => ByteString -> m Version
+  linkVersion bs = do
+    t <- throwEither $ E.decodeUtf8' bs
+    throwEither $ MP.parse parser "" t
+   where
+    parser =
+      MP.chunk "haskell-language-server-wrapper-" *> version'
+
+
+-- | Return the GHC versions the currently selected HLS supports.
+hlsGHCVersions :: ( MonadReader Settings m
+                  , MonadIO m
+                  , MonadThrow m
+                  , MonadCatch m
+                  )
+               => m [Version]
+hlsGHCVersions = do
+  h                             <- hlsSet
+  vers                          <- forM h $ \h' -> do
+    bins <- hlsServerBinaries h'
+    pure $ fmap
+      (\bin ->
+        version
+          . decUTF8Safe
+          . fromJust
+          . B.stripPrefix "haskell-language-server-"
+          . head
+          . B.split _tilde
+          . toFilePath
+          $ bin
+      )
+      bins
+  pure . rights . concat . maybeToList $ vers
+
+
+-- | Get all server binaries for an hls version, if any.
+hlsServerBinaries :: (MonadReader Settings m, MonadIO m)
+                  => Version
+                  -> m [Path Rel]
+hlsServerBinaries ver = do
+  Settings { dirs = Dirs {..} } <- ask
+  liftIO $ handleIO (\_ -> pure []) $ findFiles
+    binDir
+    (makeRegexOpts
+      compExtended
+      execBlank
+      ([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> [s|$|] :: ByteString
+      )
+    )
+
+
+-- | Get the wrapper binary for an hls version, if any.
+hlsWrapperBinary :: (MonadReader Settings m, MonadThrow m, MonadIO m)
+                 => Version
+                 -> m (Maybe (Path Rel))
+hlsWrapperBinary ver = do
+  Settings { dirs = Dirs {..} } <- ask
+  wrapper                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
+    binDir
+    (makeRegexOpts
+      compExtended
+      execBlank
+      ([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> [s|$|] :: ByteString
+      )
+    )
+  case wrapper of
+    []  -> pure $ Nothing
+    [x] -> pure $ Just x
+    _   -> throwM $ UnexpectedListLength
+      "There were multiple hls wrapper binaries for a single version"
+
+
+-- | Get all binaries for an hls version, if any.
+hlsAllBinaries :: (MonadReader Settings m, MonadIO m, MonadThrow m) => Version -> m [Path Rel]
+hlsAllBinaries ver = do
+  hls     <- hlsServerBinaries ver
+  wrapper <- hlsWrapperBinary ver
+  pure (maybeToList wrapper ++ hls)
+
+
+-- | Get the active symlinks for hls.
+hlsSymlinks :: (MonadReader Settings m, MonadIO m, MonadCatch m) => m [Path Rel]
+hlsSymlinks = do
+  Settings { dirs = Dirs {..} } <- ask
+  oldSyms                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
+    binDir
+    (makeRegexOpts compExtended
+                   execBlank
+                   ([s|^haskell-language-server-.*$|] :: ByteString)
+    )
+  filterM
+    ( fmap (== SymbolicLink)
+    . liftIO
+    . getFileType
+    . (binDir </>)
+    )
+    oldSyms
+


    -----------------------------------------
--- a/lib/GHCup/Utils/Prelude.hs
+++ b/lib/GHCup/Utils/Prelude.hs
@ -31,11 +31,13 @@ import           Data.ByteString                ( ByteString )
 import           Data.String
 import           Data.Text                      ( Text )
 import           Data.Versions
+import           Data.Word8
 import           Haskus.Utils.Types.List
 import           Haskus.Utils.Variant.Excepts
 import           System.IO.Error
 import           System.Posix.Env.ByteString    ( getEnvironment )

+import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as L
 import qualified Data.Strict.Maybe             as S
 import qualified Data.Text                     as T
@ -275,3 +277,13 @@ decUTF8Safe = E.decodeUtf8With E.lenientDecode

 decUTF8Safe' :: L.ByteString -> Text
 decUTF8Safe' = TL.toStrict . TLE.decodeUtf8With E.lenientDecode
+
+
+-- | Escape a version for use in regex
+escapeVerRex :: Version -> ByteString
+escapeVerRex = B.pack . go . B.unpack . verToBS
+ where
+  go [] = []
+  go (x : xs) | x == _period = [_backslash, _period] ++ go xs
+              | otherwise    = x : go xs
+
--- a/lib/GHCup/Version.hs
+++ b/lib/GHCup/Version.hs
@ -26,7 +26,7 @@ ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.yaml|]

 -- | The current ghcup version.
 ghcUpVer :: PVP
-ghcUpVer = [pver|0.1.10|]
+ghcUpVer = [pver|0.1.11|]

 -- | ghcup version as numeric string.
 numericVer :: String