From 7115d1ec162b4059b3e8e8f84bd8d5898c1db025 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 14 May 2014 19:41:05 -0400 Subject: moved source code to src This is to work around OSX's brain-damange regarding filename case insensitivity. Avoided moving config.hs, because it's a config file. Put in a symlink to make build work. --- Utility/Misc.hs | 148 -------------------------------------------------------- 1 file changed, 148 deletions(-) delete mode 100644 Utility/Misc.hs (limited to 'Utility/Misc.hs') diff --git a/Utility/Misc.hs b/Utility/Misc.hs deleted file mode 100644 index 949f41e7..00000000 --- a/Utility/Misc.hs +++ /dev/null @@ -1,148 +0,0 @@ -{- misc utility functions - - - - Copyright 2010-2011 Joey Hess - - - - License: BSD-2-clause - -} - -{-# LANGUAGE CPP #-} - -module Utility.Misc where - -import System.IO -import Control.Monad -import Foreign -import Data.Char -import Data.List -import Control.Applicative -import System.Exit -#ifndef mingw32_HOST_OS -import System.Posix.Process (getAnyProcessStatus) -import Utility.Exception -#endif - -import Utility.FileSystemEncoding -import Utility.Monad - -{- A version of hgetContents that is not lazy. Ensures file is - - all read before it gets closed. -} -hGetContentsStrict :: Handle -> IO String -hGetContentsStrict = hGetContents >=> \s -> length s `seq` return s - -{- A version of readFile that is not lazy. -} -readFileStrict :: FilePath -> IO String -readFileStrict = readFile >=> \s -> length s `seq` return s - -{- Reads a file strictly, and using the FileSystemEncoding, so it will - - never crash on a badly encoded file. -} -readFileStrictAnyEncoding :: FilePath -> IO String -readFileStrictAnyEncoding f = withFile f ReadMode $ \h -> do - fileEncoding h - hClose h `after` hGetContentsStrict h - -{- Writes a file, using the FileSystemEncoding so it will never crash - - on a badly encoded content string. -} -writeFileAnyEncoding :: FilePath -> String -> IO () -writeFileAnyEncoding f content = withFile f WriteMode $ \h -> do - fileEncoding h - hPutStr h content - -{- Like break, but the item matching the condition is not included - - in the second result list. - - - - separate (== ':') "foo:bar" = ("foo", "bar") - - separate (== ':') "foobar" = ("foobar", "") - -} -separate :: (a -> Bool) -> [a] -> ([a], [a]) -separate c l = unbreak $ break c l - where - unbreak r@(a, b) - | null b = r - | otherwise = (a, tail b) - -{- Breaks out the first line. -} -firstLine :: String -> String -firstLine = takeWhile (/= '\n') - -{- Splits a list into segments that are delimited by items matching - - a predicate. (The delimiters are not included in the segments.) - - Segments may be empty. -} -segment :: (a -> Bool) -> [a] -> [[a]] -segment p l = map reverse $ go [] [] l - where - go c r [] = reverse $ c:r - go c r (i:is) - | p i = go [] (c:r) is - | otherwise = go (i:c) r is - -prop_segment_regressionTest :: Bool -prop_segment_regressionTest = all id - -- Even an empty list is a segment. - [ segment (== "--") [] == [[]] - -- There are two segements in this list, even though the first is empty. - , segment (== "--") ["--", "foo", "bar"] == [[],["foo","bar"]] - ] - -{- Includes the delimiters as segments of their own. -} -segmentDelim :: (a -> Bool) -> [a] -> [[a]] -segmentDelim p l = map reverse $ go [] [] l - where - go c r [] = reverse $ c:r - go c r (i:is) - | p i = go [] ([i]:c:r) is - | otherwise = go (i:c) r is - -{- Replaces multiple values in a string. - - - - Takes care to skip over just-replaced values, so that they are not - - mangled. For example, massReplace [("foo", "new foo")] does not - - replace the "new foo" with "new new foo". - -} -massReplace :: [(String, String)] -> String -> String -massReplace vs = go [] vs - where - - go acc _ [] = concat $ reverse acc - go acc [] (c:cs) = go ([c]:acc) vs cs - go acc ((val, replacement):rest) s - | val `isPrefixOf` s = - go (replacement:acc) vs (drop (length val) s) - | otherwise = go acc rest s - -{- Wrapper around hGetBufSome that returns a String. - - - - The null string is returned on eof, otherwise returns whatever - - data is currently available to read from the handle, or waits for - - data to be written to it if none is currently available. - - - - Note on encodings: The normal encoding of the Handle is ignored; - - each byte is converted to a Char. Not unicode clean! - -} -hGetSomeString :: Handle -> Int -> IO String -hGetSomeString h sz = do - fp <- mallocForeignPtrBytes sz - len <- withForeignPtr fp $ \buf -> hGetBufSome h buf sz - map (chr . fromIntegral) <$> withForeignPtr fp (peekbytes len) - where - peekbytes :: Int -> Ptr Word8 -> IO [Word8] - peekbytes len buf = mapM (peekElemOff buf) [0..pred len] - -{- Reaps any zombie git processes. - - - - Warning: Not thread safe. Anything that was expecting to wait - - on a process and get back an exit status is going to be confused - - if this reap gets there first. -} -reapZombies :: IO () -#ifndef mingw32_HOST_OS -reapZombies = do - -- throws an exception when there are no child processes - catchDefaultIO Nothing (getAnyProcessStatus False True) - >>= maybe (return ()) (const reapZombies) - -#else -reapZombies = return () -#endif - -exitBool :: Bool -> IO a -exitBool False = exitFailure -exitBool True = exitSuccess -- cgit v1.2.3