mirror of
https://github.com/ryantm/nixpkgs-update.git
synced 2024-08-17 01:30:21 +03:00
use -Wall and fix all warnings
This commit is contained in:
parent
2ebd9c33db
commit
2d4fe9053a
1
.gitignore
vendored
1
.gitignore
vendored
@ -5,3 +5,4 @@ dist/
|
||||
dist-newstyle/
|
||||
/nixpkgs-update.cabal
|
||||
/shell.nix
|
||||
.ghc*
|
@ -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:
|
||||
|
30
src/Check.hs
30
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 " <>
|
||||
|
21
src/Clean.hs
21
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 $
|
||||
|
@ -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)
|
||||
|
13
src/GH.hs
13
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 =
|
||||
|
26
src/Git.hs
26
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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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"
|
||||
|
||||
|
10
src/Shell.hs
10
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)
|
||||
|
@ -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)
|
||||
|
17
src/Utils.hs
17
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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user