typed-process-effectful (empty) → 1.0.0.0

raw patch · 7 files changed

+556/−0 lines, 7 filesdep +basedep +bytestringdep +effectful

Dependencies added: base, bytestring, effectful, effectful-core, tasty, tasty-hunit, typed-process, typed-process-effectful

Files

• CHANGELOG.md +4/−0
• LICENSE.md +26/−0
• README.md +30/−0
• src/Effectful/Process/Typed.hs +246/−0
• test/Main.hs +137/−0
• test/Utils.hs +40/−0
• typed-process-effectful.cabal +73/−0

@@ -0,0 +1,4 @@+# CHANGELOG++## v1.0.0.0 (2023-08-23)+* Initial release

@@ -0,0 +1,26 @@+Copyright (c) 2021-2022, Dominik Peteler++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS 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.

@@ -0,0 +1,30 @@+# typed-process-effectful++## Description++An alternative `Process` effect for the [`effectful`][effectful] ecosystem.+While to the `Process` effect shipped with the `effectful` library is based on+the [`process`][process] package this implementation relies on+[`typed-process`][typed-process] instead.++## How to use++The functions exposed by the `Effectful.Process.Typed` module are those from+[`System.Process.Typed`](https://hackage.haskell.org/package/typed-process-0.2.6.1/docs/System-Process-Typed.html)+with the notable difference that they have a `TypedProcess :> es` constraint.+Use `runTypedProcess` to handle the effect and eliminate the constraint.++```haskell+import Effectful.Monad+import Effectful.Process.Typed++main :: IO ()+main = runEff . runTypedProcess $ true++true :: TypedProcess :> es => Eff es ()+true = Effectful.Process.Typed.runProcess_ $ shell "true"+```++[effectful]: https://github.com/haskell-effectful/effectful+[process]: https://hackage.haskell.org/package/process+[typed-process]: https://hackage.haskell.org/package/typed-process

@@ -0,0 +1,246 @@+{-|+Module      : Effectful.Process.Typed+Description : effectful bindings for typed-process+Copyright   : (c) 2022 Dominik Peteler+License     : BSD-3-Clause+Stability   : stable++This module provides [effectful](https://hackage.haskell.org/package/effectful)+bindings for [typed-process](https://hackage.haskell.org/package/typed-process).+-}+{-# OPTIONS_GHC -fno-warn-dodgy-imports #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+module Effectful.Process.Typed+  ( -- * Process effect+    TypedProcess+  , runTypedProcess++  -- * Launch a process+  , startProcess+  , stopProcess+  , withProcessWait+  , withProcessWait_+  , withProcessTerm+  , withProcessTerm_+  , readProcess+  , readProcess_+  , runProcess+  , runProcess_+  , readProcessStdout+  , readProcessStdout_+  , readProcessStderr+  , readProcessStderr_+  , readProcessInterleaved+  , readProcessInterleaved_++  -- * Process exit code+  , waitExitCode+  , getExitCode+  , checkExitCode++  -- * Re-exports from "System.Process.Typed"+  , module Reexport+#if ! MIN_VERSION_typed_process(0,2,8)+  , ExitCode(..)+#endif+  ) where++import System.Process.Typed as Reexport hiding+  ( startProcess+  , stopProcess+  , withProcessWait+  , withProcessWait_+  , withProcessTerm+  , withProcessTerm_+  , readProcess+  , readProcess_+  , runProcess+  , runProcess_+  , readProcessStdout+  , readProcessStdout_+  , readProcessStderr+  , readProcessStderr_+  , readProcessInterleaved+  , readProcessInterleaved_+  , waitExitCode+  , getExitCode+  , checkExitCode+  )++import Data.ByteString.Lazy (ByteString)+import qualified System.Process.Typed as PT++import Effectful+import qualified Effectful.Process+import Effectful.Dispatch.Static++#if ! MIN_VERSION_typed_process(0,2,8)+import System.Exit (ExitCode(..))+#endif++----------------------------------------+-- Effect & Handler++-- | We provide a type synonym for the 'Effectful.Process.Process' effect since+-- it clashes with 'PT.Process' type of @typed-process@.+type TypedProcess = Effectful.Process.Process++-- | This is merely an alias for 'Effectful.Process.runProcess' since that name+-- clashes with 'runProcess', i.e.:+--+-- > runTypedProcess = Effectful.Process.runProcess+runTypedProcess :: IOE :> es => Eff (TypedProcess : es) a -> Eff es a+runTypedProcess = Effectful.Process.runProcess++----------------------------------------+-- Launch a process++-- | Lifted 'PT.startProcess'.+startProcess :: TypedProcess :> es+             => PT.ProcessConfig stdin stdout stderr+             -> Eff es (PT.Process stdin stdout stderr)+startProcess = unsafeEff_ . PT.startProcess++-- | Lifted 'PT.stopProcess'.+stopProcess :: TypedProcess :> es => PT.Process stdin stdout stderr -> Eff es ()+stopProcess = unsafeEff_ . PT.stopProcess++-- | Lifted 'PT.withProcessWait'.+withProcessWait :: TypedProcess :> es+                => PT.ProcessConfig stdin stdout stderr+                -> (PT.Process stdin stdout stderr -> Eff es a)+                -> Eff es a+withProcessWait = liftWithProcess PT.withProcessWait++-- | Lifted 'PT.withProcessWait_'.+withProcessWait_ :: TypedProcess :> es+                 => PT.ProcessConfig stdin stdout stderr+                 -> (PT.Process stdin stdout stderr -> Eff es a)+                 -> Eff es a+withProcessWait_ = liftWithProcess PT.withProcessWait_++-- | Lifted 'PT.withProcessTerm'.+withProcessTerm :: TypedProcess :> es+                => PT.ProcessConfig stdin stdout stderr+                -> (PT.Process stdin stdout stderr -> Eff es a)+                -> Eff es a+withProcessTerm = liftWithProcess PT.withProcessTerm++-- | Lifted 'PT.withProcessTerm_'.+withProcessTerm_ :: TypedProcess :> es+                 => PT.ProcessConfig stdin stdout stderr+                 -> (PT.Process stdin stdout stderr -> Eff es a)+                 -> Eff es a+withProcessTerm_ = liftWithProcess PT.withProcessTerm_++-- | Lifted 'PT.readProcess'.+readProcess :: TypedProcess :> es+            => PT.ProcessConfig stdin stdoutIgnored stderrIgnored+            -> Eff es (ExitCode, ByteString, ByteString)+readProcess = unsafeEff_ . PT.readProcess++-- | Lifted 'PT.readProcess_'.+readProcess_ :: TypedProcess :> es+             => PT.ProcessConfig stdin stdoutIgnored stderrIgnored+             -> Eff es (ByteString, ByteString)+readProcess_ = unsafeEff_ . PT.readProcess_++-- | Lifted 'PT.runProcess'.+runProcess :: TypedProcess :> es+           => PT.ProcessConfig stdin stdout stderr+           -> Eff es ExitCode+runProcess = unsafeEff_ . PT.runProcess++-- | Lifted 'PT.runProcess_'.+runProcess_ :: TypedProcess :> es+            => PT.ProcessConfig stdin stdout stderr+            -> Eff es ()+runProcess_ = unsafeEff_ . PT.runProcess_++-- | Lifted 'PT.readProcessStdout'.+readProcessStdout :: TypedProcess :> es+                 => PT.ProcessConfig stdin stdoutIgnored stderr+                 -> Eff es (ExitCode, ByteString)+readProcessStdout = unsafeEff_ . PT.readProcessStdout++-- | Lifted 'PT.readProcessStdout_'.+readProcessStdout_ :: TypedProcess :> es+                  => PT.ProcessConfig stdin stdoutIgnored stderr+                  -> Eff es ByteString+readProcessStdout_ = unsafeEff_ . PT.readProcessStdout_++-- | Lifted 'PT.readProcessStderr'.+readProcessStderr :: TypedProcess :> es+                 => PT.ProcessConfig stdin stdout stderrIgnored+                 -> Eff es (ExitCode, ByteString)+readProcessStderr = unsafeEff_ . PT.readProcessStderr++-- | Lifted 'PT.readProcessStderr_'.+readProcessStderr_ :: TypedProcess :> es+                  => PT.ProcessConfig stdin stdout stderrIgnored+                  -> Eff es ByteString+readProcessStderr_ = unsafeEff_ . PT.readProcessStderr_++-- | Lifted 'PT.readProcessInterleaved'.+readProcessInterleaved :: TypedProcess :> es+                      => PT.ProcessConfig stdin stdoutIgnored stderrIgnored+                      -> Eff es (ExitCode, ByteString)+readProcessInterleaved = unsafeEff_ . PT.readProcessInterleaved++-- | Lifted 'PT.readProcessInterleaved_'.+readProcessInterleaved_ :: TypedProcess :> es+                       => PT.ProcessConfig stdin stdoutIgnored stderrIgnored+                       -> Eff es ByteString+readProcessInterleaved_ = unsafeEff_ . PT.readProcessInterleaved_++----------------------------------------+-- Process exit code++-- | Lifted 'PT.waitExitCode'.+waitExitCode :: TypedProcess :> es+             => PT.Process stdin stdout stderr+             -> Eff es ExitCode+waitExitCode = unsafeEff_ . PT.waitExitCode++---- | Lifted 'PT.waitExitCodeSTM'.+--waitExitCodeSTM :: TypedProcess :> es+--                => PT.Process stdin stdout stderr+--                -> Eff es ExitCode+--waitExitCodeSTM = unsafeEff_ . PT.waitExitCode++-- | Lifted 'PT.getExitCode'.+getExitCode :: TypedProcess :> es+            => PT.Process stdin stdout stderr+            -> Eff es (Maybe ExitCode)+getExitCode = unsafeEff_ . PT.getExitCode++---- | Lifted 'PT.getExitCodeSTM'.+--getExitCodeSTM :: TypedProcess :> es+--               => PT.Process stdin stdout stderr+--               -> Eff es (Maybe ExitCode)+--getExitCodeSTM = unsafeEff_ . PT.getExitCodeSTM++-- | Lifted 'PT.checkExitCode'.+checkExitCode :: TypedProcess :> es+              => PT.Process stdin stdout stderr+              -> Eff es ()+checkExitCode = unsafeEff_ . PT.checkExitCode++---- | Lifted 'PT.checkExitCodeSTM'.+--checkExitCodeSTM :: TypedProcess :> es+--                 => PT.Process stdin stdout stderr+--                 -> Eff es ()+--checkExitCodeSTM = unsafeEff_ . PT.checkExitCodeSTM++----------------------------------------+-- Helpers++liftWithProcess :: TypedProcess :> es+                => (PT.ProcessConfig stdin stdout stderr -> (PT.Process stdin stdout stderr -> IO a) -> IO a)+                -> PT.ProcessConfig stdin stdout stderr+                -> (PT.Process stdin stdout stderr -> Eff es a)+                -> Eff es a+liftWithProcess k pc f = unsafeEff $ \es ->+  seqUnliftIO es $ \runInIO ->+    k pc (runInIO . f)

@@ -0,0 +1,137 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Effectful+import Effectful.Temporary+import System.IO.Error (isDoesNotExistError)+import qualified Utils as U++import Effectful.Process.Typed+import Test.Tasty.HUnit (Assertion, testCase)+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main = defaultMain $ testGroup "typed-process-effectful"+  [ testCase "Existing executable" testExistingExecutable+  , testCase "Non-existent executable" testNonExistentExecutable+  , testCase "Continue process execution" testContinueProcessExecution+  , testCase "Terminate process" testTerminateProcess+  , testCase "Wait for process" testWaitForProcess+  , testCase "Helper functions" testHelperFunctions+  , testCase "Exit Codes" testExitCodes+  ]++testExistingExecutable :: Assertion+testExistingExecutable = runEff $ do+  let pc = proc "/usr/bin/env" ["true"]+      action =  runTypedProcess $ do+        p <- startProcess pc+        waitExitCode p+  result <- action+  U.assertEqual "Executable exists" ExitSuccess result++testNonExistentExecutable :: Assertion+testNonExistentExecutable = runEff $ do+  let pc = proc "/bin/doesnotexist" []+  let action = runTypedProcess $ do+        p <- startProcess pc+        waitExitCode p+  U.assertException (runEff action) isDoesNotExistError++testContinueProcessExecution :: Assertion+testContinueProcessExecution = runEff $ do+  let pc = shell "sleep 3"+      action =  runTypedProcess $ do+        p <- startProcess pc+        getExitCode p+  result <- action+  U.assertEqual "" result Nothing++testTerminateProcess :: Assertion+testTerminateProcess = runEff $ do+  let action =  runTemporary . runTypedProcess $ do+        withSystemTempFile "typed-process-effectful-test" $ \fp h -> do+          let pc = setStdout (useHandleClose h)+                 $ shell "sleep 1; printf 'Output'"+          withProcessTerm pc (const $ pure ())+          liftIO $ readFile fp+  result <- action+  U.assertEqual "" "" result++testWaitForProcess :: Assertion+testWaitForProcess = runEff $ do+  let action =  runTemporary . runTypedProcess $ do+        withSystemTempFile "typed-process-effectful-test" $ \fp h -> do+          let pc = setStdout (useHandleClose h)+                 $ shell "sleep 1; printf 'Output'"+          withProcessWait pc (const $ pure ())+          liftIO $ readFile fp+  result <- action+  U.assertEqual "" result "Output"++testHelperFunctions :: Assertion+testHelperFunctions = runEff $ do+  let pc = proc "/usr/bin/env" ["true"]+      action = runTypedProcess $ do+        runProcess pc+  result <- action+  U.assertEqual "" result ExitSuccess++  let pc2 = proc "/usr/bin/env" ["true"]+  result2 <- runTypedProcess $ do+        runProcess_ pc2+  U.assertEqual "" result2  ()++  let pc3 = shell "printf 'stdout'; printf 'stderr' >&2"+  result3 <- runTypedProcess $ do+        readProcess pc3+  U.assertEqual "" result3  (ExitSuccess, "stdout", "stderr")++  let pc4 = shell "printf 'stdout'; printf 'stderr' >&2"+  result4 <- runTypedProcess $ do+        readProcess_ pc4+  U.assertEqual "" result4 ("stdout", "stderr")++  let pc5 = shell "printf 'Output'"+  result5 <- runTypedProcess $ do+        readProcessStdout pc5+  U.assertEqual "" result5 (ExitSuccess, "Output")++  let pc6 = shell "printf 'Output'"+  result6 <- runTypedProcess $ do+        readProcessStdout pc6+  U.assertEqual "" result6 (ExitSuccess, "Output")++  let pc7 = shell "printf 'Output'"+  result7 <- runTypedProcess $ do+        readProcessStdout_ pc7+  U.assertEqual "" result7 "Output"++  let pc8 = shell "printf 'Output' >&2"+  result8 <- runTypedProcess $ do+        readProcessStderr pc8+  U.assertEqual "" result8 (ExitSuccess, "Output")++testExitCodes :: Assertion+testExitCodes = runEff $ do+  let pc = proc "/usr/bin/env" ["false"]+      action = runEff . runTypedProcess $ do+          runProcess_ pc+  U.assertException action (const @_ @ExitCodeException True)++  let pc2 = proc "/usr/bin/env" ["false"]+      action2 = runEff . runTypedProcess $ do+        readProcess_ pc2+  U.assertException action2 (const @_ @ExitCodeException True)++  let pc3 = proc "/usr/bin/env" ["false"]+      action3 = runEff . runTypedProcess $ do+        readProcessStdout_ pc3+  U.assertException action3 (const @_ @ExitCodeException True)++  let pc4 = proc "/usr/bin/env" ["false"]+      action4 = runEff . runTypedProcess $ do+        readProcessStderr_ pc4+  U.assertException action4 (const @_ @ExitCodeException True)

@@ -0,0 +1,40 @@+{-# LANGUAGE RankNTypes #-}+module Utils+  ( assertBool+  , assertEqual+  , assertFailure+  , assertException+  ) where++import GHC.Stack+import qualified Test.Tasty.HUnit as T++import Effectful+import Control.Exception++assertBool :: (HasCallStack, IOE :> es) => String -> Bool -> Eff es ()+assertBool msg p = liftIO $ T.assertBool msg p++assertEqual+  :: (HasCallStack, Eq a, Show a, IOE :> es)+  => String+  -> a+  -> a+  -> Eff es ()+assertEqual msg expected given = liftIO $ T.assertEqual msg expected given++assertFailure :: (HasCallStack, IOE :> es) => String -> Eff es a+assertFailure msg = liftIO $ T.assertFailure msg++assertException :: forall e es a+                . (HasCallStack, Exception e, IOE :> es)+                => IO a+                -> (e -> Bool)+                -> Eff es ()+assertException action expectedClassifier = do+  r <- liftIO $ try action+  case r of+      Right _ ->+        assertFailure "The action did not raise an exception"+      Left e ->+        assertBool "The expected exception doesn't match what was given" (expectedClassifier e)

@@ -0,0 +1,73 @@+cabal-version:   3.0+name:            typed-process-effectful+version:         1.0.0.0+synopsis:+  A binding of the @typed-process@ library for the @effectful@ effect system.++description:+  This library provides an alternative `Process` effect for the+  [effectful](https://github.com/haskell-effectful/effectful) ecosystem.+  While to the `Process` effect shipped with the `effectful` library is based on+  the [process](https://hackage.haskell.org/package/process) package this+  implementation relies on+  [typed-process](https://hackage.haskell.org/package/typed-process) instead.++category:        System+homepage:+  https://github.com/haskell-effectful/typed-process-effectful#readme++bug-reports:+  https://github.com/haskell-effectful/typed-process-effectful/issues++author:          Dominik Peteler+maintainer:      hackage+typed-process-effectful@with-h.at+license:         BSD-3-Clause+build-type:      Simple+extra-doc-files:+  CHANGELOG.md+  LICENSE.md+  README.md++tested-with:     GHC ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4 || ==9.6.1++source-repository head+  type:     git+  location:+    https://github.com/haskell-effectful/typed-process-effectful++common language+  ghc-options:        -Wall -Wcompat+  default-language:   Haskell2010+  default-extensions:+    DataKinds+    FlexibleContexts+    GADTs+    KindSignatures+    TypeOperators++library+  import:          language+  hs-source-dirs:  src+  exposed-modules: Effectful.Process.Typed+  build-depends:+    , base            >=4.14  && <5+    , bytestring      <0.12+    , effectful       >=2.0   && <2.3+    , effectful-core  >=2.0   && <2.3+    , typed-process   >=0.2.5 && <0.3++test-suite typed-process-effectful-test+  import:         language+  ghc-options:    -rtsopts -threaded -with-rtsopts=-N+  build-depends:+    , base+    , effectful+    , effectful-core+    , tasty                    >=1.4  && <1.5+    , tasty-hunit              >=0.10 && <0.11+    , typed-process-effectful++  hs-source-dirs: test+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  other-modules:  Utils