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