Fix command parser

tmspzz · Oct 8, 2021 · 84389ed · 84389ed
1 parent 5fb46cc
commit 84389ed
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 28 deletions.
diff --git a/src/CommandParsers.hs b/src/CommandParsers.hs
@@ -43,12 +43,6 @@ noSkipCurrentParser = NoSkipCurrentFlag <$> Opts.switch
   <> Opts.help "Do not skip the `currentMap` section in the Romefile when performing the operation."
   )
 
-useXcFrameworksParser :: Opts.Parser UseXcFrameworksFlag
-useXcFrameworksParser = UseXcFrameworksFlag <$> Opts.switch
-  (  Opts.long "use-xcframeworks"
-  <> Opts.help "Search for .xcframeworks when performing the operation."
-  )
-
 concurrentlyParser :: Opts.Parser ConcurrentlyFlag
 concurrentlyParser = ConcurrentlyFlag <$> Opts.switch
   (  Opts.long "concurrently"
@@ -82,16 +76,22 @@ platformsParser =
   splitPlatforms s = filter (not . null) $ filter isLetter <$> wordsBy (not . isLetter) s
   platformListOrError s = mapM platformOrError $ splitPlatforms s
 
+platformCommandParser :: Opts.Parser PlatformCommand
+platformCommandParser =
+  flag' UseXcFrameworks
+  (  Opts.long "use-xcframeworks"
+  <> Opts.help "Search for .xcframeworks when performing the operation."
+  ) <|> (TargetPlatforms <$> platformsParser)
+
 udcPayloadParser :: Opts.Parser RomeUDCPayload
 udcPayloadParser =
   RomeUDCPayload
     <$> reposParser
-    <*> platformsParser
+    <*> platformCommandParser
     <*> cachePrefixParser
     <*> skipLocalCacheParser
     <*> noIgnoreParser
     <*> noSkipCurrentParser
-    <*> useXcFrameworksParser
     <*> concurrentlyParser
 
 uploadParser :: Opts.Parser RomeCommand
@@ -118,12 +118,11 @@ listPayloadParser :: Opts.Parser RomeListPayload
 listPayloadParser =
   RomeListPayload
     <$> listModeParser
-    <*> platformsParser
+    <*> platformCommandParser
     <*> cachePrefixParser
     <*> printFormatParser
     <*> noIgnoreParser
     <*> noSkipCurrentParser
-    <*> useXcFrameworksParser
 
 listParser :: Opts.Parser RomeCommand
 listParser = List <$> listPayloadParser

diff --git a/src/Lib.hs b/src/Lib.hs
@@ -204,7 +204,7 @@ runUDCCommand command absoluteRomefilePath verbose romeVersion = do
 
   case command of
 
-    Upload (RomeUDCPayload gitRepoNames platforms cachePrefixString skipLocalCache noIgnoreFlag noSkipCurrentFlag useXcFrameworksFlag concurrentlyFlag)
+    Upload (RomeUDCPayload gitRepoNames platformCmd cachePrefixString skipLocalCache noIgnoreFlag noSkipCurrentFlag concurrentlyFlag)
       -> sayVersionWarning romeVersion verbose
         *> performWithDefaultFlow uploadArtifacts
                                   (verbose, noIgnoreFlag, skipLocalCache, noSkipCurrentFlag, concurrentlyFlag)
@@ -215,10 +215,10 @@ runUDCCommand command absoluteRomefilePath verbose romeVersion = do
                                   mS3BucketName
                                   mlCacheDir
                                   mEnginePath
-                                  (_useXcFrameworks useXcFrameworksFlag)
-                                  platforms
+                                  (getXcCommand platformCmd)
+                                  (getPlatforms platformCmd)
 
-    Download (RomeUDCPayload gitRepoNames platforms cachePrefixString skipLocalCache noIgnoreFlag noSkipCurrentFlag useXcFrameworksFlag concurrentlyFlag)
+    Download (RomeUDCPayload gitRepoNames platformCmd cachePrefixString skipLocalCache noIgnoreFlag noSkipCurrentFlag concurrentlyFlag)
       -> sayVersionWarning romeVersion verbose
         *> performWithDefaultFlow downloadArtifacts
                                   (verbose, noIgnoreFlag, skipLocalCache, noSkipCurrentFlag, concurrentlyFlag)
@@ -229,10 +229,10 @@ runUDCCommand command absoluteRomefilePath verbose romeVersion = do
                                   mS3BucketName
                                   mlCacheDir
                                   mEnginePath
-                                  (_useXcFrameworks useXcFrameworksFlag)
-                                  platforms
+                                  (getXcCommand platformCmd)
+                                  (getPlatforms platformCmd)
 
-    List (RomeListPayload listMode platforms cachePrefixString printFormat noIgnoreFlag noSkipCurrentFlag useXcFrameworksFlag) -> do
+    List (RomeListPayload listMode platformCmd cachePrefixString printFormat noIgnoreFlag noSkipCurrentFlag) -> do
 
       currentVersion <- deriveCurrentVersion
 
@@ -256,13 +256,13 @@ runUDCCommand command absoluteRomefilePath verbose romeVersion = do
           mlCacheDir
           mEnginePath
           listMode
-          (_useXcFrameworks useXcFrameworksFlag)
+          (getXcCommand platformCmd)
           (reverseRepositoryMap <> if _noSkipCurrent noSkipCurrentFlag then currentInvertedMap else M.empty)
           (frameworkVersions <> if _noSkipCurrent noSkipCurrentFlag
             then (currentFrameworkVersions `filterOutFrameworksAndVersionsIfNotIn` finalIgnoreNames)
             else []
           )
-          platforms
+          (getPlatforms platformCmd)
           printFormat
         )
         (cachePrefix, SkipLocalCacheFlag False, verbose)
@@ -281,6 +281,10 @@ runUDCCommand command absoluteRomefilePath verbose romeVersion = do
       <> "You are currently on: "
       <> romeVersionToString vers
       <> noColorControlSequence
+  getPlatforms platformCmd = case platformCmd of
+    TargetPlatforms xs -> xs
+    UseXcFrameworks -> allTargetPlatforms
+  getXcCommand = (==) UseXcFrameworks
 
 type FlowFunction
   =  Maybe S3.BucketName -- ^ Just an S3 Bucket name or Nothing
@@ -300,7 +304,7 @@ performWithDefaultFlow
   -> (Bool {- verbose -}
           , NoIgnoreFlag  {- noIgnoreFlag -}
                         , SkipLocalCacheFlag {- skipLocalCache -}
-                                            , NoSkipCurrentFlag {- skipLocalCache -}
+                                            , NoSkipCurrentFlag {- noSkipCurrentFlag -}
                                                                 , ConcurrentlyFlag) {- concurrentlyFlag -}
   -> ([ {- repositoryMapEntries -}
        RomefileEntry], [ {- ignoreMapEntries -}

diff --git a/src/Types/Commands.hs b/src/Types/Commands.hs
@@ -12,18 +12,19 @@ data RomeCommand = Upload RomeUDCPayload
 
 
 data RomeUDCPayload = RomeUDCPayload { _payload              :: [ProjectName]
-                                     , _udcPlatforms         :: [TargetPlatform]
+                                     , _udcPlatforms         :: PlatformCommand
                                      , _cachePrefix          :: String
                                     --  , _verifyFlag         :: VerifyFlag
                                      , _skipLocalCacheFlag   :: SkipLocalCacheFlag
                                      , _noIgnoreFlag         :: NoIgnoreFlag
                                      , _noSkipCurrentFlag    :: NoSkipCurrentFlag
-                                     , _useXcFrameworksFlag  :: UseXcFrameworksFlag
                                      , _concurrentlyFlag     :: ConcurrentlyFlag
                                      }
                                      deriving (Show, Eq)
 
-
+data PlatformCommand = TargetPlatforms [TargetPlatform]
+                      | UseXcFrameworks
+                      deriving (Show, Eq)
 
 data RomeUtilsPayload = RomeUtilsPayload { _subcommand :: RomeUtilsSubcommand }
                                          deriving (Show, Eq)
@@ -41,19 +42,15 @@ newtype NoIgnoreFlag = NoIgnoreFlag { _noIgnore :: Bool }
 newtype NoSkipCurrentFlag = NoSkipCurrentFlag { _noSkipCurrent :: Bool }
                                               deriving (Show, Eq)
 
-newtype UseXcFrameworksFlag = UseXcFrameworksFlag { _useXcFrameworks :: Bool }
-                                              deriving (Show, Eq)
-
 newtype ConcurrentlyFlag = ConcurrentlyFlag { _concurrently :: Bool }
                                               deriving (Show, Eq)
 
 data RomeListPayload = RomeListPayload { _listMode                  :: ListMode
-                                       , _listPlatforms             :: [TargetPlatform]
+                                       , _listPlatforms             :: PlatformCommand
                                        , _listCachePrefix           :: String
                                        , _listFormat                :: PrintFormat
                                        , _listNoIgnoreFlag          :: NoIgnoreFlag
                                        , _listNoSkipCurrentFlag     :: NoSkipCurrentFlag
-                                       , _listUseXcFrameworksFlag   :: UseXcFrameworksFlag
                                        }
                                        deriving (Show, Eq)