diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 9b1f32be..967ea1d4 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -268,11 +268,11 @@ jobs: - name: doctest run: | if [ $((HCNUMVER < 91200)) -ne 0 ] ; then cd ${PKGDIR_effectful_core} || false ; fi - if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi + if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators -XUndecidableInstances src ; fi if [ $((HCNUMVER < 91200)) -ne 0 ] ; then cd ${PKGDIR_effectful_th} || false ; fi - if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi + if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators -XUndecidableInstances src ; fi if [ $((HCNUMVER < 91200)) -ne 0 ] ; then cd ${PKGDIR_effectful} || false ; fi - if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi + if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators -XUndecidableInstances src ; fi - name: cabal check run: | cd ${PKGDIR_effectful_core} || false diff --git a/doctest.sh b/doctest.sh index 180895ea..5fd328ef 100755 --- a/doctest.sh +++ b/doctest.sh @@ -37,7 +37,8 @@ run_doctest() { -XTupleSections \ -XTypeApplications \ -XTypeFamilies \ - -XTypeOperators + -XTypeOperators \ + -XUndecidableInstances popd } diff --git a/effectful-core/CHANGELOG.md b/effectful-core/CHANGELOG.md index f58d2e17..aaea0924 100644 --- a/effectful-core/CHANGELOG.md +++ b/effectful-core/CHANGELOG.md @@ -1,3 +1,7 @@ +# effectful-core-2.6.1.0 (????-??-??) +* Add `MonadError`, `MonadReader`, `MonadState` and `MonadWriter` instances for + `Eff` for compatibility with existing code. + # effectful-core-2.6.0.0 (2025-06-13) * Adjust `generalBracket` with `base >= 4.21` to make use of the new exception annotation mechanism. diff --git a/effectful-core/effectful-core.cabal b/effectful-core/effectful-core.cabal index 26a360ea..f8e288b2 100644 --- a/effectful-core/effectful-core.cabal +++ b/effectful-core/effectful-core.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 build-type: Simple name: effectful-core -version: 2.6.0.0 +version: 2.6.1.0 license: BSD-3-Clause license-file: LICENSE category: Control @@ -60,6 +60,7 @@ common language TypeApplications TypeFamilies TypeOperators + UndecidableInstances library import: language @@ -70,6 +71,7 @@ library , containers >= 0.6 , deepseq >= 1.2 , exceptions >= 0.10.4 + , mtl >= 2.2.1 , monad-control >= 1.0.3 , primitive >= 0.7.3.0 , strict-mutable-base >= 1.1.0.0 diff --git a/effectful-core/src/Effectful/Dispatch/Dynamic.hs b/effectful-core/src/Effectful/Dispatch/Dynamic.hs index ae75c521..bee058da 100644 --- a/effectful-core/src/Effectful/Dispatch/Dynamic.hs +++ b/effectful-core/src/Effectful/Dispatch/Dynamic.hs @@ -1,6 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE UndecidableInstances #-} -- | Dynamically dispatched effects. module Effectful.Dispatch.Dynamic ( -- * Introduction @@ -349,8 +348,6 @@ import Effectful.Internal.Utils -- __orphan__, __canonical__ instance of @MonadRNG@ for 'Eff' that delegates to -- the @RNG@ effect: -- --- >>> :set -XUndecidableInstances --- -- >>> :{ -- instance RNG :> es => MonadRNG (Eff es) where -- randomInt = send RandomInt diff --git a/effectful-core/src/Effectful/Error/Dynamic.hs b/effectful-core/src/Effectful/Error/Dynamic.hs index 1f69cd6a..cbac64f6 100644 --- a/effectful-core/src/Effectful/Error/Dynamic.hs +++ b/effectful-core/src/Effectful/Error/Dynamic.hs @@ -1,6 +1,8 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- | The dynamically dispatched variant of the 'Error' effect. -- --- /Note:/ unless you plan to change interpretations at runtime, it's +-- /Note:/ unless you plan to change interpretations at runtime or you need the +-- 'MTL.MonadError' instance for compatibility with existing code, it's -- recommended to use the statically dispatched variant, -- i.e. "Effectful.Error.Static". module Effectful.Error.Dynamic @@ -28,6 +30,7 @@ module Effectful.Error.Dynamic , E.prettyCallStack ) where +import Control.Monad.Except qualified as MTL import GHC.Stack (withFrozenCallStack) import Effectful @@ -148,3 +151,15 @@ tryError -- ^ The inner computation. -> Eff es (Either (E.CallStack, e) a) tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e) + +---------------------------------------- +-- Orphan instance + +-- | Instance included for compatibility with existing code. +instance + ( Show e + , Error e :> es + , MTL.MonadError e (Eff es) + ) => MTL.MonadError e (Eff es) where + throwError = send . ThrowErrorWith show + catchError action = send . CatchError action . const diff --git a/effectful-core/src/Effectful/Internal/Effect.hs b/effectful-core/src/Effectful/Internal/Effect.hs index 897b9fef..d38afa52 100644 --- a/effectful-core/src/Effectful/Internal/Effect.hs +++ b/effectful-core/src/Effectful/Internal/Effect.hs @@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK not-home #-} -- | Type-safe indexing for 'Effectful.Internal.Monad.Env'. -- diff --git a/effectful-core/src/Effectful/Internal/Monad.hs b/effectful-core/src/Effectful/Internal/Monad.hs index bce83e15..8c3e4cce 100644 --- a/effectful-core/src/Effectful/Internal/Monad.hs +++ b/effectful-core/src/Effectful/Internal/Monad.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_HADDOCK not-home #-} -- | The 'Eff' monad. diff --git a/effectful-core/src/Effectful/Reader/Dynamic.hs b/effectful-core/src/Effectful/Reader/Dynamic.hs index 6b22b38b..a6cdc6f1 100644 --- a/effectful-core/src/Effectful/Reader/Dynamic.hs +++ b/effectful-core/src/Effectful/Reader/Dynamic.hs @@ -1,6 +1,8 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- | The dynamically dispatched variant of the 'Reader' effect. -- --- /Note:/ unless you plan to change interpretations at runtime, it's +-- /Note:/ unless you plan to change interpretations at runtime or you need the +-- 'MTL.MonadReader' instance for compatibility with existing code, it's -- recommended to use the statically dispatched variant, -- i.e. "Effectful.Reader.Static". module Effectful.Reader.Dynamic @@ -17,6 +19,8 @@ module Effectful.Reader.Dynamic , local ) where +import Control.Monad.Reader qualified as MTL + import Effectful import Effectful.Dispatch.Dynamic @@ -81,3 +85,15 @@ local -> Eff es a -> Eff es a local f = send . Local f + +---------------------------------------- +-- Orphan instance + +-- | Instance included for compatibility with existing code. +instance + ( Reader r :> es + , MTL.MonadReader r (Eff es) + ) => MTL.MonadReader r (Eff es) where + ask = send Ask + local f = send . Local f + reader f = f <$> send Ask diff --git a/effectful-core/src/Effectful/State/Dynamic.hs b/effectful-core/src/Effectful/State/Dynamic.hs index 715649a0..142d847f 100644 --- a/effectful-core/src/Effectful/State/Dynamic.hs +++ b/effectful-core/src/Effectful/State/Dynamic.hs @@ -1,6 +1,8 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- | The dynamically dispatched variant of the 'State' effect. -- --- /Note:/ unless you plan to change interpretations at runtime, it's +-- /Note:/ unless you plan to change interpretations at runtime or you need the +-- 'MTL.MonadState' instance for compatibility with existing code, it's -- recommended to use one of the statically dispatched variants, -- i.e. "Effectful.State.Static.Local" or "Effectful.State.Static.Shared". module Effectful.State.Dynamic @@ -29,6 +31,8 @@ module Effectful.State.Dynamic , modifyM ) where +import Control.Monad.State qualified as MTL + import Effectful import Effectful.Dispatch.Dynamic import Effectful.State.Static.Local qualified as L @@ -149,3 +153,15 @@ modifyM => (s -> Eff es s) -> Eff es () modifyM f = stateM (\s -> ((), ) <$> f s) + +---------------------------------------- +-- Orphan instance + +-- | Instance included for compatibility with existing code. +instance + ( State s :> es + , MTL.MonadState s (Eff es) + ) => MTL.MonadState s (Eff es) where + get = send Get + put = send . Put + state = send . State diff --git a/effectful-core/src/Effectful/Writer/Dynamic.hs b/effectful-core/src/Effectful/Writer/Dynamic.hs index 00e6414e..d9572b30 100644 --- a/effectful-core/src/Effectful/Writer/Dynamic.hs +++ b/effectful-core/src/Effectful/Writer/Dynamic.hs @@ -1,6 +1,8 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- | The dynamically dispatched variant of the 'Writer' effect. -- --- /Note:/ unless you plan to change interpretations at runtime, it's +-- /Note:/ unless you plan to change interpretations at runtime or you need the +-- 'MTL.MonadWriter' instance for compatibility with existing code, it's -- recommended to use one of the statically dispatched variants, -- i.e. "Effectful.Writer.Static.Local" or "Effectful.Writer.Static.Shared". module Effectful.Writer.Dynamic @@ -23,6 +25,8 @@ module Effectful.Writer.Dynamic , listens ) where +import Control.Monad.Writer qualified as MTL + import Effectful import Effectful.Dispatch.Dynamic import Effectful.Writer.Static.Local qualified as L @@ -102,3 +106,17 @@ listens listens f m = do (a, w) <- listen m pure (a, f w) + +---------------------------------------- +-- Orphan instance + +-- | Instance included for compatibility with existing code. +instance + ( Monoid w + , Writer w :> es + , MTL.MonadWriter w (Eff es) + ) => MTL.MonadWriter w (Eff es) where + writer (a, w) = a <$ send (Tell w) + tell = send . Tell + listen = send . Listen + pass = error "pass is not implemented due to ambiguous semantics in presence of runtime exceptions" diff --git a/effectful-plugin/effectful-plugin.cabal b/effectful-plugin/effectful-plugin.cabal index 030cb041..d6dd3255 100644 --- a/effectful-plugin/effectful-plugin.cabal +++ b/effectful-plugin/effectful-plugin.cabal @@ -66,6 +66,7 @@ common language TypeApplications TypeFamilies TypeOperators + UndecidableInstances if impl(ghc >= 9.4) default-extensions: NoFieldSelectors diff --git a/effectful-th/effectful-th.cabal b/effectful-th/effectful-th.cabal index 78158958..7b3aac25 100644 --- a/effectful-th/effectful-th.cabal +++ b/effectful-th/effectful-th.cabal @@ -57,6 +57,7 @@ common language TypeApplications TypeFamilies TypeOperators + UndecidableInstances library import: language diff --git a/effectful/CHANGELOG.md b/effectful/CHANGELOG.md index 31b12dca..ffe3ef41 100644 --- a/effectful/CHANGELOG.md +++ b/effectful/CHANGELOG.md @@ -1,4 +1,6 @@ # effectful-2.6.1.0 (????-??-??) +* Add `MonadError`, `MonadReader`, `MonadState` and `MonadWriter` instances for + `Eff` for compatibility with existing code. * Re-export `writeTMVar` from `stm-2.5.1.0` in `Effectful.Concurrent.STM`. * Add `cancelMany` to `Effectful.Concurrent.Async`. diff --git a/effectful/bench/FileSizes.hs b/effectful/bench/FileSizes.hs index 570a069c..a514d638 100644 --- a/effectful/bench/FileSizes.hs +++ b/effectful/bench/FileSizes.hs @@ -1,6 +1,5 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE UndecidableInstances #-} module FileSizes where import Control.Exception diff --git a/effectful/effectful.cabal b/effectful/effectful.cabal index b082e3bb..36e69ec6 100644 --- a/effectful/effectful.cabal +++ b/effectful/effectful.cabal @@ -66,6 +66,7 @@ common language TypeApplications TypeFamilies TypeOperators + UndecidableInstances library import: language @@ -74,7 +75,7 @@ library , async >= 2.2.5 , bytestring >= 0.10 , directory >= 1.3.2 - , effectful-core >= 2.6.0.0 && < 2.6.1.0 + , effectful-core >= 2.6.1.0 && < 2.6.2.0 , process >= 1.6.9 , strict-mutable-base >= 1.1.0.0 , time >= 1.9.2 diff --git a/effectful/src/Effectful/Concurrent/Async.hs b/effectful/src/Effectful/Concurrent/Async.hs index 579d0323..86fcc763 100644 --- a/effectful/src/Effectful/Concurrent/Async.hs +++ b/effectful/src/Effectful/Concurrent/Async.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE UndecidableInstances #-} -- | Lifted "Control.Concurrent.Async". module Effectful.Concurrent.Async ( -- * Effect