Show a warning if xattr can't be executed
This commit is contained in:
		
							parent
							
								
									cea71beb4d
								
							
						
					
					
						commit
						bfc50e269c
					
				
							
								
								
									
										15
									
								
								lib/GHCup.hs
									
									
									
									
									
								
							
							
						
						
									
										15
									
								
								lib/GHCup.hs
									
									
									
									
									
								
							| @ -83,7 +83,7 @@ import           System.IO.Error | |||||||
| #if defined(IS_WINDOWS) | #if defined(IS_WINDOWS) | ||||||
| import           System.IO.Temp | import           System.IO.Temp | ||||||
| #endif | #endif | ||||||
| import           Text.PrettyPrint.HughesPJClass ( prettyShow ) | import           Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty ) | ||||||
| import           Text.Regex.Posix | import           Text.Regex.Posix | ||||||
| 
 | 
 | ||||||
| import qualified Crypto.Hash.SHA256            as SHA256 | import qualified Crypto.Hash.SHA256            as SHA256 | ||||||
| @ -276,7 +276,7 @@ installPackedGHC dl msubdir inst ver = do | |||||||
|   -- unpack |   -- unpack | ||||||
|   tmpUnpack <- lift mkGhcupTmpDir |   tmpUnpack <- lift mkGhcupTmpDir | ||||||
|   liftE $ unpackToDir tmpUnpack dl |   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 |   -- the subdir of the archive where we do the work | ||||||
|   workdir <- maybe (pure tmpUnpack) |   workdir <- maybe (pure tmpUnpack) | ||||||
| @ -451,7 +451,7 @@ installCabalBindist dlinfo ver isoFilepath = do | |||||||
|   -- unpack |   -- unpack | ||||||
|   tmpUnpack <- lift withGHCupTmpDir |   tmpUnpack <- lift withGHCupTmpDir | ||||||
|   liftE $ unpackToDir tmpUnpack dl |   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 |   -- the subdir of the archive where we do the work | ||||||
|   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) |   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) | ||||||
| @ -579,7 +579,7 @@ installHLSBindist dlinfo ver isoFilepath = do | |||||||
|   -- unpack |   -- unpack | ||||||
|   tmpUnpack <- lift withGHCupTmpDir |   tmpUnpack <- lift withGHCupTmpDir | ||||||
|   liftE $ unpackToDir tmpUnpack dl |   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 |   -- the subdir of the archive where we do the work | ||||||
|   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) |   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) | ||||||
| @ -760,7 +760,7 @@ installStackBindist dlinfo ver isoFilepath = do | |||||||
|   -- unpack |   -- unpack | ||||||
|   tmpUnpack <- lift withGHCupTmpDir |   tmpUnpack <- lift withGHCupTmpDir | ||||||
|   liftE $ unpackToDir tmpUnpack dl |   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 |   -- the subdir of the archive where we do the work | ||||||
|   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) |   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 |         -- unpack | ||||||
|         tmpUnpack <- lift mkGhcupTmpDir |         tmpUnpack <- lift mkGhcupTmpDir | ||||||
|         liftE $ unpackToDir tmpUnpack dl |         liftE $ unpackToDir tmpUnpack dl | ||||||
|         void $ lift $ darwinNotarization _rPlatform tmpUnpack |         liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack | ||||||
| 
 | 
 | ||||||
|         workdir <- maybe (pure tmpUnpack) |         workdir <- maybe (pure tmpUnpack) | ||||||
|                          (liftE . intoSubdir 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 |             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)) |             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}|] |         lift $ $(logInfo) [i|Git version #{ref} corresponds to GHC version #{prettyVer tver}|] | ||||||
| 
 | 
 | ||||||
|         pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver) |         pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver) | ||||||
| @ -2354,4 +2354,3 @@ whereIsTool tool ver@GHCTargetVersion {..} = do | |||||||
|       liftIO $ canonicalizePath currentRunningExecPath |       liftIO $ canonicalizePath currentRunningExecPath | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| 
 |  | ||||||
|  | |||||||
| @ -5,6 +5,7 @@ | |||||||
| {-# LANGUAGE ScopedTypeVariables #-} | {-# LANGUAGE ScopedTypeVariables #-} | ||||||
| {-# LANGUAGE TypeFamilies        #-} | {-# LANGUAGE TypeFamilies        #-} | ||||||
| {-# LANGUAGE TypeOperators       #-} | {-# LANGUAGE TypeOperators       #-} | ||||||
|  | {-# LANGUAGE TemplateHaskell     #-} | ||||||
| 
 | 
 | ||||||
| {-| | {-| | ||||||
| Module      : GHCup.Utils.Prelude | Module      : GHCup.Utils.Prelude | ||||||
| @ -29,6 +30,7 @@ import           Control.Exception.Safe | |||||||
| import           Control.Monad | import           Control.Monad | ||||||
| import           Control.Monad.IO.Class | import           Control.Monad.IO.Class | ||||||
| import           Control.Monad.Reader | import           Control.Monad.Reader | ||||||
|  | import           Control.Monad.Logger | ||||||
| import           Data.Bifunctor | import           Data.Bifunctor | ||||||
| import           Data.ByteString                ( ByteString ) | import           Data.ByteString                ( ByteString ) | ||||||
| import           Data.List                      ( nub, intercalate ) | import           Data.List                      ( nub, intercalate ) | ||||||
| @ -39,6 +41,7 @@ import           Data.Versions | |||||||
| import           Data.Word8 | import           Data.Word8 | ||||||
| import           Haskus.Utils.Types.List | import           Haskus.Utils.Types.List | ||||||
| import           Haskus.Utils.Variant.Excepts | import           Haskus.Utils.Variant.Excepts | ||||||
|  | import           Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty ) | ||||||
| import           System.IO.Error | import           System.IO.Error | ||||||
| #if defined(IS_WINDOWS) | #if defined(IS_WINDOWS) | ||||||
| import           System.IO.Temp | import           System.IO.Temp | ||||||
| @ -170,6 +173,10 @@ lEM' :: forall e' e es a m | |||||||
|      -> Excepts es m a |      -> Excepts es m a | ||||||
| lEM' f em = lift em >>= lE . first f | 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 a b -> VEither '[a] b | ||||||
| fromEither = either (VLeft . V) VRight | fromEither = either (VLeft . V) VRight | ||||||
| 
 | 
 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user