diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,22 @@
+# effectful-th-1.0.0.4 (2026-08-24)
+* Drop support for GHC < 9.6.
+* Don't generate signatures with an out-of-scope name when a constructor
+ mentions the monad variable in its context (e.g. `Op :: Monad m => Int -> E m
+ ()`) or in arguments of the effect type (e.g. `Op :: Int -> E (m Int) m ()`).
+* Correctly transfer fixity annotations of constructors to the generated
+ functions.
+* Restore the friendly error for effects with mis-kinded type parameters,
+ accidentally disabled in 1.0.0.2.
+
+# effectful-th-1.0.0.3 (2024-10-08)
+* Make `makeEffect` reuse Haddock descriptions of effect operations for
+ corresponding functions it generates (GHC >= 9.2).
+
+# effectful-th-1.0.0.2 (2024-06-07)
+* Add support for GHC 9.10.
+* Drop support for GHC 8.8.
+* `makeEffect` no longer generates `Wunused-type-patterns` warning ([#200](https://github.com/haskell-effectful/effectful/pull/200)).
+
# effectful-th-1.0.0.1 (2023-01-13)
* Depend on `effectful-core`, not `effectful`.
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,13 +1,12 @@
# effectful
-[](https://github.com/haskell-effectful/effectful/actions?query=branch%3Amaster)
+[](https://github.com/haskell-effectful/effectful/actions/workflows/haskell-ci.yml)
[](https://hackage.haskell.org/package/effectful)
-[](https://packdeps.haskellers.com/feed?needle=andrzej@rybczak.net)
[](https://www.stackage.org/lts/package/effectful)
[](https://www.stackage.org/nightly/package/effectful)
-
+
An easy to use, fast extensible effects library with seamless integration with
the existing Haskell ecosystem.
@@ -38,7 +37,7 @@
[freer-simple](https://hackage.haskell.org/package/freer-simple),
[fused-effects](https://hackage.haskell.org/package/fused-effects),
[polysemy](https://hackage.haskell.org/package/polysemy),
-[eff](https://github.com/hasura/eff) and probably a few more.
+[eff](https://github.com/lexi-lambda/eff) and probably a few more.
It needs to be noted that of all of them only the work-in-progress `eff` library
is a promising proposition because of reasonable performance characteristics
@@ -161,7 +160,8 @@
For the examples see the *Introduction* sections of
[`Effectful.Dispatch.Dynamic`](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Dynamic.html)
and
-[`Effectful.Dispatch.Static`](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Static.html).
+[`Effectful.Dispatch.Static`](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Static.html)
+(when in doubt, start with dynamic dispatch).
## Acknowledgements
diff --git a/effectful-th.cabal b/effectful-th.cabal
--- a/effectful-th.cabal
+++ b/effectful-th.cabal
@@ -1,7 +1,7 @@
-cabal-version: 2.4
+cabal-version: 3.8
build-type: Simple
name: effectful-th
-version: 1.0.0.1
+version: 1.0.0.4
license: BSD-3-Clause
license-file: LICENSE
category: Control
@@ -17,7 +17,7 @@
CHANGELOG.md
README.md
-tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.5 || ==9.4.4
+tested-with: GHC == { 9.6.7, 9.8.4, 9.10.3, 9.12.4, 9.14.1 }
bug-reports: https://github.com/haskell-effectful/effectful/issues
source-repository head
@@ -25,41 +25,33 @@
location: https://github.com/haskell-effectful/effectful.git
common language
- ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors
+ ghc-options: -Wall
+ -Wcompat
+ -Werror=missing-deriving-strategies
+ -Werror=prepositive-qualified-module
- default-language: Haskell2010
+ default-language: GHC2021
- default-extensions: BangPatterns
- ConstraintKinds
- DataKinds
- DeriveFunctor
- DeriveGeneric
- FlexibleContexts
- FlexibleInstances
- GADTs
- GeneralizedNewtypeDeriving
+ default-extensions: DataKinds
+ DeepSubsumption
+ DerivingStrategies
+ DuplicateRecordFields
LambdaCase
- MultiParamTypeClasses
+ NoFieldSelectors
NoStarIsType
- RankNTypes
- RecordWildCards
+ OverloadedRecordDot
RoleAnnotations
- ScopedTypeVariables
- StandaloneDeriving
- TupleSections
- TypeApplications
TypeFamilies
- TypeOperators
+ UndecidableInstances
library
import: language
- build-depends: base >= 4.13 && < 5
+ build-depends: base >= 4.18 && < 5
, containers >= 0.6
, effectful-core >= 1.0.0.0 && < 3.0.0.0
- , exceptions >= 0.10.4
- , template-haskell >= 2.15 && < 2.20
- , th-abstraction >= 0.4 && < 0.5
+ , template-haskell >= 2.20 && < 2.25
+ , th-abstraction >= 0.6 && < 0.8
hs-source-dirs: src
@@ -71,6 +63,7 @@
build-depends: base
, effectful-core
, effectful-th
+ , template-haskell
hs-source-dirs: tests
diff --git a/src/Effectful/TH.hs b/src/Effectful/TH.hs
--- a/src/Effectful/TH.hs
+++ b/src/Effectful/TH.hs
@@ -9,12 +9,12 @@
import Control.Monad
import Data.Char (toLower)
-import Data.Foldable (foldl')
+import Data.Foldable qualified as F
+import Data.Map.Strict qualified as Map
import Data.Maybe
import Language.Haskell.TH
import Language.Haskell.TH.Datatype
import Language.Haskell.TH.Datatype.TyVarBndr
-import qualified Data.Map.Strict as Map
import Effectful
import Effectful.Dispatch.Dynamic
@@ -33,7 +33,7 @@
--
-- >>> :kind! DispatchOf E
-- DispatchOf E :: Dispatch
--- = 'Dynamic
+-- ...Dynamic
--
-- >>> :i op1
-- op1 :: (HasCallStack, E :> es) => Int -> Eff es a -> Eff es a
@@ -53,6 +53,9 @@
-- lowercase or removes the @:@ symbol in case of operators. Any fixity
-- annotations defined for the constructors are preserved for the corresponding
-- definitions.
+--
+-- If the constructor declaration has Haddock, then this is reused for the
+-- sending functions, otherwise a simple placeholder is used.
makeEffect :: Name -> Q [Dec]
makeEffect = makeEffectImpl True
@@ -89,12 +92,10 @@
checkKind "the next to last" (ArrowT `AppT` StarT `AppT` StarT) m
checkKind "the last" StarT r
pure e
- (v : vs) -> getEff (e `AppT` forgetKind v) vs
+ -- Apply a wildcard instead of the type parameter to avoid the
+ -- Wunused-type-patterns warning in the generated code (#200).
+ (_ : vs) -> getEff (e `AppT` WildCardT) vs
_ -> fail "The effect data type needs at least 2 type parameters"
- where
- forgetKind = \case
- SigT v _ -> v
- ty -> ty
checkKind which expected = \case
SigT (VarT _) k
@@ -153,53 +154,45 @@
++ [kindedTVSpecified esName $ ListT `AppT` ConT ''Effect]
Nothing -> origActionVars
-#if MIN_VERSION_template_haskell(2,17,0)
- -- In GHC >= 9.0 it's possible to generate the following body:
+ -- Generate the following body:
--
-- e x1 .. xN = send (E @ty1 .. @tyN x1 .. xN)
--
- -- because specificities of constructor variables are exposed.
- --
- -- This allows to generate functions for such effects:
+ -- The type applications make it possible to generate functions for such
+ -- effects:
--
-- type family F ty :: Type
-- data AmbEff :: Effect where
-- AmbEff :: Int -> AmbEff m (F ty)
- --
- -- Sadly the version for GHC < 9 will not compile due to ambiguity error.
let fnBody =
- let tvFlag = \case
- PlainTV _ flag -> flag
- KindedTV _ flag _ -> flag
-
- tyApps = (`mapMaybe` origActionVars) $ \v -> case tvFlag v of
+ let tyApps = (`mapMaybe` origActionVars) $ \v -> case tvFlag v of
InferredSpec -> Nothing
SpecifiedSpec -> Just $ if maybeMonadName == Just (tvName v)
then ConT ''Eff `AppT` esVar
else VarT (tvName v)
effCon = if makeSig
- then foldl' AppTypeE (ConE name) tyApps
+ then F.foldl' AppTypeE (ConE name) tyApps
else ConE name
- in VarE 'send `AppE` foldl' (\f -> AppE f . VarE) effCon fnArgs
-#else
- -- In GHC < 9.0, generate the following body:
- --
- -- e :: E v1 .. vN :> es => x1 -> .. -> xK -> E v1 .. vN (Eff es) r
- -- e x1 .. xK = send (E x1 .. xN :: E v1 .. vK (Eff es) r)
- let fnBody =
- let effOp = foldl' (\f -> AppE f . VarE) (ConE name) fnArgs
- effSig = effTy `AppT` (ConT ''Eff `AppT` esVar) `AppT` substM resTy
- in if makeSig
- then VarE 'send `AppE` SigE effOp effSig
- else VarE 'send `AppE` effOp
-#endif
+ in VarE 'send `AppE` F.foldl' (\f -> AppE f . VarE) effCon fnArgs
+ -- The binder of the monad variable is removed from 'actionVars', so 'substM'
+ -- needs to be applied to every part of the signature that might mention it:
+ -- not just parameters and the result type, but also the effect type (e.g. E
+ -- (m Int) m ()) and the constructor context (e.g. Monad m => ... -> E m ()),
+ -- otherwise the generated signature references an out-of-scope name.
let fnSig = ForallT actionVars
- (ConT ''HasCallStack : UInfixT effTy ''(:>) esVar : actionCtx)
+ (ConT ''HasCallStack : UInfixT (substM effTy) ''(:>) esVar : map substM actionCtx)
(makeTyp esVar substM resTy actionParams)
- let rest = FunD fnName [Clause (VarP <$> fnArgs) (NormalB fnBody) []]
- : maybeToList ((`InfixD` name) <$> fixity)
+ let mkDec fix =
+#if MIN_VERSION_template_haskell(2,22,0)
+ InfixD fix NoNamespaceSpecifier fnName
+#else
+ InfixD fix fnName
+#endif
+ rest = FunD fnName [Clause (VarP <$> fnArgs) (NormalB fnBody) []]
+ : maybeToList (mkDec <$> fixity)
+
(++ rest) <$> withHaddock name [SigD fnName fnSig | makeSig]
----------------------------------------
@@ -224,11 +217,9 @@
ArrowT `AppT` a `AppT` ty -> do
(args, ret) <- extractParams ty
pure (a : args, ret)
-#if MIN_VERSION_template_haskell(2,17,0)
MulArrowT `AppT` _ `AppT` a `AppT` ty -> do
(args, ret) <- extractParams ty
pure (a : args, ret)
-#endif
effTy `AppT` monadTy `AppT` resTy -> case monadTy of
VarT monadName -> pure ([], (effTy, Right monadName, resTy))
ConT eff `AppT` VarT esName
@@ -242,12 +233,13 @@
(p : ps) -> ArrowT `AppT` substM p `AppT` makeTyp esVar substM resTy ps
withHaddock :: Name -> [Dec] -> Q [Dec]
-#if MIN_VERSION_template_haskell(2,18,0)
-withHaddock name dec = withDecsDoc
- ("Perform the operation '" ++ nameBase name ++ "'.") (pure dec)
-#else
-withHaddock _ dec = pure dec
-#endif
+withHaddock name decs = do
+ existingHaddock <- getDoc (DeclDoc name)
+ let newDoc =
+ case existingHaddock of
+ Just doc -> doc
+ Nothing -> "Perform the operation '" ++ nameBase name ++ "'."
+ withDecsDoc newDoc (pure decs)
checkRequiredExtensions :: Q ()
checkRequiredExtensions = do
@@ -262,9 +254,7 @@
where
exts = [ FlexibleContexts
, ScopedTypeVariables
-#if MIN_VERSION_template_haskell(2,17,0)
, TypeApplications
-#endif
, TypeFamilies
, TypeOperators
]
diff --git a/tests/ThTests.hs b/tests/ThTests.hs
--- a/tests/ThTests.hs
+++ b/tests/ThTests.hs
@@ -1,11 +1,11 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FieldSelectors #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Data.Kind (Type)
import GHC.TypeLits
+import Language.Haskell.TH (recover)
import Effectful
import Effectful.TH
@@ -16,7 +16,11 @@
data SimpleADT (m :: Type -> Type) (a :: Type)
= SimpleADTC1 Int
| SimpleADTC2 String
+ -- ^ This one does the second thing
+-- Test generation of fixity information.
+infixl 1 `SimpleADTC1`
+
makeEffect ''SimpleADT
data ADTSyntax1 (m :: Type -> Type) (a :: Type)
@@ -37,6 +41,7 @@
data GADTSyntax :: Effect where
GADTSyntaxC1 :: Int -> GADTSyntax m Int
+ -- | I am documented
GADTSyntaxC2 :: String -> GADTSyntax m String
GADTSyntaxC3 :: IOE :> es => Bool -> GADTSyntax (Eff es) a
@@ -133,11 +138,44 @@
makeEffect 'byFieldAf
+-- Test that fixity is transferred to the generated function. With the default
+-- infixl 9 the expression below parses as (1 `fixityOp` 2) `fixityOp` pure 3
+-- and fails to typecheck.
+data Fixity :: Effect where
+ FixityOp :: Int -> m a -> Fixity m a
+
+infixr 5 `FixityOp`
+
+makeEffect ''Fixity
+
+fixityTest :: Fixity :> es => Eff es Int
+fixityTest = 1 `fixityOp` 2 `fixityOp` pure 3
+
+-- Test that effects with mis-kinded type parameters are rejected with a
+-- friendly error. If the kind check doesn't fire, 'makeEffect' succeeds, so
+-- 'badKindRejected' is not generated and its usage below doesn't compile.
+data BadKind (m :: Type) (a :: Type)
+
+$(recover [d| badKindRejected :: (); badKindRejected = () |] $ makeEffect ''BadKind)
+
+useBadKindRejected :: ()
+useBadKindRejected = badKindRejected
+
+-- Test that the monad variable is substituted in constructor contexts.
+data MonadInCtx :: Effect where
+ MonadInCtxA :: Monad m => Int -> MonadInCtx m ()
+ MonadInCtxB :: (Monad m, Show a) => a -> MonadInCtx m a
+
+makeEffect ''MonadInCtx
+
+-- Test that the monad variable is substituted in the effect type.
+data MonadInHead a :: Effect where
+ MonadInHeadC :: Int -> MonadInHead (m Int) m ()
+
+makeEffect ''MonadInHead
+
type family F ty
data AmbEff :: Effect where
AmbEff :: Int -> AmbEff m (F ty)
--- This only works in GHC >= 9, otherwise the 'ty' variable is ambiguous.
-#if __GLASGOW_HASKELL__ >= 900
makeEffect 'AmbEff
-#endif