diff options
| author | Joey Hess <joeyh@joeyh.name> | 2016-01-03 16:57:23 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-01-03 16:57:23 -0400 |
| commit | 6a700a2a1c40332bf4961b5ea4122d4bd2bd7996 (patch) | |
| tree | 8fc25d3120cef650166db4a8ccabd7504f68f290 /src/Propellor/Git/Config.hs | |
| parent | 3f5cc046915a9f64c31a6d48aaef5254f5eb7598 (diff) | |
| parent | fc6b042daf2a1714485373cec1c7475855799f71 (diff) | |
Merge branch 'joeyconfig'
Diffstat (limited to 'src/Propellor/Git/Config.hs')
| -rw-r--r-- | src/Propellor/Git/Config.hs | 47 |
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"] |
