diff options
| -rw-r--r-- | Git/Branch.hs | 10 | ||||
| -rw-r--r-- | Git/Command.hs | 12 | ||||
| -rw-r--r-- | Git/HashObject.hs | 8 | ||||
| -rw-r--r-- | Git/Ref.hs | 5 | ||||
| -rw-r--r-- | System/Cmd/Utils.hs | 4 | ||||
| -rw-r--r-- | Utility/Misc.hs | 2 | ||||
| -rw-r--r-- | Utility/SafeCommand.hs | 4 | ||||
| -rw-r--r-- | git-annex.cabal | 2 |
8 files changed, 25 insertions, 22 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs index 6edc1c306..6f3d25186 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -73,12 +73,12 @@ commit :: String -> Branch -> [Ref] -> Repo -> IO Sha commit message branch parentrefs repo = do tree <- getSha "write-tree" $ pipeRead [Param "write-tree"] repo - sha <- getSha "commit-tree" $ - ignorehandle $ pipeWriteRead - (map Param $ ["commit-tree", show tree] ++ ps) - message repo + sha <- getSha "commit-tree" $ pipeWriteRead + (map Param $ ["commit-tree", show tree] ++ ps) + message repo + print ("got", sha) run "update-ref" [Param $ show branch, Param $ show sha] repo + print ("update-ref done", sha) return sha where - ignorehandle a = snd <$> a ps = concatMap (\r -> ["-p", show r]) parentrefs diff --git a/Git/Command.hs b/Git/Command.hs index 35f0838ba..9a09300e2 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -57,16 +57,18 @@ pipeWrite params s repo = assertLocal repo $ do hClose h return p -{- Runs a git subcommand, feeding it input, and returning its output. - - You should call either getProcessStatus or forceSuccess on the PipeHandle. -} -pipeWriteRead :: [CommandParam] -> String -> Repo -> IO (PipeHandle, String) +{- Runs a git subcommand, feeding it input, and returning its output, + - which is expected to be fairly small, since it's all read into memory + - strictly. -} +pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String pipeWriteRead params s repo = assertLocal repo $ do (p, from, to) <- hPipeBoth "git" (toCommand $ gitCommandLine params repo) fileEncoding to fileEncoding from _ <- forkIO $ finally (hPutStr to s) (hClose to) - c <- hGetContents from - return (p, c) + c <- hGetContentsStrict from + forceSuccess p + return c {- Reads null terminated output of a git command (as enabled by the -z - parameter), and splits it. -} diff --git a/Git/HashObject.hs b/Git/HashObject.hs index 9f37de5ba..c90c9ec3d 100644 --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -38,11 +38,9 @@ hashFile h file = CoProcess.query h send receive {- Injects some content into git, returning its Sha. -} hashObject :: ObjectType -> String -> Repo -> IO Sha hashObject objtype content repo = getSha subcmd $ do - (h, s) <- pipeWriteRead (map Param params) content repo - length s `seq` do - forceSuccess h - reap -- XXX unsure why this is needed - return s + s <- pipeWriteRead (map Param params) content repo + reap -- XXX unsure why this is needed, of if it is anymore + return s where subcmd = "hash-object" params = [subcmd, "-t", show objtype, "-w", "--stdin"] diff --git a/Git/Ref.hs b/Git/Ref.hs index ee2f02187..3052d0a6e 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -40,7 +40,10 @@ exists ref = runBool "show-ref" {- Get the sha of a fully qualified git ref, if it exists. -} sha :: Branch -> Repo -> IO (Maybe Sha) -sha branch repo = process <$> showref repo +sha branch repo = do + r <- process <$> showref repo + print r + return r where showref = pipeRead [Param "show-ref", Param "--hash", -- get the hash diff --git a/System/Cmd/Utils.hs b/System/Cmd/Utils.hs index 23c2bcedf..15544d684 100644 --- a/System/Cmd/Utils.hs +++ b/System/Cmd/Utils.hs @@ -179,7 +179,7 @@ Not available on Windows or with Hugs. -} hPipeFrom :: FilePath -> [String] -> IO (PipeHandle, Handle) hPipeFrom fp args = - ddd "hPipeFrom" $ do + ddd (show ("hPipeFrom", fp, args)) $ do pipepair <- createPipe let childstuff = do dupTo (snd pipepair) stdOutput closeFd (fst pipepair) @@ -281,7 +281,7 @@ Not available on Windows. -} hPipeBoth :: FilePath -> [String] -> IO (PipeHandle, Handle, Handle) hPipeBoth fp args = - ddd "hPipeBoth" $ do + ddd (show ("hPipeBoth", fp, args)) $ do frompair <- createPipe topair <- createPipe let childstuff = do dupTo (snd frompair) stdOutput diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 3b359139b..e11586467 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -33,7 +33,7 @@ separate c l = unbreak $ break c l | otherwise = (a, tail b) {- Breaks out the first line. -} -firstLine :: String-> String +firstLine :: String -> String firstLine = takeWhile (/= '\n') {- Splits a list into segments that are delimited by items matching diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs index aedf27137..2c6439b45 100644 --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -78,8 +78,8 @@ safeSystemEnv command params env = do {- executeFile with debug logging -} executeFile :: FilePath -> Bool -> [String] -> Maybe [(String, String)] -> IO () executeFile c path p e = do - debugM "Utility.SafeCommand.executeFile" $ - "Running: " ++ c ++ " " ++ show p ++ " " ++ maybe "" show e + --debugM "Utility.SafeCommand.executeFile" $ + -- "Running: " ++ c ++ " " ++ show p ++ " " ++ maybe "" show e System.Posix.Process.executeFile c path p e {- Escapes a filename or other parameter to be safely able to be exposed to diff --git a/git-annex.cabal b/git-annex.cabal index 0bd35e14f..3f237ce70 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 3.20120629 +Version: 3.20120630 Cabal-Version: >= 1.8 License: GPL Maintainer: Joey Hess <joey@kitenet.net> |