shelly 0.6 → 0.7

raw patch · 3 files changed

+63/−2 lines, 3 filesdep +SafeSemaphore

Dependencies added: SafeSemaphore

Files

• Shelly.hs +52/−1
• shelly.cabal +3/−1
• test/main.hs +8/−0

@@ -21,7 +21,7 @@ module Shelly        (          -- * Entering ShIO.-         ShIO, shelly, sub, silently, verbosely, print_commands+         ShIO, shelly, sub, silently, verbosely, jobs, print_commands           -- * Running external commands.          , run, run_, cmd, (-|-), lastStderr, setStdin@@ -47,6 +47,9 @@          , mv, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p          , readfile, writefile, appendfile, withTmpDir +         -- * Running external commands asynchronously.+         , background, getBgResult, BgResult+          -- * exiting the program          , exit, errorExit, terror @@ -97,6 +100,7 @@ import Control.Exception hiding (handle) import Control.Monad.Reader import Control.Concurrent+import qualified Control.Concurrent.MSem as Sem import Data.Time.Clock( getCurrentTime, diffUTCTime  )  import qualified Data.Text.Lazy.IO as TIO@@ -500,6 +504,53 @@ -- | Create a sub-ShIO in which external command outputs are echoed. See "sub". verbosely :: ShIO a -> ShIO a verbosely a = sub $ modify (\x -> x { sVerbose = True }) >> a++-- | Create a sub-ShIO which has a 'limit' on the max number of background tasks.+-- an invocation of jobs is independent of any others, and not tied to the ShIO monad in any way.+-- This blocks the execution of the program until all 'background' jobs are finished.+jobs :: Int -> (BgJobManager -> ShIO a) -> ShIO a+jobs limit action = do+    unless (limit > 0) $ terror "expected limit to be > 0"+    availableJobsSem <- liftIO $ Sem.new limit+    res <- action $ BgJobManager availableJobsSem+    liftIO $ waitForJobs availableJobsSem+    return res+  where+    waitForJobs sem = do+      avail <- Sem.peekAvail sem+      if avail == limit then return () else waitForJobs sem++newtype BgJobManager = BgJobManager (Sem.MSem Int)++-- | Type returned by tasks run asynchronously in the background.+newtype BgResult a = BgResult (MVar a)++-- | Returns the promised result from a backgrounded task.  Blocks until+-- the task completes.+getBgResult :: BgResult a -> ShIO a+getBgResult (BgResult mvar) = liftIO $ takeMVar mvar++-- | Run the `ShIO` task asynchronously in the background, returns+-- the `BgResult a`, a promise immediately. Run "getBgResult" to wait for the result.+-- The background task will inherit the current ShIO context+-- The 'BjJobManager' ensures the max jobs limit must be sufficient for the parent and all children.+background :: BgJobManager -> ShIO a -> ShIO (BgResult a)+background (BgJobManager manager) proc = do+  state <- get+  liftIO $ do+    -- take up a spot+    -- It is important to do this before forkIO:+    -- It ensures that that jobs will block and the program won't exit before our jobs are done+    -- On the other hand, a user might not expect 'jobs' to block+    Sem.wait manager+    mvar <- newEmptyMVar -- future result++    _<- forkIO $ do+      result <- shelly $ (put state >> proc)+      Sem.signal manager -- open a spot back up+      liftIO $ putMVar mvar result+    return $ BgResult mvar+  -- | Create a sub-ShIO in which external command outputs are echoed. See "sub". print_commands :: ShIO a -> ShIO a

@@ -1,6 +1,6 @@ Name:       shelly -Version:     0.6+Version:     0.7 Synopsis:    shell-like (systems) programming in Haskell  Description: Shelly is a package provides a single module for convenient@@ -32,6 +32,7 @@   Exposed-modules:     Shelly    Build-depends: base >= 4 && < 5, time, directory, text, mtl, process+               , SafeSemaphore                , unix-compat < 0.4                , system-filepath < 0.5                , system-fileio < 0.4@@ -45,6 +46,7 @@     ghc-options: -Wall      Build-depends: base >= 4 && < 5, time, directory, text, mtl, process+                 , SafeSemaphore                  , unix-compat < 0.4                  , system-filepath < 0.5                  , system-fileio < 0.4

@@ -9,6 +9,14 @@ main :: IO () main =   shelly $ do+    jobs 2 $ \job -> do+      background job $ cmd "sleep" "2"+      echo "yawn"+      background job $ cmd "sleep" "2"+      echo "tired"+      background job $ cmd "sleep" "2"+      echo "zzzz"+      setStdin "in"     echo "echo"     setStdin "catted"