From 12548bae3d8feecce6a322162d91b827289ae824 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 5 Dec 2015 17:52:43 -0400 Subject: UncheckedProperty for cmdProperty et al * Properties that run an arbitrary command, such as cmdProperty and scriptProperty are converted to use UncheckedProperty, since they cannot tell on their own if the command truely made a change or not. (API Change) Transition guide: - When GHC complains about an UncheckedProperty, add: `assume` MadeChange - Since these properties used to always return MadeChange, that change is always safe to make. - Or, if you know that the command should modifiy a file, use: `changesFile` filename * A few properties have had their Result improved, for example Apt.buldDep and Apt.autoRemove now check if a change was made or not. --- src/Propellor/Property/Git.hs | 47 ++++++++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 16 deletions(-) (limited to 'src/Propellor/Property/Git.hs') diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs index d9540994..46f6abc7 100644 --- a/src/Propellor/Property/Git.hs +++ b/src/Propellor/Property/Git.hs @@ -79,18 +79,20 @@ cloned owner url dir mbranch = check originurl (property desc checkout) whenM (doesDirectoryExist dir) $ removeDirectoryRecursive dir createDirectoryIfMissing True (takeDirectory dir) - ensureProperty $ userScriptProperty owner $ catMaybes - -- The mbranch - -- In case this repo is exposted via the web, - -- although the hook to do this ongoing is not - -- installed here. - , Just "git update-server-info" - ] + ensureProperty $ userScriptProperty owner (catMaybes checkoutcmds) + `assume` MadeChange + checkoutcmds = + -- The mbranch + -- In case this repo is exposted via the web, + -- although the hook to do this ongoing is not + -- installed here. + , Just "git update-server-info" + ] isGitDir :: FilePath -> IO Bool isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir]) @@ -103,27 +105,40 @@ bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " NotShared -> [ ownerGroup repo user (userGroup user) , userScriptProperty user ["git init --bare --shared=false " ++ shellEscape repo] + `assume` MadeChange ] SharedAll -> [ ownerGroup repo user (userGroup user) , userScriptProperty user ["git init --bare --shared=all " ++ shellEscape repo] + `assume` MadeChange ] Shared group' -> [ ownerGroup repo user group' , userScriptProperty user ["git init --bare --shared=group " ++ shellEscape repo] + `assume` MadeChange ] where isRepo repo' = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", repo']) -- | Set a key value pair in a git repo's configuration. repoConfigured :: FilePath -> (String, String) -> Property NoInfo -repo `repoConfigured` (key, value) = - trivial $ userScriptProperty (User "root") +repo `repoConfigured` (key, value) = check (not <$> alreadyconfigured) $ + userScriptProperty (User "root") [ "cd " ++ repo , "git config " ++ key ++ " " ++ value ] - `describe` ("git repo at " ++ repo - ++ " config setting " ++ key ++ " set to " ++ value) + `assume` MadeChange + `describe` desc + where + alreadyconfigured = do + vs <- getRepoConfig repo key + return $ value `elem` vs + desc = "git repo at " ++ repo ++ " config setting " ++ key ++ " set to " ++ value + +-- | Gets the value that a key is set to in a git repo's configuration. +getRepoConfig :: FilePath -> String -> IO [String] +getRepoConfig repo key = catchDefaultIO [] $ + lines <$> readProcess "git" ["-C", repo, "config", key] -- | Whether a repo accepts non-fast-forward pushes. repoAcceptsNonFFs :: FilePath -> RevertableProperty NoInfo -- cgit v1.2.3