summaryrefslogtreecommitdiff
path: root/src/Propellor/Git/Config.hs
diff options
context:
space:
mode:
authorJoey Hess2016-01-03 16:56:00 -0400
committerJoey Hess2016-01-03 16:56:00 -0400
commitf86804fa27a2cf5b1972b14ab41e81edb85ad661 (patch)
tree11753dde33d0e6dd85feae84a727846fb6a3d088 /src/Propellor/Git/Config.hs
parentb13e3f8d55c1b74123186c3178922b0809367f76 (diff)
refactor into smaller modules to untangle git and gpg modules
Diffstat (limited to 'src/Propellor/Git/Config.hs')
-rw-r--r--src/Propellor/Git/Config.hs47
1 files changed, 47 insertions, 0 deletions
diff --git a/src/Propellor/Git/Config.hs b/src/Propellor/Git/Config.hs
new file mode 100644
index 00000000..97835231
--- /dev/null
+++ b/src/Propellor/Git/Config.hs
@@ -0,0 +1,47 @@
+module Propellor.Git.Config where
+
+import Propellor.Git
+import Utility.Process
+import Utility.Exception
+import Utility.SafeCommand
+import Utility.Monad
+
+import Control.Monad
+
+getGitConfigValue :: String -> IO (Maybe String)
+getGitConfigValue key = do
+ value <- catchMaybeIO $
+ takeWhile (/= '\n')
+ <$> readProcess "git" ["config", key]
+ return $ case value of
+ Just v | not (null v) -> Just v
+ _ -> Nothing
+
+-- `git config --bool propellor.blah` outputs "false" if propellor.blah is unset
+-- i.e. the git convention is that the default value of any git-config setting
+-- is "false". So we don't need a Maybe Bool here.
+getGitConfigBool :: String -> IO Bool
+getGitConfigBool key = do
+ value <- catchMaybeIO $
+ takeWhile (/= '\n')
+ <$> readProcess "git" ["config", "--bool", key]
+ return $ case value of
+ Just "true" -> True
+ _ -> False
+
+setRepoUrl :: String -> IO ()
+setRepoUrl "" = return ()
+setRepoUrl url = do
+ subcmd <- ifM hasOrigin (pure "set-url", pure "add")
+ void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url]
+ -- same as --set-upstream-to, except origin branch
+ -- may not have been pulled yet
+ branch <- getCurrentBranch
+ let branchval s = "branch." ++ branch ++ "." ++ s
+ void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]
+ void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]
+
+getRepoUrl :: IO (Maybe String)
+getRepoUrl = getM getGitConfigValue urls
+ where
+ urls = ["remote.deploy.url", "remote.origin.url"]