diff --git a/HSH.cabal b/HSH.cabal --- a/HSH.cabal +++ b/HSH.cabal @@ -1,5 +1,5 @@ Name: HSH -Version: 1.2.5 +Version: 1.2.6 License: LGPL Maintainer: John Goerzen Author: John Goerzen @@ -15,13 +15,16 @@ to and from other shell commands and arbitrary Haskell functions at will. Exposed-Modules: HSH, HSH.Command, HSH.ShellEquivs Extensions: ExistentialQuantification, OverlappingInstances, - UndecidableInstances -Build-Depends: base, unix, mtl, regex-compat, MissingH>=1.0.0, hslogger, filepath, regex-base, regex-posix, directory + UndecidableInstances, FlexibleContexts +Build-Depends: base, unix, mtl, regex-compat, MissingH>=1.0.0, + hslogger, filepath, regex-base, regex-posix, directory, bytestring GHC-Options: -O2 -threaded -Wall Category: System +Build-type: Simple Executable: runtests Buildable: False Main-Is: runtests.hs HS-Source-Dirs: testsrc -Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances +Extensions: ExistentialQuantification, OverlappingInstances, + UndecidableInstances, FlexibleContexts diff --git a/HSH/Command.hs b/HSH/Command.hs --- a/HSH/Command.hs +++ b/HSH/Command.hs @@ -46,12 +46,15 @@ import Text.Regex.Posix import Control.Monad(when) import Data.String.Utils(rstrip) +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString as BS d, dr :: String -> IO () d = debugM "HSH.Command" dr = debugM "HSH.Command.Run" -{- | Result type for shell commands -} +{- | Result type for shell commands. The String is the text description of +the command, not its output. -} type InvokeResult = (String, IO ProcessStatus) {- | A shell command is something we can invoke, pipe to, pipe from, @@ -73,9 +76,55 @@ show _ = "(String -> String)" instance Show (String -> IO String) where show _ = "(String -> IO String)" +instance Show (BSL.ByteString -> BSL.ByteString) where + show _ = "(Data.ByteString.Lazy.ByteString -> Data.ByteString.Lazy.ByteString)" +instance Show (BSL.ByteString -> IO BSL.ByteString) where + show _ = "(Data.ByteString.Lazy.ByteString -> IO Data.ByteString.Lazy.ByteString)" +instance Show (BS.ByteString -> BS.ByteString) where + show _ = "(Data.ByteString.ByteString -> Data.ByteString.ByteString)" +instance Show (BS.ByteString -> IO BS.ByteString) where + show _ = "(Data.ByteString.ByteString -> IO Data.ByteString.ByteString)" instance ShellCommand (String -> IO String) where - fdInvoke func fstdin fstdout childclosefds childfunc = + fdInvoke = genericStringlikeIO hGetContents hPutStr + +instance ShellCommand (BSL.ByteString -> IO BSL.ByteString) where + fdInvoke = genericStringlikeIO BSL.hGetContents BSL.hPut + +instance ShellCommand (BS.ByteString -> IO BS.ByteString) where + fdInvoke = genericStringlikeIO BS.hGetContents BS.hPut + +{- | An instance of 'ShellCommand' for a pure Haskell function mapping +String to String. Implement in terms of (String -> IO String) for +simplicity. -} +instance ShellCommand (String -> String) where + fdInvoke func = + fdInvoke iofunc + where iofunc :: String -> IO String + iofunc = return . func + +instance ShellCommand (BSL.ByteString -> BSL.ByteString) where + fdInvoke func = + fdInvoke iofunc + where iofunc :: BSL.ByteString -> IO BSL.ByteString + iofunc = return . func + +instance ShellCommand (BS.ByteString -> BS.ByteString) where + fdInvoke func = + fdInvoke iofunc + where iofunc :: BS.ByteString -> IO BS.ByteString + iofunc = return . func + +genericStringlikeIO :: (Show (a -> IO a)) => + (Handle -> IO a) + -> (Handle -> a -> IO ()) + -> (a -> IO a) + -> Fd + -> Fd + -> [Fd] + -> (IO ()) + -> IO [InvokeResult] +genericStringlikeIO getcontentsfunc hputstrfunc func fstdin fstdout childclosefds childfunc = do -- d $ "SIOSF: Before fork" p <- try (forkProcess childstuff) pid <- case p of @@ -95,11 +144,11 @@ d $ "SIOSFC Running child func" childfunc d $ "SIOSFC Running func in child" - contents <- hGetContents hr + contents <- getcontentsfunc hr d $ "SIOSFC Contents read" result <- func contents d $ "SIOSFC Func applied" - hPutStr hw result + hputstrfunc hw result d $ "SIOSFC Func done, closing handles." hClose hr hClose hw @@ -107,15 +156,6 @@ -- It hung here without the exitImmediately --exitImmediately ExitSuccess -{- | An instance of 'ShellCommand' for a pure Haskell function mapping -String to String. Implement in terms of (String -> IO String) for -simplicity. -} -instance ShellCommand (String -> String) where - fdInvoke func fstdin fstdout childclosefds childfunc = - fdInvoke iofunc fstdin fstdout childclosefds childfunc - where iofunc :: String -> IO String - iofunc = return . func - instance Show ([String] -> [String]) where show _ = "([String] -> [String])" instance Show ([String] -> IO [String]) where @@ -225,9 +265,10 @@ * IO () runs, throws an exception on error, and sends stdout to stdout * IO String runs, throws an exception on error, reads stdout into - a buffer, and returns it as a string. + a buffer, and returns it as a string. Note: This output is not lazy. - * IO [String] is same as IO String, but returns the results as lines + * IO [String] is same as IO String, but returns the results as lines. + Note: this output is not lazy. * IO ProcessStatus runs and returns a ProcessStatus with the exit information. stdout is sent to stdout. Exceptions are not thrown. @@ -236,12 +277,17 @@ includes a description of the last command in the pipe to have an error (or the last command, if there was no error) + * IO ByteString and IO (ByteString, ProcessStatus) are similar to their + String counterparts. + * IO Int returns the exit code from a program directly. If a signal caused the command to be reaped, returns 128 + SIGNUM. * IO Bool returns True if the program exited normally (exit code 0, not stopped by a signal) and False otherwise. +To address insufficient laziness, you can process anything that needs to be +processed lazily within the pipeline itself. -} class RunResult a where {- | Runs a command (or pipe of commands), with results presented @@ -276,7 +322,25 @@ return (lines r) instance RunResult (IO String) where - run cmd = + run cmd = genericStringlikeResult hGetContents (\c -> evaluate (length c)) + cmd + +instance RunResult (IO BSL.ByteString) where + run cmd = genericStringlikeResult BSL.hGetContents + (\c -> evaluate (BSL.length c)) + cmd + +instance RunResult (IO BS.ByteString) where + run cmd = genericStringlikeResult BS.hGetContents + (\c -> evaluate (BS.length c)) + cmd + +genericStringlikeResult :: ShellCommand b => + (Handle -> IO a) + -> (a -> IO c) + -> b + -> IO a +genericStringlikeResult hgetcontentsfunc evalfunc cmd = do (pread, pwrite) <- createPipe -- d $ "runS: new pipe endpoints: " ++ show [pread, pwrite] -- d "runS 1" @@ -286,9 +350,10 @@ -- d "runS 3" hread <- fdToHandle pread -- d "runS 4" - c <- hGetContents hread + c <- hgetcontentsfunc hread -- d "runS 5" - evaluate (length c) + evalfunc c + --evaluate (length c) -- d "runS 6" hClose hread -- d "runS 7" diff --git a/HSH/ShellEquivs.hs b/HSH/ShellEquivs.hs --- a/HSH/ShellEquivs.hs +++ b/HSH/ShellEquivs.hs @@ -26,12 +26,15 @@ basename, bracketCD, catFrom, + catFromBS, catTo, + catToBS, cd, cut, cutR, dirname, echo, + echoBS, exit, glob, grep, @@ -52,6 +55,7 @@ unspace, tac, tee, + teeBS, tr, trd, wcW, @@ -73,6 +77,7 @@ import System.Path (absNormPath, bracketCWD) import System.Exit import qualified System.Path.Glob as Glob (glob) +import qualified Data.ByteString.Lazy as BSL {- | Return the absolute path of the arg. Raises an error if the computation is impossible. -} @@ -108,24 +113,41 @@ Unlike the shell cat, @-@ may be given twice. However, if it is, you will be forcing Haskell to buffer the input. -Note: buffering behavior here is untested. -} +Note: buffering behavior here is untested. + +See also 'catFromBS'. -} catFrom :: [FilePath] -> String -> IO String -catFrom fplist inp = - do r <- foldM foldfunc "" fplist +catFrom = genericCatFrom readFile (++) "" + +{- | Lazy ByteString version of 'catFrom'. This may have performance +benefits. -} +catFromBS :: [FilePath] -> BSL.ByteString -> IO BSL.ByteString +catFromBS = genericCatFrom BSL.readFile BSL.append BSL.empty + +genericCatFrom :: (FilePath -> IO a) -> (a -> a -> a) -> a -> [FilePath] -> a -> IO a +genericCatFrom readfilefunc appendfunc empty fplist inp = + do r <- foldM foldfunc empty fplist return r where foldfunc accum fp = case fp of - "-" -> return (accum ++ inp) - fn -> do c <- readFile fn - return (accum ++ c) + "-" -> return (appendfunc accum inp) + fn -> do c <- readfilefunc fn + return (appendfunc accum c) {- | Takes input, writes it to the specified file, and does not pass it on. - See also 'tee'. -} + The return value is the empty string. See also 'catToBS', 'tee'. -} catTo :: FilePath -> String -> IO String catTo fp inp = do writeFile fp inp return "" +{- | Like 'catTo', but operates in a lazy ByteString. This could be a +performance benefit. -} +catToBS :: FilePath -> BSL.ByteString -> IO BSL.ByteString +catToBS fp inp = + do BSL.writeFile fp inp + return (BSL.empty) + {- | Like 'catTo', but appends to the file. -} appendTo :: FilePath -> String -> IO String appendTo fp inp = @@ -164,10 +186,16 @@ {- | Takes a string and sends it on as standard output. -The input to this function is never read. -} +The input to this function is never read. + +See also 'echoBS'. -} echo :: String -> String -> String echo inp _ = inp +{- | ByteString.Lazy version of 'echo'. -} +echoBS :: BSL.ByteString -> BSL.ByteString -> BSL.ByteString +echoBS inp _ = inp + {- | Search for the regexp in the lines. Return those that match. -} egrep :: String -> [String] -> [String] egrep pat = filter (ismatch regex) @@ -290,10 +318,15 @@ {- | Takes input, writes it to all the specified files, and passes it on. This function buffers the input. -See also 'catFrom'. -} +See also 'teeBS', 'catFrom'. -} tee :: [FilePath] -> String -> IO String tee [] inp = return inp tee (x:xs) inp = writeFile x inp >> tee xs inp + +{- | Lazy ByteString version of 'tee'. -} +teeBS :: [FilePath] -> BSL.ByteString -> IO BSL.ByteString +teeBS [] inp = return inp +teeBS (x:xs) inp = BSL.writeFile x inp >> teeBS xs inp {- | Translate a character x to y, like: