Implement compiling HLS from source

.gitlab-ci.yml

@@ -263,6 +263,23 @@ test:linux:
     CABAL_VERSION: "3.4.0.0"
   needs: []
 
+test:linux:hls:
+  stage: test
+  extends:
+    - .test_ghcup_version
+    - .debian
+  variables:
+    GHC_VERSION: "8.10.7"
+    HLS_TARGET_VERSION: "1.4.0"
+    CABAL_VERSION: "3.6.0.0"
+  needs: []
+  when: manual
+  allow_failure: true
+  before_script:
+    - ./.gitlab/before_script/linux/install_deps.sh
+  script:
+    - ./.gitlab/script/ghcup_hls.sh
+
 test:linux:cross-armv7:
   stage: test
   extends:

.gitlab/ghcup_env

@@ -1,9 +1,11 @@
 if [ "${OS}" = "WINDOWS" ] ; then
 	export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
-	export PATH="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin:$CI_PROJECT_DIR/.local/bin:$PATH"
+	export GHCUP_BIN="$CI_PROJECT_DIR/ghcup/bin"
+	export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
 	export TMPDIR="$CI_PROJECT_DIR/tmp"
 else
 	export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
-	export PATH="$CI_PROJECT_DIR/.ghcup/bin:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
+	export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
+	export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
 	export TMPDIR="$CI_PROJECT_DIR/tmp"
 fi

.gitlab/script/ghcup_hls.sh

@@ -0,0 +1,51 @@
+#!/bin/sh
+
+set -eux
+
+. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
+
+mkdir -p "$CI_PROJECT_DIR"/.local/bin
+
+CI_PROJECT_DIR=$(pwd)
+
+ecabal() {
+	cabal "$@"
+}
+
+eghcup() {
+	ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
+}
+
+git describe --always
+
+### build
+
+ecabal update
+
+ecabal build -w ghc-${GHC_VERSION}
+cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
+
+### cleanup
+
+rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
+
+### manual cli based testing
+
+eghcup --numeric-version
+
+eghcup install ghc ${GHC_VERSION}
+eghcup set ghc ${GHC_VERSION}
+eghcup install cabal ${CABAL_VERSION}
+
+cabal --version
+
+eghcup debug-info
+
+eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION}
+
+[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
+
+# nuke
+eghcup nuke
+[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
+

.gitlab/script/ghcup_version.sh

@@ -101,6 +101,10 @@ eghcup install ghc ${GHC_VERSION}
 eghcup set ghc ${GHC_VERSION}
 eghcup install cabal ${CABAL_VERSION}
 [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
+eghcup unset cabal
+"$GHCUP_BIN"/cabal --version && exit || echo yes
+eghcup set cabal ${CABAL_VERSION}
+[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
 
 cabal --version
 
@@ -151,9 +155,13 @@ else
 	[ "$(ghc --numeric-version)" = "8.10.3" ]
 	eghcup set ${GHC_VERSION}
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+	eghcup unset ghc
+    "$GHCUP_BIN"/ghc --numeric-version && exit || echo yes
+	eghcup set ${GHC_VERSION}
 	eghcup --offline rm 8.10.3
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 
+
 	if [ "${OS}" = "DARWIN" ] ; then
 		eghcup install hls
 		$(eghcup whereis hls) --version
@@ -164,9 +172,13 @@ else
 		if [ "${ARCH}" = "64" ] ; then
 			eghcup install hls
 			haskell-language-server-wrapper --version
+			eghcup unset hls
+			"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit || echo yes
 
 			eghcup install stack
 			stack --version
+			eghcup unset hls
+			"$GHCUP_BIN"/stack --version && exit || echo yes
 		fi
 	fi
 fi

app/ghcup/Main.hs

@@ -103,6 +103,7 @@ data Command
   = Install (Either InstallCommand InstallOptions)
   | InstallCabalLegacy InstallOptions
   | Set (Either SetCommand SetOptions)
+  | UnSet UnsetCommand
   | List ListOptions
   | Rm (Either RmCommand RmOptions)
   | DInfo
@@ -150,6 +151,11 @@ data SetCommand = SetGHC SetOptions
                 | SetHLS SetOptions
                 | SetStack SetOptions
 
+data UnsetCommand = UnsetGHC   UnsetOptions
+                  | UnsetCabal UnsetOptions
+                  | UnsetHLS   UnsetOptions
+                  | UnsetStack UnsetOptions
+
 -- a superset of ToolVersion
 data SetToolVersion = SetToolVersion GHCTargetVersion
                     | SetToolTag Tag
@@ -160,6 +166,10 @@ data SetOptions = SetOptions
   { sToolVer :: SetToolVersion
   }
 
+data UnsetOptions = UnsetOptions
+  { sToolVer :: Maybe Text -- target platform triple
+  }
+
 data ListOptions = ListOptions
   { loTool     :: Maybe Tool
   , lCriteria  :: Maybe ListCriteria
@@ -177,6 +187,7 @@ data RmOptions = RmOptions
 
 
 data CompileCommand = CompileGHC GHCCompileOptions
+                    | CompileHLS HLSCompileOptions
 
 data ConfigCommand = ShowConfig | SetConfig String String | InitConfig
 
@@ -195,6 +206,16 @@ data GHCCompileOptions = GHCCompileOptions
   , isolateDir   :: Maybe FilePath
   }
 
+data HLSCompileOptions = HLSCompileOptions
+  { targetHLS    :: Either Version GitBranch
+  , jobs         :: Maybe Int
+  , setCompile   :: Bool
+  , ovewrwiteVer :: Maybe Version
+  , isolateDir   :: Maybe FilePath
+  , cabalProject :: Maybe FilePath
+  , targetGHCs   :: [ToolVersion]
+  }
+
 data UpgradeOpts = UpgradeInplace
                  | UpgradeAt FilePath
                  | UpgradeGHCupDir
@@ -357,6 +378,14 @@ com =
              <> footerDoc (Just $ text setFooter)
              )
            )
+      <> command
+           "unset"
+           (info
+             (UnSet <$> unsetParser <**> helper)
+             (  progDesc "Unset currently active GHC/cabal version"
+             <> footerDoc (Just $ text unsetFooter)
+             )
+           )
       <> command
            "rm"
            (info
@@ -470,6 +499,10 @@ com =
   is given, sets GHC to 'recommended' version).
   It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
 
+  unsetFooter :: String
+  unsetFooter = [s|Discussion:
+  Unsets the currently active GHC or cabal version.|]
+
   rmFooter :: String
   rmFooter = [s|Discussion:
   Remove the given GHC or cabal version. When no command is given,
@@ -715,12 +748,74 @@ setParser =
   setHLSFooter = [s|Discussion:
     Sets the the current haskell-language-server version.|]
 
+unsetParser :: Parser UnsetCommand
+unsetParser =
+  (subparser
+      (  command
+          "ghc"
+          (   UnsetGHC
+          <$> info
+                (unsetOpts <**> helper)
+                (  progDesc "Unset GHC version"
+                <> footerDoc (Just $ text unsetGHCFooter)
+                )
+          )
+      <> command
+           "cabal"
+           (   UnsetCabal
+           <$> info
+                (unsetOpts <**> helper)
+                 (  progDesc "Unset Cabal version"
+                 <> footerDoc (Just $ text unsetCabalFooter)
+                 )
+           )
+      <> command
+           "hls"
+           (   UnsetHLS
+           <$> info
+                 (unsetOpts <**> helper)
+                 (  progDesc "Unset haskell-language-server version"
+                 <> footerDoc (Just $ text unsetHLSFooter)
+                 )
+           )
+      <> command
+           "stack"
+           (   UnsetStack
+           <$> info
+                 (unsetOpts <**> helper)
+                 (  progDesc "Unset stack version"
+                 <> footerDoc (Just $ text unsetStackFooter)
+                 )
+           )
+      )
+    )
+ where
+  unsetGHCFooter :: String
+  unsetGHCFooter = [s|Discussion:
+    Unsets the the current GHC version. That means there won't
+    be a ~/.ghcup/bin/ghc anymore.|]
+
+  unsetCabalFooter :: String
+  unsetCabalFooter = [s|Discussion:
+    Unsets the the current Cabal version.|]
+
+  unsetStackFooter :: String
+  unsetStackFooter = [s|Discussion:
+    Unsets the the current Stack version.|]
+
+  unsetHLSFooter :: String
+  unsetHLSFooter = [s|Discussion:
+    Unsets the the current haskell-language-server version.|]
+
 
 setOpts :: Maybe Tool -> Parser SetOptions
 setOpts tool = SetOptions <$>
     (fromMaybe SetRecommended <$>
       optional (setVersionArgument (Just ListInstalled) tool))
 
+unsetOpts :: Parser UnsetOptions
+unsetOpts = UnsetOptions . fmap T.pack <$> optional (argument str (metavar "TRIPLE"))
+
 listOpts :: Parser ListOptions
 listOpts =
   ListOptions
@@ -811,6 +906,15 @@ compileP = subparser
             <> footerDoc (Just $ text compileFooter)
             )
       )
+  <>  command
+      "hls"
+      (   CompileHLS
+      <$> info
+            (hlsCompileOpts <**> helper)
+            (  progDesc "Compile HLS from source"
+            <> footerDoc (Just $ text compileHLSFooter)
+            )
+      )
   )
  where
   compileFooter = [s|Discussion:
@@ -835,6 +939,12 @@ Examples:
   # build cross compiler
   ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
 
+  compileHLSFooter = [s|Discussion:
+  Compiles and installs the specified HLS version.
+
+Examples:
+  ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
+
 configP :: Parser ConfigCommand
 configP = subparser
       (  command "init" initP
@@ -1104,6 +1214,64 @@ ghcCompileOpts =
             )
            )
 
+hlsCompileOpts :: Parser HLSCompileOptions
+hlsCompileOpts =
+  HLSCompileOptions
+    <$> ((Left <$> option
+          (eitherReader
+            (first (const "Not a valid version") . version . T.pack)
+          )
+          (short 'v' <> long "version" <> metavar "VERSION" <> help
+            "The tool version to compile"
+          )
+          ) <|>
+          (Right <$> (GitBranch <$> option
+          str
+          (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
+            "The git commit/branch/ref to build from"
+          ) <*>
+          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          )))
+    <*> optional
+          (option
+            (eitherReader (readEither @Int))
+            (short 'j' <> long "jobs" <> metavar "JOBS" <> help
+              "How many jobs to use for make"
+            )
+          )
+    <*> flag
+          False
+          True
+          (long "set" <> help
+            "Set as active version after install"
+          )
+    <*> optional
+          (option
+            (eitherReader
+              (first (const "Not a valid version") . version . T.pack)
+            )
+            (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
+              "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
+            )
+          )
+    <*> optional
+          (option
+            (eitherReader isolateParser)
+            (  short 'i'
+            <> long "isolate"
+            <> metavar "DIR"
+            <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
+            )
+           )
+    <*> optional
+          (option
+            str
+            (short 'p' <> long "projectfile" <> metavar "CABAL_PROJECT_LOCAL" <> help
+              "Absolute path to a cabal.project.local to be used for the build"
+            )
+          )
+    <*> many (toolVersionArgument Nothing (Just GHC))
+
 
 toolVersionParser :: Parser ToolVersion
 toolVersionParser = verP' <|> toolP
@@ -1629,6 +1797,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     , NoToolVersionSet
                     ]
 
+            runUnsetGHC =
+                runAppState
+                . runE
+                  @'[ NotInstalled ]
+
           let
             runLeanSetCabal =
                 runLeanAppState
@@ -1700,6 +1873,29 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , ArchiveResult
                       ]
 
+          let runCompileHLS =
+                  runAppState
+                  . runResourceT
+                  . runE
+                    @'[ AlreadyInstalled
+                      , BuildFailed
+                      , DigestError
+                      , GPGError
+                      , DownloadFailed
+                      , GHCupSetError
+                      , NoDownload
+                      , NotFoundInPATH
+                      , PatchFailed
+                      , UnknownArchive
+                      , TarDirDoesNotExist
+                      , TagNotFound
+                      , NextVerNotFound
+                      , NoToolVersionSet
+                      , NotInstalled
+                      , DirNotEmpty
+                      , ArchiveResult
+                      ]
+
           let
             runLeanWhereIs =
                 -- Don't use runLeanAppState here, which is disabled on windows.
@@ -2089,6 +2285,27 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Set (Left (SetHLS sopts)) -> setHLS' sopts
             Set (Left (SetStack sopts)) -> setStack' sopts
 
+            UnSet (UnsetGHC (UnsetOptions triple)) -> runUnsetGHC (unsetGHC triple)
+                  >>= \case
+                        VRight _ -> do
+                          runLogger $ logInfo "GHC successfully unset"
+                          pure ExitSuccess
+                        VLeft  e -> do
+                          runLogger $ logError $ T.pack $ prettyShow e
+                          pure $ ExitFailure 14
+            UnSet (UnsetCabal (UnsetOptions _)) -> do
+              runAppState unsetCabal
+              runLogger $ logInfo "Cabal successfully unset"
+              pure ExitSuccess
+            UnSet (UnsetHLS (UnsetOptions _)) -> do
+              runAppState unsetHLS
+              runLogger $ logInfo "HLS successfully unset"
+              pure ExitSuccess
+            UnSet (UnsetStack (UnsetOptions _)) -> do
+              runAppState unsetStack
+              runLogger $ logInfo "Stack successfully unset"
+              pure ExitSuccess
+
             List ListOptions {..} ->
               runListGHC (do
                   l <- listVersions loTool lCriteria
@@ -2114,6 +2331,51 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                         runLogger $ logError $ T.pack $ prettyShow e
                         pure $ ExitFailure 8
 
+            Compile (CompileHLS HLSCompileOptions { .. }) -> do
+              runCompileHLS (do
+                case targetHLS of
+                  Left targetVer -> do
+                    GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+                    let vi = getVersionInfo targetVer HLS dls
+                    forM_ (_viPreCompile =<< vi) $ \msg -> do
+                      lift $ logInfo msg
+                      lift $ logInfo
+                        "...waiting for 5 seconds, you can still abort..."
+                      liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
+                  Right _ -> pure ()
+                ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
+                targetVer <- liftE $ compileHLS
+                            targetHLS
+                            ghcs
+                            jobs
+                            ovewrwiteVer
+                            isolateDir
+                            cabalProject
+                GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+                let vi = getVersionInfo targetVer HLS dls
+                when setCompile $ void $ liftE $
+                  setHLS targetVer
+                pure (vi, targetVer)
+                )
+                >>= \case
+                      VRight (vi, tv) -> do
+                        runLogger $ logInfo
+                          "HLS successfully compiled and installed"
+                        forM_ (_viPostInstall =<< vi) $ \msg ->
+                          runLogger $ logInfo msg
+                        putStr (T.unpack $ prettyVer tv)
+                        pure ExitSuccess
+                      VLeft err@(V (BuildFailed tmpdir _)) -> do
+                        case keepDirs settings of
+                          Never -> runLogger $ logError $ T.pack $ prettyShow err
+                          _ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
+                                "Check the logs at " <> T.pack logsDir <> " and the build directory "
+                                <> T.pack tmpdir <> " for more clues." <> "\n" <>
+                                "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
+                        pure $ ExitFailure 9
+                      VLeft e -> do
+                        runLogger $ logError $ T.pack $ prettyShow e
+                        pure $ ExitFailure 9
             Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
               runLogger $ logError "Hadrian cross compile support is not yet implemented!"
               pure $ ExitFailure 9

data/metadata/ghcup-0.0.6.yaml

@@ -2388,6 +2388,10 @@ ghcupDownloads:
         - Latest
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
       viPostInstall: *hls-post-install
+      viSourceDL:
+        dlUri: https://downloads.haskell.org/ghcup/src/haskell-language-server/1.4.0/haskell-language-server-1.4.0.tar.gz
+        dlSubdir: haskell-language-server-1.4.0
+        dlHash: c5d7dbf7fae9aa3ed2c1184b49e82d8ac623ca786494ef6602cfe11735d28db0
       viArch:
         A_64:
           Linux_UnknownLinux:

data/metadata/ghcup-0.0.7.yaml

@@ -2449,6 +2449,10 @@ ghcupDownloads:
         - Latest
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
       viPostInstall: *hls-post-install
+      viSourceDL:
+        dlUri: https://downloads.haskell.org/ghcup/src/haskell-language-server/1.4.0/haskell-language-server-1.4.0.tar.gz
+        dlSubdir: haskell-language-server-1.4.0
+        dlHash: c5d7dbf7fae9aa3ed2c1184b49e82d8ac623ca786494ef6602cfe11735d28db0
       viArch:
         A_64:
           Linux_UnknownLinux:

ghcup.cabal

@@ -100,6 +100,7 @@ library
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
     , bytestring            ^>=0.10
+    , Cabal
     , case-insensitive      ^>=1.2.1.0
     , casing                ^>=0.1.4.1
     , concurrent-output     ^>=1.10.11

lib/GHCup.hs

@@ -63,6 +63,11 @@ import           Data.Text                      ( Text )
 import           Data.Time.Clock
 import           Data.Time.Format.ISO8601
 import           Data.Versions
+import           Distribution.Types.Version   hiding ( Version )
+import           Distribution.Types.PackageId
+import           Distribution.Types.PackageDescription
+import           Distribution.Types.GenericPackageDescription
+import           Distribution.PackageDescription.Parsec
 import           GHC.IO.Exception
 import           Haskus.Utils.Variant.Excepts
 import           Language.Haskell.TH
@@ -83,6 +88,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           Text.Regex.Posix
 
 import qualified Crypto.Hash.SHA256            as SHA256
+import qualified Data.List.NonEmpty            as NE
 import qualified Data.ByteString.Base16        as B16
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as BL
@@ -264,6 +270,7 @@ installPackedGHC :: ( MonadMask m
                     , HasLog env
                     , MonadIO m
                     , MonadUnliftIO m
+                    , MonadFail m
                     )
                  => FilePath          -- ^ Path to the packed GHC bindist
                  -> Maybe TarDir      -- ^ Subdir of the archive
@@ -621,10 +628,7 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do
       liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall
 
-      -- 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
+  liftE $ installHLSPostInst isoFilepath ver
 
 
 -- | Install an unpacked hls distribution.
@@ -678,6 +682,21 @@ installHLSUnpacked path inst mver' forceInstall = do
     
   lift $ chmod_755 destWrapperPath
 
+
+installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
+                   => Maybe FilePath
+                   -> Version
+                   -> Excepts '[NotInstalled] m ()
+installHLSPostInst isoFilepath ver = 
+  case isoFilepath of
+    Just _ -> pure ()
+    Nothing -> do
+      -- 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
+
+
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
 installHLSBin :: ( MonadMask m
@@ -716,6 +735,155 @@ installHLSBin ver isoFilepath forceInstall = do
   installHLSBindist dlinfo ver isoFilepath forceInstall
 
 
+compileHLS :: ( MonadMask m
+              , MonadCatch m
+              , MonadReader env m
+              , HasDirs env
+              , HasSettings env
+              , HasPlatformReq env
+              , HasGHCupInfo env
+              , HasLog env
+              , MonadResource m
+              , MonadIO m
+              , MonadUnliftIO m
+              , MonadFail m
+              )
+           => Either Version GitBranch
+           -> [Version]
+           -> Maybe Int
+           -> Maybe Version
+           -> Maybe FilePath
+           -> Maybe FilePath
+           -> Excepts '[ NoDownload
+                       , GPGError
+                       , DownloadFailed
+                       , DigestError
+                       , UnknownArchive
+                       , TarDirDoesNotExist
+                       , ArchiveResult
+                       , BuildFailed
+                       , NotInstalled
+                       ] m Version
+compileHLS targetHLS ghcs jobs ov isolateDir cabalProject = do
+  PlatformRequest { .. } <- lift getPlatformReq
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+  Dirs { .. } <- lift getDirs
+
+  (workdir, tver) <- case targetHLS of
+    -- unpack from version tarball
+    Left tver -> do
+      lift $ logDebug $ "Requested to compile: " <> prettyVer tver
+
+      -- download source tarball
+      dlInfo <-
+        preview (ix HLS % ix tver % viSourceDL % _Just) dls
+          ?? NoDownload
+      dl <- liftE $ downloadCached dlInfo Nothing
+
+      -- unpack
+      tmpUnpack <- lift mkGhcupTmpDir
+      liftE $ unpackToDir tmpUnpack dl
+      liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
+
+      workdir <- maybe (pure tmpUnpack)
+                       (liftE . intoSubdir tmpUnpack)
+                       (view dlSubdir dlInfo)
+
+      pure (workdir, tver)
+
+    -- clone from git
+    Right GitBranch{..} -> do
+      tmpUnpack <- lift mkGhcupTmpDir
+      let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
+      tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
+        let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
+        lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
+        lEM $ git [ "init" ]
+        lEM $ git [ "remote"
+                  , "add"
+                  , "origin"
+                  , fromString rep ]
+
+        let fetch_args = 
+                  [ "fetch"
+                  , "--depth"
+                  , "1"
+                  , "--quiet"
+                  , "origin"
+                  , fromString ref ]
+        lEM $ git fetch_args
+
+        lEM $ git [ "checkout", "FETCH_HEAD" ]
+        (Just gpd) <- parseGenericPackageDescriptionMaybe <$> liftIO (B.readFile (tmpUnpack </> "haskell-language-server.cabal"))
+        pure . (\c -> Version Nothing c [] Nothing)
+          . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
+          . versionNumbers
+          . pkgVersion
+          . package
+          . packageDescription
+          $ gpd
+
+      liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
+      lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to HLS version " <> prettyVer tver
+
+      pure (tmpUnpack, tver)
+
+  -- the version that's installed may differ from the
+  -- compiled version, so the user can overwrite it
+  let installVer = fromMaybe tver ov
+
+  liftE $ runBuildAction
+    workdir
+    Nothing
+    (reThrowAll @_ @'[ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
+      let installDir = workdir </> "out"
+
+      artifacts <- forM (sort ghcs) $ \ghc -> do
+        let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
+        liftIO $ createDirRecursive' installDir
+        forM_ cabalProject $ \cp -> handleIO (throwE . CopyError . show) $ liftIO $ copyFile cp (workdir </> "cabal.project.local")
+        lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
+        liftE $ lEM @_ @'[ProcessError] $
+          execLogged "cabal" ( [ "v2-install"
+                               , "-w"
+                               , "ghc-" <> T.unpack (prettyVer ghc)
+                               , "--install-method=copy"
+                               ] ++
+                               maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
+                               [ "--overwrite-policy=always"
+                               , "--disable-profiling"
+                               , "--disable-tests"
+                               , "--enable-split-sections"
+                               , "--enable-executable-stripping"
+                               , "--enable-executable-static"
+                               , "--installdir=" <> ghcInstallDir
+                               , "exe:haskell-language-server"
+                               , "exe:haskell-language-server-wrapper"]
+                             )
+          (Just workdir) "cabal" Nothing
+        pure ghcInstallDir
+
+      forM_ artifacts $ \artifact -> do
+        liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
+          (installDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
+        liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
+          (installDir </> "haskell-language-server-wrapper" <.> exeExt)
+        liftIO $ rmPathForcibly artifact
+
+      case isolateDir of
+        Just isoDir -> do
+          lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
+          liftE $ installHLSUnpacked installDir isoDir Nothing True
+        Nothing -> do
+          liftE $ installHLSUnpacked installDir binDir (Just installVer) True
+    )
+
+  liftE $ installHLSPostInst isolateDir installVer
+
+  pure installVer
+
+
+
 -- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
 -- creates a default @stack -> stack-x.y.z.q@ symlink for
 -- the latest installed version.
@@ -968,6 +1136,17 @@ setGHC ver sghc = do
             $ createDirectoryLink targetF fullF
       _ -> pure ()
 
+unsetGHC :: ( MonadReader env m
+            , HasDirs env
+            , HasLog env
+            , MonadThrow m
+            , MonadFail m
+            , MonadIO m
+            , MonadMask m
+            )
+         => Maybe Text
+         -> Excepts '[NotInstalled] m ()
+unsetGHC = rmPlain
 
 
 -- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
@@ -975,7 +1154,6 @@ setCabal :: ( MonadMask m
             , MonadReader env m
             , HasDirs env
             , HasLog env
-            , MonadThrow m
             , MonadFail m
             , MonadIO m
             , MonadUnliftIO m)
@@ -999,18 +1177,24 @@ setCabal ver = do
 
   pure ()
 
-
+unsetCabal :: ( MonadMask m
+              , MonadReader env m
+              , HasDirs env
+              , MonadIO m)
+           => m ()
+unsetCabal = do
+  Dirs {..} <- getDirs
+  let cabalbin = binDir </> "cabal" <> exeExt
+  hideError doesNotExistErrorType $ rmLink cabalbin
 
 
 -- | Set the haskell-language-server symlinks.
-setHLS :: ( MonadCatch m
-          , MonadReader env m
+setHLS :: ( MonadReader env m
           , HasDirs env
           , HasLog env
-          , MonadThrow m
-          , MonadFail m
           , MonadIO m
           , MonadMask m
+          , MonadFail m
           , MonadUnliftIO m
           )
        => Version
@@ -1045,6 +1229,21 @@ setHLS ver = do
   pure ()
 
 
+unsetHLS :: ( MonadMask m
+            , MonadReader env m
+            , HasDirs env
+            , MonadIO m)
+         => m ()
+unsetHLS = do
+  Dirs {..} <- getDirs
+  let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
+  bins   <- liftIO $ handleIO (\_ -> pure []) $ findFiles'
+    binDir
+    (MP.chunk "haskell-language-server-" <* pvp' <* MP.chunk (T.pack exeExt) <* MP.eof)
+  forM_ bins (hideError doesNotExistErrorType . rmLink . (binDir </>))
+  hideError doesNotExistErrorType $ rmLink wrapper
+
+
 -- | Set the @~\/.ghcup\/bin\/stack@ symlink.
 setStack :: ( MonadMask m
             , MonadReader env m
@@ -1074,6 +1273,17 @@ setStack ver = do
   pure ()
 
 
+unsetStack :: ( MonadMask m
+              , MonadReader env m
+              , HasDirs env
+              , MonadIO m)
+           => m ()
+unsetStack = do
+  Dirs {..} <- getDirs
+  let stackbin = binDir </> "stack" <> exeExt
+  hideError doesNotExistErrorType $ rmLink stackbin
+
+
 -- | Warn if the installed and set HLS is not compatible with the installed and
 -- set GHC version.
 warnAboutHlsCompatibility :: ( MonadReader env m

lib/GHCup/Download.hs

@@ -636,7 +636,7 @@ checkDigest eDigest file = do
     lift $ logInfo $ "verifying digest of: " <> T.pack p'
     c <- liftIO $ L.readFile file
     cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
-    when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
+    when ((cDigest /= eDigest) && verify) $ throwE (DigestError file cDigest eDigest)
 
 
 -- | Get additional curl args from env. This is an undocumented option.

lib/GHCup/Errors.hs

@@ -188,12 +188,14 @@ instance Pretty TarDirDoesNotExist where
     text "Tar directory does not exist:" <+> pPrint dir
 
 -- | File digest verification failed.
-data DigestError = DigestError Text Text
+data DigestError = DigestError FilePath Text Text
   deriving Show
 
 instance Pretty DigestError where
-  pPrint (DigestError currentDigest expectedDigest) =
-    text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
+  pPrint (DigestError fp currentDigest expectedDigest) =
+    text "Digest error for" <+> text (fp <> ": expected")
+      <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text
+      "\nConsider removing the file in case it's cached and try again."
 
 -- | File digest verification failed.
 data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)

lib/GHCup/Utils.hs

@@ -842,6 +842,8 @@ runBuildAction :: ( Pretty (V e)
                   , MonadMask m
                   , HasLog env
                   , MonadUnliftIO m
+                  , MonadFail m
+                  , MonadCatch m
                   )
                => FilePath        -- ^ build directory (cleaned up depending on Settings)
                -> Maybe FilePath  -- ^ dir to *always* clean up on exception
@@ -1039,7 +1041,7 @@ ensureGlobalTools = do
   shimDownload <- liftE $ lE @_ @'[NoDownload]
     $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
   let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
-  void $ (\(DigestError _ _) -> do
+  void $ (\(DigestError _ _ _) -> do
       lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
       lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
       lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")

lib/GHCup/Utils/File/Common.hs

@@ -9,6 +9,8 @@ import           GHCup.Utils.Prelude
 
 import           Control.Monad.Reader
 import           Data.Maybe
+import           Data.Text               ( Text )
+import           Data.Void
 import           GHC.IO.Exception
 import           Optics                  hiding ((<|), (|>))
 import           System.Directory
@@ -16,7 +18,9 @@ import           System.FilePath
 import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
 
+import qualified Data.Text                     as T
 import qualified Data.ByteString.Lazy          as BL
+import qualified Text.Megaparsec               as MP
 
 
 
@@ -101,6 +105,11 @@ findFiles path regex = do
   contents <- listDirectory path
   pure $ filter (match regex) contents
 
+findFiles' :: FilePath -> MP.Parsec Void Text a -> IO [FilePath]
+findFiles' path parser = do
+  contents <- listDirectory path
+  pure $ filter (\fp -> either (const False) (const True) $ MP.parse parser "" (T.pack fp)) contents
+
 
 checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
 checkFileAlreadyExists fp = liftIO $ doesFileExist fp