Permalink
Browse files

Getting there...

  • Loading branch information...
1 parent 202df00 commit fa440850948e67987b12f30208b7ee8136f8fbbf Ian Duncan committed Jun 26, 2012
Showing with 55 additions and 31 deletions.
  1. +24 −20 Command/Update.hs
  2. +5 −7 GitMega.cabal
  3. +26 −4 Main.hs
View
44 Command/Update.hs
@@ -9,7 +9,7 @@ import qualified Data.Text as T
git = command1 "git"
-isDirty = didExitFail $ git "diff" ["--no-ext-diff", "--quiet", "--exit-code"]
+isDirty = git "diff" ["--no-ext-diff", "--quiet", "--exit-code"] exitError
bracketWhen :: Monad m => m Bool -> m a -> m b -> m c -> m c
bracketWhen mb mbefore mafter maction = do
@@ -19,32 +19,36 @@ bracketWhen mb mbefore mafter maction = do
when b $ mafter >> return ()
return a
-smartStash = bracketWhen isDirty (awaitExit $ git "stash" []) (awaitExit $ git "stash" ["pop"])
+smartStash = bracketWhen isDirty (git "stash" [] exec) (git "stash" ["pop"] exec)
--- puts you on the new head of the most recent branch you were on.
--- if you were not on a branch, returns to the commit you were on.
-smartCheckout action = do
- symP <- getBranchTip
- hasSymbolicName <- wasExitSuccess symP
- reference <- if hasSymbolicName
- then (head . asLines) <$> out symP
- else (head . asLines) <$> out getBranchTip
- result <- action
- awaitExit $ git "checkout" [T.unpack reference]
- return result
+getRef = asSingleLine <$> git "rev-parse" ["HEAD"] out
-getRef = git "rev-parse" ["HEAD"]
-getBranchTip = git "symbolic-ref" ["HEAD", "--short"]
+getBranchTip = git "symbolic-ref" ["HEAD", "--short"] $ \p -> do
+ b <- exitOK p
+ if b then out p >>= (return . Just . asSingleLine) else return Nothing
getTrackingBranches :: Concert [(T.Text, T.Text)]
getTrackingBranches = do
- raw <- asLines <$> (out $ git "for-each-ref" ["--format=(\"%(refname:short)\", \"%(upstream:short)\")", "refs/heads"])
+ raw <- asLines <$> git "for-each-ref" ["--format=(\"%(refname:short)\", \"%(upstream:short)\")", "refs/heads"] out
return $! filter (not . T.null . snd) $ map (read . T.unpack) $ raw
-rebase local remote = git "rebase" [T.unpack remote, T.unpack local]
+-- puts you on the new head of the most recent branch you were on.
+-- if you were not on a branch, returns to the commit you were on.
+smartCheckout action = do
+ msym <- getBranchTip
+ location <- case msym of
+ Nothing -> getRef
+ Just loc -> return loc
+ result <- action
+ git "checkout" [T.unpack location] exec
+ return result
+
+rebase local remote = do
+ liftIO $ putStrLn $ "rebasing " ++ T.unpack remote ++ " " ++ T.unpack local
+ git "rebase" [T.unpack remote, T.unpack local] exec
-update repo = {- notify_error $ -} chdir repo $ do
- -- notify $ LT.append "Updating " $ toTextIgnore repo
- git "fetch" []
+update repo = chdir repo $ do
+ liftIO $ putStrLn "fetching"
+ git "fetch" [] exec
updatable <- getTrackingBranches
smartCheckout $ smartStash $ mapM_ (uncurry rebase) updatable
View
12 GitMega.cabal
@@ -15,17 +15,15 @@ category: Development
build-type: Simple
cabal-version: >=1.8
-executable GitMega
- -- main-is:
- -- other-modules:
+executable git-mega
+ main-is: Main.hs
+ other-modules: Command.Update
extensions: OverloadedStrings,
ExtendedDefaultRules,
QuasiQuotes,
TemplateHaskell,
KindSignatures
- ghc-options: -fno-warn-type-defaults,
- -Wall
build-depends: base ==4.5.*,
text ==0.11.*,
- shelly ==0.10.*,
- shelly-extra ==0.2.*,
+ concert < 0.2,
+ mtl ==2.*
View
30 Main.hs
@@ -1,17 +1,39 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where
+import Control.Applicative
import Control.Monad
+import Data.Default
import System.Concert
import System.Concert.Filesystem
+import System.Console.CmdTheLine
--- import Command.Update
+import Command.Update
gitRepos = getWorkingDirectory >>= listDirectory >>= filterM (isDirectory . (</> ".git"))
-main = do
- repos <- inCurrentDirectory Nothing $ gitRepos
- print repos
+updateAll = gitRepos >>= mapM_ update
+
+main :: IO ()
+main = runChoice help [(updateCmd, updateInfo)]
+
+help = undefined
+
+commandName :: Term String
+commandName = pos 0 "help" posInfo { argName = "COMMAND" }
+
+directoryArg :: Term (Maybe String)
+directoryArg = pos 1 Nothing $ posInfo { argName = "DIRECTORY" }
+
+updateCmd = updateCommand <$> commandName <*> directoryArg
+
+updateInfo = def { termName = "git mega"
+ , termDoc = "commands for execution across many repositories" }
+
+updateCommand :: String -> Maybe String -> IO ()
+updateCommand cmdName mdir = case mdir of
+ Nothing -> inCurrentDirectory Nothing updateAll
+ Just dir -> inDirectory (decodeString dir) Nothing updateAll
{-
branchInfo branch field = git "config" $ [LT.concat ["branch.", branch, ".", field]]

0 comments on commit fa44085

Please sign in to comment.