From 45592b442b02c41993c9c62eb7f06bcb1267c117 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 18:39:10 -0400 Subject: factor out git repo module --- src/Propellor/Git.hs | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 src/Propellor/Git.hs (limited to 'src/Propellor/Git.hs') diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs new file mode 100644 index 00000000..0de82f8a --- /dev/null +++ b/src/Propellor/Git.hs @@ -0,0 +1,41 @@ +module Propellor.Git where + +import Propellor +import Utility.SafeCommand + +getCurrentBranch :: IO String +getCurrentBranch = takeWhile (/= '\n') + <$> readProcess "git" ["symbolic-ref", "--short", "HEAD"] + +getCurrentGitSha1 :: String -> IO String +getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref] + +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 get urls + where + urls = ["remote.deploy.url", "remote.origin.url"] + get u = do + v <- catchMaybeIO $ + takeWhile (/= '\n') + <$> readProcess "git" ["config", u] + return $ case v of + Just url | not (null url) -> Just url + _ -> Nothing + +hasOrigin :: IO Bool +hasOrigin = do + rs <- lines <$> readProcess "git" ["remote"] + return $ "origin" `elem` rs + -- cgit v1.2.3