moving terminateProcess to Eff

Author: GuillaumedeVolpiano

app/Main.hs

@@ -28,6 +28,7 @@ import           Effectful.Process             (Process, runProcess)
 import           Effectful.Reader.Static       (Reader, runReader)
 import           Effectful.State.Static.Shared (State, evalState)
 import           Effectful.Time                (Time, runTime)
+import Effectful.Concurrent (Concurrent, runConcurrent)
 import           GHRB.Core                     (buildEmptyState)
 import           GHRB.Core.Types               (Args, Running (Running), St,
                                                 getAllPackages, getPquery,
@@ -43,6 +44,7 @@ builder ::
      , State St :> es
      , Reader Args :> es
      , Time :> es
+     , Concurrent :> es
      , IOE :> es
      )
   => Eff es ()
@@ -68,4 +70,4 @@ main =
               Right set -> do
                 untried' <- liftIO . shuffleIO . toList $ set
                 let state = initialState {untried = untried'}
-                runTime . evalState state $ finally builder terminate
+                runConcurrent . runTime . evalState state $ finally builder terminate

eff/Data/Conduit/Process/Effectful.hs

@@ -5,45 +5,47 @@ module Data.Conduit.Process.Effectful
   ( sourceProcessWithStreams
   ) where
 
-import           Control.Concurrent.Async (Concurrently (..), runConcurrently)
-import           Control.Exception        (finally, onException)
-import           Data.ByteString          (ByteString)
-import           Data.Conduit             (ConduitT, runConduit, (.|))
-import           Data.Conduit.Process     (StreamingProcessHandle,
-                                           streamingProcess,
-                                           streamingProcessHandleRaw,
-                                           waitForStreamingProcess)
-import           Data.Void                (Void)
-import           Effectful                (Eff, IOE, Limit (Unlimited),
-                                           Persistence (Ephemeral),
-                                           UnliftStrategy (ConcUnlift),
-                                           withEffToIO, (:>))
-import           System.Exit              (ExitCode)
-import           System.Process           (CreateProcess, terminateProcess)
+import           Data.ByteString            (ByteString)
+import           Data.Conduit               (ConduitT, runConduit, (.|))
+import           Data.Conduit.Process       (StreamingProcessHandle,
+                                             streamingProcess,
+                                             streamingProcessHandleRaw,
+                                             waitForStreamingProcess)
+import           Data.Void                  (Void)
+import           Effectful                  (Eff, IOE, Limit (Unlimited),
+                                             Persistence (Ephemeral),
+                                             UnliftStrategy (ConcUnlift),
+                                             liftIO, withEffToIO, (:>))
+import           Effectful.Concurrent.Async (Concurrent, Concurrently (..),
+                                             runConcurrently)
+import           Effectful.Exception        (finally, onException)
+import           Effectful.Process          (CreateProcess, Process,
+                                             terminateProcess)
+import           System.Exit                (ExitCode)
 
 sourceProcessWithStreams ::
-     (IOE :> es)
+     (Process :> es, Concurrent :> es, IOE :> es)
   => CreateProcess
   -> ConduitT () ByteString (Eff es) ()
   -> ConduitT ByteString Void (Eff es) a
   -> ConduitT ByteString Void (Eff es) b
   -> Eff es (ExitCode, a, b)
-sourceProcessWithStreams cp producerStdin consumerStdout consumerStderr =
-  withEffToIO (ConcUnlift Ephemeral Unlimited) $ \u -> do
-    ((sinkStdin, closeStdin), (sourceStdout, closeStdout), (sourceStderr, closeStderr), sph) <-
-      streamingProcess cp
-    (_, resStdout, resStderr) <-
-      runConcurrently
-        ((,,)
-           <$> Concurrently
-                 (u (runConduit $ producerStdin .| sinkStdin)
-                    `finally` closeStdin)
-           <*> Concurrently (u $ runConduit $ sourceStdout .| consumerStdout)
-           <*> Concurrently (u $ runConduit $ sourceStderr .| consumerStderr))
-        `finally` (closeStdout >> closeStderr)
-        `onException` terminateStreamingProcess sph
-    ec <- waitForStreamingProcess sph
-    return (ec, resStdout, resStderr)
+sourceProcessWithStreams cp producerStdin consumerStdout consumerStderr = do
+  ((sinkStdin, closeStdin), (sourceStdout, closeStdout), (sourceStderr, closeStderr), sph) <-
+    streamingProcess cp
+  (_, resStdout, resStderr) <-
+    runConcurrently
+      ((,,)
+         <$> Concurrently
+               (runConduit (producerStdin .| sinkStdin) `finally` closeStdin)
+         <*> Concurrently (runConduit (sourceStdout .| consumerStdout))
+         <*> Concurrently
+               (runConduit (sourceStderr .| consumerStderr)
+                  `finally` (closeStdout >> closeStderr)))
+      `onException` terminateStreamingProcess sph
+  ec <- waitForStreamingProcess sph
+  return (ec, resStdout, resStderr)
 
-terminateStreamingProcess :: StreamingProcessHandle -> IO ()
+terminateStreamingProcess ::
+     (Process :> es) => StreamingProcessHandle -> Eff es ()
 terminateStreamingProcess = terminateProcess . streamingProcessHandleRaw

src/GHRB/IO.hs

@@ -16,6 +16,7 @@ import qualified Data.Text                     as T (unpack)
 import           Data.Time.Clock               (UTCTime)
 import           Distribution.Portage.Types    (Package)
 import           Effectful                     (Eff, IOE, (:>))
+import           Effectful.Concurrent          (Concurrent)
 import           Effectful.FileSystem          (FileSystem)
 import           Effectful.Process             (Process,
                                                 readProcessWithExitCode)
@@ -86,7 +87,12 @@ runEmerge args pkg =
       ""
 
 runHaskellUpdater ::
-     (IOE :> es, FileSystem :> es, Process :> es, Reader Args :> es)
+     ( IOE :> es
+     , FileSystem :> es
+     , Process :> es
+     , Reader Args :> es
+     , Concurrent :> es
+     )
   => Eff es (ExitCode, Stdout, Stderr)
 runHaskellUpdater =
   asks getHU >>= \haskellUpdater -> runTransparent haskellUpdater defaultHUArgs
@@ -166,6 +172,7 @@ install ::
      , Reader Args :> es
      , Process :> es
      , Time :> es
+     , Concurrent :> es
      )
   => Eff es (EmergeResult, Running)
 install = do
@@ -255,7 +262,8 @@ capturePortageOutput ::
   -> Eff es (ExitCode, String)
 capturePortageOutput pkg = do
   emerge <- asks getEmerge
-  stderr (emerge ++ " " ++ unwords defaultEmergeArgs ++ " " ++ "--pretend --color=y")
+  stderr
+    (emerge ++ " " ++ unwords defaultEmergeArgs ++ " " ++ "--pretend --color=y")
   (exitCode, stdOut, stdErr) <- runEmerge ["--pretend", "--color=y"] pkg
   let output = stdOut ++ stdErr
   stderr ("pretend_return: " ++ output)
@@ -283,6 +291,7 @@ randomBuild ::
      , Reader Args :> es
      , Process :> es
      , Time :> es
+     , Concurrent :> es
      , IOE :> es
      )
   => Eff es Running

src/GHRB/IO/Cmd.hs

@@ -17,8 +17,10 @@ import           Data.Conduit                       (ConduitT, (.|))
 import           Data.Conduit.Process.Effectful     (sourceProcessWithStreams)
 import           Data.Void                          (Void)
 import           Effectful                          (Eff, IOE, (:>))
+import           Effectful.Concurrent               (Concurrent)
 import           Effectful.FileSystem               (FileSystem)
 import           Effectful.FileSystem.IO.ByteString as BS (hPut)
+import           Effectful.Process                  (Process)
 import           Effectful.Reader.Static            (Reader)
 import           GHRB.Core.Types                    (Args, Stderr, Stdout)
 import           GHRB.Core.Utils                    (prettyMessage)
@@ -65,7 +67,12 @@ installedArgs = ["-I"]
 -- | Run a command and dump stdout to @stdout@, stderr to @stderr@, also
 --   capturing both streams.
 runTransparent ::
-     (IOE :> es, FileSystem :> es, Reader Args :> es)
+     ( IOE :> es
+     , FileSystem :> es
+     , Reader Args :> es
+     , Concurrent :> es
+     , Process :> es
+     )
   => FilePath -- ^ executable path
   -> [String] -- ^ arguments
        -- | Exit code, stdout, stderr