broke up Utility

Command/Unused.hs

@@ -16,6 +16,7 @@ import Common.Annex
 import Command
 import Annex.Content
 import Utility.FileMode
+import Utility.TempFile
 import Logs.Location
 import qualified Annex
 import qualified Git

Common.hs

@@ -15,7 +15,7 @@ module Common (
 	module System.Posix.IO,
 	module System.Posix.Process,
 	module System.Exit,
-	module Utility,
+	module Utility.Misc,
 	module Utility.Conditional,
 	module Utility.SafeCommand,
 	module Utility.Path,
@@ -40,7 +40,7 @@ import System.Posix.IO
 import System.Posix.Process hiding (executeFile)
 import System.Exit
 
-import Utility
+import Utility.Misc
 import Utility.Conditional
 import Utility.SafeCommand
 import Utility.Path

Init.hs

@@ -12,6 +12,7 @@ module Init (
 ) where
 
 import Common.Annex
+import Utility.TempFile
 import qualified Git
 import qualified Annex.Branch
 import Annex.Version

Remote/Git.hs

@@ -20,6 +20,7 @@ import qualified Annex
 import Annex.UUID
 import qualified Annex.Content
 import qualified Utility.Url as Url
+import Utility.TempFile
 import Config
 import Init
 

Remote/Rsync.hs

@@ -13,7 +13,6 @@ import qualified Data.Map as M
 import Common.Annex
 import Types.Remote
 import qualified Git
-import Logs.UUID
 import Config
 import Annex.Content
 import Remote.Helper.Special

Remote/S3real.hs

@@ -21,7 +21,6 @@ import Common.Annex
 import Types.Remote
 import Types.Key
 import qualified Git
-import Logs.UUID
 import Config
 import Remote.Helper.Special
 import Remote.Helper.Encryptable

Remote/Web.hs

@@ -13,6 +13,7 @@ import qualified Git
 import Config
 import Logs.Web
 import qualified Utility.Url as Url
+import Utility.Monad
 
 remote :: RemoteType Annex
 remote = RemoteType {

Upgrade/V1.hs

@@ -21,6 +21,7 @@ import qualified Git.LsFiles as LsFiles
 import Backend
 import Annex.Version
 import Utility.FileMode
+import Utility.TempFile
 import qualified Upgrade.V2
 
 -- v2 adds hashing of filenames of content and location log files.

Upgrade/V2.hs

@@ -12,6 +12,7 @@ import qualified Git
 import qualified Annex.Branch
 import Logs.Location
 import Annex.Content
+import Utility.TempFile
 
 olddir :: Git.Repo -> FilePath
 olddir g

Utility.hs

@@ -1,106 +0,0 @@
-{- general purpose utility functions
- -
- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Utility (
-	hGetContentsStrict,
-	readFileStrict,
-	readMaybe,
-	viaTmp,
-	withTempFile,
-	dirContents,
-	myHomeDir,
-	catchBool,
-	inPath,
-	firstM,
-	anyM
-) where
-
-import Control.Applicative
-import IO (bracket)
-import System.IO
-import System.Posix.Process hiding (executeFile)
-import System.Posix.User
-import System.FilePath
-import System.Directory
-import Utility.Path
-import Data.Maybe
-import Control.Monad (liftM)
-
-{- A version of hgetContents that is not lazy. Ensures file is 
- - all read before it gets closed. -}
-hGetContentsStrict :: Handle -> IO String
-hGetContentsStrict h  = hGetContents h >>= \s -> length s `seq` return s
-
-{- A version of readFile that is not lazy. -}
-readFileStrict :: FilePath -> IO String
-readFileStrict f = readFile f >>= \s -> length s `seq` return s
-
-{- Attempts to read a value from a String. -}
-readMaybe :: (Read a) => String -> Maybe a
-readMaybe s = case reads s of
-	((x,_):_) -> Just x
-	_ -> Nothing
-
-{- Runs an action like writeFile, writing to a tmp file first and
- - then moving it into place. -}
-viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()
-viaTmp a file content = do
-	pid <- getProcessID
-        let tmpfile = file ++ ".tmp" ++ show pid
-	createDirectoryIfMissing True (parentDir file)
-	a tmpfile content
-	renameFile tmpfile file
-
-{- Runs an action with a temp file, then removes the file. -}
-withTempFile :: String -> (FilePath -> Handle -> IO a) -> IO a
-withTempFile template a = bracket create remove use
-	where
-		create = do
-			tmpdir <- catch getTemporaryDirectory (const $ return ".")
-			openTempFile tmpdir template
-		remove (name, handle) = do
-			hClose handle
-			catchBool (removeFile name >> return True)
-		use (name, handle) = a name handle
-
-{- Lists the contents of a directory.
- - Unlike getDirectoryContents, paths are not relative to the directory. -}
-dirContents :: FilePath -> IO [FilePath]
-dirContents d = map (d </>) . filter notcruft <$> getDirectoryContents d
-	where
-		notcruft "." = False
-		notcruft ".." = False
-		notcruft _ = True
-
-{- Current user's home directory. -}
-myHomeDir :: IO FilePath
-myHomeDir = homeDirectory <$> (getUserEntryForID =<< getEffectiveUserID)
-
-{- Catches IO errors and returns a Bool -}
-catchBool :: IO Bool -> IO Bool
-catchBool = flip catch (const $ return False)
-
-{- Return the first value from a list, if any, satisfying the given
- - predicate -}
-firstM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
-firstM _ [] = return Nothing
-firstM p (x:xs) = do
-	q <- p x
-	if q
-		then return (Just x)
-		else firstM p xs
-
-{- Returns true if any value in the list satisfies the preducate,
- - stopping once one is found. -}
-anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
-anyM p = liftM isJust . firstM p
-
-{- Checks if a command is available in PATH. -}
-inPath :: String -> IO Bool
-inPath command = getSearchPath >>= anyM indir
-	where
-		indir d = doesFileExist $ d </> command

Utility/Misc.hs

@@ -0,0 +1,29 @@
+{- misc utility functions
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Misc where
+
+import System.IO
+
+{- A version of hgetContents that is not lazy. Ensures file is 
+ - all read before it gets closed. -}
+hGetContentsStrict :: Handle -> IO String
+hGetContentsStrict h  = hGetContents h >>= \s -> length s `seq` return s
+
+{- A version of readFile that is not lazy. -}
+readFileStrict :: FilePath -> IO String
+readFileStrict f = readFile f >>= \s -> length s `seq` return s
+
+{- Attempts to read a value from a String. -}
+readMaybe :: (Read a) => String -> Maybe a
+readMaybe s = case reads s of
+	((x,_):_) -> Just x
+	_ -> Nothing
+
+{- Catches IO errors and returns a Bool -}
+catchBool :: IO Bool -> IO Bool
+catchBool = flip catch (const $ return False)

Utility/Monad.hs

@@ -0,0 +1,26 @@
+{- monadic stuff
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Monad where
+
+import Data.Maybe
+import Control.Monad (liftM)
+
+{- Return the first value from a list, if any, satisfying the given
+ - predicate -}
+firstM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
+firstM _ [] = return Nothing
+firstM p (x:xs) = do
+	q <- p x
+	if q
+		then return (Just x)
+		else firstM p xs
+
+{- Returns true if any value in the list satisfies the preducate,
+ - stopping once one is found. -}
+anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
+anyM p = liftM isJust . firstM p

Utility/Path.hs

@@ -14,6 +14,9 @@ import System.Directory
 import Data.List
 import Data.Maybe
 import Control.Applicative
+import System.Posix.User
+
+import Utility.Monad
 
 {- Returns the parent directory of a path. Parent of / is "" -}
 parentDir :: FilePath -> FilePath
@@ -112,3 +115,22 @@ preserveOrder (l:ls) new = found ++ preserveOrder ls rest
  -}
 runPreserveOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
 runPreserveOrder a files = preserveOrder files <$> a files
+
+{- Lists the contents of a directory.
+ - Unlike getDirectoryContents, paths are not relative to the directory. -}
+dirContents :: FilePath -> IO [FilePath]
+dirContents d = map (d </>) . filter notcruft <$> getDirectoryContents d
+	where
+		notcruft "." = False
+		notcruft ".." = False
+		notcruft _ = True
+
+{- Current user's home directory. -}
+myHomeDir :: IO FilePath
+myHomeDir = homeDirectory <$> (getUserEntryForID =<< getEffectiveUserID)
+
+{- Checks if a command is available in PATH. -}
+inPath :: String -> IO Bool
+inPath command = getSearchPath >>= anyM indir
+	where
+		indir d = doesFileExist $ d </> command

Utility/RsyncFile.hs

@@ -1,4 +1,4 @@
-{- git-annex file copying with rsync
+{- file copying with rsync
  -
  - Copyright 2010 Joey Hess <joey@kitenet.net>
  -

Utility/TempFile.hs

@@ -0,0 +1,39 @@
+{- temp file functions
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.TempFile where
+
+import IO (bracket)
+import System.IO
+import System.Posix.Process hiding (executeFile)
+import System.Directory
+
+import Utility.Misc
+import Utility.Path
+
+{- Runs an action like writeFile, writing to a temp file first and
+ - then moving it into place. The temp file is stored in the same
+ - directory as the final file to avoid cross-device renames. -}
+viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()
+viaTmp a file content = do
+	pid <- getProcessID
+        let tmpfile = file ++ ".tmp" ++ show pid
+	createDirectoryIfMissing True (parentDir file)
+	a tmpfile content
+	renameFile tmpfile file
+
+{- Runs an action with a temp file, then removes the file. -}
+withTempFile :: String -> (FilePath -> Handle -> IO a) -> IO a
+withTempFile template a = bracket create remove use
+	where
+		create = do
+			tmpdir <- catch getTemporaryDirectory (const $ return ".")
+			openTempFile tmpdir template
+		remove (name, handle) = do
+			hClose handle
+			catchBool (removeFile name >> return True)
+		use (name, handle) = a name handle

Utility/Url.hs

@@ -17,7 +17,7 @@ import Network.HTTP
 import Network.URI
 
 import Utility.SafeCommand
-import Utility
+import Utility.Path
 
 type URLString = String