broke up Utility

6 files changed, 118 insertions, 2 deletions

diff --git a/Utility/Misc.hs b/Utility/Misc.hs
new file mode 100644
index 000000000..bc1834774
--- /dev/null
+++ b/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)
diff --git a/Utility/Monad.hs b/Utility/Monad.hs
new file mode 100644
index 000000000..9523e1716
--- /dev/null
+++ b/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
diff --git a/Utility/Path.hs b/Utility/Path.hs
index 1c68b87bb..38e7bd05c 100644
--- a/Utility/Path.hs
+++ b/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
diff --git a/Utility/RsyncFile.hs b/Utility/RsyncFile.hs
index b6c2267e8..056bd8d11 100644
--- a/Utility/RsyncFile.hs
+++ b/Utility/RsyncFile.hs
@@ -1,4 +1,4 @@
-{- git-annex file copying with rsync
+{- file copying with rsync
  -
  - Copyright 2010 Joey Hess <joey@kitenet.net>
  -
diff --git a/Utility/TempFile.hs b/Utility/TempFile.hs
new file mode 100644
index 000000000..1e823c10e
--- /dev/null
+++ b/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
diff --git a/Utility/Url.hs b/Utility/Url.hs
index b5f5b78c0..617fe3f4d 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -17,7 +17,7 @@ import Network.HTTP
 import Network.URI
 
 import Utility.SafeCommand
-import Utility
+import Utility.Path
 
 type URLString = String