effectful-th 1.0.0.3 → 1.0.0.4
raw patch · 5 files changed
+81/−73 lines, 5 filesdep −exceptionsdep ~basedep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependencies removed: exceptions
Dependency ranges changed: base, template-haskell
API changes (from Hackage documentation)
Files
- CHANGELOG.md +10/−0
- README.md +2/−3
- effectful-th.cabal +14/−28
- src/Effectful/TH.hs +17/−38
- tests/ThTests.hs +38/−4
CHANGELOG.md view
@@ -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).
README.md view
@@ -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) -<img src="https://user-images.githubusercontent.com/387658/127747903-f728437f-2ee4-47b8-9f0c-5102fd44c8e4.png" width="128">+<img src="https://raw.githubusercontent.com/haskell-effectful/effectful/master/logo.svg" width="150"> An easy to use, fast extensible effects library with seamless integration with the existing Haskell ecosystem.
effectful-th.cabal view
@@ -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
src/Effectful/TH.hs view
@@ -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 ]
tests/ThTests.hs view
@@ -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