more debugging

Annex/Branch.hs

@@ -164,7 +164,9 @@ get' staleok file = fromcache =<< getCache file
 		fromjournal Nothing
 			| staleok = withIndex frombranch
 			| otherwise = withIndexUpdate $ frombranch >>= cache
-		frombranch = L.unpack <$> catFile fullname file
+		frombranch = do
+			liftIO $ putStrLn $ "frombranch " ++ file
+			L.unpack <$> catFile fullname file
 		cache content = do
 			setCache file content
 			return content

Git/CatFile.hs

@@ -50,11 +50,16 @@ catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha))
 catObjectDetails h object = CoProcess.query h send receive
 	where
 		send to = do
+			putStrLn "catObjectDetails send start"
 			fileEncoding to
 			hPutStrLn to $ show object
+			putStrLn $ "catObjectDetails send done " ++ show object
 		receive from = do
+			putStrLn "catObjectDetails read header start"
 			fileEncoding from
+			putStrLn "catObjectDetails read header start2"
 			header <- hGetLine from
+			putStrLn "catObjectDetails read header done"
 			case words header of
 				[sha, objtype, size]
 					| length sha == shaSize &&
@@ -67,9 +72,14 @@ catObjectDetails h object = CoProcess.query h send receive
 					| header == show object ++ " missing" -> dne
 					| otherwise -> error $ "unknown response from git cat-file " ++ show (header, object)
 		readcontent bytes from sha = do
+			putStrLn "readcontent start"
 			content <- S.hGet from bytes
+			putStrLn "readcontent end"
 			c <- hGetChar from
+			putStrLn "readcontent newline read"
 			when (c /= '\n') $
 				error "missing newline from git cat-file"
 			return $ Just (L.fromChunks [content], Ref sha)
-		dne = return Nothing
+		dne = do
+			putStrLn "dne"
+			return Nothing

Git/CheckAttr.hs

@@ -44,11 +44,15 @@ checkAttr (h, attrs, cwd) want file = do
 		_ -> error $ "unable to determine " ++ want ++ " attribute of " ++ file
 	where
 		send to = do
+			putStrLn "checkAttr send start"
 			fileEncoding to
 			hPutStr to $ file' ++ "\0"
+			putStrLn "checkAttr send end"
 		receive from = forM attrs $ \attr -> do
+			putStrLn "checkAttr receive start"
 			fileEncoding from
 			l <- hGetLine from
+			putStrLn "checkAttr receive end"
 			return (attr, attrvalue attr l)
 		{- Before git 1.7.7, git check-attr worked best with
 		 - absolute filenames; using them worked around some bugs

System/Cmd/Utils.hs

@@ -501,7 +501,7 @@ pOpen3 :: Maybe Fd                      -- ^ Send stdin to this fd
        -> (ProcessID -> IO a)           -- ^ Action to run in parent
        -> IO ()                         -- ^ Action to run in child before execing (if you don't need something, set this to @return ()@) -- IGNORED IN HUGS
        -> IO a
-pOpen3 pin pout perr fp args func childfunc = ddd "pOpen3" $
+pOpen3 pin pout perr fp args func childfunc = ddd (show ("pOpen3", fp, args)) $
     do pid <- pOpen3Raw pin pout perr fp args childfunc
        putStrLn "got pid"
        retval <- func $! pid

Utility/SafeCommand.hs

@@ -54,6 +54,7 @@ safeSystem command params = safeSystemEnv command params Nothing
 {- SIGINT(ctrl-c) is allowed to propigate and will terminate the program. -}
 safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode
 safeSystemEnv command params env = do
+	putStrLn "safeSystemEnv start"
 	-- Going low-level because all the high-level system functions
 	-- block SIGINT etc. We need to block SIGCHLD, but allow
 	-- SIGINT to do its default program termination.
@@ -65,7 +66,9 @@ safeSystemEnv command params env = do
 	mps <- getProcessStatus True False childpid
 	restoresignals oldint oldset
 	case mps of
-		Just (Exited code) -> return code
+		Just (Exited code) -> do
+			putStrLn "safeSystemEnv end"
+			return code
 		_ -> error $ "unknown error running " ++ command
 	where
 		restoresignals oldint oldset = do
@@ -78,9 +81,11 @@ safeSystemEnv command params env = do
 {- executeFile with debug logging -}
 executeFile :: FilePath -> Bool -> [String] -> Maybe [(String, String)] -> IO ()
 executeFile c path p e = do
+	putStrLn "executeFile start"
 	--debugM "Utility.SafeCommand.executeFile" $
 	--	"Running: " ++ c ++ " " ++ show p ++ " " ++ maybe "" show e
 	System.Posix.Process.executeFile c path p e
+	putStrLn "executeFile end"
 
 {- Escapes a filename or other parameter to be safely able to be exposed to
  - the shell. -}