Show a warning if xattr can't be executed

.gitlab/script/ghcup_version.sh

@@ -49,6 +49,15 @@ elif [ "${OS}" = "LINUX" ] ; then
 		ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
 		ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
 		ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
+
+		# doctest
+		curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20210111/cabal-docspec-0.0.0.20210111.xz > cabal-docspec.xz
+		echo '0829bd034fba901cbcfe491d98ed8b28fd54f9cb5c91fa8e1ac62dc4413c9562  cabal-docspec.xz' | sha256sum -c -
+		xz -d < cabal-docspec.xz > "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
+		rm -f cabal-docspec.xz
+		chmod a+x "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
+
+		cabal-docspec -XCPP -XTypeSynonymInstances -XOverloadedStrings -XPackageImports --check-properties
 	fi
 elif [ "${OS}" = "FREEBSD" ] ; then
 	ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd"

lib/GHCup.hs

@@ -83,7 +83,7 @@ import           System.IO.Error
 #if defined(IS_WINDOWS)
 import           System.IO.Temp
 #endif
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
+import           Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
 import           Text.Regex.Posix
 
 import qualified Crypto.Hash.SHA256            as SHA256
@@ -276,7 +276,7 @@ installPackedGHC dl msubdir inst ver = do
   -- unpack
   tmpUnpack <- lift mkGhcupTmpDir
   liftE $ unpackToDir tmpUnpack dl
-  void $ lift $ darwinNotarization _rPlatform tmpUnpack
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack)
@@ -451,7 +451,7 @@ installCabalBindist dlinfo ver isoFilepath = do
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
   liftE $ unpackToDir tmpUnpack dl
-  void $ lift $ darwinNotarization _rPlatform tmpUnpack
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
@@ -579,7 +579,7 @@ installHLSBindist dlinfo ver isoFilepath = do
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
   liftE $ unpackToDir tmpUnpack dl
-  void $ lift $ darwinNotarization _rPlatform tmpUnpack
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
@@ -760,7 +760,7 @@ installStackBindist dlinfo ver isoFilepath = do
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
   liftE $ unpackToDir tmpUnpack dl
-  void $ lift $ darwinNotarization _rPlatform tmpUnpack
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
@@ -1816,7 +1816,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
         -- unpack
         tmpUnpack <- lift mkGhcupTmpDir
         liftE $ unpackToDir tmpUnpack dl
-        void $ lift $ darwinNotarization _rPlatform tmpUnpack
+        liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
         workdir <- maybe (pure tmpUnpack)
                          (liftE . intoSubdir tmpUnpack)
@@ -1856,7 +1856,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
             ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . decUTF8Safe' $ _stdOut
             ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
 
-        void $ lift $ darwinNotarization _rPlatform tmpUnpack
+        liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
         lift $ $(logInfo) [i|Git version #{ref} corresponds to GHC version #{prettyVer tver}|]
 
         pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
@@ -2354,4 +2354,3 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
       liftIO $ canonicalizePath currentRunningExecPath
 
 
-

lib/GHCup/Download.hs

@@ -601,5 +601,7 @@ urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
 --
 -- >>> getLastHeader "\n\nHTTP/1.0 200 Connection established\n\nHTTP/1.1 304 Not Modified\n"
 -- "HTTP/1.1 304 Not Modified\n"
+-- >>> getLastHeader "HTTP/1.1 304 Not Modified\n"
+-- "HTTP/1.1 304 Not Modified\n"
 getLastHeader :: T.Text -> T.Text
 getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [""] . fmap T.stripEnd . T.lines

lib/GHCup/Utils/Prelude.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE TemplateHaskell     #-}
 
 {-|
 Module      : GHCup.Utils.Prelude
@@ -29,6 +30,7 @@ import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
+import           Control.Monad.Logger
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
 import           Data.List                      ( nub, intercalate )
@@ -39,6 +41,7 @@ import           Data.Versions
 import           Data.Word8
 import           Haskus.Utils.Types.List
 import           Haskus.Utils.Variant.Excepts
+import           Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
 import           System.IO.Error
 #if defined(IS_WINDOWS)
 import           System.IO.Temp
@@ -170,6 +173,10 @@ lEM' :: forall e' e es a m
      -> Excepts es m a
 lEM' f em = lift em >>= lE . first f
 
+-- for some obscure reason... this won't type-check if we move it to a different module
+catchWarn :: forall es m . (Pretty (V es), MonadLogger m, Monad m) => Excepts es m () -> Excepts '[] m ()
+catchWarn = catchAllE @_ @es (\v -> lift $ $(logWarn) (T.pack . prettyShow $ v))
+
 fromEither :: Either a b -> VEither '[a] b
 fromEither = either (VLeft . V) VRight