packages feed

shell-conduit (empty) → 0.0

raw patch · 9 files changed

+672/−0 lines, 9 filesdep +basedep +bytestringdep +conduitsetup-changed

Dependencies added: base, bytestring, conduit, conduit-extra, control-monad-loop, directory, filepath, monad-control, monads-tf, process, resourcet, split, template-haskell, text, transformers, transformers-base

Files

+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2014, shell-conduit+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 shell-conduit nor the+      names of its 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 <COPYRIGHT HOLDER> 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
+ shell-conduit.cabal view
@@ -0,0 +1,38 @@+name:                shell-conduit+version:             0.0+synopsis:            Write shell scripts with Conduit+description:         Write shell scripts with Conduit. See "Data.Conduit.Shell" for documentation.+license:             BSD3+license-file:        LICENSE+author:              Chris Done+maintainer:          chrisdone@gmail.com+copyright:           2014 Chris Done+category:            Conduit, Scripting+build-type:          Simple+cabal-version:       >=1.8++library+  hs-source-dirs:    src/+  ghc-options:       -Wall -O2+  exposed-modules:   Data.Conduit.Shell+                     Data.Conduit.Shell.PATH+                     Data.Conduit.Shell.TH+                     Data.Conduit.Shell.Process+                     Data.Conduit.Shell.Types+                     Data.Conduit.Shell.Variadic+  build-depends:     base >= 4 && <5+                   , bytestring+                   , conduit+                   , conduit-extra+                   , control-monad-loop+                   , directory+                   , filepath+                   , monad-control+                   , monads-tf+                   , process+                   , resourcet+                   , split+                   , template-haskell+                   , transformers+                   , transformers-base+                   , text
+ src/Data/Conduit/Shell.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE NoMonomorphismRestriction #-}++-- | Shell scripting with Conduit+--+-- This module consists only of re-exports, including a few thousand+-- top-level names based on @PATH@. If you don't want that, you can+-- cherry-pick specific modules to import from the library.+--+-- See "Data.Conduit.Shell.PATH" for all binaries. But you should be+-- able to use whatever executables are in your @PATH@ when the library+-- is compiled.+--+-- == Examples+--+-- The monad instance of Conduit will simply pass along all stdout+-- results:+--+-- >>> run (do echo "Hello"; sed "s/l/a/"; echo "OK!")+-- Hello+-- OK!+--+-- Piping with Conduit's normal pipe will predictably pipe things+-- together, as in Bash:+--+-- >>> run (do shell "echo Hello" $= sed "s/l/a/"; echo "OK!")+-- Healo+-- OK!+--+-- Streaming pipes (aka lazy pipes) is also possible:+--+-- >>> run (do tail' "foo.txt" "-f" $= grep "--line-buffered" "Hello")+-- Hello, world!+-- Oh, hello!+--+-- (Remember that @grep@ needs @--line-buffered@ if it is to output+-- things line-by-line).+--+-- == How it works+--+-- All executable names in the @PATH@ at compile-time are brought into+-- scope as runnable process conduits e.g. @ls@ or @grep@.+--+-- Stdin/out and stderr are handled as an 'Either' type: 'Chunk'+--+-- 'Left' is stderr, 'Right' is @stdin@/@stdout@.+--+-- All processes are bound as variadic process calling functions, like this:+--+-- @+-- rmdir :: ProcessType r => r+-- ls :: ProcessType r => r+-- @+--+-- But ultimately the types end up being:+--+-- @+-- rmdir "foo" :: Conduit Chunk m Chunk+-- ls :: Conduit Chunk m Chunk+-- ls "." :: Conduit Chunk m Chunk+-- @+--+-- Etc.+--+-- Run all shell scripts with 'run':+--+-- @+-- run :: (MonadIO m, MonadBaseControl IO m)+--     => Conduit Chunk (ShellT m) Chunk -> m ()+-- @+--+-- == String types+--+-- If using @OverloadedStrings@ so that you can use 'Text' for arguments,+-- then also enable @ExtendedDefaultRules@, otherwise you'll get+-- ambiguous type errors.+--+-- @+-- {-# LANGUAGE ExtendedDefaultRules #-}+-- @+--+-- But this isn't necessary if you don't need to use 'Text' yet. Strings+-- literals will be interpreted as 'String'. Though you can pass a value+-- of type 'Text' or any instance of 'CmdArg' without needing conversions.+--++module Data.Conduit.Shell+  (-- * Running scripts+   run+   -- * Example executables+   -- $examples+  ,Data.Conduit.Shell.ls+  ,Data.Conduit.Shell.cat+  ,Data.Conduit.Shell.grep+   -- * Running custom processes+  ,shell+  ,proc+  -- * I/O chunks+  ,withRights+  ,redirect+  ,quiet+  ,writeChunks+  ,discardChunks+   -- * Re-exports+   -- $exports+  ,module Data.Conduit.Shell.PATH+  ,module Data.Conduit.Shell.Types+  ,module Data.Conduit.Shell.Variadic+  ,module Data.Conduit.Filesystem+  ,module Data.Conduit)+  where++import Data.Conduit+import Data.Conduit.Filesystem+import qualified Data.Conduit.Shell.PATH+import Data.Conduit.Shell.PATH hiding (ls,grep,cat)+import Data.Conduit.Shell.Process+import Data.Conduit.Shell.Types+import Data.Conduit.Shell.Variadic++-- $examples+--+-- These are three documented executables provided as examples (chosen+-- because they are bound to exist for all POSIX users),+-- re-exported. To see the complete list, look at the module+-- "Data.Conduit.Shell.PATH". That whole module is re-exported from+-- this module.+--+-- The type in each is @ProcessType r => r@, because they are+-- variadic. You can specify an arbitrary number of arguments:+--+--+-- >>> run ls+-- dist+-- ..+--+-- >>> run (ls ".")+-- foo.txt+-- bar.txt+-- >>> run (ls "/")+-- bin+-- boot+-- cdrom+-- ...+--+-- >>> run (ls "/" "-al")+-- total 180+-- drwxr-xr-x  24 root root  4096 Aug  4  2013 .+-- drwxr-xr-x  24 root root  4096 Aug  4  2013 ..+-- drwxr-xr-x   2 root root  4096 Sep 12 08:35 bin+-- drwxr-xr-x   4 root root  4096 May 28  2013 boot+-- drwxr-xr-x   2 root root  4096 Apr 27  2013 cdrom+-- ...++-- | List directory contents.+ls :: ProcessType r => r+ls = Data.Conduit.Shell.PATH.ls++-- | Print lines matching a pattern.+grep :: ProcessType r => r+grep = Data.Conduit.Shell.PATH.grep++-- | Concatenate files and print on the standard output.+cat :: ProcessType r => r+cat = Data.Conduit.Shell.PATH.cat++-- $exports+--+-- The following modules are exported for scripting+-- convenience. "Data.Conduit" and "Data.Conduit.Filesystem" are+-- re-exported from other libraries because they are typical uses. If+-- you want a stream of the contents of a directory, recursively,+-- 'sourceDirectoryDeep' is handy. A program like @find@ is strict,+-- whereas a Conduit can stop processing whenever you wish.+--+-- You might want to import the regular Conduit modules qualified, too:+--+-- @+-- import qualified Data.Conduit.List as CL+-- @+--+-- Which contains handy functions for working on streams in a+-- list-like way. See the rest of the handy modules for Conduit in+-- conduit-extra: <http://hackage.haskell.org/package/conduit-extra>+--+-- Also of interest is csv-conduit: <http://hackage.haskell.org/package/csv-conduit>+-- And html-conduit: <http://hackage.haskell.org/package/html-conduit>+-- And http-conduit: <http://hackage.haskell.org/package/http-conduit>+--+-- Finally, see the Conduit category on Hackage for other useful libraries: <http://hackage.haskell.org/packages/#cat:Conduit>+--+-- All of these general purpose Conduits can be used in shell+-- scripting.
+ src/Data/Conduit/Shell/PATH.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++-- | All binaries in PATH.++module Data.Conduit.Shell.PATH where++import Data.Conduit.Shell.TH++$(generateBinaries)
+ src/Data/Conduit/Shell/Process.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE FlexibleContexts #-}++-- | Reading from the process.++module Data.Conduit.Shell.Process+  (-- * Running scripts+   run+   -- * Running processes+  ,Data.Conduit.Shell.Process.shell+  ,Data.Conduit.Shell.Process.proc+   -- * I/O chunks+  ,withRights+  ,redirect+  ,quiet+  ,writeChunks+  ,discardChunks+  -- * Low-level internals+  ,conduitProcess+  )+  where++import           Data.Conduit.Shell.Types++import           Control.Applicative+import qualified Control.Exception as E+import           Control.Monad+import           Control.Monad.Trans+import           Control.Monad.Trans.Loop+import           Control.Monad.Trans.Resource+import           Data.ByteString+import qualified Data.ByteString as S+import           Data.Conduit+import           Data.Conduit.List (sourceList)+import qualified Data.Conduit.List as CL+import           Data.Conduit.Process+import           Data.Either+import           Data.Maybe+import           System.Exit (ExitCode(..))+import           System.IO+import qualified System.Process++-- | Run a shell command.+shell :: (MonadResource m) => String -> Conduit Chunk m Chunk+shell = conduitProcess . System.Process.shell++-- | Run a shell command.+proc :: (MonadResource m) => String -> [String] -> Conduit Chunk m Chunk+proc px args = conduitProcess (System.Process.proc px args)++-- | Size of buffer used to read from process.+bufSize :: Int+bufSize = 64 * 1024++-- | Do something with just the rights.+withRights :: (Monad m)+           => Conduit ByteString m ByteString -> Conduit Chunk m Chunk+withRights f =+  getZipConduit+    (ZipConduit f' *>+     ZipConduit g')+  where f' =+          CL.mapMaybe (either (const Nothing) Just) =$=+          f =$=+          CL.map Right+        g' = CL.filter isLeft++-- | Redirect the given chunk type to the other type.+redirect :: Monad m+         => ChunkType -> Conduit Chunk m Chunk+redirect ty =+  CL.map (\c' ->+            case c' of+              Left x' ->+                case ty of+                  Stderr -> Right x'+                  Stdout -> c'+              Right x' ->+                case ty of+                  Stderr -> c'+                  Stdout -> Left x')++-- | Discard any output from the command: make it quiet.+quiet :: (Monad m,MonadIO m) => Conduit Chunk m Chunk -> Conduit Chunk m Chunk+quiet m = m $= discardChunks++-- | Run a shell scripting conduit.+run :: (MonadIO m,MonadBaseControl IO m)+    => Conduit Chunk (ShellT m) Chunk -> m ()+run p =+  runResourceT+    (runShellT (sourceList [] $=+                p $$+                writeChunks))++-- | Write chunks to stdout and stderr.+writeChunks :: (MonadIO m)+            => Consumer Chunk m ()+writeChunks =+  awaitForever+    (\c ->+       case c of+         Left e -> liftIO (S.hPut stderr e)+         Right o -> liftIO (S.hPut stdout o))++-- | Discard all chunks.+discardChunks :: (MonadIO m)+              => Consumer Chunk m ()+discardChunks = awaitForever (const (return ()))++-- | Conduit of process.+conduitProcess+  :: (MonadResource m)+     => CreateProcess+     -> Conduit Chunk m Chunk+conduitProcess cp = bracketP createp closep $ \(Just cin, Just cout, _, ph) -> do+  end <- repeatLoopT $ do+    -- if process's outputs are available, then yields them.+    repeatLoopT $ do+      b <- liftIO $ hReady' cout+      when (not b) exit+      out <- liftIO $ S.hGetSome cout bufSize+      void $ lift . lift $ yield (Right out)++    -- if process exited, then exit+    end <- liftIO $ getProcessExitCode ph+    when (isJust end) $ exitWith end++    inp <- lift await+    case inp of+      -- if upper stream ended, then exit+      Nothing -> exitWith Nothing+      Just c ->+        case c of+          -- pass along errors to next process+          Left{} -> lift (leftover c)+          -- write stdin into this process+          Right s ->+             liftIO (do S.hPut cin s+                        hFlush cin)++  -- uppstream or process is done.+  -- process rest outputs.+  liftIO $ hClose cin+  repeatLoopT $ do+    out <- liftIO $ S.hGetSome cout bufSize+    when (S.null out) exit+    lift $ yield (Right out)++  ec <- liftIO $ maybe (waitForProcess' ph) return end+  case ec of+    ExitSuccess -> return ()+    ExitFailure i -> lift (monadThrow (ShellExitFailure i))++  where+    createp = createProcess cp+      { std_in  = CreatePipe+      , std_out = CreatePipe+      }++    closep (Just cin, Just cout, _, ph) = do+      hClose cin+      hClose cout+      _ <- waitForProcess' ph+      return ()+    closep _ = error "Data.Conduit.Process.closep: Unhandled case"++    hReady' h =+      hReady h `E.catch` \(E.SomeException _) -> return False+    waitForProcess' ph =+      waitForProcess ph `E.catch` \(E.SomeException _) -> return ExitSuccess
+ src/Data/Conduit/Shell/TH.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++-- | Generate top-level names for binaries.++module Data.Conduit.Shell.TH+  (generateBinaries)+  where++import Data.Conduit.Shell.Variadic++import Control.Arrow+import Control.Monad+import Data.Char+import Data.Function+import Data.List+import Data.List.Split+import Language.Haskell.TH+import System.Directory+import System.Environment+import System.FilePath++-- | Generate top-level names for all binaries in PATH.+generateBinaries :: Q [Dec]+generateBinaries =+  do bins <- runIO getAllBinaries+     return (map (\(name,bin) ->+                    FunD (mkName name)+                         [Clause []+                                 (NormalB (AppE (VarE 'variadicProcess)+                                                (LitE (StringL bin))))+                                 []])+                 (nubBy (on (==) fst)+                        (filter (not . null . fst)+                                (map (normalize &&& id) bins))))+  where normalize = remap . uncapitalize . go+          where go (c:cs)+                  | c == '-' || c == '_' =+                    case go cs of+                      (z:zs) -> toUpper z : zs+                      [] -> []+                  | not (elem (toLower c) allowed) = go cs+                  | otherwise = c : go cs+                go [] = []+        uncapitalize (c:cs)+          | isDigit c = '_' : c : cs+          | otherwise = toLower c : cs+        uncapitalize [] = []+        allowed =+          ['a' .. 'z'] +++          ['0' .. '9']++-- | Remap conflicting names.+remap :: [Char] -> [Char]+remap name =+  case name of+   "head" -> "head'"+   "seq" -> "seq'"+   "zip" -> "zip'"+   "print" -> "print'"+   "id" -> "id'"+   "unzip" -> "unzip'"+   "join" -> "join'"+   "init" -> "init'"+   "last" -> "last'"+   "tail" -> "tail'"+   "find" -> "find'"+   "sort" -> "sort'"+   "sum" -> "sum'"+   "compare" -> "compare'"+   "truncate" -> "truncate'"+   "lex" -> "lex'"+   "env" -> "env'"+   e -> e++-- | Get a list of all binaries in PATH.+getAllBinaries :: IO [FilePath]+getAllBinaries =+  do path <- getEnv "PATH"+     fmap concat+          (forM (splitOn ":" path)+                (\dir ->+                   do exists <- doesDirectoryExist dir+                      if exists+                         then do contents <- getDirectoryContents dir+                                 filterM (\file ->+                                            do exists' <- doesFileExist (dir </> file)+                                               if exists'+                                                  then do perms <- getPermissions (dir </> file)+                                                          return (executable perms)+                                                  else return False)+                                         contents+                         else return []))
+ src/Data/Conduit/Shell/Types.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}++-- | All types.++module Data.Conduit.Shell.Types where++import Control.Applicative+import Control.Exception+import Control.Monad+import Control.Monad.Base+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Control+import Control.Monad.Trans.Resource+import Data.ByteString (ByteString)+import Data.Conduit+import Data.Typeable++-- | A chunk, either stdout/stdin or stderr. Used for both input and+-- output.+type Chunk = Either ByteString ByteString++-- | Either stdout or stderr.+data ChunkType+  = Stderr -- ^ Stderr.+  | Stdout -- ^ Stdin or stdout.+  deriving (Eq,Enum,Bounded)++-- | Shell transformer.+newtype ShellT m a =+  ShellT {runShellT :: ResourceT m a}+  deriving (Applicative,Monad,Functor,MonadThrow,MonadIO,MonadTrans)++deriving instance (MonadResourceBase m) => MonadBase IO (ShellT m)+deriving instance (MonadResourceBase m) => MonadResource (ShellT m)++-- | Dumb instance.+instance (MonadThrow m,MonadIO m,MonadBaseControl IO m) => MonadBaseControl IO (ShellT m) where+  newtype StM (ShellT m) a = StMShell{unStMGeoServer ::+                                    StM (ResourceT m) a}+  liftBaseWith f =+    ShellT (liftBaseWith+              (\run ->+                 f (liftM StMShell .+                    run .+                    runShellT)))+  restoreM = ShellT . restoreM . unStMGeoServer++-- | Intentionally only handles 'ShellException'. Use normal exception+-- handling to handle usual exceptions.+instance (MonadBaseControl IO (ShellT m),Applicative m,MonadThrow m) => Alternative (ConduitM i o (ShellT m)) where+  empty = monadThrow ShellEmpty+  x <|> y =+    do r <- tryC x+       case r of+         Left (_ :: ShellException) -> y+         Right rr -> return rr++-- | An exception resulting from a shell command.+data ShellException+  = ShellEmpty -- ^ For 'mempty'.+  | ShellExitFailure !Int -- ^ Process exited with failure.+  deriving (Typeable,Show)+instance Exception ShellException
+ src/Data/Conduit/Shell/Variadic.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++-- | Variadic process calling.++module Data.Conduit.Shell.Variadic+  (ProcessType(..)+  ,variadicProcess+  ,CmdArg(..))+  where++import           Control.Monad.Trans.Resource+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import           Data.Conduit+import           Data.Conduit.Shell.Process+import           Data.Conduit.Shell.Types+import qualified Data.Text as ST+import qualified Data.Text.Encoding as ST+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT++-- | A variadic process maker.+variadicProcess :: (ProcessType r)+                => String -> r+variadicProcess name = spr name []++-- | Make the final conduit.+makeProcessLauncher :: (MonadResource m)+                    => String -> [ST.Text] -> Conduit Chunk m Chunk+makeProcessLauncher name args = proc name (map ST.unpack args)++-- | Process return type.+class ProcessType t where+    spr :: String -> [ST.Text] -> t++-- | The real type should be:+--+-- @ConduitM Chunk Chunk m ()@+--+-- But with this more liberal instance head we catch all cases in the+-- instance resolver, and then apply the equality restrictions later.+--+instance (MonadResource m, c ~ Chunk, c' ~ Chunk, r ~ ()) => ProcessType (ConduitM c c' m r) where+    spr name args = makeProcessLauncher name (reverse args)++-- | Accept strings as arguments.+instance (ProcessType r,CmdArg a) => ProcessType (a -> r) where+    spr name args = \a -> spr name (toTextArg a : args)++-- | Command line argument.+class CmdArg a  where+  toTextArg :: a -> ST.Text++instance CmdArg ST.Text where+  toTextArg = id++instance CmdArg LT.Text where+  toTextArg = LT.toStrict++instance CmdArg SB.ByteString where+  toTextArg = ST.decodeUtf8++instance CmdArg LB.ByteString where+  toTextArg = LT.toStrict . LT.decodeUtf8++instance CmdArg String where+  toTextArg = ST.pack