pipes-shell (empty) → 0.1.0
raw patch · 5 files changed
+455/−0 lines, 5 filesdep +asyncdep +basedep +bytestringsetup-changed
Dependencies added: async, base, bytestring, hspec, pipes, pipes-bytestring, pipes-safe, process, stm, stm-chans, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- pipes-shell.cabal +107/−0
- src/Pipes/Shell.hs +315/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, kartoffelbrei++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of kartoffelbrei nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pipes-shell.cabal view
@@ -0,0 +1,107 @@+-- Initial pipes-shell.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: pipes-shell++version: 0.1.0++-- A short (one-line) description of the package.+synopsis: Create proper Pipes from System.Process++-- A longer description of the package.+description: This package provide functions to build proper Pipes from Unix shell commands like /tr/, /ls/ or /echo/ in a concise way.+ .+ Build with /cabal configure --enable-tests/ to build the little hspec test.++-- The license under which the package is released.+license: BSD3++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: kartoffelbrei++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer: kartoffelbrei.mit.muskatnuss@gmail.com++bug-reports: https://github.com/kbrei/pipes-shell/issues+++-- A copyright notice.+copyright: 2013 Lars Schulna++category: Pipes++build-type: Simple++-- Extra files to be distributed with the package, such as examples or a+-- README.+-- extra-source-files:++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/kbrei/pipes-shell.git++library+ -- Modules exported by the library.+ exposed-modules: Pipes.Shell++ -- Modules included in this library but not exported.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ -- Other library packages from which modules are imported.+ build-depends: base >=4.6 && <4.7,+ stm >=2.4 && <2.5,+ process >=1.1 && <1.2,+ pipes >= 4.0.1 && <5,+ pipes-safe >= 2.0.1 && <3,+ pipes-bytestring >= 1.0.1 && <2,+ text >= 0.11.3.0 && <0.12,+ bytestring >= 0.10.0.2 && <0.11,+ async >= 2.0.1.0 && <2.1,+ stm-chans >= 3.0.0 && <3.1++ -- Directories containing source files.+ hs-source-dirs: src++ -- Base language which the package is written in.+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs++ -- Modules included in this library but not exported.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ -- Other library packages from which modules are imported.+ build-depends: base >=4.6 && <4.7,+ stm >=2.4 && <2.5,+ process >=1.1 && <1.2,+ pipes >= 4.0.1 && <5,+ pipes-safe >= 2.0.1 && <3,+ pipes-bytestring >= 1.0.1 && <2,+ text >= 0.11.3.0 && <0.12,+ bytestring >= 0.10.0.2 && <0.11,+ async >= 2.0.1.0 && <2.1,+ stm-chans >= 3.0.0 && <3.1,+ hspec >= 1.7.2.0 && <1.8++ -- Directories containing source files.+ hs-source-dirs: src, test++ -- Base language which the package is written in.+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Pipes/Shell.hs view
@@ -0,0 +1,315 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}++-- | This module contains a few functions to use unix-y shell commands+-- as 'Pipe's.+--+-- The output 'ByteString's from 'pipeCmdEnv' and friends are not line-wise, but chunk-wise. To get proper lines use the pipes-binary and the upcoming pipes-text machinery.+--+-- All code examples in this module assume following qualified imports:+-- Pipes.Prelude as P, Pipes.ByteString as PBS, Data.ByteString.Char8 as BSC++module Pipes.Shell+ (++ -- * Basic combinators+ pipeCmdEnv, pipeCmd, pipeCmd'+ , producerCmdEnv, producerCmd, producerCmd'+ , consumerCmdEnv, consumerCmd++ -- * Fancy overloads+ , Cmd, Cmd'+ , cmdEnv, cmd, cmd'++ -- * Utils+ , (>?>)+ , markEnd+ , ignoreErr, ignoreOut+ , runShell+ ) where++import Control.Monad+import Pipes+import qualified Pipes.ByteString as PBS+import Pipes.Core+import qualified Pipes.Prelude as P+import Pipes.Safe hiding (handle)++import Control.Concurrent hiding (yield)+import Control.Concurrent.Async+import Control.Concurrent.STM+import Control.Concurrent.STM.TBMChan+import qualified System.IO as IO+import System.Process++import qualified Data.ByteString as BS++-- Fancy overloads++-- | An ad-hoc typeclass to get the varadic arguments and DWIM behavoir of 'cmdEnv'+class Cmd cmd where+ -- | Like 'pipeCmdEnv', 'producerCmdEnv' or 'consumerCmdEnv' depending on the context.+ -- It also supports varadic arguments.+ --+ -- Examples:+ --+ -- As 'Pipe':+ --+ -- >>> runShell $ yield (BSC.pack "aaa") >?> cmd "tr 'a' 'A'" >-> ignoreErr >-> PBS.stdout+ -- AAA+ --+ -- As 'Producer':+ --+ -- >>> runShell $ cmd "ls" >-> ignoreErr >-> PBS.stdout+ -- <output from ls on the current directory>+ --+ -- As 'Consumer':+ --+ -- >>> runShell $ yield (BSC.pack "aaa") >?> cmd "cat > test.file"+ -- <a new file with "aaa" in it>+ cmdEnv :: Maybe [(String,String)] -> String -> cmd++ -- | Like 'cmdEnv' but doesn't set enviorment varaibles+ cmd :: Cmd cmd => String -> cmd+ cmd = cmdEnv Nothing++instance Cmd cmd => Cmd (String -> cmd) where+ cmdEnv env' binary arg = cmdEnv env' $ binary ++ " " ++ arg++instance MonadSafe m =>+ Cmd (Pipe (Maybe BS.ByteString) (Either BS.ByteString BS.ByteString) m ()) where+ cmdEnv = pipeCmdEnv++instance MonadSafe m =>+ Cmd (Producer (Either BS.ByteString BS.ByteString) m ()) where+ cmdEnv = producerCmdEnv++instance MonadSafe m =>+ Cmd (Consumer (Maybe BS.ByteString) m ()) where+ cmdEnv = consumerCmdEnv+++-- | An ad-hoc typeclass to get the varadic arguments and DWIM behavoir of 'cmd''.+-- This class is seperate from 'Cmd' to make the return types work out.+class Cmd' cmd where+ -- | Like 'cmd' but uses 'ignoreErr' automatically.+ -- So it's like 'pipeCmd'', 'producerCmd'' or 'consumerCmd' depending on context.+ -- It supports the same style of varadic arguments as 'cmd'+ cmd' :: String -> cmd++instance Cmd' cmd => Cmd' (String -> cmd) where+ cmd' binary arg = cmd' $ binary ++ " " ++ arg++instance MonadSafe m =>+ Cmd' (Pipe (Maybe BS.ByteString) BS.ByteString m ()) where+ cmd' = pipeCmd'++instance MonadSafe m =>+ Cmd' (Producer BS.ByteString m ()) where+ cmd' = producerCmd'++instance MonadSafe m =>+ Cmd' (Consumer (Maybe BS.ByteString) m ()) where+ cmd' = consumerCmd+++-- Basic combinators++-- | This is the workhorse of this package.+--+-- It provides the direct interface from a shell command string to a proper+-- 'Pipe'.+--+-- >>> runShell $ yield (BSC.pack "aaa") >?> pipeCmdEnv Nothing "tr 'a' 'A'" >-> PBS.stdout+-- AAA+pipeCmdEnv :: MonadSafe m =>+ Maybe [(String,String)] ->+ String ->+ Pipe (Maybe BS.ByteString) (Either BS.ByteString BS.ByteString) m ()+pipeCmdEnv env' cmdStr = bracket (aquirePipe env' cmdStr) releasePipe $+ \(stdin, stdout, stderr) -> do++ chan <- liftIO $ newTBMChanIO 4+ _ <- liftIO $ forkIO $+ handlesToChan stdout stderr chan++ body stdin chan++ where+ body stdin chan = do+ got <- await+ case got of+ Nothing -> do+ liftIO $ IO.hClose stdin+ fromTBMChan chan+ Just val -> do+ liftIO $ BS.hPutStr stdin val+ yieldOne chan+ body stdin chan++ -- *try* to read one line from the chan and yield it.+ yieldOne chan = do+ mLine <- liftIO $ atomically $ tryReadTBMChan chan+ whenJust (join mLine)+ yield++ -- fill the TBMChan from the stdout and stderr handles+ -- the current implementation reads stderr and stdout async+ handlesToChan stdout stderr chan = do+ out <- async $ toTBMChan chan $ do+ PBS.fromHandle stdout >-> P.map Right+ liftIO $ IO.hClose stdout++ err <- async $ toTBMChan chan $ do+ PBS.fromHandle stderr >-> P.map Left+ liftIO $ IO.hClose stderr++ forM_ [out, err] wait++ atomically $ closeTBMChan chan++-- | Like 'pipeCmdEnv' but doesn't set enviorment varaibles+pipeCmd :: MonadSafe m =>+ String ->+ Pipe (Maybe BS.ByteString) (Either BS.ByteString BS.ByteString) m ()+pipeCmd = pipeCmdEnv Nothing++-- | Like 'pipeCmd' but ignores stderr+pipeCmd' :: MonadSafe m =>+ String ->+ Pipe (Maybe BS.ByteString) BS.ByteString m ()+pipeCmd' cmdStr = pipeCmd cmdStr >-> ignoreErr++-- | Like 'pipeCmdEnv' but closes the input end immediately.+--+-- Useful for command line tools like @ ls @+producerCmdEnv :: MonadSafe m =>+ Maybe [(String, String)] ->+ String ->+ Producer (Either BS.ByteString BS.ByteString) m ()+producerCmdEnv env' cmdStr = yield Nothing >-> pipeCmdEnv env' cmdStr++-- | Like 'producerCmdEnv' but doesn't set enviorment varaibles+producerCmd :: MonadSafe m =>+ String ->+ Producer (Either BS.ByteString BS.ByteString) m ()+producerCmd = producerCmdEnv Nothing++-- | Like 'producerCmd' but ignores stderr+producerCmd' :: MonadSafe m =>+ String ->+ Producer BS.ByteString m ()+producerCmd' cmdStr = producerCmd cmdStr >-> ignoreErr++-- | Like 'pipeCmd' but closes the output end immediately.+--+-- Useful for command line tools like @ cat > test.file @+consumerCmdEnv:: MonadSafe m =>+ Maybe [(String,String)] ->+ String ->+ Consumer (Maybe BS.ByteString) m ()+consumerCmdEnv env' cmdStr = pipeCmdEnv env' cmdStr >-> void await++-- | Like 'consumerCmdEnv' but doesn't set enviorment varaibles+consumerCmd:: MonadSafe m =>+ String ->+ Consumer (Maybe BS.ByteString) m ()+consumerCmd = consumerCmdEnv Nothing+++-- Utils++-- | Like '>->' but marks the end of the left pipe with 'markEnd'.+-- It's needed because 'pipeCmdEnv' has to know when the upstream 'Pipe' finishes.+--+-- The basic rule is:+--+-- @ Replace every '>->' with '>?>' when it's in front of 'pipeCmdEnv' or similar. @+(>?>) :: Monad m =>+ Proxy a' a () b m r ->+ Proxy () (Maybe b) c' c m r ->+ Proxy a' a c' c m r+a >?> b = markEnd a >-> b+infixl 7 >?>++-- | Mark the end of a pipe.+-- It wraps all values in a 'Just' and yields *one* 'Nothing' after the upstream pipefinished.+markEnd :: Monad m =>+ Proxy a' a b' b m r ->+ Proxy a' a b' (Maybe b) m r+markEnd pipe = do+ result <- for pipe (respond . Just)+ _ <- respond Nothing+ return result++-- | Ignore stderr from a 'pipeCmd'+ignoreErr :: (Monad m) => Pipe (Either BS.ByteString BS.ByteString) BS.ByteString m ()+ignoreErr = forever $ do+ val <- await+ case val of+ Left _ -> return ()+ Right x -> yield x++-- | Ignore stdout from a 'pipeCmd'+ignoreOut :: (Monad m) => Pipe (Either BS.ByteString BS.ByteString) BS.ByteString m ()+ignoreOut = forever $ do+ val <- await+ case val of+ Left x -> yield x+ Right _ -> return ()++-- | A simple run function for 'Pipe's that live in 'SafeT' 'IO'+runShell :: Effect (SafeT IO) r -> IO r+runShell = runSafeT . runEffect++++-- Implementation utils++whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+whenJust (Just x) action = action x+whenJust Nothing _ = return ()++fromTBMChan :: (MonadIO m) => TBMChan a -> Producer' a m ()+fromTBMChan chan = do+ msg <- liftIO $ atomically $ readTBMChan chan+ whenJust msg $ \m -> do+ yield m+ fromTBMChan chan++toTBMChan :: MonadIO m => TBMChan a -> Producer' a m () -> m ()+toTBMChan chan prod = runEffect $+ for prod (liftIO . atomically . writeTBMChan chan)++-- | Creates the pipe handles+aquirePipe :: MonadIO m =>+ Maybe [(String, String)] ->+ String ->+ m (IO.Handle, IO.Handle, IO.Handle)+aquirePipe env' cmdStr = liftIO $ do+ (Just stdin, Just stdout, Just stderr, _) <- createProcess (shellPiped env' cmdStr)+ return (stdin, stdout, stderr)++-- | Releases the pipe handles+releasePipe :: MonadIO m => (IO.Handle, IO.Handle, IO.Handle) -> m ()+releasePipe (stdin, stdout, stderr) = liftIO $ do+ IO.hClose stdin+ IO.hClose stdout+ IO.hClose stderr++-- | Helper function to create the shell pipe handles+shellPiped :: Maybe [(String, String)] -> String -> CreateProcess+shellPiped env' cmdStr = CreateProcess+ { cmdspec = ShellCommand cmdStr+ , cwd = Nothing+ , env = env'+ , std_in = CreatePipe+ , std_out = CreatePipe+ , std_err = CreatePipe+ , close_fds = False+ , create_group = False+ }
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}