[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 7b5b0098583f47728294386670431528538e0ac4
Author: John Goerzen <jgoerzen at complete.org>
Date:   Wed Oct 20 02:43:24 2004 +0100

    Added Cmd.hs
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--1.0--patch-74)

diff --git a/ChangeLog b/ChangeLog
index 2039b27..55bb7ea 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,21 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-19 20:43:24 GMT	John Goerzen <jgoerzen at complete.org>	patch-74
+
+    Summary:
+      Added Cmd.hs
+    Revision:
+      missingh--head--1.0--patch-74
+
+
+    new files:
+     libsrc/MissingH/Cmd.hs
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO.hs
+
+
 2004-10-19 20:25:47 GMT	John Goerzen <jgoerzen at complete.org>	patch-73
 
     Summary:
diff --git a/libsrc/MissingH/Cmd.hs b/libsrc/MissingH/Cmd.hs
new file mode 100644
index 0000000..f815411
--- /dev/null
+++ b/libsrc/MissingH/Cmd.hs
@@ -0,0 +1,69 @@
+{- arch-tag: Command utilities main file
+Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+{- | Command invocation utilities.
+
+Written by John Goerzen, jgoerzen\@complete.org
+-}
+
+module MissingH.Cmd(safeSystem)
+where
+
+import System.Exit
+import System.Cmd
+import MissingH.Logging.Logger
+
+logbase = "MissingH.Cmd"
+
+{- | Invokes the specified command in a subprocess, waiting for the result.
+If the command terminated successfully, return normally.  Otherwise,
+raises a userError with the problem.
+
+Command lines executed will be logged using "MissingH.Logging.Logger" at the
+DEBUG level.  Failure messages will be logged at the WARNING level in addition
+to being raised as an exception.  Both are logged under
+\"MissingH.Cmd.safeSystem\".  If you wish to suppress these messages
+globally, you can simply run:
+
+> updateGlobalLogger "MissingH.Cmd.safeSystem"
+>                     (setLevel CRITICAL)
+
+See also: 'MissingH.Logging.Logger.updateGlobalLogger',
+"MissingH.Logging.Logger".
+
+-}
+
+safeSystem :: FilePath -> [String] -> IO ()
+safeSystem command args = 
+    do
+    debugM (logbase ++ ".safeSystem")
+               ("Running: " ++ command ++ " " ++ (show args))
+    ec <- rawSystem command args
+    case ec of
+            ExitSuccess -> return ()
+            ExitFailure fc -> cmdfailed command args fc
+
+cmdfailed :: FilePath -> [String] -> Int -> IO ()
+cmdfailed command args failcode = do
+    let errormsg = "Command " ++ command ++ " " ++ (show args) ++
+            " failed; exit code " ++ (show failcode)
+    let e = userError (errormsg)
+    warningM (logbase ++ ".safeSystem") errormsg
+    ioError e
+
+
diff --git a/libsrc/MissingH/IO.hs b/libsrc/MissingH/IO.hs
index b20d01d..1edc422 100644
--- a/libsrc/MissingH/IO.hs
+++ b/libsrc/MissingH/IO.hs
@@ -157,5 +157,4 @@ copyFileLinesToFile infn outfn = do
                                  hClose hin
                                  hClose hout
                                  return ()
-                                 
 

-- 
haskell-testpack