effectful-th 1.0.0.1 → 1.0.0.4
raw patch · 5 files changed
Files
- CHANGELOG.md +19/−0
- README.md +5/−5
- effectful-th.cabal +19/−26
- src/Effectful/TH.hs +37/−47
- tests/ThTests.hs +43/−5
CHANGELOG.md view
@@ -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`.
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.@@ -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
effectful-th.cabal view
@@ -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
src/Effectful/TH.hs view
@@ -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 ]
tests/ThTests.hs view
@@ -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