mirror of
https://github.com/ryantm/nixpkgs-update.git
synced 2024-08-16 17:20:37 +03:00
Merge a1863fa89e
into d49fec1752
This commit is contained in:
commit
e4439a2e35
54
flake.lock
54
flake.lock
@ -5,14 +5,14 @@
|
|||||||
"nixpkgs": [
|
"nixpkgs": [
|
||||||
"nixpkgs"
|
"nixpkgs"
|
||||||
],
|
],
|
||||||
"nixpkgs-for-manual": "nixpkgs-for-manual"
|
"systems": "systems"
|
||||||
},
|
},
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1669050835,
|
"lastModified": 1710694589,
|
||||||
"narHash": "sha256-4ppYRBBY6lIqwMNYp0XA2mku1lSPyX4JaoTf+gt5NDg=",
|
"narHash": "sha256-5wa+Jzxr+LygoxSZuZg0YU81jgdnx2IY/CqDIJMOgec=",
|
||||||
"owner": "ryantm",
|
"owner": "ryantm",
|
||||||
"repo": "mmdoc",
|
"repo": "mmdoc",
|
||||||
"rev": "cec02bafac9456bd1ed9b261b8d163a893885e5b",
|
"rev": "b6ddf748b1d1c01ca582bb1b3dafd6bc3a4c83a6",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
@ -23,11 +23,11 @@
|
|||||||
},
|
},
|
||||||
"nixpkgs": {
|
"nixpkgs": {
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1672428209,
|
"lastModified": 1714213793,
|
||||||
"narHash": "sha256-eejhqkDz2cb2vc5VeaWphJz8UXNuoNoM8/Op8eWv2tQ=",
|
"narHash": "sha256-Yg5D5LhyAZvd3DZrQQfJAVK8K3TkUYKooFtH1ulM0mw=",
|
||||||
"owner": "NixOS",
|
"owner": "NixOS",
|
||||||
"repo": "nixpkgs",
|
"repo": "nixpkgs",
|
||||||
"rev": "293a28df6d7ff3dec1e61e37cc4ee6e6c0fb0847",
|
"rev": "d6f6eb2a984f2ba9a366c31e4d36d65465683450",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
@ -35,43 +35,25 @@
|
|||||||
"type": "indirect"
|
"type": "indirect"
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
"nixpkgs-for-manual": {
|
|
||||||
"locked": {
|
|
||||||
"lastModified": 1663819393,
|
|
||||||
"narHash": "sha256-SMWfyAOKRPBC95M8dhZJTlb0kHyilr2lKEAfQSHlM7I=",
|
|
||||||
"owner": "ryantm",
|
|
||||||
"repo": "nixpkgs",
|
|
||||||
"rev": "6a6caacfdd079a0fa249046514480a1c4597d861",
|
|
||||||
"type": "github"
|
|
||||||
},
|
|
||||||
"original": {
|
|
||||||
"owner": "ryantm",
|
|
||||||
"ref": "minman",
|
|
||||||
"repo": "nixpkgs",
|
|
||||||
"type": "github"
|
|
||||||
}
|
|
||||||
},
|
|
||||||
"root": {
|
"root": {
|
||||||
"inputs": {
|
"inputs": {
|
||||||
"mmdoc": "mmdoc",
|
"mmdoc": "mmdoc",
|
||||||
"nixpkgs": "nixpkgs",
|
"nixpkgs": "nixpkgs",
|
||||||
"runtimeDeps": "runtimeDeps",
|
|
||||||
"treefmt-nix": "treefmt-nix"
|
"treefmt-nix": "treefmt-nix"
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
"runtimeDeps": {
|
"systems": {
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1714247354,
|
"lastModified": 1681028828,
|
||||||
"narHash": "sha256-6dFKqP/aCKIdpOgqgIQUrRT0NOfVc14ftNcdELa4Pu4=",
|
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
|
||||||
"owner": "NixOS",
|
"owner": "nix-systems",
|
||||||
"repo": "nixpkgs",
|
"repo": "default",
|
||||||
"rev": "c8d7c8a78fb516c0842cc65346506a565c88014d",
|
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
"owner": "NixOS",
|
"owner": "nix-systems",
|
||||||
"ref": "nixos-unstable-small",
|
"repo": "default",
|
||||||
"repo": "nixpkgs",
|
|
||||||
"type": "github"
|
"type": "github"
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
@ -82,11 +64,11 @@
|
|||||||
]
|
]
|
||||||
},
|
},
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1711963903,
|
"lastModified": 1714058656,
|
||||||
"narHash": "sha256-N3QDhoaX+paWXHbEXZapqd1r95mdshxToGowtjtYkGI=",
|
"narHash": "sha256-Qv4RBm4LKuO4fNOfx9wl40W2rBbv5u5m+whxRYUMiaA=",
|
||||||
"owner": "numtide",
|
"owner": "numtide",
|
||||||
"repo": "treefmt-nix",
|
"repo": "treefmt-nix",
|
||||||
"rev": "49dc4a92b02b8e68798abd99184f228243b6e3ac",
|
"rev": "c6aaf729f34a36c445618580a9f95a48f5e4e03f",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
|
@ -7,12 +7,10 @@
|
|||||||
inputs.treefmt-nix.url = "github:numtide/treefmt-nix";
|
inputs.treefmt-nix.url = "github:numtide/treefmt-nix";
|
||||||
inputs.treefmt-nix.inputs.nixpkgs.follows = "nixpkgs";
|
inputs.treefmt-nix.inputs.nixpkgs.follows = "nixpkgs";
|
||||||
|
|
||||||
inputs.runtimeDeps.url = "github:NixOS/nixpkgs/nixos-unstable-small";
|
|
||||||
|
|
||||||
nixConfig.extra-substituters = "https://nix-community.cachix.org";
|
nixConfig.extra-substituters = "https://nix-community.cachix.org";
|
||||||
nixConfig.extra-trusted-public-keys = "nix-community.cachix.org-1:mB9FSh9qf2dCimDSUo8Zy7bkq5CX+/rkCWyvRCYg3Fs=";
|
nixConfig.extra-trusted-public-keys = "nix-community.cachix.org-1:mB9FSh9qf2dCimDSUo8Zy7bkq5CX+/rkCWyvRCYg3Fs=";
|
||||||
|
|
||||||
outputs = { self, nixpkgs, mmdoc, treefmt-nix, runtimeDeps } @ args:
|
outputs = { self, nixpkgs, mmdoc, treefmt-nix } @ args:
|
||||||
let
|
let
|
||||||
systems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
|
systems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
|
||||||
eachSystem = f: nixpkgs.lib.genAttrs systems (system: f nixpkgs.legacyPackages.${system});
|
eachSystem = f: nixpkgs.lib.genAttrs systems (system: f nixpkgs.legacyPackages.${system});
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
{ nixpkgs
|
{ nixpkgs
|
||||||
, mmdoc
|
, mmdoc
|
||||||
, runtimeDeps
|
|
||||||
, system
|
, system
|
||||||
, self
|
, self
|
||||||
, ...
|
, ...
|
||||||
@ -8,11 +7,9 @@
|
|||||||
|
|
||||||
let
|
let
|
||||||
|
|
||||||
runtimePkgs = import runtimeDeps { inherit system; };
|
|
||||||
|
|
||||||
pkgs = import nixpkgs { inherit system; config = { allowBroken = true; }; };
|
pkgs = import nixpkgs { inherit system; config = { allowBroken = true; }; };
|
||||||
|
|
||||||
drvAttrs = attrs: with runtimePkgs; {
|
drvAttrs = attrs: with pkgs; {
|
||||||
NIX = nix;
|
NIX = nix;
|
||||||
GIT = git;
|
GIT = git;
|
||||||
JQ = jq;
|
JQ = jq;
|
||||||
@ -33,7 +30,7 @@ let
|
|||||||
pkgs.haskell.lib.failOnAllWarnings (
|
pkgs.haskell.lib.failOnAllWarnings (
|
||||||
pkgs.haskell.lib.disableExecutableProfiling (
|
pkgs.haskell.lib.disableExecutableProfiling (
|
||||||
pkgs.haskell.lib.disableLibraryProfiling (
|
pkgs.haskell.lib.disableLibraryProfiling (
|
||||||
pkgs.haskell.lib.generateOptparseApplicativeCompletion "nixpkgs-update" (
|
pkgs.haskellPackages.generateOptparseApplicativeCompletions [ "nixpkgs-update" ] (
|
||||||
(haskellPackages.callPackage ../nixpkgs-update.nix { }).overrideAttrs drvAttrs
|
(haskellPackages.callPackage ../nixpkgs-update.nix { }).overrideAttrs drvAttrs
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
@ -123,7 +123,7 @@ instance Show CPE where
|
|||||||
]
|
]
|
||||||
<> "}"
|
<> "}"
|
||||||
where
|
where
|
||||||
cpeField :: Show a => String -> Maybe a -> [String]
|
cpeField :: (Show a) => String -> Maybe a -> [String]
|
||||||
cpeField _ Nothing = []
|
cpeField _ Nothing = []
|
||||||
cpeField name (Just value) = [name <> " = " <> show value]
|
cpeField name (Just value) = [name <> " = " <> show value]
|
||||||
|
|
||||||
|
@ -176,7 +176,7 @@ duGist resultPath =
|
|||||||
return $ "- du listing: " <> g <> "\n"
|
return $ "- du listing: " <> g <> "\n"
|
||||||
)
|
)
|
||||||
|
|
||||||
result :: MonadIO m => UpdateEnv -> String -> m Text
|
result :: (MonadIO m) => UpdateEnv -> String -> m Text
|
||||||
result updateEnv resultPath =
|
result updateEnv resultPath =
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
let expectedVersion = newVersion updateEnv
|
let expectedVersion = newVersion updateEnv
|
||||||
|
@ -26,7 +26,7 @@ class Hex t where
|
|||||||
hex :: t -> t
|
hex :: t -> t
|
||||||
|
|
||||||
-- | Convert from hexadecimal and fail on invalid input.
|
-- | Convert from hexadecimal and fail on invalid input.
|
||||||
unhex :: MonadFail m => t -> m t
|
unhex :: (MonadFail m) => t -> m t
|
||||||
|
|
||||||
instance Hex String where
|
instance Hex String where
|
||||||
hex = Prelude.concatMap w
|
hex = Prelude.concatMap w
|
||||||
@ -42,7 +42,7 @@ instance Hex String where
|
|||||||
liftM (toEnum ((x * 16) + y) :) $ unhex r
|
liftM (toEnum ((x * 16) + y) :) $ unhex r
|
||||||
unhex [_] = fail "Non-even length"
|
unhex [_] = fail "Non-even length"
|
||||||
|
|
||||||
c :: MonadFail m => Char -> m Int
|
c :: (MonadFail m) => Char -> m Int
|
||||||
c '0' = return 0
|
c '0' = return 0
|
||||||
c '1' = return 1
|
c '1' = return 1
|
||||||
c '2' = return 2
|
c '2' = return 2
|
||||||
|
@ -18,7 +18,7 @@ data File m a where
|
|||||||
makeSem ''File
|
makeSem ''File
|
||||||
|
|
||||||
runIO ::
|
runIO ::
|
||||||
Member (Embed IO) r =>
|
(Member (Embed IO) r) =>
|
||||||
Sem (File ': r) a ->
|
Sem (File ': r) a ->
|
||||||
Sem r a
|
Sem r a
|
||||||
runIO =
|
runIO =
|
||||||
@ -38,7 +38,7 @@ runPure contentList =
|
|||||||
Write _file contents -> output contents
|
Write _file contents -> output contents
|
||||||
|
|
||||||
replace ::
|
replace ::
|
||||||
Member File r =>
|
(Member File r) =>
|
||||||
Text ->
|
Text ->
|
||||||
Text ->
|
Text ->
|
||||||
FilePath ->
|
FilePath ->
|
||||||
@ -50,7 +50,7 @@ replace find replacement file = do
|
|||||||
File.write file newContents
|
File.write file newContents
|
||||||
return $ contents /= newContents
|
return $ contents /= newContents
|
||||||
|
|
||||||
replaceIO :: MonadIO m => Text -> Text -> FilePath -> m Bool
|
replaceIO :: (MonadIO m) => Text -> Text -> FilePath -> m Bool
|
||||||
replaceIO find replacement file =
|
replaceIO find replacement file =
|
||||||
liftIO $
|
liftIO $
|
||||||
runFinal $
|
runFinal $
|
||||||
|
18
src/GH.hs
18
src/GH.hs
@ -38,18 +38,18 @@ import qualified Utils as U
|
|||||||
|
|
||||||
default (T.Text)
|
default (T.Text)
|
||||||
|
|
||||||
gReleaseUrl :: MonadIO m => GH.Auth -> URLParts -> ExceptT Text m Text
|
gReleaseUrl :: (MonadIO m) => GH.Auth -> URLParts -> ExceptT Text m Text
|
||||||
gReleaseUrl auth (URLParts o r t) =
|
gReleaseUrl auth (URLParts o r t) =
|
||||||
ExceptT $
|
ExceptT $
|
||||||
bimap (T.pack . show) (GH.getUrl . GH.releaseHtmlUrl)
|
bimap (T.pack . show) (GH.getUrl . GH.releaseHtmlUrl)
|
||||||
<$> liftIO (GH.github auth (GH.releaseByTagNameR o r t))
|
<$> liftIO (GH.github auth (GH.releaseByTagNameR o r t))
|
||||||
|
|
||||||
releaseUrl :: MonadIO m => UpdateEnv -> Text -> ExceptT Text m Text
|
releaseUrl :: (MonadIO m) => UpdateEnv -> Text -> ExceptT Text m Text
|
||||||
releaseUrl env url = do
|
releaseUrl env url = do
|
||||||
urlParts <- parseURL url
|
urlParts <- parseURL url
|
||||||
gReleaseUrl (authFrom env) urlParts
|
gReleaseUrl (authFrom env) urlParts
|
||||||
|
|
||||||
pr :: MonadIO m => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text)
|
pr :: (MonadIO m) => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text)
|
||||||
pr env title body prHead base = do
|
pr env title body prHead base = do
|
||||||
tryPR `catchE` \case
|
tryPR `catchE` \case
|
||||||
-- If creating the PR returns a 422, most likely cause is that the
|
-- If creating the PR returns a 422, most likely cause is that the
|
||||||
@ -74,9 +74,9 @@ pr env title body prHead base = do
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
prUpdate :: forall m. MonadIO m => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text)
|
prUpdate :: forall m. (MonadIO m) => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text)
|
||||||
prUpdate env title body prHead base = do
|
prUpdate env title body prHead base = do
|
||||||
let runRequest :: FromJSON a => GH.Request k a -> ExceptT Text m a
|
let runRequest :: (FromJSON a) => GH.Request k a -> ExceptT Text m a
|
||||||
runRequest = ExceptT . fmap (first (T.pack . show)) . liftIO . GH.github (authFrom env)
|
runRequest = ExceptT . fmap (first (T.pack . show)) . liftIO . GH.github (authFrom env)
|
||||||
let inNixpkgs f = f (N "nixos") (N "nixpkgs")
|
let inNixpkgs f = f (N "nixos") (N "nixpkgs")
|
||||||
|
|
||||||
@ -149,11 +149,11 @@ parseURLMaybe url =
|
|||||||
)
|
)
|
||||||
in url =~ regex
|
in url =~ regex
|
||||||
|
|
||||||
parseURL :: MonadIO m => Text -> ExceptT Text m URLParts
|
parseURL :: (MonadIO m) => Text -> ExceptT Text m URLParts
|
||||||
parseURL url =
|
parseURL url =
|
||||||
tryJust ("GitHub: " <> url <> " is not a GitHub URL.") (parseURLMaybe url)
|
tryJust ("GitHub: " <> url <> " is not a GitHub URL.") (parseURLMaybe url)
|
||||||
|
|
||||||
compareUrl :: MonadIO m => Text -> Text -> ExceptT Text m Text
|
compareUrl :: (MonadIO m) => Text -> Text -> ExceptT Text m Text
|
||||||
compareUrl urlOld urlNew = do
|
compareUrl urlOld urlNew = do
|
||||||
oldParts <- parseURL urlOld
|
oldParts <- parseURL urlOld
|
||||||
newParts <- parseURL urlNew
|
newParts <- parseURL urlNew
|
||||||
@ -213,7 +213,7 @@ authFromToken = GH.OAuth . T.encodeUtf8
|
|||||||
authFrom :: UpdateEnv -> GH.Auth
|
authFrom :: UpdateEnv -> GH.Auth
|
||||||
authFrom = authFromToken . U.githubToken . options
|
authFrom = authFromToken . U.githubToken . options
|
||||||
|
|
||||||
checkExistingUpdatePR :: MonadIO m => UpdateEnv -> Text -> ExceptT Text m ()
|
checkExistingUpdatePR :: (MonadIO m) => UpdateEnv -> Text -> ExceptT Text m ()
|
||||||
checkExistingUpdatePR env attrPath = do
|
checkExistingUpdatePR env attrPath = do
|
||||||
searchResult <-
|
searchResult <-
|
||||||
ExceptT $
|
ExceptT $
|
||||||
@ -239,7 +239,7 @@ checkExistingUpdatePR env attrPath = do
|
|||||||
& T.unlines
|
& T.unlines
|
||||||
report i = "- " <> GH.issueTitle i <> "\n " <> tshow (GH.issueUrl i)
|
report i = "- " <> GH.issueTitle i <> "\n " <> tshow (GH.issueUrl i)
|
||||||
|
|
||||||
latestVersion :: MonadIO m => UpdateEnv -> Text -> ExceptT Text m Version
|
latestVersion :: (MonadIO m) => UpdateEnv -> Text -> ExceptT Text m Version
|
||||||
latestVersion env url = do
|
latestVersion env url = do
|
||||||
urlParts <- parseURL url
|
urlParts <- parseURL url
|
||||||
r <-
|
r <-
|
||||||
|
26
src/Git.hs
26
src/Git.hs
@ -80,7 +80,7 @@ deleteOrigin :: [Text] -> ProcessConfig () () ()
|
|||||||
deleteOrigin branches =
|
deleteOrigin branches =
|
||||||
silently $ procGit (["push", "origin", "--delete"] ++ fmap T.unpack branches)
|
silently $ procGit (["push", "origin", "--delete"] ++ fmap T.unpack branches)
|
||||||
|
|
||||||
cleanAndResetTo :: MonadIO m => Text -> ExceptT Text m ()
|
cleanAndResetTo :: (MonadIO m) => Text -> ExceptT Text m ()
|
||||||
cleanAndResetTo branch =
|
cleanAndResetTo branch =
|
||||||
let target = "upstream/" <> branch
|
let target = "upstream/" <> branch
|
||||||
in do
|
in do
|
||||||
@ -90,19 +90,19 @@ cleanAndResetTo branch =
|
|||||||
runProcessNoIndexIssue_ $ reset target
|
runProcessNoIndexIssue_ $ reset target
|
||||||
runProcessNoIndexIssue_ clean
|
runProcessNoIndexIssue_ clean
|
||||||
|
|
||||||
show :: MonadIO m => Text -> Text -> ExceptT Text m Text
|
show :: (MonadIO m) => Text -> Text -> ExceptT Text m Text
|
||||||
show branch file =
|
show branch file =
|
||||||
readProcessInterleavedNoIndexIssue_ $ silently $ procGit ["show", T.unpack ("remotes/upstream/" <> branch <> ":" <> file)]
|
readProcessInterleavedNoIndexIssue_ $ silently $ procGit ["show", T.unpack ("remotes/upstream/" <> branch <> ":" <> file)]
|
||||||
|
|
||||||
diff :: MonadIO m => Text -> ExceptT Text m Text
|
diff :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
diff branch = readProcessInterleavedNoIndexIssue_ $ procGit ["diff", T.unpack branch]
|
diff branch = readProcessInterleavedNoIndexIssue_ $ procGit ["diff", T.unpack branch]
|
||||||
|
|
||||||
diffFileNames :: MonadIO m => Text -> ExceptT Text m [Text]
|
diffFileNames :: (MonadIO m) => Text -> ExceptT Text m [Text]
|
||||||
diffFileNames branch =
|
diffFileNames branch =
|
||||||
readProcessInterleavedNoIndexIssue_ (procGit ["diff", T.unpack branch, "--name-only"])
|
readProcessInterleavedNoIndexIssue_ (procGit ["diff", T.unpack branch, "--name-only"])
|
||||||
& fmapRT T.lines
|
& fmapRT T.lines
|
||||||
|
|
||||||
staleFetchHead :: MonadIO m => m Bool
|
staleFetchHead :: (MonadIO m) => m Bool
|
||||||
staleFetchHead =
|
staleFetchHead =
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
nixpkgsGit <- getUserCacheDir "nixpkgs"
|
nixpkgsGit <- getUserCacheDir "nixpkgs"
|
||||||
@ -116,16 +116,16 @@ staleFetchHead =
|
|||||||
fetchedLast <- getModificationTime fetchHead
|
fetchedLast <- getModificationTime fetchHead
|
||||||
return (fetchedLast < oneHourAgo)
|
return (fetchedLast < oneHourAgo)
|
||||||
|
|
||||||
fetchIfStale :: MonadIO m => ExceptT Text m ()
|
fetchIfStale :: (MonadIO m) => ExceptT Text m ()
|
||||||
fetchIfStale = whenM staleFetchHead fetch
|
fetchIfStale = whenM staleFetchHead fetch
|
||||||
|
|
||||||
fetch :: MonadIO m => ExceptT Text m ()
|
fetch :: (MonadIO m) => ExceptT Text m ()
|
||||||
fetch =
|
fetch =
|
||||||
runProcessNoIndexIssue_ $
|
runProcessNoIndexIssue_ $
|
||||||
silently $
|
silently $
|
||||||
procGit ["fetch", "-q", "--prune", "--multiple", "upstream", "origin"]
|
procGit ["fetch", "-q", "--prune", "--multiple", "upstream", "origin"]
|
||||||
|
|
||||||
push :: MonadIO m => UpdateEnv -> ExceptT Text m ()
|
push :: (MonadIO m) => UpdateEnv -> ExceptT Text m ()
|
||||||
push updateEnv =
|
push updateEnv =
|
||||||
runProcessNoIndexIssue_
|
runProcessNoIndexIssue_
|
||||||
( procGit
|
( procGit
|
||||||
@ -176,7 +176,7 @@ mergeBase = do
|
|||||||
|
|
||||||
-- Return Nothing if a remote branch for this package doesn't exist. If a
|
-- Return Nothing if a remote branch for this package doesn't exist. If a
|
||||||
-- branch does exist, return a Just of its last commit message.
|
-- branch does exist, return a Just of its last commit message.
|
||||||
findAutoUpdateBranchMessage :: MonadIO m => Text -> ExceptT Text m (Maybe Text)
|
findAutoUpdateBranchMessage :: (MonadIO m) => Text -> ExceptT Text m (Maybe Text)
|
||||||
findAutoUpdateBranchMessage pName = do
|
findAutoUpdateBranchMessage pName = do
|
||||||
remoteBranches <-
|
remoteBranches <-
|
||||||
readProcessInterleavedNoIndexIssue_ (procGit ["branch", "--remote", "--format=%(refname:short) %(subject)"])
|
readProcessInterleavedNoIndexIssue_ (procGit ["branch", "--remote", "--format=%(refname:short) %(subject)"])
|
||||||
@ -190,11 +190,11 @@ inNixpkgsRepo = do
|
|||||||
currentDir <- getCurrentDirectory
|
currentDir <- getCurrentDirectory
|
||||||
doesFileExist (currentDir <> "/nixos/release.nix")
|
doesFileExist (currentDir <> "/nixos/release.nix")
|
||||||
|
|
||||||
commit :: MonadIO m => Text -> ExceptT Text m ()
|
commit :: (MonadIO m) => Text -> ExceptT Text m ()
|
||||||
commit ref =
|
commit ref =
|
||||||
runProcessNoIndexIssue_ (procGit ["commit", "-am", T.unpack ref])
|
runProcessNoIndexIssue_ (procGit ["commit", "-am", T.unpack ref])
|
||||||
|
|
||||||
headRev :: MonadIO m => ExceptT Text m Text
|
headRev :: (MonadIO m) => ExceptT Text m Text
|
||||||
headRev = T.strip <$> readProcessInterleavedNoIndexIssue_ (procGit ["rev-parse", "HEAD"])
|
headRev = T.strip <$> readProcessInterleavedNoIndexIssue_ (procGit ["rev-parse", "HEAD"])
|
||||||
|
|
||||||
deleteBranchesEverywhere :: Vector Text -> IO ()
|
deleteBranchesEverywhere :: Vector Text -> IO ()
|
||||||
@ -227,7 +227,7 @@ runProcessNoIndexIssue_IO config = go
|
|||||||
ExitFailure _ -> throw $ ExitCodeException code config out e
|
ExitFailure _ -> throw $ ExitCodeException code config out e
|
||||||
|
|
||||||
runProcessNoIndexIssue_ ::
|
runProcessNoIndexIssue_ ::
|
||||||
MonadIO m => ProcessConfig () () () -> ExceptT Text m ()
|
(MonadIO m) => ProcessConfig () () () -> ExceptT Text m ()
|
||||||
runProcessNoIndexIssue_ config = tryIOTextET go
|
runProcessNoIndexIssue_ config = tryIOTextET go
|
||||||
where
|
where
|
||||||
go = do
|
go = do
|
||||||
@ -241,7 +241,7 @@ runProcessNoIndexIssue_ config = tryIOTextET go
|
|||||||
ExitFailure _ -> throw $ ExitCodeException code config out e
|
ExitFailure _ -> throw $ ExitCodeException code config out e
|
||||||
|
|
||||||
readProcessInterleavedNoIndexIssue_ ::
|
readProcessInterleavedNoIndexIssue_ ::
|
||||||
MonadIO m => ProcessConfig () () () -> ExceptT Text m Text
|
(MonadIO m) => ProcessConfig () () () -> ExceptT Text m Text
|
||||||
readProcessInterleavedNoIndexIssue_ config = tryIOTextET go
|
readProcessInterleavedNoIndexIssue_ config = tryIOTextET go
|
||||||
where
|
where
|
||||||
go = do
|
go = do
|
||||||
|
@ -16,17 +16,17 @@ filter _ cpeMatch "socat" v
|
|||||||
filter _ cpeMatch "uzbl" v
|
filter _ cpeMatch "uzbl" v
|
||||||
| isNothing (v =~ yearRegex)
|
| isNothing (v =~ yearRegex)
|
||||||
&& "2009.12.22"
|
&& "2009.12.22"
|
||||||
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
||||||
False
|
False
|
||||||
| isNothing (v =~ yearRegex)
|
| isNothing (v =~ yearRegex)
|
||||||
&& "2010.04.03"
|
&& "2010.04.03"
|
||||||
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
||||||
False
|
False
|
||||||
filter _ cpeMatch "go" v
|
filter _ cpeMatch "go" v
|
||||||
| "."
|
| "."
|
||||||
`T.isInfixOf` v
|
`T.isInfixOf` v
|
||||||
&& "-"
|
&& "-"
|
||||||
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
||||||
False
|
False
|
||||||
filter _ cpeMatch "terraform" _
|
filter _ cpeMatch "terraform" _
|
||||||
| cpeTargetSoftware (cpeMatchCPE cpeMatch) == Just "aws" = False
|
| cpeTargetSoftware (cpeMatchCPE cpeMatch) == Just "aws" = False
|
||||||
|
52
src/Nix.hs
52
src/Nix.hs
@ -61,7 +61,7 @@ rawOpt Raw = ["--raw"]
|
|||||||
rawOpt NoRaw = []
|
rawOpt NoRaw = []
|
||||||
|
|
||||||
nixEvalApply ::
|
nixEvalApply ::
|
||||||
MonadIO m =>
|
(MonadIO m) =>
|
||||||
Text ->
|
Text ->
|
||||||
Text ->
|
Text ->
|
||||||
ExceptT Text m Text
|
ExceptT Text m Text
|
||||||
@ -71,7 +71,7 @@ nixEvalApply applyFunc attrPath =
|
|||||||
& fmapRT (fst >>> T.strip)
|
& fmapRT (fst >>> T.strip)
|
||||||
|
|
||||||
nixEvalApplyRaw ::
|
nixEvalApplyRaw ::
|
||||||
MonadIO m =>
|
(MonadIO m) =>
|
||||||
Text ->
|
Text ->
|
||||||
Text ->
|
Text ->
|
||||||
ExceptT Text m Text
|
ExceptT Text m Text
|
||||||
@ -81,7 +81,7 @@ nixEvalApplyRaw applyFunc attrPath =
|
|||||||
& fmapRT (fst >>> T.strip)
|
& fmapRT (fst >>> T.strip)
|
||||||
|
|
||||||
nixEvalExpr ::
|
nixEvalExpr ::
|
||||||
MonadIO m =>
|
(MonadIO m) =>
|
||||||
Text ->
|
Text ->
|
||||||
ExceptT Text m Text
|
ExceptT Text m Text
|
||||||
nixEvalExpr expr =
|
nixEvalExpr expr =
|
||||||
@ -90,7 +90,7 @@ nixEvalExpr expr =
|
|||||||
& fmapRT (fst >>> T.strip)
|
& fmapRT (fst >>> T.strip)
|
||||||
|
|
||||||
-- Error if the "new version" is actually newer according to nix
|
-- Error if the "new version" is actually newer according to nix
|
||||||
assertNewerVersion :: MonadIO m => UpdateEnv -> ExceptT Text m ()
|
assertNewerVersion :: (MonadIO m) => UpdateEnv -> ExceptT Text m ()
|
||||||
assertNewerVersion updateEnv = do
|
assertNewerVersion updateEnv = do
|
||||||
versionComparison <-
|
versionComparison <-
|
||||||
nixEvalExpr
|
nixEvalExpr
|
||||||
@ -113,7 +113,7 @@ assertNewerVersion updateEnv = do
|
|||||||
)
|
)
|
||||||
|
|
||||||
-- This is extremely slow but gives us the best results we know of
|
-- This is extremely slow but gives us the best results we know of
|
||||||
lookupAttrPath :: MonadIO m => UpdateEnv -> ExceptT Text m Text
|
lookupAttrPath :: (MonadIO m) => UpdateEnv -> ExceptT Text m Text
|
||||||
lookupAttrPath updateEnv =
|
lookupAttrPath updateEnv =
|
||||||
-- lookup attrpath by nix-env
|
-- lookup attrpath by nix-env
|
||||||
( proc
|
( proc
|
||||||
@ -134,7 +134,7 @@ lookupAttrPath updateEnv =
|
|||||||
(getAttrString "name" (packageName updateEnv))
|
(getAttrString "name" (packageName updateEnv))
|
||||||
& fmapRT (const (packageName updateEnv))
|
& fmapRT (const (packageName updateEnv))
|
||||||
|
|
||||||
getDerivationFile :: MonadIO m => Text -> ExceptT Text m Text
|
getDerivationFile :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getDerivationFile attrPath = do
|
getDerivationFile attrPath = do
|
||||||
npDir <- liftIO $ Git.nixpkgsDir
|
npDir <- liftIO $ Git.nixpkgsDir
|
||||||
proc "env" ["EDITOR=echo", (binPath <> "/nix"), "--extra-experimental-features", "nix-command", "edit", attrPath & T.unpack, "-f", "."]
|
proc "env" ["EDITOR=echo", (binPath <> "/nix"), "--extra-experimental-features", "nix-command", "edit", attrPath & T.unpack, "-f", "."]
|
||||||
@ -143,20 +143,20 @@ getDerivationFile attrPath = do
|
|||||||
|
|
||||||
-- Get an attribute that can be evaluated off a derivation, as in:
|
-- Get an attribute that can be evaluated off a derivation, as in:
|
||||||
-- getAttr "cargoSha256" "ripgrep" -> 0lwz661rbm7kwkd6mallxym1pz8ynda5f03ynjfd16vrazy2dj21
|
-- getAttr "cargoSha256" "ripgrep" -> 0lwz661rbm7kwkd6mallxym1pz8ynda5f03ynjfd16vrazy2dj21
|
||||||
getAttr :: MonadIO m => Text -> Text -> ExceptT Text m Text
|
getAttr :: (MonadIO m) => Text -> Text -> ExceptT Text m Text
|
||||||
getAttr attr = srcOrMain (nixEvalApply ("p: p." <> attr))
|
getAttr attr = srcOrMain (nixEvalApply ("p: p." <> attr))
|
||||||
|
|
||||||
getAttrString :: MonadIO m => Text -> Text -> ExceptT Text m Text
|
getAttrString :: (MonadIO m) => Text -> Text -> ExceptT Text m Text
|
||||||
getAttrString attr = srcOrMain (nixEvalApplyRaw ("p: p." <> attr))
|
getAttrString attr = srcOrMain (nixEvalApplyRaw ("p: p." <> attr))
|
||||||
|
|
||||||
getHash :: MonadIO m => Text -> ExceptT Text m Text
|
getHash :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getHash = getAttrString "drvAttrs.outputHash"
|
getHash = getAttrString "drvAttrs.outputHash"
|
||||||
|
|
||||||
getMaintainers :: MonadIO m => Text -> ExceptT Text m Text
|
getMaintainers :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getMaintainers =
|
getMaintainers =
|
||||||
nixEvalApplyRaw "p: let gh = m : m.github or \"\"; nonempty = s: s != \"\"; addAt = s: \"@\"+s; in builtins.concatStringsSep \" \" (map addAt (builtins.filter nonempty (map gh p.meta.maintainers or [])))"
|
nixEvalApplyRaw "p: let gh = m : m.github or \"\"; nonempty = s: s != \"\"; addAt = s: \"@\"+s; in builtins.concatStringsSep \" \" (map addAt (builtins.filter nonempty (map gh p.meta.maintainers or [])))"
|
||||||
|
|
||||||
readNixBool :: MonadIO m => ExceptT Text m Text -> ExceptT Text m Bool
|
readNixBool :: (MonadIO m) => ExceptT Text m Text -> ExceptT Text m Bool
|
||||||
readNixBool t = do
|
readNixBool t = do
|
||||||
text <- t
|
text <- t
|
||||||
case text of
|
case text of
|
||||||
@ -164,21 +164,21 @@ readNixBool t = do
|
|||||||
"false" -> return False
|
"false" -> return False
|
||||||
a -> throwE ("Failed to read expected nix boolean " <> a <> " ")
|
a -> throwE ("Failed to read expected nix boolean " <> a <> " ")
|
||||||
|
|
||||||
getIsBroken :: MonadIO m => Text -> ExceptT Text m Bool
|
getIsBroken :: (MonadIO m) => Text -> ExceptT Text m Bool
|
||||||
getIsBroken attrPath =
|
getIsBroken attrPath =
|
||||||
getAttr "meta.broken" attrPath
|
getAttr "meta.broken" attrPath
|
||||||
& readNixBool
|
& readNixBool
|
||||||
|
|
||||||
getChangelog :: MonadIO m => Text -> ExceptT Text m Text
|
getChangelog :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getChangelog = nixEvalApplyRaw "p: p.meta.changelog or \"\""
|
getChangelog = nixEvalApplyRaw "p: p.meta.changelog or \"\""
|
||||||
|
|
||||||
getDescription :: MonadIO m => Text -> ExceptT Text m Text
|
getDescription :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getDescription = nixEvalApplyRaw "p: p.meta.description or \"\""
|
getDescription = nixEvalApplyRaw "p: p.meta.description or \"\""
|
||||||
|
|
||||||
getHomepage :: MonadIO m => Text -> ExceptT Text m Text
|
getHomepage :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getHomepage = nixEvalApplyRaw "p: p.meta.homepage or \"\""
|
getHomepage = nixEvalApplyRaw "p: p.meta.homepage or \"\""
|
||||||
|
|
||||||
getSrcUrl :: MonadIO m => Text -> ExceptT Text m Text
|
getSrcUrl :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getSrcUrl =
|
getSrcUrl =
|
||||||
srcOrMain
|
srcOrMain
|
||||||
(nixEvalApplyRaw "p: builtins.elemAt p.drvAttrs.urls 0")
|
(nixEvalApplyRaw "p: builtins.elemAt p.drvAttrs.urls 0")
|
||||||
@ -190,7 +190,7 @@ buildCmd attrPath =
|
|||||||
log :: Text -> ProcessConfig () () ()
|
log :: Text -> ProcessConfig () () ()
|
||||||
log attrPath = proc (binPath <> "/nix") ["--extra-experimental-features", "nix-command", "log", "-f", ".", attrPath & T.unpack]
|
log attrPath = proc (binPath <> "/nix") ["--extra-experimental-features", "nix-command", "log", "-f", ".", attrPath & T.unpack]
|
||||||
|
|
||||||
build :: MonadIO m => Text -> ExceptT Text m ()
|
build :: (MonadIO m) => Text -> ExceptT Text m ()
|
||||||
build attrPath =
|
build attrPath =
|
||||||
(buildCmd attrPath & runProcess_ & tryIOTextET)
|
(buildCmd attrPath & runProcess_ & tryIOTextET)
|
||||||
<|> ( do
|
<|> ( do
|
||||||
@ -204,7 +204,7 @@ build attrPath =
|
|||||||
& fmap (T.lines >>> reverse >>> take 30 >>> reverse >>> T.unlines)
|
& fmap (T.lines >>> reverse >>> take 30 >>> reverse >>> T.unlines)
|
||||||
throwE ("nix build failed.\n" <> buildLog <> " ")
|
throwE ("nix build failed.\n" <> buildLog <> " ")
|
||||||
|
|
||||||
cachix :: MonadIO m => Text -> ExceptT Text m ()
|
cachix :: (MonadIO m) => Text -> ExceptT Text m ()
|
||||||
cachix resultPath =
|
cachix resultPath =
|
||||||
( setStdin
|
( setStdin
|
||||||
(byteStringInput (TL.encodeUtf8 (TL.fromStrict resultPath)))
|
(byteStringInput (TL.encodeUtf8 (TL.fromStrict resultPath)))
|
||||||
@ -228,7 +228,7 @@ numberOfHashes derivationContents =
|
|||||||
countUp x = T.count x derivationContents
|
countUp x = T.count x derivationContents
|
||||||
|
|
||||||
assertOldVersionOn ::
|
assertOldVersionOn ::
|
||||||
MonadIO m => UpdateEnv -> Text -> Text -> ExceptT Text m ()
|
(MonadIO m) => UpdateEnv -> Text -> Text -> ExceptT Text m ()
|
||||||
assertOldVersionOn updateEnv branchName contents =
|
assertOldVersionOn updateEnv branchName contents =
|
||||||
tryAssert
|
tryAssert
|
||||||
("Old version " <> oldVersionPattern <> " not present in " <> branchName <> " derivation file with contents: " <> contents)
|
("Old version " <> oldVersionPattern <> " not present in " <> branchName <> " derivation file with contents: " <> contents)
|
||||||
@ -236,7 +236,7 @@ assertOldVersionOn updateEnv branchName contents =
|
|||||||
where
|
where
|
||||||
oldVersionPattern = oldVersion updateEnv <> "\""
|
oldVersionPattern = oldVersion updateEnv <> "\""
|
||||||
|
|
||||||
resultLink :: MonadIO m => ExceptT Text m Text
|
resultLink :: (MonadIO m) => ExceptT Text m Text
|
||||||
resultLink =
|
resultLink =
|
||||||
T.strip
|
T.strip
|
||||||
<$> ( ourReadProcessInterleaved_ "readlink ./result"
|
<$> ( ourReadProcessInterleaved_ "readlink ./result"
|
||||||
@ -252,7 +252,7 @@ fakeHashMatching oldHash =
|
|||||||
else "sha256-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA="
|
else "sha256-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA="
|
||||||
|
|
||||||
-- fixed-output derivation produced path '/nix/store/fg2hz90z5bc773gpsx4gfxn3l6fl66nw-source' with sha256 hash '0q1lsgc1621czrg49nmabq6am9sgxa9syxrwzlksqqr4dyzw4nmf' instead of the expected hash '0bp22mzkjy48gncj5vm9b7whzrggcbs5pd4cnb6k8jpl9j02dhdv'
|
-- fixed-output derivation produced path '/nix/store/fg2hz90z5bc773gpsx4gfxn3l6fl66nw-source' with sha256 hash '0q1lsgc1621czrg49nmabq6am9sgxa9syxrwzlksqqr4dyzw4nmf' instead of the expected hash '0bp22mzkjy48gncj5vm9b7whzrggcbs5pd4cnb6k8jpl9j02dhdv'
|
||||||
getHashFromBuild :: MonadIO m => Text -> ExceptT Text m Text
|
getHashFromBuild :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getHashFromBuild =
|
getHashFromBuild =
|
||||||
srcOrMain
|
srcOrMain
|
||||||
( \attrPath -> do
|
( \attrPath -> do
|
||||||
@ -275,26 +275,26 @@ getHashFromBuild =
|
|||||||
secondSplit
|
secondSplit
|
||||||
)
|
)
|
||||||
|
|
||||||
version :: MonadIO m => ExceptT Text m Text
|
version :: (MonadIO m) => ExceptT Text m Text
|
||||||
version = ourReadProcessInterleaved_ (proc (binPath <> "/nix") ["--version"])
|
version = ourReadProcessInterleaved_ (proc (binPath <> "/nix") ["--version"])
|
||||||
|
|
||||||
getPatches :: MonadIO m => Text -> ExceptT Text m Text
|
getPatches :: (MonadIO m) => Text -> ExceptT Text m Text
|
||||||
getPatches =
|
getPatches =
|
||||||
nixEvalApply "p: map (patch: patch.name) p.patches"
|
nixEvalApply "p: map (patch: patch.name) p.patches"
|
||||||
|
|
||||||
hasPatchNamed :: MonadIO m => Text -> Text -> ExceptT Text m Bool
|
hasPatchNamed :: (MonadIO m) => Text -> Text -> ExceptT Text m Bool
|
||||||
hasPatchNamed attrPath name = do
|
hasPatchNamed attrPath name = do
|
||||||
ps <- getPatches attrPath
|
ps <- getPatches attrPath
|
||||||
return $ name `T.isInfixOf` ps
|
return $ name `T.isInfixOf` ps
|
||||||
|
|
||||||
hasUpdateScript :: MonadIO m => Text -> ExceptT Text m Bool
|
hasUpdateScript :: (MonadIO m) => Text -> ExceptT Text m Bool
|
||||||
hasUpdateScript attrPath = do
|
hasUpdateScript attrPath = do
|
||||||
nixEvalApply
|
nixEvalApply
|
||||||
"p: builtins.hasAttr \"updateScript\" p"
|
"p: builtins.hasAttr \"updateScript\" p"
|
||||||
attrPath
|
attrPath
|
||||||
& readNixBool
|
& readNixBool
|
||||||
|
|
||||||
runUpdateScript :: MonadIO m => Text -> ExceptT Text m (ExitCode, Text)
|
runUpdateScript :: (MonadIO m) => Text -> ExceptT Text m (ExitCode, Text)
|
||||||
runUpdateScript attrPath = do
|
runUpdateScript attrPath = do
|
||||||
let timeout = "10m" :: Text
|
let timeout = "10m" :: Text
|
||||||
(exitCode, output) <-
|
(exitCode, output) <-
|
||||||
|
@ -29,7 +29,7 @@ revDir :: FilePath -> Text -> FilePath
|
|||||||
revDir cache commit = cache <> "/rev-" <> T.unpack commit
|
revDir cache commit = cache <> "/rev-" <> T.unpack commit
|
||||||
|
|
||||||
run ::
|
run ::
|
||||||
Members '[F.File, P.Process, Output Text] r =>
|
(Members '[F.File, P.Process, Output Text] r) =>
|
||||||
FilePath ->
|
FilePath ->
|
||||||
Text ->
|
Text ->
|
||||||
Sem r Text
|
Sem r Text
|
||||||
|
@ -62,46 +62,46 @@ import System.Process.Typed
|
|||||||
interpolate :: QuasiQuoter
|
interpolate :: QuasiQuoter
|
||||||
interpolate = NeatInterpolation.text
|
interpolate = NeatInterpolation.text
|
||||||
|
|
||||||
tshow :: Show a => a -> Text
|
tshow :: (Show a) => a -> Text
|
||||||
tshow = show >>> pack
|
tshow = show >>> pack
|
||||||
|
|
||||||
tryIOTextET :: MonadIO m => IO a -> ExceptT Text m a
|
tryIOTextET :: (MonadIO m) => IO a -> ExceptT Text m a
|
||||||
tryIOTextET = syncIO >>> fmapLT tshow
|
tryIOTextET = syncIO >>> fmapLT tshow
|
||||||
|
|
||||||
whenM :: Monad m => m Bool -> m () -> m ()
|
whenM :: (Monad m) => m Bool -> m () -> m ()
|
||||||
whenM c a = c >>= \res -> when res a
|
whenM c a = c >>= \res -> when res a
|
||||||
|
|
||||||
bytestringToText :: BSL.ByteString -> Text
|
bytestringToText :: BSL.ByteString -> Text
|
||||||
bytestringToText = BSL.toStrict >>> (T.decodeUtf8With T.lenientDecode)
|
bytestringToText = BSL.toStrict >>> (T.decodeUtf8With T.lenientDecode)
|
||||||
|
|
||||||
ourReadProcessInterleavedBS_ ::
|
ourReadProcessInterleavedBS_ ::
|
||||||
MonadIO m =>
|
(MonadIO m) =>
|
||||||
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
||||||
ExceptT Text m BSL.ByteString
|
ExceptT Text m BSL.ByteString
|
||||||
ourReadProcessInterleavedBS_ = readProcessInterleaved_ >>> tryIOTextET
|
ourReadProcessInterleavedBS_ = readProcessInterleaved_ >>> tryIOTextET
|
||||||
|
|
||||||
ourReadProcess_ ::
|
ourReadProcess_ ::
|
||||||
MonadIO m =>
|
(MonadIO m) =>
|
||||||
ProcessConfig stdin stdout stderr ->
|
ProcessConfig stdin stdout stderr ->
|
||||||
ExceptT Text m (Text, Text)
|
ExceptT Text m (Text, Text)
|
||||||
ourReadProcess_ = readProcess_ >>> tryIOTextET >>> fmapRT (\(stdout, stderr) -> (bytestringToText stdout, bytestringToText stderr))
|
ourReadProcess_ = readProcess_ >>> tryIOTextET >>> fmapRT (\(stdout, stderr) -> (bytestringToText stdout, bytestringToText stderr))
|
||||||
|
|
||||||
ourReadProcess_Sem ::
|
ourReadProcess_Sem ::
|
||||||
Members '[P.Process] r =>
|
(Members '[P.Process] r) =>
|
||||||
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
||||||
Sem r (Text, Text)
|
Sem r (Text, Text)
|
||||||
ourReadProcess_Sem =
|
ourReadProcess_Sem =
|
||||||
P.read_ >>> fmap (\(stdout, stderr) -> (bytestringToText stdout, bytestringToText stderr))
|
P.read_ >>> fmap (\(stdout, stderr) -> (bytestringToText stdout, bytestringToText stderr))
|
||||||
|
|
||||||
ourReadProcessInterleaved_ ::
|
ourReadProcessInterleaved_ ::
|
||||||
MonadIO m =>
|
(MonadIO m) =>
|
||||||
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
||||||
ExceptT Text m Text
|
ExceptT Text m Text
|
||||||
ourReadProcessInterleaved_ =
|
ourReadProcessInterleaved_ =
|
||||||
readProcessInterleaved_ >>> tryIOTextET >>> fmapRT bytestringToText
|
readProcessInterleaved_ >>> tryIOTextET >>> fmapRT bytestringToText
|
||||||
|
|
||||||
ourReadProcessInterleaved ::
|
ourReadProcessInterleaved ::
|
||||||
MonadIO m =>
|
(MonadIO m) =>
|
||||||
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
||||||
ExceptT Text m (ExitCode, Text)
|
ExceptT Text m (ExitCode, Text)
|
||||||
ourReadProcessInterleaved =
|
ourReadProcessInterleaved =
|
||||||
@ -110,7 +110,7 @@ ourReadProcessInterleaved =
|
|||||||
>>> fmapRT (\(a, b) -> (a, bytestringToText b))
|
>>> fmapRT (\(a, b) -> (a, bytestringToText b))
|
||||||
|
|
||||||
ourReadProcessInterleavedSem ::
|
ourReadProcessInterleavedSem ::
|
||||||
Members '[P.Process] r =>
|
(Members '[P.Process] r) =>
|
||||||
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
ProcessConfig stdin stdoutIgnored stderrIgnored ->
|
||||||
Sem r (ExitCode, Text)
|
Sem r (ExitCode, Text)
|
||||||
ourReadProcessInterleavedSem =
|
ourReadProcessInterleavedSem =
|
||||||
|
@ -87,7 +87,7 @@ in
|
|||||||
tweak (builtins.removeAttrs hydraJobs blacklist)
|
tweak (builtins.removeAttrs hydraJobs blacklist)
|
||||||
|]
|
|]
|
||||||
|
|
||||||
outPath :: MonadIO m => ExceptT Text m Text
|
outPath :: (MonadIO m) => ExceptT Text m Text
|
||||||
outPath = do
|
outPath = do
|
||||||
cacheDir <- liftIO $ Utils.outpathCacheDir
|
cacheDir <- liftIO $ Utils.outpathCacheDir
|
||||||
let outpathFile = (cacheDir </> "outpaths.nix")
|
let outpathFile = (cacheDir </> "outpaths.nix")
|
||||||
@ -131,7 +131,7 @@ data ResultLine = ResultLine
|
|||||||
-- testInput :: Text
|
-- testInput :: Text
|
||||||
-- testInput =
|
-- 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"
|
-- "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"
|
||||||
currentOutpathSet :: MonadIO m => ExceptT Text m (Set ResultLine)
|
currentOutpathSet :: (MonadIO m) => ExceptT Text m (Set ResultLine)
|
||||||
currentOutpathSet = do
|
currentOutpathSet = do
|
||||||
rev <- Git.headRev
|
rev <- Git.headRev
|
||||||
mayOp <- lift $ lookupOutPathByRev rev
|
mayOp <- lift $ lookupOutPathByRev rev
|
||||||
@ -145,12 +145,12 @@ currentOutpathSet = do
|
|||||||
pure paths
|
pure paths
|
||||||
parse parseResults "outpath" op & fmapL tshow & hoistEither
|
parse parseResults "outpath" op & fmapL tshow & hoistEither
|
||||||
|
|
||||||
currentOutpathSetUncached :: MonadIO m => ExceptT Text m (Set ResultLine)
|
currentOutpathSetUncached :: (MonadIO m) => ExceptT Text m (Set ResultLine)
|
||||||
currentOutpathSetUncached = do
|
currentOutpathSetUncached = do
|
||||||
op <- outPath
|
op <- outPath
|
||||||
parse parseResults "outpath" op & fmapL tshow & hoistEither
|
parse parseResults "outpath" op & fmapL tshow & hoistEither
|
||||||
|
|
||||||
lookupOutPathByRev :: MonadIO m => Text -> m (Maybe Text)
|
lookupOutPathByRev :: (MonadIO m) => Text -> m (Maybe Text)
|
||||||
lookupOutPathByRev rev = do
|
lookupOutPathByRev rev = do
|
||||||
dir <- Utils.outpathCacheDir
|
dir <- Utils.outpathCacheDir
|
||||||
let file = dir <> "/" <> T.unpack rev
|
let file = dir <> "/" <> T.unpack rev
|
||||||
@ -167,10 +167,10 @@ dummyOutpathSetBefore attrPath = S.singleton (ResultLine attrPath "x86-64" (V.si
|
|||||||
dummyOutpathSetAfter :: Text -> Set ResultLine
|
dummyOutpathSetAfter :: Text -> Set ResultLine
|
||||||
dummyOutpathSetAfter attrPath = S.singleton (ResultLine attrPath "x86-64" (V.singleton (Outpath (Just "attrPath") "fakepath-edited")))
|
dummyOutpathSetAfter attrPath = S.singleton (ResultLine attrPath "x86-64" (V.singleton (Outpath (Just "attrPath") "fakepath-edited")))
|
||||||
|
|
||||||
parseResults :: CharParsing m => m (Set ResultLine)
|
parseResults :: (CharParsing m) => m (Set ResultLine)
|
||||||
parseResults = S.fromList <$> parseResultLine `sepEndBy` newline
|
parseResults = S.fromList <$> parseResultLine `sepEndBy` newline
|
||||||
|
|
||||||
parseResultLine :: CharParsing m => m ResultLine
|
parseResultLine :: (CharParsing m) => m ResultLine
|
||||||
parseResultLine =
|
parseResultLine =
|
||||||
ResultLine
|
ResultLine
|
||||||
<$> (T.dropWhileEnd (== '.') <$> parseAttrpath)
|
<$> (T.dropWhileEnd (== '.') <$> parseAttrpath)
|
||||||
@ -178,19 +178,19 @@ parseResultLine =
|
|||||||
<* spaces
|
<* spaces
|
||||||
<*> parseOutpaths
|
<*> parseOutpaths
|
||||||
|
|
||||||
parseAttrpath :: CharParsing m => m Text
|
parseAttrpath :: (CharParsing m) => m Text
|
||||||
parseAttrpath = T.concat <$> many (try parseAttrpathPart)
|
parseAttrpath = T.concat <$> many (try parseAttrpathPart)
|
||||||
|
|
||||||
parseAttrpathPart :: CharParsing m => m Text
|
parseAttrpathPart :: (CharParsing m) => m Text
|
||||||
parseAttrpathPart = T.snoc <$> (T.pack <$> many (noneOf ". ")) <*> char '.'
|
parseAttrpathPart = T.snoc <$> (T.pack <$> many (noneOf ". ")) <*> char '.'
|
||||||
|
|
||||||
parseArchitecture :: CharParsing m => m Text
|
parseArchitecture :: (CharParsing m) => m Text
|
||||||
parseArchitecture = T.pack <$> many (noneOf " ")
|
parseArchitecture = T.pack <$> many (noneOf " ")
|
||||||
|
|
||||||
parseOutpaths :: CharParsing m => m (Vector Outpath)
|
parseOutpaths :: (CharParsing m) => m (Vector Outpath)
|
||||||
parseOutpaths = V.fromList <$> (parseOutpath `sepBy1` char ';')
|
parseOutpaths = V.fromList <$> (parseOutpath `sepBy1` char ';')
|
||||||
|
|
||||||
parseOutpath :: CharParsing m => m Outpath
|
parseOutpath :: (CharParsing m) => m Outpath
|
||||||
parseOutpath =
|
parseOutpath =
|
||||||
Outpath
|
Outpath
|
||||||
<$> optional (try (T.pack <$> (many (noneOf "=\n") <* char '=')))
|
<$> optional (try (T.pack <$> (many (noneOf "=\n") <* char '=')))
|
||||||
|
@ -17,7 +17,7 @@ data Process m a where
|
|||||||
makeSem ''Process
|
makeSem ''Process
|
||||||
|
|
||||||
runIO ::
|
runIO ::
|
||||||
Member (Embed IO) r =>
|
(Member (Embed IO) r) =>
|
||||||
Sem (Process ': r) a ->
|
Sem (Process ': r) a ->
|
||||||
Sem r a
|
Sem r a
|
||||||
runIO =
|
runIO =
|
||||||
|
186
src/Rewrite.hs
186
src/Rewrite.hs
@ -77,23 +77,23 @@ runAll log args = do
|
|||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- The canonical updater: updates the src attribute and recomputes the sha256
|
-- The canonical updater: updates the src attribute and recomputes the sha256
|
||||||
version :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
version :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
||||||
version log args@Args {..} = do
|
version log args@Args {..} = do
|
||||||
if
|
if
|
||||||
| Nix.numberOfFetchers derivationContents > 1 || Nix.numberOfHashes derivationContents > 1 -> do
|
| Nix.numberOfFetchers derivationContents > 1 || Nix.numberOfHashes derivationContents > 1 -> do
|
||||||
lift $ log "generic version rewriter does not support multiple hashes"
|
lift $ log "generic version rewriter does not support multiple hashes"
|
||||||
return Nothing
|
return Nothing
|
||||||
| hasUpdateScript -> do
|
| hasUpdateScript -> do
|
||||||
lift $ log "skipping because derivation has updateScript"
|
lift $ log "skipping because derivation has updateScript"
|
||||||
return Nothing
|
return Nothing
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
srcVersionFix args
|
srcVersionFix args
|
||||||
lift $ log "updated version and sha256"
|
lift $ log "updated version and sha256"
|
||||||
return $ Just "Version update"
|
return $ Just "Version update"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Redirect homepage when moved.
|
-- Redirect homepage when moved.
|
||||||
redirectedUrls :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
redirectedUrls :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
||||||
redirectedUrls log Args {..} = do
|
redirectedUrls log Args {..} = do
|
||||||
homepage <- Nix.getHomepage attrPath
|
homepage <- Nix.getHomepage attrPath
|
||||||
response <- liftIO $ do
|
response <- liftIO $ do
|
||||||
@ -127,106 +127,106 @@ redirectedUrls log Args {..} = do
|
|||||||
-- Rewrite Rust on rustPlatform.buildRustPackage
|
-- Rewrite Rust on rustPlatform.buildRustPackage
|
||||||
-- This is basically `version` above, but with a second pass to also update the
|
-- This is basically `version` above, but with a second pass to also update the
|
||||||
-- cargoSha256 vendor hash.
|
-- cargoSha256 vendor hash.
|
||||||
rustCrateVersion :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
rustCrateVersion :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
||||||
rustCrateVersion log args@Args {..} = do
|
rustCrateVersion log args@Args {..} = do
|
||||||
if
|
if
|
||||||
| and [(not (T.isInfixOf "cargoSha256" derivationContents)), (not (T.isInfixOf "cargoHash" derivationContents))] -> do
|
| and [(not (T.isInfixOf "cargoSha256" derivationContents)), (not (T.isInfixOf "cargoHash" derivationContents))] -> do
|
||||||
lift $ log "No cargoSha256 or cargoHash found"
|
lift $ log "No cargoSha256 or cargoHash found"
|
||||||
return Nothing
|
return Nothing
|
||||||
| hasUpdateScript -> do
|
| hasUpdateScript -> do
|
||||||
lift $ log "skipping because derivation has updateScript"
|
lift $ log "skipping because derivation has updateScript"
|
||||||
return Nothing
|
return Nothing
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
_ <- lift $ File.replaceIO "cargoSha256 =" "cargoHash =" derivationFile
|
_ <- lift $ File.replaceIO "cargoSha256 =" "cargoHash =" derivationFile
|
||||||
-- This starts the same way `version` does, minus the assert
|
-- This starts the same way `version` does, minus the assert
|
||||||
srcVersionFix args
|
srcVersionFix args
|
||||||
-- But then from there we need to do this a second time for the cargoHash!
|
-- But then from there we need to do this a second time for the cargoHash!
|
||||||
oldCargoHash <- Nix.getAttrString "cargoHash" attrPath
|
oldCargoHash <- Nix.getAttrString "cargoHash" attrPath
|
||||||
let fakeHash = Nix.fakeHashMatching oldCargoHash
|
let fakeHash = Nix.fakeHashMatching oldCargoHash
|
||||||
_ <- lift $ File.replaceIO oldCargoHash fakeHash derivationFile
|
_ <- lift $ File.replaceIO oldCargoHash fakeHash derivationFile
|
||||||
newCargoHash <- Nix.getHashFromBuild attrPath
|
newCargoHash <- Nix.getHashFromBuild attrPath
|
||||||
when (oldCargoHash == newCargoHash) $ throwE ("cargo hashes equal; no update necessary: " <> oldCargoHash)
|
when (oldCargoHash == newCargoHash) $ throwE ("cargo hashes equal; no update necessary: " <> oldCargoHash)
|
||||||
lift . log $ "Replacing cargoHash with " <> newCargoHash
|
lift . log $ "Replacing cargoHash with " <> newCargoHash
|
||||||
_ <- lift $ File.replaceIO fakeHash newCargoHash derivationFile
|
_ <- lift $ File.replaceIO fakeHash newCargoHash derivationFile
|
||||||
-- Ensure the package actually builds and passes its tests
|
-- Ensure the package actually builds and passes its tests
|
||||||
Nix.build attrPath
|
Nix.build attrPath
|
||||||
lift $ log "Finished updating Crate version and replacing hashes"
|
lift $ log "Finished updating Crate version and replacing hashes"
|
||||||
return $ Just "Rust version update"
|
return $ Just "Rust version update"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Rewrite Golang packages with buildGoModule
|
-- Rewrite Golang packages with buildGoModule
|
||||||
-- This is basically `version` above, but with a second pass to also update the
|
-- This is basically `version` above, but with a second pass to also update the
|
||||||
-- vendorHash go vendor hash.
|
-- vendorHash go vendor hash.
|
||||||
golangModuleVersion :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
golangModuleVersion :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
||||||
golangModuleVersion log args@Args {..} = do
|
golangModuleVersion log args@Args {..} = do
|
||||||
if
|
if
|
||||||
| and [not (T.isInfixOf "buildGoModule" derivationContents && T.isInfixOf "vendorSha256" derivationContents), not (T.isInfixOf "buildGoModule" derivationContents && T.isInfixOf "vendorHash" derivationContents)] -> do
|
| and [not (T.isInfixOf "buildGoModule" derivationContents && T.isInfixOf "vendorSha256" derivationContents), not (T.isInfixOf "buildGoModule" derivationContents && T.isInfixOf "vendorHash" derivationContents)] -> do
|
||||||
lift $ log "Not a buildGoModule package with vendorSha256 or vendorHash"
|
lift $ log "Not a buildGoModule package with vendorSha256 or vendorHash"
|
||||||
return Nothing
|
return Nothing
|
||||||
| hasUpdateScript -> do
|
| hasUpdateScript -> do
|
||||||
lift $ log "skipping because derivation has updateScript"
|
lift $ log "skipping because derivation has updateScript"
|
||||||
return Nothing
|
return Nothing
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
_ <- lift $ File.replaceIO "vendorSha256 =" "vendorHash =" derivationFile
|
_ <- lift $ File.replaceIO "vendorSha256 =" "vendorHash =" derivationFile
|
||||||
-- This starts the same way `version` does, minus the assert
|
-- This starts the same way `version` does, minus the assert
|
||||||
srcVersionFix args
|
srcVersionFix args
|
||||||
-- But then from there we need to do this a second time for the vendorHash!
|
-- But then from there we need to do this a second time for the vendorHash!
|
||||||
-- Note that explicit `null` cannot be coerced to a string by nix eval --raw
|
-- Note that explicit `null` cannot be coerced to a string by nix eval --raw
|
||||||
oldVendorHash <- Nix.getAttr "vendorHash" attrPath
|
oldVendorHash <- Nix.getAttr "vendorHash" attrPath
|
||||||
lift . log $ "Found old vendorHash = " <> oldVendorHash
|
lift . log $ "Found old vendorHash = " <> oldVendorHash
|
||||||
original <- liftIO $ T.readFile derivationFile
|
original <- liftIO $ T.readFile derivationFile
|
||||||
_ <- lift $ File.replaceIO oldVendorHash "null" derivationFile
|
_ <- lift $ File.replaceIO oldVendorHash "null" derivationFile
|
||||||
ok <- runExceptT $ Nix.build attrPath
|
ok <- runExceptT $ Nix.build attrPath
|
||||||
_ <-
|
_ <-
|
||||||
if isLeft ok
|
if isLeft ok
|
||||||
then do
|
then do
|
||||||
_ <- liftIO $ T.writeFile derivationFile original
|
_ <- liftIO $ T.writeFile derivationFile original
|
||||||
let fakeHash = Nix.fakeHashMatching oldVendorHash
|
let fakeHash = Nix.fakeHashMatching oldVendorHash
|
||||||
_ <- lift $ File.replaceIO oldVendorHash ("\"" <> fakeHash <> "\"") derivationFile
|
_ <- lift $ File.replaceIO oldVendorHash ("\"" <> fakeHash <> "\"") derivationFile
|
||||||
newVendorHash <- Nix.getHashFromBuild attrPath
|
newVendorHash <- Nix.getHashFromBuild attrPath
|
||||||
_ <- lift $ File.replaceIO fakeHash newVendorHash derivationFile
|
_ <- lift $ File.replaceIO fakeHash newVendorHash derivationFile
|
||||||
-- Note that on some small bumps, this may not actually change if go.sum did not
|
-- Note that on some small bumps, this may not actually change if go.sum did not
|
||||||
lift . log $ "Replaced vendorHash with " <> newVendorHash
|
lift . log $ "Replaced vendorHash with " <> newVendorHash
|
||||||
else do
|
else do
|
||||||
lift . log $ "Set vendorHash to null"
|
lift . log $ "Set vendorHash to null"
|
||||||
-- Ensure the package actually builds and passes its tests
|
-- Ensure the package actually builds and passes its tests
|
||||||
Nix.build attrPath
|
Nix.build attrPath
|
||||||
lift $ log "Finished updating vendorHash"
|
lift $ log "Finished updating vendorHash"
|
||||||
return $ Just "Golang update"
|
return $ Just "Golang update"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Rewrite NPM packages with buildNpmPackage
|
-- Rewrite NPM packages with buildNpmPackage
|
||||||
-- This is basically `version` above, but with a second pass to also update the
|
-- This is basically `version` above, but with a second pass to also update the
|
||||||
-- cargoSha256 vendor hash.
|
-- cargoSha256 vendor hash.
|
||||||
npmDepsVersion :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
npmDepsVersion :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
||||||
npmDepsVersion log args@Args {..} = do
|
npmDepsVersion log args@Args {..} = do
|
||||||
if
|
if
|
||||||
| not (T.isInfixOf "npmDepsHash" derivationContents) -> do
|
| not (T.isInfixOf "npmDepsHash" derivationContents) -> do
|
||||||
lift $ log "No npmDepsHash"
|
lift $ log "No npmDepsHash"
|
||||||
return Nothing
|
return Nothing
|
||||||
| hasUpdateScript -> do
|
| hasUpdateScript -> do
|
||||||
lift $ log "skipping because derivation has updateScript"
|
lift $ log "skipping because derivation has updateScript"
|
||||||
return Nothing
|
return Nothing
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
-- This starts the same way `version` does, minus the assert
|
-- This starts the same way `version` does, minus the assert
|
||||||
srcVersionFix args
|
srcVersionFix args
|
||||||
-- But then from there we need to do this a second time for the cargoHash!
|
-- But then from there we need to do this a second time for the cargoHash!
|
||||||
oldDepsHash <- Nix.getAttrString "npmDepsHash" attrPath
|
oldDepsHash <- Nix.getAttrString "npmDepsHash" attrPath
|
||||||
let fakeHash = Nix.fakeHashMatching oldDepsHash
|
let fakeHash = Nix.fakeHashMatching oldDepsHash
|
||||||
_ <- lift $ File.replaceIO oldDepsHash fakeHash derivationFile
|
_ <- lift $ File.replaceIO oldDepsHash fakeHash derivationFile
|
||||||
newDepsHash <- Nix.getHashFromBuild attrPath
|
newDepsHash <- Nix.getHashFromBuild attrPath
|
||||||
when (oldDepsHash == newDepsHash) $ throwE ("deps hashes equal; no update necessary: " <> oldDepsHash)
|
when (oldDepsHash == newDepsHash) $ throwE ("deps hashes equal; no update necessary: " <> oldDepsHash)
|
||||||
lift . log $ "Replacing npmDepsHash with " <> newDepsHash
|
lift . log $ "Replacing npmDepsHash with " <> newDepsHash
|
||||||
_ <- lift $ File.replaceIO fakeHash newDepsHash derivationFile
|
_ <- lift $ File.replaceIO fakeHash newDepsHash derivationFile
|
||||||
-- Ensure the package actually builds and passes its tests
|
-- Ensure the package actually builds and passes its tests
|
||||||
Nix.build attrPath
|
Nix.build attrPath
|
||||||
lift $ log "Finished updating NPM deps version and replacing hashes"
|
lift $ log "Finished updating NPM deps version and replacing hashes"
|
||||||
return $ Just "NPM version update"
|
return $ Just "NPM version update"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
-- Calls passthru.updateScript
|
-- Calls passthru.updateScript
|
||||||
updateScript :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
updateScript :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
|
||||||
updateScript log Args {..} = do
|
updateScript log Args {..} = do
|
||||||
if hasUpdateScript
|
if hasUpdateScript
|
||||||
then do
|
then do
|
||||||
@ -246,7 +246,7 @@ updateScript log Args {..} = do
|
|||||||
-- Common helper functions and utilities
|
-- Common helper functions and utilities
|
||||||
-- Helper to update version and src attributes, re-computing the sha256.
|
-- Helper to update version and src attributes, re-computing the sha256.
|
||||||
-- This is done by the generic version upgrader, but is also a sub-component of some of the others.
|
-- This is done by the generic version upgrader, but is also a sub-component of some of the others.
|
||||||
srcVersionFix :: MonadIO m => Args -> ExceptT Text m ()
|
srcVersionFix :: (MonadIO m) => Args -> ExceptT Text m ()
|
||||||
srcVersionFix Args {..} = do
|
srcVersionFix Args {..} = do
|
||||||
let UpdateEnv {..} = updateEnv
|
let UpdateEnv {..} = updateEnv
|
||||||
oldHash <- Nix.getHash attrPath
|
oldHash <- Nix.getHash attrPath
|
||||||
|
@ -223,7 +223,7 @@ eq part reason = ((part ==), reason)
|
|||||||
regex :: RE' a -> Text -> (Text -> Bool, Text)
|
regex :: RE' a -> Text -> (Text -> Bool, Text)
|
||||||
regex pat reason = (isJust . (=~ pat), reason)
|
regex pat reason = (isJust . (=~ pat), reason)
|
||||||
|
|
||||||
python :: Monad m => Int -> Text -> ExceptT Text m ()
|
python :: (Monad m) => Int -> Text -> ExceptT Text m ()
|
||||||
python numPackageRebuilds derivationContents =
|
python numPackageRebuilds derivationContents =
|
||||||
tryAssert
|
tryAssert
|
||||||
( "Python package with too many package rebuilds "
|
( "Python package with too many package rebuilds "
|
||||||
|
@ -68,7 +68,7 @@ alsoLogToAttrPath attrPath topLevelLog = do
|
|||||||
topLevelLog text
|
topLevelLog text
|
||||||
attrPathLog text
|
attrPathLog text
|
||||||
|
|
||||||
log' :: MonadIO m => FilePath -> Text -> m ()
|
log' :: (MonadIO m) => FilePath -> Text -> m ()
|
||||||
log' logFile msg = liftIO $ T.appendFile logFile (msg <> "\n")
|
log' logFile msg = liftIO $ T.appendFile logFile (msg <> "\n")
|
||||||
|
|
||||||
attrPathLogFilePath :: Text -> IO String
|
attrPathLogFilePath :: Text -> IO String
|
||||||
@ -628,7 +628,7 @@ untilOfBorgFree log waitUntil = do
|
|||||||
untilOfBorgFree log waitUntil
|
untilOfBorgFree log waitUntil
|
||||||
|
|
||||||
assertNotUpdatedOn ::
|
assertNotUpdatedOn ::
|
||||||
MonadIO m => UpdateEnv -> Text -> Text -> ExceptT Text m ()
|
(MonadIO m) => UpdateEnv -> Text -> Text -> ExceptT Text m ()
|
||||||
assertNotUpdatedOn updateEnv derivationFile branch = do
|
assertNotUpdatedOn updateEnv derivationFile branch = do
|
||||||
derivationContents <- Git.show branch derivationFile
|
derivationContents <- Git.show branch derivationFile
|
||||||
Nix.assertOldVersionOn updateEnv branch derivationContents
|
Nix.assertOldVersionOn updateEnv branch derivationContents
|
||||||
@ -700,7 +700,7 @@ cveReport updateEnv =
|
|||||||
<br/>
|
<br/>
|
||||||
|]
|
|]
|
||||||
|
|
||||||
doCachix :: MonadIO m => (Text -> m ()) -> UpdateEnv -> Text -> ExceptT Text m Text
|
doCachix :: (MonadIO m) => (Text -> m ()) -> UpdateEnv -> Text -> ExceptT Text m Text
|
||||||
doCachix log updateEnv resultPath =
|
doCachix log updateEnv resultPath =
|
||||||
let o = options updateEnv
|
let o = options updateEnv
|
||||||
in if batchUpdate o && "r-ryantm" == (GH.untagName $ githubUser o)
|
in if batchUpdate o && "r-ryantm" == (GH.untagName $ githubUser o)
|
||||||
|
18
src/Utils.hs
18
src/Utils.hs
@ -96,7 +96,7 @@ readField f@(Field (SQLText t) _) =
|
|||||||
Left e -> returnError ConversionFailed f $ "read error: " <> e
|
Left e -> returnError ConversionFailed f $ "read error: " <> e
|
||||||
readField f = returnError ConversionFailed f "expecting SQLText column type"
|
readField f = returnError ConversionFailed f "expecting SQLText column type"
|
||||||
|
|
||||||
showField :: Show a => a -> SQLData
|
showField :: (Show a) => a -> SQLData
|
||||||
showField = toField . show
|
showField = toField . show
|
||||||
|
|
||||||
instance FromField VersionMatcher where
|
instance FromField VersionMatcher where
|
||||||
@ -125,7 +125,7 @@ data UpdateEnv = UpdateEnv
|
|||||||
options :: Options
|
options :: Options
|
||||||
}
|
}
|
||||||
|
|
||||||
whenBatch :: Applicative f => UpdateEnv -> f () -> f ()
|
whenBatch :: (Applicative f) => UpdateEnv -> f () -> f ()
|
||||||
whenBatch updateEnv = when (batchUpdate . options $ updateEnv)
|
whenBatch updateEnv = when (batchUpdate . options $ updateEnv)
|
||||||
|
|
||||||
prTitle :: UpdateEnv -> Text -> Text
|
prTitle :: UpdateEnv -> Text -> Text
|
||||||
@ -147,7 +147,7 @@ regDirMode =
|
|||||||
.|. otherReadMode
|
.|. otherReadMode
|
||||||
.|. otherExecuteMode
|
.|. otherExecuteMode
|
||||||
|
|
||||||
logsDirectory :: MonadIO m => ExceptT Text m FilePath
|
logsDirectory :: (MonadIO m) => ExceptT Text m FilePath
|
||||||
logsDirectory = do
|
logsDirectory = do
|
||||||
dir <-
|
dir <-
|
||||||
noteT "Could not get environment variable LOGS_DIRECTORY" $
|
noteT "Could not get environment variable LOGS_DIRECTORY" $
|
||||||
@ -163,7 +163,7 @@ logsDirectory = do
|
|||||||
)
|
)
|
||||||
return dir
|
return dir
|
||||||
|
|
||||||
cacheDir :: MonadIO m => m FilePath
|
cacheDir :: (MonadIO m) => m FilePath
|
||||||
cacheDir = do
|
cacheDir = do
|
||||||
cacheDirectory <- liftIO $ lookupEnv "CACHE_DIRECTORY"
|
cacheDirectory <- liftIO $ lookupEnv "CACHE_DIRECTORY"
|
||||||
xdgCacheHome <- liftIO $ fmap (fmap (\dir -> dir </> "nixpkgs-update")) $ lookupEnv "XDG_CACHE_HOME"
|
xdgCacheHome <- liftIO $ fmap (fmap (\dir -> dir </> "nixpkgs-update")) $ lookupEnv "XDG_CACHE_HOME"
|
||||||
@ -172,7 +172,7 @@ cacheDir = do
|
|||||||
liftIO $ createDirectoryIfMissing True dir
|
liftIO $ createDirectoryIfMissing True dir
|
||||||
return dir
|
return dir
|
||||||
|
|
||||||
outpathCacheDir :: MonadIO m => m FilePath
|
outpathCacheDir :: (MonadIO m) => m FilePath
|
||||||
outpathCacheDir = do
|
outpathCacheDir = do
|
||||||
cache <- cacheDir
|
cache <- cacheDir
|
||||||
let dir = cache </> "outpath"
|
let dir = cache </> "outpath"
|
||||||
@ -186,7 +186,7 @@ worktreeDir = do
|
|||||||
createDirectoryIfMissing False dir
|
createDirectoryIfMissing False dir
|
||||||
return dir
|
return dir
|
||||||
|
|
||||||
xdgRuntimeDir :: MonadIO m => ExceptT Text m FilePath
|
xdgRuntimeDir :: (MonadIO m) => ExceptT Text m FilePath
|
||||||
xdgRuntimeDir = do
|
xdgRuntimeDir = do
|
||||||
xDir <-
|
xDir <-
|
||||||
noteT "Could not get environment variable XDG_RUNTIME_DIR" $
|
noteT "Could not get environment variable XDG_RUNTIME_DIR" $
|
||||||
@ -204,7 +204,7 @@ xdgRuntimeDir = do
|
|||||||
)
|
)
|
||||||
return dir
|
return dir
|
||||||
|
|
||||||
tmpRuntimeDir :: MonadIO m => ExceptT Text m FilePath
|
tmpRuntimeDir :: (MonadIO m) => ExceptT Text m FilePath
|
||||||
tmpRuntimeDir = do
|
tmpRuntimeDir = do
|
||||||
dir <- liftIO $ mkdtemp "nixpkgs-update"
|
dir <- liftIO $ mkdtemp "nixpkgs-update"
|
||||||
dirExists <- liftIO $ doesDirectoryExist dir
|
dirExists <- liftIO $ doesDirectoryExist dir
|
||||||
@ -241,7 +241,7 @@ parseUpdates = map (toTriple . T.words) . T.lines
|
|||||||
toTriple [package, oldVer, newVer, url] = Right (package, oldVer, newVer, Just url)
|
toTriple [package, oldVer, newVer, url] = Right (package, oldVer, newVer, Just url)
|
||||||
toTriple line = Left $ "Unable to parse update: " <> T.unwords line
|
toTriple line = Left $ "Unable to parse update: " <> T.unwords line
|
||||||
|
|
||||||
srcOrMain :: MonadIO m => (Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
|
srcOrMain :: (MonadIO m) => (Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
|
||||||
srcOrMain et attrPath = et (attrPath <> ".src") <|> et (attrPath <> ".originalSrc") <|> et attrPath
|
srcOrMain et attrPath = et (attrPath <> ".src") <|> et (attrPath <> ".originalSrc") <|> et attrPath
|
||||||
|
|
||||||
nixCommonOptions :: [String]
|
nixCommonOptions :: [String]
|
||||||
@ -263,7 +263,7 @@ nixBuildOptions =
|
|||||||
<> nixCommonOptions
|
<> nixCommonOptions
|
||||||
|
|
||||||
runLog ::
|
runLog ::
|
||||||
Member (Embed IO) r =>
|
(Member (Embed IO) r) =>
|
||||||
(Text -> IO ()) ->
|
(Text -> IO ()) ->
|
||||||
Sem ((Output Text) ': r) a ->
|
Sem ((Output Text) ': r) a ->
|
||||||
Sem r a
|
Sem r a
|
||||||
|
@ -91,7 +91,7 @@ versionIncompatibleWithPathPin :: Text -> Version -> Bool
|
|||||||
versionIncompatibleWithPathPin path version =
|
versionIncompatibleWithPathPin path version =
|
||||||
not (versionCompatibleWithPathPin path version)
|
not (versionCompatibleWithPathPin path version)
|
||||||
|
|
||||||
assertCompatibleWithPathPin :: Monad m => UpdateEnv -> Text -> ExceptT Text m ()
|
assertCompatibleWithPathPin :: (Monad m) => UpdateEnv -> Text -> ExceptT Text m ()
|
||||||
assertCompatibleWithPathPin ue attrPath =
|
assertCompatibleWithPathPin ue attrPath =
|
||||||
tryAssert
|
tryAssert
|
||||||
( "Version in attr path "
|
( "Version in attr path "
|
||||||
|
Loading…
Reference in New Issue
Block a user