diff --git a/app/ghcup/GHCup/OptParse/Compile.hs b/app/ghcup/GHCup/OptParse/Compile.hs index 42b6317..311bde0 100644 --- a/app/ghcup/GHCup/OptParse/Compile.hs +++ b/app/ghcup/GHCup/OptParse/Compile.hs @@ -78,8 +78,9 @@ data GHCCompileOptions = GHCCompileOptions , isolateDir :: Maybe FilePath } + data HLSCompileOptions = HLSCompileOptions - { targetHLS :: Either Version GitBranch + { targetHLS :: HLSVer , jobs :: Maybe Int , setCompile :: Bool , ovewrwiteVer :: Either Bool Version @@ -149,10 +150,12 @@ Examples: These need to be available in PATH prior to compilation. Examples: - # compile 1.7.0.0 for ghc 8.10.5 and 8.10.7, passing '--allow-newer' to cabal + # compile 1.7.0.0 from hackage for 8.10.7 + ghcup compile hls --hackage-version 1.7.0.0 --ghc 8.10.7 + # compile 1.7.0.0 from official source dist for ghc 8.10.5 and 8.10.7, passing '--allow-newer' to cabal ghcup compile hls -v 1.7.0.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 -- --allow-newer - # compile from master for ghc 9.2.3 and use 'git describe' to name the binary - ghcup compile hls -g master --git-describe-version --ghc 9.2.3 + # compile from master for ghc 9.2.3 using 'git describe' to name the binary and ignore the pinned index state + ghcup compile hls -g master --git-describe-version --ghc 9.2.3 -- --index-state=@(date '+%s') # compile a specific commit for ghc 9.2.3 and set a specifc version for the binary name ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|] @@ -270,7 +273,7 @@ ghcCompileOpts = hlsCompileOpts :: Parser HLSCompileOptions hlsCompileOpts = HLSCompileOptions - <$> ((Left <$> option + <$> ((SourceDist <$> option (eitherReader (first (const "Not a valid version") . version . T.pack) ) @@ -278,8 +281,9 @@ hlsCompileOpts = "The tool version to compile" <> (completer $ versionCompleter Nothing HLS) ) - ) <|> - (Right <$> (GitBranch <$> option + ) + <|> + (GitDist <$> (GitBranch <$> option str (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help "The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)" @@ -287,7 +291,28 @@ hlsCompileOpts = optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)" <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"]) )) - ))) + )) + <|> + (HackageDist <$> (option + (eitherReader + (first (const "Not a valid version") . version . T.pack) + ) + (long "hackage-version" <> metavar "HACKAGE_VERSION" <> help + "The hackage version to compile" + <> (completer $ versionCompleter Nothing HLS) + ) + )) + <|> + ( + RemoteDist <$> (option + (eitherReader uriParser) + (long "remote-source-dist" <> metavar "URI" <> help + "URI (https/http/file) to a HLS source distribution" + <> completer fileUri + ) + ) + ) + ) <*> optional (option (eitherReader (readEither @Int)) @@ -468,7 +493,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do (CompileHLS HLSCompileOptions { .. }) -> do runCompileHLS runAppState (do case targetHLS of - Left targetVer -> do + SourceDist targetVer -> do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo let vi = getVersionInfo targetVer HLS dls forM_ (_viPreCompile =<< vi) $ \msg -> do @@ -476,7 +501,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do lift $ logInfo "...waiting for 5 seconds, you can still abort..." liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene - Right _ -> pure () + _ -> pure () ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC) targetVer <- liftE $ compileHLS targetHLS diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 290aadb..7d55e57 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -342,7 +342,9 @@ Report bugs at |] (GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over })) (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver - alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver })) + alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = SourceDist tver })) + (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver + alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HackageDist tver })) (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True alreadyInstalling _ _ = pure False diff --git a/lib/GHCup/HLS.hs b/lib/GHCup/HLS.hs index 9b99069..1f5779e 100644 --- a/lib/GHCup/HLS.hs +++ b/lib/GHCup/HLS.hs @@ -324,7 +324,7 @@ compileHLS :: ( MonadMask m , MonadUnliftIO m , MonadFail m ) - => Either Version GitBranch + => HLSVer -> [Version] -> Maybe Int -> Either Bool Version @@ -349,9 +349,9 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc Dirs { .. } <- lift getDirs - (workdir, tver, git_describe) <- case targetHLS of + (workdir, tmpUnpack, tver, git_describe) <- case targetHLS of -- unpack from version tarball - Left tver -> do + SourceDist tver -> do lift $ logDebug $ "Requested to compile: " <> prettyVer tver -- download source tarball @@ -369,10 +369,47 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc (liftE . intoSubdir tmpUnpack) (view dlSubdir dlInfo) - pure (workdir, tver, Nothing) + pure (workdir, tmpUnpack, tver, Nothing) + + HackageDist tver -> do + lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver + + -- download source tarball + tmpUnpack <- lift mkGhcupTmpDir + let hls = "haskell-language-server-" <> T.unpack (prettyVer tver) + reThrowAll @_ @'[ProcessError] DownloadFailed $ do + -- unpack + lEM $ exec "cabal" ["unpack", hls] (Just $ fromGHCupPath tmpUnpack) Nothing + + let workdir = appendGHCupPath tmpUnpack hls + + pure (workdir, tmpUnpack, tver, Nothing) + + RemoteDist uri -> do + lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri) + + -- download source tarball + tmpDownload <- lift withGHCupTmpDir + tmpUnpack <- lift mkGhcupTmpDir + tar <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpDownload) Nothing False + (cf, tver) <- liftE $ cleanUpOnError tmpUnpack $ do + unpackToDir (fromGHCupPath tmpUnpack) tar + let regex = [s|haskell-language-server\.cabal$|] :: B.ByteString + [cabalFile] <- liftIO $ handleIO (\_ -> pure []) $ findFilesDeep + tmpUnpack + (makeRegexOpts compExtended + execBlank + regex + ) + tver <- getCabalVersion (fromGHCupPath tmpUnpack cabalFile) + pure (cabalFile, tver) + + let workdir = appendGHCupPath tmpUnpack (takeDirectory cf) + + pure (workdir, tmpUnpack, tver, Nothing) -- clone from git - Right GitBranch{..} -> do + GitDist GitBranch{..} -> do tmpUnpack <- lift mkGhcupTmpDir let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing reThrowAll @_ @'[ProcessError] DownloadFailed $ do @@ -409,15 +446,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc then pure Nothing else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack) chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack) - (Just gpd) <- parseGenericPackageDescriptionMaybe - <$> liftIO (B.readFile (fromGHCupPath tmpUnpack "haskell-language-server.cabal")) - let tver = (\c -> Version Nothing c [] Nothing) - . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral) - . versionNumbers - . pkgVersion - . package - . packageDescription - $ gpd + tver <- getCabalVersion (fromGHCupPath tmpUnpack "haskell-language-server.cabal") liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack) lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <> @@ -425,7 +454,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc (if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <> (if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash) - pure (tmpUnpack, tver, git_describe) + pure (tmpUnpack, tmpUnpack, tver, git_describe) -- the version that's installed may differ from the -- compiled version, so the user can overwrite it @@ -441,7 +470,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc Right v -> pure v liftE $ runBuildAction - workdir + tmpUnpack (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do let tmpInstallDir = fromGHCupPath workdir "out" liftIO $ createDirRecursive' tmpInstallDir @@ -457,14 +486,22 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc pure "cabal.project" | otherwise -> pure (takeFileName cp) Just (Right uri) -> do - tmpUnpack <- lift withGHCupTmpDir - cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just "cabal.project") False + tmpUnpack' <- lift withGHCupTmpDir + cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False copyFileE cp (fromGHCupPath workdir "cabal.project") False pure "cabal.project" - Nothing -> pure "cabal.project" + Nothing + | HackageDist _ <- targetHLS -> do + liftIO $ B.writeFile (fromGHCupPath workdir "cabal.project") "packages: ./" + pure "cabal.project" + | RemoteDist _ <- targetHLS -> do + let cabalFile = fromGHCupPath workdir "cabal.project" + liftIO $ whenM (not <$> doesFileExist cabalFile) $ B.writeFile cabalFile "packages: ./" + pure "cabal.project" + | otherwise -> pure "cabal.project" forM_ cabalProjectLocal $ \uri -> do - tmpUnpack <- lift withGHCupTmpDir - cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just (cp <.> "local")) False + tmpUnpack' <- lift withGHCupTmpDir + cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just (cp <.> "local")) False copyFileE cpl (fromGHCupPath workdir cp <.> "local") False artifacts <- forM (sort ghcs) $ \ghc -> do let ghcInstallDir = tmpInstallDir T.unpack (prettyVer ghc) @@ -658,3 +695,19 @@ rmHLSVer ver = do case headMay . reverse . sort $ hlsVers of Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing Nothing -> pure () + + +getCabalVersion :: (MonadIO m, MonadFail m) => FilePath -> m Version +getCabalVersion fp = do + contents <- liftIO $ B.readFile fp + gpd <- case parseGenericPackageDescriptionMaybe contents of + Nothing -> fail $ "could not parse cabal file: " <> fp + Just r -> pure r + let tver = (\c -> Version Nothing c [] Nothing) + . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral) + . versionNumbers + . pkgVersion + . package + . packageDescription + $ gpd + pure tver diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index 63761d2..d59037d 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -657,7 +657,9 @@ isSafeDir (GHCupBinDir _) = False - - +data HLSVer = SourceDist Version + | GitDist GitBranch + | HackageDist Version + | RemoteDist URI