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.

1 files changed, 31 insertions, 16 deletions

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 </dev/null fixes an intermittent
-			-- "fatal: read error: Bad file descriptor"
-			-- when run across ssh with propellor --spin
-			[ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
-			, Just $ "cd " ++ shellEscape dir
-			, ("git checkout " ++) <$> 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 </dev/null fixes an intermittent
+		-- "fatal: read error: Bad file descriptor"
+		-- when run across ssh with propellor --spin
+		[ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
+		, Just $ "cd " ++ shellEscape dir
+		, ("git checkout " ++) <$> 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