diff --git a/Rome.cabal b/Rome.cabal index 9faf80a..c23d20d 100644 --- a/Rome.cabal +++ b/Rome.cabal @@ -25,6 +25,7 @@ library , Data.Carthage.TargetPlatform , Data.Carthage.Common , Data.Carthage.VersionFile + , Data.PodBuilder.PodfileRestore , Data.Romefile , Data.S3Config , Text.Parsec.Utils diff --git a/src/Data/PodBuilder/PodfileRestore.hs b/src/Data/PodBuilder/PodfileRestore.hs new file mode 100644 index 0000000..d7371e4 --- /dev/null +++ b/src/Data/PodBuilder/PodfileRestore.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} + +module Data.Carthage.Cartfile + ( parsePodfileRestore + , podfileRestore + , PodfileEntry(..) + ) +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 + +data PodVersion = PodVersion { version :: String } deriving (Eq, Show) +data PodName = PodName { podNameMain :: String, podNameSub :: Maybe String } deriving (Eq, Show) +data PodfileEntry = PodfileEntry { podName :: PodName, podVersion :: PodVersion } deriving (Show, Eq) + +podfileRestore :: String +podfileRestore = "Podfile.restore" + +-- Podfile.restore parsing + +eatAttributeSeparator :: Parsec.Parsec String () () +eatAttributeSeparator = Parsec.spaces >> Parsec.char ',' >> Parsec.spaces + +eatNonCommitOrTagAttribute :: Parsec.Parsec String () () +eatNonCommitOrTagAttribute = Parsec.try + ( Parsec.char ':' + >> Parsec.notFollowedBy (Parsec.string "commit") + >> Parsec.notFollowedBy (Parsec.string "tag") + >> Parsec.many (Parsec.noneOf [',', '#', '\n']) + >> Parsec.try (Parsec.char ',') + <|> Parsec.lookAhead (Parsec.char '#') + >> Parsec.spaces + ) + +parseNonExactVersion :: Parsec.Parsec String () String +parseNonExactVersion = do + _ <- Parsec.spaces + _ <- Parsec.skipMany eatNonCommitOrTagAttribute + _ <- Parsec.try (Parsec.string ":commit") + <|> Parsec.try (Parsec.string ":tag") + _ <- Parsec.spaces + _ <- Parsec.string "=>" + _ <- Parsec.spaces + _ <- Parsec.char '\'' + version <- Parsec.many (Parsec.noneOf ['\'', '\n']) + _ <- Parsec.char '\'' + _ <- Parsec.spaces + _ <- Parsec.optional (Parsec.char ',') + _ <- Parsec.spaces + _ <- Parsec.skipMany eatNonCommitOrTagAttribute + _ <- Parsec.spaces + return version + +parseExactVersion :: Parsec.Parsec String () String +parseExactVersion = do + _ <- Parsec.spaces + version <- + Parsec.char '\'' *> Parsec.many (Parsec.noneOf ['\'', '\n']) <* Parsec.char + '\'' + _ <- Parsec.spaces + return version + +parseAttributesIncludingVersion :: Parsec.Parsec String () PodVersion +parseAttributesIncludingVersion = do + version <- Parsec.try parseExactVersion <|> Parsec.try parseNonExactVersion + return PodVersion {..} + +parsePodName :: Parsec.Parsec String () PodName +parsePodName = do + _ <- Parsec.char '\'' + podNameMain <- Parsec.many1 (Parsec.noneOf ['\'', '/', '\n']) + podNameSub <- Parsec.optionMaybe + (Parsec.char '/' >> Parsec.many (Parsec.noneOf ['\'', '\n'])) + _ <- Parsec.char '\'' + return PodName {..} + +parsePodfileRestorePodLine :: Parsec.Parsec String () PodfileEntry +parsePodfileRestorePodLine = do + _ <- Parsec.spaces >> Parsec.string "pod" >> Parsec.spaces + podName <- parsePodName + _ <- eatAttributeSeparator + podVersion <- parseAttributesIncludingVersion + _ <- Parsec.spaces >> Parsec.char '#' -- INFO only lines that end with "# pb" are relevant for Rome, others are already precompiled pods + _ <- Parsec.many (Parsec.noneOf ['\n']) + return PodfileEntry {..} + +parseMaybePodfileEntry :: Parsec.Parsec String () (Maybe PodfileEntry) +parseMaybePodfileEntry = + Parsec.optional Parsec.spaces + *> (parsePodfileRestorePodLine `Parsec.onceAndConsumeTill` Parsec.endOfLine) + +parsePodfileRestore + :: MonadIO m => String -> m (Either Parsec.ParseError [PodfileEntry]) +parsePodfileRestore = liftIO . Parsec.parseFromFile + (catMaybes <$> Parsec.many (Parsec.try parseMaybePodfileEntry)) + + +-- print on separate lines for testing like this in GHCi: +-- parsePodfileRestore podfileRestore >>= pure . fromRight [] >>= mapM_ print