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/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 diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 015815c..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 @@ -851,31 +853,27 @@ 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 + ] ++ fmap T.unpack cabalArgs ++ [ + "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 @@ -1102,7 +1100,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 @@ -2505,6 +2503,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..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 @@ -149,6 +151,7 @@ executeOut path args chdir = do execLogged :: ( MonadReader env m , HasDirs env + , HasLog env , HasSettings env , MonadIO m , MonadThrow m) @@ -160,6 +163,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) 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