process-listlike (empty) → 0.6
raw patch · 11 files changed
+502/−0 lines, 11 filesdep +HUnitdep +ListLikedep +basesetup-changed
Dependencies added: HUnit, ListLike, base, bytestring, listlike-instances, process, process-listlike, text, unix, utf8-string
Files
- LICENSE +19/−0
- Setup.hs +18/−0
- System/Process/ByteString.hs +22/−0
- System/Process/ByteString/Lazy.hs +22/−0
- System/Process/Read.hs +10/−0
- System/Process/Read/Chars.hs +190/−0
- System/Process/Read/Instances.hs +43/−0
- System/Process/Text.hs +22/−0
- System/Process/Text/Lazy.hs +22/−0
- Tests/Main.hs +79/−0
- process-listlike.cabal +55/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2012 David Lazar <lazar6@illinois.edu>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,18 @@+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir))+import Distribution.Simple.Program+import System.Cmd+import System.Exit++main = defaultMainWithHooks simpleUserHooks {+ postBuild =+ \ _ _ _ lbi ->+ case buildDir lbi of+ "dist-ghc/build" -> return ()+ _ -> runTestScript lbi+ , runTests = \ _ _ _ lbi -> runTestScript lbi+ }++runTestScript lbi =+ system (buildDir lbi ++ "/tests/tests") >>= \ code ->+ if code == ExitSuccess then return () else error "unit test failure"
+ System/Process/ByteString.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module System.Process.ByteString+ ( readProcess+ , readProcessWithExitCode+ , readCreateProcess+ , readCreateProcessWithExitCode+ ) where++import Data.ByteString.Char8 (ByteString)+import System.Exit (ExitCode)+import System.Process (CreateProcess)+import qualified System.Process.Read as R++readProcess :: (a ~ ByteString) => FilePath -> [String] -> a -> IO a+readProcess = R.readProcess+readProcessWithExitCode :: (a ~ ByteString) => FilePath -> [String] -> a -> IO (ExitCode, a, a)+readProcessWithExitCode = R.readProcessWithExitCode+readCreateProcess :: (a ~ ByteString) => CreateProcess -> a -> IO a+readCreateProcess = R.readCreateProcess+readCreateProcessWithExitCode :: (a ~ ByteString) => CreateProcess -> a -> IO (ExitCode, a, a)+readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
+ System/Process/ByteString/Lazy.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module System.Process.ByteString.Lazy+ ( readProcess+ , readProcessWithExitCode+ , readCreateProcess+ , readCreateProcessWithExitCode+ ) where++import Data.ByteString.Lazy.Char8 (ByteString)+import System.Exit (ExitCode)+import System.Process (CreateProcess)+import qualified System.Process.Read as R++readProcess ::(a ~ ByteString) => FilePath -> [String] -> a -> IO a+readProcess = R.readProcess+readProcessWithExitCode ::(a ~ ByteString) => FilePath -> [String] -> a -> IO (ExitCode, a, a)+readProcessWithExitCode = R.readProcessWithExitCode+readCreateProcess ::(a ~ ByteString) => CreateProcess -> a -> IO a+readCreateProcess = R.readCreateProcess+readCreateProcessWithExitCode ::(a ~ ByteString) => CreateProcess -> a -> IO (ExitCode, a, a)+readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
+ System/Process/Read.hs view
@@ -0,0 +1,10 @@+module System.Process.Read+ ( ListLikePlus(..)+ , readCreateProcessWithExitCode+ , readCreateProcess+ , readProcessWithExitCode+ , readProcess+ ) where++import System.Process.Read.Chars+import System.Process.Read.Instances ()
+ System/Process/Read/Chars.hs view
@@ -0,0 +1,190 @@+-- | Versions of the functions in module 'System.Process.Read' specialized for type ByteString.+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies #-}+module System.Process.Read.Chars (+ ListLikePlus(..),+ readCreateProcessWithExitCode,+ readCreateProcess,+ readProcessWithExitCode,+ readProcess,+ ) where++import Control.Concurrent+import Control.Exception as E (SomeException, onException, evaluate, catch, try, throwIO, mask)+import Control.Monad+import Data.ListLike (ListLike(..), ListLikeIO(..))+import Data.ListLike.Text.Text ()+import Data.ListLike.Text.TextLazy ()+import GHC.IO.Exception (IOErrorType(OtherError, ResourceVanished), IOException(ioe_type))+import Prelude hiding (null, length)+import System.Exit (ExitCode(ExitSuccess, ExitFailure))+import System.IO hiding (hPutStr, hGetContents)+import qualified System.IO.Error as IO+import System.Process (CreateProcess(..), StdStream(CreatePipe, Inherit), proc,+ CmdSpec(RawCommand, ShellCommand), showCommandForUser,+ createProcess, waitForProcess, terminateProcess)++-- | Class of types which can be used as the input and outputs of the process functions.+class (Integral (LengthType a), ListLikeIO a c) => ListLikePlus a c where+ type LengthType a+ binary :: a -> [Handle] -> IO ()+ -- ^ This should call 'hSetBinaryMode' on each handle if a is a+ -- ByteString type, so that it doesn't attempt to decode the text+ -- using the current locale.+ lazy :: a -> Bool+ length' :: a -> LengthType a++-- | A polymorphic implementation of+-- 'System.Process.readProcessWithExitCode' with a few+-- generalizations:+--+-- 1. The input and outputs can be any instance of 'ListLikePlus'.+--+-- 2. Allows you to modify the 'CreateProcess' record before the process starts+--+-- 3. Takes a 'CmdSpec', so you can launch either a 'RawCommand' or a 'ShellCommand'.+readCreateProcessWithExitCode+ :: forall a c.+ ListLikePlus a c =>+ CreateProcess -- ^ process to run+ -> a -- ^ standard input+ -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr, exception+readCreateProcessWithExitCode p input = mask $ \restore -> do+ (Just inh, Just outh, Just errh, pid) <-+ createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe })++ flip onException+ (do hClose inh; hClose outh; hClose errh;+ terminateProcess pid; waitForProcess pid) $ restore $ do+ (out, err) <- (if lazy input then readLazy else readStrict) inh outh errh++ hClose outh+ hClose errh++ -- wait on the process+ ex <- waitForProcess pid++ return (ex, out, err)+ where+ readLazy :: Handle -> Handle -> Handle -> IO (a, a)+ readLazy inh outh errh =+ do out <- hGetContents outh+ waitOut <- forkWait $ void $ force $ out+ err <- hGetContents errh+ waitErr <- forkWait $ void $ force $ err+ -- now write and flush any input+ writeInput inh+ -- wait on the output+ waitOut+ waitErr+ return (out, err)++ readStrict :: Handle -> Handle -> Handle -> IO (a, a)+ readStrict inh outh errh =+ do -- fork off a thread to start consuming stdout+ waitOut <- forkWait $ hGetContents outh+ -- fork off a thread to start consuming stderr+ waitErr <- forkWait $ hGetContents errh+ -- now write and flush any input+ writeInput inh+ -- wait on the output+ out <- waitOut+ err <- waitErr+ return (out, err)++ writeInput :: Handle -> IO ()+ writeInput inh = do+ (do unless (null input) (hPutStr inh input >> hFlush inh)+ hClose inh) `E.catch` resourceVanished (\ _ -> return ())++-- | A polymorphic implementation of+-- 'System.Process.readProcessWithExitCode' in terms of+-- 'readCreateProcessWithExitCode'.+readProcessWithExitCode+ :: ListLikePlus a c =>+ FilePath -- ^ command to run+ -> [String] -- ^ any arguments+ -> a -- ^ standard input+ -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr+readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input++-- | Implementation of 'System.Process.readProcess' in terms of+-- 'readCreateProcess'.+readProcess+ :: ListLikePlus a c =>+ FilePath -- ^ command to run+ -> [String] -- ^ any arguments+ -> a -- ^ standard input+ -> IO a -- ^ stdout+readProcess cmd args = readCreateProcess (proc cmd args)++-- | A polymorphic implementation of 'System.Process.readProcess' with a few generalizations:+--+-- 1. The input and outputs can be any instance of 'ListLikePlus'.+--+-- 2. Allows you to modify the 'CreateProcess' record before the process starts+--+-- 3. Takes a 'CmdSpec', so you can launch either a 'RawCommand' or a 'ShellCommand'.+readCreateProcess+ :: ListLikePlus a c =>+ CreateProcess -- ^ process to run+ -> a -- ^ standard input+ -> IO a -- ^ stdout+readCreateProcess p input = mask $ \restore -> do+ (Just inh, Just outh, _, pid) <-+ createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit })++ flip onException+ (do hClose inh; hClose outh;+ terminateProcess pid; waitForProcess pid) $ restore $ do+ out <- (if lazy input then readLazy else readStrict) inh outh++ hClose outh++ -- wait on the process+ ex <- waitForProcess pid++ case ex of+ ExitSuccess -> return out+ ExitFailure r -> ioError (mkError "readCreateProcess: " (cmdspec p) r)+ where+ readLazy inh outh =+ do -- fork off a thread to start consuming stdout+ out <- hGetContents outh+ waitOut <- forkWait $ void $ force $ out+ writeInput inh+ waitOut+ return out++ readStrict inh outh =+ do waitOut <- forkWait $ hGetContents outh+ writeInput inh+ waitOut++ writeInput inh = do+ (do unless (null input) (hPutStr inh input >> hFlush inh)+ hClose inh) `E.catch` resourceVanished (\ _ -> return ())++forkWait :: IO a -> IO (IO a)+forkWait a = do+ res <- newEmptyMVar+ _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res+ return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)++-- | Wrapper for a process that provides a handler for the+-- ResourceVanished exception. This is frequently an exception we+-- wish to ignore, because many processes will deliberately exit+-- before they have read all of their input.+resourceVanished :: (IOError -> IO a) -> IOError -> IO a+resourceVanished epipe e = if ioe_type e == ResourceVanished then epipe e else ioError e++-- | Create an exception for a process that exited abnormally.+mkError :: String -> CmdSpec -> Int -> IOError+mkError prefix (RawCommand cmd args) r =+ IO.mkIOError OtherError (prefix ++ showCommandForUser cmd args ++ " (exit " ++ show r ++ ")")+ Nothing Nothing+mkError prefix (ShellCommand cmd) r =+ IO.mkIOError OtherError (prefix ++ cmd ++ " (exit " ++ show r ++ ")")+ Nothing Nothing++force :: forall a c. ListLikePlus a c => a -> IO (LengthType a)+force x = evaluate $ length' $ x
+ System/Process/Read/Instances.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module System.Process.Read.Instances where++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.Int (Int64)+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Data.Word (Word8)+import Prelude hiding (catch)+import System.IO (hSetBinaryMode)+import System.Process.Read.Chars (ListLikePlus(..))++instance ListLikePlus String Char where+ type LengthType String = Int+ binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles (because internally this uses lazy bytestrings)+ lazy _ = True+ length' = length++instance ListLikePlus B.ByteString Word8 where+ type LengthType B.ByteString = Int+ binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles+ lazy _ = False+ length' = B.length++instance ListLikePlus L.ByteString Word8 where+ type LengthType L.ByteString = Int64+ binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles+ lazy _ = True+ length' = L.length++instance ListLikePlus T.Text Char where+ type LengthType T.Text = Int+ binary _ _ = return ()+ lazy _ = False+ length' = T.length++instance ListLikePlus LT.Text Char where+ type LengthType LT.Text = Int64+ binary _ _ = return ()+ lazy _ = True+ length' = LT.length
+ System/Process/Text.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module System.Process.Text+ ( readProcess+ , readProcessWithExitCode+ , readCreateProcess+ , readCreateProcessWithExitCode+ ) where++import Data.Text (Text)+import System.Exit (ExitCode)+import System.Process (CreateProcess)+import qualified System.Process.Read as R++readProcess :: (a ~ Text) => FilePath -> [String] -> a -> IO a+readProcess = R.readProcess+readProcessWithExitCode :: (a ~ Text) => FilePath -> [String] -> a -> IO (ExitCode, a, a)+readProcessWithExitCode = R.readProcessWithExitCode+readCreateProcess :: (a ~ Text) => CreateProcess -> a -> IO a+readCreateProcess = R.readCreateProcess+readCreateProcessWithExitCode :: (a ~ Text) => CreateProcess -> a -> IO (ExitCode, a, a)+readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
+ System/Process/Text/Lazy.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module System.Process.Text.Lazy+ ( readProcess+ , readProcessWithExitCode+ , readCreateProcess+ , readCreateProcessWithExitCode+ ) where++import Data.Text.Lazy (Text)+import System.Exit (ExitCode)+import System.Process (CreateProcess)+import qualified System.Process.Read as R++readProcess :: (a ~ Text) => FilePath -> [String] -> a -> IO a+readProcess = R.readProcess+readProcessWithExitCode :: (a ~ Text) => FilePath -> [String] -> a -> IO (ExitCode, a, a)+readProcessWithExitCode = R.readProcessWithExitCode+readCreateProcess :: (a ~ Text) => CreateProcess -> a -> IO a+readCreateProcess = R.readCreateProcess+readCreateProcessWithExitCode :: (a ~ Text) => CreateProcess -> a -> IO (ExitCode, a, a)+readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
+ Tests/Main.hs view
@@ -0,0 +1,79 @@+module Main where++import Codec.Binary.UTF8.String (encode)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.ListLike (ListLike(..))+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Prelude hiding (length, concat)+import System.Exit+import System.Posix.Files (getFileStatus, fileMode, setFileMode, unionFileModes, ownerExecuteMode, groupExecuteMode, otherExecuteMode)+import System.Process (proc)+import System.Process.Read (readProcessWithExitCode, readCreateProcessWithExitCode, readCreateProcess, ListLikePlus(..))+import Test.HUnit hiding (path)++fromString :: String -> B.ByteString+fromString = fromList . encode++lazyFromString :: String -> L.ByteString+lazyFromString = L.fromChunks . (: []) . fromString++main :: IO ()+main =+ do chmod "Tests/Test1.hs"+ chmod "Tests/Test2.hs"+ chmod "Tests/Test4.hs"+ (c,st) <- runTestText putTextToShowS test1 -- (TestList (versionTests ++ sourcesListTests ++ dependencyTests ++ changesTests))+ putStrLn (st "")+ case (failures c) + (errors c) of+ 0 -> return ()+ _ -> exitFailure++chmod :: FilePath -> IO ()+chmod path =+ getFileStatus "Tests/Test1.hs" >>= \ status ->+ setFileMode path (foldr unionFileModes (fileMode status) [ownerExecuteMode, groupExecuteMode, otherExecuteMode])++test1 :: Test+test1 =+ TestLabel "test1"+ (TestList+ [ TestLabel "ByteString" $+ TestCase (do b <- readProcessWithExitCode "Tests/Test1.hs" [] B.empty+ assertEqual "ByteString" (ExitFailure 123, fromString "", fromString "This is an error message.\n") b)+ , TestLabel "Lazy" $+ TestCase (do l <- readProcessWithExitCode "Tests/Test1.hs" [] L.empty+ assertEqual "Lazy ByteString" (ExitFailure 123, lazyFromString "", lazyFromString "This is an error message.\n") l)+ , TestLabel "Text" $+ TestCase (do t <- readProcessWithExitCode "Tests/Test1.hs" [] T.empty+ assertEqual "Text" (ExitFailure 123, T.pack "", T.pack "This is an error message.\n") t)+ , TestLabel "LazyText" $+ TestCase (do lt <- readProcessWithExitCode "Tests/Test1.hs" [] LT.empty+ assertEqual "LazyText" (ExitFailure 123, LT.pack "", LT.pack "This is an error message.\n") lt)+ , TestLabel "String" $+ TestCase (do s <- readProcessWithExitCode "Tests/Test1.hs" [] ""+ assertEqual "String" (ExitFailure 123, "", "This is an error message.\n") s)+ , TestLabel "pnmfile" $+ TestCase (do out <- B.readFile "Tests/penguin.jpg" >>=+ readCreateProcess (proc "djpeg" []) >>=+ readCreateProcess (proc "pnmfile" [])+ assertEqual "pnmfile" (fromString "stdin:\tPPM raw, 96 by 96 maxval 255\n") out)+ , TestLabel "pnmfile2" $+ TestCase (do jpg <- B.readFile "Tests/penguin.jpg"+ (code1, pnm, err1) <- readCreateProcessWithExitCode (proc "djpeg" []) jpg+ out2 <- readCreateProcess (proc "pnmfile" []) pnm+ assertEqual "pnmfile2" (ExitSuccess, empty, 2192, 27661, fromString "stdin:\tPPM raw, 96 by 96 maxval 255\n") (code1, err1, length' jpg, length' pnm, out2))+ , TestLabel "file closed 1" $+ TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) (fromString "a" :: B.ByteString)+ assertEqual "file closed 1" (ExitSuccess, (fromString "a"), (fromString "Read one character: 'a'\n")) result)+ , TestLabel "file closed 2" $+ TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) (lazyFromString "" :: L.ByteString)+ assertEqual "file closed 2" (ExitFailure 1, empty, (lazyFromString "Test4.hs: <stdin>: hGetChar: end of file\n")) result)+ , TestLabel "file closed 3" $+ TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) "abcde"+ assertEqual "file closed 3" (ExitSuccess, "a", "Read one character: 'a'\n") result)+ , TestLabel "file closed 4" $+ TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) "abcde"+ assertEqual "file closed 4" (ExitSuccess, "a", "Read one character: 'a'\n") result)+ ])
+ process-listlike.cabal view
@@ -0,0 +1,55 @@+Name: process-listlike+Version: 0.6+Synopsis: Enhanced version of process-extras+Description: Extra functionality for the Process library+ <http://hackage.haskell.org/package/process>.+Homepage: http://src.seereason.com/process-listlike+License: MIT+License-file: LICENSE+Author: David Lazar, Bas van Dijk, David Fox+Maintainer: David Fox <dsf@seereason.com>+Category: System+Build-type: Simple+Cabal-version: >=1.8++source-repository head+ Type: darcs+ Location: http://src.seereason.com/process-extras++Library+ ghc-options: -Wall -O2++ Exposed-modules:+ System.Process.Read+ System.Process.Read.Chars+ System.Process.Read.Instances+ System.Process.ByteString+ System.Process.ByteString.Lazy+ System.Process.Text+ System.Process.Text.Lazy++ Build-depends:+ base >= 4 && < 5,+ process,+ bytestring,+ HUnit,+ ListLike,+ listlike-instances,+ process,+ text,+ utf8-string++Executable tests+ Main-Is: Tests/Main.hs+ GHC-Options: -Wall -O2 -threaded -rtsopts+ Build-Depends:+ base >= 4 && < 5,+ bytestring,+ HUnit,+ ListLike,+ listlike-instances,+ process,+ process-listlike,+ text,+ utf8-string,+ unix