Feature/repo names instead of framework names

README.md

@@ -191,26 +191,33 @@ Available commands:
 Uploading one or more frameworks and corresponding dSYMs
 (an empty list of frameworks will upload all frameworks found in `Cartfile.resolved`):
 
+Referring to the `Cartfile.resolved` in [RepositoryMap](#RepositoryMap)
+
 ```
-$ rome upload Alamofire FGAuth
-Uploaded: Alamofire/Alamofire.framework-3.4.1.zip
-Uploaded: Alamofire/Alamofire.framework.dSYM-3.4.1.zip
-Uploaded: FGAuth/FGAuth.framework-v3.3.3.zip
+$ rome upload HockeySDK-iOS awesome-framework-for-cat-names
+Uploaded HockeySDK to: bitstadium/HockeySDK.framework-3.8.6.zip
+Uploaded HockeySDK.dSYM to: bitstadium/HockeySDK.framework.dSYM-3.8.6.zip
+Uploaded CatFramework to: CatFramework/CatFramework.framework-3.3.1.zip
+Uploaded CatFramework.dSYM to: CatFramework/CatFramework.framework.dSYM-3.3.1.zip
 ```
 
 #### Downloading
 
 Downloading one or more frameworks and corresponding dSYMs
 (an empty list of frameworks will download all frameworks found in `Cartfile.resolved`):
 
+Referring to the `Cartfile.resolved` in [RepositoryMap](#RepositoryMap)
+
 ```
-$ rome download Alamofire FGAuth
-Downloaded: Alamofire.framework-3.4.1.zip
-Unzipped: Alamofire.framework-3.4.1.zip
-Downloaded: Alamofire.framework.dSYM-3.4.1.zip
-Unzipped: Alamofire.framework.dSYM-3.4.1.zip
-Downloaded: FGAuth.framework-v3.3.3.zip
-Unzipped: FGAuth.framework-v3.3.3.zip
+$ rome download HockeySDK-iOS awesome-framework-for-cat-names
+Downloaded HockeySDK from: HockeySDK/HockeySDK.framework-3.8.6.zip
+Unzipped HockeySDK from: HockeySDK.framework-3.8.6.zip
+Downloaded HockeySDK.dSYM from: HockeySDK/HockeySDK.framework.dSYM-3.8.6.zip
+Unzipped HockeySDK.dSYM from: HockeySDK.framework.dSYM-3.8.6.zip
+Downloaded CatFramework from: CatFramework/CatFramework.framework-3.3.1.zip
+Unzipped CatFramework from: CatFramework.framework-3.3.1.zip
+Downloaded CatFramework from: CatFramework/CatFramework.framework.dSYM-3.3.1.zip
+Unzipped CatFramework from: CatFramework.framework.dSYM-3.3.1.zip
 ```
 
 #### Listing
@@ -246,7 +253,7 @@ $ rome list --present
 ResearchKit
 ```
 
-Note: `list` completely ignores dSYMs. If a dSYM is missing the corresponding
+Note: `list` __completely ignores dSYMs__. If a dSYM is missing the corresponding
 framework is still reported as present.
 
 ## Get Rome

Rome.cabal

@@ -1,5 +1,5 @@
 name:                Rome
-version:             0.6.1.11
+version:             0.7.0.12
 synopsis:            An S3 cache for Carthage
 description:         Please see README.md
 homepage:            https://github.com/blender/Rome

app/Main.hs

@@ -8,7 +8,7 @@ import           Options.Applicative  as Opts
 
 
 romeVersion :: String
-romeVersion = "0.6.1.11"
+romeVersion = "0.7.0.12"
 
 
 

src/Data/Cartfile.hs

@@ -17,10 +17,10 @@ import qualified Text.Parsec         as Parsec
 import qualified Text.Parsec.String  as Parsec
 import qualified Text.Parsec.Utils   as Parsec
 
-newtype Location = Location { unLocation :: String } 
-                 deriving (Eq, Show)
-newtype Version = Version { unVersion :: String } 
-                deriving (Eq, Show)
+newtype Location = Location { unLocation :: String }
+                   deriving (Eq, Show, Ord)
+newtype Version  = Version { unVersion :: String }
+                   deriving (Eq, Show, Ord)
 
 data RepoHosting = GitHub | Git
   deriving (Eq, Show)
@@ -57,9 +57,9 @@ quotedContent = do
 parseCartfileResolvedLine :: Parsec.Parsec String () CartfileEntry
 parseCartfileResolvedLine = do
   hosting <- repoHosting
-  location <- (fmap Location) quotedContent
+  location <- fmap Location quotedContent
   Parsec.many1 Parsec.space
-  version <- (fmap Version) quotedContent
+  version <- fmap Version quotedContent
   Parsec.endOfLine
   return CartfileEntry {..}
 

src/Data/Romefile.hs

@@ -24,15 +24,15 @@ import           Control.Monad.Trans
 
 
 newtype FrameworkName = FrameworkName { unFrameworkName :: String }
-                      deriving (Show, Eq, Ord)
+                        deriving (Eq, Show, Ord)
 
-newtype GitRepoName = GitRepoName { unGitRepoName :: String } 
-                    deriving (Eq, Show, Ord)
+newtype GitRepoName   = GitRepoName { unGitRepoName :: String }
+                        deriving (Eq, Show, Ord)
 
-data RomefileEntry = RomefileEntry { gitRepositoryName   :: GitRepoName
-                                   , frameworkCommonNames :: [FrameworkName]
-                                   }
-                                   deriving (Show, Eq)
+data RomefileEntry    = RomefileEntry { gitRepositoryName   :: GitRepoName
+                                      , frameworkCommonNames :: [FrameworkName]
+                                      }
+                                      deriving (Show, Eq)
 
 
 

src/Lib.hs

@@ -29,7 +29,7 @@ import           Data.Char                    (isSpace)
 import           Data.Conduit.Binary          (sinkLbs)
 import           Data.Ini                     as INI
 import           Data.Ini.Utils               as INI
-import qualified Data.Map                     as M
+import qualified Data.Map.Strict              as M
 import           Data.Maybe
 import           Data.Romefile
 import           Data.String.Utils
@@ -46,11 +46,13 @@ import           System.Environment
 
 {- Types -}
 
-type Config        = (AWS.Env, Bool)
-type RomeMonad     = ExceptT String IO
+type Config                = (AWS.Env, Bool)
+type RomeMonad             = ExceptT String IO
+type RepositoryMap         = M.Map GitRepoName [FrameworkName]
+type InvertedRepositoryMap = M.Map FrameworkName GitRepoName
 
-data RomeCommand = Upload [FrameworkName]
-                  | Download [FrameworkName]
+data RomeCommand = Upload [GitRepoName]
+                  | Download [GitRepoName]
                   | List ListMode
                   deriving (Show, Eq)
 
@@ -67,10 +69,10 @@ data RomeOptions = RomeOptions { romeCommand :: RomeCommand
 
 {- Functions -}
 uploadParser :: Opts.Parser RomeCommand
-uploadParser = pure Upload <*> Opts.many (Opts.argument (FrameworkName <$> str) (Opts.metavar "FRAMEWORKS..." <> Opts.help "Zero or more framework names. If zero, all frameworks and dSYMs are uploaded."))
+uploadParser = pure Upload <*> Opts.many (Opts.argument (GitRepoName <$> str) (Opts.metavar "FRAMEWORKS..." <> Opts.help "Zero or more framework names. If zero, all frameworks and dSYMs are uploaded."))
 
 downloadParser :: Opts.Parser RomeCommand
-downloadParser = pure Download <*> Opts.many (Opts.argument (FrameworkName <$> str) (Opts.metavar "FRAMEWORKS..." <> Opts.help "Zero or more framework names. If zero, all frameworks and dSYMs are downloaded."))
+downloadParser = pure Download <*> Opts.many (Opts.argument (GitRepoName <$> str) (Opts.metavar "FRAMEWORKS..." <> Opts.help "Zero or more framework names. If zero, all frameworks and dSYMs are downloaded."))
 
 listParser :: Opts.Parser RomeCommand
 listParser = pure List <*> (
@@ -107,39 +109,46 @@ runRomeWithOptions :: AWS.Env -> RomeOptions -> ExceptT String IO ()
 runRomeWithOptions env (RomeOptions options verbose) = do
   cartfileEntries <- getCartfileEntires
   (s3BucketName, romefileEntries) <- getRomefileEntries
+  let respositoryMap = toRomeFilesEntriesMap romefileEntries
   case options of
 
       Upload [] -> do
-        let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries romefileEntries
+        let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries respositoryMap
         liftIO $ runReaderT (uploadFrameworksAndDsymsToS3 s3BucketName frameworkAndVersions) (env, verbose)
 
-      Upload names ->
-        liftIO $ runReaderT (uploadFrameworksAndDsymsToS3 s3BucketName (filterByNames cartfileEntries romefileEntries names)) (env, verbose)
+      Upload gitRepoNames -> do
+        let frameworkAndVersions = constructFrameworksAndVersionsFrom  (filterCartfileEntriesByGitRepoNames gitRepoNames cartfileEntries) respositoryMap
+        liftIO $ runReaderT (uploadFrameworksAndDsymsToS3 s3BucketName frameworkAndVersions) (env, verbose)
 
       Download [] -> do
-        let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries romefileEntries
+        let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries respositoryMap
         liftIO $ runReaderT (downloadFrameworksAndDsymsFromS3 s3BucketName frameworkAndVersions) (env, verbose)
 
-      Download names ->
-        liftIO $ runReaderT (downloadFrameworksAndDsymsFromS3 s3BucketName (filterByNames cartfileEntries romefileEntries names)) (env, verbose)
+      Download gitRepoNames -> do
+        let frameworkAndVersions = constructFrameworksAndVersionsFrom  (filterCartfileEntriesByGitRepoNames gitRepoNames cartfileEntries) respositoryMap
+        liftIO $ runReaderT (downloadFrameworksAndDsymsFromS3 s3BucketName frameworkAndVersions) (env, verbose)
 
       List listMode -> do
-        let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries romefileEntries
+        let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries respositoryMap
         existing <- liftIO $ runReaderT (probeForFrameworks s3BucketName frameworkAndVersions) (env, verbose)
-        let t = toInvertedRomeFilesEntriesMap romefileEntries
         let namesVersionAndExisting = replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults (toInvertedRomeFilesEntriesMap romefileEntries) . filterAccordingToListMode listMode $  zip frameworkAndVersions existing
         liftIO $ mapM_ (printProbeResult listMode) namesVersionAndExisting
 
   where
-    constructFrameworksAndVersionsFrom :: [CartfileEntry] -> [RomefileEntry] -> [(FrameworkName, Version)]
-    constructFrameworksAndVersionsFrom cartfileEntries romefileEntries = deriveFrameworkNamesAndVersion (toRomeFilesEntriesMap romefileEntries) cartfileEntries
-    filterByNames cartfileEntries romefileEntries = concatMap (constructFrameworksAndVersionsFrom cartfileEntries romefileEntries `filterByName`)
+    constructFrameworksAndVersionsFrom :: [CartfileEntry] -> RepositoryMap -> [(FrameworkName, Version)]
+    constructFrameworksAndVersionsFrom cartfileEntries repositoryMap = deriveFrameworkNamesAndVersion repositoryMap cartfileEntries
+
+    filterRepoMapByGitRepoNames :: RepositoryMap -> [GitRepoName] -> RepositoryMap
+    filterRepoMapByGitRepoNames repoMap gitRepoNames = M.unions $ map (restrictRepositoryMapToGitRepoName repoMap) gitRepoNames
 
 fromErrorMessage :: AWS.ErrorMessage -> String
 fromErrorMessage (AWS.ErrorMessage t) = T.unpack t
 
-filterByName:: [(FrameworkName, Version)] -> FrameworkName -> [(FrameworkName, Version)]
-filterByName fs s = filter (\(name, version) -> name == s) fs
+filterByNameEqualTo :: [(FrameworkName, Version)] -> FrameworkName -> [(FrameworkName, Version)]
+filterByNameEqualTo fs s = filter (\(name, version) -> name == s) fs
+
+restrictRepositoryMapToGitRepoName:: RepositoryMap -> GitRepoName -> RepositoryMap
+restrictRepositoryMapToGitRepoName repoMap repoName = maybe M.empty (M.singleton repoName) $ repoName `M.lookup` repoMap
 
 uploadFrameworksAndDsymsToS3 :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO ()
 uploadFrameworksAndDsymsToS3 s3Bucket = mapM_ (uploadFrameworkAndDsymToS3 s3Bucket)
@@ -169,30 +178,32 @@ uploadFrameworkAndDsymToS3 s3BucketName fv@(framework@(FrameworkName fwn), versi
     remoteDsymUploadPath = fwn ++ "/" ++ dSYMArchiveName fv
     zipDir dir verbose = liftIO $ Zip.addFilesToArchive (zipOptions verbose) Zip.emptyArchive [dir]
 
-uploadBinary s3BucketName binaryZip destinationPath frameworkName = do
+uploadBinary s3BucketName binaryZip destinationPath objectName = do
   let objectKey = S3.ObjectKey $ T.pack destinationPath
   (env, verbose) <- ask
   runResourceT . AWS.runAWS env $ do
     let body = AWS.toBody binaryZip
     let sayFunc = if verbose then sayLnWithTime else sayLn
     when verbose $
-      sayFunc $ "Started uploading " <> frameworkName <> " to: " <> destinationPath
+      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 " <> frameworkName <> " : " <> errorString e
-      Right _ -> sayFunc $ "Successfully uploaded " <> frameworkName <> " to: " <> destinationPath
+      Left e -> sayFunc $ "Error uploading " <> objectName <> " : " <> errorString e
+      Right _ -> sayFunc $ "Uploaded " <> objectName <> " to: " <> destinationPath
 
 downloadFrameworksAndDsymsFromS3 :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO ()
 downloadFrameworksAndDsymsFromS3 s3BucketName = mapM_ (downloadFrameworkAndDsymFromS3 s3BucketName)
 
 downloadFrameworkAndDsymFromS3 s3BucketName fv@(FrameworkName fwn, version) = do
-  downloadBinary s3BucketName fwn frameworkZipName
-  downloadBinary s3BucketName fwn dSYMZipName
+  downloadBinary s3BucketName remoteFrameworkUploadPath fwn frameworkZipName
+  downloadBinary s3BucketName remoteDsymUploadPath (fwn ++ ".dSYM") dSYMZipName
   where
     frameworkZipName = frameworkArchiveName fv
+    remoteFrameworkUploadPath = fwn ++ "/" ++ frameworkArchiveName fv
     dSYMZipName = dSYMArchiveName fv
+    remoteDsymUploadPath = fwn ++ "/" ++ dSYMArchiveName fv
 
-downloadBinary s3BucketName objectName objectZipName = do
+downloadBinary s3BucketName objectRemotePath objectName objectZipName = do
   (env, verbose) <- ask
   runResourceT . AWS.runAWS env $ do
     let sayFunc = if verbose then sayLnWithTime else sayLn
@@ -203,13 +214,12 @@ downloadBinary s3BucketName objectName objectZipName = do
       Left e -> sayFunc $ "Error downloading " <> objectName <> " : " <> errorString e
       Right goResponse -> do
         lbs <- lift $ view S3.gorsBody goResponse `AWS.sinkBody` sinkLbs
-        sayFunc $ "Downloaded: " <> objectName
+        sayFunc $ "Downloaded " <> objectName <> " from: " <> objectRemotePath
         when verbose $
-          sayFunc $ "Staring to unzip " <> objectName
+          sayFunc $ "Staring to unzip " <> objectZipName
         liftIO $ Zip.extractFilesFromArchive (zipOptions verbose) (Zip.toArchive lbs)
-        sayFunc $ "Unzipped: " <> objectName
+        sayFunc $ "Unzipped " <> objectName <> " from: " <> objectZipName
   where
-    objectRemotePath = objectName ++ "/" ++ objectZipName
     objectKey = S3.ObjectKey . T.pack $ objectRemotePath
 
 probeForFrameworks :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO [Bool]
@@ -223,7 +233,6 @@ probeForFramework s3BucketName fv@(FrameworkName fwn, version) = do
     frameworkZipName = frameworkArchiveName fv
     frameworkObjectKey = S3.ObjectKey . T.pack $ fwn ++ "/" ++ frameworkZipName
 
-
 checkIfFrameworkExistsInBucket s3BucketName frameworkObjectKey verbose = do
   rs <- AWS.trying AWS._Error (AWS.send $ S3.headObject s3BucketName frameworkObjectKey)
   case rs of
@@ -246,17 +255,23 @@ sayLnWithTime line = do
 zipOptions :: Bool -> [Zip.ZipOption]
 zipOptions verbose = if verbose then [Zip.OptRecursive, Zip.OptVerbose] else [Zip.OptRecursive]
 
-deriveFrameworkNamesAndVersion :: M.Map GitRepoName [FrameworkName] -> [CartfileEntry] -> [(FrameworkName, Version)]
+deriveFrameworkNamesAndVersion :: RepositoryMap -> [CartfileEntry] -> [(FrameworkName, Version)]
 deriveFrameworkNamesAndVersion romeMap = concatMap (deriveFrameworkNameAndVersion romeMap)
 
-deriveFrameworkNameAndVersion ::  M.Map GitRepoName [FrameworkName] -> CartfileEntry -> [(FrameworkName, Version)]
-deriveFrameworkNameAndVersion romeMap (CartfileEntry GitHub (Location l) v) = map (\n -> (n, v)) $ fromMaybe [FrameworkName gitHubRepositoryName] (M.lookup (GitRepoName gitHubRepositoryName) romeMap)
+deriveFrameworkNameAndVersion ::  RepositoryMap -> CartfileEntry -> [(FrameworkName, Version)]
+deriveFrameworkNameAndVersion romeMap cfe@(CartfileEntry GitHub (Location l) v) = map (\n -> (n, v)) $ fromMaybe [FrameworkName gitHubRepositoryName] (M.lookup (gitRepoNameFromCartfileEntry cfe) romeMap)
   where
-    gitHubRepositoryName = last $ splitWithSeparator '/' l
-deriveFrameworkNameAndVersion romeMap (CartfileEntry Git (Location l) v)    = map (\n -> (n, v)) $ fromMaybe [FrameworkName gitRepositoryName] (M.lookup (GitRepoName gitRepositoryName) romeMap)
+    gitHubRepositoryName = unGitRepoName $ gitRepoNameFromCartfileEntry cfe
+deriveFrameworkNameAndVersion romeMap cfe@(CartfileEntry Git (Location l) v)    = map (\n -> (n, v)) $ fromMaybe [FrameworkName gitRepositoryName] (M.lookup (gitRepoNameFromCartfileEntry cfe) romeMap)
   where
-    gitRepositoryName = getGitRepositoryNameFromGitURL l
-    getGitRepositoryNameFromGitURL = replace ".git" "" . last . splitWithSeparator '/'
+    gitRepositoryName = unGitRepoName $ gitRepoNameFromCartfileEntry cfe
+
+gitRepoNameFromCartfileEntry :: CartfileEntry -> GitRepoName
+gitRepoNameFromCartfileEntry (CartfileEntry GitHub (Location l) _) = GitRepoName . last . splitWithSeparator '/' $ l
+gitRepoNameFromCartfileEntry (CartfileEntry Git (Location l) _) = GitRepoName . replace ".git" "" . last . splitWithSeparator '/' $ l
+
+filterCartfileEntriesByGitRepoNames :: [GitRepoName] -> [CartfileEntry] -> [CartfileEntry]
+filterCartfileEntriesByGitRepoNames repoNames cartfileEntries = [c | c <- cartfileEntries, gitRepoNameFromCartfileEntry c `elem` repoNames]
 
 appendFrameworkExtensionTo :: FrameworkName -> String
 appendFrameworkExtensionTo (FrameworkName a) = a ++ ".framework"
@@ -277,7 +292,7 @@ splitWithSeparator a as = g as : splitWithSeparator a (dropTaken as as)
 
 printProbeResult :: MonadIO m => ListMode -> ((String, Version), Bool) -> m ()
 printProbeResult listMode ((frameworkName, Version v), present) | listMode == Missing || listMode ==  Present = sayLn frameworkName
-                                                              | otherwise                                   = sayLn $ frameworkName <> " " <> v <> " " <> printProbeStringForBool present
+                                                              | otherwise                                     = sayLn $ frameworkName <> " " <> v <> " " <> printProbeStringForBool present
 
 printProbeStringForBool :: Bool -> String
 printProbeStringForBool True  = green <> "✔︎" <> noColor
@@ -297,10 +312,10 @@ filterAccordingToListMode All probeResults     = probeResults
 filterAccordingToListMode Missing probeResults = (\((FrameworkName fwn, version), present) -> not present) `filter` probeResults
 filterAccordingToListMode Present probeResults = (\((FrameworkName fwn, version), present) -> present) `filter` probeResults
 
-replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults :: M.Map FrameworkName GitRepoName -> [((FrameworkName, Version), Bool)] -> [((String, Version), Bool)]
+replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults :: InvertedRepositoryMap -> [((FrameworkName, Version), Bool)] -> [((String, Version), Bool)]
 replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults reverseRomeMap = map (replaceResultIfFrameworkNameIsInMap reverseRomeMap)
   where
-    replaceResultIfFrameworkNameIsInMap :: M.Map FrameworkName GitRepoName -> ((FrameworkName, Version), Bool) -> ((String, Version), Bool)
+    replaceResultIfFrameworkNameIsInMap :: InvertedRepositoryMap -> ((FrameworkName, Version), Bool) -> ((String, Version), Bool)
     replaceResultIfFrameworkNameIsInMap reverseRomeMap ((frameworkName@(FrameworkName fwn), version), present) = ((maybe fwn unGitRepoName (M.lookup frameworkName reverseRomeMap), version), present)
 
 s3ConfigFile :: (MonadIO m) => m FilePath
@@ -327,10 +342,10 @@ getRegionFromFile f profile = do
         Right r -> return r
 
 
-toRomeFilesEntriesMap :: [RomefileEntry] -> M.Map GitRepoName [FrameworkName]
+toRomeFilesEntriesMap :: [RomefileEntry] -> RepositoryMap
 toRomeFilesEntriesMap = M.fromList . map romeFileEntryToTuple
 
-toInvertedRomeFilesEntriesMap :: [RomefileEntry] -> M.Map FrameworkName GitRepoName
+toInvertedRomeFilesEntriesMap :: [RomefileEntry] -> InvertedRepositoryMap
 toInvertedRomeFilesEntriesMap = M.fromList . concatMap romeFileEntryToListOfTuples
   where listify (fs, g) = map (\f -> (f,g)) fs
         flipTuple = uncurry (flip (,))