Fix HLS rebuilds

.gitlab-ci.yml

@@ -86,7 +86,7 @@ variables:
 
 .freebsd12:
   tags:
-    - x86_64-freebsd
+    - x86_64-freebsd12
   variables:
     OS: "FREEBSD"
     ARCH: "64"

app/ghcup/Main.hs

@@ -824,7 +824,7 @@ listOpts =
     <$> optional
           (option
             (eitherReader toolParser)
-            (short 't' <> long "tool" <> metavar "<ghc|cabal>" <> help
+            (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
               "Tool to list versions for. Default is all"
             )
           )
@@ -833,8 +833,8 @@ listOpts =
             (eitherReader criteriaParser)
             (  short 'c'
             <> long "show-criteria"
-            <> metavar "<installed|set>"
+            <> metavar "<installed|set|available>"
-            <> help "Show only installed or set tool versions"
+            <> help "Show only installed/set/available tool versions"
             )
           )
     <*> switch
@@ -1429,6 +1429,8 @@ toolVersionEither s' =
 toolParser :: String -> Either String Tool
 toolParser s' | t == T.pack "ghc"   = Right GHC
               | t == T.pack "cabal" = Right Cabal
+              | t == T.pack "hls"   = Right HLS
+              | t == T.pack "stack" = Right Stack
               | otherwise           = Left ("Unknown tool: " <> s')
   where t = T.toLower (T.pack s')
 
@@ -1436,6 +1438,7 @@ toolParser s' | t == T.pack "ghc"   = Right GHC
 criteriaParser :: String -> Either String ListCriteria
 criteriaParser s' | t == T.pack "installed" = Right ListInstalled
                   | t == T.pack "set"       = Right ListSet
+                  | t == T.pack "available" = Right ListAvailable
                   | otherwise               = Left ("Unknown criteria: " <> s')
   where t = T.toLower (T.pack s')
 

lib/GHCup.hs

@@ -511,7 +511,7 @@ installCabalUnpacked path inst mver' forceInstall = do
   unless forceInstall          -- Overwrite it when it IS a force install
     (liftE $ throwIfFileAlreadyExists destPath)
     
-  handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+  copyFileE
     (path </> cabalFile <> exeExt)
     destPath
   lift $ chmod_755 destPath
@@ -661,7 +661,7 @@ installHLSUnpacked path inst mver' forceInstall = do
     unless forceInstall   -- if it is a force install, overwrite it.
       (liftE $ throwIfFileAlreadyExists destPath)
       
-    handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+    copyFileE
       srcPath
       destPath
     lift $ chmod_755 destPath
@@ -677,7 +677,7 @@ installHLSUnpacked path inst mver' forceInstall = do
   unless forceInstall
     (liftE $ throwIfFileAlreadyExists destWrapperPath)
       
-  handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+  copyFileE
     srcWrapperPath
     destWrapperPath
     
@@ -849,35 +849,37 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
       cp <- case cabalProject of
         Just cp
           | isAbsolute cp -> do
-              handleIO (throwE . CopyError . show) $ liftIO $ copyFile cp (workdir </> "cabal.project")
+              copyFileE cp (workdir </> "cabal.project")
               pure "cabal.project"
           | otherwise -> pure (takeFileName cp)
         Nothing -> pure "cabal.project"
-      forM_ cabalProjectLocal $ \cpl -> handleIO (throwE . CopyError . show) $ liftIO $ copyFile cpl (workdir </> cp <.> "local")
+      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' installDir
+        liftIO $ createDirRecursive' ghcInstallDir
         lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
         liftE $ lEM @_ @'[ProcessError] $
-          execLogged "cabal" ( [ "v2-install"
+          execLogged "cabal" ( [ "v2-build"
                                , "-w"
                                , "ghc-" <> T.unpack (prettyVer ghc)
-                               , "--install-method=copy"
                                ] ++
                                maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
-                               [ "--overwrite-policy=always"
+                               [ "--project-file=" <> cp
-                               , "--disable-profiling"
+                               ] ++ targets
-                               , "--disable-tests"
-                               , "--enable-split-sections"
-                               , "--enable-executable-stripping"
-                               , "--enable-executable-static"
-                               , "--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
@@ -1038,7 +1040,7 @@ installStackUnpacked path inst mver' forceInstall = do
   unless forceInstall
     (liftE $ throwIfFileAlreadyExists destPath)
       
-  handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+  copyFileE
     (path </> stackFile <> exeExt)
     destPath
   lift $ chmod_755 destPath
@@ -1335,6 +1337,7 @@ warnAboutHlsCompatibility = do
 -- | Filter data type for 'listVersions'.
 data ListCriteria = ListInstalled
                   | ListSet
+                  | ListAvailable
                   deriving Show
 
 -- | A list result describes a single tool version
@@ -1677,6 +1680,7 @@ listVersions lt' criteria = do
     Nothing            -> lr
     Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
     Just ListSet       -> filter (\ListResult {..} -> lSet) lr
+    Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr
 
 
 
@@ -2407,7 +2411,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
                             <> ".tar"
                             <> takeExtension tar)
     let tarPath = cacheDir </> tarName
-    handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
+    copyFileE (workdir </> tar)
                                                              tarPath
     lift $ logInfo $ "Copied bindist to " <> T.pack tarPath
     pure tarPath
@@ -2573,7 +2577,7 @@ upgradeGHCup mtarget force' = do
   lift $ logDebug $ "rm -f " <> T.pack destFile
   lift $ hideError NoSuchThing $ recycleFile destFile
   lift $ logDebug $ "cp " <> T.pack p <> " " <> T.pack destFile
-  handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
+  copyFileE p
                                                            destFile
   lift $ chmod_755 destFile
 

lib/GHCup/Utils/Prelude.hs

@@ -24,6 +24,7 @@ import           GHCup.Types
 #endif
 import           GHCup.Types.Optics
 import {-# SOURCE #-} GHCup.Utils.Logger
+import           GHCup.Errors
 
 import           Control.Applicative
 import           Control.Exception.Safe
@@ -32,7 +33,7 @@ import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
-import           Data.List                      ( nub, intercalate, stripPrefix, isPrefixOf )
+import           Data.List                      ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd )
 import           Data.Maybe
 import           Data.Foldable
 import           Data.String
@@ -509,6 +510,10 @@ recover action =
 #endif
 
 
+copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Excepts xs m ()
+copyFileE from = handleIO (throwE . CopyError . show) . liftIO . copyFile from
+
+
 -- | Gathering monoidal values
 --
 -- >>> traverseFold (pure . (:["0"])) ["1","2"]
@@ -529,6 +534,8 @@ forFold = \t -> (`traverseFold` t)
 --
 -- >>> stripNewline "foo\n\n\n"
 -- "foo"
+-- >>> stripNewline "foo\n\n\nfoo"
+-- "foofoo"
 -- >>> stripNewline "foo\r"
 -- "foo"
 -- >>> stripNewline "foo"
@@ -540,10 +547,29 @@ stripNewline :: String -> String
 stripNewline = filter (`notElem` "\n\r")
 
 
+-- | Strip @\\r@ and @\\n@ from end of 'String'.
+--
+-- >>> stripNewlineEnd "foo\n\n\n"
+-- "foo"
+-- >>> stripNewlineEnd "foo\n\n\nfoo"
+-- "foo\n\n\nfoo"
+-- >>> stripNewlineEnd "foo\r"
+-- "foo"
+-- >>> stripNewlineEnd "foo"
+-- "foo"
+--
+-- prop> \t -> stripNewlineEnd (t <> "\n") === stripNewlineEnd t
+-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewlineEnd t == t
+stripNewlineEnd :: String -> String
+stripNewlineEnd = dropWhileEnd (`elem` "\n\r")
+
+
 -- | Strip @\\r@ and @\\n@ from 'Text's
 --
 -- >>> stripNewline' "foo\n\n\n"
 -- "foo"
+-- >>> stripNewline' "foo\n\n\nfoo"
+-- "foofoo"
 -- >>> stripNewline' "foo\r"
 -- "foo"
 -- >>> stripNewline' "foo"