effectful-th 1.0.0.1 → 1.0.0.3
raw patch · 5 files changed
Files
- CHANGELOG.md +9/−0
- README.md +3/−2
- effectful-th.cabal +14/−7
- src/Effectful/TH.hs +28/−17
- tests/ThTests.hs +5/−1
CHANGELOG.md view
@@ -1,3 +1,12 @@+# 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
@@ -38,7 +38,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 +161,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.0 build-type: Simple name: effectful-th-version: 1.0.0.1+version: 1.0.0.3 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 == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.5, 9.8.2, 9.10.1 } bug-reports: https://github.com/haskell-effectful/effectful/issues source-repository head@@ -25,7 +25,11 @@ location: https://github.com/haskell-effectful/effectful.git common language- ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors+ ghc-options: -Wall+ -Wcompat+ -Wno-unticked-promoted-constructors+ -Wmissing-deriving-strategies+ -Werror=prepositive-qualified-module default-language: Haskell2010 @@ -34,13 +38,16 @@ DataKinds DeriveFunctor DeriveGeneric+ DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+ ImportQualifiedPost LambdaCase MultiParamTypeClasses NoStarIsType+ PolyKinds RankNTypes RecordWildCards RoleAnnotations@@ -54,12 +61,12 @@ library import: language - build-depends: base >= 4.13 && < 5+ build-depends: base >= 4.14 && < 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.16 && < 2.23+ , th-abstraction >= 0.6 && < 0.8 hs-source-dirs: src
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 @@ -76,7 +79,7 @@ checkRequiredExtensions info <- reifyDatatype effName dispatch <- do- e <- getEff (ConT $ datatypeName info) (datatypeInstTypes info)+ e <- getEff (ConT $ datatypeName info) (const WildCardT <$> datatypeInstTypes info) let dispatchE = ConT ''DispatchOf `AppT` e dynamic = PromotedT 'Dynamic pure . TySynInstD $ TySynEqn Nothing dispatchE dynamic@@ -168,27 +171,23 @@ -- -- 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+ 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 = foldl' (\f -> AppE f . VarE) (ConE name) fnArgs+ 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@@ -198,8 +197,15 @@ (ConT ''HasCallStack : UInfixT effTy ''(:>) esVar : 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 DataNamespaceSpecifier name+#else+ InfixD fix name+#endif+ rest = FunD fnName [Clause (VarP <$> fnArgs) (NormalB fnBody) []]+ : maybeToList (mkDec <$> fixity)+ (++ rest) <$> withHaddock name [SigD fnName fnSig | makeSig] ----------------------------------------@@ -243,10 +249,15 @@ withHaddock :: Name -> [Dec] -> Q [Dec] #if MIN_VERSION_template_haskell(2,18,0)-withHaddock name dec = withDecsDoc- ("Perform the operation '" ++ nameBase name ++ "'.") (pure dec)+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) #else-withHaddock _ dec = pure dec+withHaddock _ decs = pure decs #endif checkRequiredExtensions :: Q ()
tests/ThTests.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} module Main where @@ -16,7 +15,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 +40,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