shellmate 0.1.1 → 0.1.2

raw patch · 2 files changed

+89/−5 lines, 2 files

Files

• Control/Shell.hs +88/−4
• shellmate.cabal +1/−1

@@ -1,23 +1,29 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, DeriveDataTypeable #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, DeriveDataTypeable,+             MultiParamTypeClasses, FunctionalDependencies,+             UndecidableInstances #-} -- | Simple interface for shell scripting-like tasks. module Control.Shell ( -    Shell, shell,+    Shell,+    Guard (..),+    shell,     mayFail, orElse,     withEnv, getEnv, lookupEnv,-    run, run_, runInteractive, sudo,+    run, run_, runInteractive, genericRun, sudo,     cd, cpDir, pwd, ls, mkdir, rmdir, inDirectory, isDirectory,     withHomeDirectory, inHomeDirectory, withAppDirectory, inAppDirectory,+    forEachFile, cpFilter,     isFile, rm, mv, cp, file,     withTempFile, withTempDirectory, inTempDirectory,     hPutStr, hPutStrLn, echo,     module System.FilePath, liftIO   ) where import Control.Applicative-import Control.Monad (ap)+import Control.Monad (ap, forM, filterM, forM_, when) import Control.Monad.IO.Class import Data.Time.Clock import Data.Typeable import System.FilePath+import System.IO.Unsafe import qualified System.Process as Proc import qualified System.Directory as Dir import qualified System.Exit as Exit@@ -167,6 +173,38 @@     s <- IO.hGetContents out     return (Right s, [Pid p pid]) +-- | Run a program and return a boolean indicating whether the command+--   succeeded, the output from stdout, and the output from stderr.+--   This command will never fail.+genericRun :: FilePath -> [String] -> String -> Shell (Bool, String, String)+genericRun p args stdin = do+    (Just inp, Just out, Just err, pid) <- createproc+    Shell $ \_ -> do+      let feed str = do+            case splitAt 4096 str of+              ([], [])      -> IO.hClose inp+              (first, str') -> IO.hPutStr inp first >> feed str'+      Conc.forkIO $ feed stdin+      o <- IO.hGetContents out+      e <- IO.hGetContents err+      merr <- waitPids [Pid p pid]+      return (Right (maybe True (const False) merr, o, e), [])+  where+    createproc = Shell $ \env -> do+      (inp, out, err, pid) <- Proc.createProcess (cproc env)+      return (Right (inp, out, err, pid), [])+    cproc env = Proc.CreateProcess {+        Proc.cmdspec      = Proc.RawCommand p args,+        Proc.cwd          = Nothing,+        Proc.env          = Just env,+        Proc.std_in       = Proc.CreatePipe,+        Proc.std_out      = Proc.CreatePipe,+        Proc.std_err      = Proc.CreatePipe,+        Proc.close_fds    = False,+        Proc.create_group = False+      }++ -- | Like @run@, but echoes the command's text output to the screen instead of --   returning it. run_ :: FilePath -> [String] -> String -> Shell ()@@ -249,6 +287,35 @@           liftIO $ Dir.createDirectoryIfMissing False to           ls from >>= mapM_ (\f -> cpDir (from </> f) (to </> f)) +-- | Recursively copy a directory, but omit all files that do not match the+--   give predicate.+cpFiltered :: (FilePath -> Bool) -> FilePath -> FilePath -> Shell ()+cpFiltered pred from to = do+  isdir <- isDirectory to+  -- Lazily create directories only when needed!+  let to' = unsafePerformIO $ do+        when (not isdir) $ Dir.createDirectory to+        return to+  files <- ls from+  mapM_ ((`cp` to') . (from </>)) (filter pred files)+  fromdirs <- filterM (\d -> isDirectory (from </> d)) files+  forM_ fromdirs $ \dir -> do+    cpFilter pred (from </> dir) (to </> dir)++-- | Perform an action on each file in the given directory.+--   This function will traverse any subdirectories of the given as well.+--   File paths are given relative to the given directory; the current working+--   directory is not affected.+forEachFile :: FilePath -> (FilePath -> Shell a) -> Shell [a]+forEachFile dir f = do+  echo $ "forEachFile in dir " ++ dir+  files <- map (dir </>) <$> ls dir+  xs <- filterM isFile files >>= mapM f+  fromdirs <- filterM isDirectory files+  xss <- forM fromdirs $ \d -> do+    forEachFile d f+  return $ concat (xs:xss)+ -- | Copy a file. Fails if the source is a directory. If the target is a --   directory, the source file is copied into that directory using its current --   name.@@ -360,3 +427,20 @@ -- | @putStrLn@ lifted into Shell for convenience. echo :: String -> Shell () echo = liftIO . putStrLn++class Guard guard a | guard -> a where+  -- | Perform a Shell computation; if the computation succeeds but returns+  --   a false-ish value, the outer Shell computation fails with the given+  --   error message.+  guard :: String -> guard -> Shell a++instance Guard (Maybe a) a where+  guard _ (Just x) = return x+  guard desc _     = fail $ "Guard failed: " ++ desc++instance Guard Bool () where+  guard _ True = return ()+  guard desc _ = fail $ "Guard failed: " ++ desc++instance Guard a b => Guard (Shell a) b where+  guard desc m = m >>= \x -> guard desc x

@@ -1,5 +1,5 @@ name:                shellmate-version:             0.1.1+version:             0.1.2 synopsis:            Simple interface for shell scripting in Haskell. -- description:          homepage:            http://github.com/valderman/shellmate