deal with git using / internally, even on DOS

Git/CatFile.hs

@@ -23,6 +23,7 @@ import Git
 import Git.Sha
 import Git.Command
 import Git.Types
+import Git.FilePath
 import qualified Utility.CoProcess as CoProcess
 
 type CatFileHandle = CoProcess.CoProcessHandle
@@ -38,7 +39,8 @@ catFileStop = CoProcess.stop
 
 {- Reads a file from a specified branch. -}
 catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString
-catFile h branch file = catObject h $ Ref $ show branch ++ ":" ++ file
+catFile h branch file = catObject h $ Ref $
+	show branch ++ ":" ++ toInternalGitPath file
 
 {- Uses a running git cat-file read the content of an object.
  - Objects that do not exist will have "" returned. -}

Git/FilePath.hs

@@ -5,16 +5,21 @@
  - top of the repository even when run in a subdirectory. Adding some
  - types helps keep that straight.
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Git.FilePath (
 	TopFilePath,
 	getTopFilePath,
 	toTopFilePath,
 	asTopFilePath,
+	InternalGitPath,
+	toInternalGitPath,
+	fromInternalGitPath
 ) where
 
 import Common
@@ -32,3 +37,22 @@ toTopFilePath file repo = TopFilePath <$>
  - repository -}
 asTopFilePath :: FilePath -> TopFilePath
 asTopFilePath file = TopFilePath file
+
+{- Git may use a different representation of a path when storing
+ - it internally. For example, on Windows, git uses '/' to separate paths
+ - stored in the repository, despite Windows using '\' -}
+type InternalGitPath = String
+
+toInternalGitPath :: FilePath -> InternalGitPath
+#ifndef __WINDOWS__
+toInternalGitPath = id
+#else
+toInternalGitPath = replace "\\" "/"
+#endif
+
+fromInternalGitPath :: InternalGitPath -> FilePath
+#ifndef __WINDOWS__
+fromInternalGitPath = id
+#else
+fromInternalGitPath = replace "/" "\\"
+#endif

Git/UpdateIndex.hs

@@ -1,11 +1,11 @@
 {- git-update-index library
  -
- - Copyright 2011, 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP #-}
 
 module Git.UpdateIndex (
 	Streamer,
@@ -59,13 +59,13 @@ lsTree (Ref x) repo streamer = do
  - a given file with a given sha. -}
 updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
 updateIndexLine sha filetype file =
-	show filetype ++ " blob " ++ show sha ++ "\t" ++ getTopFilePath file
+	show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file
 
 {- A streamer that removes a file from the index. -}
 unstageFile :: FilePath -> Repo -> IO Streamer
 unstageFile file repo = do
 	p <- toTopFilePath file repo
-	return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ getTopFilePath p
+	return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ indexPath p
 
 {- A streamer that adds a symlink to the index. -}
 stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
@@ -75,3 +75,6 @@ stageSymlink file sha repo = do
 		<*> pure SymlinkBlob
 		<*> toTopFilePath file repo
 	return $ pureStreamer line
+
+indexPath :: TopFilePath -> InternalGitPath
+indexPath = toInternalGitPath . getTopFilePath