[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
gwern0
gwern0 at gmail.com
Fri Apr 23 15:22:29 UTC 2010
The following commit has been merged in the master branch:
commit d8ebda988400d3dc908723469171b43820e5c1eb
Author: gwern0 <gwern0 at gmail.com>
Date: Fri Nov 30 12:51:27 2007 +0100
minor changes to System.IO.Utils, System.Path, System.Daemon
diff --git a/src/System/Daemon.hs b/src/System/Daemon.hs
index c47f443..c603984 100644
--- a/src/System/Daemon.hs
+++ b/src/System/Daemon.hs
@@ -22,7 +22,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Copyright : Copyright (C) 2005 John Goerzen
License : GNU GPL, version 2 or above
- Maintainer : John Goerzen <jgoerzen at complete.org>
+ Maintainer : John Goerzen <jgoerzen at complete.org>
Stability : provisional
Portability: portable to platforms with POSIX process\/signal tools
@@ -47,8 +47,8 @@ module System.Daemon (
#ifndef mingw32_HOST_OS
detachDaemon
#endif
- )
-where
+ )
+ where
#ifndef mingw32_HOST_OS
import System.Posix.Process
@@ -58,6 +58,7 @@ import System.Log.Logger
import System.Exit
+trap :: IO a -> IO a
trap = traplogging "System.Daemon" ERROR "detachDaemon"
{- | Detach the process from a controlling terminal and run it in the
@@ -67,7 +68,7 @@ After running this, please note the following side-effects:
* The PID of the running process will change
- * stdin, stdout, and stderr will not work (they'll be set to
+ * stdin, stdout, and stderr will not work (they'll be set to
\/dev\/null)
* CWD will be changed to \/
@@ -76,10 +77,9 @@ I /highly/ suggest running this function before starting any threads.
Note that this is not intended for a daemon invoked from inetd(1).
-}
-
detachDaemon :: IO ()
-detachDaemon = trap $
- do forkProcess child1
+detachDaemon = trap $
+ do forkProcess child1
exitImmediately ExitSuccess
child1 :: IO ()
@@ -95,6 +95,4 @@ child2 = trap $
nullFd <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags
mapM_ (dupTo nullFd) [stdInput, stdOutput, stdError]
closeFd nullFd
-
-
#endif
diff --git a/src/System/IO/Utils.hs b/src/System/IO/Utils.hs
index e12bc24..93fc58f 100644
--- a/src/System/IO/Utils.hs
+++ b/src/System/IO/Utils.hs
@@ -21,11 +21,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Copyright : Copyright (C) 2004-2006 John Goerzen
License : GNU GPL, version 2 or above
- Maintainer : John Goerzen <jgoerzen at complete.org>
+ Maintainer : John Goerzen <jgoerzen at complete.org>
Stability : provisional
Portability: portable
-
-asdf.
-}
module System.IO.Utils(-- * Entire File Handle Utilities
@@ -46,15 +44,14 @@ module System.IO.Utils(-- * Entire File Handle Utilities
optimizeForBatch, optimizeForInteraction
) where
-import System.IO.Unsafe
+import System.IO.Unsafe (unsafeInterleaveIO)
import System.IO
-import Data.List
+import Data.List (genericLength)
import System.IO.HVIO
{- | Given a list of strings, output a line containing each item, adding
newlines as appropriate. The list is not expected to have newlines already.
-}
-
hPutStrLns :: HVIO a => a -> [String] -> IO ()
hPutStrLns h = mapM_ $ vPutStrLn h
@@ -72,17 +69,16 @@ Example:
-}
--- FIXME does hGetContents h >>= return.lines not work?
+-- FIXME: does hGetContents h >>= return . lines not work?
hGetLines :: HVIO a => a -> IO [String]
hGetLines h = unsafeInterleaveIO (do
ieof <- vIsEOF h
- if (ieof)
+ if (ieof)
then return []
else do
line <- vGetLine h
remainder <- hGetLines h
- return (line : remainder)
- )
+ return (line : remainder))
{- | This is similar to the built-in 'System.IO.interact', but works
@@ -117,7 +113,7 @@ to wrapping hInteract with 'lines' and 'unlines'.
One could view this function like this:
-> hLineInteract finput foutput func =
+> hLineInteract finput foutput func =
> let newf = unlines . func . lines in
> hInteract finput foutput newf
@@ -128,7 +124,6 @@ Though the actual implementation is this for efficiency:
> lines <- hGetLines finput
> hPutStrLns foutput (func lines)
-}
-
hLineInteract :: (HVIO a, HVIO b) => a -> b -> ([String] -> [String]) -> IO ()
hLineInteract finput foutput func =
do
@@ -146,8 +141,7 @@ hCopy hin hout = do
{- | Copies from one handle to another in raw mode (using hGetContents).
Takes a function to provide progress updates to the user.
-}
-
-hCopyProgress :: (HVIO b, HVIO c, Integral a) =>
+hCopyProgress :: (HVIO b, HVIO c, Integral a) =>
b -- ^ Input handle
-> c -- ^ Output handle
-> (Maybe a -> Integer -> Bool -> IO ()) -- ^ Progress function -- the bool is always False unless this is the final call
@@ -178,13 +172,11 @@ Like 'hBlockCopy', this implementation is nice:
> hLineCopy hin hout = hLineInteract hin hout id
-}
-
hLineCopy :: (HVIO a, HVIO b) => a -> b -> IO()
hLineCopy hin hout = hLineInteract hin hout id
{- | Copies from 'stdin' to 'stdout' using lines. An alias for 'hLineCopy'
over 'stdin' and 'stdout'. -}
-
lineCopy :: IO ()
lineCopy = hLineCopy stdin stdout
@@ -194,7 +186,6 @@ Please note that the Unix permission bits are set at a default; you may
need to adjust them after the copy yourself.
This function is implemented using 'hLineCopy' internally. -}
-
copyFileLinesToFile :: FilePath -> FilePath -> IO ()
copyFileLinesToFile infn outfn = do
hin <- openFile infn ReadMode
@@ -213,8 +204,7 @@ optimizeForBatch = do
hSetBuffering stdout (BlockBuffering (Just 4096))
{- | Sets stdin and stdout to be line-buffered. This saves resources
-on stdout, but not many on stdin, since it it still looking for newlines.
--}
+on stdout, but not many on stdin, since it it still looking for newlines. -}
optimizeForInteraction :: IO ()
optimizeForInteraction = do
hSetBuffering stdin LineBuffering
diff --git a/src/System/Path.hs b/src/System/Path.hs
index aa37a5a..cd09c2f 100644
--- a/src/System/Path.hs
+++ b/src/System/Path.hs
@@ -22,7 +22,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Copyright : Copyright (C) 2004-2005 John Goerzen
License : GNU GPL, version 2 or above
- Maintainer : John Goerzen <jgoerzen at complete.org>
+ Maintainer : John Goerzen <jgoerzen at complete.org>
Stability : provisional
Portability: portable
@@ -59,11 +59,9 @@ import System.IO.HVFS.Utils
{- | Splits a pathname into a tuple representing the root of the name and
the extension. The extension is considered to be all characters from the last
dot after the last slash to the end. Either returned string may be empty. -}
-
--- FIXME - See 6.4 API when released.
-
+-- FIXME: See 6.4 API when released.
splitExt :: String -> (String, String)
-splitExt path =
+splitExt path =
let dotindex = alwaysElemRIndex '.' path
slashindex = alwaysElemRIndex '/' path
in
@@ -140,7 +138,7 @@ removes the directory and all its contents when the action completes (or raises
an exception. -}
brackettmpdir :: String -> (String -> IO a) -> IO a
brackettmpdir x action = do tmpdir <- mktmpdir x
- finally (action tmpdir)
+ finally (action tmpdir)
(recursiveRemove SystemFS tmpdir)
{- | Changes the current working directory to the given path,
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list