summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-16 00:31:25 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-16 00:50:12 -0400
commit23f2a12816e250f6780f80443ef6ec31c13fca9e (patch)
tree98de024aa2909caa39f82a76ccde182afef5093b
parent91366c896d9c9cb4519b451a64ed4d1e0ff52cb3 (diff)
broke up Utility
-rw-r--r--Command/Unused.hs1
-rw-r--r--Common.hs4
-rw-r--r--Init.hs1
-rw-r--r--Remote/Git.hs1
-rw-r--r--Remote/Rsync.hs1
-rw-r--r--Remote/S3real.hs1
-rw-r--r--Remote/Web.hs1
-rw-r--r--Upgrade/V1.hs1
-rw-r--r--Upgrade/V2.hs1
-rw-r--r--Utility.hs106
-rw-r--r--Utility/Misc.hs29
-rw-r--r--Utility/Monad.hs26
-rw-r--r--Utility/Path.hs22
-rw-r--r--Utility/RsyncFile.hs2
-rw-r--r--Utility/TempFile.hs39
-rw-r--r--Utility/Url.hs2
16 files changed, 126 insertions, 112 deletions
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 874b0ca06..a90174752 100644
--- a/Command/Unused.hs
+++ b/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
diff --git a/Common.hs b/Common.hs
index e88342ae4..2e1e4d996 100644
--- a/Common.hs
+++ b/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
diff --git a/Init.hs b/Init.hs
index 43840a108..6e024e9fc 100644
--- a/Init.hs
+++ b/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
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 8857d821d..5d31770a2 100644
--- a/Remote/Git.hs
+++ b/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
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 321656747..e79762a38 100644
--- a/Remote/Rsync.hs
+++ b/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
diff --git a/Remote/S3real.hs b/Remote/S3real.hs
index 40d7d905d..89b032637 100644
--- a/Remote/S3real.hs
+++ b/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
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 3fea94531..393932d47 100644
--- a/Remote/Web.hs
+++ b/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 {
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs
index 6c6531ace..331328e81 100644
--- a/Upgrade/V1.hs
+++ b/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.
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index d6334ed65..1ad41266a 100644
--- a/Upgrade/V2.hs
+++ b/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
diff --git a/Utility.hs b/Utility.hs
deleted file mode 100644
index 8ef60a081..000000000
--- a/Utility.hs
+++ /dev/null
@@ -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
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