diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,4 +1,5 @@ -VERSION = 3.3.2 +# nächste Version: +VERSION = 3.3.4 default :: lib diff --git a/hsshellscript.cabal b/hsshellscript.cabal --- a/hsshellscript.cabal +++ b/hsshellscript.cabal @@ -1,5 +1,5 @@ Name: hsshellscript -Version: 3.3.3 +Version: 3.3.4 Synopsis: Haskell for Unix shell scripting tasks Description: A Haskell-library for tasks which are usually done in shell scripts. This includes parsing command line diff --git a/src/HsShellScript.hs b/src/HsShellScript.hs --- a/src/HsShellScript.hs +++ b/src/HsShellScript.hs @@ -78,7 +78,7 @@ strerror, perror', perror, - {-abort, _exit,-} + _exit, HsShellScript.ProcErr.failIO, exitcode, throwErrno', @@ -106,6 +106,7 @@ import System.Directory import System.Exit import System.Posix + {- | Error reporting wrapper for the @main@ function. This catches any diff --git a/src/HsShellScript/ProcErr.chs b/src/HsShellScript/ProcErr.chs --- a/src/HsShellScript/ProcErr.chs +++ b/src/HsShellScript/ProcErr.chs @@ -514,6 +514,9 @@ > ) > ) + >sunproc ( err_to_out foo + > -|- exec "/usr/bin/tee" ["-a", "/tmp/foo.log"] ) + See 'subproc', '(=|-)', '(-|=)', 'redirect' -} (-|-) :: IO a -- ^ Action which won't be forked @@ -587,7 +590,7 @@ Example: - >@subproc (exec \"\/usr\/bin\/foo\" [] -|= exec \"\/usr\/bin\/bar\" [])@ +>subproc (exec \"\/usr\/bin\/foo\" [] -|= exec \"\/usr\/bin\/bar\" []) See 'subproc', '(=|-)', '(=|=)'. -} @@ -1875,14 +1878,14 @@ ) , Handler $ (\(e::ExitCode) -> do -- Child process is a subroutine that has terminated normally. - errm "Warning! Child process tries to shut down normally. This is a bug. It should\n\ - \terminate with _exit (or catch the ExitException yourself). See section\n\"\ - \Running a Subroutine in a Separate Process\" in the HsShellScript API\n\ - \documentation. Terminating with _exit 0 now." - _exit (case e of - ExitSuccess -> 0 - ExitFailure ec' -> ec' - )) + let ec = case e of + ExitSuccess -> 0 + ExitFailure ec' -> ec' + errm ("Warning! Child process tries to shut down normally. This is a bug. It should\n\ + \terminate with _exit (or catch the ExitException yourself). See section\n\"\ + \Running a Subroutine in a Separate Process\" in the HsShellScript API\n\ + \documentation. Terminating with _exit " ++ show ec ++ " now.") + _exit ec) , Handler $ (\(e::SomeException) -> do errm ("Child process quit with unexpected exception:\n" ++ show e) _exit 1 diff --git a/test/Makefile b/test/Makefile --- a/test/Makefile +++ b/test/Makefile @@ -1,5 +1,6 @@ -VERSION=3.3.1 -CFLAGS=-XDeriveDataTypeable +VERSION=3.3.4 +CFLAGS=-XDeriveDataTypeable -i../dist/build -package-name hsshellscript-3.3.4 +# Kleines i bei "-i" oben PROG_HS = $(notdir $(basename $(wildcard [_abcdefghijklmnopqrstuvwxyzäöü]*.hs))) PROG_CHS = $(notdir $(basename $(wildcard [_abcdefghijklmnopqrstuvwxyzäöü]*.chs))) @@ -9,7 +10,7 @@ % : %.o cteile.o ../dist/build/libHShsshellscript-$(VERSION).a - ghc -o $@ $^ -package haskell2010 -package unix + ghc -o $@ $^ -package haskell2010 -package unix -package directory -package random %.o : %.hs ghc -c $(CFLAGS) $^ @@ -27,7 +28,7 @@ $(foreach m, $(PROG_CHS), "$(m).hs") depend :: $(foreach m, $(PROGS), $(m).hs) - ghc -M $(CFLAGS) -dep-makefile -optdepdepend \ + ghc -M $(CFLAGS) -dep-makefile -optdepdepend -dep-suffix "p_" \ $(foreach m, $(PROGS), "$(m).hs") make cteile.o diff --git a/test/_exit.chs b/test/_exit.chs new file mode 100644 --- /dev/null +++ b/test/_exit.chs @@ -0,0 +1,35 @@ +import HsShellScript +--import Foreign.C + + +main = _exit 666 + + +{- +main = do + _exit (0::Int) + return () +-} + + +{- +_exit :: Int -- ^ Exit code + -> IO a -- ^ Never returns +_exit ec = do + _exit_prim (fromIntegral ec) + error "Impossible error" -- never reached + +foreign import ccall safe "HsShellScript/ProcErr.chs.h _exit" + _exit_prim :: (CInt -> (IO ())) +-} + + +--_exit :: Int -- ^ Exit code +-- -> IO a -- ^ Never returns +--_exit ec = do +-- _exit_prim (fromIntegral ec) +-- error "Impossible error" -- never reached, only for the type checker + + +--foreign import ccall safe "HsShellScript/ProcErr.chs.h _exit" +-- _exit_prim :: (CInt -> (IO ())) diff --git a/test/cteile.c b/test/cteile.c --- a/test/cteile.c +++ b/test/cteile.c @@ -3,7 +3,7 @@ void c_aufruf(const char* ptr) { - printf("ptr = >%s<\nlength = %d\n", ptr, strlen(ptr)); + printf("ptr = >%s<\nlength = %d\n", ptr, (int) strlen(ptr)); } diff --git a/test/pipe_to_proc.hs b/test/pipe_to_proc.hs new file mode 100644 --- /dev/null +++ b/test/pipe_to_proc.hs @@ -0,0 +1,11 @@ +import HsShellScript + +main = do + outm "-1-" + subproc ( exec "/bin/echo" ["bla"] + -|= ( -- Do something with foo's output + do cnt <- lazy_contents "-" + outm ("in subprocess: read \"" ++ cnt ++ "\"") + ) + ) + outm "-2-" diff --git a/test/tee.hs b/test/tee.hs new file mode 100644 --- /dev/null +++ b/test/tee.hs @@ -0,0 +1,11 @@ +import HsShellScript + +main = do + outm "Davor." + subproc + ( (err_to_out main') + -|- exec "/usr/bin/tee" ["/tmp/tee.log"] ) + outm "Danach." + +main' = + outm "In main'" diff --git a/test/textmode.chs b/test/textmode.chs deleted file mode 100644 --- a/test/textmode.chs +++ /dev/null @@ -1,120 +0,0 @@ -{- - * withCString konvertiert von Haskell (d.h. Unicode) nach UTF-8 (je nach Locale) - * puts aus der C-Bibliothek fügt einen Zeilenumbruch am Ende ein. --} - -import HsShellScript -import System.IO -import System.Posix.Process -import System.Posix.Types -import Foreign.C -import Foreign.Ptr - -main = mainwrapper $ do - - - h <- openFile "/home/v/src/hsskripte/tmp/txt" ReadMode - hSetBinaryMode h True - c <- hGetContents h - seq (length c) (return ()) - hClose h - putStr ("Datei im Binär-Modus: " ++ c) - - h <- openFile "/home/v/src/hsskripte/tmp/txt" ReadMode - hSetBinaryMode h False - c <- hGetContents h - seq (length c) (return ()) - hClose h - putStr ("Datei im Text-Modus: " ++ c) - - h <- openFile "/home/v/src/hsskripte/tmp/txt" ReadMode - c <- hGetContents h - seq (length c) (return ()) - hClose h - putStr ("Datei im voreingestellten Modus: " ++ c) - - - - let str = "-äöü-" - putStrLn ("Haskell-Seite\n-------------"); - putStrLn ("str = \"" ++ str ++ "\"\nLänge = " ++ show (length str)) - - - putStrLn "\n1. withCString\n--------------" - putStr ("Per withCString an die C-Seite übergeben = ") - hFlush stdout - print_utf8 str - - putStrLn "\n2. pipe_to zu einer IO-Aktion\n-----------------------------" - pipe_to str lies_stdin - - putStrLn "\n2a. pipe_to zu einer IO-Aktion, im Binärmodus\n---------------------------------------------\n" - pipe_to str lies_stdin_binary - - putStrLn "\n3. h_pipe_to' zu einer IO-Aktion\n-------------------------------" - (h, pid) <- h_pipe_to' lies_stdin - hPutStr h str - hClose h - getProcessStatus True False pid - putStrLn "" - - - putStrLn "\n4. h_pipe_to' zu /bin/cat\n------------------------\n" - (h, pid) <- h_pipe_to' - (do exec "/bin/cat" []) - hPutStr h str - hClose h - getProcessStatus True False pid - putStrLn "" - - - putStrLn "\n5. pipes zu tmp/z\n--------------------\n" - (Just h, _, _, pid) <- pipes (do exec "./z" []) - True False False - hSetBinaryMode h False - hPutStr h str - hClose h - getProcessStatus True False pid - putStrLn "" - - - -h_pipe_to' :: IO a -- ^ Action to run as a separate process, and to pipe to - -> IO (Handle, ProcessID) -- ^ Returns handle connected to the standard input of the child process, and the child's process ID -h_pipe_to' io = do - (Just h, _, _, pid) <- pipes io True False False - return (h, pid) - - - -lies_stdin = do - hSetBinaryMode stdin False --XX - daten <- hGetContents stdin - putStrLn ("Angekommen: \"" ++ daten ++ "\", Länge = " ++ show (length daten)) - hFlush stdout - -lies_stdin_binary = do - hSetBinaryMode stdin True - daten <- hGetContents stdin - putStrLn ("Angekommen: \"" ++ daten ++ "\", Länge = " ++ show (length daten)) - hFlush stdout - - -puts_hs :: String -> IO () -puts_hs str = do - i <- withCString str $ \str -> {#call puts#} str - return () - -print_utf8 :: String -> IO () -print_utf8 str = do - i <- withCString str $ \str -> {#call print_utf8_c#} str - return () - - -#c - -#include - -void print_utf8_c(char* puf); - -#endc diff --git a/test/textmode.hs b/test/textmode.hs deleted file mode 100644 --- a/test/textmode.hs +++ /dev/null @@ -1,124 +0,0 @@ --- GENERATED by C->Haskell Compiler, version 0.16.2 Crystal Seed, 24 Jan 2009 (Haskell) --- Edit the ORIGNAL .chs file instead! - - -{-# LINE 1 "textmode.chs" #-}{- - * withCString konvertiert von Haskell (d.h. Unicode) nach UTF-8 (je nach Locale) - * puts aus der C-Bibliothek fügt einen Zeilenumbruch am Ende ein. --} - -import HsShellScript -import System.IO -import System.Posix.Process -import System.Posix.Types -import Foreign.C -import Foreign.Ptr - -main = mainwrapper $ do - - - h <- openFile "/home/v/src/hsskripte/tmp/txt" ReadMode - hSetBinaryMode h True - c <- hGetContents h - seq (length c) (return ()) - hClose h - putStr ("Datei im Binär-Modus: " ++ c) - - h <- openFile "/home/v/src/hsskripte/tmp/txt" ReadMode - hSetBinaryMode h False - c <- hGetContents h - seq (length c) (return ()) - hClose h - putStr ("Datei im Text-Modus: " ++ c) - - h <- openFile "/home/v/src/hsskripte/tmp/txt" ReadMode - c <- hGetContents h - seq (length c) (return ()) - hClose h - putStr ("Datei im voreingestellten Modus: " ++ c) - - - - let str = "-äöü-" - putStrLn ("Haskell-Seite\n-------------"); - putStrLn ("str = \"" ++ str ++ "\"\nLänge = " ++ show (length str)) - - - putStrLn "\n1. withCString\n--------------" - putStr ("Per withCString an die C-Seite übergeben = ") - hFlush stdout - print_utf8 str - - putStrLn "\n2. pipe_to zu einer IO-Aktion\n-----------------------------" - pipe_to str lies_stdin - - putStrLn "\n2a. pipe_to zu einer IO-Aktion, im Binärmodus\n---------------------------------------------\n" - pipe_to str lies_stdin_binary - - putStrLn "\n3. h_pipe_to' zu einer IO-Aktion\n-------------------------------" - (h, pid) <- h_pipe_to' lies_stdin - hPutStr h str - hClose h - getProcessStatus True False pid - putStrLn "" - - - putStrLn "\n4. h_pipe_to' zu /bin/cat\n------------------------\n" - (h, pid) <- h_pipe_to' - (do exec "/bin/cat" []) - hPutStr h str - hClose h - getProcessStatus True False pid - putStrLn "" - - - putStrLn "\n5. pipes zu tmp/z\n--------------------\n" - (Just h, _, _, pid) <- pipes (do exec "./z" []) - True False False - hSetBinaryMode h False - hPutStr h str - hClose h - getProcessStatus True False pid - putStrLn "" - - - -h_pipe_to' :: IO a -- ^ Action to run as a separate process, and to pipe to - -> IO (Handle, ProcessID) -- ^ Returns handle connected to the standard input of the child process, and the child's process ID -h_pipe_to' io = do - (Just h, _, _, pid) <- pipes io True False False - return (h, pid) - - - -lies_stdin = do - hSetBinaryMode stdin False --XX - daten <- hGetContents stdin - putStrLn ("Angekommen: \"" ++ daten ++ "\", Länge = " ++ show (length daten)) - hFlush stdout - -lies_stdin_binary = do - hSetBinaryMode stdin True - daten <- hGetContents stdin - putStrLn ("Angekommen: \"" ++ daten ++ "\", Länge = " ++ show (length daten)) - hFlush stdout - - -puts_hs :: String -> IO () -puts_hs str = do - i <- withCString str $ \str -> puts str - return () - -print_utf8 :: String -> IO () -print_utf8 str = do - i <- withCString str $ \str -> print_utf8_c str - return () - - - - -foreign import ccall safe "textmode.chs.h puts" - puts :: ((Ptr CChar) -> (IO CInt)) - -foreign import ccall safe "textmode.chs.h print_utf8_c" - print_utf8_c :: ((Ptr CChar) -> (IO ()))