From 4415bc17d6e7dc493e0ba036c397559d9b43477f Mon Sep 17 00:00:00 2001
From: Greg Pfeil <greg@technomadic.org>
Date: Sun, 14 Jun 2026 15:29:12 -0600
Subject: [PATCH] Add extra support for using `Duoidal` with `do`

---
 core/duoids.cabal                |  3 ++
 core/src/Control/Duoidal/Do.hs   | 44 +++++++++++++++++++++++
 core/src/Control/Duoidal/Fail.hs | 60 ++++++++++++++++++++++++++++++++
 core/src/Control/Duoidal/Fix.hs  | 57 ++++++++++++++++++++++++++++++
 4 files changed, 164 insertions(+)
 create mode 100644 core/src/Control/Duoidal/Do.hs
 create mode 100644 core/src/Control/Duoidal/Fail.hs
 create mode 100644 core/src/Control/Duoidal/Fix.hs

diff --git a/core/duoids.cabal b/core/duoids.cabal
index fb3636c..21a8f39 100644
--- a/core/duoids.cabal
+++ b/core/duoids.cabal
@@ -141,7 +141,10 @@ library
     src
   exposed-modules:
     Control.Duoidal
+    Control.Duoidal.Do
     Control.Duoidal.Either
+    Control.Duoidal.Fail
+    Control.Duoidal.Fix
     Control.Duoidal.Laws
     Data.Duoid
     Data.Duoid.Laws
diff --git a/core/src/Control/Duoidal/Do.hs b/core/src/Control/Duoidal/Do.hs
new file mode 100644
index 0000000..fa68534
--- /dev/null
+++ b/core/src/Control/Duoidal/Do.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE Safe #-}
+
+-- |
+-- Copyright: 2026 Greg Pfeil
+-- License: AGPL-3.0-only WITH Universal-FOSS-exception-1.0 OR LicenseRef-proprietary
+--
+-- Re-export all of the operations used by @do@ notation (including with
+-- [@ApplicativeDo@](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/applicative_do.html)
+-- and
+-- [@RecursiveDo@](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/recursive_do.html)).
+-- This way you can use
+--
+-- > :seti -XApplicativeDo
+-- > :seti -XQualifiedDo
+-- > import "duoids" Control.Duoidal.Do qualified as Duoidal
+--
+-- and get duoidal semantics with @Duoidal.do@. Alternatively,
+--
+-- > :seti -XApplicativeDo
+-- > :seti -XRebindableSyntax
+-- > import "duoids" Control.Duoidal.Do -- intentionally omitted import list
+--
+-- to get duoidal semantics with /all/ @do@ blocks. I would use this approach
+-- myself if
+-- [@RebindableSyntax@](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/rebindable_syntax.html)
+-- were more fine-grained.
+--
+-- @since 99999
+module Control.Duoidal.Do
+  ( fail,
+    fmap,
+    join,
+    mfix,
+    return,
+    (<*>),
+    (>>),
+    (>>=),
+  )
+where
+
+import "base" Data.Functor (fmap)
+import "this" Control.Duoidal (join, return, (<*>), (>>), (>>=))
+import "this" Control.Duoidal.Fail (fail)
+import "this" Control.Duoidal.Fix (mfix)
diff --git a/core/src/Control/Duoidal/Fail.hs b/core/src/Control/Duoidal/Fail.hs
new file mode 100644
index 0000000..4f4e2d2
--- /dev/null
+++ b/core/src/Control/Duoidal/Fail.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+-- NOTE: `HasCallStack` is seen as redundant.
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+
+-- |
+-- Copyright: 2026 Greg Pfeil
+-- License: AGPL-3.0-only WITH Universal-FOSS-exception-1.0 OR LicenseRef-proprietary
+--
+-- @since 99999
+module Control.Duoidal.Fail
+  ( fail,
+    sequentialFail,
+  )
+where
+
+import "base" Control.Category ((.))
+import "base" Control.Monad (Monad)
+import "base" Control.Monad.Fail (MonadFail)
+import "base" Control.Monad.Fail qualified as Monad
+import "base" Data.Maybe (Maybe)
+import "base" Data.Monoid (Ap (Ap))
+import "base" Data.String (String)
+import "base" GHC.Stack (HasCallStack)
+import "base" System.IO (IO)
+import "this" Control.Duoidal (Sequential (Sequential), getSequential)
+
+-- | A `Control.Duoidal.Duoidal` version of `Monad.fail`.
+--
+-- @since 99999
+fail :: (HasCallStack, MonadFail (Sequential f)) => String -> f a
+fail = getSequential . Monad.fail
+
+-- | Lift the underlying `Monad`’s `fail` to `Control.Duoidal.Duoidal`.
+--
+-- @since 99999
+sequentialFail :: (MonadFail f) => String -> Sequential f a
+sequentialFail = Sequential . Monad.fail
+
+-- |
+--
+-- @since 99999
+instance MonadFail (Sequential IO) where
+  fail = sequentialFail
+
+-- |
+--
+-- @since 99999
+instance MonadFail (Sequential Maybe) where
+  fail = sequentialFail
+
+-- |
+--
+-- @since 99999
+instance
+  (MonadFail (Sequential f), Monad (Sequential (Ap f))) =>
+  MonadFail (Sequential (Ap f))
+  where
+  fail = Sequential . Ap . fail
diff --git a/core/src/Control/Duoidal/Fix.hs b/core/src/Control/Duoidal/Fix.hs
new file mode 100644
index 0000000..fbe733d
--- /dev/null
+++ b/core/src/Control/Duoidal/Fix.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- |
+-- Copyright: 2026 Greg Pfeil
+-- License: AGPL-3.0-only WITH Universal-FOSS-exception-1.0 OR LicenseRef-proprietary
+--
+-- @since 99999
+module Control.Duoidal.Fix
+  ( mfix,
+    sequentialMfix,
+  )
+where
+
+import "base" Control.Category ((.))
+import "base" Control.Monad (Monad)
+import "base" Control.Monad.Fix (MonadFix)
+import "base" Control.Monad.Fix qualified as Monad
+import "base" Data.Function (($))
+import "base" Data.Maybe (Maybe)
+import "base" Data.Monoid (Ap (Ap), getAp)
+import "base" System.IO (IO)
+import "this" Control.Duoidal (Sequential (Sequential), getSequential)
+
+-- | A `Control.Duoidal.Duoidal` version of `Monad.fail`.
+--
+-- @since 99999
+mfix :: (MonadFix (Sequential f)) => (a -> f a) -> f a
+mfix f = getSequential . Monad.mfix $ Sequential . f
+
+-- | Lift the underlying `Monad`’s `mfix` to `Control.Duoidal.Duoidal`.
+--
+-- @since 99999
+sequentialMfix :: (MonadFix f) => (a -> Sequential f a) -> Sequential f a
+sequentialMfix f = Sequential . Monad.mfix $ getSequential . f
+
+-- |
+--
+-- @since 99999
+instance MonadFix (Sequential IO) where
+  mfix = sequentialMfix
+
+-- |
+--
+-- @since 99999
+instance MonadFix (Sequential Maybe) where
+  mfix = sequentialMfix
+
+-- |
+--
+-- @since 99999
+instance
+  (MonadFix (Sequential f), Monad (Sequential (Ap f))) =>
+  MonadFix (Sequential (Ap f))
+  where
+  mfix f = Sequential . Ap . mfix $ getAp . getSequential . f