diff --git a/src/Caches/Local/Downloading.hs b/src/Caches/Local/Downloading.hs index dbc62f51..d0c62f40 100644 --- a/src/Caches/Local/Downloading.hs +++ b/src/Caches/Local/Downloading.hs @@ -1,38 +1,44 @@ module Caches.Local.Downloading where -import Configuration ( carthageBuildDirectory - , carthageArtifactsBuildDirectoryForPlatform - ) +import Configuration ( carthageBuildDirectory + , carthageArtifactsBuildDirectoryForPlatform + ) +import Control.Exception ( catch + , throw + , displayException + ) import Control.Monad.Except -import Control.Monad.Trans.Resource ( runResourceT ) +import Control.Monad.Trans.Resource ( runResourceT ) import qualified Data.ByteString.Lazy as LBS import Data.Carthage.TargetPlatform import qualified Data.Conduit as C - ( runConduit - , (.|) - ) + ( runConduit + , (.|) + ) import qualified Data.Conduit.Binary as C - ( sinkLbs - , sourceFile - ) + ( sinkLbs + , sourceFile + ) import Data.Romefile import Data.UUID as UUID - ( UUID ) + ( UUID ) import System.Directory import System.FilePath -import Types hiding ( version ) +import Types hiding ( version ) import Caches.Common -import Control.Monad.Reader ( ReaderT - , ask - ) +import Control.Monad.Reader ( ReaderT + , ask + ) import Data.Either -import Data.Monoid ( (<>) ) +import Data.Monoid ( (<>) ) +import System.IO.Error ( isDoesNotExistError ) import Utils import Xcode.DWARF + -- | Retrieves a Framework from a local cache getFrameworkFromLocalCache :: MonadIO m @@ -139,7 +145,14 @@ getAndUnzipBcsymbolmapFromLocalCache lCacheDir reverseRomeMap fVersion@(Framewor let symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID binary <- getBcsymbolmapFromLocalCache lCacheDir cachePrefix reverseRomeMap fVersion platform dwarfUUID sayFunc $ "Found " <> symbolmapName <> " in local cache at: " <> frameworkLocalCachePath prefix - deleteFile (bcsymbolmapPath dwarfUUID) verbose + liftIO + $ deleteFile (bcsymbolmapPath dwarfUUID) verbose + `catch` (\e -> + let sayFuncIO = if verbose then sayLnWithTime else sayLn + in if isDoesNotExistError e + then when verbose $ sayFuncIO ("Error :" <> displayException e) + else throw e + ) unzipBinary binary symbolmapName (bcsymbolmapZipName dwarfUUID) verbose where frameworkLocalCachePath cPrefix = lCacheDir cPrefix remoteFrameworkUploadPath diff --git a/src/Caches/S3/Downloading.hs b/src/Caches/S3/Downloading.hs index 3eb3feae..a8f6d6dc 100644 --- a/src/Caches/S3/Downloading.hs +++ b/src/Caches/S3/Downloading.hs @@ -1,36 +1,41 @@ module Caches.S3.Downloading where import Caches.Common -import Configuration ( carthageArtifactsBuildDirectoryForPlatform ) -import Control.Exception ( try ) -import Control.Lens ( view ) +import Configuration ( carthageArtifactsBuildDirectoryForPlatform ) +import Control.Exception ( try + , catch + , throw + , displayException + ) +import Control.Lens ( view ) import Control.Monad import Control.Monad.Except -import Control.Monad.Reader ( ReaderT - , ask - , runReaderT - , withReaderT - ) +import Control.Monad.Reader ( ReaderT + , ask + , runReaderT + , withReaderT + ) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Carthage.TargetPlatform import qualified Data.Conduit as C - ( ConduitT - , await - , yield - , (.|) - ) + ( ConduitT + , await + , yield + , (.|) + ) import qualified Data.Conduit.Binary as C - ( sinkLbs ) -import Data.Either ( lefts ) -import Data.Maybe ( fromMaybe ) -import Data.Monoid ( (<>) ) -import Data.Romefile ( Framework(..) ) + ( sinkLbs ) +import Data.Either ( lefts ) +import Data.Maybe ( fromMaybe ) +import Data.Monoid ( (<>) ) +import Data.Romefile ( Framework(..) ) import qualified Data.Text as T import qualified Network.AWS as AWS import qualified Network.AWS.S3 as S3 -import System.FilePath ( () ) -import Types hiding ( version ) +import System.FilePath ( () ) +import System.IO.Error ( isDoesNotExistError ) +import Types hiding ( version ) import Utils import Xcode.DWARF @@ -150,9 +155,13 @@ getAndUnzipBcsymbolmapFromS3 getAndUnzipBcsymbolmapFromS3 s3BucketName reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform dwarfUUID = when (platform `elem` fwps) $ do (_, _, verbose) <- ask + let sayFunc = if verbose then sayLnWithTime else sayLn let symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID binary <- getBcsymbolmapFromS3 s3BucketName reverseRomeMap fVersion platform dwarfUUID - deleteFile (bcsymbolmapPath dwarfUUID) verbose + liftIO + $ deleteFile (bcsymbolmapPath dwarfUUID) verbose + `catch` (\e -> if isDoesNotExistError e then when verbose $ sayFunc ("Error :" <> displayException e) else throw e + ) unzipBinary binary symbolmapName (bcsymbolmapZipName dwarfUUID) verbose where platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f diff --git a/src/Engine/Downloading.hs b/src/Engine/Downloading.hs index 41535b01..0795e311 100644 --- a/src/Engine/Downloading.hs +++ b/src/Engine/Downloading.hs @@ -4,25 +4,26 @@ module Engine.Downloading where import Caches.Common -import Configuration ( carthageArtifactsBuildDirectoryForPlatform ) -import Control.Exception ( try ) +import Configuration ( carthageArtifactsBuildDirectoryForPlatform ) +import Control.Exception ( try, catch, throw, displayException) import Control.Monad import Control.Monad.Except -import Control.Monad.Reader ( ReaderT - , ask - , runReaderT - , withReaderT - ) +import Control.Monad.Reader ( ReaderT + , ask + , runReaderT + , withReaderT + ) import qualified Data.ByteString.Lazy as LBS import Data.Carthage.TargetPlatform -import Data.Either ( lefts ) -import Data.Monoid ( (<>) ) -import Data.Romefile ( Framework(..) ) +import Data.Either ( lefts ) +import Data.Monoid ( (<>) ) +import Data.Romefile ( Framework(..) ) import qualified Data.UUID as UUID - ( UUID ) + ( UUID ) import System.Directory -import System.FilePath ( () ) -import Types hiding ( version ) +import System.FilePath ( () ) +import System.IO.Error ( isDoesNotExistError ) +import Types hiding ( version ) import Utils import Xcode.DWARF import qualified Turtle @@ -108,9 +109,12 @@ getAndUnzipBcsymbolmapWithEngine getAndUnzipBcsymbolmapWithEngine enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform dwarfUUID tmpDir = when (platform `elem` fwps) $ do (_, verbose, _) <- ask + let sayFunc = if verbose then sayLnWithTime else sayLn let symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID binary <- getBcsymbolmapWithEngine enginePath reverseRomeMap fVersion platform dwarfUUID tmpDir - deleteFile (bcsymbolmapPath dwarfUUID) verbose + liftIO $ deleteFile (bcsymbolmapPath dwarfUUID) verbose + `catch` (\e -> + if isDoesNotExistError e then when verbose $ sayFunc ("Error :" <> displayException e) else throw e) unzipBinary binary symbolmapName (bcsymbolmapZipName dwarfUUID) verbose where platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f @@ -191,7 +195,7 @@ getArtifactFromEngine -> ExceptT String (ReaderT (Bool, UUID.UUID) IO) LBS.ByteString getArtifactFromEngine enginePath remotePath artifactName tmpDir = do readerEnv <- ask - eitherArtifact :: Either IOError LBS.ByteString <- liftIO $ try $ runReaderT + eitherArtifact :: Either IOError LBS.ByteString <- liftIO $ Control.Exception.try $ runReaderT (downloadBinaryWithEngine enginePath remotePath artifactName tmpDir) readerEnv case eitherArtifact of @@ -229,5 +233,7 @@ downloadBinaryWithEngine enginePath objectRemotePath objectName tmpDir = do then liftIO $ do binary <- LBS.readFile outputPath deleteFile outputPath verbose + `catch` (\e -> let sayFuncIO = if verbose then sayLnWithTime else sayLn in + if isDoesNotExistError e then when verbose $ sayFuncIO ("Error :" <> displayException e) else throw e) return binary else fail "Binary was not downloaded by engine" diff --git a/src/Lib.hs b/src/Lib.hs index f61e66f0..d5290170 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -22,59 +22,62 @@ import Engine.Downloading import Engine.Probing import Engine.Uploading import Configuration -import Control.Applicative ( (<|>) ) -import Control.Concurrent.Async.Lifted.Safe ( mapConcurrently_ - , mapConcurrently - , concurrently_ - ) -import Control.Lens hiding ( List ) +import Control.Applicative ( (<|>) ) +import Control.Concurrent.Async.Lifted.Safe + ( mapConcurrently_ + , mapConcurrently + , concurrently_ + ) +import Control.Lens hiding ( List ) import Control.Monad + import Control.Monad.Catch + import Control.Monad.Except -import Control.Monad.Reader ( ReaderT - , ask - , runReaderT - ) -import Control.Monad.Trans.Maybe ( exceptToMaybeT - , runMaybeT - ) +import Control.Monad.Reader ( ReaderT + , ask + , runReaderT + ) +import Control.Monad.Trans.Maybe ( exceptToMaybeT + , runMaybeT + ) import qualified Data.ByteString.Char8 as BS - ( pack ) + ( pack ) import qualified Data.ByteString.Lazy as LBS -import Data.Yaml ( encodeFile ) -import Data.IORef ( newIORef ) +import Data.Yaml ( encodeFile ) +import Data.IORef ( newIORef ) import Data.Carthage.Cartfile import Data.Carthage.TargetPlatform -import Data.Either.Extra ( maybeToEither - , eitherToMaybe - , mapLeft - ) -import Data.Maybe ( fromMaybe - , maybe - ) -import Data.Monoid ( (<>) ) +import Data.Either.Extra ( maybeToEither + , eitherToMaybe + , mapLeft + ) +import Data.Maybe ( fromMaybe + , maybe + ) +import Data.Monoid ( (<>) ) import Data.Romefile import qualified Data.UUID as UUID - ( UUID - , toString - ) + ( UUID + , toString + ) import qualified Data.Map.Strict as M - ( empty ) + ( empty ) import qualified Data.Text as T import qualified Network.AWS as AWS import qualified Network.AWS.Auth as AWS - ( fromEnv ) + ( fromEnv ) import qualified Network.AWS.Env as AWS - ( Env(..) - , retryConnectionFailure - ) + ( Env(..) + , retryConnectionFailure + ) import qualified Network.AWS.Data as AWS - ( fromText ) + ( fromText ) import qualified Network.AWS.S3 as S3 import qualified Network.AWS.STS.AssumeRole as STS - ( assumeRole - , arrsCredentials - ) + ( assumeRole + , arrsCredentials + ) import qualified Network.AWS.Utils as AWS import qualified Network.HTTP.Conduit as Conduit @@ -82,6 +85,7 @@ import Network.URL import System.Directory import System.Environment import System.FilePath +import System.IO.Error ( isDoesNotExistError ) import Types import Types.Commands as Commands import Utils @@ -119,7 +123,8 @@ getAWSEnv = do ExceptT . return . Left . show $ e (auth, _) <- AWS.catching AWS._MissingEnvError AWS.fromEnv $ \envError -> either throwError - (\_ {- cred -} -> do + (\_ {- cred -} + -> do let finalProfile = fromMaybe profile (eitherToMaybe $ AWS.sourceProfileOf profile =<< config) let authAndRegion = (,) @@ -494,22 +499,29 @@ downloadArtifacts mS3BucketName mlCacheDir mEnginePath reverseRepositoryMap fram tmpDir <- liftIO $ tmpDirWithUUID uuid let engineEnv = (cachePrefix, skipLocalCacheFlag, concurrentlyFlag, verbose, uuid) let action1 = runReaderT - (downloadFrameworksAndArtifactsWithEngine ePath lCacheDir reverseRepositoryMap frameworkVersions platforms tmpDir) + (downloadFrameworksAndArtifactsWithEngine ePath + lCacheDir + reverseRepositoryMap + frameworkVersions + platforms + tmpDir + ) engineEnv - let action2 = runReaderT (downloadVersionFilesWithEngine ePath lCacheDir gitRepoNamesAndVersions tmpDir) engineEnv - if performConcurrently + let action2 = + runReaderT (downloadVersionFilesWithEngine ePath lCacheDir gitRepoNamesAndVersions tmpDir) engineEnv + if performConcurrently then liftIO $ concurrently_ action1 action2 >> deleteDirectory tmpDir verbose - else liftIO $ action1 >> action2 >> deleteDirectory tmpDir verbose + else liftIO $ action1 >> action2 >> deleteDirectory tmpDir verbose -- Misconfigured - (Nothing , Nothing, Nothing ) -> throwError allCacheKeysMissingMessage + (Nothing, Nothing, Nothing) -> throwError allCacheKeysMissingMessage -- Misconfigured - (Just _, _ , Just _) -> throwError conflictingCachesMessage + (Just _ , _ , Just _ ) -> throwError conflictingCachesMessage where gitRepoNamesAndVersions :: [ProjectNameAndVersion] gitRepoNamesAndVersions = repoNamesAndVersionForFrameworkVersions reverseRepositoryMap frameworkVersions - + tmpDirWithUUID :: UUID.UUID -> IO FilePath tmpDirWithUUID uuid = do dir <- getTemporaryDirectory @@ -562,7 +574,7 @@ uploadArtifacts mS3BucketName mlCacheDir mEnginePath reverseRepositoryMap framew let action2 = runReaderT (uploadVersionFilesToEngine ePath lCacheDir gitRepoNamesAndVersions) engineEnv if performConcurrently then liftIO $ concurrently_ action1 action2 else liftIO $ action1 >> action2 (Nothing, Nothing, Nothing) -> throwError allCacheKeysMissingMessage - (Just _, _ , Just _) -> throwError conflictingCachesMessage + (Just _ , _ , Just _ ) -> throwError conflictingCachesMessage where gitRepoNamesAndVersions :: [ProjectNameAndVersion] @@ -599,8 +611,8 @@ uploadVersionFileToEngine ePath mlCacheDir projectNameAndVersion = do <*> Just versionFileContent <*> Just projectNameAndVersion <*> Just verbose - liftIO $ runReaderT (uploadVersionFileToEngine' ePath versionFileContent projectNameAndVersion) - (cachePrefix, verbose) + liftIO + $ runReaderT (uploadVersionFileToEngine' ePath versionFileContent projectNameAndVersion) (cachePrefix, verbose) where versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion @@ -1038,6 +1050,12 @@ downloadFrameworkAndArtifactsFromCaches s3BucketName (Just lCacheDir) reverseRom fwn verbose deleteFile (localBcsymbolmapPathFrom dwarfUUID) verbose + `catch` (\e -> if isDoesNotExistError e + then + when verbose $ sayFunc ("Error :" <> displayException e) + else + throwM e + ) unzipBinary symbolmapBinary symbolmapLoggingName (bcsymbolmapZipName dwarfUUID) verbose whenLeft sayFunc e ) @@ -1103,33 +1121,17 @@ downloadFrameworksAndArtifactsWithEngine -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` identifying the Frameworks and dSYMs -> [TargetPlatform] -- ^ A list of target platforms restricting the scope of this action. -> FilePath -- ^ A temporary intermediate directory used by the engine - -> ReaderT - ( CachePrefix - , SkipLocalCacheFlag - , ConcurrentlyFlag - , Bool - , UUID.UUID - ) - IO - () -downloadFrameworksAndArtifactsWithEngine ePath lCacheDir reverseRomeMap fvs platforms tmpDir - = do - (_, _, ConcurrentlyFlag performConcurrently, _, _) <- ask - if performConcurrently - then mapConcurrently_ downloadConcurrently fvs - -- (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) - -- (Traversable t, Monad m) => t (m a) -> m (t a) - else mapM_ (sequence . download) platforms + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) IO () +downloadFrameworksAndArtifactsWithEngine ePath lCacheDir reverseRomeMap fvs platforms tmpDir = do + (_, _, ConcurrentlyFlag performConcurrently, _, _) <- ask + if performConcurrently + then mapConcurrently_ downloadConcurrently fvs + -- (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) + -- (Traversable t, Monad m) => t (m a) -> m (t a) + else mapM_ (sequence . download) platforms where - downloadConcurrently f = mapConcurrently - (\p -> downloadFrameworkAndArtifactsWithEngine ePath - lCacheDir - reverseRomeMap - f - p - tmpDir - ) - platforms + downloadConcurrently f = + mapConcurrently (\p -> downloadFrameworkAndArtifactsWithEngine ePath lCacheDir reverseRomeMap f p tmpDir) platforms -- Types here a tricky (for me) -- someF = mapM (\k v -> putStrLn (k ++ " " ++ v)) ["hello", "ciao"] :: String -> [IO ()] -- while @@ -1201,6 +1203,12 @@ downloadFrameworkAndArtifactsWithEngine ePath (Just lCacheDir) reverseRomeMap fV fwn verbose deleteFile (localBcsymbolmapPathFrom dwarfUUID) verbose + `catch` (\e -> if isDoesNotExistError e + then + when verbose $ sayFunc ("Error :" <> displayException e) + else + throwM e + ) unzipBinary symbolmapBinary symbolmapLoggingName (bcsymbolmapZipName dwarfUUID) verbose whenLeft sayFunc e ) @@ -1263,7 +1271,8 @@ downloadVersionFilesWithEngine -> [ProjectNameAndVersion] -- ^ A list of `ProjectName`s and `Version`s information. -> FilePath -- ^ A temporary path used by the engine to download binaries to -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) IO () -downloadVersionFilesWithEngine ePath lDir pnvs tmpDir = mapM_ (\pnv -> downloadVersionFileWithEngine ePath lDir pnv tmpDir) pnvs +downloadVersionFilesWithEngine ePath lDir pnvs tmpDir = + mapM_ (\pnv -> downloadVersionFileWithEngine ePath lDir pnv tmpDir) pnvs diff --git a/src/Network/AWS/Utils.hs b/src/Network/AWS/Utils.hs index 7c04570c..9bc2b1bd 100644 --- a/src/Network/AWS/Utils.hs +++ b/src/Network/AWS/Utils.hs @@ -97,9 +97,7 @@ authFromCredentilas profile credentials = AWS.Auth <$> authEnv AWS.AuthEnv <$> (AWS.AccessKey <$> accessKeyId) <*> (AWS.Sensitive . AWS.SecretKey <$> secretAccessKey) - <*> ( (Just . AWS.Sensitive . AWS.SessionToken <$> sessionToken) - <|> pure Nothing - ) + <*> ((Just . AWS.Sensitive . AWS.SessionToken <$> sessionToken) <|> pure Nothing) <*> ((T.readEither =<< T.unpack <$> expirationDate) <|> pure Nothing) regionOf :: T.Text -> ConfigFile -> Either String AWS.Region @@ -115,65 +113,47 @@ endPointOf profile = parseURL <=< lookupValue profile "endpoint" . asIni where parseURL s = if T.null s then Left "Failed reading: Failure parsing Endpoint from empty string" - else - maybeToEither "Failed reading: Endpoint is not a valid URL" - $ importURL - . T.unpack - $ s + else maybeToEither "Failed reading: Endpoint is not a valid URL" $ importURL . T.unpack $ s -getPropertyFromCredentials - :: T.Text -> T.Text -> CredentialsFile -> Either String T.Text -getPropertyFromCredentials profile property = - lookupValue profile property . asIni +getPropertyFromCredentials :: T.Text -> T.Text -> CredentialsFile -> Either String T.Text +getPropertyFromCredentials profile property = lookupValue profile property . asIni getPropertyFromConfig :: T.Text -> T.Text -> ConfigFile -> Either String T.Text getPropertyFromConfig profile property = lookupValue profile property . asIni sourceProfileOf :: T.Text -> ConfigFile -> Either String T.Text -sourceProfileOf profile configFile = - getPropertyFromConfig finalProfile key configFile - `withError` const (missingKeyError key profile) +sourceProfileOf profile configFile = getPropertyFromConfig finalProfile key configFile + `withError` const (missingKeyError key profile) where - key = "source_profile" - finalProfile = - if profile == "default" then profile else T.pack "profile " <> profile + key = "source_profile" + finalProfile = if profile == "default" then profile else T.pack "profile " <> profile roleARNOf :: T.Text -> ConfigFile -> Either String T.Text -roleARNOf profile configFile = - getPropertyFromConfig finalProfile key configFile - `withError` const (missingKeyError key profile) +roleARNOf profile configFile = getPropertyFromConfig finalProfile key configFile + `withError` const (missingKeyError key profile) where - key = "role_arn" - finalProfile = - if profile == "default" then profile else T.pack "profile " <> profile + key = "role_arn" + finalProfile = if profile == "default" then profile else T.pack "profile " <> profile accessKeyIdOf :: T.Text -> CredentialsFile -> Either String T.Text -accessKeyIdOf profile credFile = - getPropertyFromCredentials profile key credFile - `withError` const (missingKeyError key profile) +accessKeyIdOf profile credFile = getPropertyFromCredentials profile key credFile + `withError` const (missingKeyError key profile) where key = "aws_access_key_id" missingKeyError :: T.Text -> T.Text -> String -missingKeyError key profile = - "Could not find key `" - ++ T.unpack key - ++ "` for profile `" - ++ T.unpack profile - ++ "`" +missingKeyError key profile = "Could not find key `" ++ T.unpack key ++ "` for profile `" ++ T.unpack profile ++ "`" withError :: Either a b -> (a -> c) -> Either c b withError = flip mapLeft secretAccessKeyOf :: T.Text -> CredentialsFile -> Either String T.Text -secretAccessKeyOf profile credFile = - getPropertyFromCredentials profile key credFile - `withError` const (missingKeyError key profile) +secretAccessKeyOf profile credFile = getPropertyFromCredentials profile key credFile + `withError` const (missingKeyError key profile) where key = "aws_secret_access_key" sessionTokenOf :: T.Text -> CredentialsFile -> Either String T.Text -sessionTokenOf profile credFile = - getPropertyFromCredentials profile key credFile - `withError` const (missingKeyError key profile) +sessionTokenOf profile credFile = getPropertyFromCredentials profile key credFile + `withError` const (missingKeyError key profile) where key = "aws_session_token" expirationOf :: T.Text -> CredentialsFile -> Either String T.Text diff --git a/src/Utils.hs b/src/Utils.hs index 5e4eab8d..4ec74e77 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -6,76 +6,74 @@ module Utils where import qualified Codec.Archive.Zip as Zip -import Configuration ( carthageArtifactsBuildDirectoryForPlatform ) -import Control.Arrow ( left ) +import Configuration ( carthageArtifactsBuildDirectoryForPlatform ) +import Control.Arrow ( left ) import Control.Exception as E - ( try ) -import Control.Lens hiding ( List ) -import Control.Monad.Catch + ( try ) +import Control.Lens hiding ( List ) import Control.Monad.Except -import Control.Monad.Trans.Resource ( MonadUnliftIO - , runResourceT - ) +import Control.Monad.Trans.Resource ( MonadUnliftIO + , runResourceT + ) import Data.Aeson import Data.Aeson.Types import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as LBS import Data.Carthage.Cartfile import Data.Carthage.TargetPlatform -import Data.Char ( isNumber ) +import Data.Char ( isNumber ) import qualified Data.Conduit as C - ( runConduit - , (.|) - ) + ( runConduit + , (.|) + ) import qualified Data.Conduit.Binary as C - ( sinkFile - , sourceLbs - ) -import Data.Function ( on ) + ( sinkFile + , sourceLbs + ) +import Data.Function ( on ) import Data.List import qualified Data.Map.Strict as M -import Data.Maybe ( fromJust - , fromMaybe - ) +import Data.Maybe ( fromJust + , fromMaybe + ) import Data.Romefile import qualified Data.Text as T import Data.Text.Encoding import qualified Data.Text.IO as T import Data.Time import qualified Network.AWS as AWS - ( Error - , ErrorMessage(..) - , serviceMessage - , _ServiceError - ) + ( Error + , ErrorMessage(..) + , serviceMessage + , _ServiceError + ) import qualified Network.AWS.Data.Text as AWS - ( showText ) + ( showText ) import Network.HTTP.Conduit as HTTP import Network.HTTP.Types.Header as HTTP - ( hUserAgent ) -import Numeric ( showFFloat ) -import System.Directory ( createDirectoryIfMissing - , doesDirectoryExist - , doesFileExist - , getHomeDirectory - , removeFile - ) -import System.FilePath ( addTrailingPathSeparator - , dropFileName - , normalise - , () - ) -import System.IO.Error ( isDoesNotExistError ) -import System.Path.NameManip ( absolute_path - , guess_dotdot - ) -import Text.Read ( readMaybe ) + ( hUserAgent ) +import Numeric ( showFFloat ) +import System.Directory ( createDirectoryIfMissing + , doesDirectoryExist + , doesFileExist + , getHomeDirectory + , removeFile + ) +import System.FilePath ( addTrailingPathSeparator + , dropFileName + , normalise + , () + ) +import System.Path.NameManip ( absolute_path + , guess_dotdot + ) +import Text.Read ( readMaybe ) import qualified Turtle import Types -import Xcode.DWARF ( DwarfUUID - , bcsymbolmapNameFrom - ) +import Xcode.DWARF ( DwarfUUID + , bcsymbolmapNameFrom + ) @@ -561,11 +559,8 @@ deleteFile -> m () deleteFile path verbose = do let sayFunc = if verbose then sayLnWithTime else sayLn - liftIO $ removeFile path `catch` handleError sayFunc + liftIO $ removeFile path when verbose $ liftIO . sayFunc $ "Deleted: " <> path - where - handleError f e | isDoesNotExistError e = f $ "Error: no such file " <> path - | otherwise = throwM e