From d038c361c06fd201cda4281cc5dd647151135397 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Thu, 11 Nov 2021 21:21:37 +0100 Subject: [PATCH 1/7] Revert "Fix HLS rebuilds" This reverts commit 8e8198546f5f150b775e9882be09b904c38789c2. --- lib/GHCup.hs | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 015815c..530e53a 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -851,31 +851,26 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc Nothing -> pure "cabal.project" forM_ cabalProjectLocal $ \cpl -> copyFileE cpl (workdir cp <.> "local") - let targets = ["exe:haskell-language-server", "exe:haskell-language-server-wrapper"] - artifacts <- forM (sort ghcs) $ \ghc -> do let ghcInstallDir = installDir T.unpack (prettyVer ghc) - liftIO $ createDirRecursive' ghcInstallDir + liftIO $ createDirRecursive' installDir lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc liftE $ lEM @_ @'[ProcessError] $ - execLogged "cabal" ( [ "v2-build" + execLogged "cabal" ( [ "v2-install" , "-w" , "ghc-" <> T.unpack (prettyVer ghc) + , "--install-method=copy" ] ++ maybe [] (\j -> ["--jobs=" <> show j]) jobs ++ - [ "--project-file=" <> cp - ] ++ targets + [ "--overwrite-policy=always" + , "--disable-profiling" + , "--disable-tests" + , "--installdir=" <> ghcInstallDir + , "--project-file=" <> cp + , "exe:haskell-language-server" + , "exe:haskell-language-server-wrapper"] ) (Just workdir) "cabal" Nothing - forM_ targets $ \target -> do - let cabal = "cabal" - args = ["list-bin", target] - CapturedProcess{..} <- lift $ executeOut cabal args (Just workdir) - case _exitCode of - ExitFailure i -> throwE (NonZeroExit i cabal args) - _ -> pure () - let cbin = stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut - copyFileE cbin (ghcInstallDir takeFileName cbin) pure ghcInstallDir forM_ artifacts $ \artifact -> do From 6b6ce221e0c7d21a37f2813831235717b491439a Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 12 Nov 2021 00:57:39 +0100 Subject: [PATCH 2/7] Use patched haskus-utils-variant, fixing applicative instance --- cabal.project | 6 ++++++ ghcup.cabal | 4 ++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 99ea20b..ab8c30a 100644 --- a/cabal.project +++ b/cabal.project @@ -12,6 +12,12 @@ constraints: http-io-streams -brotli, any.Cabal ==3.6.2.0, any.aeson >= 2.0.1.0 +source-repository-package + type: git + location: https://github.com/hasufell/packages.git + tag: cc0b4688f8bb374fa92f17c856949de795b56291 + subdir: haskus-utils-variant + package libarchive flags: -system-libarchive diff --git a/ghcup.cabal b/ghcup.cabal index 09d1778..2551735 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -110,7 +110,7 @@ library , disk-free-space ^>=0.1.0.1 , filepath ^>=1.4.2.1 , haskus-utils-types ^>=1.5 - , haskus-utils-variant >=3.0 && <3.2 + , haskus-utils-variant ^>=3.2.1 , libarchive ^>=3.0.3.0 , lzma-static ^>=5.2.5.3 , megaparsec >=8.0.0 && <9.1 @@ -227,7 +227,7 @@ executable ghcup , directory ^>=1.3.6.0 , filepath ^>=1.4.2.1 , ghcup - , haskus-utils-variant >=3.0 && <3.2 + , haskus-utils-variant ^>=3.2.1 , libarchive ^>=3.0.3.0 , megaparsec >=8.0.0 && <9.1 , mtl ^>=2.2 From 626a2dd020375394f4d44b618b7fe4f07ddf44c1 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 12 Nov 2021 00:58:21 +0100 Subject: [PATCH 3/7] More debug logging --- lib/GHCup.hs | 1 + lib/GHCup/Utils.hs | 1 + lib/GHCup/Utils/File/Posix.hs | 2 ++ lib/GHCup/Utils/File/Windows.hs | 2 ++ 4 files changed, 6 insertions(+) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 530e53a..4ab43a6 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -2500,6 +2500,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had execWithGhcEnv :: ( MonadReader env m , HasSettings env , HasDirs env + , HasLog env , MonadIO m , MonadThrow m) => FilePath -- ^ thing to execute diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index dab1789..489e856 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -856,6 +856,7 @@ make :: ( MonadThrow m , MonadIO m , MonadReader env m , HasDirs env + , HasLog env , HasSettings env ) => [String] diff --git a/lib/GHCup/Utils/File/Posix.hs b/lib/GHCup/Utils/File/Posix.hs index fdd788b..b13aec9 100644 --- a/lib/GHCup/Utils/File/Posix.hs +++ b/lib/GHCup/Utils/File/Posix.hs @@ -73,6 +73,7 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do execLogged :: ( MonadReader env m , HasSettings env + , HasLog env , HasDirs env , MonadIO m , MonadThrow m) @@ -85,6 +86,7 @@ execLogged :: ( MonadReader env m execLogged exe args chdir lfile env = do Settings {..} <- getSettings Dirs {..} <- getDirs + logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args let logfile = logsDir lfile <> ".log" liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True }) closeFd diff --git a/lib/GHCup/Utils/File/Windows.hs b/lib/GHCup/Utils/File/Windows.hs index b7b6e17..91ec2d7 100644 --- a/lib/GHCup/Utils/File/Windows.hs +++ b/lib/GHCup/Utils/File/Windows.hs @@ -149,6 +149,7 @@ executeOut path args chdir = do execLogged :: ( MonadReader env m , HasDirs env + , HasLog env , HasSettings env , MonadIO m , MonadThrow m) @@ -160,6 +161,7 @@ execLogged :: ( MonadReader env m -> m (Either ProcessError ()) execLogged exe args chdir lfile env = do Dirs {..} <- getDirs + logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args let stdoutLogfile = logsDir lfile <> ".stdout.log" stderrLogfile = logsDir lfile <> ".stderr.log" cp <- createProcessWithMingwPath ((proc exe args) From 8eea9bd6a58cffdd3f0f8b981b0c72d6258bd5b9 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 12 Nov 2021 01:04:27 +0100 Subject: [PATCH 4/7] Prefer forM_ when possible --- lib/GHCup.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 4ab43a6..8881029 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -1097,7 +1097,7 @@ setGHC ver sghc = do pure $ Just (file <> "-" <> verS) -- create symlink - forM mTargetFile $ \targetFile -> do + forM_ mTargetFile $ \targetFile -> do let fullF = binDir targetFile <> exeExt fileWithExt = file <> exeExt destL <- lift $ ghcLinkDestination fileWithExt ver From 274978a8a7b2fefb60643e922628286b1959bcf2 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 12 Nov 2021 01:13:57 +0100 Subject: [PATCH 5/7] Allow to pass cabal args to 'compile hls' This breaks the existing cli interface, but whatever. --- app/ghcup/GHCup/OptParse/Common.hs | 24 ++++++++++++------------ app/ghcup/GHCup/OptParse/Compile.hs | 10 ++++++++-- lib/GHCup.hs | 7 +++++-- 3 files changed, 25 insertions(+), 16 deletions(-) diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs index 2d8abd2..8fd50c9 100644 --- a/app/ghcup/GHCup/OptParse/Common.hs +++ b/app/ghcup/GHCup/OptParse/Common.hs @@ -89,6 +89,18 @@ toolVersionArgument criteria tool = mv _ = "VERSION|TAG" +toolVersionOption :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion +toolVersionOption criteria tool = + option (eitherReader toolVersionEither) + ( sh tool + <> completer (tagCompleter (fromMaybe GHC tool) []) + <> foldMap (completer . versionCompleter criteria) tool) + where + sh (Just GHC) = long "ghc" <> metavar "GHC_VERSION|TAG" + sh (Just HLS) = long "hls" <> metavar "HLS_VERSION|TAG" + sh _ = long "version" <> metavar "VERSION|TAG" + + versionParser :: Parser GHCTargetVersion versionParser = option (eitherReader tVersionEither) @@ -246,18 +258,6 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled where t = T.toLower (T.pack s') -toolVersionParser :: Parser ToolVersion -toolVersionParser = verP' <|> toolP - where - verP' = ToolVersion <$> versionParser - toolP = - ToolTag - <$> option - (eitherReader tagEither) - (short 't' <> long "tag" <> metavar "TAG" <> help "The target tag") - - - keepOnParser :: String -> Either String KeepDirs keepOnParser s' | t == T.pack "always" = Right Always diff --git a/app/ghcup/GHCup/OptParse/Compile.hs b/app/ghcup/GHCup/OptParse/Compile.hs index fa89c1b..65fee42 100644 --- a/app/ghcup/GHCup/OptParse/Compile.hs +++ b/app/ghcup/GHCup/OptParse/Compile.hs @@ -88,6 +88,7 @@ data HLSCompileOptions = HLSCompileOptions , cabalProjectLocal :: Maybe FilePath , patchDir :: Maybe FilePath , targetGHCs :: [ToolVersion] + , cabalArgs :: [Text] } @@ -148,7 +149,10 @@ Examples: These need to be available in PATH prior to compilation. Examples: - ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|] + # compile 1.4.0 for ghc 8.10.5 and 8.10.7 + ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 + # compile from master for ghc 8.10.7, linking everything dynamically + ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|] ghcCompileOpts :: Parser GHCCompileOptions @@ -315,7 +319,8 @@ hlsCompileOpts = "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)" ) ) - <*> some (toolVersionArgument Nothing (Just GHC)) + <*> some (toolVersionOption Nothing (Just GHC)) + <*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)")) @@ -431,6 +436,7 @@ compile compileCommand settings runAppState runLogger = do cabalProject cabalProjectLocal patchDir + cabalArgs GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo let vi = getVersionInfo targetVer HLS dls when setCompile $ void $ liftE $ diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 8881029..f5715dc 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -753,6 +753,7 @@ compileHLS :: ( MonadMask m -> Maybe FilePath -> Maybe FilePath -> Maybe FilePath + -> [Text] -- ^ additional args to cabal install -> Excepts '[ NoDownload , GPGError , DownloadFailed @@ -763,11 +764,12 @@ compileHLS :: ( MonadMask m , BuildFailed , NotInstalled ] m Version -compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patchdir = do +compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patchdir cabalArgs = do PlatformRequest { .. } <- lift getPlatformReq GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo Dirs { .. } <- lift getDirs + (workdir, tver) <- case targetHLS of -- unpack from version tarball Left tver -> do @@ -867,7 +869,8 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc , "--disable-tests" , "--installdir=" <> ghcInstallDir , "--project-file=" <> cp - , "exe:haskell-language-server" + ] ++ fmap T.unpack cabalArgs ++ [ + "exe:haskell-language-server" , "exe:haskell-language-server-wrapper"] ) (Just workdir) "cabal" Nothing From 74e0f39bc228db70f9d92a4fe598cca38117e875 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 12 Nov 2021 01:28:40 +0100 Subject: [PATCH 6/7] Fix stack.yaml --- stack.yaml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index 7babd7f..c970fc8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -16,7 +16,6 @@ extra-deps: - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216 - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466 - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298 - - haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159 - heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340 - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269 - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615 @@ -40,6 +39,11 @@ extra-deps: - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243 - yaml-streamly-0.12.0 + - git: https://github.com/hasufell/packages.git + commit: cc0b4688f8bb374fa92f17c856949de795b56291 + subdirs: + - haskus-utils-variant + flags: http-io-streams: brotli: false From 3a5f8d6139033457365efff93fae6153552231b1 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 12 Nov 2021 14:32:06 +0100 Subject: [PATCH 7/7] Fix build on windows --- lib/GHCup/Utils/File/Windows.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/GHCup/Utils/File/Windows.hs b/lib/GHCup/Utils/File/Windows.hs index 91ec2d7..2b5b26d 100644 --- a/lib/GHCup/Utils/File/Windows.hs +++ b/lib/GHCup/Utils/File/Windows.hs @@ -18,6 +18,7 @@ module GHCup.Utils.File.Windows where import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink ) import GHCup.Utils.Dirs import GHCup.Utils.File.Common +import GHCup.Utils.Logger import GHCup.Types import GHCup.Types.Optics @@ -40,6 +41,7 @@ import qualified Control.Exception as EX import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import qualified Data.Map.Strict as Map +import qualified Data.Text as T