Merge branch 'master' into ghc7.4

Conflicts:
	Utility/Misc.hs

Annex/Content.hs

@@ -25,7 +25,6 @@ module Annex.Content (
 	preseedTmp,
 ) where
 
-import System.IO.Error (try)
 import Control.Exception (bracket_)
 import System.Posix.Types
 
@@ -79,7 +78,7 @@ lockContent key a = do
 	where
 		lock Nothing = return Nothing
 		lock (Just l) = do
-			v <- try $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
+			v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
 			case v of
 				Left _ -> error "content is locked"
 				Right _ -> return $ Just l

Annex/Journal.hs

@@ -91,4 +91,4 @@ lockJournal a = do
 {- Runs an action, catching failure and running something to fix it up, and
  - retrying if necessary. -}
 doRedo :: IO a -> IO b -> IO a
-doRedo a b = catch a $ const $ b >> a
+doRedo a b = catchIO a $ const $ b >> a

Annex/Ssh.hs

@@ -11,7 +11,6 @@ module Annex.Ssh (
 ) where
 
 import qualified Data.Map as M
-import System.IO.Error (try)
 
 import Common.Annex
 import Annex.LockPool
@@ -72,7 +71,8 @@ sshCleanup = do
 			let lockfile = socket2lock socketfile
 			unlockFile lockfile
 			fd <- liftIO $ openFd lockfile ReadWrite (Just stdFileMode) defaultFileFlags
-			v <- liftIO $ try $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+			v <- liftIO $ tryIO $
+				setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 			case v of
 				Left _ -> return ()
 				Right _ -> stopssh socketfile

Backend.hs

@@ -16,7 +16,6 @@ module Backend (
 	maybeLookupBackendName
 ) where
 
-import System.IO.Error (try)
 import System.Posix.Files
 
 import Common.Annex
@@ -77,7 +76,7 @@ genKey' (b:bs) file = do
  - by examining what the file symlinks to. -}
 lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
 lookupFile file = do
-	tl <- liftIO $ try getsymlink
+	tl <- liftIO $ tryIO getsymlink
 	case tl of
 		Left _ -> return Nothing
 		Right l -> makekey l

CmdLine.hs

@@ -11,7 +11,6 @@ module CmdLine (
 	shutdown
 ) where
 
-import qualified System.IO.Error as IO
 import qualified Control.Exception as E
 import Control.Exception (throw)
 import System.Console.GetOpt
@@ -74,7 +73,7 @@ tryRun' errnum _ cmd []
 	| otherwise = return ()
 tryRun' errnum state cmd (a:as) = run >>= handle
 	where
-		run = IO.try $ Annex.run state $ do
+		run = tryIO $ Annex.run state $ do
 			Annex.Queue.flushWhenFull
 			a
 		handle (Left err) = showerr err >> cont False state

Command/Fsck.hs

@@ -81,7 +81,7 @@ performRemote key file backend numcopies remote = do
 			t <- fromRepo gitAnnexTmpDir
 			let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
 			liftIO $ createDirectoryIfMissing True t
-			let cleanup = liftIO $ catch (removeFile tmp) (const $ return ())
+			let cleanup = liftIO $ catchIO (removeFile tmp) (const $ return ())
 			cleanup
 			cleanup `after` a tmp
 		getfile tmp = do

Common.hs

@@ -21,6 +21,7 @@ import System.Posix.Process as X hiding (executeFile)
 import System.Exit as X
 
 import Utility.Misc as X
+import Utility.Exception as X
 import Utility.SafeCommand as X
 import Utility.Path as X
 import Utility.Directory as X

Remote/Bup.hs

@@ -8,7 +8,6 @@
 module Remote.Bup (remote) where
 
 import qualified Data.ByteString.Lazy.Char8 as L
-import System.IO.Error
 import qualified Data.Map as M
 import System.Process
 
@@ -200,7 +199,7 @@ getBupUUID :: Git.Repo -> UUID -> Annex (UUID, Git.Repo)
 getBupUUID r u
 	| Git.repoIsUrl r = return (u, r)
 	| otherwise = liftIO $ do
-		ret <- try $ Git.Config.read r
+		ret <- tryIO $ Git.Config.read r
 		case ret of
 			Right r' -> return (toUUID $ Git.Config.get "annex.uuid" "" r', r')
 			Left _ -> return (NoUUID, r)

Upgrade/V0.hs

@@ -7,8 +7,6 @@
 
 module Upgrade.V0 where
 
-import System.IO.Error (try)
-
 import Common.Annex
 import Annex.Content
 import qualified Upgrade.V1
@@ -47,7 +45,7 @@ getKeysPresent0 dir = do
 			return $ map fileKey0 files
 	where
 		present d = do
-			result <- try $
+			result <- tryIO $
 				getFileStatus $ dir ++ "/" ++ takeFileName d
 			case result of
 				Right s -> return $ isRegularFile s

Upgrade/V1.hs

@@ -7,7 +7,6 @@
 
 module Upgrade.V1 where
 
-import System.IO.Error (try)
 import System.Posix.Types
 import Data.Char
 
@@ -183,7 +182,7 @@ readLog1 file = catchDefaultIO (parseLog <$> readFileStrict file) []
 
 lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend))
 lookupFile1 file = do
-	tl <- liftIO $ try getsymlink
+	tl <- liftIO $ tryIO getsymlink
 	case tl of
 		Left _ -> return Nothing
 		Right l -> makekey l
@@ -216,7 +215,7 @@ getKeyFilesPresent1' dir = do
 			liftIO $ filterM present files
 	where
 		present f = do
-			result <- try $ getFileStatus f
+			result <- tryIO $ getFileStatus f
 			case result of
 				Right s -> return $ isRegularFile s
 				Left _ -> return False

Utility/Directory.hs

@@ -16,11 +16,12 @@ import Control.Monad.IfElse
 
 import Utility.SafeCommand
 import Utility.TempFile
+import Utility.Exception
 
 {- Moves one filename to another.
  - First tries a rename, but falls back to moving across devices if needed. -}
 moveFile :: FilePath -> FilePath -> IO ()
-moveFile src dest = try (rename src dest) >>= onrename
+moveFile src dest = tryIO (rename src dest) >>= onrename
 	where
 		onrename (Right _) = return ()
 		onrename (Left e)
@@ -40,11 +41,10 @@ moveFile src dest = try (rename src dest) >>= onrename
 						Param src, Param tmp]
 					unless ok $ do
 						-- delete any partial
-						_ <- try $
+						_ <- tryIO $ removeFile tmp
-							removeFile tmp
 						rethrow
 		isdir f = do
-			r <- try (getFileStatus f)
+			r <- tryIO $ getFileStatus f
 			case r of
 				(Left _) -> return False
 				(Right s) -> return $ isDirectory s

Utility/Exception.hs

@@ -0,0 +1,39 @@
+{- Simple IO exception handling
+ -
+ - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Exception where
+
+import Prelude hiding (catch)
+import Control.Exception
+import Control.Applicative
+
+{- Catches IO errors and returns a Bool -}
+catchBoolIO :: IO Bool -> IO Bool
+catchBoolIO a = catchDefaultIO a False
+
+{- Catches IO errors and returns a Maybe -}
+catchMaybeIO :: IO a -> IO (Maybe a)
+catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing
+
+{- Catches IO errors and returns a default value. -}
+catchDefaultIO :: IO a -> a -> IO a
+catchDefaultIO a def = catchIO a (const $ return def)
+
+{- Catches IO errors and returns the error message. -}
+catchMsgIO :: IO a -> IO (Either String a)
+catchMsgIO a = dispatch <$> tryIO a
+	where
+		dispatch (Left e) = Left $ show e
+		dispatch (Right v) = Right v
+
+{- catch specialized for IO errors only -}
+catchIO :: IO a -> (IOException -> IO a) -> IO a
+catchIO = catch
+
+{- try specialized for IO errors only -}
+tryIO :: IO a -> IO (Either IOException a)
+tryIO = try

Utility/Misc.hs

@@ -8,9 +8,7 @@
 module Utility.Misc where
 
 import System.IO
-import System.IO.Error (try)
 import Control.Monad
-import Control.Applicative
 import GHC.IO.Encoding
 
 {- Sets a Handle to use the filesystem encoding. This causes data
@@ -45,22 +43,3 @@ separate c l = unbreak $ break c l
 {- Breaks out the first line. -}
 firstLine :: String-> String
 firstLine = takeWhile (/= '\n')
-
-{- Catches IO errors and returns a Bool -}
-catchBoolIO :: IO Bool -> IO Bool
-catchBoolIO a = catchDefaultIO a False
-
-{- Catches IO errors and returns a Maybe -}
-catchMaybeIO :: IO a -> IO (Maybe a)
-catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing
-
-{- Catches IO errors and returns a default value. -}
-catchDefaultIO :: IO a -> a -> IO a
-catchDefaultIO a def = catch a (const $ return def)
-
-{- Catches IO errors and returns the error message. -}
-catchMsgIO :: IO a -> IO (Either String a)
-catchMsgIO a = dispatch <$> try a
-	where
-		dispatch (Left e) = Left $ show e
-		dispatch (Right v) = Right v

Utility/TempFile.hs

@@ -12,7 +12,7 @@ import System.IO
 import System.Posix.Process hiding (executeFile)
 import System.Directory
 
-import Utility.Misc
+import Utility.Exception
 import Utility.Path
 
 {- Runs an action like writeFile, writing to a temp file first and

doc/bugs/problems_with_utf8_names.mdwn

@@ -1,6 +1,12 @@
 This bug is reopened to track some new UTF-8 filename issues caused by GHC
-7.4. Older versions of GHC, like the 7.0.4 in debian unstable, are not
+7.4. In this version of GHC, git-annex's hack to support filenames in any
-affected. See the comments for details about the new bug. --[[Joey]] 
+encoding no longer works. Even unicode filenames fail to work when
+git-annex is built with 7.4. --[[Joey]]
+
+I now have a `ghc7.4` branch in git that seems to solve this, 
+for all filename encodings, and all system encodings. It will
+only build with the new GHC. If you have this problem, give it a try!
+--[[Joey]] 
 
 ----
 
@@ -74,39 +80,3 @@ It looks like the common latin1-to-UTF8 encoding. Functionality other than otupu
 >    > On second thought, I switched to this. Any decoding of a filename
 >    > is going to make someone unhappy; the previous approach broke
 >    > non-utf8 filenames.
-
-----
-
-Simpler test case:
-
-<pre>
-import Codec.Binary.UTF8.String
-import System.Environment
-
-main = do
-        args <- getArgs
-        let file = decodeString $ head args
-        putStrLn $ "file is: " ++ file
-        putStr =<< readFile file
-</pre>
-
-If I pass this a filename like 'ü', it will fail, and notice
-the bad encoding of the filename in the error message:
-
-<pre>
-$ echo hi > ü; runghc foo.hs ü
-file is: ü
-foo.hs: <20>: openFile: does not exist (No such file or directory)
-</pre>
-
-On the other hand, if I remove the decodeString, it prints the filename
-wrong, while accessing it right:
-
-<pre>
-$ runghc foo.hs ü
-file is: üa
-hi
-</pre>
-
-The only way that seems to consistently work is to delay decoding the
-filename to places where it's output. But then it's easy to miss some.

doc/todo/windows_support.mdwn

@@ -1,25 +1,16 @@
-short answer: no
+Can it be built on Windows?
 
-Long answer, quoting from a mail to someone else:
+short answer: not yet
 
-Well, I can tell you that it assumes a POSIX system, both in available
+First, you need to get some unix utilities for windows. Git of course.
-utilities and system calls, So you'd need to use cygwin or something
+Also rsync, and a `cp` command that understands at least `cp -p`, and
-like that. (Perhaps you already are for git, I think git also assumes a
+`uuid`, and `xargs` and `sha1sum`. Note that some of these could be
-POSIX system.) So you need a Haskell that can target that. What this
+replaced with haskell libraries to some degree.
-page refers to as "GHC-Cygwin":
-<http://www.haskell.org/ghc/docs/6.6/html/building/platforms.html>
-I don't know where to get one. Did find this:
-<http://copilotco.com/mail-archives/haskell-cafe.2007/msg00824.html>
 
-(There are probably also still some places where it assumes / as a path
+There are probably still some places where it assumes / as a path
-separator, although I fixed some. Probably almost all are fixed now.)
+separator, although I fixed probably almost all by now.
 
-FWIW, git-annex works fine on OS X and other fine proprietary unixen. ;P
+Then windows versions of these functions could be found,
---[[Joey]]
-
-----
-
-Alternatively, windows versions of these functions could be found,
 which are all the ones that need POSIX, I think. A fair amount of this,
 the stuff to do with signals and users, could be empty stubs in windows.
 The file manipulation, particularly symlinks, would probably be the main
@@ -63,3 +54,8 @@ sigCHLD
 sigINT
 unionFileModes
 </pre>
+
+A good starting point is
+<http://hackage.haskell.org/package/unix-compat-0.3.0.1>. However, note
+that its implementations of stuff like `createSymbolicLink` are stubs.
+--[[Joey]]