Skip to content

Commit

Permalink
Fixes #25 (#26)
Browse files Browse the repository at this point in the history 
* Started frameworkname, realized reponame would be easier

* Only one error left in this file for this port

* Strongly typed gitRepoNames

* Pared down to 10 errors to fix

* Fixed more type errors, the rest require more thought

* Done with FrameworkName

* Finished Location and Version

* Pattern matching rather than a function call
  • Loading branch information
@2016rshah @tmspzz
2016rshah authored and tmspzz committed Oct 2, 2016
1 parent efe641f commit ef1cfac
Show file tree
Hide file tree
Showing 3 changed files with 55 additions and 34 deletions.
14 changes: 8 additions & 6 deletions src/Data/Cartfile.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,8 @@ module Data.Cartfile
, cartfileResolved
, CartfileEntry (..)
, RepoHosting (..)
, Version
, Location
, Version (..)
, Location (..)
) where


Expand All @@ -17,8 +17,10 @@ import qualified Text.Parsec as Parsec
import qualified Text.Parsec.String as Parsec
import qualified Text.Parsec.Utils as Parsec

type Location = String
type Version = String
newtype Location = Location { unLocation :: String }
deriving (Eq, Show)
newtype Version = Version { unVersion :: String }
deriving (Eq, Show)

data RepoHosting = GitHub | Git
deriving (Eq, Show)
Expand Down Expand Up @@ -55,9 +57,9 @@ quotedContent = do
parseCartfileResolvedLine :: Parsec.Parsec String () CartfileEntry
parseCartfileResolvedLine = do
hosting <- repoHosting
location <- quotedContent
location <- (fmap Location) quotedContent
Parsec.many1 Parsec.space
version <- quotedContent
version <- (fmap Version) quotedContent
Parsec.endOfLine
return CartfileEntry {..}

Expand Down
23 changes: 18 additions & 5 deletions src/Data/Romefile.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,8 @@ module Data.Romefile
( parseRomefile
, romefile
, RomefileEntry (..)
, FrameworkName
, GitRepoName
, FrameworkName (..)
, GitRepoName (..)
)
where

Expand All @@ -22,8 +22,13 @@ import Control.Monad.Trans



type FrameworkName = String
type GitRepoName = String

newtype FrameworkName = FrameworkName { unFrameworkName :: String }
deriving (Show, Eq, Ord)

newtype GitRepoName = GitRepoName { unGitRepoName :: String }
deriving (Eq, Show, Ord)

data RomefileEntry = RomefileEntry { gitRepositoryName :: GitRepoName
, frameworkCommonNames :: [FrameworkName]
}
Expand Down Expand Up @@ -64,4 +69,12 @@ getBucket ini = requireKey s3BucketKey `inRequiredSection` cacheSectionDelimiter

getRomefileEntries ini = do
m <- inOptionalSection repositoryMapSectionDelimiter M.empty keysAndValues `fromIni''` ini
return $ Prelude.map (\(repoName, frameworkCommonNames) -> RomefileEntry (unpack repoName) (Prelude.map (unpack . strip) (splitOn "," frameworkCommonNames))) (M.toList m)
return $
Prelude.map
(\(repoName, frameworkCommonNames)
-> RomefileEntry
(GitRepoName (unpack repoName))
(Prelude.map
(FrameworkName . unpack . strip)
(splitOn "," frameworkCommonNames)))
(M.toList m)
52 changes: 29 additions & 23 deletions src/Lib.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,10 +66,10 @@ data RomeOptions = RomeOptions { romeCommand :: RomeCommand

{- Functions -}
uploadParser :: Opts.Parser RomeCommand
uploadParser = pure Upload <*> Opts.many (Opts.argument 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 (FrameworkName <$> 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 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 (FrameworkName <$> 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 <*> (
Expand Down Expand Up @@ -109,7 +109,7 @@ runRomeWithOptions env (RomeOptions options verbose) = do
case options of
Upload [] -> do
let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries romefileEntries
liftIO $ runReaderT (uploadFrameworksAndDsymsToS3 s3BucketName frameworkAndVersions) (env, verbose)
liftIO $ runReaderT (uploadFrameworksAndDsymsToS3 s3BucketName (frameworkAndVersions)) (env, verbose)

Upload names ->
liftIO $ runReaderT (uploadFrameworksAndDsymsToS3 s3BucketName (filterByNames cartfileEntries romefileEntries names)) (env, verbose)
Expand All @@ -129,6 +129,7 @@ runRomeWithOptions env (RomeOptions options verbose) = do
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`)

Expand All @@ -138,18 +139,20 @@ fromErrorMessage (AWS.ErrorMessage t) = T.unpack t
filterByName:: [(FrameworkName, Version)] -> FrameworkName -> [(FrameworkName, Version)]
filterByName fs s = filter (\(name, version) -> name == s) fs

uploadFrameworksAndDsymsToS3 :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO ()
uploadFrameworksAndDsymsToS3 s3Bucket = mapM_ (uploadFrameworkAndDsymToS3 s3Bucket)

uploadFrameworkAndDsymToS3 s3BucketName fv@(framework, version) = do
uploadFrameworkAndDsymToS3 :: BucketName -> (FrameworkName, Version) -> ReaderT (AWS.Env, Bool) IO ()
uploadFrameworkAndDsymToS3 s3BucketName fv@(framework@(FrameworkName fwn), version) = do
(env, verbose) <- ask
frameworkExists <- liftIO $ doesDirectoryExist frameworkDirectory
dSymExists <- liftIO $ doesDirectoryExist dSYMdirectory
when frameworkExists $ do
frameworkArchive <- zipDir frameworkDirectory verbose
uploadBinary s3BucketName (Zip.fromArchive frameworkArchive) (framework ++ "/" ++ frameworkArchiveName fv) framework
uploadBinary s3BucketName (Zip.fromArchive frameworkArchive) (fwn ++ "/" ++ frameworkArchiveName (fwn, version)) (fwn)
when dSymExists $ do
dSYMArchive <- zipDir dSYMdirectory verbose
uploadBinary s3BucketName (Zip.fromArchive dSYMArchive) (framework ++ "/" ++ dSYMArchiveName fv) (framework ++ ".dSYM")
uploadBinary s3BucketName (Zip.fromArchive dSYMArchive) (fwn ++ "/" ++ dSYMArchiveName (fwn, version)) (fwn ++ ".dSYM")
where
carthageBuildDirecotryiOS = "Carthage/Build/iOS/"
frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo framework
Expand All @@ -168,11 +171,12 @@ uploadBinary s3BucketName binaryZip destinationPath frameworkName = do
Left e -> sayLn $ "Error uploading " <> frameworkName <> " : " <> errorString e
Right _ -> sayLn $ "Successfully uploaded " <> frameworkName <> " to: " <> destinationPath

downloadFrameworksAndDsymsFromS3 :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO ()
downloadFrameworksAndDsymsFromS3 s3BucketName = mapM_ (downloadFrameworkAndDsymFromS3 s3BucketName)

downloadFrameworkAndDsymFromS3 s3BucketName fv@(frameworkName, version) = do
let frameworkZipName = frameworkArchiveName fv
let dSYMZipName = dSYMArchiveName fv
downloadFrameworkAndDsymFromS3 s3BucketName fv@((FrameworkName frameworkName), version) = do
let frameworkZipName = frameworkArchiveName (frameworkName, version)
let dSYMZipName = dSYMArchiveName (frameworkName, version)
let frameworkObjectKey = S3.ObjectKey . T.pack $ frameworkName ++ "/" ++ frameworkZipName
let dSYMObjectKey = S3.ObjectKey . T.pack $ frameworkName ++ "/" ++ dSYMZipName
(env, verbose) <- ask
Expand All @@ -189,10 +193,11 @@ getZip s3BucketName frameworkObjectKey zipName verbose = do
liftIO $ Zip.extractFilesFromArchive (zipOptions verbose) (Zip.toArchive lbs)
sayLn $ "Unzipped: " ++ zipName


probeForFrameworks :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO [Bool]
probeForFrameworks s3BucketName = mapM (probeForFramework s3BucketName)

probeForFramework s3BucketName (frameworkName, version) = do
probeForFramework :: BucketName -> (FrameworkName, Version) -> ReaderT (AWS.Env, Bool) IO Bool
probeForFramework s3BucketName ((FrameworkName frameworkName), version) = do
let frameworkZipName = frameworkArchiveName (frameworkName, version)
let frameworkObjectKey = S3.ObjectKey . T.pack $ frameworkName ++ "/" ++ frameworkZipName
(env, verbose) <- ask
Expand Down Expand Up @@ -220,22 +225,22 @@ deriveFrameworkNamesAndVersion :: M.Map GitRepoName [FrameworkName] -> [Cartfile
deriveFrameworkNamesAndVersion romeMap = concatMap (deriveFrameworkNameAndVersion romeMap)

deriveFrameworkNameAndVersion :: M.Map GitRepoName [FrameworkName] -> CartfileEntry -> [(FrameworkName, Version)]
deriveFrameworkNameAndVersion romeMap (CartfileEntry GitHub l v) = map (\n -> (n, v)) $ fromMaybe [gitHubRepositoryName] (M.lookup gitHubRepositoryName romeMap)
deriveFrameworkNameAndVersion romeMap (CartfileEntry GitHub (Location l) v) = map (\n -> (n, v)) $ fromMaybe [FrameworkName gitHubRepositoryName] (M.lookup (GitRepoName gitHubRepositoryName) romeMap)
where
gitHubRepositoryName = last $ splitWithSeparator '/' l
deriveFrameworkNameAndVersion romeMap (CartfileEntry Git l v) = map (\n -> (n, v)) $ fromMaybe [gitRepositoryName] (M.lookup gitRepositoryName romeMap)
deriveFrameworkNameAndVersion romeMap (CartfileEntry Git (Location l) v) = map (\n -> (n, v)) $ fromMaybe [FrameworkName gitRepositoryName] (M.lookup (GitRepoName gitRepositoryName) romeMap)
where
gitRepositoryName = getGitRepositoryNameFromGitURL l
getGitRepositoryNameFromGitURL = replace ".git" "" . last . splitWithSeparator '/'

appendFrameworkExtensionTo :: FrameworkName -> String
appendFrameworkExtensionTo a = a ++ ".framework"
appendFrameworkExtensionTo (FrameworkName a) = a ++ ".framework"

frameworkArchiveName :: (String, Version) -> String
frameworkArchiveName (name, version) = appendFrameworkExtensionTo name ++ "-" ++ version ++ ".zip"
frameworkArchiveName (name, (Version v)) = appendFrameworkExtensionTo (FrameworkName name) ++ "-" ++ v ++ ".zip"

dSYMArchiveName :: (String, Version) -> String
dSYMArchiveName (name, version) = appendFrameworkExtensionTo name ++ ".dSYM" ++ "-" ++ version ++ ".zip"
dSYMArchiveName (name, (Version v)) = appendFrameworkExtensionTo (FrameworkName name) ++ ".dSYM" ++ "-" ++ v ++ ".zip"

splitWithSeparator :: (Eq a) => a -> [a] -> [[a]]
splitWithSeparator _ [] = []
Expand All @@ -246,8 +251,8 @@ splitWithSeparator a as = g as : splitWithSeparator a (dropTaken as as)
dropTaken bs = drop $ numberOfAsIn bs + length (g bs)

printProbeResult :: MonadIO m => ListMode -> ((String, Version), Bool) -> m ()
printProbeResult listMode ((frameworkName, version), present) | listMode == Missing || listMode == Present = sayLn frameworkName
| otherwise = sayLn $ frameworkName <> " " <> version <> " " <> printProbeStringForBool present
printProbeResult listMode ((frameworkName, (Version v)), present) | listMode == Missing || listMode == Present = sayLn frameworkName
| otherwise = sayLn $ frameworkName <> " " <> v <> " " <> printProbeStringForBool present

printProbeStringForBool :: Bool -> String
printProbeStringForBool True = green <> "✔︎" <> noColor
Expand All @@ -262,15 +267,16 @@ green = "\ESC[0;32m"
noColor :: String
noColor = "\ESC[0m"

filterAccordingToListMode :: ListMode -> [((String, Version), Bool)] -> [((String, Version), Bool)]
filterAccordingToListMode :: ListMode -> [((FrameworkName, Version), Bool)] -> [((FrameworkName, Version), Bool)]
filterAccordingToListMode All probeResults = probeResults
filterAccordingToListMode Missing probeResults = (\((name, version), present) -> not present) `filter`probeResults
filterAccordingToListMode Present probeResults = (\((name, version), present) -> present) `filter`probeResults
filterAccordingToListMode Missing probeResults = (\(((FrameworkName name), version), present) -> not present) `filter` probeResults
filterAccordingToListMode Present probeResults = (\(((FrameworkName name), version), present) -> present) `filter` probeResults

replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults :: M.Map FrameworkName GitRepoName -> [((FrameworkName, Version), Bool)] -> [((String, Version), Bool)]
replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults reverseRomeMap = map (replaceResultIfFrameworkNameIsInMap reverseRomeMap)
replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults reverseRomeMap = map (replaceResultIfFrameworkNameIsInMap (reverseRomeMap))
where
replaceResultIfFrameworkNameIsInMap reverseRomeMap ((frameworkName, version), present) = ((fromMaybe frameworkName (M.lookup frameworkName reverseRomeMap), version), present)
replaceResultIfFrameworkNameIsInMap :: M.Map FrameworkName GitRepoName -> ((FrameworkName, Version), Bool) -> ((String, Version), Bool)
replaceResultIfFrameworkNameIsInMap reverseRomeMap ((frameworkName, version), present) = ((fromMaybe (unFrameworkName frameworkName) (fmap unGitRepoName (M.lookup frameworkName reverseRomeMap)), version), present)


s3ConfigFile :: (MonadIO m) => m FilePath
Expand Down

0 comments on commit ef1cfac

Please sign in to comment.