shell-conduit-4.6.1/src/0000755000000000000000000000000013055707163013260 5ustar0000000000000000shell-conduit-4.6.1/src/Data/0000755000000000000000000000000013055707163014131 5ustar0000000000000000shell-conduit-4.6.1/src/Data/Conduit/0000755000000000000000000000000013055707163015536 5ustar0000000000000000shell-conduit-4.6.1/src/Data/Conduit/Shell/0000755000000000000000000000000013057340373016603 5ustar0000000000000000shell-conduit-4.6.1/test/0000755000000000000000000000000013057340605013444 5ustar0000000000000000shell-conduit-4.6.1/src/Data/Conduit/Shell.hs0000644000000000000000000001005513055707163017142 0ustar0000000000000000{-# 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: -- -- 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 (tail' "/tmp/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). -- -- Run custom processes via the @proc@ function: -- -- >>> run (proc "ls" []) -- dist LICENSE README.md Setup.hs shell-conduit.cabal src TAGS TODO.org -- -- Run shell commands via the @shell@ function: -- -- >>> run (shell "ls") -- dist LICENSE README.md Setup.hs shell-conduit.cabal src TAGS TODO.org -- -- Run conduits via the @conduit@ function: -- -- >>> run (cat "/tmp/foo.txt" $| conduit (do Just x <- await; yield x)) -- Hello! -- -- == 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@. -- -- -- 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" :: Segment () -- ls :: Segment () -- ls "." :: Segment () -- @ -- -- Etc. -- -- Run all shell scripts with 'run': -- -- @ -- run :: Segment r -> IO r -- @ -- -- == 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 -- * Making segments ,shell ,proc ,conduit ,text ,bytes -- * Composition of segments ,($|) ,Segment ,ProcessException(..) -- * Re-exports -- $exports ,module Data.Conduit.Shell.PATH ,module Data.Conduit.Shell.Types ,module Data.Conduit.Shell.Variadic ,module Data.Conduit) where import Data.Conduit import Data.Conduit.Shell.PATH hiding (strings) import Data.Conduit.Shell.Process import Data.Conduit.Shell.Types import Data.Conduit.Shell.Variadic -- $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: -- -- Also of interest is csv-conduit: -- And html-conduit: -- And http-conduit: -- -- Finally, see the Conduit category on Hackage for other useful libraries: -- -- All of these general purpose Conduits can be used in shell -- scripting. shell-conduit-4.6.1/src/Data/Conduit/Shell/PATH.hs0000644000000000000000000000127713057340373017702 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-imports #-} -- | All binaries in PATH. module Data.Conduit.Shell.PATH where import Control.Monad import Control.Monad.IO.Class import Data.Conduit.Shell.Process import Data.Conduit.Shell.TH import Data.Conduit.Shell.Variadic import Data.List import qualified Data.Text as T (unpack) import Prelude import System.Directory -- | Helpful CD command. cd :: (MonadIO m, CmdArg arg) => arg -> m () cd fp = case (toTextArg fp) of [] -> return () (path:_) -> liftIO $ setCurrentDirectory (T.unpack path) $(generateBinaries) shell-conduit-4.6.1/src/Data/Conduit/Shell/TH.hs0000644000000000000000000000551113055707163017456 0ustar0000000000000000{-# 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 mapM (\(name,bin) -> do uniqueName <- getUniqueName name return (FunD uniqueName [Clause [] (NormalB (AppE (VarE 'variadicProcess) (LitE (StringL bin)))) []])) (nubBy (on (==) fst) (filter (not . null . fst) (map (normalize &&& id) bins))) where normalize = 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'] -- | Get a version of the given name available to be bound. getUniqueName :: String -> Q Name getUniqueName candidate = do inScope <- recover (return False) (do void (reify (mkName candidate)) return True) if inScope || candidate == "import" || candidate == "type" then getUniqueName (candidate ++ "'") else return (mkName candidate) -- | 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 [])) shell-conduit-4.6.1/src/Data/Conduit/Shell/Process.hs0000644000000000000000000002153313055707163020563 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveDataTypeable #-} -- | Reading from the process. module Data.Conduit.Shell.Process (-- * Running scripts run -- * Conduit types ,text ,bytes -- * General conduits ,conduit ,conduitEither -- * Running processes ,Data.Conduit.Shell.Process.shell ,Data.Conduit.Shell.Process.proc ,($|) ,Segment ,ProcessException(..) ,ToChunk(..) ,tryS ) where import Control.Applicative import Control.Concurrent.Async import Control.Exception import Control.Monad import Control.Monad.IO.Class import Data.ByteString (ByteString) import qualified Data.ByteString as S import Data.Conduit import Data.Conduit.Binary import qualified Data.Conduit.List as CL import Data.Conduit.Text (encodeUtf8, decodeUtf8) import Data.Text (Text) import Data.Typeable import System.Exit import System.IO import System.Posix.IO (createPipe, fdToHandle) import System.Process hiding (createPipe) -- | A pipeable segment. Either a conduit or a process. data Segment r = SegmentConduit (ConduitM ByteString (Either ByteString ByteString) IO r) | SegmentProcess (Handles -> IO r) instance Monad Segment where return = SegmentConduit . return SegmentConduit c >>= f = SegmentProcess (conduitToProcess c) >>= f SegmentProcess f >>= g = SegmentProcess (\handles -> do x <- f handles case g x of SegmentConduit c -> conduitToProcess c handles SegmentProcess p -> p handles) instance Functor Segment where fmap = liftM instance Applicative Segment where (<*>) = ap; pure = return instance Alternative Segment where this <|> that = do ex <- tryS this case ex of Right x -> pure x Left (_ :: ProcessException) -> that empty = throw ProcessEmpty -- | Try something in a segment. tryS :: Exception e => Segment r -> Segment (Either e r) tryS s = case s of SegmentConduit c -> SegmentConduit (tryC c) SegmentProcess f -> SegmentProcess (\h -> try (f h)) instance MonadIO Segment where liftIO x = SegmentProcess (const x) -- | Process handles: @stdin@, @stdout@, @stderr@ data Handles = Handles Handle Handle Handle -- | Process running exception. data ProcessException = ProcessException CreateProcess ExitCode | ProcessEmpty deriving (Typeable) instance Exception ProcessException instance Show ProcessException where show ProcessEmpty = "empty process" show (ProcessException cp ec) = concat ["The " ,case cmdspec cp of ShellCommand s -> "shell command " ++ show s RawCommand f args -> "raw command: " ++ unwords (f : map show args) ," returned a failure exit code: " ,case ec of ExitFailure i -> show i _ -> show ec] -- | Convert a process or a conduit to a segment. class ToSegment a where type SegmentResult a toSegment :: a -> Segment (SegmentResult a) instance ToSegment (Segment r) where type SegmentResult (Segment r) = r toSegment = id instance (a ~ ByteString,ToChunk b,m ~ IO) => ToSegment (ConduitM a b m r) where type SegmentResult (ConduitM a b m r) = r toSegment f = SegmentConduit (f `fuseUpstream` CL.map toChunk) instance ToSegment CreateProcess where type SegmentResult CreateProcess = () toSegment = liftProcess -- | Used to allow outputting stdout or stderr. class ToChunk a where toChunk :: a -> Either ByteString ByteString instance ToChunk ByteString where toChunk = Left instance ToChunk (Either ByteString ByteString) where toChunk = id -- | Run a shell command. shell :: String -> Segment () shell = liftProcess . System.Process.shell -- | Run a process command. proc :: String -> [String] -> Segment () proc name args = liftProcess (System.Process.proc name args) -- | Run a segment. run :: Segment r -> IO r run (SegmentConduit c) = run (SegmentProcess (conduitToProcess c)) run (SegmentProcess p) = p (Handles stdin stdout stderr) -- | Fuse two segments (either processes or conduits). ($|) :: Segment () -> Segment b -> Segment b x $| y = x `fuseSegment` y infixl 0 $| -- | Work on the stream as 'Text' values from UTF-8. text :: (r ~ (),m ~ IO) => ConduitM Text Text m r -> Segment r text conduit' = bytes (decodeUtf8 $= conduit' $= encodeUtf8) -- | Lift a conduit into a segment. bytes :: (a ~ ByteString,m ~ IO) => ConduitM a ByteString m r -> Segment r bytes f = SegmentConduit (f `fuseUpstream` CL.map toChunk) -- | Lift a conduit into a segment. conduit :: (a ~ ByteString,m ~ IO) => ConduitM a ByteString m r -> Segment r conduit f = SegmentConduit (f `fuseUpstream` CL.map toChunk) -- | Lift a conduit into a segment, which can yield stderr. conduitEither :: (a ~ ByteString,m ~ IO) => ConduitM a (Either ByteString ByteString) m r -> Segment r conduitEither f = SegmentConduit (f `fuseUpstream` CL.map toChunk) -- | Lift a process into a segment. liftProcess :: CreateProcess -> Segment () liftProcess cp = SegmentProcess (\(Handles inh outh errh) -> let config = cp {std_in = UseHandle inh ,std_out = UseHandle outh ,std_err = UseHandle errh ,close_fds = True} in do (Nothing,Nothing,Nothing,ph) <- createProcess_ "liftProcess" config ec <- waitForProcess ph case ec of ExitSuccess -> return () _ -> throwIO (ProcessException cp ec)) -- | Convert a conduit to a process. conduitToProcess :: ConduitM ByteString (Either ByteString ByteString) IO r -> (Handles -> IO r) conduitToProcess c (Handles inh outh errh) = sourceHandle inh $$ c `fuseUpstream` sinkHandles outh errh -- | Sink everything into the two handles. sinkHandles :: Handle -> Handle -> Consumer (Either ByteString ByteString) IO () sinkHandles out err = CL.mapM_ (\ebs -> case ebs of Left bs -> S.hPut out bs Right bs -> S.hPut err bs) -- | Create a pipe. createHandles :: IO (Handle, Handle) createHandles = mask_ (do (inFD,outFD) <- createPipe x <- fdToHandle inFD y <- fdToHandle outFD hSetBuffering x NoBuffering hSetBuffering y NoBuffering return (x,y)) -- | Fuse two processes. fuseProcess :: (Handles -> IO ()) -> (Handles -> IO r) -> (Handles -> IO r) fuseProcess left right (Handles in1 out2 err) = do (in2,out1) <- createHandles runConcurrently (Concurrently (left (Handles in1 out1 err) `finally` hClose out1) *> Concurrently (right (Handles in2 out2 err) `finally` hClose in2)) -- | Fuse two conduits. fuseConduit :: Monad m => ConduitM ByteString (Either ByteString ByteString) m () -> ConduitM ByteString (Either ByteString ByteString) m r -> ConduitM ByteString (Either ByteString ByteString) m r fuseConduit left right = left =$= getZipConduit right' where right' = ZipConduit (CL.filter isRight) *> ZipConduit (CL.mapMaybe (either (const Nothing) Just) =$= right) isRight Right{} = True isRight Left{} = False -- | Fuse a conduit with a process. fuseConduitProcess :: ConduitM ByteString (Either ByteString ByteString) IO () -> (Handles -> IO r) -> (Handles -> IO r) fuseConduitProcess left right (Handles in1 out2 err) = do (in2,out1) <- createHandles runConcurrently (Concurrently ((sourceHandle in1 $$ left =$ sinkHandles out1 err) `finally` hClose out1) *> Concurrently (right (Handles in2 out2 err) `finally` hClose in2)) -- | Fuse a process with a conduit. fuseProcessConduit :: (Handles -> IO ()) -> ConduitM ByteString (Either ByteString ByteString) IO r -> (Handles -> IO r) fuseProcessConduit left right (Handles in1 out2 err) = do (in2,out1) <- createHandles runConcurrently (Concurrently (left (Handles in1 out1 err) `finally` hClose out1) *> Concurrently ((sourceHandle in2 $$ right `fuseUpstream` sinkHandles out2 err) `finally` hClose in2)) -- | Fuse one segment with another. fuseSegment :: Segment () -> Segment r -> Segment r SegmentConduit x `fuseSegment` SegmentConduit y = SegmentConduit (fuseConduit x y) SegmentConduit x `fuseSegment` SegmentProcess y = SegmentProcess (fuseConduitProcess x y) SegmentProcess x `fuseSegment` SegmentConduit y = SegmentProcess (fuseProcessConduit x y) SegmentProcess x `fuseSegment` SegmentProcess y = SegmentProcess (fuseProcess x y) shell-conduit-4.6.1/src/Data/Conduit/Shell/Types.hs0000644000000000000000000000431713055707163020252 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE CPP #-} -- | 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.Conduit import Data.Typeable -- | 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) #if MIN_VERSION_monad_control(1,0,0) newtype StMShell m a = StMShell{unStMGeoServer :: StM (ResourceT m) a} #endif -- | Dumb instance. instance (MonadThrow m,MonadIO m,MonadBaseControl IO m) => MonadBaseControl IO (ShellT m) where #if MIN_VERSION_monad_control(1,0,0) type StM (ShellT m) a = StMShell m a #else newtype StM (ShellT m) a = StMShell{unStMGeoServer :: StM (ResourceT m) a} #endif 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 shell-conduit-4.6.1/src/Data/Conduit/Shell/Segments.hs0000644000000000000000000000144413055707163020731 0ustar0000000000000000-- | Helpful segment combinators. module Data.Conduit.Shell.Segments where import qualified Data.ByteString.Char8 as S8 import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Conduit.Binary as CB import Data.Conduit.Shell.Process import Data.Text (Text) import qualified Data.Text.Encoding as T -- | Extract the 'String' values from a segment. strings :: Segment () -> Segment [String] strings s = s $| conduit (CB.lines $= CL.map S8.unpack $= CL.consume) -- | Extract the 'Text' values from a segment. texts :: Segment () -> Segment [Text] texts s = s $| conduit (CB.lines $= CL.map T.decodeUtf8 $= CL.consume) -- | Ignore any output from a segment. ignore :: Segment () -> Segment () ignore s = fmap (const ()) (s $| conduit (CL.consume)) shell-conduit-4.6.1/src/Data/Conduit/Shell/Variadic.hs0000644000000000000000000000354313057340373020666 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} -- | Variadic process calling. module Data.Conduit.Shell.Variadic ( ProcessType(..) , variadicProcess , CmdArg(..) ) where import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy as LB import Data.Conduit.Shell.Process 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 import Control.Applicative (pure) -- | A variadic process maker. variadicProcess :: (ProcessType r) => String -> r variadicProcess name = spr name [] -- | Make the final conduit. makeProcessLauncher :: String -> [ST.Text] -> Segment () makeProcessLauncher name args = proc name (map ST.unpack args) -- | Process return type. class ProcessType t where spr :: String -> [ST.Text] -> t instance (r ~ ()) => ProcessType (Segment r) where spr name args = makeProcessLauncher name args -- | Accept strings as arguments. instance (ProcessType r, CmdArg a) => ProcessType (a -> r) where spr name args = \a -> spr name (args ++ toTextArg a) -- | Command line argument. class CmdArg a where toTextArg :: a -> [ST.Text] instance CmdArg ST.Text where toTextArg = pure . id instance CmdArg LT.Text where toTextArg = pure . LT.toStrict instance CmdArg SB.ByteString where toTextArg = pure . ST.decodeUtf8 instance CmdArg LB.ByteString where toTextArg = pure . LT.toStrict . LT.decodeUtf8 instance CmdArg String where toTextArg = pure . ST.pack instance CmdArg [String] where toTextArg = map ST.pack instance CmdArg [ST.Text] where toTextArg = map id instance CmdArg [LT.Text] where toTextArg = map LT.toStrict instance CmdArg [SB.ByteString] where toTextArg = map ST.decodeUtf8 instance CmdArg [LB.ByteString] where toTextArg = map (LT.toStrict . LT.decodeUtf8) shell-conduit-4.6.1/test/Spec.hs0000644000000000000000000000546113057340605014700 0ustar0000000000000000{-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE CPP #-} import Test.Hspec import Data.Conduit.Shell hiding (ignore) -- https://github.com/fpco/stackage/issues/2355#issue-212177275 import Data.Conduit.Shell.PATH (true, false) import Data.Conduit.Shell.Segments (strings, ignore) import Control.Applicative main :: IO () main = hspec $ do describe "SHELL path functions" $ do it "false" $ do val <- run $ strings (false <|> echo "failed") val `shouldBe` ["failed"] it "true" $ do val <- run $ strings (true <|> echo "passed") val `shouldBe` [] describe "ls" $ do it "home directory check" $ do val <- run $ strings (ls "/") val `shouldContain` ["home"] it "long option" $ do val <- run $ strings (ls "-a" ["/"]) val `shouldContain` ["home"] describe "multiple string usage" $ do it "make two directory" $ do val <- run $ do ignore $ mkdir "-p" "mtest1" "mtest2" "mtest3" strings $ ls "." run $ rmdir ["mtest1", "mtest2", "mtest3"] val `shouldContain` ["mtest1", "mtest2", "mtest3"] describe "list usage in variadic" $ do it "two directory" $ do val <- run $ do ignore $ mkdir "-p" ["test1", "test2"] strings $ ls "." run $ rmdir ["test1", "test2"] val `shouldContain` ["test1", "test2"] describe "shell calls" $ do it "shell ls" $ do val <- run $ do strings $ shell "ls /" val `shouldContain` ["home"] describe "ordering of arguments" $ do it "echo -e" $ do val <- run $ do strings $ echo "-e" "hello\n" "haskell" #ifdef darwin_HOST_OS val `shouldBe` ["-e hello", " haskell"] #else val `shouldBe` ["hello", " haskell"] #endif it "mixed variant" $ do val <- run $ strings $ echo "-e" ["hello\n", "haskell"] #ifdef darwin_HOST_OS val `shouldBe` ["-e hello", " haskell"] #else val `shouldBe` ["hello", " haskell"] #endif it "list variant" $ do val <- run $ strings $ echo ["-e", "hello\n", "haskell"] #ifdef darwin_HOST_OS val `shouldBe` ["-e hello", " haskell"] #else val `shouldBe` ["hello", " haskell"] #endif describe "cd" $ do it "cd /" $ do val <- run $ do ignore $ cd "/" strings pwd val `shouldBe` ["/"] it "cd /home" $ do val <- run $ do ignore $ cd ["/home", undefined] strings pwd val `shouldBe` ["/home"] shell-conduit-4.6.1/LICENSE0000644000000000000000000000272713055707163013506 0ustar0000000000000000Copyright (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 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. shell-conduit-4.6.1/Setup.hs0000644000000000000000000000005613055707163014126 0ustar0000000000000000import Distribution.Simple main = defaultMain shell-conduit-4.6.1/shell-conduit.cabal0000644000000000000000000000406113057340720016222 0ustar0000000000000000name: shell-conduit version: 4.6.1 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: Sibi Prabakaran copyright: 2014-2017 Chris Done category: Conduit, Scripting build-type: Simple cabal-version: >=1.8 homepage: https://github.com/psibi/shell-conduit extra-source-files: CHANGELOG.md README.md bug-reports: https://github.com/psibi/shell-conduit/issues 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.Segments Data.Conduit.Shell.Variadic build-depends: async >= 2.0.1.5 , base >= 4 && <5 , bytestring , conduit , conduit-extra , control-monad-loop , directory , filepath , monad-control , monads-tf , process >= 1.2.1.0 , resourcet , semigroups , split , template-haskell , text , transformers , transformers-base , unix >= 2.7.0.1 test-suite test type: exitcode-stdio-1.0 ghc-options: -Wall hs-source-dirs: test/ main-is: Spec.hs build-depends: base >= 4.5 && < 5, shell-conduit, hspec >= 2.1 && < 3, hspec-expectations, template-haskell source-repository head type: git location: http://github.com/psibi/shell-conduit shell-conduit-4.6.1/CHANGELOG.md0000644000000000000000000000035313057342501014274 0ustar0000000000000000# 4.6.1 * Fix import error in Stackage: https://github.com/fpco/stackage/issues/2355 # 4.6.0 * Add basic tests code * Accept list as variadic command line arguments `mkdir "-p" ["folder1", "folder2"]` works now. * TRAVIS CI added shell-conduit-4.6.1/README.md0000644000000000000000000001075113056646226013757 0ustar0000000000000000shell-conduit [![Hackage](https://img.shields.io/hackage/v/shell-conduit.svg?style=flat)](https://hackage.haskell.org/package/shell-conduit) [![Build Status](https://travis-ci.org/psibi/shell-conduit.svg?branch=master)](https://travis-ci.org/psibi/shell-conduit) ===== Write shell scripts with Conduit. Still in the experimental phase. [Haddock API documentation](https://www.stackage.org/package/shell-conduit). ### Examples ##### Cloning and initializing a repo ``` haskell import Control.Monad.IO.Class import Data.Conduit.Shell import System.Directory main = run (do exists <- liftIO (doesDirectoryExist "fpco") if exists then rm "fpco/.hsenvs" "-rf" else git "clone" "git@github.com:fpco/fpco.git" liftIO (setCurrentDirectory "fpco") shell "./dev-scripts/update-repo.sh" shell "./dev-scripts/build-all.sh" alertDone) ``` ##### Piping Piping of processes and normal conduits is possible: ``` haskell λ> run (ls $| grep ".*" $| shell "cat" $| conduit (CL.map (S8.map toUpper))) DIST EXAMPLES LICENSE README.MD SETUP.HS SHELL-CONDUIT.CABAL SRC TAGS TODO.ORG ``` ##### Running actions in sequence and piping Results are outputted to stdout unless piped into other processes: ``` haskell λ> run (do shell "echo sup"; shell "echo hi") sup hi λ> run (do shell "echo sup" $| sed "s/u/a/"; shell "echo hi") sap hi ``` ##### Streaming Live streaming between pipes like in normal shell scripting is possible: ``` haskell λ> run (do tail' "/tmp/example.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). ##### Handling exit failures Process errors can be ignored by using the Alternative instance. ``` haskell import Control.Applicative import Control.Monad.Fix import Data.Conduit.Shell main = run (do ls echo "Restarting server ... ?" killall name "-q" <|> return () fix (\loop -> do echo "Waiting for it to terminate ..." sleep "1" (ps "-C" name >> loop) <|> return ()) shell "dist/build/ircbrowse/ircbrowse ircbrowse.conf") where name = "ircbrowse" ``` ##### Running custom things You can run processes directly: ``` haskell λ> run (proc "ls" []) dist LICENSE Setup.hs src TODO.org examples README.md shell-conduit.cabal TAGS ``` Or shell commands: ``` haskell λ> run (shell "ls") dist LICENSE Setup.hs src TODO.org examples README.md shell-conduit.cabal TAGS ``` Or conduits: ``` haskell λ> run (cat $| conduit (awaitForever yield)) hello hello Interrupted. ``` ##### Keyboard configuration ``` haskell import Data.Conduit.Shell main = run (do xmodmap ".xmodmap" xset "r" "rate" "150" "50") ``` ### 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`. All processes are bound as variadic process calling functions, like this: ``` haskell rmdir :: ProcessType r => r ls :: ProcessType r => r ``` But ultimately the types end up being: ``` haskell rmdir "foo" :: Segment r ls :: Segment r ls "." :: Segment r ``` Etc. Run all shell scripts with ``` haskell run :: Segment r -> IO r ``` The `Segment` type has a handy `Alternative` instance. ### String types If using `OverloadedStrings` so that you can use `Text` for arguments, then also enable `ExtendedDefaultRules`, otherwise you'll get ambiguous type errors. ``` haskell {-# 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. ### Other modules You might want to import the regular Conduit modules qualified, too: ``` haskell 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), [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: All of these general purpose Conduits can be used in shell scripting.