Merge branch 'dynamic-hls'

2021-11-12 17:57:15 +01:00 · 2021-11-12 17:57:15 +01:00 · ccecda2eff
commit ccecda2eff
parent c05876cc60 3a5f8d6139
9 changed files with 56 additions and 34 deletions
--- 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
--- 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 $
--- 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

--- 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
--- 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
--- 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]
--- 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
--- 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)
--- 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