diff --git a/.gitignore b/.gitignore index b3d841a6..235456aa 100644 --- a/.gitignore +++ b/.gitignore @@ -24,3 +24,13 @@ codex.tags _Dangerfile.tmp hscope.out TAGS + +# Tests and dev stuff +Carthage/ +Cartfile +Cartfile.resolved +Romefile +engine.sh +rome-local-cache/ +server-cache/ +travis/ diff --git a/.travis.yml b/.travis.yml index f8f554e0..2695e93c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -124,7 +124,7 @@ jobs: - travis_wait 60 bats integration-tests/static-frameworks-engine-yml.bats env: -- ARGS="--resolver=lts-13.10" +- ARGS="--resolver=lts-14.14" cache: directories: diff --git a/Rome.cabal b/Rome.cabal index 2024be7e..815e3924 100644 --- a/Rome.cabal +++ b/Rome.cabal @@ -1,5 +1,5 @@ name: Rome -version: 0.23.1.61 +version: 0.23.2.62 synopsis: A cache for Carthage description: Please see README.md homepage: https://github.com/blender/Rome @@ -74,6 +74,7 @@ library , extra >= 1.5.3 , yaml >= 0.9.0 , safe >= 0.3.17 + , uuid >= 1.3.13 ghc-options: -Wall -fno-warn-unused-do-bind @@ -89,6 +90,8 @@ executable rome , Rome , mtl >= 2.2.1 , optparse-applicative >= 0.12 + , uuid >= 1.3.13 + diff --git a/Rome.podspec b/Rome.podspec index fde6af7d..b82034d8 100644 --- a/Rome.podspec +++ b/Rome.podspec @@ -1,6 +1,6 @@ Pod::Spec.new do |s| s.name = 'Rome' - s.version = '0.23.1.61' + s.version = '0.23.2.62' s.summary = 'A cache tool for Carthage' s.homepage = 'https://github.com/blender/Rome' s.source = { :http => "#{s.homepage}/releases/download/v#{s.version}/rome.zip" } diff --git a/app/Main.hs b/app/Main.hs index 602c0b27..45596d15 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,16 +1,19 @@ module Main where -import CommandParsers (parseRomeOptions) +import CommandParsers ( parseRomeOptions ) import Control.Monad.Except -import Data.Monoid ((<>)) +import Control.Monad.Reader ( runReaderT ) +import Data.Monoid ( (<>) ) +import Data.UUID.V4 as UUID + ( nextRandom ) import Lib -import Options.Applicative as Opts +import Options.Applicative as Opts import System.Exit romeVersion :: RomeVersion -romeVersion = (0, 23, 1, 61) +romeVersion = (0, 23, 2, 62) @@ -19,24 +22,17 @@ main :: IO () main = do let opts = info ( Opts.helper - <*> Opts.flag' - Nothing - ( Opts.long "version" - <> Opts.help "Prints the version information" - <> Opts.hidden - ) + <*> Opts.flag' Nothing (Opts.long "version" <> Opts.help "Prints the version information" <> Opts.hidden) <|> Just <$> parseRomeOptions ) (header "Cache tool for Carthage") cmd <- execParser opts case cmd of - Nothing -> - putStrLn - $ romeVersionToString romeVersion - ++ " - Romam uno die non fuisse conditam." + Nothing -> putStrLn $ romeVersionToString romeVersion ++ " - Romam uno die non fuisse conditam." Just romeOptions -> do - p <- runExceptT $ runRomeWithOptions romeOptions romeVersion + globalUUID <- UUID.nextRandom + p <- runReaderT (runExceptT (runRomeWithOptions romeOptions romeVersion)) globalUUID case p of Right _ -> return () Left e -> die e diff --git a/brittany.yaml b/brittany.yaml new file mode 100644 index 00000000..a4d49c12 --- /dev/null +++ b/brittany.yaml @@ -0,0 +1,2 @@ +conf_layout: + lconfig_cols: 120 diff --git a/integration-tests/current-framework-named-yml.bats b/integration-tests/current-framework-named-yml.bats index a7ae7d78..8c4fc2d3 100644 --- a/integration-tests/current-framework-named-yml.bats +++ b/integration-tests/current-framework-named-yml.bats @@ -42,7 +42,7 @@ currentMap: EOF mkdir -p ~/.aws - printf "[default]\n region = us-east-1" >> ~/.aws/config + printf "[default]\n region = us-east-1" > ~/.aws/config # minio diff --git a/integration-tests/current-framework-yml.bats b/integration-tests/current-framework-yml.bats index 8fd3384b..0995d896 100644 --- a/integration-tests/current-framework-yml.bats +++ b/integration-tests/current-framework-yml.bats @@ -40,7 +40,7 @@ currentMap: EOF mkdir -p ~/.aws - printf "[default]\n region = us-east-1" >> ~/.aws/config + printf "[default]\n region = us-east-1" > ~/.aws/config # minio diff --git a/integration-tests/dynamic-frameworks-engine-yml.bats b/integration-tests/dynamic-frameworks-engine-yml.bats index 8370306e..7c00c19f 100644 --- a/integration-tests/dynamic-frameworks-engine-yml.bats +++ b/integration-tests/dynamic-frameworks-engine-yml.bats @@ -173,7 +173,7 @@ teardown() { rm -rf Carthage/Build run rome download --concurrently --skip-local-cache --cache-prefix travis - + [ "$status" -eq 0 ] # Version file diff --git a/integration-tests/dynamic-frameworks-ini.bats b/integration-tests/dynamic-frameworks-ini.bats index 1850170b..741ce780 100644 --- a/integration-tests/dynamic-frameworks-ini.bats +++ b/integration-tests/dynamic-frameworks-ini.bats @@ -29,9 +29,9 @@ setup() { cp ../_Cartfile.resolved_bkp Cartfile.resolved fi - printf "[Cache]\n S3-Bucket = rome\n local = rome-local-cache" >> Romefile + printf "[Cache]\n S3-Bucket = rome\n local = rome-local-cache" > Romefile mkdir -p ~/.aws - printf "[default]\n region = us-east-1" >> ~/.aws/config + printf "[default]\n region = us-east-1" > ~/.aws/config # minio diff --git a/integration-tests/dynamic-frameworks-yml.bats b/integration-tests/dynamic-frameworks-yml.bats index 1454cb63..8ab02c59 100644 --- a/integration-tests/dynamic-frameworks-yml.bats +++ b/integration-tests/dynamic-frameworks-yml.bats @@ -42,7 +42,7 @@ ignoreMap: platforms: [Mac] EOF mkdir -p ~/.aws - printf "[default]\n region = us-east-1" >> ~/.aws/config + printf "[default]\n region = us-east-1" > ~/.aws/config # minio @@ -238,7 +238,9 @@ teardown() { } @test "rome downloads all artifacts from the local cache (dynamic, yml)" { - + + skip + if [ -d "../_rome-local-cache_bkp" ]; then echo "# Rome local cache restored" >&3 cp -R ../_rome-local-cache_bkp/ rome-local-cache diff --git a/integration-tests/engine.sh b/integration-tests/engine.sh index 78b466d1..549ce5b4 100755 --- a/integration-tests/engine.sh +++ b/integration-tests/engine.sh @@ -9,6 +9,7 @@ STORAGE_DIR="server-cache" if [ "$ACTION" == "upload" ]; then LOCAL_PATH="$2" REMOTE_PATH="$3" + echo "🚂 Engine invocation: upload $LOCAL_PATH to $REMOTE_PATH" # create directory structure if it doesn't exist yet mkdir -p $STORAGE_DIR/$(dirname $REMOTE_PATH) # fake the upload of a file by just copying binary to the storage directory @@ -17,6 +18,7 @@ if [ "$ACTION" == "upload" ]; then elif [ "$ACTION" == "download" ]; then REMOTE_PATH="$2" OUTPUT_PATH="$3" + echo "🚂 Engine invocation: download $REMOTE_PATH to $OUTPUT_PATH" # create directory structure if it doesn't exist yet mkdir -p $(dirname $OUTPUT_PATH) # fake download by just copying binary from the storage directory @@ -27,7 +29,7 @@ elif [ "$ACTION" == "download" ]; then elif [ "$ACTION" == "list" ]; then REMOTE_PATH="$2" - + echo "🚂 Engine invocation: list $REMOTE_PATH" # verify that the list command contains the cache prefix if [[ ! "$REMOTE_PATH" =~ "travis" ]]; then exit 1 diff --git a/integration-tests/static-frameworks-ini.bats b/integration-tests/static-frameworks-ini.bats index 0097b977..114109cb 100644 --- a/integration-tests/static-frameworks-ini.bats +++ b/integration-tests/static-frameworks-ini.bats @@ -27,9 +27,9 @@ setup() { cp ../_Cartfile.resolved_bkp Cartfile.resolved fi - printf "[Cache]\n S3-Bucket = rome\n local = rome-local-cache\n[RepositoryMap]\n Staticfire = static/Alamofire" >> Romefile + printf "[Cache]\n S3-Bucket = rome\n local = rome-local-cache\n[RepositoryMap]\n Staticfire = static/Alamofire" > Romefile mkdir -p ~/.aws - printf "[default]\n region = us-east-1" >> ~/.aws/config + printf "[default]\n region = us-east-1" > ~/.aws/config # minio diff --git a/integration-tests/static-frameworks-yml.bats b/integration-tests/static-frameworks-yml.bats index e52d7949..57dbb8a4 100644 --- a/integration-tests/static-frameworks-yml.bats +++ b/integration-tests/static-frameworks-yml.bats @@ -50,7 +50,7 @@ ignoreMap: platforms: [iOS,Mac,tvOS,watchOS] EOF mkdir -p ~/.aws - printf "[default]\n region = us-east-1" >> ~/.aws/config + printf "[default]\n region = us-east-1" > ~/.aws/config # minio diff --git a/src/Caches/Local/Downloading.hs b/src/Caches/Local/Downloading.hs index fca187fa..dbc62f51 100644 --- a/src/Caches/Local/Downloading.hs +++ b/src/Caches/Local/Downloading.hs @@ -1,22 +1,33 @@ module Caches.Local.Downloading where -import Configuration (carthageBuildDirectory, - carthageArtifactsBuildDirectoryForPlatform) +import Configuration ( carthageBuildDirectory + , carthageArtifactsBuildDirectoryForPlatform + ) 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, (.|)) -import qualified Data.Conduit.Binary as C (sinkLbs, sourceFile) +import qualified Data.Conduit as C + ( runConduit + , (.|) + ) +import qualified Data.Conduit.Binary as C + ( sinkLbs + , sourceFile + ) import Data.Romefile +import Data.UUID as 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 Utils import Xcode.DWARF @@ -33,26 +44,13 @@ getFrameworkFromLocalCache -> ExceptT String m LBS.ByteString getFrameworkFromLocalCache lCacheDir (CachePrefix prefix) reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform = do - frameworkExistsInLocalCache <- - liftIO . doesFileExist $ frameworkLocalCachePath prefix + frameworkExistsInLocalCache <- liftIO . doesFileExist $ frameworkLocalCachePath prefix if frameworkExistsInLocalCache - then - liftIO - . runResourceT - . C.runConduit - $ C.sourceFile (frameworkLocalCachePath prefix) - C..| C.sinkLbs - else - throwError - $ "Error: could not find " - <> fwn - <> " in local cache at : " - <> frameworkLocalCachePath prefix + then liftIO . runResourceT . C.runConduit $ C.sourceFile (frameworkLocalCachePath prefix) C..| C.sinkLbs + else throwError $ "Error: could not find " <> fwn <> " in local cache at : " <> frameworkLocalCachePath prefix where - frameworkLocalCachePath cPrefix = - lCacheDir cPrefix remoteFrameworkUploadPath - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version + frameworkLocalCachePath cPrefix = lCacheDir cPrefix remoteFrameworkUploadPath + remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version @@ -63,27 +61,16 @@ getVersionFileFromLocalCache -> CachePrefix -- ^ A prefix for folders at top level in the cache. -> ProjectNameAndVersion -- ^ The `ProjectNameAndVersion` used to identify the .version file -> ExceptT String m LBS.ByteString -getVersionFileFromLocalCache lCacheDir (CachePrefix prefix) projectNameAndVersion - = do - versionFileExistsInLocalCache <- - liftIO . doesFileExist $ versionFileLocalCachePath - - if versionFileExistsInLocalCache - then - liftIO - . runResourceT - . C.runConduit - $ C.sourceFile versionFileLocalCachePath - C..| C.sinkLbs - else - throwError - $ "Error: could not find " - <> versionFileName - <> " in local cache at : " - <> versionFileLocalCachePath +getVersionFileFromLocalCache lCacheDir (CachePrefix prefix) projectNameAndVersion = do + versionFileExistsInLocalCache <- liftIO . doesFileExist $ versionFileLocalCachePath + + if versionFileExistsInLocalCache + then liftIO . runResourceT . C.runConduit $ C.sourceFile versionFileLocalCachePath C..| C.sinkLbs + else + throwError $ "Error: could not find " <> versionFileName <> " in local cache at : " <> versionFileLocalCachePath where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion - versionFileRemotePath = remoteVersionFilePath projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileRemotePath = remoteVersionFilePath projectNameAndVersion versionFileLocalCachePath = lCacheDir prefix versionFileRemotePath @@ -101,26 +88,14 @@ getBcsymbolmapFromLocalCache getBcsymbolmapFromLocalCache lCacheDir (CachePrefix prefix) reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform dwarfUUID = do let finalBcsymbolmapLocalPath = bcsymbolmapLocalCachePath prefix - bcSymbolmapExistsInLocalCache <- - liftIO . doesFileExist $ finalBcsymbolmapLocalPath + bcSymbolmapExistsInLocalCache <- liftIO . doesFileExist $ finalBcsymbolmapLocalPath if bcSymbolmapExistsInLocalCache - then - liftIO - . runResourceT - . C.runConduit - $ C.sourceFile finalBcsymbolmapLocalPath - C..| C.sinkLbs + then liftIO . runResourceT . C.runConduit $ C.sourceFile finalBcsymbolmapLocalPath C..| C.sinkLbs else - throwError - $ "Error: could not find " - <> bcsymbolmapName - <> " in local cache at : " - <> finalBcsymbolmapLocalPath + throwError $ "Error: could not find " <> bcsymbolmapName <> " in local cache at : " <> finalBcsymbolmapLocalPath where - remoteBcsymbolmapUploadPath = - remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version - bcsymbolmapLocalCachePath cPrefix = - lCacheDir cPrefix remoteBcsymbolmapUploadPath + remoteBcsymbolmapUploadPath = remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version + bcsymbolmapLocalCachePath cPrefix = lCacheDir cPrefix remoteBcsymbolmapUploadPath bcsymbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID @@ -139,18 +114,8 @@ getDSYMFromLocalCache lCacheDir (CachePrefix prefix) reverseRomeMap (FrameworkVe let finalDSYMLocalPath = dSYMLocalCachePath prefix dSYMExistsInLocalCache <- liftIO . doesFileExist $ finalDSYMLocalPath if dSYMExistsInLocalCache - then - liftIO - . runResourceT - . C.runConduit - $ C.sourceFile finalDSYMLocalPath - C..| C.sinkLbs - else - throwError - $ "Error: could not find " - <> dSYMName - <> " in local cache at : " - <> finalDSYMLocalPath + then liftIO . runResourceT . C.runConduit $ C.sourceFile finalDSYMLocalPath C..| C.sinkLbs + else throwError $ "Error: could not find " <> dSYMName <> " in local cache at : " <> finalDSYMLocalPath where dSYMLocalCachePath cPrefix = lCacheDir cPrefix remotedSYMUploadPath remotedSYMUploadPath = remoteDsymPath platform reverseRomeMap f version @@ -166,34 +131,22 @@ getAndUnzipBcsymbolmapFromLocalCache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to -> DwarfUUID - -> ExceptT String (ReaderT (CachePrefix, Bool) m) () + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) m) () getAndUnzipBcsymbolmapFromLocalCache lCacheDir reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform dwarfUUID = when (platform `elem` fwps) $ do - (cachePrefix@(CachePrefix prefix), verbose) <- ask + (cachePrefix@(CachePrefix prefix), verbose, _) <- ask let sayFunc = if verbose then sayLnWithTime else sayLn let symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID - binary <- getBcsymbolmapFromLocalCache lCacheDir - cachePrefix - reverseRomeMap - fVersion - platform - dwarfUUID - sayFunc - $ "Found " - <> symbolmapName - <> " in local cache at: " - <> frameworkLocalCachePath prefix + binary <- getBcsymbolmapFromLocalCache lCacheDir cachePrefix reverseRomeMap fVersion platform dwarfUUID + sayFunc $ "Found " <> symbolmapName <> " in local cache at: " <> frameworkLocalCachePath prefix deleteFile (bcsymbolmapPath dwarfUUID) verbose unzipBinary binary symbolmapName (bcsymbolmapZipName dwarfUUID) verbose where - frameworkLocalCachePath cPrefix = - lCacheDir cPrefix remoteFrameworkUploadPath - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version + frameworkLocalCachePath cPrefix = lCacheDir cPrefix remoteFrameworkUploadPath + remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version bcsymbolmapZipName d = bcsymbolmapArchiveName d version bcsymbolmapPath d = platformBuildDirectory bcsymbolmapNameFrom d - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f @@ -204,29 +157,22 @@ getAndUnzipBcsymbolmapsFromLocalCache -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the dSYM in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT String (ReaderT (CachePrefix, Bool) m) () + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) m) () getAndUnzipBcsymbolmapsFromLocalCache lCacheDir reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) _) platform = when (platform `elem` fwps) $ do - (_, verbose) <- ask + (_, verbose, _) <- ask let sayFunc = if verbose then sayLnWithTime else sayLn dwarfUUIDs <- dwarfUUIDsFrom (frameworkDirectory fwn) mapM_ (\dwarfUUID -> - getAndUnzipBcsymbolmapFromLocalCache lCacheDir - reverseRomeMap - fVersion - platform - dwarfUUID - `catchError` sayFunc + getAndUnzipBcsymbolmapFromLocalCache lCacheDir reverseRomeMap fVersion platform dwarfUUID `catchError` sayFunc ) dwarfUUIDs where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - frameworkDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + frameworkDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension @@ -237,35 +183,24 @@ getAndUnzipBcsymbolmapsFromLocalCache' -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the dSYM in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT - DWARFOperationError - (ReaderT (CachePrefix, Bool) m) - () + -> ExceptT DWARFOperationError (ReaderT (CachePrefix, Bool, UUID.UUID) m) () getAndUnzipBcsymbolmapsFromLocalCache' lCacheDir reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) _) platform = when (platform `elem` fwps) $ do - dwarfUUIDs <- withExceptT (const ErrorGettingDwarfUUIDs) - $ dwarfUUIDsFrom (frameworkDirectory fwn) + dwarfUUIDs <- withExceptT (const ErrorGettingDwarfUUIDs) $ dwarfUUIDsFrom (frameworkDirectory fwn) eitherDwarfUUIDsOrSucces <- forM dwarfUUIDs (\dwarfUUID -> lift $ runExceptT ( withExceptT (\e -> (dwarfUUID, e)) - $ getAndUnzipBcsymbolmapFromLocalCache lCacheDir - reverseRomeMap - fVersion - platform - dwarfUUID + $ getAndUnzipBcsymbolmapFromLocalCache lCacheDir reverseRomeMap fVersion platform dwarfUUID ) ) let failedUUIDsAndErrors = lefts eitherDwarfUUIDsOrSucces - unless (null failedUUIDsAndErrors) $ throwError $ FailedDwarfUUIDs - failedUUIDsAndErrors + unless (null failedUUIDsAndErrors) $ throwError $ FailedDwarfUUIDs failedUUIDsAndErrors where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - frameworkDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + frameworkDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension @@ -277,18 +212,15 @@ getAndUnzipFrameworksAndArtifactsFromLocalCache -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the Framework in the cache -> [FrameworkVersion] -- ^ The a list of `FrameworkVersion` identifying the Frameworks and dSYMs -> [TargetPlatform] -- ^ A list of `TargetPlatform`s to limit the operation to - -> [ExceptT String (ReaderT (CachePrefix, Bool) m) ()] -getAndUnzipFrameworksAndArtifactsFromLocalCache lCacheDir reverseRomeMap fvs platforms - = concatMap getAndUnzipFramework platforms + -> [ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) m) ()] +getAndUnzipFrameworksAndArtifactsFromLocalCache lCacheDir reverseRomeMap fvs platforms = + concatMap getAndUnzipFramework platforms <> concatMap getAndUnzipBcsymbolmaps platforms <> concatMap getAndUnzipDSYM platforms where - getAndUnzipFramework = - mapM (getAndUnzipFrameworkFromLocalCache lCacheDir reverseRomeMap) fvs - getAndUnzipBcsymbolmaps = - mapM (getAndUnzipBcsymbolmapsFromLocalCache lCacheDir reverseRomeMap) fvs - getAndUnzipDSYM = - mapM (getAndUnzipDSYMFromLocalCache lCacheDir reverseRomeMap) fvs + getAndUnzipFramework = mapM (getAndUnzipFrameworkFromLocalCache lCacheDir reverseRomeMap) fvs + getAndUnzipBcsymbolmaps = mapM (getAndUnzipBcsymbolmapsFromLocalCache lCacheDir reverseRomeMap) fvs + getAndUnzipDSYM = mapM (getAndUnzipDSYMFromLocalCache lCacheDir reverseRomeMap) fvs @@ -299,31 +231,21 @@ getAndUnzipFrameworkFromLocalCache -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the Framework in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT String (ReaderT (CachePrefix, Bool) m) () + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) m) () getAndUnzipFrameworkFromLocalCache lCacheDir reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do - (cachePrefix@(CachePrefix prefix), verbose) <- ask + (cachePrefix@(CachePrefix prefix), verbose, _) <- ask let sayFunc = if verbose then sayLnWithTime else sayLn - binary <- getFrameworkFromLocalCache lCacheDir - cachePrefix - reverseRomeMap - fVersion - platform - sayFunc - $ "Found " - <> fwn - <> " in local cache at: " - <> frameworkLocalCachePath prefix + binary <- getFrameworkFromLocalCache lCacheDir cachePrefix reverseRomeMap fVersion platform + sayFunc $ "Found " <> fwn <> " in local cache at: " <> frameworkLocalCachePath prefix deleteFrameworkDirectory fVersion platform verbose unzipBinary binary fwn frameworkZipName verbose <* ifExists frameworkExecutablePath (makeExecutable frameworkExecutablePath) where - frameworkLocalCachePath cPrefix = - lCacheDir cPrefix remoteFrameworkUploadPath - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version - frameworkZipName = frameworkArchiveName f version - frameworkExecutablePath = frameworkBuildBundleForPlatform platform f fwn + frameworkLocalCachePath cPrefix = lCacheDir cPrefix remoteFrameworkUploadPath + remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version + frameworkZipName = frameworkArchiveName f version + frameworkExecutablePath = frameworkBuildBundleForPlatform platform f fwn @@ -334,22 +256,14 @@ getAndUnzipDSYMFromLocalCache -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the dSYM in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT String (ReaderT (CachePrefix, Bool) m) () + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) m) () getAndUnzipDSYMFromLocalCache lCacheDir reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do - (cachePrefix@(CachePrefix prefix), verbose) <- ask + (cachePrefix@(CachePrefix prefix), verbose, _) <- ask let finalDSYMLocalPath = dSYMLocalCachePath prefix let sayFunc = if verbose then sayLnWithTime else sayLn - binary <- getDSYMFromLocalCache lCacheDir - cachePrefix - reverseRomeMap - fVersion - platform - sayFunc - $ "Found " - <> dSYMName - <> " in local cache at: " - <> finalDSYMLocalPath + binary <- getDSYMFromLocalCache lCacheDir cachePrefix reverseRomeMap fVersion platform + sayFunc $ "Found " <> dSYMName <> " in local cache at: " <> finalDSYMLocalPath deleteDSYMDirectory fVersion platform verbose unzipBinary binary fwn dSYMZipName verbose where @@ -365,9 +279,8 @@ getAndSaveVersionFilesFromLocalCache :: MonadIO m => FilePath -- ^ The cache definition. -> [ProjectNameAndVersion] -- ^ A list of `ProjectNameAndVersion` identifying the .version files - -> [ExceptT String (ReaderT (CachePrefix, Bool) m) ()] -getAndSaveVersionFilesFromLocalCache lCacheDir = - map (getAndSaveVersionFileFromLocalCache lCacheDir) + -> [ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) m) ()] +getAndSaveVersionFilesFromLocalCache lCacheDir = map (getAndSaveVersionFileFromLocalCache lCacheDir) @@ -376,27 +289,20 @@ getAndSaveVersionFileFromLocalCache :: MonadIO m => FilePath -- ^ The cache definition. -> ProjectNameAndVersion -- ^ The `ProjectNameAndVersion` identifying the .version file - -> ExceptT String (ReaderT (CachePrefix, Bool) m) () + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) m) () getAndSaveVersionFileFromLocalCache lCacheDir projectNameAndVersion = do - (cachePrefix@(CachePrefix prefix), verbose) <- ask + (cachePrefix@(CachePrefix prefix), verbose, _) <- ask let finalVersionFileLocalCachePath = versionFileLocalCachePath prefix let sayFunc = if verbose then sayLnWithTime else sayLn - versionFileBinary <- getVersionFileFromLocalCache lCacheDir - cachePrefix - projectNameAndVersion - sayFunc - $ "Found " - <> versionFileName - <> " in local cache at: " - <> finalVersionFileLocalCachePath + versionFileBinary <- getVersionFileFromLocalCache lCacheDir cachePrefix projectNameAndVersion + sayFunc $ "Found " <> versionFileName <> " in local cache at: " <> finalVersionFileLocalCachePath liftIO $ saveBinaryToFile versionFileBinary versionFileLocalPath sayFunc $ "Copied " <> versionFileName <> " to: " <> versionFileLocalPath where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileRemotePath = remoteVersionFilePath projectNameAndVersion - versionFileLocalPath = carthageBuildDirectory versionFileName - versionFileLocalCachePath cPrefix = - lCacheDir cPrefix versionFileRemotePath + versionFileLocalPath = carthageBuildDirectory versionFileName + versionFileLocalCachePath cPrefix = lCacheDir cPrefix versionFileRemotePath diff --git a/src/Caches/Local/Probing.hs b/src/Caches/Local/Probing.hs index 855ec7e2..fe128aa0 100644 --- a/src/Caches/Local/Probing.hs +++ b/src/Caches/Local/Probing.hs @@ -4,11 +4,11 @@ module Caches.Local.Probing where import Control.Monad.IO.Class import Data.Carthage.TargetPlatform -import Data.List (intersect) -import Data.Romefile (_frameworkPlatforms) +import Data.List ( intersect ) +import Data.Romefile ( _frameworkPlatforms ) import System.Directory -import System.FilePath (()) -import Types hiding (version) +import System.FilePath ( () ) +import Types hiding ( version ) import Utils -- | Probes a `FilePath` to check if each `FrameworkVersion` exists for each `TargetPlatform` @@ -20,12 +20,9 @@ probeLocalCacheForFrameworks -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` to probe for. -> [TargetPlatform] -- ^ A list target platforms restricting the scope of this action. -> m [FrameworkAvailability] -probeLocalCacheForFrameworks lCacheDir cachePrefix reverseRomeMap frameworkVersions - = sequence . probeForEachFramework +probeLocalCacheForFrameworks lCacheDir cachePrefix reverseRomeMap frameworkVersions = sequence . probeForEachFramework where - probeForEachFramework = mapM - (probeLocalCacheForFramework lCacheDir cachePrefix reverseRomeMap) - frameworkVersions + probeForEachFramework = mapM (probeLocalCacheForFramework lCacheDir cachePrefix reverseRomeMap) frameworkVersions @@ -38,15 +35,12 @@ probeLocalCacheForFramework -> FrameworkVersion -- ^ The `FrameworkVersion` to probe for. -> [TargetPlatform] -- ^ A list target platforms restricting the scope of this action. -> m FrameworkAvailability -probeLocalCacheForFramework lCacheDir cachePrefix reverseRomeMap frameworkVersion platforms - = fmap (FrameworkAvailability frameworkVersion) probeForEachPlatform +probeLocalCacheForFramework lCacheDir cachePrefix reverseRomeMap frameworkVersion platforms = fmap + (FrameworkAvailability frameworkVersion) + probeForEachPlatform where probeForEachPlatform = mapM - (probeLocalCacheForFrameworkOnPlatform lCacheDir - cachePrefix - reverseRomeMap - frameworkVersion - ) + (probeLocalCacheForFrameworkOnPlatform lCacheDir cachePrefix reverseRomeMap frameworkVersion) (platforms `intersect` (_frameworkPlatforms . _framework $ frameworkVersion)) @@ -62,13 +56,8 @@ probeLocalCacheForFrameworkOnPlatform -> m PlatformAvailability probeLocalCacheForFrameworkOnPlatform lCacheDir (CachePrefix prefix) reverseRomeMap (FrameworkVersion fwn version) platform = do - frameworkExistsInLocalCache <- - liftIO . doesFileExist $ frameworkLocalCachePath + frameworkExistsInLocalCache <- liftIO . doesFileExist $ frameworkLocalCachePath return (PlatformAvailability platform frameworkExistsInLocalCache) where - frameworkLocalCachePath = lCacheDir prefix remoteFrameworkUploadPath - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap fwn version - - - + frameworkLocalCachePath = lCacheDir prefix remoteFrameworkUploadPath + remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap fwn version diff --git a/src/Caches/Local/Uploading.hs b/src/Caches/Local/Uploading.hs index 9cb55fa4..4915ac9f 100644 --- a/src/Caches/Local/Uploading.hs +++ b/src/Caches/Local/Uploading.hs @@ -2,19 +2,23 @@ module Caches.Local.Uploading where -import qualified Codec.Archive.Zip as Zip +import qualified Codec.Archive.Zip as Zip import Configuration -import Control.Monad (unless, when) +import Control.Monad ( unless + , when + ) import Control.Monad.IO.Class -import Control.Monad.Reader (ReaderT, ask) -import qualified Data.ByteString.Lazy as LBS +import Control.Monad.Reader ( ReaderT + , ask + ) +import qualified Data.ByteString.Lazy as LBS import Data.Carthage.TargetPlatform -import Data.Monoid ((<>)) -import Data.Romefile (Framework (..)) +import Data.Monoid ( (<>) ) +import Data.Romefile ( Framework(..) ) import System.Directory -import System.FilePath (()) -import Types hiding (version) -import Types.Commands (SkipLocalCacheFlag (..)) +import System.FilePath ( () ) +import Types hiding ( version ) +import Types.Commands ( SkipLocalCacheFlag(..) ) import Utils import Xcode.DWARF @@ -31,15 +35,13 @@ saveFrameworkToLocalCache saveFrameworkToLocalCache lCacheDir frameworkArchive reverseRomeMap (FrameworkVersion f@(Framework _ _ fwps) version) platform = when (platform `elem` fwps) $ do (CachePrefix prefix, SkipLocalCacheFlag skipLocalCache, verbose) <- ask - unless skipLocalCache $ saveBinaryToLocalCache - lCacheDir - (Zip.fromArchive frameworkArchive) - (prefix remoteFrameworkUploadPath) - frameworkNameWithFrameworkExtension - verbose + unless skipLocalCache $ saveBinaryToLocalCache lCacheDir + (Zip.fromArchive frameworkArchive) + (prefix remoteFrameworkUploadPath) + frameworkNameWithFrameworkExtension + verbose where - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version + remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f @@ -55,12 +57,11 @@ saveDsymToLocalCache saveDsymToLocalCache lCacheDir dSYMArchive reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do (CachePrefix prefix, SkipLocalCacheFlag skipLocalCache, verbose) <- ask - unless skipLocalCache $ saveBinaryToLocalCache - lCacheDir - (Zip.fromArchive dSYMArchive) - (prefix remoteDsymUploadPath) - (fwn <> ".dSYM") - verbose + unless skipLocalCache $ saveBinaryToLocalCache lCacheDir + (Zip.fromArchive dSYMArchive) + (prefix remoteDsymUploadPath) + (fwn <> ".dSYM") + verbose where remoteDsymUploadPath = remoteDsymPath platform reverseRomeMap f version @@ -77,15 +78,12 @@ saveBcsymbolmapToLocalCache saveBcsymbolmapToLocalCache lCacheDir dwarfUUID dwarfArchive reverseRomeMap (FrameworkVersion f@(Framework _ _ fwps) version) platform = when (platform `elem` fwps) $ do (CachePrefix prefix, SkipLocalCacheFlag skipLocalCache, verbose) <- ask - unless skipLocalCache $ saveBinaryToLocalCache - lCacheDir - (Zip.fromArchive dwarfArchive) - (prefix remoteBcSymbolmapUploadPath) - (bcsymbolmapNameFrom dwarfUUID) - verbose - where - remoteBcSymbolmapUploadPath = - remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version + unless skipLocalCache $ saveBinaryToLocalCache lCacheDir + (Zip.fromArchive dwarfArchive) + (prefix remoteBcSymbolmapUploadPath) + (bcsymbolmapNameFrom dwarfUUID) + verbose + where remoteBcSymbolmapUploadPath = remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version @@ -98,17 +96,11 @@ saveBinaryToLocalCache -> String -- ^ A colloquial name for the artifact printed when verbose is `True`. -> Bool -- ^ A verbosity flag. -> m () -saveBinaryToLocalCache cachePath binaryZip destinationPath objectName verbose = - do - let sayFunc = if verbose then sayLnWithTime else sayLn - when verbose - $ sayLnWithTime - $ "Copying " - <> objectName - <> " to: " - <> finalPath - liftIO $ saveBinaryToFile binaryZip finalPath - sayFunc $ "Copied " <> objectName <> " to: " <> finalPath +saveBinaryToLocalCache cachePath binaryZip destinationPath objectName verbose = do + let sayFunc = if verbose then sayLnWithTime else sayLn + when verbose $ sayLnWithTime $ "Copying " <> objectName <> " to: " <> finalPath + liftIO $ saveBinaryToFile binaryZip finalPath + sayFunc $ "Copied " <> objectName <> " to: " <> finalPath where finalPath = cachePath destinationPath @@ -118,8 +110,7 @@ saveVersionFilesToLocalCache :: FilePath -- ^ The cache definition. -> [ProjectNameAndVersion] -- ^ The information used to derive the name and path for the .version file. -> ReaderT (CachePrefix, Bool) IO () -saveVersionFilesToLocalCache lCacheDir = - mapM_ (saveVersonFileToLocalCache lCacheDir) +saveVersionFilesToLocalCache lCacheDir = mapM_ (saveVersonFileToLocalCache lCacheDir) @@ -134,13 +125,9 @@ saveVersonFileToLocalCache lCacheDir projectNameAndVersion = do when versionFileExists $ do versionFileContent <- liftIO $ LBS.readFile versionFileLocalPath - saveVersionFileBinaryToLocalCache lCacheDir - cachePrefix - versionFileContent - projectNameAndVersion - verbose + saveVersionFileBinaryToLocalCache lCacheDir cachePrefix versionFileContent projectNameAndVersion verbose where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileLocalPath = carthageBuildDirectory versionFileName @@ -154,11 +141,8 @@ saveVersionFileBinaryToLocalCache -> ProjectNameAndVersion -- ^ The information used to derive the name and path for the .version file. -> Bool -- ^ A flag controlling verbosity. -> m () -saveVersionFileBinaryToLocalCache lCacheDir (CachePrefix prefix) versionFileContent projectNameAndVersion - = saveBinaryToLocalCache lCacheDir - versionFileContent - (prefix versionFileRemotePath) - versionFileName +saveVersionFileBinaryToLocalCache lCacheDir (CachePrefix prefix) versionFileContent projectNameAndVersion = + saveBinaryToLocalCache lCacheDir versionFileContent (prefix versionFileRemotePath) versionFileName where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileRemotePath = remoteVersionFilePath projectNameAndVersion diff --git a/src/Caches/S3/Downloading.hs b/src/Caches/S3/Downloading.hs index bd4f1024..3eb3feae 100644 --- a/src/Caches/S3/Downloading.hs +++ b/src/Caches/S3/Downloading.hs @@ -1,28 +1,36 @@ 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 ) +import Control.Lens ( view ) import Control.Monad import Control.Monad.Except -import Control.Monad.Reader (ReaderT, ask, runReaderT, - withReaderT) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS +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, - (.|)) -import qualified Data.Conduit.Binary as C (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 qualified Data.Conduit as C + ( 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(..) ) +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 Utils import Xcode.DWARF @@ -34,20 +42,12 @@ getFrameworkFromS3 -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the Framework in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT - String - (ReaderT (AWS.Env, CachePrefix, Bool) IO) - LBS.ByteString -getFrameworkFromS3 s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform - = do - (env, CachePrefix prefix, verbose) <- ask - mapExceptT - (withReaderT (const (env, verbose))) - (getArtifactFromS3 s3BucketName (prefix remoteFrameworkUploadPath) fwn - ) - where - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version + -> ExceptT String (ReaderT (AWS.Env, CachePrefix, Bool) IO) LBS.ByteString +getFrameworkFromS3 s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform = do + (env, CachePrefix prefix, verbose) <- ask + mapExceptT (withReaderT (const (env, verbose))) + (getArtifactFromS3 s3BucketName (prefix remoteFrameworkUploadPath) fwn) + where remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version @@ -57,16 +57,11 @@ getDSYMFromS3 -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the dSYM in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the dSYM -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT - String - (ReaderT (AWS.Env, CachePrefix, Bool) IO) - LBS.ByteString -getDSYMFromS3 s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform - = do - (env, CachePrefix prefix, verbose) <- ask - let finalRemoteDSYMUploadPath = prefix remoteDSYMUploadPath - mapExceptT (withReaderT (const (env, verbose))) - $ getArtifactFromS3 s3BucketName finalRemoteDSYMUploadPath dSYMName + -> ExceptT String (ReaderT (AWS.Env, CachePrefix, Bool) IO) LBS.ByteString +getDSYMFromS3 s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform = do + (env, CachePrefix prefix, verbose) <- ask + let finalRemoteDSYMUploadPath = prefix remoteDSYMUploadPath + mapExceptT (withReaderT (const (env, verbose))) $ getArtifactFromS3 s3BucketName finalRemoteDSYMUploadPath dSYMName where remoteDSYMUploadPath = remoteDsymPath platform reverseRomeMap f version dSYMName = fwn <> ".dSYM" @@ -75,21 +70,14 @@ getDSYMFromS3 s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ _ -- | Retrieves a .version file from S3 getVersionFileFromS3 - :: S3.BucketName - -> ProjectNameAndVersion - -> ExceptT - String - (ReaderT (AWS.Env, CachePrefix, Bool) IO) - LBS.ByteString + :: S3.BucketName -> ProjectNameAndVersion -> ExceptT String (ReaderT (AWS.Env, CachePrefix, Bool) IO) LBS.ByteString getVersionFileFromS3 s3BucketName projectNameAndVersion = do (env, CachePrefix prefix, verbose) <- ask let finalVersionFileRemotePath = prefix versionFileRemotePath - mapExceptT (withReaderT (const (env, verbose))) $ getArtifactFromS3 - s3BucketName - finalVersionFileRemotePath - versionFileName + mapExceptT (withReaderT (const (env, verbose))) + $ getArtifactFromS3 s3BucketName finalVersionFileRemotePath versionFileName where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileRemotePath = remoteVersionFilePath projectNameAndVersion @@ -101,22 +89,16 @@ getBcsymbolmapFromS3 -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the dSYM -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to -> DwarfUUID -- ^ The UUID of the bcsymbolmap - -> ExceptT - String - (ReaderT (AWS.Env, CachePrefix, Bool) IO) - LBS.ByteString -getBcsymbolmapFromS3 s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform dwarfUUID - = do + -> ExceptT String (ReaderT (AWS.Env, CachePrefix, Bool) IO) LBS.ByteString +getBcsymbolmapFromS3 s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform dwarfUUID = + do (env, CachePrefix prefix, verbose) <- ask let finalRemoteBcsymbolmaploadPath = prefix remoteBcSymbolmapUploadPath - mapExceptT (withReaderT (const (env, verbose))) $ getArtifactFromS3 - s3BucketName - finalRemoteBcsymbolmaploadPath - symbolmapName + mapExceptT (withReaderT (const (env, verbose))) + $ getArtifactFromS3 s3BucketName finalRemoteBcsymbolmaploadPath symbolmapName where - remoteBcSymbolmapUploadPath = - remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version - symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID + remoteBcSymbolmapUploadPath = remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version + symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID @@ -130,15 +112,10 @@ getAndUnzipFrameworkFromS3 getAndUnzipFrameworkFromS3 s3BucketName reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do (_, _, verbose) <- ask - frameworkBinary <- getFrameworkFromS3 s3BucketName - reverseRomeMap - fVersion - platform + frameworkBinary <- getFrameworkFromS3 s3BucketName reverseRomeMap fVersion platform deleteFrameworkDirectory fVersion platform verbose unzipBinary frameworkBinary fwn frameworkZipName verbose - <* ifExists - frameworkExecutablePath - (makeExecutable frameworkExecutablePath) + <* ifExists frameworkExecutablePath (makeExecutable frameworkExecutablePath) where frameworkZipName = frameworkArchiveName f version frameworkExecutablePath = frameworkBuildBundleForPlatform platform f fwn @@ -155,7 +132,7 @@ getAndUnzipDSYMFromS3 getAndUnzipDSYMFromS3 s3BucketName reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do (_, _, verbose) <- ask - dSYMBinary <- getDSYMFromS3 s3BucketName reverseRomeMap fVersion platform + dSYMBinary <- getDSYMFromS3 s3BucketName reverseRomeMap fVersion platform deleteDSYMDirectory fVersion platform verbose unzipBinary dSYMBinary fwn dSYMZipName verbose where dSYMZipName = dSYMArchiveName f version @@ -174,16 +151,11 @@ getAndUnzipBcsymbolmapFromS3 s3BucketName reverseRomeMap fVersion@(FrameworkVers = when (platform `elem` fwps) $ do (_, _, verbose) <- ask let symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID - binary <- getBcsymbolmapFromS3 s3BucketName - reverseRomeMap - fVersion - platform - dwarfUUID + binary <- getBcsymbolmapFromS3 s3BucketName reverseRomeMap fVersion platform dwarfUUID deleteFile (bcsymbolmapPath dwarfUUID) verbose unzipBinary binary symbolmapName (bcsymbolmapZipName dwarfUUID) verbose where - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f bcsymbolmapZipName d = bcsymbolmapArchiveName d version bcsymbolmapPath d = platformBuildDirectory bcsymbolmapNameFrom d @@ -195,36 +167,25 @@ getAndUnzipBcsymbolmapsFromS3' -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the dSYM in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT - DWARFOperationError - (ReaderT (AWS.Env, CachePrefix, Bool) IO) - () + -> ExceptT DWARFOperationError (ReaderT (AWS.Env, CachePrefix, Bool) IO) () getAndUnzipBcsymbolmapsFromS3' lCacheDir reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) _) platform = when (platform `elem` fwps) $ do - dwarfUUIDs <- withExceptT (const ErrorGettingDwarfUUIDs) - $ dwarfUUIDsFrom (frameworkDirectory fwn) + dwarfUUIDs <- withExceptT (const ErrorGettingDwarfUUIDs) $ dwarfUUIDsFrom (frameworkDirectory fwn) eitherDwarfUUIDsOrSucces <- forM dwarfUUIDs (\dwarfUUID -> lift $ runExceptT - (withExceptT (\e -> (dwarfUUID, e)) $ getAndUnzipBcsymbolmapFromS3 - lCacheDir - reverseRomeMap - fVersion - platform - dwarfUUID + ( withExceptT (\e -> (dwarfUUID, e)) + $ getAndUnzipBcsymbolmapFromS3 lCacheDir reverseRomeMap fVersion platform dwarfUUID ) ) let failedUUIDsAndErrors = lefts eitherDwarfUUIDsOrSucces - unless (null failedUUIDsAndErrors) $ throwError $ FailedDwarfUUIDs - failedUUIDsAndErrors + unless (null failedUUIDsAndErrors) $ throwError $ FailedDwarfUUIDs failedUUIDsAndErrors where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - frameworkDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + frameworkDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension @@ -235,51 +196,31 @@ getArtifactFromS3 -> String -- ^ A colloquial name for the artifact -> ExceptT String (ReaderT (AWS.Env, Bool) IO) LBS.ByteString getArtifactFromS3 s3BucketName remotePath artifactName = do - readerEnv@(_, verbose) <- ask - eitherArtifact <- liftIO $ try $ runReaderT - (downloadBinary s3BucketName remotePath artifactName) - readerEnv + readerEnv@(_, verbose) <- ask + eitherArtifact <- liftIO $ try $ runReaderT (downloadBinary s3BucketName remotePath artifactName) readerEnv case eitherArtifact of - Left e -> - throwError - $ "Error: could not download " - <> artifactName - <> " : " - <> awsErrorToString e verbose + Left e -> throwError $ "Error: could not download " <> artifactName <> " : " <> awsErrorToString e verbose Right artifactBinary -> return artifactBinary -- | Downloads an artifact stored at a given path from an `S3.BucketName`. -downloadBinary - :: S3.BucketName - -> FilePath - -> FilePath - -> ReaderT (AWS.Env, Bool) IO LBS.ByteString +downloadBinary :: S3.BucketName -> FilePath -> FilePath -> ReaderT (AWS.Env, Bool) IO LBS.ByteString downloadBinary s3BucketName objectRemotePath objectName = do (env, verbose) <- ask AWS.runResourceT . AWS.runAWS env $ do let sayFunc = if verbose then sayLnWithTime else sayLn - when verbose - $ sayFunc - $ "Started downloading " - <> objectName - <> " from: " - <> objectRemotePath + when verbose $ sayFunc $ "Started downloading " <> objectName <> " from: " <> objectRemotePath rs <- AWS.send $ S3.getObject s3BucketName objectKey - let contentLength = - fromIntegral $ fromMaybe 0 $ view S3.gorsContentLength rs + let contentLength = fromIntegral $ fromMaybe 0 $ view S3.gorsContentLength rs binary <- view S3.gorsBody rs `AWS.sinkBody` sink verbose contentLength sayFunc $ "Downloaded " <> objectName <> " from: " <> objectRemotePath return binary where objectKey = S3.ObjectKey . T.pack $ objectRemotePath - sink verbose totalLength = if verbose - then printProgress objectName totalLength C..| C.sinkLbs - else C.sinkLbs + sink verbose totalLength = if verbose then printProgress objectName totalLength C..| C.sinkLbs else C.sinkLbs - printProgress - :: MonadIO m => String -> Int -> C.ConduitT BS.ByteString BS.ByteString m () + printProgress :: MonadIO m => String -> Int -> C.ConduitT BS.ByteString BS.ByteString m () printProgress objName totalLength = loop totalLength 0 0 where loop t consumedLen lastLen = C.await >>= maybe diff --git a/src/Caches/S3/Probing.hs b/src/Caches/S3/Probing.hs index dd0f8739..6233fe0f 100644 --- a/src/Caches/S3/Probing.hs +++ b/src/Caches/S3/Probing.hs @@ -1,14 +1,16 @@ module Caches.S3.Probing where -import Control.Concurrent.Async.Lifted.Safe (mapConcurrently) -import Control.Monad.Reader (ReaderT, ask) +import Control.Concurrent.Async.Lifted.Safe ( mapConcurrently ) +import Control.Monad.Reader ( ReaderT + , ask + ) import Data.Carthage.TargetPlatform -import Data.List (intersect) -import Data.Romefile (_frameworkPlatforms) -import qualified Data.Text as T -import qualified Network.AWS as AWS -import qualified Network.AWS.S3 as S3 -import System.FilePath (()) +import Data.List ( intersect ) +import Data.Romefile ( _frameworkPlatforms ) +import qualified Data.Text as T +import qualified Network.AWS as AWS +import qualified Network.AWS.S3 as S3 +import System.FilePath ( () ) import Types import Utils @@ -22,11 +24,8 @@ probeS3ForFrameworks -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` to probe for. -> [TargetPlatform] -- ^ A list target platforms restricting the scope of this action. -> ReaderT (AWS.Env, CachePrefix, Bool) IO [FrameworkAvailability] -probeS3ForFrameworks s3BucketName reverseRomeMap frameworkVersions platforms = - mapConcurrently probe frameworkVersions - where - probe fVersions = - probeS3ForFramework s3BucketName reverseRomeMap fVersions platforms +probeS3ForFrameworks s3BucketName reverseRomeMap frameworkVersions platforms = mapConcurrently probe frameworkVersions + where probe fVersions = probeS3ForFramework s3BucketName reverseRomeMap fVersions platforms @@ -37,8 +36,9 @@ probeS3ForFramework -> FrameworkVersion -- ^ The `FrameworkVersion` to probe for. -> [TargetPlatform] -- ^ A list target platforms restricting the scope of this action. -> ReaderT (AWS.Env, CachePrefix, Bool) IO FrameworkAvailability -probeS3ForFramework s3BucketName reverseRomeMap frameworkVersion platforms = - fmap (FrameworkAvailability frameworkVersion) probeForEachPlatform +probeS3ForFramework s3BucketName reverseRomeMap frameworkVersion platforms = fmap + (FrameworkAvailability frameworkVersion) + probeForEachPlatform where probeForEachPlatform = mapConcurrently (probeS3ForFrameworkOnPlatform s3BucketName reverseRomeMap frameworkVersion) @@ -53,20 +53,15 @@ probeS3ForFrameworkOnPlatform -> FrameworkVersion -- ^ The `FrameworkVersion` to probe for. -> TargetPlatform -- ^ A target platforms restricting the scope of this action. -> ReaderT (AWS.Env, CachePrefix, Bool) IO PlatformAvailability -probeS3ForFrameworkOnPlatform s3BucketName reverseRomeMap (FrameworkVersion fwn v) platform - = do - (env, CachePrefix prefixStr, _) <- ask - let isAvailable = - AWS.runResourceT . AWS.runAWS env $ checkIfFrameworkExistsInBucket - s3BucketName - (frameworkObjectKeyWithPrefix prefixStr) - PlatformAvailability platform <$> isAvailable +probeS3ForFrameworkOnPlatform s3BucketName reverseRomeMap (FrameworkVersion fwn v) platform = do + (env, CachePrefix prefixStr, _) <- ask + let isAvailable = AWS.runResourceT . AWS.runAWS env $ checkIfFrameworkExistsInBucket + s3BucketName + (frameworkObjectKeyWithPrefix prefixStr) + PlatformAvailability platform <$> isAvailable where frameworkObjectKeyWithPrefix cPrefix = - S3.ObjectKey - . T.pack - $ cPrefix - remoteFrameworkPath platform reverseRomeMap fwn v + S3.ObjectKey . T.pack $ cPrefix remoteFrameworkPath platform reverseRomeMap fwn v @@ -77,8 +72,7 @@ checkIfFrameworkExistsInBucket -> S3.ObjectKey -- ^ The `S3.ObjectKey` to look for. -> m Bool checkIfFrameworkExistsInBucket s3BucketName frameworkObjectKey = do - rs <- AWS.trying AWS._Error - (AWS.send $ S3.headObject s3BucketName frameworkObjectKey) + rs <- AWS.trying AWS._Error (AWS.send $ S3.headObject s3BucketName frameworkObjectKey) case rs of Left _ -> return False Right _ -> return True diff --git a/src/Caches/S3/Uploading.hs b/src/Caches/S3/Uploading.hs index d310c01a..1394c665 100644 --- a/src/Caches/S3/Uploading.hs +++ b/src/Caches/S3/Uploading.hs @@ -1,17 +1,20 @@ module Caches.S3.Uploading where -import qualified Codec.Archive.Zip as Zip -import Control.Monad (when) -import Control.Monad.Reader (ReaderT, ask, withReaderT) -import qualified Data.ByteString.Lazy as LBS +import qualified Codec.Archive.Zip as Zip +import Control.Monad ( when ) +import Control.Monad.Reader ( ReaderT + , ask + , withReaderT + ) +import qualified Data.ByteString.Lazy as LBS import Data.Carthage.TargetPlatform -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 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 Utils import Xcode.DWARF @@ -28,14 +31,9 @@ uploadFrameworkToS3 uploadFrameworkToS3 frameworkArchive s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do (env, CachePrefix prefix, verbose) <- ask - withReaderT (const (env, verbose)) $ uploadBinary - s3BucketName - (Zip.fromArchive frameworkArchive) - (prefix remoteFrameworkUploadPath) - fwn - where - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version + withReaderT (const (env, verbose)) + $ uploadBinary s3BucketName (Zip.fromArchive frameworkArchive) (prefix remoteFrameworkUploadPath) fwn + where remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version @@ -47,14 +45,11 @@ uploadDsymToS3 -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework and the dSYM. -> TargetPlatform -- ^ A `TargetPlatform` restricting the scope of this action. -> ReaderT UploadDownloadEnv IO () -uploadDsymToS3 dSYMArchive s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform - = when (platform `elem` fwps) $ do +uploadDsymToS3 dSYMArchive s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform = + when (platform `elem` fwps) $ do (env, CachePrefix prefix, verbose) <- ask - withReaderT (const (env, verbose)) $ uploadBinary - s3BucketName - (Zip.fromArchive dSYMArchive) - (prefix remoteDsymUploadPath) - (fwn <> ".dSYM") + withReaderT (const (env, verbose)) + $ uploadBinary s3BucketName (Zip.fromArchive dSYMArchive) (prefix remoteDsymUploadPath) (fwn <> ".dSYM") where remoteDsymUploadPath = remoteDsymPath platform reverseRomeMap f version @@ -71,14 +66,11 @@ uploadBcsymbolmapToS3 uploadBcsymbolmapToS3 dwarfUUID dwarfArchive s3BucketName reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do (env, CachePrefix prefix, verbose) <- ask - withReaderT (const (env, verbose)) $ uploadBinary - s3BucketName - (Zip.fromArchive dwarfArchive) - (prefix remoteBcsymbolmapUploadPath) - (fwn <> "." <> bcsymbolmapNameFrom dwarfUUID) - where - remoteBcsymbolmapUploadPath = - remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version + withReaderT (const (env, verbose)) $ uploadBinary s3BucketName + (Zip.fromArchive dwarfArchive) + (prefix remoteBcsymbolmapUploadPath) + (fwn <> "." <> bcsymbolmapNameFrom dwarfUUID) + where remoteBcsymbolmapUploadPath = remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version @@ -88,46 +80,28 @@ uploadVersionFileToS3 -> LBS.ByteString -- ^ The contents of the .version file. -> ProjectNameAndVersion -- ^ The information used to derive the name and path for the .version file. -> ReaderT (AWS.Env, CachePrefix, Bool) IO () -uploadVersionFileToS3 s3BucketName versionFileContent projectNameAndVersion = - do - (env, CachePrefix prefix, verbose) <- ask - withReaderT (const (env, verbose)) $ uploadBinary - s3BucketName - versionFileContent - (prefix versionFileRemotePath) - versionFileName +uploadVersionFileToS3 s3BucketName versionFileContent projectNameAndVersion = do + (env, CachePrefix prefix, verbose) <- ask + withReaderT (const (env, verbose)) + $ uploadBinary s3BucketName versionFileContent (prefix versionFileRemotePath) versionFileName where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileRemotePath = remoteVersionFilePath projectNameAndVersion -- | Uploads an artifact to an `S3.BucketName` at a given path in the bucket. -uploadBinary - :: AWS.ToBody a - => S3.BucketName - -> a - -> FilePath - -> FilePath - -> ReaderT (AWS.Env, Bool) IO () +uploadBinary :: AWS.ToBody a => S3.BucketName -> a -> FilePath -> FilePath -> ReaderT (AWS.Env, Bool) IO () uploadBinary s3BucketName binaryZip destinationPath objectName = do (env, verbose) <- ask let objectKey = S3.ObjectKey $ T.pack destinationPath AWS.runResourceT . AWS.runAWS env $ do let body = AWS.toBody binaryZip let sayFunc = if verbose then sayLnWithTime else sayLn - when verbose - $ sayFunc - $ "Started uploading " - <> objectName - <> " to: " - <> destinationPath - rs <- AWS.trying AWS._Error - (AWS.send $ S3.putObject s3BucketName objectKey body) + when verbose $ sayFunc $ "Started uploading " <> objectName <> " to: " <> destinationPath + rs <- AWS.trying AWS._Error (AWS.send $ S3.putObject s3BucketName objectKey body) case rs of - Left e -> - sayFunc $ "Error uploading " <> objectName <> ": " <> awsErrorToString e verbose - Right _ -> - sayFunc $ "Uploaded " <> objectName <> " to: " <> destinationPath + Left e -> sayFunc $ "Error uploading " <> objectName <> ": " <> awsErrorToString e verbose + Right _ -> sayFunc $ "Uploaded " <> objectName <> " to: " <> destinationPath diff --git a/src/CommandParsers.hs b/src/CommandParsers.hs index 1ddd3d9d..3a9dcd24 100644 --- a/src/CommandParsers.hs +++ b/src/CommandParsers.hs @@ -3,14 +3,14 @@ module CommandParsers where import Data.Carthage.TargetPlatform -import Data.Char (isLetter) -import Data.Either.Utils (maybeToEither) -import Data.List (nub) -import Data.List.Split (wordsBy) -import Data.Monoid ((<>)) +import Data.Char ( isLetter ) +import Data.Either.Utils ( maybeToEither ) +import Data.List ( nub ) +import Data.List.Split ( wordsBy ) +import Data.Monoid ( (<>) ) import Data.Romefile -import Options.Applicative as Opts -import Text.Read (readMaybe) +import Options.Applicative as Opts +import Text.Read ( readMaybe ) import Types.Commands @@ -30,30 +30,23 @@ cachePrefixParser = Opts.strOption ) skipLocalCacheParser :: Opts.Parser SkipLocalCacheFlag -skipLocalCacheParser = SkipLocalCacheFlag <$> Opts.switch - ( Opts.long "skip-local-cache" - <> Opts.help "Ignore the local cache when performing the operation." - ) +skipLocalCacheParser = SkipLocalCacheFlag + <$> Opts.switch (Opts.long "skip-local-cache" <> Opts.help "Ignore the local cache when performing the operation.") noIgnoreParser :: Opts.Parser NoIgnoreFlag noIgnoreParser = NoIgnoreFlag <$> Opts.switch - ( Opts.long "no-ignore" - <> Opts.help - "Ignore the `ignoreMap` section in the Romefile when performing the operation." - ) + (Opts.long "no-ignore" <> Opts.help "Ignore the `ignoreMap` section in the Romefile when performing the operation.") noSkipCurrentParser :: Opts.Parser NoSkipCurrentFlag noSkipCurrentParser = NoSkipCurrentFlag <$> Opts.switch ( Opts.long "no-skip-current" - <> Opts.help - "Do not skip the `currentMap` section in the Romefile when performing the operation." + <> Opts.help "Do not skip the `currentMap` section in the Romefile when performing the operation." ) concurrentlyParser :: Opts.Parser ConcurrentlyFlag concurrentlyParser = ConcurrentlyFlag <$> Opts.switch ( Opts.long "concurrently" - <> Opts.help - "Maximise concurrency while performing the operation. Might make verbose output hard to follow." + <> Opts.help "Maximise concurrency while performing the operation. Might make verbose output hard to follow." ) reposParser :: Opts.Parser [ProjectName] @@ -61,14 +54,13 @@ reposParser = Opts.many (Opts.argument (ProjectName <$> str) ( Opts.metavar "FRAMEWORKS..." - <> Opts.help - "Zero or more framework names. If zero, all frameworks and dSYMs are uploaded." + <> Opts.help "Zero or more framework names. If zero, all frameworks and dSYMs are uploaded." ) ) platformsParser :: Opts.Parser [TargetPlatform] -platformsParser - = (nub . concat <$> Opts.some +platformsParser = + (nub . concat <$> Opts.some (Opts.option (eitherReader platformListOrError) ( Opts.metavar "PLATFORMS" @@ -80,10 +72,8 @@ platformsParser ) <|> pure allTargetPlatforms where - platformOrError s = - maybeToEither ("Unrecognized platform '" ++ s ++ "'") (readMaybe s) - splitPlatforms s = - filter (not . null) $ filter isLetter <$> wordsBy (not . isLetter) s + platformOrError s = maybeToEither ("Unrecognized platform '" ++ s ++ "'") (readMaybe s) + splitPlatforms s = filter (not . null) $ filter isLetter <$> wordsBy (not . isLetter) s platformListOrError s = mapM platformOrError $ splitPlatforms s udcPayloadParser :: Opts.Parser RomeUDCPayload @@ -105,31 +95,16 @@ downloadParser = pure Download <*> udcPayloadParser listModeParser :: Opts.Parser ListMode listModeParser = - ( Opts.flag' - Missing - ( Opts.long "missing" - <> Opts.help "List frameworks missing from the cache. Ignores dSYMs" - ) - <|> Opts.flag' - Present - (Opts.long "present" <> Opts.help - "List frameworks present in the cache. Ignores dSYMs." - ) + ( Opts.flag' Missing (Opts.long "missing" <> Opts.help "List frameworks missing from the cache. Ignores dSYMs") + <|> Opts.flag' Present (Opts.long "present" <> Opts.help "List frameworks present in the cache. Ignores dSYMs.") ) - <|> Opts.flag - All - All - (Opts.help - "Reports missing or present status of frameworks in the cache. Ignores dSYMs." - ) + <|> Opts.flag All All (Opts.help "Reports missing or present status of frameworks in the cache. Ignores dSYMs.") printFormatParser :: Opts.Parser PrintFormat printFormatParser = Opts.option Opts.auto - ( Opts.value Text - <> Opts.long "print-format" - <> Opts.metavar "FORMATS" - <> Opts.help "Available print formats: JSON or if omitted, default to Text" + (Opts.value Text <> Opts.long "print-format" <> Opts.metavar "FORMATS" <> Opts.help + "Available print formats: JSON or if omitted, default to Text" ) listPayloadParser :: Opts.Parser RomeListPayload @@ -149,20 +124,16 @@ utilsPayloadParser :: Opts.Parser RomeUtilsPayload utilsPayloadParser = RomeUtilsPayload <$> romeUtilsSubcommandParser romeUtilsSubcommandParser :: Opts.Parser RomeUtilsSubcommand -romeUtilsSubcommandParser = Opts.subparser $ Opts.command - "migrate-romefile" - (pure MigrateRomefile `withInfo` "Migrates a Romefile from INI to YAML.") +romeUtilsSubcommandParser = Opts.subparser + $ Opts.command "migrate-romefile" (pure MigrateRomefile `withInfo` "Migrates a Romefile from INI to YAML.") utilsParser :: Opts.Parser RomeCommand utilsParser = Utils <$> utilsPayloadParser parseRomefilePath :: Opts.Parser String parseRomefilePath = Opts.strOption - ( Opts.value canonicalRomefileName - <> Opts.metavar "PATH" - <> Opts.long "romefile" - <> Opts.help - "The path to the Romefile to use. Defaults to the \"Romefile\" in the current directory." + (Opts.value canonicalRomefileName <> Opts.metavar "PATH" <> Opts.long "romefile" <> Opts.help + "The path to the Romefile to use. Defaults to the \"Romefile\" in the current directory." ) parseRomeCommand :: Opts.Parser RomeCommand @@ -185,14 +156,11 @@ parseRomeCommand = ) <> Opts.command "utils" - (utilsParser - `withInfo` "A series of utilities to make life easier. `rome utils --help` to know more" - ) + (utilsParser `withInfo` "A series of utilities to make life easier. `rome utils --help` to know more") parseRomeOptions :: Opts.Parser RomeOptions parseRomeOptions = - RomeOptions <$> parseRomeCommand <*> parseRomefilePath <*> Opts.switch - (Opts.short 'v' <> help "Show verbose output") + RomeOptions <$> parseRomeCommand <*> parseRomefilePath <*> Opts.switch (Opts.short 'v' <> help "Show verbose output") withInfo :: Opts.Parser a -> String -> Opts.ParserInfo a withInfo opts desc = Opts.info (Opts.helper <*> opts) $ Opts.progDesc desc diff --git a/src/Configuration.hs b/src/Configuration.hs index 0bd5071d..1a8b7bb8 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -1,42 +1,39 @@ module Configuration where -import Control.Applicative ((<|>)) -import Control.Arrow (left) +import Control.Applicative ( (<|>) ) +import Control.Arrow ( left ) import Control.Monad.Except import Data.Carthage.Cartfile import Data.Carthage.TargetPlatform -import Data.Yaml (decodeFileEither, prettyPrintParseException) -import Data.Monoid ((<>)) +import Data.Yaml ( decodeFileEither + , prettyPrintParseException + ) +import Data.Monoid ( (<>) ) import Data.Romefile -import qualified Data.Text.IO as T +import qualified Data.Text.IO as T import System.Directory import System.FilePath -import Types -getCartfileEntries :: RomeMonad [CartfileEntry] +getCartfileEntries :: MonadIO m => ExceptT String m [CartfileEntry] getCartfileEntries = do eitherCartfileEntries <- parseCartfileResolved cartfileResolved case eitherCartfileEntries of - Left e -> throwError $ "Cartfile.resolved parse error: " ++ show e + Left e -> throwError $ "Cartfile.resolved parse error: " ++ show e Right cartfileEntries -> return cartfileEntries -getRomefileEntries :: FilePath -> RomeMonad Romefile +getRomefileEntries :: MonadIO m => FilePath -> ExceptT String m Romefile getRomefileEntries absoluteRomefilePath = - let fromYaml = - ExceptT - $ left prettyPrintParseException - <$> decodeFileEither absoluteRomefilePath - fromIni = ExceptT $ parseRomefile <$> T.readFile absoluteRomefilePath + let fromYaml = ExceptT $ left prettyPrintParseException <$> (liftIO $ decodeFileEither absoluteRomefilePath) + fromIni = ExceptT $ parseRomefile <$> (liftIO $ T.readFile absoluteRomefilePath) in withExceptT toErr $ fromYaml <|> fromIni where toErr e = "Error while parsing " <> absoluteRomefilePath <> ": " <> e getAWSConfigFilePath :: MonadIO m => m FilePath -getAWSConfigFilePath = ( awsConfigFilePath) `liftM` liftIO getHomeDirectory - where awsConfigFilePath = ".aws/config" +getAWSConfigFilePath = ( awsConfigFilePath) `liftM` liftIO getHomeDirectory where awsConfigFilePath = ".aws/config" -getAWSCredentialsFilePath:: MonadIO m => m FilePath +getAWSCredentialsFilePath :: MonadIO m => m FilePath getAWSCredentialsFilePath = ( awsCredentialsFilePath) `liftM` liftIO getHomeDirectory where awsCredentialsFilePath = ".aws/credentials" @@ -46,9 +43,7 @@ carthageBuildDirectory = "Carthage" "Build" -- | The Carthage build directory based on the `TargetPlatform` and the `FrameworkType` -- from `Framework`. Ignores the `TargetPlatform` list in `Framework` -carthageArtifactsBuildDirectoryForPlatform - :: TargetPlatform -> Framework -> FilePath -carthageArtifactsBuildDirectoryForPlatform platform (Framework _ Dynamic _) = - carthageBuildDirectory show platform +carthageArtifactsBuildDirectoryForPlatform :: TargetPlatform -> Framework -> FilePath +carthageArtifactsBuildDirectoryForPlatform platform (Framework _ Dynamic _) = carthageBuildDirectory show platform carthageArtifactsBuildDirectoryForPlatform platform (Framework _ Static _) = carthageBuildDirectory show platform "Static" diff --git a/src/Data/Carthage/Cartfile.hs b/src/Data/Carthage/Cartfile.hs index be85739e..79cac22c 100644 --- a/src/Data/Carthage/Cartfile.hs +++ b/src/Data/Carthage/Cartfile.hs @@ -1,21 +1,23 @@ -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} module Data.Carthage.Cartfile - ( parseCartfileResolved - , cartfileResolved - , CartfileEntry (..) - , RepoHosting (..) - , Version (..) - , Location (..) - ) where - -import Control.Applicative ((<|>)) -import Control.Monad.Trans (MonadIO, liftIO) + ( parseCartfileResolved + , cartfileResolved + , CartfileEntry(..) + , RepoHosting(..) + , Version(..) + , Location(..) + ) +where + +import Control.Applicative ( (<|>) ) +import Control.Monad.Trans ( MonadIO + , liftIO + ) import Data.Maybe -import qualified Text.Parsec as Parsec -import qualified Text.Parsec.String as Parsec -import qualified Text.Parsec.Utils as Parsec +import qualified Text.Parsec as Parsec +import qualified Text.Parsec.String as Parsec +import qualified Text.Parsec.Utils as Parsec import Data.Carthage.Common newtype Location = Location { unLocation :: String } @@ -38,22 +40,19 @@ cartfileResolved = "Cartfile.resolved" -- Cartfile.resolved parsing parseGitHub :: Parsec.Parsec String () RepoHosting -parseGitHub = - Parsec.string "github" >> Parsec.many1 Parsec.space >> pure GitHub +parseGitHub = Parsec.string "github" >> Parsec.many1 Parsec.space >> pure GitHub parseGit :: Parsec.Parsec String () RepoHosting parseGit = Parsec.string "git" >> Parsec.many1 Parsec.space >> pure Git parseBinary :: Parsec.Parsec String () RepoHosting -parseBinary = - Parsec.string "binary" >> Parsec.many1 Parsec.space >> pure Binary +parseBinary = Parsec.string "binary" >> Parsec.many1 Parsec.space >> pure Binary repoHosting :: Parsec.Parsec String () RepoHosting repoHosting = Parsec.try parseGit <|> parseGitHub <|> parseBinary quotedContent :: Parsec.Parsec String () String -quotedContent = - Parsec.char '"' *> Parsec.parseUnquotedString <* Parsec.char '"' +quotedContent = Parsec.char '"' *> Parsec.parseUnquotedString <* Parsec.char '"' parseCartfileEntry :: Parsec.Parsec String () CartfileEntry parseCartfileEntry = do @@ -61,24 +60,19 @@ parseCartfileEntry = do location <- Location <$> quotedContent _ <- Parsec.many1 Parsec.space version <- Version <$> quotedContent - return CartfileEntry {..} + return CartfileEntry { .. } -parseCartfileResolved - :: MonadIO m => String -> m (Either Parsec.ParseError [CartfileEntry]) +parseCartfileResolved :: MonadIO m => String -> m (Either Parsec.ParseError [CartfileEntry]) parseCartfileResolved = liftIO . Parsec.parseFromFile ( catMaybes <$> ( (Parsec.many $ do line <- Parsec.optional Parsec.endOfLine - *> ( Parsec.try parseEmptyLine - <|> Parsec.try parseDependency - <|> Parsec.try parseComment - ) + *> (Parsec.try parseEmptyLine <|> Parsec.try parseDependency <|> Parsec.try parseComment) <* Parsec.optional Parsec.endOfLine case line of - Dependency entry -> - return $ Just entry - _ -> return Nothing + Dependency entry -> return $ Just entry + _ -> return Nothing ) <* Parsec.eof ) @@ -90,10 +84,7 @@ parseDependency :: Parsec.Parsec String () CartfileLine parseDependency = Dependency <$> parseCartfileEntry parseComment :: Parsec.Parsec String () CartfileLine -parseComment = - Parsec.char '#' - >> Parsec.manyTill Parsec.anyChar (Parsec.lookAhead Parsec.endOfLine) - >> return Comment +parseComment = Parsec.char '#' >> Parsec.manyTill Parsec.anyChar (Parsec.lookAhead Parsec.endOfLine) >> return Comment parseEmptyLine :: Parsec.Parsec String () CartfileLine parseEmptyLine = Parsec.many1 Parsec.space >> return EmptyLine diff --git a/src/Data/Carthage/TargetPlatform.hs b/src/Data/Carthage/TargetPlatform.hs index 66bc00f6..4218f49f 100644 --- a/src/Data/Carthage/TargetPlatform.hs +++ b/src/Data/Carthage/TargetPlatform.hs @@ -2,22 +2,22 @@ module Data.Carthage.TargetPlatform where import Text.Read -import qualified Text.Read.Lex as L -import Data.Char (toLower) +import qualified Text.Read.Lex as L +import Data.Char ( toLower ) data TargetPlatform = IOS | MacOS | TVOS | WatchOS deriving (Ord, Eq) instance Show TargetPlatform where - show IOS = "iOS" - show MacOS = "Mac" - show TVOS = "tvOS" - show WatchOS = "watchOS" + show IOS = "iOS" + show MacOS = "Mac" + show TVOS = "tvOS" + show WatchOS = "watchOS" instance Read TargetPlatform where - readPrec = parens $ do - L.Ident s <- lexP - case map toLower s of + readPrec = parens $ do + L.Ident s <- lexP + case map toLower s of "ios" -> return IOS "macos" -> return MacOS "mac" -> return MacOS @@ -27,4 +27,4 @@ instance Read TargetPlatform where allTargetPlatforms :: [TargetPlatform] -allTargetPlatforms = [IOS, MacOS, WatchOS, TVOS] \ No newline at end of file +allTargetPlatforms = [IOS, MacOS, WatchOS, TVOS] diff --git a/src/Data/Carthage/VersionFile.hs b/src/Data/Carthage/VersionFile.hs index a5618777..48d608b9 100644 --- a/src/Data/Carthage/VersionFile.hs +++ b/src/Data/Carthage/VersionFile.hs @@ -5,7 +5,7 @@ module Data.Carthage.VersionFile where import Data.Carthage.Common import Data.Carthage.TargetPlatform -import qualified Data.Map.Strict as M +import qualified Data.Map.Strict as M import Data.Aeson import Data.Aeson.Types @@ -19,9 +19,7 @@ data FrameworkInfo = FrameworkInfo { _hash :: String deriving (Show, Eq) instance FromJSON FrameworkInfo where - parseJSON (Object v) = FrameworkInfo <$> - v .: "hash" <*> - v .: "name" + parseJSON (Object v) = FrameworkInfo <$> v .: "hash" <*> v .: "name" parseJSON invalid = typeMismatch "FrameworkInfo" invalid data FrameworkPlatformInfo = FrameworkPlatformInfo { targetPlatform :: TargetPlatform @@ -40,12 +38,18 @@ data VersionFileEntry = VersionFileEntry { commitish :: Version deriving (Show, Eq) instance FromJSON VersionFileEntry where - parseJSON (Object v) = VersionFileEntry - <$> (Version <$> v .: "commitish") - <*> v .: "xcodeVersion" - <*> v .:? "iOS" - <*> v .:? "tvOS" - <*> v .:? "watchOS" - <*> v .:? "Mac" - - parseJSON invalid = typeMismatch "VersionFileEntry" invalid + parseJSON (Object v) = + VersionFileEntry + <$> (Version <$> v .: "commitish") + <*> v + .: "xcodeVersion" + <*> v + .:? "iOS" + <*> v + .:? "tvOS" + <*> v + .:? "watchOS" + <*> v + .:? "Mac" + + parseJSON invalid = typeMismatch "VersionFileEntry" invalid diff --git a/src/Data/Romefile.hs b/src/Data/Romefile.hs index b70d221f..08cf9ea3 100644 --- a/src/Data/Romefile.hs +++ b/src/Data/Romefile.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -9,42 +8,42 @@ module Data.Romefile - ( parseRomefile - , canonicalRomefileName - , RomefileEntry (..) - , Framework (..) - , ProjectName (..) - , Romefile (..) - , RomeCacheInfo (..) - , cacheInfo - , bucket - , localCacheDir - , enginePath - , frameworkName - , frameworkType - , FrameworkType (..) - , toFramework - ) + ( parseRomefile + , canonicalRomefileName + , RomefileEntry(..) + , Framework(..) + , ProjectName(..) + , Romefile(..) + , RomeCacheInfo(..) + , cacheInfo + , bucket + , localCacheDir + , enginePath + , frameworkName + , frameworkType + , FrameworkType(..) + , toFramework + ) where -import Control.Arrow (left) -import Control.Lens hiding ((.=)) +import Control.Arrow ( left ) +import Control.Lens hiding ( (.=) ) import Control.Monad.Except import Data.Aeson -import Data.Aeson.Types (typeMismatch) +import Data.Aeson.Types ( typeMismatch ) import Data.Carthage.TargetPlatform import Data.Char import Data.Either -import qualified Data.HashMap.Strict as M -import Data.Ini as INI -import Data.List (nub) +import qualified Data.HashMap.Strict as M +import Data.Ini as INI +import Data.List ( nub ) import Data.Maybe -import qualified Data.Text as T +import qualified Data.Text as T import Data.Yaml import GHC.Generics import Safe import Text.Read -import qualified Text.Read.Lex as L +import qualified Text.Read.Lex as L @@ -55,27 +54,25 @@ instance ToJSON FrameworkType where toJSON = genericToJSON defaultOptions { constructorTagModifier = map toLower } instance FromJSON FrameworkType where - parseJSON = withText "FrameworkType" $ \v -> - return (read $ T.unpack v) + parseJSON = withText "FrameworkType" $ \v -> return (read $ T.unpack v) instance Read FrameworkType where readPrec = parens $ do L.Ident s <- lexP case map toLower s of "dynamic" -> return Dynamic - "static" -> return Static - o -> fail $ "Could not parse '" ++ o ++ "' into a FrameworkType" + "static" -> return Static + o -> fail $ "Could not parse '" ++ o ++ "' into a FrameworkType" instance ToJSON TargetPlatform where toJSON t = case t of - IOS -> Data.Yaml.String "iOS" - MacOS -> Data.Yaml.String "macOS" + IOS -> Data.Yaml.String "iOS" + MacOS -> Data.Yaml.String "macOS" WatchOS -> Data.Yaml.String "watchOS" - TVOS -> Data.Yaml.String "tvOS" + TVOS -> Data.Yaml.String "tvOS" instance FromJSON TargetPlatform where - parseJSON = withText "TargetPlatform" $ \v -> - return (read $ T.unpack v) + parseJSON = withText "TargetPlatform" $ \v -> return (read $ T.unpack v) data Framework = Framework { _frameworkName :: String @@ -86,14 +83,14 @@ data Framework = Framework { _frameworkName :: String instance ToJSON Framework where toJSON (Framework fName fType fPlatforms) = object fields - where fields = (T.pack "name" .= fName) : [T.pack "type" .= fType | fType /= Dynamic] ++ platforms - platforms = [ T.pack "platforms" .= fPlatforms | length (nub fPlatforms) /= 4 ] + where + fields = (T.pack "name" .= fName) : [ T.pack "type" .= fType | fType /= Dynamic ] ++ platforms + platforms = [ T.pack "platforms" .= fPlatforms | length (nub fPlatforms) /= 4 ] instance FromJSON Framework where - parseJSON = withObject "Framework" $ \v -> Framework - <$> v .: "name" - <*> v .:? "type" .!= Dynamic - <*> fmap nub (v .:? "platforms" .!= [IOS, MacOS, WatchOS, TVOS]) + parseJSON = withObject "Framework" $ \v -> Framework <$> v .: "name" <*> v .:? "type" .!= Dynamic <*> fmap + nub + (v .:? "platforms" .!= [IOS, MacOS, WatchOS, TVOS]) @@ -117,9 +114,8 @@ instance FromJSON RomefileEntry where parseJSON o@(Object obj) = do let firstKey = fst <$> (headMay . M.toList $ obj) case firstKey of - Just key -> - RomefileEntry <$> parseJSON (Data.Aeson.String key) <*> (obj .: key) - Nothing -> typeMismatch "RomefileEntry" o + Just key -> RomefileEntry <$> parseJSON (Data.Aeson.String key) <*> (obj .: key) + Nothing -> typeMismatch "RomefileEntry" o parseJSON invalid = typeMismatch "RomefileEntry" invalid instance ToJSON RomefileEntry where @@ -147,29 +143,34 @@ data Romefile = Romefile { _cacheInfo :: RomeCacheInfo deriving (Eq, Show, Generic) instance FromJSON Romefile where - parseJSON = withObject "Romefile" $ \v -> Romefile - <$> v .: cacheJSONKey - <*> v .:? repositoryMapJSONKey .!= [] - <*> v .:? ignoreMapJSONKey .!= [] - <*> v .:? currentMapJSONKey .!= [] + parseJSON = withObject "Romefile" $ \v -> + Romefile + <$> v + .: cacheJSONKey + <*> v + .:? repositoryMapJSONKey + .!= [] + <*> v + .:? ignoreMapJSONKey + .!= [] + <*> v + .:? currentMapJSONKey + .!= [] instance ToJSON Romefile where toJSON (Romefile cInfo rMap iMap cMap) = object fields - where - fields = (cacheJSONKey .= cInfo) - : [ repositoryMapJSONKey .= rMap | not $ null rMap] - ++ [ ignoreMapJSONKey .= iMap | not $ null iMap] - ++ [ currentMapJSONKey .= cMap | not $ null cMap] + where + fields = + (cacheJSONKey .= cInfo) + : [ repositoryMapJSONKey .= rMap | not $ null rMap ] + ++ [ ignoreMapJSONKey .= iMap | not $ null iMap ] + ++ [ currentMapJSONKey .= cMap | not $ null cMap ] frameworkName :: Lens' Framework String -frameworkName = lens - _frameworkName - (\framework newName -> framework { _frameworkName = newName }) +frameworkName = lens _frameworkName (\framework newName -> framework { _frameworkName = newName }) frameworkType :: Lens' Framework FrameworkType -frameworkType = lens - _frameworkType - (\framework newType -> framework { _frameworkType = newType }) +frameworkType = lens _frameworkType (\framework newType -> framework { _frameworkType = newType }) cacheInfo :: Lens' Romefile RomeCacheInfo cacheInfo = lens _cacheInfo (\parseResult n -> parseResult { _cacheInfo = n }) @@ -181,17 +182,14 @@ data RomeCacheInfo = RomeCacheInfo { _bucket :: Maybe T.Text deriving (Eq, Show, Generic) instance FromJSON RomeCacheInfo where - parseJSON = withObject "RomeCacheInfo" $ \v -> RomeCacheInfo - <$> v .:? "s3Bucket" - <*> v .:? "local" - <*> v .:? "engine" + parseJSON = + withObject "RomeCacheInfo" $ \v -> RomeCacheInfo <$> v .:? "s3Bucket" <*> v .:? "local" <*> v .:? "engine" instance ToJSON RomeCacheInfo where toJSON (RomeCacheInfo b l e) = object fields - where - fields = [T.pack "s3Bucket" .= b | isJust b] - ++ [T.pack "local" .= l | isJust l] - ++ [T.pack "engine" .= e| isJust e] + where + fields = + [ T.pack "s3Bucket" .= b | isJust b ] ++ [ T.pack "local" .= l | isJust l ] ++ [ T.pack "engine" .= e | isJust e ] bucket :: Lens' RomeCacheInfo (Maybe T.Text) bucket = lens _bucket (\cInfo n -> cInfo { _bucket = n }) @@ -238,26 +236,18 @@ toRomefile ini = do let _repositoryMapEntries = getRepositoryMapEntries ini _ignoreMapEntries = getIgnoreMapEntries ini _enginePath = _engine - _cacheInfo = RomeCacheInfo {..} - Romefile - <$> Right _cacheInfo - <*> _repositoryMapEntries - <*> _ignoreMapEntries - <*> Right [] - -getSection :: T.Text -> M.HashMap T.Text b -> Either T.Text b -getSection key = maybe (Left err) Right . M.lookup key + _cacheInfo = RomeCacheInfo { .. } + Romefile <$> Right _cacheInfo <*> _repositoryMapEntries <*> _ignoreMapEntries <*> Right [] + +getSection :: T.Text -> Ini -> Either T.Text (M.HashMap T.Text T.Text) +getSection key ini = maybe (Left err) Right (M.lookup key (INI.unIni ini)) where err = T.pack $ "Could not find section: " <> show key getBucket :: Ini -> Either T.Text (Maybe T.Text) -getBucket (Ini ini) = - M.lookup s3BucketKey <$> getSection cacheSectionDelimiter ini +getBucket ini = M.lookup s3BucketKey <$> getSection cacheSectionDelimiter ini getLocalCacheDir :: Ini -> Either T.Text (Maybe FilePath) -getLocalCacheDir (Ini ini) = - fmap T.unpack - . M.lookup localCacheDirKey - <$> getSection cacheSectionDelimiter ini +getLocalCacheDir ini = fmap T.unpack . M.lookup localCacheDirKey <$> getSection cacheSectionDelimiter ini getRepositoryMapEntries :: Ini -> Either T.Text [RomefileEntry] getRepositoryMapEntries = getRomefileEntries repositoryMapSectionDelimiter @@ -266,20 +256,15 @@ getIgnoreMapEntries :: Ini -> Either T.Text [RomefileEntry] getIgnoreMapEntries = getRomefileEntries ignoreMapSectionDelimiter getRomefileEntries :: T.Text -> Ini -> Either T.Text [RomefileEntry] -getRomefileEntries sectionDelimiter (Ini ini) = - traverse toEntry - . M.toList - . fromMaybe M.empty - . M.lookup sectionDelimiter - $ ini +getRomefileEntries sectionDelimiter ini = + traverse toEntry . M.toList . fromMaybe M.empty . M.lookup sectionDelimiter $ INI.unIni ini toEntry :: (T.Text, T.Text) -> Either T.Text RomefileEntry toEntry (repoName, frameworksAsStrings) = - let projectName = ProjectName $ T.unpack repoName - eitherFrameworks = - map (toFramework . T.strip) (T.splitOn "," frameworksAsStrings) - (ls, rs) = partitionEithers eitherFrameworks - errors = T.intercalate "\n" ls + let projectName = ProjectName $ T.unpack repoName + eitherFrameworks = map (toFramework . T.strip) (T.splitOn "," frameworksAsStrings) + (ls, rs) = partitionEithers eitherFrameworks + errors = T.intercalate "\n" ls in case ls of [] -> RomefileEntry <$> Right projectName <*> Right rs _ -> Left errors @@ -290,27 +275,20 @@ toFramework t = case T.splitOn "/" t of [fName] -> Right $ Framework (T.unpack fName) Dynamic allPlatforms [fType, fName] -> let unpackedFtype = T.unpack fType - unpackedName = T.unpack fName + unpackedName = T.unpack fName in left T.pack - $ Framework - <$> Right (T.unpack fName) - <*> ( left (const (errorMessage unpackedName unpackedFtype)) - . readEither - $ unpackedFtype - ) - <*> Right allPlatforms + $ Framework + <$> Right (T.unpack fName) + <*> (left (const (errorMessage unpackedName unpackedFtype)) . readEither $ unpackedFtype) + <*> Right allPlatforms (fType : fNameFragments) -> let unpackedFtype = T.unpack fType - unpackedName = T.unpack $ T.intercalate "/" fNameFragments + unpackedName = T.unpack $ T.intercalate "/" fNameFragments in left T.pack - $ Framework - <$> Right unpackedName - <*> ( left (const (errorMessage unpackedName unpackedFtype)) - . readEither - . T.unpack - $ fType - ) - <*> Right allPlatforms + $ Framework + <$> Right unpackedName + <*> (left (const (errorMessage unpackedName unpackedFtype)) . readEither . T.unpack $ fType) + <*> Right allPlatforms where allPlatforms = [IOS, MacOS, WatchOS, TVOS] errorMessage fType fName = diff --git a/src/Engine/Downloading.hs b/src/Engine/Downloading.hs index ce1373be..41535b01 100644 --- a/src/Engine/Downloading.hs +++ b/src/Engine/Downloading.hs @@ -4,20 +4,25 @@ module Engine.Downloading where import Caches.Common -import Configuration (carthageArtifactsBuildDirectoryForPlatform) -import Control.Exception (try) +import Configuration ( carthageArtifactsBuildDirectoryForPlatform ) +import Control.Exception ( try ) import Control.Monad import Control.Monad.Except -import Control.Monad.Reader (ReaderT, ask, runReaderT, - withReaderT) -import qualified Data.ByteString.Lazy as LBS +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 ) import System.Directory -import System.FilePath (()) -import Types hiding (version) +import System.FilePath ( () ) +import Types hiding ( version ) import Utils import Xcode.DWARF import qualified Turtle @@ -28,36 +33,28 @@ getFrameworkFromEngine -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the Framework in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT String (ReaderT (CachePrefix, Bool) IO) LBS.ByteString -getFrameworkFromEngine enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform - = do - (CachePrefix cachePrefix, verbose) <- ask - let frameworkLocalPath = cachePrefix remoteFrameworkUploadPath - mapExceptT - (withReaderT (const verbose)) - (getArtifactFromEngine enginePath frameworkLocalPath fwn - ) - where - remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version + -> FilePath -- ^ A temporary intermediate directory + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) IO) LBS.ByteString +getFrameworkFromEngine enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform tmpDir = do + (CachePrefix cachePrefix, verbose, uuid) <- ask + let frameworkLocalPath = cachePrefix remoteFrameworkUploadPath + mapExceptT (withReaderT (const (verbose, uuid))) (getArtifactFromEngine enginePath frameworkLocalPath fwn tmpDir) + where remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version -- | Retrieves a .version file using the engine getVersionFileFromEngine :: FilePath -- ^ The `FilePath` to the engine -> ProjectNameAndVersion - -> ExceptT - String - (ReaderT (CachePrefix, Bool) IO) - LBS.ByteString -getVersionFileFromEngine enginePath projectNameAndVersion = do - (CachePrefix prefix, verbose) <- ask + -> FilePath -- ^ A temporary intermediate directory + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) IO) LBS.ByteString +getVersionFileFromEngine enginePath projectNameAndVersion tmpDir = do + (CachePrefix prefix, verbose, uuid) <- ask let finalVersionFileRemotePath = prefix versionFileRemotePath - mapExceptT (withReaderT (const verbose)) $ getArtifactFromEngine - enginePath - finalVersionFileRemotePath - versionFileName + mapExceptT (withReaderT (const (verbose, uuid))) + $ getArtifactFromEngine enginePath finalVersionFileRemotePath versionFileName tmpDir where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileRemotePath = remoteVersionFilePath projectNameAndVersion @@ -68,22 +65,17 @@ getBcsymbolmapWithEngine -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the dSYM -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to -> DwarfUUID -- ^ The UUID of the bcsymbolmap - -> ExceptT - String - (ReaderT (CachePrefix, Bool) IO) - LBS.ByteString -getBcsymbolmapWithEngine enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform dwarfUUID + -> FilePath -- ^ A temporary intermediate directory + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) IO) LBS.ByteString +getBcsymbolmapWithEngine enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform dwarfUUID tmpDir = do - (CachePrefix prefix, verbose) <- ask + (CachePrefix prefix, verbose, uuid) <- ask let finalRemoteBcsymbolmaploadPath = prefix remoteBcSymbolmapUploadPath - mapExceptT (withReaderT (const verbose)) $ getArtifactFromEngine - enginePath - finalRemoteBcsymbolmaploadPath - symbolmapName + mapExceptT (withReaderT (const (verbose, uuid))) + $ getArtifactFromEngine enginePath finalRemoteBcsymbolmaploadPath symbolmapName tmpDir where - remoteBcSymbolmapUploadPath = - remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version - symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID + remoteBcSymbolmapUploadPath = remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version + symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID -- | Retrieves a dSYM using the engine @@ -92,16 +84,13 @@ getDSYMFromEngine -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the dSYM in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the dSYM -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT - String - (ReaderT (CachePrefix, Bool) IO) - LBS.ByteString -getDSYMFromEngine enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform - = do - (CachePrefix prefix, verbose) <- ask - let finalRemoteDSYMUploadPath = prefix remoteDSYMUploadPath - mapExceptT (withReaderT (const verbose)) - $ getArtifactFromEngine enginePath finalRemoteDSYMUploadPath dSYMName + -> FilePath -- ^ A temporary intermediate directory + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) IO) LBS.ByteString +getDSYMFromEngine enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ _) version) platform tmpDir = do + (CachePrefix prefix, verbose, uuid) <- ask + let finalRemoteDSYMUploadPath = prefix remoteDSYMUploadPath + mapExceptT (withReaderT (const (verbose, uuid))) + $ getArtifactFromEngine enginePath finalRemoteDSYMUploadPath dSYMName tmpDir where remoteDSYMUploadPath = remoteDsymPath platform reverseRomeMap f version dSYMName = fwn <> ".dSYM" @@ -114,21 +103,17 @@ getAndUnzipBcsymbolmapWithEngine -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the dSYM -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to -> DwarfUUID -- ^ The UUID of the bcsymbolmap - -> ExceptT String (ReaderT (CachePrefix, Bool) IO) () -getAndUnzipBcsymbolmapWithEngine enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform dwarfUUID + -> FilePath -- ^ A temporary intermediate directory + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) IO) () +getAndUnzipBcsymbolmapWithEngine enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform dwarfUUID tmpDir = when (platform `elem` fwps) $ do - (_, verbose) <- ask + (_, verbose, _) <- ask let symbolmapName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID - binary <- getBcsymbolmapWithEngine enginePath - reverseRomeMap - fVersion - platform - dwarfUUID + binary <- getBcsymbolmapWithEngine enginePath reverseRomeMap fVersion platform dwarfUUID tmpDir deleteFile (bcsymbolmapPath dwarfUUID) verbose unzipBinary binary symbolmapName (bcsymbolmapZipName dwarfUUID) verbose where - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f bcsymbolmapZipName d = bcsymbolmapArchiveName d version bcsymbolmapPath d = platformBuildDirectory bcsymbolmapNameFrom d @@ -139,36 +124,26 @@ getAndUnzipBcsymbolmapsWithEngine' -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the dSYM in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT - DWARFOperationError - (ReaderT (CachePrefix, Bool) IO) - () -getAndUnzipBcsymbolmapsWithEngine' enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) _) platform + -> FilePath -- ^ A temporary intermediate directory + -> ExceptT DWARFOperationError (ReaderT (CachePrefix, Bool, UUID.UUID) IO) () +getAndUnzipBcsymbolmapsWithEngine' enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) _) platform tmpDir = when (platform `elem` fwps) $ do - dwarfUUIDs <- withExceptT (const ErrorGettingDwarfUUIDs) - $ dwarfUUIDsFrom (frameworkDirectory fwn) + dwarfUUIDs <- withExceptT (const ErrorGettingDwarfUUIDs) $ dwarfUUIDsFrom (frameworkDirectory fwn) eitherDwarfUUIDsOrSucces <- forM dwarfUUIDs (\dwarfUUID -> lift $ runExceptT - (withExceptT (\e -> (dwarfUUID, e)) $ getAndUnzipBcsymbolmapWithEngine - enginePath - reverseRomeMap - fVersion - platform - dwarfUUID + ( withExceptT (\e -> (dwarfUUID, e)) + $ getAndUnzipBcsymbolmapWithEngine enginePath reverseRomeMap fVersion platform dwarfUUID tmpDir ) ) let failedUUIDsAndErrors = lefts eitherDwarfUUIDsOrSucces - unless (null failedUUIDsAndErrors) $ throwError $ FailedDwarfUUIDs - failedUUIDsAndErrors + unless (null failedUUIDsAndErrors) $ throwError $ FailedDwarfUUIDs failedUUIDsAndErrors where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - frameworkDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + frameworkDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension -- | Retrieves a Framework using the engine and unzip the contents @@ -177,19 +152,15 @@ getAndUnzipFrameworkWithEngine -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the Framework in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT String (ReaderT (CachePrefix, Bool) IO) () -getAndUnzipFrameworkWithEngine enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform + -> FilePath -- ^ A temporary intermediate directory + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) IO) () +getAndUnzipFrameworkWithEngine enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform tmpDir = when (platform `elem` fwps) $ do - (_, verbose) <- ask - frameworkBinary <- getFrameworkFromEngine enginePath - reverseRomeMap - fVersion - platform + (_, verbose, _) <- ask + frameworkBinary <- getFrameworkFromEngine enginePath reverseRomeMap fVersion platform tmpDir deleteFrameworkDirectory fVersion platform verbose unzipBinary frameworkBinary fwn frameworkZipName verbose - <* ifExists - frameworkExecutablePath - (makeExecutable frameworkExecutablePath) + <* ifExists frameworkExecutablePath (makeExecutable frameworkExecutablePath) where frameworkZipName = frameworkArchiveName f version frameworkExecutablePath = frameworkBuildBundleForPlatform platform f fwn @@ -201,11 +172,12 @@ getAndUnzipDSYMWithEngine -> InvertedRepositoryMap -- ^ The map used to resolve from a `FrameworkVersion` to the path of the dSYM in the cache -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the dSYM -> TargetPlatform -- ^ The `TargetPlatform` to limit the operation to - -> ExceptT String (ReaderT (CachePrefix, Bool) IO) () -getAndUnzipDSYMWithEngine enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform + -> FilePath -- ^ A temporary intermediate directory + -> ExceptT String (ReaderT (CachePrefix, Bool, UUID.UUID) IO) () +getAndUnzipDSYMWithEngine enginePath reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ fwps) version) platform tmpDir = when (platform `elem` fwps) $ do - (_, verbose) <- ask - dSYMBinary <- getDSYMFromEngine enginePath reverseRomeMap fVersion platform + (_, verbose, _) <- ask + dSYMBinary <- getDSYMFromEngine enginePath reverseRomeMap fVersion platform tmpDir deleteDSYMDirectory fVersion platform verbose unzipBinary dSYMBinary fwn dSYMZipName verbose where dSYMZipName = dSYMArchiveName f version @@ -215,49 +187,47 @@ getArtifactFromEngine :: FilePath -- ^ The `FilePath` to the engine -> FilePath -- ^ The remote path -> String -- ^ A colloquial name for the artifact - -> ExceptT String (ReaderT Bool IO) LBS.ByteString -getArtifactFromEngine enginePath remotePath artifactName = do - readerEnv@(verbose) <- ask + -> FilePath -- ^ A temporary intermediate directory + -> 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 - (downloadBinaryWithEngine enginePath remotePath artifactName) + (downloadBinaryWithEngine enginePath remotePath artifactName tmpDir) readerEnv case eitherArtifact of - Left e -> - throwError - $ "Error: could not download " - <> artifactName - <> " : " - <> show e + Left e -> throwError $ "Error: could not download " <> artifactName <> " : " <> show e Right artifactBinary -> return artifactBinary -- | Downloads an artifact stored at a given path using the engine downloadBinaryWithEngine :: FilePath -- ^ The `FilePath` to the engine - -> FilePath - -> FilePath - -> (ReaderT Bool IO) LBS.ByteString -downloadBinaryWithEngine enginePath objectRemotePath objectName = do - verbose <- ask - let cmd = Turtle.fromString enginePath - let sayFunc = if verbose then sayLnWithTime else sayLn - when verbose - $ sayLnWithTime - $ "Invoking engine " - <> show enginePath - <> " to download " - <> objectName - <> " from: " - <> objectRemotePath - exitCode <- Turtle.proc - cmd - ["download", Turtle.fromString objectRemotePath, Turtle.fromString objectRemotePath] - (return $ Turtle.unsafeTextToLine "") - case exitCode of - Turtle.ExitSuccess -> return () - Turtle.ExitFailure n -> sayFunc - $ "Error: could not download " - <> objectRemotePath - binaryExists <- liftIO . doesFileExist $ objectRemotePath - if binaryExists - then liftIO $ LBS.readFile objectRemotePath - else fail "Binary was not downloaded by engine" + -> FilePath -- ^ The remote path + -> String -- ^ A colloquial name for the artifact + -> FilePath -- ^ A temporary intermediate directory + -> ReaderT (Bool, UUID.UUID) IO LBS.ByteString +downloadBinaryWithEngine enginePath objectRemotePath objectName tmpDir = do + (verbose, _) <- ask + let cmd = Turtle.fromString enginePath + let sayFunc = if verbose then sayLnWithTime else sayLn + when verbose + $ sayLnWithTime + $ "Invoking engine " + <> show enginePath + <> " to download " + <> objectName + <> " from: " + <> objectRemotePath + let outputPath = tmpDir objectRemotePath + exitCode <- Turtle.proc cmd + ["download", Turtle.fromString objectRemotePath, Turtle.fromString outputPath] + (return $ Turtle.unsafeTextToLine "") + case exitCode of + Turtle.ExitSuccess -> return () + Turtle.ExitFailure _ -> sayFunc $ "Error: could not download " <> outputPath + binaryExists <- liftIO . doesFileExist $ outputPath + if binaryExists + then liftIO $ do + binary <- LBS.readFile outputPath + deleteFile outputPath verbose + return binary + else fail "Binary was not downloaded by engine" diff --git a/src/Engine/Probing.hs b/src/Engine/Probing.hs index 974a165c..1364a2e3 100644 --- a/src/Engine/Probing.hs +++ b/src/Engine/Probing.hs @@ -4,12 +4,12 @@ module Engine.Probing where import Control.Monad.IO.Class import Data.Carthage.TargetPlatform -import Data.List (intersect) -import Data.Romefile (_frameworkPlatforms) -import Types hiding (version) +import Data.List ( intersect ) +import Data.Romefile ( _frameworkPlatforms ) +import Types hiding ( version ) import Utils import qualified Turtle -import System.FilePath (()) +import System.FilePath ( () ) -- | Probes a `FilePath` to check if each `FrameworkVersion` exists for each `TargetPlatform` @@ -21,12 +21,8 @@ probeEngineForFrameworks -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` to probe for. -> [TargetPlatform] -- ^ A list target platforms restricting the scope of this action. -> m [FrameworkAvailability] -probeEngineForFrameworks lCacheDir cachePrefix reverseRomeMap frameworkVersions - = sequence . probeForEachFramework - where - probeForEachFramework = mapM - (probeEngineForFramework lCacheDir cachePrefix reverseRomeMap) - frameworkVersions +probeEngineForFrameworks lCacheDir cachePrefix reverseRomeMap frameworkVersions = sequence . probeForEachFramework + where probeForEachFramework = mapM (probeEngineForFramework lCacheDir cachePrefix reverseRomeMap) frameworkVersions -- | Probes the engine at `FilePath` to check if a `FrameworkVersion` exists for each `TargetPlatform` @@ -38,15 +34,12 @@ probeEngineForFramework -> FrameworkVersion -- ^ The `FrameworkVersion` to probe for. -> [TargetPlatform] -- ^ A list target platforms restricting the scope of this action. -> m FrameworkAvailability -probeEngineForFramework lCacheDir cachePrefix reverseRomeMap frameworkVersion platforms - = fmap (FrameworkAvailability frameworkVersion) probeForEachPlatform +probeEngineForFramework lCacheDir cachePrefix reverseRomeMap frameworkVersion platforms = fmap + (FrameworkAvailability frameworkVersion) + probeForEachPlatform where probeForEachPlatform = mapM - (probeEngineForFrameworkOnPlatform lCacheDir - cachePrefix - reverseRomeMap - frameworkVersion - ) + (probeEngineForFrameworkOnPlatform lCacheDir cachePrefix reverseRomeMap frameworkVersion) (platforms `intersect` (_frameworkPlatforms . _framework $ frameworkVersion)) @@ -62,15 +55,12 @@ probeEngineForFrameworkOnPlatform probeEngineForFrameworkOnPlatform enginePath (CachePrefix prefix) reverseRomeMap (FrameworkVersion fwn version) platform = do let cmd = Turtle.fromString enginePath - exitCode <- Turtle.proc - cmd - ["list", Turtle.fromString (prefix remoteFrameworkUploadPath)] - (return $ Turtle.unsafeTextToLine "") + exitCode <- Turtle.proc cmd + ["list", Turtle.fromString (prefix remoteFrameworkUploadPath)] + (return $ Turtle.unsafeTextToLine "") case exitCode of -- If engine exits with success, we assume the framework exists. - Turtle.ExitSuccess -> return (PlatformAvailability platform True) - Turtle.ExitFailure _ -> return (PlatformAvailability platform False) - where - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap fwn version + Turtle.ExitSuccess -> return (PlatformAvailability platform True) + Turtle.ExitFailure _ -> return (PlatformAvailability platform False) + where remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap fwn version diff --git a/src/Engine/Uploading.hs b/src/Engine/Uploading.hs index fe511a3b..5e5cd283 100644 --- a/src/Engine/Uploading.hs +++ b/src/Engine/Uploading.hs @@ -2,16 +2,19 @@ module Engine.Uploading where -import qualified Codec.Archive.Zip as Zip -import Control.Monad (when) -import Control.Monad.Reader (ReaderT, ask, withReaderT) +import qualified Codec.Archive.Zip as Zip +import Control.Monad ( when ) +import Control.Monad.Reader ( ReaderT + , ask + , withReaderT + ) import Control.Monad.IO.Class -import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy as LBS import Data.Carthage.TargetPlatform -import Data.Monoid ((<>)) -import Data.Romefile (Framework (..)) -import System.FilePath (()) -import Types hiding (version) +import Data.Monoid ( (<>) ) +import Data.Romefile ( Framework(..) ) +import System.FilePath ( () ) +import Types hiding ( version ) import Utils import Xcode.DWARF import qualified Turtle @@ -28,14 +31,9 @@ uploadFrameworkToEngine uploadFrameworkToEngine frameworkArchive enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do (CachePrefix prefix, verbose) <- ask - withReaderT (const verbose) $ uploadBinary - enginePath - (Zip.fromArchive frameworkArchive) - (prefix remoteFrameworkUploadPath) - fwn - where - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version + withReaderT (const verbose) + $ uploadBinary enginePath (Zip.fromArchive frameworkArchive) (prefix remoteFrameworkUploadPath) fwn + where remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version @@ -47,14 +45,11 @@ uploadDsymToEngine -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework and the dSYM. -> TargetPlatform -- ^ A `TargetPlatform` restricting the scope of this action. -> ReaderT (CachePrefix, Bool) IO () -uploadDsymToEngine dSYMArchive enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform - = when (platform `elem` fwps) $ do +uploadDsymToEngine dSYMArchive enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform = + when (platform `elem` fwps) $ do (CachePrefix prefix, verbose) <- ask - withReaderT (const verbose) $ uploadBinary - enginePath - (Zip.fromArchive dSYMArchive) - (prefix remoteDsymUploadPath) - (fwn <> ".dSYM") + withReaderT (const verbose) + $ uploadBinary enginePath (Zip.fromArchive dSYMArchive) (prefix remoteDsymUploadPath) (fwn <> ".dSYM") where remoteDsymUploadPath = remoteDsymPath platform reverseRomeMap f version @@ -71,14 +66,11 @@ uploadBcsymbolmapToEngine uploadBcsymbolmapToEngine dwarfUUID dwarfArchive enginePath reverseRomeMap (FrameworkVersion f@(Framework fwn _ fwps) version) platform = when (platform `elem` fwps) $ do (CachePrefix prefix, verbose) <- ask - withReaderT (const verbose) $ uploadBinary - enginePath - (Zip.fromArchive dwarfArchive) - (prefix remoteBcsymbolmapUploadPath) - (fwn <> "." <> bcsymbolmapNameFrom dwarfUUID) - where - remoteBcsymbolmapUploadPath = - remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version + withReaderT (const verbose) $ uploadBinary enginePath + (Zip.fromArchive dwarfArchive) + (prefix remoteBcsymbolmapUploadPath) + (fwn <> "." <> bcsymbolmapNameFrom dwarfUUID) + where remoteBcsymbolmapUploadPath = remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version @@ -88,16 +80,12 @@ uploadVersionFileToEngine' -> LBS.ByteString -- ^ The contents of the .version file. -> ProjectNameAndVersion -- ^ The information used to derive the name and path for the .version file. -> ReaderT (CachePrefix, Bool) IO () -uploadVersionFileToEngine' enginePath versionFileContent projectNameAndVersion = - do - (CachePrefix prefix, verbose) <- ask - withReaderT (const verbose) $ uploadBinary - enginePath - versionFileContent - (prefix versionFileRemotePath) - versionFileName +uploadVersionFileToEngine' enginePath versionFileContent projectNameAndVersion = do + (CachePrefix prefix, verbose) <- ask + withReaderT (const verbose) + $ uploadBinary enginePath versionFileContent (prefix versionFileRemotePath) versionFileName where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileRemotePath = remoteVersionFilePath projectNameAndVersion @@ -110,26 +98,15 @@ uploadBinary -> FilePath -> FilePath -> ReaderT Bool a () -uploadBinary enginePath binaryZip destinationPath objectName = - do - verbose <- ask - let cmd = Turtle.fromString enginePath - liftIO $ saveBinaryToFile binaryZip destinationPath - when verbose - $ sayLnWithTime - $ "Invoking engine " - <> show enginePath - <> " to upload " - <> destinationPath - exitCode <- Turtle.proc - cmd - ["upload", Turtle.fromString destinationPath, Turtle.fromString destinationPath] - (return $ Turtle.unsafeTextToLine "") - case exitCode of - Turtle.ExitSuccess -> return () - Turtle.ExitFailure n -> sayLn - $ "Error " - <> show n - <> ": could not upload " - <> destinationPath - +uploadBinary enginePath binaryZip destinationPath _ = do + verbose <- ask + let cmd = Turtle.fromString enginePath + liftIO $ saveBinaryToFile binaryZip destinationPath + when verbose $ sayLnWithTime $ "Invoking engine " <> show enginePath <> " to upload " <> destinationPath + exitCode <- Turtle.proc cmd + ["upload", Turtle.fromString destinationPath, Turtle.fromString destinationPath] + (return $ Turtle.unsafeTextToLine "") + case exitCode of + Turtle.ExitSuccess -> return () + Turtle.ExitFailure n -> sayLn $ "Error " <> show n <> ": could not upload " <> destinationPath + diff --git a/src/Lib.hs b/src/Lib.hs index 68be1164..f61e66f0 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,15 +1,15 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Lib (module Lib - , Types.RomeVersion - , Utils.romeVersionToString - ) - where +module Lib + ( module Lib + , Types.RomeVersion + , Utils.romeVersionToString + ) +where import Caches.Common import Caches.Local.Downloading @@ -22,43 +22,68 @@ 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 qualified Data.ByteString.Char8 as BS (pack) -import qualified Data.ByteString.Lazy as LBS -import Data.Yaml (encodeFile) -import Data.IORef (newIORef) +import Control.Monad.Reader ( ReaderT + , ask + , runReaderT + ) +import Control.Monad.Trans.Maybe ( exceptToMaybeT + , runMaybeT + ) +import qualified Data.ByteString.Char8 as BS + ( pack ) +import qualified Data.ByteString.Lazy as LBS +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.Map.Strict as M (empty) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T (encodeUtf8) -import qualified Network.AWS as AWS -import qualified Network.AWS.Auth as AWS (fromEnv) -import qualified Network.AWS.Env as AWS (Env (..), retryConnectionFailure) -import qualified Network.AWS.Data as AWS (fromText) -import qualified Network.AWS.Data.Sensitive as AWS (Sensitive (..)) -import qualified Network.AWS.S3 as S3 -import qualified Network.AWS.STS.AssumeRole as STS (assumeRole, arrsCredentials) -import qualified Network.AWS.Utils as AWS -import qualified Network.HTTP.Conduit as Conduit +import qualified Data.UUID as UUID + ( UUID + , toString + ) +import qualified Data.Map.Strict as M + ( empty ) +import qualified Data.Text as T +import qualified Network.AWS as AWS +import qualified Network.AWS.Auth as AWS + ( fromEnv ) +import qualified Network.AWS.Env as AWS + ( Env(..) + , retryConnectionFailure + ) +import qualified Network.AWS.Data as AWS + ( fromText ) +import qualified Network.AWS.S3 as S3 +import qualified Network.AWS.STS.AssumeRole as STS + ( assumeRole + , arrsCredentials + ) +import qualified Network.AWS.Utils as AWS +import qualified Network.HTTP.Conduit as Conduit import Network.URL import System.Directory import System.Environment import System.FilePath import Types -import Types.Commands as Commands +import Types.Commands as Commands import Utils import Xcode.DWARF @@ -68,10 +93,7 @@ s3EndpointOverride (URL (Absolute h) _ _) = let isSecure = secure h host' = host h port' = port h <|> if isSecure then Just 443 else Nothing - in AWS.setEndpoint isSecure - (BS.pack host') - (maybe 9000 fromInteger port') - S3.s3 + in AWS.setEndpoint isSecure (BS.pack host') (maybe 9000 fromInteger port') S3.s3 s3EndpointOverride _ = S3.s3 -- | Tries to get authentication details and region to perform @@ -90,78 +112,53 @@ getAWSEnv :: (MonadIO m, MonadCatch m) => ExceptT String m AWS.Env getAWSEnv = do region <- discoverRegion endpointURL <- runMaybeT . exceptToMaybeT $ discoverEndpoint - profile <- T.pack . fromMaybe "default" <$> liftIO - (lookupEnv (T.unpack "AWS_PROFILE")) - credentials <- - runExceptT $ (AWS.credentialsFromFile =<< getAWSCredentialsFilePath) `catch` \(e :: IOError) -> ExceptT . return . Left . show $ e - config <- - runExceptT $ (AWS.configFromFile =<< getAWSConfigFilePath) `catch` \(e :: IOError) -> ExceptT . return . Left . show $ e - (auth, _) <- - AWS.catching AWS._MissingEnvError AWS.fromEnv $ \envError -> either - throwError - (\cred -> do - let finalProfile = fromMaybe - profile - (eitherToMaybe $ AWS.sourceProfileOf profile =<< config) - let - authAndRegion = + profile <- T.pack . fromMaybe "default" <$> liftIO (lookupEnv (T.unpack "AWS_PROFILE")) + credentials <- runExceptT $ (AWS.credentialsFromFile =<< getAWSCredentialsFilePath) `catch` \(e :: IOError) -> + ExceptT . return . Left . show $ e + config <- runExceptT $ (AWS.configFromFile =<< getAWSConfigFilePath) `catch` \(e :: IOError) -> + ExceptT . return . Left . show $ e + (auth, _) <- AWS.catching AWS._MissingEnvError AWS.fromEnv $ \envError -> either + throwError + (\_ {- cred -} -> do + let finalProfile = fromMaybe profile (eitherToMaybe $ AWS.sourceProfileOf profile =<< config) + let authAndRegion = (,) - <$> mapLeft - (\e -> - T.unpack envError - ++ ". " - ++ e - ++ " in file ~/.aws/credentials" - ) - (AWS.authFromCredentilas finalProfile =<< credentials) + <$> mapLeft (\e -> T.unpack envError ++ ". " ++ e ++ " in file ~/.aws/credentials") + (AWS.authFromCredentilas finalProfile =<< credentials) <*> pure (pure region) - liftEither authAndRegion - ) - credentials + liftEither authAndRegion + ) + credentials manager <- liftIO (Conduit.newManager Conduit.tlsManagerSettings) ref <- liftIO (newIORef Nothing) - let roleARN = eitherToMaybe $ AWS.roleARNOf profile =<< config - let currentEnv = AWS.Env region - (\_ _ -> pure ()) - (AWS.retryConnectionFailure 3) - mempty - manager - ref - auth + let roleARN = eitherToMaybe $ AWS.roleARNOf profile =<< config + let currentEnv = AWS.Env region (\_ _ -> pure ()) (AWS.retryConnectionFailure 3) mempty manager ref auth case roleARN of Just role -> newEnvFromRole role currentEnv - Nothing -> return - $ AWS.configure (maybe S3.s3 s3EndpointOverride endpointURL) currentEnv + Nothing -> return $ AWS.configure (maybe S3.s3 s3EndpointOverride endpointURL) currentEnv newEnvFromRole :: MonadIO m => T.Text -> AWS.Env -> ExceptT String m AWS.Env newEnvFromRole roleARN currentEnv = do - assumeRoleResult <- - liftIO - $ AWS.runResourceT - . AWS.runAWS currentEnv - $ AWS.send - $ STS.assumeRole roleARN "rome-cache-operation" + assumeRoleResult <- liftIO $ AWS.runResourceT . AWS.runAWS currentEnv $ AWS.send $ STS.assumeRole + roleARN + "rome-cache-operation" let maybeAuth = AWS.Auth <$> assumeRoleResult ^. STS.arrsCredentials case maybeAuth of - Nothing -> - throwError - $ "Could not create AWS Auth from STS response: " - ++ show assumeRoleResult + Nothing -> throwError $ "Could not create AWS Auth from STS response: " ++ show assumeRoleResult Just newAuth -> return $ currentEnv & AWS.envAuth .~ newAuth allCacheKeysMissingMessage :: String -allCacheKeysMissingMessage - = "Error: expected at least one of \"local\", \ +allCacheKeysMissingMessage = + "Error: expected at least one of \"local\", \ \\"s3Bucket\" or \"engine\" in the cache definition of your Romefile." conflictingCachesMessage :: String -conflictingCachesMessage - = "Error: both \"s3Bucket\" and \"engine\" defined. \ +conflictingCachesMessage = "Error: both \"s3Bucket\" and \"engine\" defined. \ \ Rome cannot use both, choose one." conflictingSkipLocalCacheOptionMessage :: String -conflictingSkipLocalCacheOptionMessage - = "Error: only \"local\" defined as cache \ +conflictingSkipLocalCacheOptionMessage = + "Error: only \"local\" defined as cache \ \in your Romefile, but you have asked Rome to skip \ \this cache." @@ -170,30 +167,25 @@ runRomeWithOptions :: RomeOptions -- ^ The `RomeOptions` to run Rome with. -> RomeVersion -> RomeMonad () -runRomeWithOptions (RomeOptions options romefilePath verbose) romeVersion = do - absoluteRomefilePath <- liftIO $ absolutizePath romefilePath +runRomeWithOptions (RomeOptions options rFilePath verbose) romeVersion = do + absoluteRomefilePath <- liftIO $ absolutizePath rFilePath case options of - Utils _ -> - runUtilsCommand options absoluteRomefilePath verbose romeVersion - _ -> - runUDCCommand options absoluteRomefilePath verbose romeVersion + Utils _ -> runUtilsCommand options absoluteRomefilePath verbose romeVersion + _ -> runUDCCommand options absoluteRomefilePath verbose romeVersion -- | Runs one of the Utility commands -runUtilsCommand - :: RomeCommand -> FilePath -> Bool -> RomeVersion -> RomeMonad () -runUtilsCommand command absoluteRomefilePath _ _ = - case command of - Utils _ -> do - romeFileEntries <- getRomefileEntries absoluteRomefilePath - lift $ encodeFile absoluteRomefilePath romeFileEntries - _ -> throwError "Error: Programming Error. Only Utils command supported." +runUtilsCommand :: RomeCommand -> FilePath -> Bool -> RomeVersion -> RomeMonad () +runUtilsCommand command absoluteRomefilePath _ _ = case command of + Utils _ -> do + romeFileEntries <- getRomefileEntries absoluteRomefilePath + lift . lift $ encodeFile absoluteRomefilePath romeFileEntries + _ -> throwError "Error: Programming Error. Only Utils command supported." -- | Runs a command containing a `UDCPayload` runUDCCommand :: RomeCommand -> FilePath -> Bool -> RomeVersion -> RomeMonad () runUDCCommand command absoluteRomefilePath verbose romeVersion = do - cartfileEntries <- getCartfileEntries - `catch` \(_ :: IOError) -> ExceptT . return $ Right [] - romeFile <- getRomefileEntries absoluteRomefilePath + cartfileEntries <- getCartfileEntries `catch` \(_ :: IOError) -> ExceptT . return $ Right [] + romeFile <- getRomefileEntries absoluteRomefilePath let ignoreMapEntries = _ignoreMapEntries romeFile let currentMapEntries = _currentMapEntries romeFile @@ -209,101 +201,65 @@ runUDCCommand command absoluteRomefilePath verbose romeVersion = do Upload (RomeUDCPayload gitRepoNames platforms cachePrefixString skipLocalCache noIgnoreFlag noSkipCurrentFlag concurrentlyFlag) -> sayVersionWarning romeVersion verbose - *> performWithDefaultFlow - uploadArtifacts - ( verbose - , noIgnoreFlag - , skipLocalCache - , noSkipCurrentFlag - , concurrentlyFlag - ) - (repositoryMapEntries, ignoreMapEntries, currentMapEntries) - gitRepoNames - cartfileEntries - cachePrefixString - mS3BucketName - mlCacheDir - mEnginePath - platforms + *> performWithDefaultFlow uploadArtifacts + (verbose, noIgnoreFlag, skipLocalCache, noSkipCurrentFlag, concurrentlyFlag) + (repositoryMapEntries, ignoreMapEntries, currentMapEntries) + gitRepoNames + cartfileEntries + cachePrefixString + mS3BucketName + mlCacheDir + mEnginePath + platforms Download (RomeUDCPayload gitRepoNames platforms cachePrefixString skipLocalCache noIgnoreFlag noSkipCurrentFlag concurrentlyFlag) -> sayVersionWarning romeVersion verbose - *> performWithDefaultFlow - downloadArtifacts - ( verbose - , noIgnoreFlag - , skipLocalCache - , noSkipCurrentFlag - , concurrentlyFlag - ) - (repositoryMapEntries, ignoreMapEntries, currentMapEntries) - gitRepoNames - cartfileEntries - cachePrefixString - mS3BucketName - mlCacheDir - mEnginePath - platforms - - List (RomeListPayload listMode platforms cachePrefixString printFormat noIgnoreFlag noSkipCurrentFlag) - -> do - - currentVersion <- deriveCurrentVersion + *> performWithDefaultFlow downloadArtifacts + (verbose, noIgnoreFlag, skipLocalCache, noSkipCurrentFlag, concurrentlyFlag) + (repositoryMapEntries, ignoreMapEntries, currentMapEntries) + gitRepoNames + cartfileEntries + cachePrefixString + mS3BucketName + mlCacheDir + mEnginePath + platforms + + List (RomeListPayload listMode platforms cachePrefixString printFormat noIgnoreFlag noSkipCurrentFlag) -> do + + currentVersion <- deriveCurrentVersion + + let finalRepositoryMapEntries = if _noIgnore noIgnoreFlag + then repositoryMapEntries + else repositoryMapEntries `filterRomeFileEntriesByPlatforms` ignoreMapEntries + let repositoryMap = toRepositoryMap finalRepositoryMapEntries + let reverseRepositoryMap = toInvertedRepositoryMap finalRepositoryMapEntries + let finalIgnoreNames = if _noIgnore noIgnoreFlag then [] else ignoreFrameworks + let derivedFrameworkVersions = deriveFrameworkNamesAndVersion repositoryMap cartfileEntries + let frameworkVersions = derivedFrameworkVersions `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames + let cachePrefix = CachePrefix cachePrefixString + let filteredCurrentMapEntries = currentMapEntries `filterRomeFileEntriesByPlatforms` ignoreMapEntries + let currentFrameworks = concatMap (snd . romeFileEntryToTuple) filteredCurrentMapEntries + let currentFrameworkVersions = map (flip FrameworkVersion currentVersion) currentFrameworks + let currentInvertedMap = toInvertedRepositoryMap filteredCurrentMapEntries - let - finalRepositoryMapEntries = - if _noIgnore noIgnoreFlag - then - repositoryMapEntries - else - repositoryMapEntries - `filterRomeFileEntriesByPlatforms` ignoreMapEntries - let repositoryMap = toRepositoryMap finalRepositoryMapEntries - let reverseRepositoryMap = - toInvertedRepositoryMap finalRepositoryMapEntries - let finalIgnoreNames = - if _noIgnore noIgnoreFlag then [] else ignoreFrameworks - let derivedFrameworkVersions = - deriveFrameworkNamesAndVersion repositoryMap cartfileEntries - let frameworkVersions = - derivedFrameworkVersions - `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames - let cachePrefix = CachePrefix cachePrefixString - let filteredCurrentMapEntries = - currentMapEntries - `filterRomeFileEntriesByPlatforms` ignoreMapEntries - let currentFrameworks = - concatMap (snd . romeFileEntryToTuple) filteredCurrentMapEntries - let currentFrameworkVersions = - map (flip FrameworkVersion currentVersion) currentFrameworks - let currentInvertedMap = - toInvertedRepositoryMap filteredCurrentMapEntries - - runReaderT - (listArtifacts - mS3BucketName - mlCacheDir - mEnginePath - listMode - (reverseRepositoryMap <> if _noSkipCurrent noSkipCurrentFlag - then currentInvertedMap - else M.empty - ) - (frameworkVersions <> if _noSkipCurrent noSkipCurrentFlag - then - (currentFrameworkVersions - `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames - ) - else [] - ) - platforms - printFormat + runReaderT + (listArtifacts + mS3BucketName + mlCacheDir + mEnginePath + listMode + (reverseRepositoryMap <> if _noSkipCurrent noSkipCurrentFlag then currentInvertedMap else M.empty) + (frameworkVersions <> if _noSkipCurrent noSkipCurrentFlag + then (currentFrameworkVersions `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames) + else [] ) - (cachePrefix, SkipLocalCacheFlag False, verbose) + platforms + printFormat + ) + (cachePrefix, SkipLocalCacheFlag False, verbose) - _ -> - throwError - "Error: Programming Error. Only List, Download, Upload commands are supported." + _ -> throwError "Error: Programming Error. Only List, Download, Upload commands are supported." where sayVersionWarning vers verb = runMaybeT $ exceptToMaybeT $ do let sayFunc = if verb then sayLnWithTime else sayLn @@ -318,28 +274,28 @@ runUDCCommand command absoluteRomefilePath verbose romeVersion = do <> romeVersionToString vers <> noColorControlSequence -type FlowFunction = Maybe S3.BucketName -- ^ Just an S3 Bucket name or Nothing +type FlowFunction + = Maybe S3.BucketName -- ^ Just an S3 Bucket name or Nothing -> Maybe FilePath -- ^ Just the path to the local cache or Nothing -> Maybe FilePath -- ^ Just the path to the engine or Nothing -> InvertedRepositoryMap -- ^ The map used to resolve `FrameworkName`s to `ProjectName`s. -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` from which to derive Frameworks, dSYMs and .version files -> [TargetPlatform] -- ^ A list of `TargetPlatform` to restrict this operation to. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) RomeMonad () + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) RomeMonad () -- | Convenience function wrapping the regular sequence of events -- | in case of Download or Upload commands performWithDefaultFlow :: FlowFunction - -> ( Bool {- verbose -} - , NoIgnoreFlag {- noIgnoreFlag -} - , SkipLocalCacheFlag {- skipLocalCache -} - , NoSkipCurrentFlag {- noSkipCurrentFlag -} - , ConcurrentlyFlag - ) {- concurrentlyFlag -} - -> ([RomefileEntry] {- repositoryMapEntries -} - , [RomefileEntry] {- ignoreMapEntries -} - , [RomefileEntry]) {- currentMapEntries -} + -> (Bool {- verbose -} + , NoIgnoreFlag {- noIgnoreFlag -} + , SkipLocalCacheFlag {- skipLocalCache -} + , NoSkipCurrentFlag {- noSkipCurrentFlag -} + , ConcurrentlyFlag) {- concurrentlyFlag -} + -> ([ {- repositoryMapEntries -} + RomefileEntry], [ {- ignoreMapEntries -} + RomefileEntry], [RomefileEntry]) {- currentMapEntries -} -> [ProjectName] -- gitRepoNames -> [CartfileEntry] -- cartfileEntries -> String -- cachePrefixString @@ -351,87 +307,61 @@ performWithDefaultFlow performWithDefaultFlow flowFunc (verbose, noIgnoreFlag, skipLocalCache, noSkipCurrentFlag, concurrentlyFlag) (repositoryMapEntries, ignoreMapEntries, currentMapEntries) gitRepoNames cartfileEntries cachePrefixString mS3BucketName mlCacheDir mEnginePath platforms = do + uuid <- ask let ignoreFrameworks = concatMap _frameworks ignoreMapEntries - let - finalRepositoryMapEntries = - if _noIgnore noIgnoreFlag - then - repositoryMapEntries - else - repositoryMapEntries - `filterRomeFileEntriesByPlatforms` ignoreMapEntries - let repositoryMap = toRepositoryMap finalRepositoryMapEntries - let reverseRepositoryMap = - toInvertedRepositoryMap finalRepositoryMapEntries - let finalIgnoreNames = - if _noIgnore noIgnoreFlag then [] else ignoreFrameworks + let finalRepositoryMapEntries = if _noIgnore noIgnoreFlag + then repositoryMapEntries + else repositoryMapEntries `filterRomeFileEntriesByPlatforms` ignoreMapEntries + let repositoryMap = toRepositoryMap finalRepositoryMapEntries + let reverseRepositoryMap = toInvertedRepositoryMap finalRepositoryMapEntries + let finalIgnoreNames = if _noIgnore noIgnoreFlag then [] else ignoreFrameworks if null gitRepoNames then - let - derivedFrameworkVersions = - deriveFrameworkNamesAndVersion repositoryMap cartfileEntries - cachePrefix = CachePrefix cachePrefixString - in - do - runReaderT - (flowFunc - mS3BucketName - mlCacheDir - mEnginePath - reverseRepositoryMap - (derivedFrameworkVersions - `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames - ) - platforms - ) - (cachePrefix, skipLocalCache, concurrentlyFlag, verbose) - when (_noSkipCurrent noSkipCurrentFlag) $ do - currentVersion <- deriveCurrentVersion - let filteredCurrentMapEntries = - currentMapEntries - `filterRomeFileEntriesByPlatforms` ignoreMapEntries - let currentFrameworks = concatMap (snd . romeFileEntryToTuple) - filteredCurrentMapEntries - let currentFrameworkVersions = map - (flip FrameworkVersion currentVersion) - currentFrameworks - let currentInvertedMap = - toInvertedRepositoryMap filteredCurrentMapEntries + let derivedFrameworkVersions = deriveFrameworkNamesAndVersion repositoryMap cartfileEntries + cachePrefix = CachePrefix cachePrefixString + in do runReaderT - (flowFunc - mS3BucketName - mlCacheDir - mEnginePath - currentInvertedMap - (currentFrameworkVersions - `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames - ) - platforms + (flowFunc mS3BucketName + mlCacheDir + mEnginePath + reverseRepositoryMap + (derivedFrameworkVersions `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames) + platforms ) - (cachePrefix, skipLocalCache, concurrentlyFlag, verbose) + (cachePrefix, skipLocalCache, concurrentlyFlag, verbose, uuid) + when (_noSkipCurrent noSkipCurrentFlag) $ do + currentVersion <- deriveCurrentVersion + let filteredCurrentMapEntries = currentMapEntries `filterRomeFileEntriesByPlatforms` ignoreMapEntries + let currentFrameworks = concatMap (snd . romeFileEntryToTuple) filteredCurrentMapEntries + let currentFrameworkVersions = map (flip FrameworkVersion currentVersion) currentFrameworks + let currentInvertedMap = toInvertedRepositoryMap filteredCurrentMapEntries + runReaderT + (flowFunc mS3BucketName + mlCacheDir + mEnginePath + currentInvertedMap + (currentFrameworkVersions `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames) + platforms + ) + (cachePrefix, skipLocalCache, concurrentlyFlag, verbose, uuid) else do currentVersion <- deriveCurrentVersion let filteredCurrentMapEntries = - ( (\e -> _projectName e `elem` gitRepoNames) - `filter` currentMapEntries - ) -- Make sure the command is only run for the mentioned projects + ((\e -> _projectName e `elem` gitRepoNames) `filter` currentMapEntries) -- Make sure the command is only run for the mentioned projects `filterRomeFileEntriesByPlatforms` ignoreMapEntries - let currentFrameworks = - concatMap (snd . romeFileEntryToTuple) filteredCurrentMapEntries - let currentFrameworkVersions = - map (flip FrameworkVersion currentVersion) currentFrameworks - let - derivedFrameworkVersions = deriveFrameworkNamesAndVersion - repositoryMap - (filterCartfileEntriesByGitRepoNames gitRepoNames cartfileEntries) - frameworkVersions = - (derivedFrameworkVersions <> currentFrameworkVersions) - `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames - cachePrefix = CachePrefix cachePrefixString - currentInvertedMap = - toInvertedRepositoryMap filteredCurrentMapEntries + let currentFrameworks = concatMap (snd . romeFileEntryToTuple) filteredCurrentMapEntries + let currentFrameworks = concatMap (snd . romeFileEntryToTuple) filteredCurrentMapEntries + let currentFrameworkVersions = map (flip FrameworkVersion currentVersion) currentFrameworks + let derivedFrameworkVersions = deriveFrameworkNamesAndVersion + repositoryMap + (filterCartfileEntriesByGitRepoNames gitRepoNames cartfileEntries) + frameworkVersions = + (derivedFrameworkVersions <> currentFrameworkVersions) + `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames + cachePrefix = CachePrefix cachePrefixString + currentInvertedMap = toInvertedRepositoryMap filteredCurrentMapEntries runReaderT (flowFunc mS3BucketName mlCacheDir @@ -440,7 +370,7 @@ performWithDefaultFlow flowFunc (verbose, noIgnoreFlag, skipLocalCache, noSkipCu frameworkVersions platforms ) - (cachePrefix, skipLocalCache, concurrentlyFlag, verbose) + (cachePrefix, skipLocalCache, concurrentlyFlag, verbose, uuid) -- | Lists Frameworks in the caches. listArtifacts @@ -452,28 +382,22 @@ listArtifacts -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` from which to derive Frameworks -> [TargetPlatform] -- ^ A list of `TargetPlatform` to limit the operation to. -> PrintFormat -- ^ A format of the string result: text or JSON. - -> ReaderT - (CachePrefix, SkipLocalCacheFlag, Bool) - RomeMonad - () -listArtifacts mS3BucketName mlCacheDir mEnginePath listMode reverseRepositoryMap frameworkVersions platforms format - = do + -> ReaderT (CachePrefix, SkipLocalCacheFlag, Bool) RomeMonad () +listArtifacts mS3BucketName mlCacheDir mEnginePath listMode reverseRepositoryMap frameworkVersions platforms format = + do (_, _, verbose) <- ask let sayFunc = if verbose then sayLnWithTime else sayLn - repoAvailabilities <- getProjectAvailabilityFromCaches - mS3BucketName - mlCacheDir - mEnginePath - reverseRepositoryMap - frameworkVersions - platforms + repoAvailabilities <- getProjectAvailabilityFromCaches mS3BucketName + mlCacheDir + mEnginePath + reverseRepositoryMap + frameworkVersions + platforms if format == Text then mapM_ sayFunc $ repoLines repoAvailabilities - else sayFunc $ toJSONStr $ ReposJSON - (fmap formattedRepoAvailabilityJSON repoAvailabilities) + else sayFunc $ toJSONStr $ ReposJSON (fmap formattedRepoAvailabilityJSON repoAvailabilities) where - repoLines repoAvailabilities = filter (not . null) - $ fmap (formattedRepoAvailability listMode) repoAvailabilities + repoLines repoAvailabilities = filter (not . null) $ fmap (formattedRepoAvailability listMode) repoAvailabilities @@ -485,55 +409,28 @@ getProjectAvailabilityFromCaches -> InvertedRepositoryMap -- ^ The map used to resolve `FrameworkName`s to `ProjectName`s. -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` from which to derive Frameworks, dSYMs and .version files -> [TargetPlatform] -- ^ A list of `TargetPlatform`s to limit the operation to. - -> ReaderT - (CachePrefix, SkipLocalCacheFlag, Bool) - RomeMonad - [ProjectAvailability] -getProjectAvailabilityFromCaches (Just s3BucketName) _ Nothing reverseRepositoryMap frameworkVersions platforms - = do - env <- lift getAWSEnv - (cachePrefix, _, verbose) <- ask - let readerEnv = (env, cachePrefix, verbose) - availabilities <- liftIO $ runReaderT - (probeS3ForFrameworks s3BucketName - reverseRepositoryMap - frameworkVersions - platforms - ) - readerEnv - return $ getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities - reverseRepositoryMap - availabilities + -> ReaderT (CachePrefix, SkipLocalCacheFlag, Bool) RomeMonad [ProjectAvailability] +getProjectAvailabilityFromCaches (Just s3BucketName) _ Nothing reverseRepositoryMap frameworkVersions platforms = do + env <- lift getAWSEnv + (cachePrefix, _, verbose) <- ask + let readerEnv = (env, cachePrefix, verbose) + availabilities <- liftIO + $ runReaderT (probeS3ForFrameworks s3BucketName reverseRepositoryMap frameworkVersions platforms) readerEnv + return $ getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities reverseRepositoryMap availabilities -getProjectAvailabilityFromCaches Nothing (Just lCacheDir) Nothing reverseRepositoryMap frameworkVersions platforms - = do - (cachePrefix, SkipLocalCacheFlag skipLocalCache, _) <- ask - when skipLocalCache $ throwError conflictingSkipLocalCacheOptionMessage - - availabilities <- probeLocalCacheForFrameworks lCacheDir - cachePrefix - reverseRepositoryMap - frameworkVersions - platforms - return $ getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities - reverseRepositoryMap - availabilities - -getProjectAvailabilityFromCaches Nothing _ (Just ePath) reverseRepositoryMap frameworkVersions platforms - = do - (cachePrefix, _, _) <- ask - availabilities <- probeEngineForFrameworks ePath - cachePrefix - reverseRepositoryMap - frameworkVersions - platforms - return $ getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities - reverseRepositoryMap - availabilities -getProjectAvailabilityFromCaches (Just _) _ (Just _) _ _ _ = - throwError conflictingCachesMessage -getProjectAvailabilityFromCaches Nothing Nothing Nothing _ _ _ = - throwError allCacheKeysMissingMessage +getProjectAvailabilityFromCaches Nothing (Just lCacheDir) Nothing reverseRepositoryMap frameworkVersions platforms = do + (cachePrefix, SkipLocalCacheFlag skipLocalCache, _) <- ask + when skipLocalCache $ throwError conflictingSkipLocalCacheOptionMessage + + availabilities <- probeLocalCacheForFrameworks lCacheDir cachePrefix reverseRepositoryMap frameworkVersions platforms + return $ getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities reverseRepositoryMap availabilities + +getProjectAvailabilityFromCaches Nothing _ (Just ePath) reverseRepositoryMap frameworkVersions platforms = do + (cachePrefix, _, _) <- ask + availabilities <- probeEngineForFrameworks ePath cachePrefix reverseRepositoryMap frameworkVersions platforms + return $ getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities reverseRepositoryMap availabilities +getProjectAvailabilityFromCaches (Just _) _ (Just _) _ _ _ = throwError conflictingCachesMessage +getProjectAvailabilityFromCaches Nothing Nothing Nothing _ _ _ = throwError allCacheKeysMissingMessage @@ -546,103 +443,77 @@ downloadArtifacts -> InvertedRepositoryMap -- ^ The map used to resolve `FrameworkName`s to `ProjectName`s. -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` from which to derive Frameworks, dSYMs and .version files -> [TargetPlatform] -- ^ A list of `TargetPlatform`s to limit the operation to. - -> ReaderT - ( CachePrefix - , SkipLocalCacheFlag - , ConcurrentlyFlag - , Bool - ) - RomeMonad - () -downloadArtifacts mS3BucketName mlCacheDir mEnginePath reverseRepositoryMap frameworkVersions platforms - = do - (cachePrefix, skipLocalCacheFlag@(SkipLocalCacheFlag skipLocalCache), concurrentlyFlag@(ConcurrentlyFlag performConcurrently), verbose) <- - ask - - let sayFunc :: MonadIO m => String -> m () - sayFunc = if verbose then sayLnWithTime else sayLn - - case (mS3BucketName, mlCacheDir, mEnginePath) of - - (Just s3BucketName, lCacheDir, Nothing) -> do - env <- lift getAWSEnv - let uploadDownloadEnv = - (env, cachePrefix, skipLocalCacheFlag, concurrentlyFlag, verbose) - let action1 = runReaderT - (downloadFrameworksAndArtifactsFromCaches s3BucketName - lCacheDir - reverseRepositoryMap - frameworkVersions - platforms - ) - uploadDownloadEnv - let action2 = runReaderT - (downloadVersionFilesFromCaches s3BucketName - lCacheDir - gitRepoNamesAndVersions - ) - uploadDownloadEnv - if performConcurrently - then liftIO $ concurrently_ action1 action2 - else liftIO $ action1 >> action2 + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) RomeMonad () +downloadArtifacts mS3BucketName mlCacheDir mEnginePath reverseRepositoryMap frameworkVersions platforms = do + (cachePrefix, skipLocalCacheFlag@(SkipLocalCacheFlag skipLocalCache), concurrentlyFlag@(ConcurrentlyFlag performConcurrently), verbose, uuid) <- + ask - (Nothing, Just lCacheDir, Nothing) -> do + let sayFunc :: MonadIO m => String -> m () + sayFunc = if verbose then sayLnWithTime else sayLn - let readerEnv = (cachePrefix, verbose) - when skipLocalCache $ throwError conflictingSkipLocalCacheOptionMessage + case (mS3BucketName, mlCacheDir, mEnginePath) of - liftIO $ do - runReaderT - (do - errors <- - mapM runExceptT - $ getAndUnzipFrameworksAndArtifactsFromLocalCache - lCacheDir - reverseRepositoryMap - frameworkVersions - platforms - mapM_ (whenLeft sayFunc) errors - ) - readerEnv - runReaderT - (do - errors <- mapM runExceptT $ getAndSaveVersionFilesFromLocalCache - lCacheDir - gitRepoNamesAndVersions - mapM_ (whenLeft sayFunc) errors + (Just s3BucketName, lCacheDir, Nothing) -> do + env <- lift getAWSEnv + let uploadDownloadEnv = (env, cachePrefix, skipLocalCacheFlag, concurrentlyFlag, verbose, uuid) + let action1 = runReaderT + (downloadFrameworksAndArtifactsFromCaches s3BucketName + lCacheDir + reverseRepositoryMap + frameworkVersions + platforms ) - readerEnv - -- Use engine - (Nothing, lCacheDir, Just ePath) -> do - let engineEnv = (cachePrefix, skipLocalCacheFlag, concurrentlyFlag, verbose) - let action1 = runReaderT - (downloadFrameworksAndArtifactsWithEngine ePath - lCacheDir - reverseRepositoryMap - frameworkVersions - platforms - ) - engineEnv - let action2 = runReaderT - (downloadVersionFilesWithEngine ePath - lCacheDir - gitRepoNamesAndVersions - ) - engineEnv - if performConcurrently - then liftIO $ concurrently_ action1 action2 - else liftIO $ action1 >> action2 - -- Misconfigured - (Nothing, Nothing, Nothing) -> throwError allCacheKeysMissingMessage - -- Misconfigured - (Just s3BucketName, _, Just ePath) -> throwError conflictingCachesMessage + uploadDownloadEnv + let action2 = runReaderT (downloadVersionFilesFromCaches s3BucketName lCacheDir gitRepoNamesAndVersions) + uploadDownloadEnv + if performConcurrently then liftIO $ concurrently_ action1 action2 else liftIO $ action1 >> action2 + + (Nothing, Just lCacheDir, Nothing) -> do + + let readerEnv = (cachePrefix, verbose, uuid) + when skipLocalCache $ throwError conflictingSkipLocalCacheOptionMessage + + liftIO $ do + runReaderT + (do + errors <- mapM runExceptT $ getAndUnzipFrameworksAndArtifactsFromLocalCache lCacheDir + reverseRepositoryMap + frameworkVersions + platforms + mapM_ (whenLeft sayFunc) errors + ) + readerEnv + runReaderT + (do + errors <- mapM runExceptT $ getAndSaveVersionFilesFromLocalCache lCacheDir gitRepoNamesAndVersions + mapM_ (whenLeft sayFunc) errors + ) + readerEnv + -- Use engine + (Nothing, lCacheDir, Just ePath) -> do + tmpDir <- liftIO $ tmpDirWithUUID uuid + let engineEnv = (cachePrefix, skipLocalCacheFlag, concurrentlyFlag, verbose, uuid) + let action1 = runReaderT + (downloadFrameworksAndArtifactsWithEngine ePath lCacheDir reverseRepositoryMap frameworkVersions platforms tmpDir) + engineEnv + 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 + + -- Misconfigured + (Nothing , Nothing, Nothing ) -> throwError allCacheKeysMissingMessage + -- Misconfigured + (Just _, _ , Just _) -> throwError conflictingCachesMessage where gitRepoNamesAndVersions :: [ProjectNameAndVersion] - gitRepoNamesAndVersions = repoNamesAndVersionForFrameworkVersions - reverseRepositoryMap - frameworkVersions - + gitRepoNamesAndVersions = repoNamesAndVersionForFrameworkVersions reverseRepositoryMap frameworkVersions + + tmpDirWithUUID :: UUID.UUID -> IO FilePath + tmpDirWithUUID uuid = do + dir <- getTemporaryDirectory + return $ dir "Rome" UUID.toString uuid -- | Uploads Frameworks and relative dSYMs together with .version files to caches @@ -653,92 +524,49 @@ uploadArtifacts -> InvertedRepositoryMap -- ^ The map used to resolve `FrameworkName`s to `ProjectName`s. -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` from which to derive Frameworks, dSYMs and .version files -> [TargetPlatform] -- ^ A list of `TargetPlatform` to restrict this operation to. - -> ReaderT - ( CachePrefix - , SkipLocalCacheFlag - , ConcurrentlyFlag - , Bool - ) - RomeMonad - () -uploadArtifacts mS3BucketName mlCacheDir mEnginePath reverseRepositoryMap frameworkVersions platforms - = do - (cachePrefix, skipLocalCacheFlag@(SkipLocalCacheFlag skipLocalCache), concurrentlyFlag@(ConcurrentlyFlag performConcurrently), verbose) <- - ask - case (mS3BucketName, mlCacheDir, mEnginePath) of - -- S3 Cache, but no engine - (Just s3BucketName, lCacheDir, Nothing) -> do - awsEnv <- lift getAWSEnv - let uploadDownloadEnv = - ( awsEnv - , cachePrefix - , skipLocalCacheFlag - , concurrentlyFlag - , verbose - ) - let action1 = runReaderT - (uploadFrameworksAndArtifactsToCaches s3BucketName - lCacheDir - reverseRepositoryMap - frameworkVersions - platforms - ) - uploadDownloadEnv - let action2 = runReaderT - (uploadVersionFilesToCaches s3BucketName - lCacheDir - gitRepoNamesAndVersions - ) - uploadDownloadEnv - if performConcurrently - then liftIO $ concurrently_ action1 action2 - else liftIO $ action1 >> action2 - -- No remotes, just local - (Nothing, Just lCacheDir, Nothing) -> do - let readerEnv = (cachePrefix, verbose) - when skipLocalCache $ throwError conflictingSkipLocalCacheOptionMessage - liftIO - $ runReaderT - (saveFrameworksAndArtifactsToLocalCache lCacheDir - reverseRepositoryMap - frameworkVersions - platforms - ) - readerEnv - >> runReaderT - (saveVersionFilesToLocalCache lCacheDir gitRepoNamesAndVersions) - readerEnv - -- Engine, maybe Cache - (Nothing, lCacheDir, Just enginePath) -> do - let engineEnv = - ( cachePrefix - , skipLocalCacheFlag - , concurrentlyFlag - , verbose - ) - let action1 = runReaderT - (uploadFrameworksAndArtifactsToEngine enginePath - lCacheDir - reverseRepositoryMap - frameworkVersions - platforms - ) - engineEnv - let action2 = runReaderT - (uploadVersionFilesToEngine enginePath - lCacheDir - gitRepoNamesAndVersions - ) - engineEnv - if performConcurrently - then liftIO $ concurrently_ action1 action2 - else liftIO $ action1 >> action2 - (Nothing, Nothing, Nothing) -> throwError allCacheKeysMissingMessage + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) RomeMonad () +uploadArtifacts mS3BucketName mlCacheDir mEnginePath reverseRepositoryMap frameworkVersions platforms = do + (cachePrefix, skipLocalCacheFlag@(SkipLocalCacheFlag skipLocalCache), concurrentlyFlag@(ConcurrentlyFlag performConcurrently), verbose, uuid) <- + ask + case (mS3BucketName, mlCacheDir, mEnginePath) of + -- S3 Cache, but no engine + (Just s3BucketName, lCacheDir, Nothing) -> do + awsEnv <- lift getAWSEnv + let uploadDownloadEnv = (awsEnv, cachePrefix, skipLocalCacheFlag, concurrentlyFlag, verbose, uuid) + let action1 = runReaderT + (uploadFrameworksAndArtifactsToCaches s3BucketName + lCacheDir + reverseRepositoryMap + frameworkVersions + platforms + ) + uploadDownloadEnv + let action2 = + runReaderT (uploadVersionFilesToCaches s3BucketName lCacheDir gitRepoNamesAndVersions) uploadDownloadEnv + if performConcurrently then liftIO $ concurrently_ action1 action2 else liftIO $ action1 >> action2 + -- No remotes, just local + (Nothing, Just lCacheDir, Nothing) -> do + let readerEnv = (cachePrefix, verbose) + when skipLocalCache $ throwError conflictingSkipLocalCacheOptionMessage + liftIO + $ runReaderT + (saveFrameworksAndArtifactsToLocalCache lCacheDir reverseRepositoryMap frameworkVersions platforms) + readerEnv + >> runReaderT (saveVersionFilesToLocalCache lCacheDir gitRepoNamesAndVersions) readerEnv + -- Engine, maybe Cache + (Nothing, lCacheDir, Just ePath) -> do + let engineEnv = (cachePrefix, skipLocalCacheFlag, concurrentlyFlag, verbose, uuid) + let action1 = runReaderT + (uploadFrameworksAndArtifactsToEngine ePath lCacheDir reverseRepositoryMap frameworkVersions platforms) + engineEnv + 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 + where gitRepoNamesAndVersions :: [ProjectNameAndVersion] - gitRepoNamesAndVersions = repoNamesAndVersionForFrameworkVersions - reverseRepositoryMap - frameworkVersions + gitRepoNamesAndVersions = repoNamesAndVersionForFrameworkVersions reverseRepositoryMap frameworkVersions -- | Uploads a lest of .version files to the engine. @@ -746,9 +574,8 @@ uploadVersionFilesToEngine :: FilePath -- ^ The engine definition. -> Maybe FilePath -- ^ Just the path to the local cache or Nothing. -> [ProjectNameAndVersion] -- ^ A list of `ProjectName` and `Version` information. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) IO () -uploadVersionFilesToEngine enginePath mlCacheDir = - mapM_ (uploadVersionFileToEngine enginePath mlCacheDir) + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) IO () +uploadVersionFilesToEngine ePath mlCacheDir = mapM_ (uploadVersionFileToEngine ePath mlCacheDir) -- | Uploads a .version file to the engine. @@ -756,9 +583,9 @@ uploadVersionFileToEngine :: FilePath -- ^ The engine definition. -> Maybe FilePath -- ^ Just the path to the local cache or Nothing. -> ProjectNameAndVersion -- ^ The information used to derive the name and path for the .version file. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) IO () -uploadVersionFileToEngine enginePath mlCacheDir projectNameAndVersion = do - (cachePrefix, SkipLocalCacheFlag skipLocalCache, _, verbose) <- ask + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) IO () +uploadVersionFileToEngine ePath mlCacheDir projectNameAndVersion = do + (cachePrefix, SkipLocalCacheFlag skipLocalCache, _, verbose, _) <- ask versionFileExists <- liftIO $ doesFileExist versionFileLocalPath @@ -772,15 +599,11 @@ uploadVersionFileToEngine enginePath mlCacheDir projectNameAndVersion = do <*> Just versionFileContent <*> Just projectNameAndVersion <*> Just verbose - liftIO $ runReaderT - (uploadVersionFileToEngine' enginePath - versionFileContent - projectNameAndVersion - ) - (cachePrefix, verbose) + liftIO $ runReaderT (uploadVersionFileToEngine' ePath versionFileContent projectNameAndVersion) + (cachePrefix, verbose) where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileLocalPath = carthageBuildDirectory versionFileName -- | Uploads a lest of .version files to the caches. @@ -789,8 +612,7 @@ uploadVersionFilesToCaches -> Maybe FilePath -- ^ Just the path to the local cache or Nothing. -> [ProjectNameAndVersion] -- ^ A list of `ProjectName` and `Version` information. -> ReaderT UploadDownloadCmdEnv IO () -uploadVersionFilesToCaches s3Bucket mlCacheDir = - mapM_ (uploadVersionFileToCaches s3Bucket mlCacheDir) +uploadVersionFilesToCaches s3Bucket mlCacheDir = mapM_ (uploadVersionFileToCaches s3Bucket mlCacheDir) @@ -801,7 +623,7 @@ uploadVersionFileToCaches -> ProjectNameAndVersion -- ^ The information used to derive the name and path for the .version file. -> ReaderT UploadDownloadCmdEnv IO () uploadVersionFileToCaches s3BucketName mlCacheDir projectNameAndVersion = do - (env, cachePrefix, SkipLocalCacheFlag skipLocalCache, _, verbose) <- ask + (env, cachePrefix, SkipLocalCacheFlag skipLocalCache, _, verbose, _) <- ask versionFileExists <- liftIO $ doesFileExist versionFileLocalPath @@ -815,15 +637,11 @@ uploadVersionFileToCaches s3BucketName mlCacheDir projectNameAndVersion = do <*> Just versionFileContent <*> Just projectNameAndVersion <*> Just verbose - liftIO $ runReaderT - (uploadVersionFileToS3 s3BucketName - versionFileContent - projectNameAndVersion - ) - (env, cachePrefix, verbose) + liftIO $ runReaderT (uploadVersionFileToS3 s3BucketName versionFileContent projectNameAndVersion) + (env, cachePrefix, verbose) where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileLocalPath = carthageBuildDirectory versionFileName @@ -836,23 +654,13 @@ uploadFrameworksAndArtifactsToCaches -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` identifying the Frameworks and dSYMs. -> [TargetPlatform] -- ^ A list of `TargetPlatform`s restricting the scope of this action. -> ReaderT UploadDownloadCmdEnv IO () -uploadFrameworksAndArtifactsToCaches s3BucketName mlCacheDir reverseRomeMap fvs platforms - = do - (_, _, _, ConcurrentlyFlag performConcurrently, _) <- ask - if performConcurrently - then mapConcurrently_ uploadConcurrently fvs - else mapM_ (sequence . upload) platforms +uploadFrameworksAndArtifactsToCaches s3BucketName mlCacheDir reverseRomeMap fvs platforms = do + (_, _, _, ConcurrentlyFlag performConcurrently, _, _) <- ask + if performConcurrently then mapConcurrently_ uploadConcurrently fvs else mapM_ (sequence . upload) platforms where - uploadConcurrently f = mapConcurrently - (uploadFrameworkAndArtifactsToCaches s3BucketName - mlCacheDir - reverseRomeMap - f - ) - platforms - upload = mapM - (uploadFrameworkAndArtifactsToCaches s3BucketName mlCacheDir reverseRomeMap) - fvs + uploadConcurrently f = + mapConcurrently (uploadFrameworkAndArtifactsToCaches s3BucketName mlCacheDir reverseRomeMap f) platforms + upload = mapM (uploadFrameworkAndArtifactsToCaches s3BucketName mlCacheDir reverseRomeMap) fvs @@ -866,7 +674,7 @@ uploadFrameworkAndArtifactsToCaches -> ReaderT UploadDownloadCmdEnv IO () uploadFrameworkAndArtifactsToCaches s3BucketName mlCacheDir reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ _) _) platform = do - (env, cachePrefix, s@(SkipLocalCacheFlag skipLocalCache), _, verbose) <- ask + (env, cachePrefix, s@(SkipLocalCacheFlag skipLocalCache), _, verbose, _) <- ask let uploadDownloadEnv = (env, cachePrefix, verbose) @@ -883,14 +691,8 @@ uploadFrameworkAndArtifactsToCaches s3BucketName mlCacheDir reverseRomeMap fVers <*> Just platform ) <*> Just (cachePrefix, s, verbose) - liftIO $ runReaderT - (uploadFrameworkToS3 frameworkArchive - s3BucketName - reverseRomeMap - fVersion - platform - ) - uploadDownloadEnv + liftIO $ runReaderT (uploadFrameworkToS3 frameworkArchive s3BucketName reverseRomeMap fVersion platform) + uploadDownloadEnv void . runExceptT $ do dSYMArchive <- createZipArchive dSYMdirectory verbose @@ -905,58 +707,37 @@ uploadFrameworkAndArtifactsToCaches s3BucketName mlCacheDir reverseRomeMap fVers <*> Just platform ) <*> Just (cachePrefix, s, verbose) - liftIO $ runReaderT - (uploadDsymToS3 dSYMArchive - s3BucketName - reverseRomeMap - fVersion - platform - ) - uploadDownloadEnv + liftIO $ runReaderT (uploadDsymToS3 dSYMArchive s3BucketName reverseRomeMap fVersion platform) uploadDownloadEnv void . runExceptT $ do dwarfUUIDs <- dwarfUUIDsFrom (frameworkDirectory fwn) - maybeUUIDsArchives <- liftIO $ forM dwarfUUIDs $ \dwarfUUID -> - runMaybeT $ do - dwarfArchive <- exceptToMaybeT - $ createZipArchive (bcSymbolMapPath dwarfUUID) verbose - return (dwarfUUID, dwarfArchive) + maybeUUIDsArchives <- liftIO $ forM dwarfUUIDs $ \dwarfUUID -> runMaybeT $ do + dwarfArchive <- exceptToMaybeT $ createZipArchive (bcSymbolMapPath dwarfUUID) verbose + return (dwarfUUID, dwarfArchive) + + unless skipLocalCache $ forM_ maybeUUIDsArchives $ mapM $ \(dwarfUUID, dwarfArchive) -> + maybe (return ()) liftIO + $ runReaderT + <$> ( saveBcsymbolmapToLocalCache + <$> mlCacheDir + <*> Just dwarfUUID + <*> Just dwarfArchive + <*> Just reverseRomeMap + <*> Just fVersion + <*> Just platform + ) + <*> Just (cachePrefix, s, verbose) - unless skipLocalCache - $ forM_ maybeUUIDsArchives - $ mapM - $ \(dwarfUUID, dwarfArchive) -> - maybe (return ()) liftIO - $ runReaderT - <$> ( saveBcsymbolmapToLocalCache - <$> mlCacheDir - <*> Just dwarfUUID - <*> Just dwarfArchive - <*> Just reverseRomeMap - <*> Just fVersion - <*> Just platform - ) - <*> Just (cachePrefix, s, verbose) - - forM_ maybeUUIDsArchives $ mapM $ \(dwarfUUID, dwarfArchive) -> - liftIO $ runReaderT - (uploadBcsymbolmapToS3 dwarfUUID - dwarfArchive - s3BucketName - reverseRomeMap - fVersion - platform - ) - uploadDownloadEnv + forM_ maybeUUIDsArchives $ mapM $ \(dwarfUUID, dwarfArchive) -> liftIO $ runReaderT + (uploadBcsymbolmapToS3 dwarfUUID dwarfArchive s3BucketName reverseRomeMap fVersion platform) + uploadDownloadEnv where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - frameworkDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension - dSYMNameWithDSYMExtension = frameworkNameWithFrameworkExtension <> ".dSYM" - dSYMdirectory = platformBuildDirectory dSYMNameWithDSYMExtension + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + frameworkDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension + dSYMNameWithDSYMExtension = frameworkNameWithFrameworkExtension <> ".dSYM" + dSYMdirectory = platformBuildDirectory dSYMNameWithDSYMExtension bcSymbolMapPath d = platformBuildDirectory bcsymbolmapNameFrom d @@ -969,11 +750,8 @@ saveFrameworksAndArtifactsToLocalCache -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` identifying Frameworks and dSYMs -> [TargetPlatform] -- ^ A list of `TargetPlatform` restricting the scope of this action. -> ReaderT (CachePrefix, Bool) m () -saveFrameworksAndArtifactsToLocalCache lCacheDir reverseRomeMap fvs = mapM_ - (sequence . save) - where - save = - mapM (saveFrameworkAndArtifactsToLocalCache lCacheDir reverseRomeMap) fvs +saveFrameworksAndArtifactsToLocalCache lCacheDir reverseRomeMap fvs = mapM_ (sequence . save) + where save = mapM (saveFrameworkAndArtifactsToLocalCache lCacheDir reverseRomeMap) fvs @@ -992,51 +770,27 @@ saveFrameworkAndArtifactsToLocalCache lCacheDir reverseRomeMap fVersion@(Framewo void . runExceptT $ do frameworkArchive <- createZipArchive frameworkDirectory verbose - liftIO $ runReaderT - (saveFrameworkToLocalCache lCacheDir - frameworkArchive - reverseRomeMap - fVersion - platform - ) - readerEnv + liftIO + $ runReaderT (saveFrameworkToLocalCache lCacheDir frameworkArchive reverseRomeMap fVersion platform) readerEnv void . runExceptT $ do dSYMArchive <- createZipArchive dSYMdirectory verbose - liftIO $ runReaderT - (saveDsymToLocalCache lCacheDir - dSYMArchive - reverseRomeMap - fVersion - platform - ) - readerEnv + liftIO $ runReaderT (saveDsymToLocalCache lCacheDir dSYMArchive reverseRomeMap fVersion platform) readerEnv void . runExceptT $ do dwarfUUIDs <- dwarfUUIDsFrom (frameworkDirectory fwn) - maybeUUIDsArchives <- liftIO $ forM dwarfUUIDs $ \dwarfUUID -> - runMaybeT $ do - dwarfArchive <- exceptToMaybeT - $ createZipArchive (bcSymbolMapPath dwarfUUID) verbose - return (dwarfUUID, dwarfArchive) - forM_ maybeUUIDsArchives $ mapM $ \(dwarfUUID, dwarfArchive) -> - liftIO $ runReaderT - (saveBcsymbolmapToLocalCache lCacheDir - dwarfUUID - dwarfArchive - reverseRomeMap - fVersion - platform - ) - readerEnv + maybeUUIDsArchives <- liftIO $ forM dwarfUUIDs $ \dwarfUUID -> runMaybeT $ do + dwarfArchive <- exceptToMaybeT $ createZipArchive (bcSymbolMapPath dwarfUUID) verbose + return (dwarfUUID, dwarfArchive) + forM_ maybeUUIDsArchives $ mapM $ \(dwarfUUID, dwarfArchive) -> liftIO $ runReaderT + (saveBcsymbolmapToLocalCache lCacheDir dwarfUUID dwarfArchive reverseRomeMap fVersion platform) + readerEnv where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - frameworkDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension - dSYMNameWithDSYMExtension = frameworkNameWithFrameworkExtension <> ".dSYM" - dSYMdirectory = platformBuildDirectory dSYMNameWithDSYMExtension + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + frameworkDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension + dSYMNameWithDSYMExtension = frameworkNameWithFrameworkExtension <> ".dSYM" + dSYMdirectory = platformBuildDirectory dSYMNameWithDSYMExtension bcSymbolMapPath d = platformBuildDirectory bcsymbolmapNameFrom d @@ -1048,23 +802,14 @@ uploadFrameworksAndArtifactsToEngine -> InvertedRepositoryMap -- ^ The map used to resolve `FrameworkName`s to `ProjectName`s. -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` from which to derive Frameworks, dSYMs and .verison files -> [TargetPlatform] -- ^ A list of `TargetPlatform` to restrict this operation to. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) IO () + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) IO () uploadFrameworksAndArtifactsToEngine enginePath mlCacheDir reverseRomeMap fvs platforms = do - (_, _, ConcurrentlyFlag performConcurrently, _) <- ask - if performConcurrently - then mapConcurrently_ uploadConcurrently fvs - else mapM_ (sequence . upload) platforms + (_, _, ConcurrentlyFlag performConcurrently, _, _) <- ask + if performConcurrently then mapConcurrently_ uploadConcurrently fvs else mapM_ (sequence . upload) platforms where - uploadConcurrently f = mapConcurrently - (uploadFrameworkAndArtifactsWithEngine enginePath - mlCacheDir - reverseRomeMap - f - ) - platforms - upload = mapM - (uploadFrameworkAndArtifactsWithEngine enginePath mlCacheDir reverseRomeMap) - fvs + uploadConcurrently f = + mapConcurrently (uploadFrameworkAndArtifactsWithEngine enginePath mlCacheDir reverseRomeMap f) platforms + upload = mapM (uploadFrameworkAndArtifactsWithEngine enginePath mlCacheDir reverseRomeMap) fvs uploadFrameworkAndArtifactsWithEngine @@ -1073,10 +818,10 @@ uploadFrameworkAndArtifactsWithEngine -> InvertedRepositoryMap -- ^ The map used to resolve `FrameworkName`s to `ProjectName`s. -> FrameworkVersion -- ^ A`FrameworkVersion` from which to derive Frameworks, dSYMs and .verison files -> TargetPlatform -- ^ A `TargetPlatform` to restrict this operation to. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) IO () + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) IO () uploadFrameworkAndArtifactsWithEngine enginePath mlCacheDir reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn fwt fwps) _) platform = do - (cachePrefix, s@(SkipLocalCacheFlag skipLocalCache), ConcurrentlyFlag performConcurrently, verbose) <- ask + (cachePrefix, s@(SkipLocalCacheFlag skipLocalCache), ConcurrentlyFlag performConcurrently, verbose, _) <- ask let readerEnv = (cachePrefix, verbose) void . runExceptT $ do frameworkArchive <- createZipArchive frameworkDirectory verbose @@ -1091,14 +836,8 @@ uploadFrameworkAndArtifactsWithEngine enginePath mlCacheDir reverseRomeMap fVers <*> Just platform ) <*> Just (cachePrefix, s, verbose) - liftIO $ runReaderT - (uploadFrameworkToEngine frameworkArchive - enginePath - reverseRomeMap - fVersion - platform - ) - readerEnv + liftIO + $ runReaderT (uploadFrameworkToEngine frameworkArchive enginePath reverseRomeMap fVersion platform) readerEnv void . runExceptT $ do dSYMArchive <- createZipArchive dSYMdirectory verbose @@ -1113,58 +852,37 @@ uploadFrameworkAndArtifactsWithEngine enginePath mlCacheDir reverseRomeMap fVers <*> Just platform ) <*> Just (cachePrefix, s, verbose) - liftIO $ runReaderT - (uploadDsymToEngine dSYMArchive - enginePath - reverseRomeMap - fVersion - platform - ) - readerEnv + liftIO $ runReaderT (uploadDsymToEngine dSYMArchive enginePath reverseRomeMap fVersion platform) readerEnv void . runExceptT $ do dwarfUUIDs <- dwarfUUIDsFrom (frameworkDirectory fwn) - maybeUUIDsArchives <- liftIO $ forM dwarfUUIDs $ \dwarfUUID -> - runMaybeT $ do - dwarfArchive <- exceptToMaybeT - $ createZipArchive (bcSymbolMapPath dwarfUUID) verbose - return (dwarfUUID, dwarfArchive) + maybeUUIDsArchives <- liftIO $ forM dwarfUUIDs $ \dwarfUUID -> runMaybeT $ do + dwarfArchive <- exceptToMaybeT $ createZipArchive (bcSymbolMapPath dwarfUUID) verbose + return (dwarfUUID, dwarfArchive) + + unless skipLocalCache $ forM_ maybeUUIDsArchives $ mapM $ \(dwarfUUID, dwarfArchive) -> + maybe (return ()) liftIO + $ runReaderT + <$> ( saveBcsymbolmapToLocalCache + <$> mlCacheDir + <*> Just dwarfUUID + <*> Just dwarfArchive + <*> Just reverseRomeMap + <*> Just fVersion + <*> Just platform + ) + <*> Just (cachePrefix, s, verbose) - unless skipLocalCache - $ forM_ maybeUUIDsArchives - $ mapM - $ \(dwarfUUID, dwarfArchive) -> - maybe (return ()) liftIO - $ runReaderT - <$> ( saveBcsymbolmapToLocalCache - <$> mlCacheDir - <*> Just dwarfUUID - <*> Just dwarfArchive - <*> Just reverseRomeMap - <*> Just fVersion - <*> Just platform - ) - <*> Just (cachePrefix, s, verbose) - - forM_ maybeUUIDsArchives $ mapM $ \(dwarfUUID, dwarfArchive) -> - liftIO $ runReaderT - (uploadBcsymbolmapToEngine dwarfUUID - dwarfArchive - enginePath - reverseRomeMap - fVersion - platform - ) - readerEnv + forM_ maybeUUIDsArchives $ mapM $ \(dwarfUUID, dwarfArchive) -> liftIO $ runReaderT + (uploadBcsymbolmapToEngine dwarfUUID dwarfArchive enginePath reverseRomeMap fVersion platform) + readerEnv where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - frameworkDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension - dSYMNameWithDSYMExtension = frameworkNameWithFrameworkExtension <> ".dSYM" - dSYMdirectory = platformBuildDirectory dSYMNameWithDSYMExtension + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + frameworkDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension + dSYMNameWithDSYMExtension = frameworkNameWithFrameworkExtension <> ".dSYM" + dSYMdirectory = platformBuildDirectory dSYMNameWithDSYMExtension bcSymbolMapPath d = platformBuildDirectory bcsymbolmapNameFrom d @@ -1175,8 +893,7 @@ downloadVersionFilesFromCaches -> Maybe FilePath -- ^ Just the local cache path or Nothing -> [ProjectNameAndVersion] -- ^ A list of `ProjectName`s and `Version`s information. -> ReaderT UploadDownloadCmdEnv IO () -downloadVersionFilesFromCaches s3BucketName lDir = - mapM_ (downloadVersionFileFromCaches s3BucketName lDir) +downloadVersionFilesFromCaches s3BucketName lDir = mapM_ (downloadVersionFileFromCaches s3BucketName lDir) @@ -1188,68 +905,53 @@ downloadVersionFileFromCaches -> Maybe FilePath -- ^ Just the local cache path or Nothing -> ProjectNameAndVersion -- ^ The `ProjectName` and `Version` information. -> ReaderT UploadDownloadCmdEnv IO () -downloadVersionFileFromCaches s3BucketName (Just lCacheDir) projectNameAndVersion - = do - (env, cachePrefix@(CachePrefix prefix), SkipLocalCacheFlag skipLocalCache, _, verbose) <- - ask - - when skipLocalCache $ downloadVersionFileFromCaches s3BucketName - Nothing - projectNameAndVersion - - unless skipLocalCache $ do - eitherSuccess <- runReaderT - (runExceptT $ getAndSaveVersionFileFromLocalCache - lCacheDir - projectNameAndVersion - ) - (cachePrefix, verbose) - case eitherSuccess of - Right _ -> return () - Left e -> liftIO $ do - let sayFunc :: MonadIO m => String -> m () - sayFunc = if verbose then sayLnWithTime else sayLn - sayFunc e - runReaderT - (do - e2 <- runExceptT $ do - versionFileBinary <- getVersionFileFromS3 - s3BucketName - projectNameAndVersion - saveBinaryToLocalCache lCacheDir - versionFileBinary - (prefix versionFileRemotePath) - versionFileName - verbose - liftIO $ saveBinaryToFile versionFileBinary versionFileLocalPath - sayFunc - $ "Copied " - <> versionFileName - <> " to: " - <> versionFileLocalPath - whenLeft sayFunc e2 - ) - (env, cachePrefix, verbose) +downloadVersionFileFromCaches s3BucketName (Just lCacheDir) projectNameAndVersion = do + (env, cachePrefix@(CachePrefix prefix), SkipLocalCacheFlag skipLocalCache, _, verbose, uuid) <- ask + + when skipLocalCache $ downloadVersionFileFromCaches s3BucketName Nothing projectNameAndVersion + + unless skipLocalCache $ do + eitherSuccess <- runReaderT (runExceptT $ getAndSaveVersionFileFromLocalCache lCacheDir projectNameAndVersion) + (cachePrefix, verbose, uuid) + case eitherSuccess of + Right _ -> return () + Left e -> liftIO $ do + let sayFunc :: MonadIO m => String -> m () + sayFunc = if verbose then sayLnWithTime else sayLn + sayFunc e + runReaderT + (do + e2 <- runExceptT $ do + versionFileBinary <- getVersionFileFromS3 s3BucketName projectNameAndVersion + saveBinaryToLocalCache lCacheDir + versionFileBinary + (prefix versionFileRemotePath) + versionFileName + verbose + liftIO $ saveBinaryToFile versionFileBinary versionFileLocalPath + sayFunc $ "Copied " <> versionFileName <> " to: " <> versionFileLocalPath + whenLeft sayFunc e2 + ) + (env, cachePrefix, verbose) where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion - versionFileLocalPath = carthageBuildDirectory versionFileName + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileLocalPath = carthageBuildDirectory versionFileName versionFileRemotePath = remoteVersionFilePath projectNameAndVersion downloadVersionFileFromCaches s3BucketName Nothing projectNameAndVersion = do - (env, cachePrefix, _, _, verbose) <- ask + (env, cachePrefix, _, _, verbose, _) <- ask let sayFunc :: MonadIO m => String -> m () sayFunc = if verbose then sayLnWithTime else sayLn eitherError <- liftIO $ runReaderT (runExceptT $ do - versionFileBinary <- getVersionFileFromS3 s3BucketName - projectNameAndVersion + versionFileBinary <- getVersionFileFromS3 s3BucketName projectNameAndVersion liftIO $ saveBinaryToFile versionFileBinary versionFileLocalPath sayFunc $ "Copied " <> versionFileName <> " to: " <> versionFileLocalPath ) (env, cachePrefix, verbose) whenLeft sayFunc eitherError where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileLocalPath = carthageBuildDirectory versionFileName @@ -1262,26 +964,13 @@ downloadFrameworksAndArtifactsFromCaches -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` identifying the Frameworks and dSYMs -> [TargetPlatform] -- ^ A list of target platforms restricting the scope of this action. -> ReaderT UploadDownloadCmdEnv IO () -downloadFrameworksAndArtifactsFromCaches s3BucketName mlCacheDir reverseRomeMap fvs platforms - = do - (_, _, _, ConcurrentlyFlag performConcurrently, _) <- ask - if performConcurrently - then mapConcurrently_ downloadConcurrently fvs - else mapM_ (sequence . download) platforms +downloadFrameworksAndArtifactsFromCaches s3BucketName mlCacheDir reverseRomeMap fvs platforms = do + (_, _, _, ConcurrentlyFlag performConcurrently, _, _) <- ask + if performConcurrently then mapConcurrently_ downloadConcurrently fvs else mapM_ (sequence . download) platforms where - downloadConcurrently f = mapConcurrently - (downloadFrameworkAndArtifactsFromCaches s3BucketName - mlCacheDir - reverseRomeMap - f - ) - platforms - download = mapM - (downloadFrameworkAndArtifactsFromCaches s3BucketName - mlCacheDir - reverseRomeMap - ) - fvs + downloadConcurrently f = + mapConcurrently (downloadFrameworkAndArtifactsFromCaches s3BucketName mlCacheDir reverseRomeMap f) platforms + download = mapM (downloadFrameworkAndArtifactsFromCaches s3BucketName mlCacheDir reverseRomeMap) fvs @@ -1297,26 +986,16 @@ downloadFrameworkAndArtifactsFromCaches -> ReaderT UploadDownloadCmdEnv IO () downloadFrameworkAndArtifactsFromCaches s3BucketName (Just lCacheDir) reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ _) version) platform = do - (env, cachePrefix@(CachePrefix prefix), SkipLocalCacheFlag skipLocalCache, _, verbose) <- - ask + (env, cachePrefix@(CachePrefix prefix), SkipLocalCacheFlag skipLocalCache, _, verbose, uuid) <- ask let remoteReaderEnv = (env, cachePrefix, verbose) - let localReaderEnv = (cachePrefix, verbose) + let localReaderEnv = (cachePrefix, verbose, uuid) - when skipLocalCache $ downloadFrameworkAndArtifactsFromCaches - s3BucketName - Nothing - reverseRomeMap - fVersion - platform + when skipLocalCache $ downloadFrameworkAndArtifactsFromCaches s3BucketName Nothing reverseRomeMap fVersion platform unless skipLocalCache $ do eitherFrameworkSuccess <- runReaderT - (runExceptT $ getAndUnzipFrameworkFromLocalCache lCacheDir - reverseRomeMap - fVersion - platform - ) + (runExceptT $ getAndUnzipFrameworkFromLocalCache lCacheDir reverseRomeMap fVersion platform) localReaderEnv let sayFunc :: MonadIO m => String -> m () sayFunc = if verbose then sayLnWithTime else sayLn @@ -1328,75 +1007,45 @@ downloadFrameworkAndArtifactsFromCaches s3BucketName (Just lCacheDir) reverseRom runReaderT (do e2 <- runExceptT $ do - frameworkBinary <- getFrameworkFromS3 s3BucketName - reverseRomeMap - fVersion - platform - saveBinaryToLocalCache lCacheDir - frameworkBinary - (prefix remoteFrameworkUploadPath) - fwn - verbose + frameworkBinary <- getFrameworkFromS3 s3BucketName reverseRomeMap fVersion platform + saveBinaryToLocalCache lCacheDir frameworkBinary (prefix remoteFrameworkUploadPath) fwn verbose deleteFrameworkDirectory fVersion platform verbose unzipBinary frameworkBinary fwn frameworkZipName verbose - <* ifExists - frameworkExecutablePath - (makeExecutable frameworkExecutablePath) + <* ifExists frameworkExecutablePath (makeExecutable frameworkExecutablePath) whenLeft sayFunc e2 ) remoteReaderEnv eitherBcsymbolmapsOrErrors <- runReaderT - (runExceptT $ getAndUnzipBcsymbolmapsFromLocalCache' lCacheDir - reverseRomeMap - fVersion - platform - ) + (runExceptT $ getAndUnzipBcsymbolmapsFromLocalCache' lCacheDir reverseRomeMap fVersion platform) localReaderEnv case eitherBcsymbolmapsOrErrors of - Right _ -> return () - Left ErrorGettingDwarfUUIDs -> - sayFunc $ "Error: Cannot retrieve symbolmaps ids for " <> fwn - Left (FailedDwarfUUIDs dwardUUIDsAndErrors) -> do + Right _ -> return () + Left ErrorGettingDwarfUUIDs -> sayFunc $ "Error: Cannot retrieve symbolmaps ids for " <> fwn + Left (FailedDwarfUUIDs dwardUUIDsAndErrors) -> do mapM_ (sayFunc . snd) dwardUUIDsAndErrors - forM_ (map fst dwardUUIDsAndErrors) - $ \dwarfUUID -> liftIO $ runReaderT - (do - e <- runExceptT $ do - let symbolmapLoggingName = - fwn <> "." <> bcsymbolmapNameFrom dwarfUUID - let bcsymbolmapZipName d = bcsymbolmapArchiveName d version - let localBcsymbolmapPathFrom d = - platformBuildDirectory bcsymbolmapNameFrom d - symbolmapBinary <- getBcsymbolmapFromS3 s3BucketName - reverseRomeMap - fVersion - platform - dwarfUUID - saveBinaryToLocalCache - lCacheDir - symbolmapBinary - (prefix remoteBcSymbolmapUploadPathFromDwarf dwarfUUID - ) - fwn - verbose - deleteFile (localBcsymbolmapPathFrom dwarfUUID) verbose - unzipBinary symbolmapBinary - symbolmapLoggingName - (bcsymbolmapZipName dwarfUUID) - verbose - whenLeft sayFunc e - ) - remoteReaderEnv + forM_ (map fst dwardUUIDsAndErrors) $ \dwarfUUID -> liftIO $ runReaderT + (do + e <- runExceptT $ do + let symbolmapLoggingName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID + let bcsymbolmapZipName d = bcsymbolmapArchiveName d version + let localBcsymbolmapPathFrom d = platformBuildDirectory bcsymbolmapNameFrom d + symbolmapBinary <- getBcsymbolmapFromS3 s3BucketName reverseRomeMap fVersion platform dwarfUUID + saveBinaryToLocalCache lCacheDir + symbolmapBinary + (prefix remoteBcSymbolmapUploadPathFromDwarf dwarfUUID) + fwn + verbose + deleteFile (localBcsymbolmapPathFrom dwarfUUID) verbose + unzipBinary symbolmapBinary symbolmapLoggingName (bcsymbolmapZipName dwarfUUID) verbose + whenLeft sayFunc e + ) + remoteReaderEnv eitherDSYMSuccess <- runReaderT - (runExceptT $ getAndUnzipDSYMFromLocalCache lCacheDir - reverseRomeMap - fVersion - platform - ) + (runExceptT $ getAndUnzipDSYMFromLocalCache lCacheDir reverseRomeMap fVersion platform) localReaderEnv case eitherDSYMSuccess of Right _ -> return () @@ -1405,68 +1054,44 @@ downloadFrameworkAndArtifactsFromCaches s3BucketName (Just lCacheDir) reverseRom runReaderT (do e2 <- runExceptT $ do - dSYMBinary <- getDSYMFromS3 s3BucketName - reverseRomeMap - fVersion - platform - saveBinaryToLocalCache lCacheDir - dSYMBinary - (prefix remotedSYMUploadPath) - dSYMName - verbose + dSYMBinary <- getDSYMFromS3 s3BucketName reverseRomeMap fVersion platform + saveBinaryToLocalCache lCacheDir dSYMBinary (prefix remotedSYMUploadPath) dSYMName verbose deleteDSYMDirectory fVersion platform verbose unzipBinary dSYMBinary dSYMName dSYMZipName verbose whenLeft sayFunc e2 ) remoteReaderEnv where - frameworkZipName = frameworkArchiveName f version - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version - remoteBcSymbolmapUploadPathFromDwarf dwarfUUID = - remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version - dSYMZipName = dSYMArchiveName f version - remotedSYMUploadPath = remoteDsymPath platform reverseRomeMap f version - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f + frameworkZipName = frameworkArchiveName f version + remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version + remoteBcSymbolmapUploadPathFromDwarf dwarfUUID = remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version + dSYMZipName = dSYMArchiveName f version + remotedSYMUploadPath = remoteDsymPath platform reverseRomeMap f version + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f dSYMName = fwn <> ".dSYM" frameworkExecutablePath = frameworkBuildBundleForPlatform platform f fwn downloadFrameworkAndArtifactsFromCaches s3BucketName Nothing reverseRomeMap fVersion@(FrameworkVersion (Framework fwn _ _) _) platform = do - (env, cachePrefix, _, _, verbose) <- ask + (env, cachePrefix, _, _, verbose, _) <- ask let readerEnv = (env, cachePrefix, verbose) let sayFunc = if verbose then sayLnWithTime else sayLn - eitherError <- liftIO $ runReaderT - (runExceptT $ getAndUnzipFrameworkFromS3 s3BucketName - reverseRomeMap - fVersion - platform - ) - readerEnv + eitherError <- liftIO + $ runReaderT (runExceptT $ getAndUnzipFrameworkFromS3 s3BucketName reverseRomeMap fVersion platform) readerEnv whenLeft sayFunc eitherError - eitherDSYMError <- liftIO $ runReaderT - ( runExceptT - $ getAndUnzipDSYMFromS3 s3BucketName reverseRomeMap fVersion platform - ) - readerEnv + eitherDSYMError <- liftIO + $ runReaderT (runExceptT $ getAndUnzipDSYMFromS3 s3BucketName reverseRomeMap fVersion platform) readerEnv whenLeft sayFunc eitherDSYMError eitherSymbolmapsOrErrors <- liftIO $ runReaderT - (runExceptT $ getAndUnzipBcsymbolmapsFromS3' s3BucketName - reverseRomeMap - fVersion - platform - ) + (runExceptT $ getAndUnzipBcsymbolmapsFromS3' s3BucketName reverseRomeMap fVersion platform) readerEnv flip whenLeft eitherSymbolmapsOrErrors $ \e -> case e of - ErrorGettingDwarfUUIDs -> - sayFunc $ "Error: Cannot retrieve symbolmaps ids for " <> fwn - (FailedDwarfUUIDs dwardUUIDsAndErrors) -> - mapM_ (sayFunc . snd) dwardUUIDsAndErrors + ErrorGettingDwarfUUIDs -> sayFunc $ "Error: Cannot retrieve symbolmaps ids for " <> fwn + (FailedDwarfUUIDs dwardUUIDsAndErrors) -> mapM_ (sayFunc . snd) dwardUUIDsAndErrors @@ -1477,27 +1102,40 @@ downloadFrameworksAndArtifactsWithEngine -> InvertedRepositoryMap -- ^ The map used to resolve `FrameworkName`s to `ProjectName`s. -> [FrameworkVersion] -- ^ A list of `FrameworkVersion` identifying the Frameworks and dSYMs -> [TargetPlatform] -- ^ A list of target platforms restricting the scope of this action. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) IO () -downloadFrameworksAndArtifactsWithEngine enginePath lCacheDir reverseRomeMap fvs platforms + -> 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 + (_, _, 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 - (downloadFrameworkAndArtifactsWithEngine enginePath + (\p -> downloadFrameworkAndArtifactsWithEngine ePath lCacheDir reverseRomeMap f + p + tmpDir ) platforms - download = mapM - (downloadFrameworkAndArtifactsWithEngine enginePath - lCacheDir - reverseRomeMap - ) - fvs + -- Types here a tricky (for me) + -- someF = mapM (\k v -> putStrLn (k ++ " " ++ v)) ["hello", "ciao"] :: String -> [IO ()] + -- while + -- someF' k = mapM (\v -> putStrLn (k ++ " " ++ v)) ["hello", "ciao" ] :: String -> IO [()] + download = mapM download' fvs + download' fv p = downloadFrameworkAndArtifactsWithEngine ePath lCacheDir reverseRomeMap fv p tmpDir -- | Downloads a Framework and it's relative dSYM with the engine or a local cache. @@ -1509,27 +1147,19 @@ downloadFrameworkAndArtifactsWithEngine -> InvertedRepositoryMap -- ^ The map used to resolve `FrameworkName`s to `ProjectName`s. -> FrameworkVersion -- ^ The `FrameworkVersion` identifying the Framework and dSYM -> TargetPlatform -- ^ A target platforms restricting the scope of this action. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) IO () -downloadFrameworkAndArtifactsWithEngine enginePath (Just lCacheDir) reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ _) version) platform + -> FilePath -- ^ A temporary path used by the engine to download binaries to + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) IO () +downloadFrameworkAndArtifactsWithEngine ePath (Just lCacheDir) reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ _) version) platform tmpDir = do - (cachePrefix@(CachePrefix prefix), SkipLocalCacheFlag skipLocalCache, _, verbose) <- ask + (cachePrefix@(CachePrefix prefix), SkipLocalCacheFlag skipLocalCache, _, verbose, uuid) <- ask - let readerEnv = (cachePrefix, verbose) + let readerEnv = (cachePrefix, verbose, uuid) - when skipLocalCache $ downloadFrameworkAndArtifactsWithEngine - enginePath - Nothing - reverseRomeMap - fVersion - platform + when skipLocalCache $ downloadFrameworkAndArtifactsWithEngine ePath Nothing reverseRomeMap fVersion platform tmpDir unless skipLocalCache $ do eitherFrameworkSuccess <- runReaderT - (runExceptT $ getAndUnzipFrameworkFromLocalCache lCacheDir - reverseRomeMap - fVersion - platform - ) + (runExceptT $ getAndUnzipFrameworkFromLocalCache lCacheDir reverseRomeMap fVersion platform) readerEnv let sayFunc :: MonadIO m => String -> m () sayFunc = if verbose then sayLnWithTime else sayLn @@ -1541,73 +1171,43 @@ downloadFrameworkAndArtifactsWithEngine enginePath (Just lCacheDir) reverseRomeM runReaderT (do e2 <- runExceptT $ do - frameworkBinary <- getFrameworkFromEngine enginePath - reverseRomeMap - fVersion - platform - saveBinaryToLocalCache lCacheDir - frameworkBinary - (prefix remoteFrameworkUploadPath) - fwn - verbose + frameworkBinary <- getFrameworkFromEngine ePath reverseRomeMap fVersion platform tmpDir + saveBinaryToLocalCache lCacheDir frameworkBinary (prefix remoteFrameworkUploadPath) fwn verbose deleteFrameworkDirectory fVersion platform verbose unzipBinary frameworkBinary fwn frameworkZipName verbose - <* ifExists - frameworkExecutablePath - (makeExecutable frameworkExecutablePath) + <* ifExists frameworkExecutablePath (makeExecutable frameworkExecutablePath) whenLeft sayFunc e2 ) readerEnv eitherBcsymbolmapsOrErrors <- runReaderT - (runExceptT $ getAndUnzipBcsymbolmapsFromLocalCache' lCacheDir - reverseRomeMap - fVersion - platform - ) + (runExceptT $ getAndUnzipBcsymbolmapsFromLocalCache' lCacheDir reverseRomeMap fVersion platform) readerEnv case eitherBcsymbolmapsOrErrors of - Right _ -> return () - Left ErrorGettingDwarfUUIDs -> - sayFunc $ "Error: Cannot retrieve symbolmaps ids for " <> fwn - Left (FailedDwarfUUIDs dwardUUIDsAndErrors) -> do + Right _ -> return () + Left ErrorGettingDwarfUUIDs -> sayFunc $ "Error: Cannot retrieve symbolmaps ids for " <> fwn + Left (FailedDwarfUUIDs dwardUUIDsAndErrors) -> do mapM_ (sayFunc . snd) dwardUUIDsAndErrors - forM_ (map fst dwardUUIDsAndErrors) - $ \dwarfUUID -> liftIO $ runReaderT - (do - e <- runExceptT $ do - let symbolmapLoggingName = - fwn <> "." <> bcsymbolmapNameFrom dwarfUUID - let bcsymbolmapZipName d = bcsymbolmapArchiveName d version - let localBcsymbolmapPathFrom d = - platformBuildDirectory bcsymbolmapNameFrom d - symbolmapBinary <- getBcsymbolmapWithEngine enginePath - reverseRomeMap - fVersion - platform - dwarfUUID - saveBinaryToLocalCache - lCacheDir - symbolmapBinary - (prefix remoteBcSymbolmapUploadPathFromDwarf dwarfUUID - ) - fwn - verbose - deleteFile (localBcsymbolmapPathFrom dwarfUUID) verbose - unzipBinary symbolmapBinary - symbolmapLoggingName - (bcsymbolmapZipName dwarfUUID) - verbose - whenLeft sayFunc e - ) - readerEnv + forM_ (map fst dwardUUIDsAndErrors) $ \dwarfUUID -> liftIO $ runReaderT + (do + e <- runExceptT $ do + let symbolmapLoggingName = fwn <> "." <> bcsymbolmapNameFrom dwarfUUID + let bcsymbolmapZipName d = bcsymbolmapArchiveName d version + let localBcsymbolmapPathFrom d = platformBuildDirectory bcsymbolmapNameFrom d + symbolmapBinary <- getBcsymbolmapWithEngine ePath reverseRomeMap fVersion platform dwarfUUID tmpDir + saveBinaryToLocalCache lCacheDir + symbolmapBinary + (prefix remoteBcSymbolmapUploadPathFromDwarf dwarfUUID) + fwn + verbose + deleteFile (localBcsymbolmapPathFrom dwarfUUID) verbose + unzipBinary symbolmapBinary symbolmapLoggingName (bcsymbolmapZipName dwarfUUID) verbose + whenLeft sayFunc e + ) + readerEnv eitherDSYMSuccess <- runReaderT - (runExceptT $ getAndUnzipDSYMFromLocalCache lCacheDir - reverseRomeMap - fVersion - platform - ) + (runExceptT $ getAndUnzipDSYMFromLocalCache lCacheDir reverseRomeMap fVersion platform) readerEnv case eitherDSYMSuccess of Right _ -> return () @@ -1616,71 +1216,44 @@ downloadFrameworkAndArtifactsWithEngine enginePath (Just lCacheDir) reverseRomeM runReaderT (do e2 <- runExceptT $ do - dSYMBinary <- getDSYMFromEngine enginePath - reverseRomeMap - fVersion - platform - saveBinaryToLocalCache lCacheDir - dSYMBinary - (prefix remotedSYMUploadPath) - dSYMName - verbose + dSYMBinary <- getDSYMFromEngine ePath reverseRomeMap fVersion platform tmpDir + saveBinaryToLocalCache lCacheDir dSYMBinary (prefix remotedSYMUploadPath) dSYMName verbose deleteDSYMDirectory fVersion platform verbose unzipBinary dSYMBinary dSYMName dSYMZipName verbose whenLeft sayFunc e2 ) readerEnv where - frameworkZipName = frameworkArchiveName f version - remoteFrameworkUploadPath = - remoteFrameworkPath platform reverseRomeMap f version - remoteBcSymbolmapUploadPathFromDwarf dwarfUUID = - remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version - dSYMZipName = dSYMArchiveName f version - remotedSYMUploadPath = remoteDsymPath platform reverseRomeMap f version - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f + frameworkZipName = frameworkArchiveName f version + remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version + remoteBcSymbolmapUploadPathFromDwarf dwarfUUID = remoteBcsymbolmapPath dwarfUUID platform reverseRomeMap f version + dSYMZipName = dSYMArchiveName f version + remotedSYMUploadPath = remoteDsymPath platform reverseRomeMap f version + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f dSYMName = fwn <> ".dSYM" frameworkExecutablePath = frameworkBuildBundleForPlatform platform f fwn -downloadFrameworkAndArtifactsWithEngine enginePath Nothing reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ _) version) platform +downloadFrameworkAndArtifactsWithEngine ePath Nothing reverseRomeMap fVersion@(FrameworkVersion f@(Framework fwn _ _) version) platform tmpDir = do - (cachePrefix, _, _, verbose) <- ask + (cachePrefix, _, _, verbose, uuid) <- ask - let readerEnv = (cachePrefix, verbose) + let readerEnv = (cachePrefix, verbose, uuid) let sayFunc = if verbose then sayLnWithTime else sayLn - liftIO $ - runReaderT - (do - error <- - runExceptT - $ getAndUnzipFrameworkWithEngine - enginePath - reverseRomeMap - fVersion - platform - whenLeft sayFunc error - eitherDSYMError <- - runExceptT - $ getAndUnzipDSYMWithEngine - enginePath - reverseRomeMap - fVersion - platform - whenLeft sayFunc eitherDSYMError - eitherSymbolmapsOrErrors <- runExceptT $ getAndUnzipBcsymbolmapsWithEngine' enginePath - reverseRomeMap - fVersion - platform - flip whenLeft eitherSymbolmapsOrErrors $ \e -> case e of - ErrorGettingDwarfUUIDs -> - sayFunc $ "Error: Cannot retrieve symbolmaps ids for " <> fwn - (FailedDwarfUUIDs dwardUUIDsAndErrors) -> - mapM_ (sayFunc . snd) dwardUUIDsAndErrors - ) - readerEnv + liftIO $ runReaderT + (do + err <- runExceptT $ getAndUnzipFrameworkWithEngine ePath reverseRomeMap fVersion platform tmpDir + whenLeft sayFunc err + eitherDSYMError <- runExceptT $ getAndUnzipDSYMWithEngine ePath reverseRomeMap fVersion platform tmpDir + whenLeft sayFunc eitherDSYMError + eitherSymbolmapsOrErrors <- runExceptT + $ getAndUnzipBcsymbolmapsWithEngine' ePath reverseRomeMap fVersion platform tmpDir + flip whenLeft eitherSymbolmapsOrErrors $ \e -> case e of + ErrorGettingDwarfUUIDs -> sayFunc $ "Error: Cannot retrieve symbolmaps ids for " <> fwn + (FailedDwarfUUIDs dwardUUIDsAndErrors) -> mapM_ (sayFunc . snd) dwardUUIDsAndErrors + ) + readerEnv -- | Downloads a list of .version files with the engine or a local cache. @@ -1688,9 +1261,9 @@ downloadVersionFilesWithEngine :: FilePath -- ^ The engine definition. -> Maybe FilePath -- ^ Just the local cache path or Nothing -> [ProjectNameAndVersion] -- ^ A list of `ProjectName`s and `Version`s information. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) IO () -downloadVersionFilesWithEngine enginePath lDir = - mapM_ (downloadVersionFileWithEngine enginePath lDir) + -> 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 @@ -1701,69 +1274,55 @@ downloadVersionFileWithEngine :: FilePath -- ^ The engine definition. -> Maybe FilePath -- ^ Just the local cache path or Nothing -> ProjectNameAndVersion -- ^ The `ProjectName` and `Version` information. - -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) IO () -downloadVersionFileWithEngine enginePath (Just lCacheDir) projectNameAndVersion - = do - (cachePrefix@(CachePrefix prefix), SkipLocalCacheFlag skipLocalCache, _, verbose) <- - ask - - when skipLocalCache $ downloadVersionFileWithEngine enginePath - Nothing - projectNameAndVersion - - unless skipLocalCache $ do - eitherSuccess <- runReaderT - (runExceptT $ getAndSaveVersionFileFromLocalCache - lCacheDir - projectNameAndVersion - ) - (cachePrefix, verbose) - case eitherSuccess of - Right _ -> return () - Left e -> liftIO $ do - let sayFunc :: MonadIO m => String -> m () - sayFunc = if verbose then sayLnWithTime else sayLn - sayFunc e - runReaderT - (do - e2 <- runExceptT $ do - versionFileBinary <- getVersionFileFromEngine - enginePath - projectNameAndVersion - saveBinaryToLocalCache lCacheDir - versionFileBinary - (prefix versionFileRemotePath) - versionFileName - verbose - liftIO $ saveBinaryToFile versionFileBinary versionFileLocalPath - sayFunc - $ "Copied " - <> versionFileName - <> " to: " - <> versionFileLocalPath - whenLeft sayFunc e2 - ) - (cachePrefix, verbose) + -> FilePath -- ^ A temporary path used by the engine to download binaries to + -> ReaderT (CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) IO () +downloadVersionFileWithEngine enginePath (Just lCacheDir) projectNameAndVersion tmpDir = do + (cachePrefix@(CachePrefix prefix), SkipLocalCacheFlag skipLocalCache, _, verbose, uuid) <- ask + + when skipLocalCache $ downloadVersionFileWithEngine enginePath Nothing projectNameAndVersion tmpDir + + unless skipLocalCache $ do + eitherSuccess <- runReaderT (runExceptT $ getAndSaveVersionFileFromLocalCache lCacheDir projectNameAndVersion) + (cachePrefix, verbose, uuid) + case eitherSuccess of + Right _ -> return () + Left e -> liftIO $ do + let sayFunc :: MonadIO m => String -> m () + sayFunc = if verbose then sayLnWithTime else sayLn + sayFunc e + runReaderT + (do + e2 <- runExceptT $ do + versionFileBinary <- getVersionFileFromEngine enginePath projectNameAndVersion tmpDir + saveBinaryToLocalCache lCacheDir + versionFileBinary + (prefix versionFileRemotePath) + versionFileName + verbose + liftIO $ saveBinaryToFile versionFileBinary versionFileLocalPath + sayFunc $ "Copied " <> versionFileName <> " to: " <> versionFileLocalPath + whenLeft sayFunc e2 + ) + (cachePrefix, verbose, uuid) where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion - versionFileLocalPath = carthageBuildDirectory versionFileName + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileLocalPath = carthageBuildDirectory versionFileName versionFileRemotePath = remoteVersionFilePath projectNameAndVersion -downloadVersionFileWithEngine enginePath Nothing projectNameAndVersion = do - (cachePrefix, _, _, verbose) <- ask +downloadVersionFileWithEngine enginePath Nothing projectNameAndVersion tmpDir = do + (cachePrefix, _, _, verbose, uuid) <- ask let sayFunc :: MonadIO m => String -> m () sayFunc = if verbose then sayLnWithTime else sayLn eitherError <- liftIO $ runReaderT (runExceptT $ do - versionFileBinary <- getVersionFileFromEngine enginePath - projectNameAndVersion + versionFileBinary <- getVersionFileFromEngine enginePath projectNameAndVersion tmpDir liftIO $ saveBinaryToFile versionFileBinary versionFileLocalPath sayFunc $ "Copied " <> versionFileName <> " to: " <> versionFileLocalPath ) - (cachePrefix, verbose) + (cachePrefix, verbose, uuid) whenLeft sayFunc eitherError where - versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion + versionFileName = versionFileNameForProjectName $ fst projectNameAndVersion versionFileLocalPath = carthageBuildDirectory versionFileName @@ -1775,28 +1334,22 @@ formattedRepoAvailability -> ProjectAvailability -- ^ A given `ProjectAvailability`. -> String formattedRepoAvailability listMode (ProjectAvailability (ProjectName pn) (Version v) pas) - | null filteredAvailabilities - = "" - | otherwise - = unwords [pn, v, ":", formattedAvailabilities] + | null filteredAvailabilities = "" + | otherwise = unwords [pn, v, ":", formattedAvailabilities] where - filteredAvailabilities = filterAccordingToListMode listMode pas - formattedAvailabilities = - unwords (formattedPlatformAvailability <$> filteredAvailabilities) + filteredAvailabilities = filterAccordingToListMode listMode pas + formattedAvailabilities = unwords (formattedPlatformAvailability <$> filteredAvailabilities) formattedRepoAvailabilityJSON :: ProjectAvailability -> RepoJSON -formattedRepoAvailabilityJSON (ProjectAvailability (ProjectName name) (Version version) ps) - = RepoJSON - { name = name - , Types.version = version - , present = getPlatforms Commands.Present - , missing = getPlatforms Commands.Missing - } - where - getPlatforms mode = - show . _availabilityPlatform <$> filterAccordingToListMode mode ps +formattedRepoAvailabilityJSON (ProjectAvailability (ProjectName name) (Version version) ps) = RepoJSON + { name = name + , Types.version = version + , present = getPlatforms Commands.Present + , missing = getPlatforms Commands.Missing + } + where getPlatforms mode = show . _availabilityPlatform <$> filterAccordingToListMode mode ps @@ -1817,16 +1370,10 @@ filterAccordingToListMode Commands.Present = filter _isAvailable -- | or falling back to _default_ profile. discoverRegion :: (MonadIO m, MonadCatch m) => ExceptT String m AWS.Region discoverRegion = do - envRegion <- - liftIO $ maybeToEither "No env variable AWS_REGION found. " <$> lookupEnv - "AWS_REGION" - profile <- liftIO $ lookupEnv "AWS_PROFILE" + envRegion <- liftIO $ maybeToEither "No env variable AWS_REGION found. " <$> lookupEnv "AWS_REGION" + profile <- liftIO $ lookupEnv "AWS_PROFILE" let eitherEnvRegion = ExceptT . return $ envRegion >>= AWS.fromText . T.pack - let - eitherFileRegion = - ( getAWSConfigFilePath - >>= flip getRegionFromFile (fromMaybe "default" profile) - ) + let eitherFileRegion = (getAWSConfigFilePath >>= flip getRegionFromFile (fromMaybe "default" profile)) `catch` \(e :: IOError) -> ExceptT . return . Left . show $ e eitherEnvRegion <|> eitherFileRegion @@ -1838,10 +1385,9 @@ getRegionFromFile => FilePath -- ^ The path to the file containing the `AWS.Region` -> String -- ^ The name of the profile to use -> ExceptT String m AWS.Region -getRegionFromFile f profile = - fromFile f $ \fileContents -> ExceptT . return $ do - config <- AWS.parseConfigFile fileContents - AWS.regionOf (T.pack profile) config +getRegionFromFile f profile = fromFile f $ \fileContents -> ExceptT . return $ do + config <- AWS.parseConfigFile fileContents + AWS.regionOf (T.pack profile) config @@ -1852,16 +1398,10 @@ getRegionFromFile f profile = discoverEndpoint :: (MonadIO m, MonadCatch m) => ExceptT String m URL discoverEndpoint = do maybeString <- liftIO $ lookupEnv "AWS_ENDPOINT" - let envEndpointURL = - maybeToEither "No env variable AWS_ENDPOINT found. " - $ maybeString - >>= importURL + let envEndpointURL = maybeToEither "No env variable AWS_ENDPOINT found. " $ maybeString >>= importURL profile <- liftIO $ lookupEnv "AWS_PROFILE" - let fileEndPointURL = - ( getAWSConfigFilePath - >>= getEndpointFromFile (fromMaybe "default" profile) - ) - `catch` \(e :: IOError) -> ExceptT . return . Left . show $ e + let fileEndPointURL = (getAWSConfigFilePath >>= getEndpointFromFile (fromMaybe "default" profile)) + `catch` \(e :: IOError) -> ExceptT . return . Left . show $ e (ExceptT . return $ envEndpointURL) <|> fileEndPointURL @@ -1873,7 +1413,6 @@ getEndpointFromFile => String -- ^ The name of the profile to use -> FilePath -- ^ The path to the file containing the `AWS.Region` -> ExceptT String m URL -getEndpointFromFile profile f = - fromFile f $ \fileContents -> ExceptT . return $ do - config <- AWS.parseConfigFile fileContents - AWS.endPointOf (T.pack profile) config +getEndpointFromFile profile f = fromFile f $ \fileContents -> ExceptT . return $ do + config <- AWS.parseConfigFile fileContents + AWS.endPointOf (T.pack profile) config diff --git a/src/Network/AWS/Utils.hs b/src/Network/AWS/Utils.hs index 0aba61c8..649a2415 100644 --- a/src/Network/AWS/Utils.hs +++ b/src/Network/AWS/Utils.hs @@ -12,26 +12,42 @@ module Network.AWS.Utils , accessKeyIdOf , secretAccessKeyOf , roleARNOf - ) where + ) +where -- For now, only very little information needs to be extracted from the S3 -- config file, but extracting it into a separate module is consistent with -- `Data.Romefile` and `Data.Carthage` and avoids dealing with the raw INI -- file representation (String-keyed hashmaps) in the main logic. -import Control.Monad ((<=<)) -import Data.Either.Utils (maybeToEither) -import Data.Either.Extra (mapLeft) -import Data.Ini (Ini, lookupValue, parseIni) -import qualified Data.Text as T (Text, null, pack, unpack) -import qualified Data.Text.Encoding as T (encodeUtf8) -import qualified Data.Text.IO as T (readFile) -import qualified Network.AWS as AWS -import qualified Network.AWS.Data as AWS -import qualified Network.AWS.Data.Sensitive as AWS (Sensitive (..)) +import Control.Monad ( (<=<) ) +import Data.Either.Utils ( maybeToEither ) +import Data.Either.Extra ( mapLeft ) +import Data.Ini ( Ini + , lookupValue + , parseIni + ) +import qualified Data.Text as T + ( Text + , null + , pack + , unpack + ) +import qualified Data.Text.Encoding as T + ( encodeUtf8 ) +import qualified Data.Text.IO as T + ( readFile ) +import qualified Network.AWS as AWS +import qualified Network.AWS.Data as AWS +import qualified Network.AWS.Data.Sensitive as AWS + ( Sensitive(..) ) import Network.URL -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Except (ExceptT (..), withExceptT) +import Control.Monad.IO.Class ( MonadIO + , liftIO + ) +import Control.Monad.Except ( ExceptT(..) + , withExceptT + ) newtype ConfigFile = ConfigFile { _awsConfigIni :: Ini } deriving Show newtype CredentialsFile = CredentialsFile { _awsCredentialsIni :: Ini } deriving Show @@ -90,66 +106,42 @@ 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 - -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 + 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 + +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) - where - key = "source_profile" - finalProfile = - if profile == "default" then - profile - else - T.pack "profile " <> 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 roleARNOf :: T.Text -> ConfigFile -> Either String T.Text 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 + where + 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" parseConfigFile :: T.Text -> Either String ConfigFile diff --git a/src/Text/Parsec/Utils.hs b/src/Text/Parsec/Utils.hs index 2a57accb..44e4d4b2 100644 --- a/src/Text/Parsec/Utils.hs +++ b/src/Text/Parsec/Utils.hs @@ -1,21 +1,16 @@ {-# LANGUAGE FlexibleContexts #-} module Text.Parsec.Utils - ( parseWhiteSpaces - , parseUnquotedString - ) where - - - -import Control.Applicative ((<|>)) -import qualified Text.Parsec as Parsec - + ( parseWhiteSpaces + , parseUnquotedString + ) +where +import Control.Applicative ( (<|>) ) +import qualified Text.Parsec as Parsec parseWhiteSpaces :: Parsec.Parsec String () String -parseWhiteSpaces = - Parsec.try (Parsec.many1 Parsec.space) <|> Parsec.many1 Parsec.tab +parseWhiteSpaces = Parsec.try (Parsec.many1 Parsec.space) <|> Parsec.many1 Parsec.tab parseUnquotedString :: Parsec.Parsec String () String -parseUnquotedString = - Parsec.many1 (Parsec.noneOf ['"', ' ', '\t', '\n', '\'', '\\', '\r']) +parseUnquotedString = Parsec.many1 (Parsec.noneOf ['"', ' ', '\t', '\n', '\'', '\\', '\r']) diff --git a/src/Types.hs b/src/Types.hs index 2a31d86f..303c482b 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,26 +1,32 @@ {-# LANGUAGE DeriveGeneric #-} module Types where -import Control.Monad.Except (ExceptT) +import Control.Monad.Except ( ExceptT ) +import Control.Monad.Trans.Reader ( ReaderT ) import Data.Aeson -import Data.Carthage.Cartfile (Version) +import Data.Carthage.Cartfile ( Version ) import Data.Carthage.TargetPlatform -import qualified Data.Map.Strict as M -import Data.Romefile (Framework, ProjectName) +import qualified Data.Map.Strict as M +import Data.Romefile ( Framework + , ProjectName + ) +import Data.UUID as UUID + ( UUID ) import GHC.Generics -import qualified Network.AWS.Env as AWS (Env) +import qualified Network.AWS.Env as AWS + ( Env ) import Types.Commands -type UploadDownloadCmdEnv = (AWS.Env, CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool) -type UploadDownloadEnv = (AWS.Env, CachePrefix, Bool) -type RomeMonad = ExceptT String IO -type RepositoryMap = M.Map ProjectName [Framework] +type UploadDownloadCmdEnv = (AWS.Env, CachePrefix, SkipLocalCacheFlag, ConcurrentlyFlag, Bool, UUID.UUID) +type UploadDownloadEnv = (AWS.Env, CachePrefix, Bool) +type RomeMonad = (ExceptT String (ReaderT UUID.UUID IO)) +type RepositoryMap = M.Map ProjectName [Framework] type InvertedRepositoryMap = M.Map Framework ProjectName -type RomeVersion = (Int, Int, Int, Int) +type RomeVersion = (Int, Int, Int, Int) type ProjectNameAndVersion = (ProjectName, Version) diff --git a/src/Utils.hs b/src/Utils.hs index 1247793f..5e4eab8d 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -5,50 +5,77 @@ module Utils where -import qualified Codec.Archive.Zip as Zip -import Configuration (carthageArtifactsBuildDirectoryForPlatform) -import Control.Arrow (left) -import Control.Exception as E (try) -import Control.Lens hiding (List) +import qualified Codec.Archive.Zip as Zip +import Configuration ( carthageArtifactsBuildDirectoryForPlatform ) +import Control.Arrow ( left ) +import Control.Exception as E + ( try ) +import Control.Lens hiding ( List ) import Control.Monad.Catch 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 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 qualified Data.Conduit as C (runConduit, (.|)) -import qualified Data.Conduit.Binary as C (sinkFile, sourceLbs) -import Data.Function (on) +import Data.Char ( isNumber ) +import qualified Data.Conduit as C + ( runConduit + , (.|) + ) +import qualified Data.Conduit.Binary as C + ( sinkFile + , sourceLbs + ) +import Data.Function ( on ) import Data.List -import qualified Data.Map.Strict as M -import Data.Maybe (fromJust, fromMaybe) +import qualified Data.Map.Strict as M +import Data.Maybe ( fromJust + , fromMaybe + ) import Data.Romefile -import qualified Data.Text as T +import qualified Data.Text as T import Data.Text.Encoding -import qualified Data.Text.IO as T +import qualified Data.Text.IO as T import Data.Time -import qualified Network.AWS as AWS (Error, ErrorMessage(..), serviceMessage, _ServiceError) -import qualified Network.AWS.Data.Text as AWS (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) +import qualified Network.AWS as AWS + ( Error + , ErrorMessage(..) + , serviceMessage + , _ServiceError + ) +import qualified Network.AWS.Data.Text as AWS + ( 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 ) import qualified Turtle import Types -import Xcode.DWARF (DwarfUUID, bcsymbolmapNameFrom) +import Xcode.DWARF ( DwarfUUID + , bcsymbolmapNameFrom + ) @@ -58,15 +85,12 @@ romeVersionToString (major, minor, patch, build) = show major <> "." <> show minor <> "." <> show patch <> "." <> show build -- | Check if the given `RomeVersion` is the latest version compared to GitHub releases -checkIfRomeLatestVersionIs - :: MonadIO m => RomeVersion -> ExceptT String m (Bool, RomeVersion) +checkIfRomeLatestVersionIs :: MonadIO m => RomeVersion -> ExceptT String m (Bool, RomeVersion) checkIfRomeLatestVersionIs currentRomeVersion = do - req <- liftIO $ HTTP.parseRequest - "https://api.github.com/repos/blender/Rome/releases/latest" + req <- liftIO $ HTTP.parseRequest "https://api.github.com/repos/blender/Rome/releases/latest" let headers = HTTP.requestHeaders req <> [(HTTP.hUserAgent, userAgent)] - let req' = - req { HTTP.responseTimeout = timeout, HTTP.requestHeaders = headers } + let req' = req { HTTP.responseTimeout = timeout, HTTP.requestHeaders = headers } manager <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings @@ -74,8 +98,7 @@ checkIfRomeLatestVersionIs currentRomeVersion = do $ E.try (HTTP.responseBody <$> HTTP.httpLbs req' manager) let eitherTagName :: Either String String = - left show eitherBody >>= eitherDecode >>= \d -> - flip parseEither d $ \obj -> obj .: "tag_name" + left show eitherBody >>= eitherDecode >>= \d -> flip parseEither d $ \obj -> obj .: "tag_name" either throwError return $ (\tagVersion -> (currentRomeVersion >= tagVersion, tagVersion)) @@ -89,12 +112,7 @@ checkIfRomeLatestVersionIs currentRomeVersion = do . splitWithSeparator '.' . T.pack . dropWhile (not . isNumber) - versionTupleOrZeros a = - ( fromMaybe 0 (a !!? 0) - , fromMaybe 0 (a !!? 1) - , fromMaybe 0 (a !!? 2) - , fromMaybe 0 (a !!? 3) - ) + versionTupleOrZeros a = (fromMaybe 0 (a !!? 0), fromMaybe 0 (a !!? 1), fromMaybe 0 (a !!? 2), fromMaybe 0 (a !!? 3)) timeout = responseTimeoutMicro 1000000 -- 1 second userAgent = BS.pack $ "Rome/" <> romeVersionToString currentRomeVersion @@ -113,8 +131,7 @@ awsErrorToString :: AWS.Error -> Bool -> String awsErrorToString e verbose = if verbose then show e else AWS.showText $ fromMaybe (AWS.ErrorMessage "Unexpected Error") maybeServiceError - where - maybeServiceError = view AWS.serviceMessage =<< (e ^? AWS._ServiceError) + where maybeServiceError = view AWS.serviceMessage =<< (e ^? AWS._ServiceError) @@ -155,8 +172,7 @@ appendFrameworkExtensionTo (Framework a _ _) = a ++ ".framework" -- | Given a `Framework` and a `Version` produces a name for a Zip archive. frameworkArchiveName :: Framework -> Version -> String -frameworkArchiveName f@(Framework _ Dynamic _) (Version v) = - appendFrameworkExtensionTo f ++ "-" ++ v ++ ".zip" +frameworkArchiveName f@(Framework _ Dynamic _) (Version v) = appendFrameworkExtensionTo f ++ "-" ++ v ++ ".zip" frameworkArchiveName f@(Framework _ Static _) (Version v) = appendFrameworkExtensionTo f ++ "-" ++ "static" ++ "-" ++ v ++ ".zip" @@ -165,31 +181,22 @@ frameworkArchiveName f@(Framework _ Static _) (Version v) = -- | Given a `Framework` and a `Version` produces a name -- | for a dSYM Zip archive. dSYMArchiveName :: Framework -> Version -> String -dSYMArchiveName f@(Framework _ Dynamic _) (Version v) = - appendFrameworkExtensionTo f ++ ".dSYM" ++ "-" ++ v ++ ".zip" +dSYMArchiveName f@(Framework _ Dynamic _) (Version v) = appendFrameworkExtensionTo f ++ ".dSYM" ++ "-" ++ v ++ ".zip" dSYMArchiveName f@(Framework _ Static _) (Version v) = - appendFrameworkExtensionTo f - ++ ".dSYM" - ++ "-" - ++ "static" - ++ "-" - ++ v - ++ ".zip" + appendFrameworkExtensionTo f ++ ".dSYM" ++ "-" ++ "static" ++ "-" ++ v ++ ".zip" -- | Given a `DwarfUUID` and a `Version` produces a name -- | for a bcsymbolmap Zip archive. bcsymbolmapArchiveName :: DwarfUUID -> Version -> String -bcsymbolmapArchiveName d (Version v) = - bcsymbolmapNameFrom d ++ "-" ++ v ++ ".zip" +bcsymbolmapArchiveName d (Version v) = bcsymbolmapNameFrom d ++ "-" ++ v ++ ".zip" -- | Given a list of `CartfileEntry`s and a list of `ProjectName`s -- | produces a list of `CartfileEntry`s filtered by `ProjectName`s -filterCartfileEntriesByGitRepoNames - :: [ProjectName] -> [CartfileEntry] -> [CartfileEntry] +filterCartfileEntriesByGitRepoNames :: [ProjectName] -> [CartfileEntry] -> [CartfileEntry] filterCartfileEntriesByGitRepoNames repoNames cartfileEntries = [ c | c <- cartfileEntries, gitRepoNameFromCartfileEntry c `elem` repoNames ] @@ -206,55 +213,35 @@ gitRepoNameFromCartfileEntry :: CartfileEntry -> ProjectName gitRepoNameFromCartfileEntry (CartfileEntry GitHub (Location l) _) = ProjectName . T.unpack . last . splitWithSeparator '/' . T.pack $ l gitRepoNameFromCartfileEntry (CartfileEntry Git (Location l) _) = - ProjectName - . T.unpack - . T.replace ".git" "" - . last - . splitWithSeparator '/' - . T.pack - $ l + ProjectName . T.unpack . T.replace ".git" "" . last . splitWithSeparator '/' . T.pack $ l gitRepoNameFromCartfileEntry (CartfileEntry Binary (Location l) _) = - ProjectName - . T.unpack - . T.replace ".json" "" - . last - . splitWithSeparator '/' - . T.pack - $ l + ProjectName . T.unpack . T.replace ".json" "" . last . splitWithSeparator '/' . T.pack $ l -- | Given a list of `FrameworkVersion` and a `Framework` returns -- | a list for `FrameworkVersion` elements matching `Framework`. -filterByFrameworkEqualTo - :: [FrameworkVersion] -> Framework -> [FrameworkVersion] -filterByFrameworkEqualTo versions f = - [ ver | ver <- versions, _framework ver == f ] +filterByFrameworkEqualTo :: [FrameworkVersion] -> Framework -> [FrameworkVersion] +filterByFrameworkEqualTo versions f = [ ver | ver <- versions, _framework ver == f ] -- | Given a list of `FrameworkVersion` and a list of `Framework` -- | filters out of the list of `FrameworkVersion` elements that don't apper -- | in the list of `Framework`. -filterOutFrameworksAndVersionsIfNotIn - :: [FrameworkVersion] -> [Framework] -> [FrameworkVersion] +filterOutFrameworksAndVersionsIfNotIn :: [FrameworkVersion] -> [Framework] -> [FrameworkVersion] filterOutFrameworksAndVersionsIfNotIn versions frameworks = do ver@(FrameworkVersion f@(Framework n t _) v) <- versions -- For each version - let filteredFrameworks = - (\(Framework nF tF _) -> nF == n && tF == t) `filter` frameworks -- filter the frameworks to exclude based on name and type, not on the platforms + let filteredFrameworks = (\(Framework nF tF _) -> nF == n && tF == t) `filter` frameworks -- filter the frameworks to exclude based on name and type, not on the platforms if null filteredFrameworks -- If none match then return ver -- don't filter this FrameworkVersion out else do -- if there there are matches - let - filteredFrameworks2 = - f `removePlatformsIn` nub - (concatMap _frameworkPlatforms filteredFrameworks) + let filteredFrameworks2 = f `removePlatformsIn` nub (concatMap _frameworkPlatforms filteredFrameworks) guard (not . null $ _frameworkPlatforms filteredFrameworks2) -- if the entry completely filters out the FrameworkVersion then remove it return $ FrameworkVersion filteredFrameworks2 v -- if it doesn't, then remove from f the platforms that appear in the filter above. where removePlatformsIn :: Framework -> [TargetPlatform] -> Framework - removePlatformsIn (Framework n t ps) rPs = - Framework n t [ p | p <- ps, p `notElem` rPs ] + removePlatformsIn (Framework n t ps) rPs = Framework n t [ p | p <- ps, p `notElem` rPs ] @@ -267,18 +254,14 @@ removeIntersectingPlatforms lhs rhs = do -- | remove the overlapping platforms removeIntersectingPlatforms' :: Framework -> Framework -> Framework removeIntersectingPlatforms' f1@(Framework n t ps) (Framework n2 t2 ps2) - | n == n2 && t == t2 && (not . null) (ps `intersect` ps2) = Framework - n - t - [ p | p <- ps, p `notElem` ps2 ] + | n == n2 && t == t2 && (not . null) (ps `intersect` ps2) = Framework n t [ p | p <- ps, p `notElem` ps2 ] | otherwise = f1 -- | Given a `RepositoryMap` and a `ProjectName` returns a `RepositoryMap` -- | with that one `ProjectName` or an empty `RepositoryMap`. -restrictRepositoryMapToGitRepoName - :: RepositoryMap -> ProjectName -> RepositoryMap +restrictRepositoryMapToGitRepoName :: RepositoryMap -> ProjectName -> RepositoryMap restrictRepositoryMapToGitRepoName repoMap repoName = maybe M.empty (M.singleton repoName) $ repoName `M.lookup` repoMap @@ -287,16 +270,12 @@ restrictRepositoryMapToGitRepoName repoMap repoName = -- | Given two lists of `RomefileEntry`, adjust the entries in one list -- | according to entries in the other list. Specifically remove the platforms that -- | are common in both entries. If the resulting platforms are empty, remove the entry. -filterRomeFileEntriesByPlatforms - :: [RomefileEntry] -> [RomefileEntry] -> [RomefileEntry] -filterRomeFileEntriesByPlatforms lhs rhs = - (uncurry RomefileEntry <$>) . M.toList $ lhsMap `purgingPlatformsIn` rhsMap +filterRomeFileEntriesByPlatforms :: [RomefileEntry] -> [RomefileEntry] -> [RomefileEntry] +filterRomeFileEntriesByPlatforms lhs rhs = (uncurry RomefileEntry <$>) . M.toList $ lhsMap `purgingPlatformsIn` rhsMap where purgingPlatformsIn = M.differenceWith purge purge a b = - let filteredEntries = - (\(Framework _ _ ps) -> not . null $ ps) - `filter` (a `removeIntersectingPlatforms` b) + let filteredEntries = (\(Framework _ _ ps) -> not . null $ ps) `filter` (a `removeIntersectingPlatforms` b) in Just filteredEntries lhsMap = toRepositoryMap lhs rhsMap = toRepositoryMap rhs @@ -304,40 +283,28 @@ filterRomeFileEntriesByPlatforms lhs rhs = -- | Builds a string representing the remote path to a framework zip archive. -remoteFrameworkPath - :: TargetPlatform -> InvertedRepositoryMap -> Framework -> Version -> String -remoteFrameworkPath p r f v = - remoteCacheDirectory p r f ++ frameworkArchiveName f v +remoteFrameworkPath :: TargetPlatform -> InvertedRepositoryMap -> Framework -> Version -> String +remoteFrameworkPath p r f v = remoteCacheDirectory p r f ++ frameworkArchiveName f v -- | Builds a `String` representing the remote path to a dSYM zip archive -remoteDsymPath - :: TargetPlatform -> InvertedRepositoryMap -> Framework -> Version -> String +remoteDsymPath :: TargetPlatform -> InvertedRepositoryMap -> Framework -> Version -> String remoteDsymPath p r f v = remoteCacheDirectory p r f ++ dSYMArchiveName f v -- | Builds a `String` representing the remote path to a bcsymbolmap zip archive -remoteBcsymbolmapPath - :: DwarfUUID - -> TargetPlatform - -> InvertedRepositoryMap - -> Framework - -> Version - -> String -remoteBcsymbolmapPath d p r f v = - remoteCacheDirectory p r f ++ bcsymbolmapArchiveName d v +remoteBcsymbolmapPath :: DwarfUUID -> TargetPlatform -> InvertedRepositoryMap -> Framework -> Version -> String +remoteBcsymbolmapPath d p r f v = remoteCacheDirectory p r f ++ bcsymbolmapArchiveName d v -- | Builds a `String` representing the name of the remote cache directory for a -- | given conbination of `TargetPlatform` and `Framework` based on an -- | `InvertedRepositoryMap`. -remoteCacheDirectory - :: TargetPlatform -> InvertedRepositoryMap -> Framework -> String -remoteCacheDirectory p r f = repoName show p ++ "/" - where repoName = unProjectName $ repoNameForFrameworkName r f +remoteCacheDirectory :: TargetPlatform -> InvertedRepositoryMap -> Framework -> String +remoteCacheDirectory p r f = repoName show p ++ "/" where repoName = unProjectName $ repoNameForFrameworkName r f @@ -345,8 +312,7 @@ remoteCacheDirectory p r f = repoName show p ++ "/" -- | `ProjectNameAndVersion` remoteVersionFilePath :: ProjectNameAndVersion -> String remoteVersionFilePath (projectName, version) = - unProjectName projectName - versionFileNameForProjectNameVersioned projectName version + unProjectName projectName versionFileNameForProjectNameVersioned projectName version @@ -354,9 +320,7 @@ remoteVersionFilePath (projectName, version) = -- | a combination of `TargetPlatform` and `Framework` representing -- | the path to the framework's bundle frameworkBuildBundleForPlatform :: TargetPlatform -> Framework -> String -frameworkBuildBundleForPlatform p f = - carthageArtifactsBuildDirectoryForPlatform p f - appendFrameworkExtensionTo f +frameworkBuildBundleForPlatform p f = carthageArtifactsBuildDirectoryForPlatform p f appendFrameworkExtensionTo f @@ -388,19 +352,16 @@ romeFileEntryToTuple RomefileEntry {..} = (_projectName, _frameworks) -- | Creates a `ProjectName` from just the `frameworkName` of a `FrameworkName` -- | in case the lookup fails. repoNameForFrameworkName :: InvertedRepositoryMap -> Framework -> ProjectName -repoNameForFrameworkName reverseRomeMap framework = fromMaybe - (ProjectName . _frameworkName $ framework) - (M.lookup framework reverseRomeMap) +repoNameForFrameworkName reverseRomeMap framework = + fromMaybe (ProjectName . _frameworkName $ framework) (M.lookup framework reverseRomeMap) -- | Given an `InvertedRepositoryMap` and a list of `FrameworkVersion` produces -- | a list of __unique__ `ProjectNameAndVersion`s -repoNamesAndVersionForFrameworkVersions - :: InvertedRepositoryMap -> [FrameworkVersion] -> [ProjectNameAndVersion] -repoNamesAndVersionForFrameworkVersions reverseRomeMap versions = nub $ zip - (map (repoNameForFrameworkName reverseRomeMap . _framework) versions) - (map _frameworkVersion versions) +repoNamesAndVersionForFrameworkVersions :: InvertedRepositoryMap -> [FrameworkVersion] -> [ProjectNameAndVersion] +repoNamesAndVersionForFrameworkVersions reverseRomeMap versions = + nub $ zip (map (repoNameForFrameworkName reverseRomeMap . _framework) versions) (map _frameworkVersion versions) @@ -414,8 +375,7 @@ versionFileNameForProjectName prjn = "." <> unProjectName prjn <> ".version" -- | Given a `ProjectName` produces the appropriate file name for the corresponding -- | Carthage VersionFile with appenended `Version` information versionFileNameForProjectNameVersioned :: ProjectName -> Version -> String -versionFileNameForProjectNameVersioned prjn version = - versionFileNameForProjectName prjn <> "-" <> unVersion version +versionFileNameForProjectNameVersioned prjn version = versionFileNameForProjectName prjn <> "-" <> unVersion version @@ -438,10 +398,8 @@ formattedPlatformAvailability p = availabilityPrefix p ++ platformName p -- | Given a `RepositoryMap` and a list of `CartfileEntry` creates a list of -- | `FrameworkVersion`s. See `deriveFrameworkNameAndVersion` for details. -deriveFrameworkNamesAndVersion - :: RepositoryMap -> [CartfileEntry] -> [FrameworkVersion] -deriveFrameworkNamesAndVersion romeMap = - concatMap (deriveFrameworkNameAndVersion romeMap) +deriveFrameworkNamesAndVersion :: RepositoryMap -> [CartfileEntry] -> [FrameworkVersion] +deriveFrameworkNamesAndVersion romeMap = concatMap (deriveFrameworkNameAndVersion romeMap) @@ -449,10 +407,9 @@ deriveFrameworkNamesAndVersion romeMap = -- | Returns the HEAD commit hash in case there is no match deriveCurrentVersion :: MonadIO m => ExceptT String m Version deriveCurrentVersion = do - (revparseExitCode, headCommit, revparseErrorText) <- Turtle.procStrictWithErr - "git" - ["rev-parse", "HEAD"] - (return $ Turtle.unsafeTextToLine "") + (revparseExitCode, headCommit, revparseErrorText) <- Turtle.procStrictWithErr "git" + ["rev-parse", "HEAD"] + (return $ Turtle.unsafeTextToLine "") case revparseExitCode of Turtle.ExitSuccess -> do (describeExitCode, version, _) <- Turtle.procStrictWithErr @@ -461,7 +418,7 @@ deriveCurrentVersion = do (return $ Turtle.unsafeTextToLine "") case describeExitCode of Turtle.ExitSuccess -> return $ Version (T.unpack $ T.stripEnd version) - _ -> return $ Version (T.unpack $ T.stripEnd headCommit) + _ -> return $ Version (T.unpack $ T.stripEnd headCommit) _ -> throwError $ if (not . T.null) revparseErrorText then T.unpack $ errorMessageHeader <> revparseErrorText else T.unpack $ errorMessageHeader <> unknownErrorText @@ -473,12 +430,10 @@ deriveCurrentVersion = do -- | Given a `RepositoryMap` and a `CartfileEntry` creates a list of -- | `FrameworkVersion` by attaching the `Version` information from the -- | `FrameworkName` in the `CartfileEntry`. -deriveFrameworkNameAndVersion - :: RepositoryMap -> CartfileEntry -> [FrameworkVersion] -deriveFrameworkNameAndVersion romeMap cfe@(CartfileEntry _ _ v) = - map (`FrameworkVersion` v) $ fromMaybe - [Framework repositoryName Dynamic allTargetPlatforms] - (M.lookup (gitRepoNameFromCartfileEntry cfe) romeMap) +deriveFrameworkNameAndVersion :: RepositoryMap -> CartfileEntry -> [FrameworkVersion] +deriveFrameworkNameAndVersion romeMap cfe@(CartfileEntry _ _ v) = map (`FrameworkVersion` v) $ fromMaybe + [Framework repositoryName Dynamic allTargetPlatforms] + (M.lookup (gitRepoNameFromCartfileEntry cfe) romeMap) where repositoryName = unProjectName $ gitRepoNameFromCartfileEntry cfe @@ -495,24 +450,17 @@ filterRepoMapByGitRepoNames repoMap gitRepoNames = getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities :: InvertedRepositoryMap -> [FrameworkAvailability] -> [ProjectAvailability] getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities reverseRomeMap = - concatMap mergeRepoAvailabilities - . groupAvailabilities - . getGitRepoAvalabilities + concatMap mergeRepoAvailabilities . groupAvailabilities . getGitRepoAvalabilities where getGitRepoAvalabilities :: [FrameworkAvailability] -> [ProjectAvailability] - getGitRepoAvalabilities = - fmap getGitRepoAvailabilityFromFrameworkAvailability + getGitRepoAvalabilities = fmap getGitRepoAvailabilityFromFrameworkAvailability - getGitRepoAvailabilityFromFrameworkAvailability - :: FrameworkAvailability -> ProjectAvailability - getGitRepoAvailabilityFromFrameworkAvailability (FrameworkAvailability (FrameworkVersion fwn v) availabilities) - = ProjectAvailability (repoNameForFrameworkName reverseRomeMap fwn) - v - availabilities + getGitRepoAvailabilityFromFrameworkAvailability :: FrameworkAvailability -> ProjectAvailability + getGitRepoAvailabilityFromFrameworkAvailability (FrameworkAvailability (FrameworkVersion fwn v) availabilities) = + ProjectAvailability (repoNameForFrameworkName reverseRomeMap fwn) v availabilities groupAvailabilities :: [ProjectAvailability] -> [[ProjectAvailability]] - groupAvailabilities = groupBy ((==) `on` _availabilityProject) - . sortBy (compare `on` _availabilityProject) + groupAvailabilities = groupBy ((==) `on` _availabilityProject) . sortBy (compare `on` _availabilityProject) -- | Given a list of `ProjectAvailability`s produces a singleton list of -- | `ProjectAvailability`s containing all `PlatformAvailability`s of the @@ -530,27 +478,22 @@ getMergedGitRepoAvailabilitiesFromFrameworkAvailabilities reverseRomeMap = -- } -- ] mergeRepoAvailabilities :: [ProjectAvailability] -> [ProjectAvailability] - mergeRepoAvailabilities [] = [] - mergeRepoAvailabilities repoAvailabilities@(x : _) = - [x { _repoPlatformAvailabilities = platformAvailabilities }] + mergeRepoAvailabilities [] = [] + mergeRepoAvailabilities repoAvailabilities@(x : _) = [x { _repoPlatformAvailabilities = platformAvailabilities }] where groupedPlatformAvailabilities :: [[PlatformAvailability]] - groupedPlatformAvailabilities = sortAndGroupPlatformAvailabilities - (repoAvailabilities >>= _repoPlatformAvailabilities) + groupedPlatformAvailabilities = + sortAndGroupPlatformAvailabilities (repoAvailabilities >>= _repoPlatformAvailabilities) - bothAvailable - :: PlatformAvailability -> PlatformAvailability -> PlatformAvailability + bothAvailable :: PlatformAvailability -> PlatformAvailability -> PlatformAvailability bothAvailable p p' = p { _isAvailable = _isAvailable p && _isAvailable p' } platformAvailabilities :: [PlatformAvailability] - platformAvailabilities = - fmap (foldl1 bothAvailable) groupedPlatformAvailabilities + platformAvailabilities = fmap (foldl1 bothAvailable) groupedPlatformAvailabilities - sortAndGroupPlatformAvailabilities - :: [PlatformAvailability] -> [[PlatformAvailability]] + sortAndGroupPlatformAvailabilities :: [PlatformAvailability] -> [[PlatformAvailability]] sortAndGroupPlatformAvailabilities = - groupBy ((==) `on` _availabilityPlatform) - . sortBy (compare `on` _availabilityPlatform) + groupBy ((==) `on` _availabilityPlatform) . sortBy (compare `on` _availabilityPlatform) @@ -577,10 +520,7 @@ createZipArchive filePath verbose = do if fileExists || directoryExist then do when verbose $ sayLnWithTime $ "Starting to zip: " <> filePath - liftIO $ Zip.addFilesToArchive - [Zip.OptRecursive, Zip.OptPreserveSymbolicLinks] - Zip.emptyArchive - [filePath] + liftIO $ Zip.addFilesToArchive [Zip.OptRecursive, Zip.OptPreserveSymbolicLinks] Zip.emptyArchive [filePath] else throwError $ "Error: " <> filePath <> " does not exist" @@ -636,14 +576,11 @@ deleteFrameworkDirectory -> TargetPlatform -- ^ The `TargetPlatform` to restrict this operation to -> Bool -- ^ A flag controlling verbosity -> m () -deleteFrameworkDirectory (FrameworkVersion f _) platform = deleteDirectory - frameworkDirectory +deleteFrameworkDirectory (FrameworkVersion f _) platform = deleteDirectory frameworkDirectory where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - frameworkDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + frameworkDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension @@ -654,14 +591,11 @@ deleteDSYMDirectory -> TargetPlatform -- ^ The `TargetPlatform` to restrict this operation to -> Bool -- ^ A flag controlling verbosity -> m () -deleteDSYMDirectory (FrameworkVersion f _) platform = deleteDirectory - dSYMDirectory +deleteDSYMDirectory (FrameworkVersion f _) platform = deleteDirectory dSYMDirectory where frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f - platformBuildDirectory = - carthageArtifactsBuildDirectoryForPlatform platform f - dSYMDirectory = - platformBuildDirectory frameworkNameWithFrameworkExtension <> ".dSYM" + platformBuildDirectory = carthageArtifactsBuildDirectoryForPlatform platform f + dSYMDirectory = platformBuildDirectory frameworkNameWithFrameworkExtension <> ".dSYM" @@ -676,22 +610,10 @@ unzipBinary unzipBinary objectBinary objectName objectZipName verbose = do when verbose $ sayLnWithTime $ "Starting to unzip " <> objectZipName if LBS.length objectBinary == 0 - then - when verbose - $ sayLnWithTime - $ "Warning: " - <> objectZipName - <> " is ZERO bytes" + then when verbose $ sayLnWithTime $ "Warning: " <> objectZipName <> " is ZERO bytes" else do - liftIO $ Zip.extractFilesFromArchive - [Zip.OptRecursive, Zip.OptPreserveSymbolicLinks] - (Zip.toArchive objectBinary) - when verbose - $ sayLnWithTime - $ "Unzipped " - <> objectName - <> " from: " - <> objectZipName + liftIO $ Zip.extractFilesFromArchive [Zip.OptRecursive, Zip.OptPreserveSymbolicLinks] (Zip.toArchive objectBinary) + when verbose $ sayLnWithTime $ "Unzipped " <> objectName <> " from: " <> objectZipName @@ -703,10 +625,7 @@ saveBinaryToFile -> m () saveBinaryToFile binaryArtifact destinationPath = do liftIO $ createDirectoryIfMissing True (dropFileName destinationPath) - runResourceT - $ C.runConduit - $ C.sourceLbs binaryArtifact - C..| C.sinkFile destinationPath + runResourceT $ C.runConduit $ C.sourceLbs binaryArtifact C..| C.sinkFile destinationPath diff --git a/src/Xcode/DWARF.hs b/src/Xcode/DWARF.hs index 2ed1e3c8..f679ed69 100644 --- a/src/Xcode/DWARF.hs +++ b/src/Xcode/DWARF.hs @@ -1,22 +1,24 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE OverloadedStrings #-} -module Xcode.DWARF ( dwarfUUIDsFrom - , DwarfUUID(..) - , bcsymbolmapNameFrom +module Xcode.DWARF + ( dwarfUUIDsFrom + , DwarfUUID(..) + , bcsymbolmapNameFrom -- test only - , Arch (..) - , parseDwarfdumpUUID - ) where + , Arch(..) + , parseDwarfdumpUUID + ) +where -import Control.Applicative ((<|>)) +import Control.Applicative ( (<|>) ) import Control.Monad.Except -import Data.Char (toLower) -import qualified Data.Text as T -import qualified Text.Parsec as Parsec +import Data.Char ( toLower ) +import qualified Data.Text as T +import qualified Text.Parsec as Parsec import Text.Read -import qualified Text.Read.Lex as L +import qualified Text.Read.Lex as L import qualified Turtle @@ -25,16 +27,16 @@ import qualified Turtle data Arch = ARMV7 | ARM64 | I386 | X86_64 | Other String deriving (Eq) instance Show Arch where - show ARMV7 = "armv7" - show ARM64 = "arm64" - show I386 = "i386" - show X86_64 = "x86_64" - show (Other s) = s + show ARMV7 = "armv7" + show ARM64 = "arm64" + show I386 = "i386" + show X86_64 = "x86_64" + show (Other s) = s instance Read Arch where - readPrec = parens $ do - L.Ident s <- lexP - case map toLower s of + readPrec = parens $ do + L.Ident s <- lexP + case map toLower s of "armv7" -> return ARMV7 "arm64" -> return ARM64 "i386" -> return I386 @@ -59,16 +61,12 @@ dwarfUUIDsFrom => FilePath -- ^ Path to dSYM or .framework/ -> ExceptT String m [DwarfUUID] dwarfUUIDsFrom fPath = do - (exitCode, stdOutText, stdErrText) <- Turtle.procStrictWithErr - "xcrun" - ["dwarfdump", "--uuid", T.pack fPath] - (return $ Turtle.unsafeTextToLine "") + (exitCode, stdOutText, stdErrText) <- Turtle.procStrictWithErr "xcrun" + ["dwarfdump", "--uuid", T.pack fPath] + (return $ Turtle.unsafeTextToLine "") case exitCode of - Turtle.ExitSuccess -> - either (throwError . (\e -> errorMessageHeader ++ show e)) return - $ mapM - (Parsec.parse parseDwarfdumpUUID "" . T.unpack) - (T.lines stdOutText) + Turtle.ExitSuccess -> either (throwError . (\e -> errorMessageHeader ++ show e)) return + $ mapM (Parsec.parse parseDwarfdumpUUID "" . T.unpack) (T.lines stdOutText) _ -> throwError $ errorMessageHeader ++ T.unpack stdErrText where errorMessageHeader = "Failed parsing DWARF UUID: " @@ -76,13 +74,9 @@ dwarfUUIDsFrom fPath = do -- UUID: EDF2AE8A-2EB4-3CA0-986F-D3E49D8C675F (i386) Carthage/Build/iOS/Alamofire.framework/Alamofire parseDwarfdumpUUID :: Parsec.Parsec String () DwarfUUID parseDwarfdumpUUID = do - uuid <- - Parsec.string "UUID:" - >> Parsec.spaces - >> Parsec.manyTill (Parsec.hexDigit <|> Parsec.char '-') Parsec.space - archString <- paren - $ Parsec.many1 (Parsec.noneOf [')', ' ', '\t', '\n', '\r']) - return DwarfUUID {_uuid = uuid, _arch = read archString} + uuid <- Parsec.string "UUID:" >> Parsec.spaces >> Parsec.manyTill (Parsec.hexDigit <|> Parsec.char '-') Parsec.space + archString <- paren $ Parsec.many1 (Parsec.noneOf [')', ' ', '\t', '\n', '\r']) + return DwarfUUID { _uuid = uuid, _arch = read archString } where paren = Parsec.between (Parsec.char '(') (Parsec.char ')') diff --git a/stack.yaml b/stack.yaml index 1660499a..51a5615e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-13.10 +resolver: lts-14.14 # User packages to be built. # Various formats can be used as shown in the example below. @@ -47,7 +47,11 @@ resolver: lts-13.10 # extra-dep: true # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) -#extra-deps: +extra-deps: + - amazonka-1.6.1@sha256:d863557379350ed6bbb91187abeb8c349a654f60b140d138710486f58ae7c476,3536 + - amazonka-core-1.6.1@sha256:9bc59ce403c6eeba3b3eaf3f10e5f0b6a33b6edbbf8f6de0dd6f4c67b86fa698,5135 + - amazonka-s3-1.6.1@sha256:9d07240fca59ad5197fb614ce3051e701e4951e6d4625a2dab4a9c17a1900194,6317 + - amazonka-sts-1.6.1@sha256:224759e5e45234064864a66b504c9c300028c50939184f533c004dea351156b1,3190 #- url-2.1.3 #- yaml-0.9.0 # Override default flag values for local packages and extra-deps diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 00000000..0f20786f --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,40 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: amazonka-1.6.1@sha256:d863557379350ed6bbb91187abeb8c349a654f60b140d138710486f58ae7c476,3536 + pantry-tree: + size: 992 + sha256: 55747f9b56063ea1be73a962e1ce44528b9856e119e2d9f1238397b3112b6e70 + original: + hackage: amazonka-1.6.1@sha256:d863557379350ed6bbb91187abeb8c349a654f60b140d138710486f58ae7c476,3536 +- completed: + hackage: amazonka-core-1.6.1@sha256:9bc59ce403c6eeba3b3eaf3f10e5f0b6a33b6edbbf8f6de0dd6f4c67b86fa698,5135 + pantry-tree: + size: 3438 + sha256: c13e643176308771491ec0e06390e269047bb1b28be4535992842f7426a95eb4 + original: + hackage: amazonka-core-1.6.1@sha256:9bc59ce403c6eeba3b3eaf3f10e5f0b6a33b6edbbf8f6de0dd6f4c67b86fa698,5135 +- completed: + hackage: amazonka-s3-1.6.1@sha256:9d07240fca59ad5197fb614ce3051e701e4951e6d4625a2dab4a9c17a1900194,6317 + pantry-tree: + size: 18385 + sha256: 5cab233d241615764d9fd6927bc397f02887154450a9932c38c2e17ea86d79bc + original: + hackage: amazonka-s3-1.6.1@sha256:9d07240fca59ad5197fb614ce3051e701e4951e6d4625a2dab4a9c17a1900194,6317 +- completed: + hackage: amazonka-sts-1.6.1@sha256:224759e5e45234064864a66b504c9c300028c50939184f533c004dea351156b1,3190 + pantry-tree: + size: 2470 + sha256: a7010e9bd69288ca0dfda026ecaa05aff9df162f06077ac3e09b2922ee6d812b + original: + hackage: amazonka-sts-1.6.1@sha256:224759e5e45234064864a66b504c9c300028c50939184f533c004dea351156b1,3190 +snapshots: +- completed: + size: 525663 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/14.yaml + sha256: 6edc48df46eb8bf7b861e98dd30d021a92c2e1820c9bb6528aac5d997b0e14ef + original: lts-14.14 diff --git a/tests/Tests.hs b/tests/Tests.hs index 2c195db4..25081233 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,16 +1,23 @@ module Main where -import Control.Arrow (left, right) +import Control.Arrow ( left + , right + ) import Control.Monad import Data.Carthage.Cartfile import Data.Carthage.TargetPlatform -import Data.Either (rights) -import Data.List (intercalate, nub, intersect) -import Data.Yaml (decodeEither', encode) +import Data.Either ( rights ) +import Data.List ( intercalate + , nub + , intersect + ) +import Data.Yaml ( decodeEither' + , encode + ) import Data.Romefile -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Text.Parsec as Parsec +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Text.Parsec as Parsec import Types import Utils import Xcode.DWARF @@ -38,45 +45,34 @@ instance Arbitrary Version where prop_filterByNameEqualTo_idempotent :: [FrameworkVersion] -> Framework -> Bool prop_filterByNameEqualTo_idempotent ls n = - filterByFrameworkEqualTo ls n - == filterByFrameworkEqualTo (filterByFrameworkEqualTo ls n) n + filterByFrameworkEqualTo ls n == filterByFrameworkEqualTo (filterByFrameworkEqualTo ls n) n prop_filterByNameEqualTo_smaller :: [FrameworkVersion] -> Framework -> Bool -prop_filterByNameEqualTo_smaller ls n = - length (filterByFrameworkEqualTo ls n) <= length ls +prop_filterByNameEqualTo_smaller ls n = length (filterByFrameworkEqualTo ls n) <= length ls prop_filterByNameEqualTo_model :: [FrameworkVersion] -> Framework -> Bool prop_filterByNameEqualTo_model ls n = - map _framework (filterByFrameworkEqualTo ls n) - == filter (== n) (map _framework ls) + map _framework (filterByFrameworkEqualTo ls n) == filter (== n) (map _framework ls) -prop_filterOutFrameworkNamesAndVersionsIfNotIn_idempotent - :: [FrameworkVersion] -> [Framework] -> Bool +prop_filterOutFrameworkNamesAndVersionsIfNotIn_idempotent :: [FrameworkVersion] -> [Framework] -> Bool prop_filterOutFrameworkNamesAndVersionsIfNotIn_idempotent ls ns = filterOutFrameworksAndVersionsIfNotIn ls ns - == filterOutFrameworksAndVersionsIfNotIn - (filterOutFrameworksAndVersionsIfNotIn ls ns) - ns + == filterOutFrameworksAndVersionsIfNotIn (filterOutFrameworksAndVersionsIfNotIn ls ns) ns -prop_filterOutFrameworkNamesAndVersionsIfNotIn_smaller - :: [FrameworkVersion] -> [Framework] -> Bool +prop_filterOutFrameworkNamesAndVersionsIfNotIn_smaller :: [FrameworkVersion] -> [Framework] -> Bool prop_filterOutFrameworkNamesAndVersionsIfNotIn_smaller ls ns = length (filterOutFrameworksAndVersionsIfNotIn ls ns) <= length ls -prop_filterOutFrameworkNamesAndVersionsIfNotIn_filterAllOut - :: [Version] -> [Framework] -> Bool -prop_filterOutFrameworkNamesAndVersionsIfNotIn_filterAllOut vs fws = +prop_filterOutFrameworkNamesAndVersionsIfNotIn_filterAllOut :: [Version] -> [Framework] -> Bool +prop_filterOutFrameworkNamesAndVersionsIfNotIn_filterAllOut vs fws = null $ (FrameworkVersion <$> fws <*> vs) `filterOutFrameworksAndVersionsIfNotIn` fws prop_split_length :: Char -> String -> Property prop_split_length sep ls = - not (null ls) ==> length (splitWithSeparator sep (T.pack ls)) == 1 + length - (filter (== sep) ls) + not (null ls) ==> length (splitWithSeparator sep (T.pack ls)) == 1 + length (filter (== sep) ls) prop_split_string :: String -> Property -prop_split_string ls = - not (null ls) ==> splitWithSeparator '/' (T.pack ls) == T.split (== '/') - (T.pack ls) +prop_split_string ls = not (null ls) ==> splitWithSeparator '/' (T.pack ls) == T.split (== '/') (T.pack ls) data TestDwarfUUID = TDUUID String String Arch deriving Show @@ -85,13 +81,13 @@ instance Arbitrary TestDwarfUUID where uuid <- arbitraryUUID arch <- arbitraryArch return $ TDUUID (toInputLine uuid arch) uuid arch - where - toInputLine uuid arch = - "UUID: " ++ uuid ++ " (" ++ show arch ++ ") Carthage/Build/iOS/Foo.framework/Foo" - arbitraryUUID = fmap (intercalate "-") - (sequence [vectorOf 8 hexDigits, vectorOf 4 hexDigits, vectorOf 4 hexDigits, vectorOf 12 hexDigits]) - hexDigits = elements (['A'..'F'] ++ ['0'..'9']) - arbitraryArch = arbitrary + where + toInputLine uuid arch = "UUID: " ++ uuid ++ " (" ++ show arch ++ ") Carthage/Build/iOS/Foo.framework/Foo" + arbitraryUUID = fmap + (intercalate "-") + (sequence [vectorOf 8 hexDigits, vectorOf 4 hexDigits, vectorOf 4 hexDigits, vectorOf 12 hexDigits]) + hexDigits = elements (['A' .. 'F'] ++ ['0' .. '9']) + arbitraryArch = arbitrary instance Arbitrary Arch where arbitrary = oneof $ fmap return [ARMV7, ARM64, I386, X86_64, Other "foobar"] @@ -110,7 +106,7 @@ data TestRomefile = TestRomefile { hasLocalCache :: Bool instance Arbitrary TestRomefile where arbitrary = do - (blCache, bS3Bucket) <- arbitrary `suchThat` (\(a, b) -> a || b ) :: Gen (Bool, Bool) + (blCache, bS3Bucket) <- arbitrary `suchThat` (\(a, b) -> a || b) :: Gen (Bool, Bool) TestRomefile blCache bS3Bucket <$> arbitrary <*> arbitrary toIniText :: TestRomefile -> T.Text @@ -119,11 +115,9 @@ toIniText r = T.pack $ "[Cache]\n" ++ if hasLocalCache r else "" ++ if hasS3Bucket r then " S3-Bucket = some-bucket\n" else "" ++ if not . null $ rMapEntries r - then "[RepositoryMap]\n" - ++ intercalate "\n" (map toIniTextRE (rMapEntries r)) + then "[RepositoryMap]\n" ++ intercalate "\n" (map toIniTextRE (rMapEntries r)) else "" ++ if not . null $ iMapEntries r - then "[IgnoreMap]\n" - ++ intercalate "\n" (map toIniTextRE (iMapEntries r)) + then "[IgnoreMap]\n" ++ intercalate "\n" (map toIniTextRE (iMapEntries r)) else "" toIniTextRE :: RomefileEntry -> String @@ -132,30 +126,27 @@ toIniTextRE r = " " ++ (unProjectName (_projectName r)) ++ " = " ++ f prop_parse_dwarf_dumpUUID :: TestDwarfUUID -> Bool prop_parse_dwarf_dumpUUID (TDUUID inputLine uuid arch) = - Right (DwarfUUID uuid arch) - == Parsec.parse parseDwarfdumpUUID "test" inputLine + Right (DwarfUUID uuid arch) == Parsec.parse parseDwarfdumpUUID "test" inputLine prop_romefileINIToYamlToRomefile_idempotent_romefileINI :: TestRomefile -> Bool -prop_romefileINIToYamlToRomefile_idempotent_romefileINI t = - rights [parseRomefile (toIniText t)] == rights - [ parseRomefile (toIniText t) - >>= Right - . encode - >>= left show - . decodeEither' - ] +prop_romefileINIToYamlToRomefile_idempotent_romefileINI t = rights [parseRomefile (toIniText t)] + == rights [parseRomefile (toIniText t) >>= Right . encode >>= left show . decodeEither'] prop_filterRomeFileEntriesByPlatforms_idempotent :: [RomefileEntry] -> [RomefileEntry] -> Bool -prop_filterRomeFileEntriesByPlatforms_idempotent base filteringValues = - base `filterRomeFileEntriesByPlatforms` filteringValues - == (base `filterRomeFileEntriesByPlatforms` filteringValues) `filterRomeFileEntriesByPlatforms` filteringValues +prop_filterRomeFileEntriesByPlatforms_idempotent base filteringValues = + base + `filterRomeFileEntriesByPlatforms` filteringValues + == (base `filterRomeFileEntriesByPlatforms` filteringValues) + `filterRomeFileEntriesByPlatforms` filteringValues -prop_filterRomeFileEntriesByPlatforms_filters :: [RomefileEntry] -> [RomefileEntry] -> Bool -prop_filterRomeFileEntriesByPlatforms_filters base filteringValues = null $ (base `filterRomeFileEntriesByPlatforms` filteringValues) `intersect` filteringValues +prop_filterRomeFileEntriesByPlatforms_filters :: [RomefileEntry] -> [RomefileEntry] -> Bool +prop_filterRomeFileEntriesByPlatforms_filters base filteringValues = + null $ (base `filterRomeFileEntriesByPlatforms` filteringValues) `intersect` filteringValues prop_filterRomeFileEntriesByPlatforms_min :: [RomefileEntry] -> [RomefileEntry] -> Bool -prop_filterRomeFileEntriesByPlatforms_min base filteringValues = (length $ base `filterRomeFileEntriesByPlatforms` filteringValues) <= length base +prop_filterRomeFileEntriesByPlatforms_min base filteringValues = + (length $ base `filterRomeFileEntriesByPlatforms` filteringValues) <= length base main :: IO () main = do @@ -192,9 +183,9 @@ main = do putStrLn "prop_filterRomeFileEntriesByPlatforms_idempotent" quickCheck (withMaxSuccess 1000 prop_filterRomeFileEntriesByPlatforms_idempotent) - + putStrLn "prop_filterRomeFileEntriesByPlatforms_min" quickCheck (withMaxSuccess 1000 prop_filterRomeFileEntriesByPlatforms_min) putStrLn "prop_filterRomeFileEntriesByPlatforms_filters" - quickCheck (withMaxSuccess 1000 prop_filterRomeFileEntriesByPlatforms_filters) \ No newline at end of file + quickCheck (withMaxSuccess 1000 prop_filterRomeFileEntriesByPlatforms_filters)