diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +# 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). diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,13 +1,12 @@ # effectful -[![Build Status](https://github.com/haskell-effectful/effectful/workflows/Haskell-CI/badge.svg?branch=master)](https://github.com/haskell-effectful/effectful/actions?query=branch%3Amaster) +[![CI](https://github.com/haskell-effectful/effectful/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/haskell-effectful/effectful/actions/workflows/haskell-ci.yml) [![Hackage](https://img.shields.io/hackage/v/effectful.svg)](https://hackage.haskell.org/package/effectful) -[![Dependencies](https://img.shields.io/hackage-deps/v/effectful.svg)](https://packdeps.haskellers.com/feed?needle=andrzej@rybczak.net) [![Stackage LTS](https://www.stackage.org/package/effectful/badge/lts)](https://www.stackage.org/lts/package/effectful) [![Stackage Nightly](https://www.stackage.org/package/effectful/badge/nightly)](https://www.stackage.org/nightly/package/effectful) - + An easy to use, fast extensible effects library with seamless integration with the existing Haskell ecosystem. diff --git a/effectful-th.cabal b/effectful-th.cabal --- a/effectful-th.cabal +++ b/effectful-th.cabal @@ -1,7 +1,7 @@ -cabal-version: 3.0 +cabal-version: 3.8 build-type: Simple name: effectful-th -version: 1.0.0.3 +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.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.5, 9.8.2, 9.10.1 } +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 @@ -27,45 +27,30 @@ common language ghc-options: -Wall -Wcompat - -Wno-unticked-promoted-constructors - -Wmissing-deriving-strategies + -Werror=missing-deriving-strategies -Werror=prepositive-qualified-module - default-language: Haskell2010 + default-language: GHC2021 - default-extensions: BangPatterns - ConstraintKinds - DataKinds - DeriveFunctor - DeriveGeneric + default-extensions: DataKinds + DeepSubsumption DerivingStrategies - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost + DuplicateRecordFields LambdaCase - MultiParamTypeClasses + NoFieldSelectors NoStarIsType - PolyKinds - RankNTypes - RecordWildCards + OverloadedRecordDot RoleAnnotations - ScopedTypeVariables - StandaloneDeriving - TupleSections - TypeApplications TypeFamilies - TypeOperators + UndecidableInstances library import: language - build-depends: base >= 4.14 && < 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.16 && < 2.23 + , template-haskell >= 2.20 && < 2.25 , th-abstraction >= 0.6 && < 0.8 hs-source-dirs: src @@ -78,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 @@ -79,7 +79,7 @@ checkRequiredExtensions info <- reifyDatatype effName dispatch <- do - e <- getEff (ConT $ datatypeName info) (const WildCardT <$> datatypeInstTypes info) + e <- getEff (ConT $ datatypeName info) (datatypeInstTypes info) let dispatchE = ConT ''DispatchOf `AppT` e dynamic = PromotedT 'Dynamic pure . TySynInstD $ TySynEqn Nothing dispatchE dynamic @@ -92,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 @@ -156,20 +154,16 @@ ++ [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 tyApps = (`mapMaybe` origActionVars) $ \v -> case tvFlag v of InferredSpec -> Nothing @@ -181,27 +175,20 @@ then F.foldl' AppTypeE (ConE name) tyApps else ConE name in VarE 'send `AppE` F.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 = F.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 + -- 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 mkDec fix = #if MIN_VERSION_template_haskell(2,22,0) - InfixD fix DataNamespaceSpecifier name + InfixD fix NoNamespaceSpecifier fnName #else - InfixD fix name + InfixD fix fnName #endif rest = FunD fnName [Clause (VarP <$> fnArgs) (NormalB fnBody) []] : maybeToList (mkDec <$> fixity) @@ -230,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 @@ -248,17 +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 decs = do +withHaddock name decs = do existingHaddock <- getDoc (DeclDoc name) - let newDoc = + let newDoc = case existingHaddock of Just doc -> doc Nothing -> "Perform the operation '" ++ nameBase name ++ "'." withDecsDoc newDoc (pure decs) -#else -withHaddock _ decs = pure decs -#endif checkRequiredExtensions :: Q () checkRequiredExtensions = do @@ -273,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,10 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE FieldSelectors #-} {-# LANGUAGE TemplateHaskell #-} module Main where import Data.Kind (Type) import GHC.TypeLits +import Language.Haskell.TH (recover) import Effectful import Effectful.TH @@ -137,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