split groups of related functions out of Utility

1 files changed, 2 insertions, 213 deletions

diff --git a/Utility.hs b/Utility.hs
index 8a332601b..788dc4103 100644
--- a/Utility.hs
+++ b/Utility.hs
@@ -6,20 +6,8 @@
  -}
 
 module Utility (
-	CommandParam(..),
-	toCommand,
 	hGetContentsStrict,
 	readFileStrict,
-	parentDir,
-	absPath,
-	absPathFrom,
-	relPathCwdToFile,
-	relPathDirToFile,
-	boolSystem,
-	boolSystemEnv,
-	executeFile,
-	shellEscape,
-	shellUnEscape,
 	unsetFileMode,
 	readMaybe,
 	viaTmp,
@@ -27,125 +15,19 @@ module Utility (
 	dirContains,
 	dirContents,
 	myHomeDir,
-	catchBool,
-	whenM,
-	(>>?),
-	unlessM,
-	(>>!),
-	
-	prop_idempotent_shellEscape,
-	prop_idempotent_shellEscape_multiword,
-	prop_parentDir_basics,
-	prop_relPathDirToFile_basics
+	catchBool
 ) where
 
 import IO (bracket)
 import System.IO
-import System.Exit
-import qualified System.Posix.Process
 import System.Posix.Process hiding (executeFile)
-import System.Posix.Signals
 import System.Posix.Files
 import System.Posix.Types
 import System.Posix.User
-import Data.String.Utils
-import System.Path
 import System.FilePath
 import System.Directory
 import Foreign (complement)
-import Data.List
-import Data.Maybe
-import Control.Monad (liftM2, when, unless)
-import System.Log.Logger
-
-{- A type for parameters passed to a shell command. A command can
- - be passed either some Params (multiple parameters can be included,
- - whitespace-separated, or a single Param (for when parameters contain
- - whitespace), or a File.
- -}
-data CommandParam = Params String | Param String | File FilePath
-	deriving (Eq, Show, Ord)
-
-{- Used to pass a list of CommandParams to a function that runs
- - a command and expects Strings. -}
-toCommand :: [CommandParam] -> [String]
-toCommand = (>>= unwrap)
-	where
-		unwrap (Param s) = [s]
-		unwrap (Params s) = filter (not . null) (split " " s)
-		-- Files that start with a dash are modified to avoid
-		-- the command interpreting them as options.
-		unwrap (File s@('-':_)) = ["./" ++ s]
-		unwrap (File s) = [s]
-
-{- Run a system command, and returns True or False
- - if it succeeded or failed.
- -
- - SIGINT(ctrl-c) is allowed to propigate and will terminate the program.
- -}
-boolSystem :: FilePath -> [CommandParam] -> IO Bool
-boolSystem command params = boolSystemEnv command params Nothing
-
-boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
-boolSystemEnv command params env = do
-	-- Going low-level because all the high-level system functions
-	-- block SIGINT etc. We need to block SIGCHLD, but allow
-	-- SIGINT to do its default program termination.
-	let sigset = addSignal sigCHLD emptySignalSet
-	oldint <- installHandler sigINT Default Nothing
-	oldset <- getSignalMask
-	blockSignals sigset
-	childpid <- forkProcess $ childaction oldint oldset
-	mps <- getProcessStatus True False childpid
-	restoresignals oldint oldset
-	case mps of
-		Just (Exited ExitSuccess) -> return True
-		_ -> return False
-	where
-		restoresignals oldint oldset = do
-			_ <- installHandler sigINT oldint Nothing
-			setSignalMask oldset
-		childaction oldint oldset = do
-			restoresignals oldint oldset
-			executeFile command True (toCommand params) env
-
-{- executeFile with debug logging -}
-executeFile :: FilePath -> Bool -> [String] -> Maybe [(String, String)] -> IO ()
-executeFile c path p e = do
-	debugM "Utility.executeFile" $
-		"Running: " ++ c ++ " " ++ show p ++ " " ++ maybe "" show e
-	System.Posix.Process.executeFile c path p e
-
-{- Escapes a filename or other parameter to be safely able to be exposed to
- - the shell. -}
-shellEscape :: String -> String
-shellEscape f = "'" ++ escaped ++ "'"
-	where
-		-- replace ' with '"'"'
-		escaped = join "'\"'\"'" $ split "'" f
-
-{- Unescapes a set of shellEscaped words or filenames. -}
-shellUnEscape :: String -> [String]
-shellUnEscape [] = []
-shellUnEscape s = word : shellUnEscape rest
-	where
-		(word, rest) = findword "" s
-		findword w [] = (w, "")
-		findword w (c:cs)
-			| c == ' ' = (w, cs)
-			| c == '\'' = inquote c w cs
-			| c == '"' = inquote c w cs
-			| otherwise = findword (w++[c]) cs
-		inquote _ w [] = (w, "")
-		inquote q w (c:cs)
-			| c == q = findword w cs
-			| otherwise = inquote q (w++[c]) cs
-
-{- For quickcheck. -}
-prop_idempotent_shellEscape :: String -> Bool
-prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s
-prop_idempotent_shellEscape_multiword :: [String] -> Bool
-prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
+import Utility.Path
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
@@ -156,82 +38,6 @@ hGetContentsStrict h  = hGetContents h >>= \s -> length s `seq` return s
 readFileStrict :: FilePath -> IO String
 readFileStrict f = readFile f >>= \s -> length s `seq` return s
 
-{- Returns the parent directory of a path. Parent of / is "" -}
-parentDir :: FilePath -> FilePath
-parentDir dir =
-	if not $ null dirs
-	then slash ++ join s (take (length dirs - 1) dirs)
-	else ""
-		where
-			dirs = filter (not . null) $ split s dir
-			slash = if isAbsolute dir then s else ""
-			s = [pathSeparator]
-
-prop_parentDir_basics :: FilePath -> Bool
-prop_parentDir_basics dir
-	| null dir = True
-	| dir == "/" = parentDir dir == ""
-	| otherwise = p /= dir
-	where
-		p = parentDir dir
-
-{- Checks if the first FilePath is, or could be said to contain the second.
- - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
- - are all equivilant.
- -}
-dirContains :: FilePath -> FilePath -> Bool
-dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
-	where
-		norm p = fromMaybe "" $ absNormPath p "."
-		a' = norm a
-		b' = norm b
-
-{- Converts a filename into a normalized, absolute path. -}
-absPath :: FilePath -> IO FilePath
-absPath file = do
-	cwd <- getCurrentDirectory
-	return $ absPathFrom cwd file
-
-{- Converts a filename into a normalized, absolute path
- - from the specified cwd. -}
-absPathFrom :: FilePath -> FilePath -> FilePath
-absPathFrom cwd file = fromMaybe bad $ absNormPath cwd file
-	where
-		bad = error $ "unable to normalize " ++ file
-
-{- Constructs a relative path from the CWD to a file.
- -
- - For example, assuming CWD is /tmp/foo/bar:
- -    relPathCwdToFile "/tmp/foo" == ".."
- -    relPathCwdToFile "/tmp/foo/bar" == "" 
- -}
-relPathCwdToFile :: FilePath -> IO FilePath
-relPathCwdToFile f = liftM2 relPathDirToFile getCurrentDirectory (absPath f)
-
-{- Constructs a relative path from a directory to a file.
- -
- - Both must be absolute, and normalized (eg with absNormpath).
- -}
-relPathDirToFile :: FilePath -> FilePath -> FilePath
-relPathDirToFile from to = path
-	where
-		s = [pathSeparator]
-		pfrom = split s from
-		pto = split s to
-		common = map fst $ filter same $ zip pfrom pto
-		same (c,d) = c == d
-		uncommon = drop numcommon pto
-		dotdots = replicate (length pfrom - numcommon) ".."
-		numcommon = length common
-		path = join s $ dotdots ++ uncommon
-
-prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
-prop_relPathDirToFile_basics from to
-	| from == to = null r
-	| otherwise = not (null r)
-	where
-		r = relPathDirToFile from to 
-
 {- Removes a FileMode from a file.
  - For example, call with otherWriteMode to chmod o-w -}
 unsetFileMode :: FilePath -> FileMode -> IO ()
@@ -288,20 +94,3 @@ myHomeDir = do
 {- Catches IO errors and returns a Bool -}
 catchBool :: IO Bool -> IO Bool
 catchBool = flip catch (const $ return False)
-
-{- when with a monadic conditional -}
-whenM :: Monad m => m Bool -> m () -> m ()
-whenM c a = c >>= flip when a
-
-unlessM :: Monad m => m Bool -> m () -> m ()
-unlessM c a = c >>= flip unless a
-
-(>>?) :: Monad m => m Bool -> m () -> m ()
-(>>?) = whenM
-
-(>>!) :: Monad m => m Bool -> m () -> m ()
-(>>!) = unlessM
-
--- low fixity allows eg, foo bar >>! error $ "failed " ++ meep
-infixr 0 >>?
-infixr 0 >>!