Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions core/duoids.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
44 changes: 44 additions & 0 deletions core/src/Control/Duoidal/Do.hs
Original file line number Diff line number Diff line change
@@ -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)
60 changes: 60 additions & 0 deletions core/src/Control/Duoidal/Fail.hs
Original file line number Diff line number Diff line change
@@ -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
57 changes: 57 additions & 0 deletions core/src/Control/Duoidal/Fix.hs
Original file line number Diff line number Diff line change
@@ -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
Loading