diff --git a/.gitignore b/.gitignore index b8eed41..e3a7e85 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,4 @@ dist/ dist-newstyle/ /nixpkgs-update.cabal /shell.nix +.ghc* \ No newline at end of file diff --git a/package.yaml b/package.yaml index fa8b232..a20ed35 100644 --- a/package.yaml +++ b/package.yaml @@ -16,6 +16,8 @@ extra-source-files: github: ryantm/nixpkgs-update +ghc-options: -Wall + dependencies: - base >= 4.7 && < 5 - directory >= 1.3 && < 1.4 @@ -37,6 +39,7 @@ dependencies: - transformers - lifted-base - xdg-basedir + - template-haskell executables: nixpkgs-update: diff --git a/src/Check.hs b/src/Check.hs index ead3164..c5cc65e 100644 --- a/src/Check.hs +++ b/src/Check.hs @@ -91,10 +91,6 @@ checkReport (BinaryCheck p False False) = checkReport (BinaryCheck p _ _) = "- " <> toTextIgnore p <> " passed the binary check." -successfullCheck :: BinaryCheck -> Bool -successfullCheck (BinaryCheck _ False False) = False -successfullCheck _ = True - result :: UpdateEnv -> FilePath -> Sh Text result updateEnv resultPath = do let expectedVersion = newVersion updateEnv @@ -112,26 +108,26 @@ result updateEnv resultPath = do if binExists then findWhen test_f (resultPath "bin") else return [] - checks <- forM binaries $ \binary -> runChecks expectedVersion binary - addToReport (T.intercalate "\n" (map checkReport checks)) + checks' <- forM binaries $ \binary -> runChecks expectedVersion binary + addToReport (T.intercalate "\n" (map checkReport checks')) let passedZeroExitCode = (T.pack . show) (foldl - (\sum c -> + (\acc c -> if zeroExitCode c - then sum + 1 - else sum) + then acc + 1 + else acc) 0 - checks :: Int) + checks' :: Int) passedVersionPresent = (T.pack . show) (foldl - (\sum c -> + (\acc c -> if versionPresent c - then sum + 1 - else sum) + then acc + 1 + else acc) 0 - checks :: Int) + checks' :: Int) numBinaries = (T.pack . show) (length binaries) addToReport ("- " <> passedZeroExitCode <> " of " <> numBinaries <> @@ -139,7 +135,7 @@ result updateEnv resultPath = do addToReport ("- " <> passedVersionPresent <> " of " <> numBinaries <> " passed binary check by having the new version present in output.") - Shell.canFail $ cmd "grep" "-r" expectedVersion resultPath + _ <- Shell.canFail $ cmd "grep" "-r" expectedVersion resultPath whenM ((== 0) <$> lastExitCode) $ addToReport $ "- found " <> expectedVersion <> " with grep in " <> @@ -147,9 +143,7 @@ result updateEnv resultPath = do whenM (null <$> findWhen - (\path -> - ((expectedVersion `T.isInfixOf` toTextIgnore path) &&) <$> - test_f path) + (\p -> ((expectedVersion `T.isInfixOf` toTextIgnore p) &&) <$> test_f p) resultPath) $ addToReport $ "- found " <> expectedVersion <> " in filename of file in " <> diff --git a/src/Clean.hs b/src/Clean.hs index 4bdaff3..a17111e 100644 --- a/src/Clean.hs +++ b/src/Clean.hs @@ -52,15 +52,16 @@ fixSrcUrl updateEnv derivationFile attrPath oldSrcUrl = do do let newName = name <> "-${version}" File.replace newDerivationName newName derivationFile - cmd "grep" "-q" ("name = \"" <> newName <> "\"") derivationFile - cmd - "sed" - "-i" - ("s|^\\([ ]*\\)\\(name = \"" <> name <> - "-${version}\";\\)|\\1\\2\\n\\1version = \"" <> - newVersion updateEnv <> - "\";|") - derivationFile + _ <- cmd "grep" "-q" ("name = \"" <> newName <> "\"") derivationFile + _ <- + cmd + "sed" + "-i" + ("s|^\\([ ]*\\)\\(name = \"" <> name <> + "-${version}\";\\)|\\1\\2\\n\\1version = \"" <> + newVersion updateEnv <> + "\";|") + derivationFile cmd "grep" "-q" @@ -96,7 +97,7 @@ fixSrcUrl updateEnv derivationFile attrPath oldSrcUrl = do "${version}" (T.replace newDerivationName "${name}" downloadUrl) lift $ File.replace oldUrl newUrl derivationFile - lift $ cmd "grep" "-q" ("url = \"" <> newUrl <> "\";") derivationFile + _ <- lift $ cmd "grep" "-q" ("url = \"" <> newUrl <> "\";") derivationFile whenM (lift $ Shell.succeeded $ diff --git a/src/DeleteMerged.hs b/src/DeleteMerged.hs index 356f2c4..eb29235 100644 --- a/src/DeleteMerged.hs +++ b/src/DeleteMerged.hs @@ -6,14 +6,11 @@ module DeleteMerged ( deleteDone ) where -import OurPrelude - import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Vector as V import qualified GH import qualified Git -import qualified Shell import Utils (Options) default (T.Text) @@ -24,6 +21,6 @@ deleteDone o = do Git.cleanAndResetToMaster result <- GH.closedAutoUpdateRefs o case result of - Left error -> T.putStrLn error + Left e -> T.putStrLn e Right refs -> V.sequence_ (fmap (\r -> Git.deleteBranch ("auto-update/" <> r)) refs) diff --git a/src/GH.hs b/src/GH.hs index 6704054..93548cc 100644 --- a/src/GH.hs +++ b/src/GH.hs @@ -25,9 +25,8 @@ import Shelly hiding (tag) import Utils gReleaseUrl :: URLParts -> IO (Either Text Text) -gReleaseUrl (URLParts owner repo tag) = - bimap (T.pack . show) (getUrl . releaseHtmlUrl) <$> - releaseByTagName owner repo tag +gReleaseUrl (URLParts o r t) = + bimap (T.pack . show) (getUrl . releaseHtmlUrl) <$> releaseByTagName o r t releaseUrl :: Text -> IO (Either Text Text) releaseUrl url = @@ -51,14 +50,14 @@ parseURL url = ("GitHub: " <> url <> " is not a GitHub URL.") ("https://github.com/" `T.isPrefixOf` url) let parts = T.splitOn "/" url - owner <- N <$> tryAt ("GitHub: owner part missing from " <> url) parts 3 - repo <- N <$> tryAt ("GitHub: repo part missing from " <> url) parts 4 + o <- N <$> tryAt ("GitHub: owner part missing from " <> url) parts 3 + r <- N <$> tryAt ("GitHub: repo part missing from " <> url) parts 4 tagPart <- tryAt ("GitHub: tag part missing from " <> url) parts 6 - tag <- + t <- tryJust ("GitHub: tag part missing .tar.gz suffix " <> url) (T.stripSuffix ".tar.gz" tagPart) - return $ URLParts owner repo tag + return $ URLParts o r t compareUrl :: Text -> Text -> IO (Either Text Text) compareUrl urlOld urlNew = diff --git a/src/Git.hs b/src/Git.hs index a413c90..f2a6a01 100644 --- a/src/Git.hs +++ b/src/Git.hs @@ -20,7 +20,7 @@ module Git import OurPrelude import qualified Data.Text as T -import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime, getCurrentTime) +import Data.Time.Clock (addUTCTime, getCurrentTime) import qualified Shell import Shelly import System.Directory (getHomeDirectory, getModificationTime) @@ -33,10 +33,10 @@ clean = shelly $ cmd "git" "clean" "-fdx" cleanAndResetTo :: MonadIO m => Text -> Text -> m () cleanAndResetTo branch target = do - shelly $ cmd "git" "reset" "--hard" + _ <- shelly $ cmd "git" "reset" "--hard" clean - shelly $ cmd "git" "checkout" "-B" branch target - shelly $ cmd "git" "reset" "--hard" target + _ <- shelly $ cmd "git" "checkout" "-B" branch target + _ <- shelly $ cmd "git" "reset" "--hard" target clean cleanAndResetToMaster :: MonadIO m => m () @@ -46,9 +46,9 @@ cleanAndResetToStaging :: MonadIO m => m () cleanAndResetToStaging = cleanAndResetTo "staging" "upstream/staging" cleanup :: MonadIO m => Text -> m () -cleanup branchName = do +cleanup bName = do cleanAndResetToMaster - shelly $ Shell.canFail $ cmd "git" "branch" "-D" branchName + shelly $ Shell.canFail $ cmd "git" "branch" "-D" bName showRef :: MonadIO m => Text -> m Text showRef ref = shelly $ cmd "git" "show-ref" ref @@ -80,19 +80,19 @@ push updateEnv = ["--dry-run" | dryRun (options updateEnv)]) checkoutAtMergeBase :: MonadIO m => Text -> m () -checkoutAtMergeBase branchName = do +checkoutAtMergeBase bName = do base <- T.strip <$> shelly (cmd "git" "merge-base" "upstream/master" "upstream/staging") - shelly $ cmd "git" "checkout" "-B" branchName base + shelly $ cmd "git" "checkout" "-B" bName base checkAutoUpdateBranchDoesntExist :: MonadIO m => Text -> ExceptT Text m () -checkAutoUpdateBranchDoesntExist packageName = do +checkAutoUpdateBranchDoesntExist pName = do remoteBranches <- lift $ map T.strip . T.lines <$> shelly (silently $ cmd "git" "branch" "--remote") when - (("origin/auto-update/" <> packageName) `elem` remoteBranches) + (("origin/auto-update/" <> pName) `elem` remoteBranches) (throwE "Update branch already on origin.") commit :: MonadIO m => Text -> m () @@ -102,8 +102,8 @@ headHash :: MonadIO m => m Text headHash = shelly $ cmd "git" "rev-parse" "HEAD" deleteBranch :: MonadIO m => Text -> m () -deleteBranch branchName = +deleteBranch bName = shelly $ Shell.canFail $ do - cmd "git" "branch" "-D" branchName - cmd "git" "push" "origin" (":" <> branchName) + _ <- cmd "git" "branch" "-D" bName + cmd "git" "push" "origin" (":" <> bName) diff --git a/src/Main.hs b/src/Main.hs index e4b5c6c..e949589 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -41,10 +41,10 @@ programInfo = makeOptions :: IO Options makeOptions = do - dryRun <- isJust <$> getEnv "DRY_RUN" + dry <- isJust <$> getEnv "DRY_RUN" homeDir <- T.pack <$> getHomeDirectory - githubToken <- T.strip <$> T.readFile "github_token.txt" - return $ Options dryRun (homeDir <> "/.nixpkgs-update") githubToken + token <- T.strip <$> T.readFile "github_token.txt" + return $ Options dry (homeDir <> "/.nixpkgs-update") token main :: IO () main = do diff --git a/src/Nix.hs b/src/Nix.hs index aba68cd..40e7b43 100644 --- a/src/Nix.hs +++ b/src/Nix.hs @@ -80,8 +80,8 @@ lookupAttrPath updateEnv = Shell.shellyET & overwriteErrorT "nix-env -q failed to find package name with old version" -getDerivationFile :: MonadIO m => UpdateEnv -> Text -> ExceptT Text m FilePath -getDerivationFile updateEnv attrPath = +getDerivationFile :: MonadIO m => Text -> ExceptT Text m FilePath +getDerivationFile attrPath = cmd "env" "EDITOR=echo" "nix" "edit" attrPath "-f" "." & fmap T.strip & fmap fromText & Shell.shellyET & @@ -167,7 +167,7 @@ buildCmd = build :: MonadIO m => Text -> ExceptT Text m () build attrPath = (buildCmd attrPath & Shell.shellyET) <|> - (do buildFailedLog + (do _ <- buildFailedLog throwE "nix log failed trying to get build logs") where buildFailedLog = do diff --git a/src/OurPrelude.hs b/src/OurPrelude.hs index 5e35e1b..70a5b6b 100644 --- a/src/OurPrelude.hs +++ b/src/OurPrelude.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE PartialTypeSignatures #-} + module OurPrelude ( (>>>) , (<|>) @@ -26,6 +28,8 @@ import Data.Semigroup ((<>)) import Data.Set (Set) import Data.Text (Text) import Data.Vector (Vector) +import Language.Haskell.TH.Quote import qualified NeatInterpolation +interpolate :: QuasiQuoter interpolate = NeatInterpolation.text diff --git a/src/Outpaths.hs b/src/Outpaths.hs index 5cfa172..5f12fbe 100644 --- a/src/Outpaths.hs +++ b/src/Outpaths.hs @@ -16,10 +16,10 @@ import Shelly import Text.Parsec (parse) import Text.Parser.Char import Text.Parser.Combinators -import Utils default (Text) +outPathsExpr :: Text outPathsExpr = [interpolate| @@ -78,11 +78,12 @@ in outPath :: Sh Text outPath = sub $ do - cmd - "curl" - "-o" - "outpaths.nix" - "https://raw.githubusercontent.com/NixOS/ofborg/released/ofborg/src/outpaths.nix" + _ <- + cmd + "curl" + "-o" + "outpaths.nix" + "https://raw.githubusercontent.com/NixOS/ofborg/released/ofborg/src/outpaths.nix" setenv "GC_INITIAL_HEAP_SIZE" "10g" cmd "nix-env" @@ -107,6 +108,7 @@ data ResultLine = ResultLine } deriving (Eq, Ord, Show) -- Example query result line: +testInput :: Text testInput = "haskellPackages.amazonka-dynamodb-streams.x86_64-linux doc=/nix/store/m4rpsc9nx0qcflh9ni6qdlg6hbkwpicc-amazonka-dynamodb-streams-1.6.0-doc;/nix/store/rvd4zydr22a7j5kgnmg5x6695c7bgqbk-amazonka-dynamodb-streams-1.6.0\nhaskellPackages.agum.x86_64-darwin doc=/nix/store/n526rc0pa5h0krdzsdni5agcpvcd3cb9-agum-2.7-doc;/nix/store/s59r75svbjm724q5iaprq4mln5k6wcr9-agum-2.7" diff --git a/src/Shell.hs b/src/Shell.hs index f2910e4..07f3806 100644 --- a/src/Shell.hs +++ b/src/Shell.hs @@ -18,9 +18,9 @@ import Utils -- | Set environment variables needed by various programs setUpEnvironment :: Options -> Sh () -setUpEnvironment options = do +setUpEnvironment o = do setenv "PAGER" "" - setenv "GITHUB_TOKEN" (githubToken options) + setenv "GITHUB_TOKEN" (githubToken o) ourSilentShell :: Options -> Sh a -> IO a ourSilentShell o s = @@ -48,12 +48,12 @@ shE s = do -- of it. shRE :: Sh a -> Sh (Either Text Text) shRE s = do - canFail s + _ <- canFail s stderr <- lastStderr status <- lastExitCode case status of 0 -> return $ Left "" - c -> return $ Right stderr + _ -> return $ Right stderr shellyET :: MonadIO m => Sh a -> ExceptT Text m a shellyET = shE >>> shelly >>> ExceptT @@ -63,6 +63,6 @@ canFail = errExit False succeeded :: Sh a -> Sh Bool succeeded s = do - canFail s + _ <- canFail s status <- lastExitCode return (status == 0) diff --git a/src/Update.hs b/src/Update.hs index bee1057..e0767c2 100644 --- a/src/Update.hs +++ b/src/Update.hs @@ -13,21 +13,19 @@ import OurPrelude import qualified Blacklist import qualified Check -import Clean (fixSrcUrl) import Control.Exception (SomeException) import Control.Exception.Lifted import Data.IORef import qualified Data.Set as S import qualified Data.Text as T -import qualified Data.Text.IO as T -import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime, getCurrentTime) +import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime, iso8601DateFormat) import qualified File import qualified GH import qualified Git import qualified Nix import Outpaths -import Prelude hiding (FilePath) +import Prelude hiding (FilePath, log) import qualified Shell import Shelly.Lifted import Utils @@ -35,7 +33,6 @@ import Utils , UpdateEnv(..) , Version , branchName - , eitherToError , parseUpdates , tRead ) @@ -48,6 +45,7 @@ data MergeBaseOutpathsInfo = MergeBaseOutpathsInfo , mergeBaseOutpaths :: Set ResultLine } +log' :: (MonadIO m, MonadSh m) => FilePath -> Text -> m () log' logFile msg -- TODO: switch to Data.Time.Format.ISO8601 once time-1.9.0 is available = do @@ -57,10 +55,10 @@ log' logFile msg appendfile logFile (runDate <> " " <> msg <> "\n") updateAll :: Options -> IO () -updateAll options = - Shell.ourShell options $ do - let logFile = fromText (workingDir options) "ups.log" - mkdir_p (fromText (workingDir options)) +updateAll o = + Shell.ourShell o $ do + let logFile = fromText (workingDir o) "ups.log" + mkdir_p (fromText (workingDir o)) touchfile logFile updates <- readfile "packages-to-update.txt" let log = log' logFile @@ -70,7 +68,7 @@ updateAll options = liftIO $ addUTCTime (fromInteger $ -60 * 60 * 2) <$> getCurrentTime mergeBaseOutpathSet <- liftIO $ newIORef (MergeBaseOutpathsInfo twoHoursAgo S.empty) - updateLoop options log (parseUpdates updates) mergeBaseOutpathSet + updateLoop o log (parseUpdates updates) mergeBaseOutpathSet updateLoop :: Options @@ -79,28 +77,28 @@ updateLoop :: -> IORef MergeBaseOutpathsInfo -> Sh () updateLoop _ log [] _ = log "ups.sh finished" -updateLoop options log (Left e:moreUpdates) mergeBaseOutpathsContext = do +updateLoop o log (Left e:moreUpdates) mergeBaseOutpathsContext = do log e - updateLoop options log moreUpdates mergeBaseOutpathsContext -updateLoop options log (Right (package, oldVersion, newVersion):moreUpdates) mergeBaseOutpathsContext = do - log (package <> " " <> oldVersion <> " -> " <> newVersion) - let updateEnv = UpdateEnv package oldVersion newVersion options + updateLoop o log moreUpdates mergeBaseOutpathsContext +updateLoop o log (Right (pName, oldVer, newVer):moreUpdates) mergeBaseOutpathsContext = do + log (pName <> " " <> oldVer <> " -> " <> newVer) + let updateEnv = UpdateEnv pName oldVer newVer o updated <- updatePackage log updateEnv mergeBaseOutpathsContext case updated of Left failure -> do liftIO $ Git.cleanup (branchName updateEnv) log $ "FAIL " <> failure - if ".0" `T.isSuffixOf` newVersion - then let Just newNewVersion = ".0" `T.stripSuffix` newVersion + if ".0" `T.isSuffixOf` newVer + then let Just newNewVersion = ".0" `T.stripSuffix` newVer in updateLoop - options + o log - (Right (package, oldVersion, newNewVersion) : moreUpdates) + (Right (pName, oldVer, newNewVersion) : moreUpdates) mergeBaseOutpathsContext - else updateLoop options log moreUpdates mergeBaseOutpathsContext + else updateLoop o log moreUpdates mergeBaseOutpathsContext Right _ -> do log "SUCCESS" - updateLoop options log moreUpdates mergeBaseOutpathsContext + updateLoop o log moreUpdates mergeBaseOutpathsContext updatePackage :: (Text -> Sh ()) @@ -122,7 +120,7 @@ updatePackage log updateEnv mergeBaseOutpathsContext = Blacklist.attrPath attrPath masterShowRef <- lift $ Git.showRef "master" lift $ log masterShowRef - derivationFile <- Nix.getDerivationFile updateEnv attrPath + derivationFile <- Nix.getDerivationFile attrPath flip catches [Handler (\(ex :: SomeException) -> throwE (T.pack (show ex)))] $ -- Make sure it hasn't been updated on master do @@ -130,8 +128,8 @@ updatePackage log updateEnv mergeBaseOutpathsContext = Nix.assertOldVersionOn updateEnv "master" masterDerivationContents -- Make sure it hasn't been updated on staging Git.cleanAndResetToStaging - masterShowRef <- lift $ Git.showRef "staging" - lift $ log masterShowRef + stagingShowRef <- lift $ Git.showRef "staging" + lift $ log stagingShowRef stagingDerivationContents <- lift $ readfile derivationFile Nix.assertOldVersionOn updateEnv "staging" stagingDerivationContents lift $ Git.checkoutAtMergeBase (branchName updateEnv) diff --git a/src/Utils.hs b/src/Utils.hs index ca347b6..b658779 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -10,7 +10,6 @@ module Utils , tRead , parseUpdates , overwriteErrorT - , eitherToError , branchName ) where @@ -45,9 +44,10 @@ setupNixpkgs = do fp <- getUserCacheDir "nixpkgs" exists <- doesDirectoryExist fp unless exists $ do - shelly $ run "hub" ["clone", "nixpkgs", T.pack fp] -- requires that user has forked nixpkgs + _ <- shelly $ run "hub" ["clone", "nixpkgs", T.pack fp] -- requires that user has forked nixpkgs setCurrentDirectory fp - shelly $ + _ <- + shelly $ cmd "git" "remote" "add" "upstream" "https://github.com/NixOS/nixpkgs" shelly $ cmd "git" "fetch" "upstream" setCurrentDirectory fp @@ -56,14 +56,6 @@ setupNixpkgs = do overwriteErrorT :: MonadIO m => Text -> ExceptT Text m a -> ExceptT Text m a overwriteErrorT t = fmapLT (const t) -rewriteError :: Monad m => Text -> m (Either Text a) -> m (Either Text a) -rewriteError t = fmap (first (const t)) - -eitherToError :: Monad m => (Text -> m a) -> m (Either Text a) -> m a -eitherToError errorExit s = do - e <- s - either errorExit return e - branchName :: UpdateEnv -> Text branchName ue = "auto-update/" <> packageName ue @@ -71,8 +63,7 @@ parseUpdates :: Text -> [Either Text (Text, Version, Version)] parseUpdates = map (toTriple . T.words) . T.lines where toTriple :: [Text] -> Either Text (Text, Version, Version) - toTriple [package, oldVersion, newVersion] = - Right (package, oldVersion, newVersion) + toTriple [package, oldVer, newVer] = Right (package, oldVer, newVer) toTriple line = Left $ "Unable to parse update: " <> T.unwords line tRead :: Read a => Text -> a diff --git a/src/Version.hs b/src/Version.hs index 8b7a36c..ea08d21 100644 --- a/src/Version.hs +++ b/src/Version.hs @@ -10,7 +10,7 @@ import qualified Data.Text as T import Utils notElemOf :: (Eq a, Foldable t) => t a -> a -> Bool -notElemOf options = not . flip elem options +notElemOf o = not . flip elem o -- | Similar to @breakOn@, but will not keep the pattern at the beginning of the suffix. -- @@ -49,19 +49,19 @@ clearBreakOn boundary string = -- >>> versionCompatibleWithPathPin "nodejs-slim-10_x" "10.12.0" -- True versionCompatibleWithPathPin :: Text -> Version -> Bool -versionCompatibleWithPathPin attrPath newVersion +versionCompatibleWithPathPin attrPath newVer | "_x" `T.isSuffixOf` T.toLower attrPath = - versionCompatibleWithPathPin (T.dropEnd 2 attrPath) newVersion + versionCompatibleWithPathPin (T.dropEnd 2 attrPath) newVer | "_" `T.isInfixOf` attrPath = let attrVersionPart = - let (name, version) = clearBreakOn "_" attrPath + let (_, version) = clearBreakOn "_" attrPath in if T.any (notElemOf ('_' : ['0' .. '9'])) version then Nothing else Just version -- Check assuming version part has underscore separators attrVersionPeriods = T.replace "_" "." <$> attrVersionPart -- If we don't find version numbers in the attr path, exit success. - in maybe True (`T.isPrefixOf` newVersion) attrVersionPeriods + in maybe True (`T.isPrefixOf` newVer) attrVersionPeriods | otherwise = let attrVersionPart = let version = T.dropWhile (notElemOf ['0' .. '9']) attrPath @@ -70,7 +70,7 @@ versionCompatibleWithPathPin attrPath newVersion else Just version -- Check assuming version part is the prefix of the version with dots -- removed. For example, 91 => "9.1" - noPeriodNewVersion = T.replace "." "" newVersion + noPeriodNewVersion = T.replace "." "" newVer -- If we don't find version numbers in the attr path, exit success. in maybe True (`T.isPrefixOf` noPeriodNewVersion) attrVersionPart