effectful stuff

.github/workflows/ci.yaml

@@ -5,6 +5,7 @@ on: # yamllint disable-line rule:truthy rule:comments
     branches:
       - main
       - release
+      - effectful
   pull_request:
     branches:
       - main
@@ -42,8 +43,9 @@ jobs:
             --ghc-options -Werror
 
       - name: Compile
-        run: cabal build ${{ matrix.ghc.proj-file }} lib:shrun
-
+        # yamllint disable rule:line-length
+        run: cabal build ${{ matrix.ghc.proj-file }} lib:shrun --minimize-conflict-set
+        # yamllint enable
       - name: Unit Tests
         run: |
           cabal test ${{ matrix.ghc.proj-file }} unit \

.hlint.yaml

@@ -14,7 +14,7 @@
       - "Shrun.Configuration.Toml"
       - "Shrun.Data.Command"
       - "Shrun.Logging.Types"
-      - "Shrun.Notify.MonadNotify"
+      - "Shrun.Notify.Effect"
       - "Functional.Prelude"
       - "Functional.TestArgs"
       - "Integration.Prelude"

app/Main.hs

@@ -1,6 +1,8 @@
 module Main (main) where
 
 import Shrun.Configuration.Env (makeEnvAndShrun)
+import Shrun.Logging.RegionLogger (runRegionLogger)
+import Shrun.Notify.DBus (runDBus)
 import Shrun.Prelude hiding (IO)
 import Prelude (IO)
 
@@ -18,11 +20,28 @@ main = do
   -- is just unhelpful noise.
   setUncaughtExceptionHandlerDisplay
 
-  makeEnvAndShrun @IO @ConsoleRegion `catch` doNothingOnSuccess
+  runShrun (makeEnvAndShrun @ConsoleRegion) `catch` doNothingOnSuccess
   where
     -- We need to catch ExitCode so that optparse applicative's --help
     -- does not set the error code to failure...but then we need to rethrow
     -- failures.
     doNothingOnSuccess :: ExitCode -> IO ()
     doNothingOnSuccess ExitSuccess = pure ()
     doNothingOnSuccess ex@(ExitFailure _) = throwM ex
+
+    runShrun =
+      runEff
+        . runConcurrent
+        . runTypedProcess
+        . runIORef
+        . runOptparse
+        . runTime
+        . runFileReader
+        . runFileWriter
+        . runHandleReader
+        . runHandleWriter
+        . runPathReader
+        . runPathWriter
+        . runTerminal
+        . runRegionLogger
+        . runDBus

benchmarks/Bench/Prelude.hs

@@ -18,18 +18,17 @@ import Shrun.Configuration.Env.Types
     HasNotifyConfig,
     HasTimeout,
   )
-import Shrun.Logging.MonadRegionLogger
-  ( MonadRegionLogger
-      ( Region,
-        displayRegions,
-        logGlobal,
-        logRegion,
-        withRegion
+import Shrun.Logging.RegionLogger
+  ( RegionLogger
+      ( DisplayRegions,
+        LogGlobal,
+        LogRegion,
+        WithRegion
       ),
   )
-import Shrun.Notify.MonadNotify (MonadNotify (notify))
+import Shrun.Notify.DBus (runDBus)
+import Shrun.Notify.Effect (Notify (Notify))
 import Shrun.Prelude
-import Shrun.ShellT (ShellT)
 import System.Environment qualified as SysEnv
 
 newtype BenchEnv = MkBenchEnv
@@ -49,22 +48,45 @@ newtype BenchEnv = MkBenchEnv
 instance HasConsoleLogging BenchEnv () where
   getConsoleLogging = getConsoleLogging . (.unCoreEnv)
 
-instance MonadRegionLogger (ShellT BenchEnv IO) where
-  type Region (ShellT BenchEnv IO) = ()
+runRegionLogger ::
+  ( r ~ (),
+    IOE :> es
+  ) =>
+  Eff (RegionLogger r : es) a ->
+  Eff es a
+runRegionLogger = interpret $ \env -> \case
+  LogGlobal _ -> pure ()
+  LogRegion {} -> pure ()
+  WithRegion _ regionToShell -> localSeqUnliftIO env $ \unlift ->
+    unlift (regionToShell ())
+  DisplayRegions m -> localSeqUnliftIO env $ \unlift -> unlift m
 
-  logGlobal _ = pure ()
-
-  logRegion _ _ = logGlobal
-
-  withRegion _layout regionToShell = regionToShell ()
-
-  displayRegions = id
-
-instance MonadNotify (ShellT BenchEnv IO) where
-  notify _ = pure Nothing
+runNotify :: Eff (Notify : es) a -> Eff es a
+runNotify = interpret_ $ \case
+  Notify _ -> pure Nothing
 
 runBench :: List String -> IO ()
 runBench argList = do
-  SysEnv.withArgs argList $ Env.withEnv $ \env -> do
+  SysEnv.withArgs argList $ runShrun $ Env.withEnv $ \env -> do
     let benchEnv = MkBenchEnv env
-    SR.runShellT SR.shrun benchEnv
+    runReader benchEnv
+      $ runRegionLogger
+      $ runNotify
+      $ SR.shrun @BenchEnv @()
+  where
+    runShrun =
+      runEff
+        . runConcurrent
+        . runTypedProcess
+        . runIORef
+        . runOptparse
+        . runTime
+        . runFileReader
+        . runFileWriter
+        . runHandleReader
+        . runHandleWriter
+        . runPathReader
+        . runPathWriter
+        . runTerminal
+        . runRegionLogger
+        . runDBus

benchmarks/Main.hs

@@ -4,8 +4,9 @@ module Main (main) where
 
 import Bench.Prelude
 import Control.DeepSeq (force)
-import Effects.FileSystem.PathReader qualified as RDir
-import Effects.FileSystem.PathWriter qualified as WDir
+import Effectful.FileSystem.PathReader.Static qualified as PR
+import Effectful.FileSystem.PathWriter.Static qualified as PW
+import Effectful.Terminal.Static qualified as Term
 import FileSystem.OsPath (unsafeDecode)
 import Shrun.Prelude hiding (IO)
 import System.Environment.Guard (ExpectEnv (ExpectEnvSet), guardOrElse')
@@ -64,19 +65,39 @@ bashLoop :: String -> String
 bashLoop bound = "for i in {1.." ++ bound ++ "}; do echo ${i}; done"
 
 setup :: IO OsPath
-setup = do
+setup = runBenchEff $ do
   testDir <-
     (\tmp -> tmp </> [osp|shrun|] </> [osp|bench|])
-      <$> RDir.getTemporaryDirectory
-  WDir.createDirectoryIfMissing True testDir
+      <$> PR.getTemporaryDirectory
+  PW.createDirectoryIfMissing True testDir
   pure testDir
 
 teardown :: OsPath -> IO ()
 teardown testDir = guardOrElse' "NO_CLEANUP" ExpectEnvSet doNothing cleanup
   where
-    cleanup = WDir.removePathForcibly testDir
+    cleanup = runBenchEff $ PW.removePathForcibly testDir
     doNothing =
-      putStrLn
+      runBenchEff
+        $ Term.putStrLn
         $ "*** Not cleaning up tmp dir: '"
         <> decodeLenient testDir
         <> "'"
+
+runBenchEff ::
+  (HasCallStack, MonadIO m) =>
+  Eff
+    [ FileWriter,
+      Term.Terminal,
+      PW.PathWriter,
+      PR.PathReader,
+      IOE
+    ]
+    a ->
+  m a
+runBenchEff =
+  liftIO
+    . runEff
+    . PR.runPathReader
+    . PW.runPathWriter
+    . Term.runTerminal
+    . runFileWriter

cabal.ghc982.project.freeze

@@ -28,6 +28,7 @@ constraints: any.OneTuple ==0.4.2,
              any.cereal ==0.5.8.3,
              any.colour ==2.3.6,
              any.comonad ==5.0.8,
+             any.concurrent-effectful ==0.1,
              any.concurrent-output ==1.10.21,
              any.conduit ==1.3.5,
              any.conduit-extra ==1.3.6,
@@ -45,25 +46,18 @@ constraints: any.OneTuple ==0.4.2,
              any.directory ==1.3.8.1,
              any.distributive ==0.6.2.1,
              any.dlist ==1.0,
-             any.effects-async ==0.1,
-             any.effects-env ==0.1,
-             any.effects-fs ==0.1,
-             any.effects-ioref ==0.1,
-             any.effects-optparse ==0.1,
-             any.effects-stm ==0.1,
-             any.effects-terminal ==0.1,
-             any.effects-thread ==0.1,
-             any.effects-time ==0.1,
-             any.effects-typed-process ==0.1,
-             any.effects-unix-compat ==0.1,
+             any.effectful ==2.5.0.0,
+             any.effectful-core ==2.5.0.0,
              any.env-guard ==0.2,
+             any.environment-effectful ==0.1,
              any.erf ==2.0.0.0,
              any.exception-utils ==0.1,
              any.exceptions ==0.10.7,
              any.fdo-notify ==0.3.1,
              any.file-io ==0.1.1,
              any.filepath ==1.4.200.1,
              any.free ==5.2,
+             any.fs-effectful ==0.1,
              any.fs-utils ==0.1,
              any.generically ==0.1.1,
              any.ghc-bignum ==1.3,
@@ -78,6 +72,7 @@ constraints: any.OneTuple ==0.4.2,
              any.integer-conversion ==0.1.0.1,
              any.integer-logarithms ==1.0.3.1,
              any.invariant ==0.6.3,
+             any.ioref-effectful ==0.1,
              any.kan-extensions ==5.2.6,
              any.lens ==5.2.3,
              any.lifted-async ==0.10.2.5,
@@ -94,6 +89,7 @@ constraints: any.OneTuple ==0.4.2,
              any.old-locale ==1.0.0.7,
              any.optics-core ==0.4.1.1,
              any.optparse-applicative ==0.18.1.0,
+             any.optparse-effectful ==0.1,
              any.os-string ==2.0.2.2,
              any.parallel ==3.2.2.0,
              any.parsec ==3.1.17.0,
@@ -122,18 +118,22 @@ constraints: any.OneTuple ==0.4.2,
              any.split ==0.2.5,
              any.splitmix ==0.1.0.5,
              any.stm ==2.5.2.1,
+             any.stm-effectful ==0.1,
              any.streaming-commons ==0.2.2.6,
              any.strict ==0.5,
+             any.strict-mutable-base ==1.1.0.0,
              any.tagged ==0.8.8,
              any.tasty ==1.4.3,
-             any.tasty-bench ==0.3.5,
-             tasty-bench -debug +tasty,
+             any.tasty-bench ==0.4,
+             tasty-bench +tasty,
              any.tasty-hedgehog ==1.4.0.2,
              any.tasty-hunit ==0.10.1,
              any.template-haskell ==2.21.0.0,
+             any.terminal-effectful ==0.1,
              any.terminal-size ==0.3.4,
              any.text ==2.1.1,
              any.text-display ==0.0.5.2,
+             text-display -book,
              any.text-iso8601 ==0.1,
              any.text-short ==0.1.6,
              any.th-abstraction ==0.7.0.0,
@@ -142,13 +142,16 @@ constraints: any.OneTuple ==0.4.2,
              any.these ==1.2,
              any.time ==1.12.2,
              any.time-compat ==1.9.6.1,
+             any.time-effectful ==0.1,
              any.toml-reader ==0.2.1.0,
              any.transformers ==0.6.1.0,
              any.transformers-base ==0.4.6,
              any.transformers-compat ==0.7.2,
              any.typed-process ==0.2.11.1,
+             any.typed-process-effectful ==1.0.0.3,
              any.unix ==2.8.4.0,
-             any.unix-compat ==0.7.2,
+             any.unix-compat ==0.7.3,
+             any.unix-compat-effectful ==0.1,
              any.unliftio ==0.2.25.0,
              any.unliftio-core ==0.2.1.0,
              any.unordered-containers ==0.2.20,
@@ -162,4 +165,4 @@ constraints: any.OneTuple ==0.4.2,
              any.xml-conduit ==1.9.1.3,
              any.xml-types ==0.3.8,
              any.zlib ==0.6.3.0
-index-state: hackage.haskell.org 2024-07-02T09:47:50Z
+index-state: hackage.haskell.org 2024-11-11T04:00:37Z

cabal.project

@@ -1,4 +1,4 @@
-index-state: 2024-07-02T09:47:50Z
+index-state: 2024-11-11T04:00:37Z
 
 packages: .
 
@@ -48,20 +48,18 @@ source-repository-package
 
 source-repository-package
     type: git
-    location: https://github.com/tbidne/monad-effects.git
-    tag: 8021f9a0855e644d91b73e6b2bcf20406ebbebb8
+    location: https://github.com/tbidne/effectful-effects.git
+    tag: 3ba8c43901087915bc9418c8ed095a7fad4f8ac1
     subdir:
-      lib/effects-async
-      lib/effects-env
-      lib/effects-fs
-      lib/effects-ioref
-      lib/effects-optparse
-      lib/effects-stm
-      lib/effects-time
-      lib/effects-terminal
-      lib/effects-thread
-      lib/effects-typed-process
-      lib/effects-unix-compat
+      lib/concurrent-effectful
+      lib/environment-effectful
+      lib/fs-effectful
+      lib/ioref-effectful
+      lib/optparse-effectful
+      lib/stm-effectful
+      lib/time-effectful
+      lib/terminal-effectful
+      lib/unix-compat-effectful
 
 source-repository-package
     type: git