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/CmdLine.hs | 37 +------------------------------------ src/Propellor/Git.hs | 41 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+), 36 deletions(-) create mode 100644 src/Propellor/Git.hs (limited to 'src/Propellor') diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 21ad5dba..c5dcd348 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -19,6 +19,7 @@ import Propellor import Propellor.Protocol import Propellor.PrivData.Paths import Propellor.Gpg +import Propellor.Git import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Docker.Shim as DockerShim import Utility.FileMode @@ -143,10 +144,6 @@ buildFirst cmdline next = do where getmtime = catchMaybeIO $ getModificationTime "propellor" -getCurrentBranch :: IO String -getCurrentBranch = takeWhile (/= '\n') - <$> readProcess "git" ["symbolic-ref", "--short", "HEAD"] - updateFirst :: CmdLine -> IO () -> IO () updateFirst cmdline next = ifM hasOrigin (updateFirst' cmdline next, next) @@ -192,9 +189,6 @@ updateFirst' cmdline next = do , errorMessage "Propellor build failed!" ) -getCurrentGitSha1 :: String -> IO String -getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref] - -- spin handles deploying propellor to a remote host, if it's not already -- installed there, or updating it if it is. Once the remote propellor is -- updated, it's run. @@ -351,35 +345,6 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout hFlush toh connect fromh toh -hasOrigin :: IO Bool -hasOrigin = do - rs <- lines <$> readProcess "git" ["remote"] - return $ "origin" `elem` rs - -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 - checkDebugMode :: IO () checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG" where 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