diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2 @@ +# effectful-th-1.0.0.0 (2022-07-13) +* Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,64 @@ +Copyright (c) 2021-2022, Andrzej Rybczak + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Andrzej Rybczak nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +This software incorporates code from the cleff package (available from +https://hackage.haskell.org/package/cleff) under the following license: + +Copyright Xy Ren (c) 2021 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Xy Ren nor the names of other contributors + may be used to endorse or promote products derived from this + software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,173 @@ +# 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) +[![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. + +Main features: + +1. Very fast + ([benchmarks](https://github.com/haskell-effectful/effectful/tree/master/benchmarks/README.md)). + +2. Easy to use API (comparable with usage of the [MonadUnliftIO](https://hackage.haskell.org/package/unliftio-core/docs/Control-Monad-IO-Unlift.html#t:MonadUnliftIO) class). + +3. Correct semantics in presence of runtime exceptions (no more discarded state + updates). + +4. Seamless integration with the existing ecosystem (`exceptions`, + `monad-control`, `unliftio-core`, `resourcet` etc.). + +5. Support for thread local and shared state (e.g. `StateT` provides a thread + local state, while `MVar` holds a shared state, both approaches have their + merits). + +6. Support for statically (implementation determined at compile time) and + dynamically (implementation determined at run time) dispatched effects. + +## Motivation + +Do we really need yet another library for handling effects? There's +[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. + +Unfortunately, of all of them only `eff` is a promising proposition because of +reasonable performance characteristics (see the talk [Effects for +Less](https://www.youtube.com/watch?v=0jI-AlWEwYI) for more information) and +potential for good interoperability with the existing ecosystem. + +The second point is arguably the most important, because it allows focusing on +things that matter instead of reinventing all kinds of wheels, hence being a +necessary condition for broader adoption of the library. + +However, `eff` uses delimited continuations underneath, which: + +- Are not yet supported by GHC (though [the +proposal](https://github.com/ghc-proposals/ghc-proposals/pull/313) for including +support for them has been accepted). + +- Are quite hard to understand. + +- Make the library "too powerful" in a sense as it faces + [a](https://github.com/hasura/eff/issues/13) + [few](https://github.com/hasura/eff/issues/7) + [issues](https://github.com/hasura/eff/issues/12) with no clear path towards + their resolution. + +### What about `mtl`? + +It's true that its "effects as classes" approach is widely known and used often. + +However: + +- `mtl` style effects are + [slow](https://github.com/haskell-effectful/effectful/tree/master/benchmarks/README.md). + +- The majority of popular monad transformers (except `ReaderT`) used for effect + implementations are rife with [subtle + issues](https://github.com/haskell-effectful/effectful/tree/master/transformers.md). + +These are problematic enough that the [ReaderT design +pattern](https://www.fpcomplete.com/blog/2017/06/readert-design-pattern/) was +invented. Its fundamentals are solid, but it's not an effect system. + +A solution? Use the `ReaderT` pattern as a base and build around it to make an +extensible effects library! This is where `effectful` comes in. The `Eff` monad +it uses is essentially a `ReaderT` over `IO` on steroids, allowing us to extend +its environment with data types representing effects. + +This concept is quite simple, so: + +- It's reasonably easy to understand what is going on under the hood. + +- The `Eff` monad being a reader allows for seamless interoperability with + ubiquitous classes such as `MonadBaseControl` and `MonadUnliftIO` and solves + [issues](https://github.com/haskell-effectful/effectful/tree/master/transformers.md) + of monad transformers mentioned above. + +What is more, the `Eff` monad is concrete, so GHC has many possibilities for +optimization, which results in a very fast code at a default optimization +level. There is no need to mark every function `INLINE` or enable additional +optimization passes, it just works. + +### Any downsides? + +As always, there's no free lunch. The `Eff` monad doesn't support `NonDet` nor +`Coroutine` effects. However, the `NonDet` effect in existing libraries is +[broken](https://github.com/lexi-lambda/eff/blob/8c4df4bf54faf22456354be18095b14825be5e85/notes/semantics-zoo.md) +and none of the ones with support for higher order effects provide the +`Coroutine` effect, so arguably it's not a big loss. + +If you need such capability in your application, there are well established +libraries such as [conduit](https://hackage.haskell.org/package/conduit) or +[list-t](https://hackage.haskell.org/package/list-t) that can be used with +`effectful` without any issues. + +### Summary + +`effectful` is an extensible effects library that aims to replace "boring" +transformer stacks (which consist of a dozen of newtype'd `ExceptT`, `ReaderT`, +`StateT` and `WriterT` transformers) and their derivatives by providing +equivalent effects with improved semantics, performance and usability (it also +makes it easy to reuse them for your own effects). It doesn't try to make monad +transformers obsolete, so you're free to use it with `ConduitT`, `ContT`, +`ListT` etc. when necessary. + +## Package structure + +The effect system is split among several libraries: + +- The [`effectful-core`](https://hackage.haskell.org/package/effectful-core) + library contains the core of the effect system along with the basic + effects. It aims for a small dependency footprint and provides building blocks + for more advanced effects. + +- The [`effectful-plugin`](https://hackage.haskell.org/package/effectful-plugin) + library provides an optional GHC plugin for improving disambiguation of + effects (see + [here](https://github.com/haskell-effectful/effectful/blob/master/effectful-plugin/README.md) + for more information). + +- The [`effectful-th`](https://hackage.haskell.org/package/effectful-th) library + provides utilities for generating bits of effect-related boilerplate via + Template Haskell. + +- The [`effectful`](https://hackage.haskell.org/package/effectful) library + re-exports public modules of `effectful-core` and additionally provides most + features of the `unliftio` library divided into appropriate effects. + +## Example + +A `Filesystem` effect with two handlers, one that runs in `IO` and another that +uses an in-memory virtual file system can be found +[here](https://github.com/haskell-effectful/effectful/blob/master/effectful/examples/FileSystem.hs). + +## Resources + +Resources that inspired the rise of this library and had a lot of impact on its +design. + +Talks: + +* [Effects for Less](https://www.youtube.com/watch?v=0jI-AlWEwYI) by Alexis King. + +* [Monad Transformer State](https://www.youtube.com/watch?v=KZIN9f9rI34) by Michael Snoyman. + +Blog posts: + +* [ReaderT design pattern](https://www.fpcomplete.com/blog/2017/06/readert-design-pattern/) by Michael Snoyman. + +* [Exceptions Best Practices](https://www.fpcomplete.com/blog/2016/11/exceptions-best-practices-haskell/) by Michael Snoyman. + +---------------------------------------- + +
Icons made by Freepik from www.flaticon.com
diff --git a/effectful-th.cabal b/effectful-th.cabal new file mode 100644 --- /dev/null +++ b/effectful-th.cabal @@ -0,0 +1,77 @@ +cabal-version: 2.4 +build-type: Simple +name: effectful-th +version: 1.0.0.0 +license: BSD-3-Clause +license-file: LICENSE +category: Control +maintainer: andrzej@rybczak.net +author: Andrzej Rybczak +synopsis: Template Haskell utilities for the effectful library. + +description: Generate functions for performing operations of dynamically + dispatched effects via Template Haskell. + +extra-source-files: + CHANGELOG.md + README.md + +tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 || ==9.4.1 + +bug-reports: https://github.com/haskell-effectful/effectful/issues +source-repository head + type: git + location: https://github.com/haskell-effectful/effectful.git + +common language + ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors + + default-language: Haskell2010 + + default-extensions: BangPatterns + ConstraintKinds + DataKinds + DeriveFunctor + DeriveGeneric + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + LambdaCase + MultiParamTypeClasses + NoStarIsType + RankNTypes + RecordWildCards + RoleAnnotations + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + TypeOperators + +library + import: language + + build-depends: base >= 4.13 && < 5 + , containers >= 0.6 + , effectful >= 1.0.0.0 && < 1.0.1.0 + , exceptions >= 0.10.4 + , template-haskell >= 2.15 && < 2.20 + , th-abstraction >= 0.4 && < 0.5 + + hs-source-dirs: src + + exposed-modules: Effectful.TH + +test-suite th-tests + import: language + + build-depends: base + , effectful + , effectful-th + + hs-source-dirs: tests + + type: exitcode-stdio-1.0 + main-is: ThTests.hs diff --git a/src/Effectful/TH.hs b/src/Effectful/TH.hs new file mode 100644 --- /dev/null +++ b/src/Effectful/TH.hs @@ -0,0 +1,270 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +-- | Generate functions for performing operations of dynamically dispatched +-- effects via Template Haskell. +module Effectful.TH + ( makeEffect + , makeEffect_ + ) where + +import Control.Monad +import Data.Char (toLower) +import Data.Foldable (foldl') +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 + +-- | For an effect data type @E@, @'makeEffect' E@ generates the appropriate +-- instance of 'DispatchOf' as well as functions for performing operations of +-- @E@ by 'send'ing them to the effect handler. +-- +-- >>> :{ +-- data E :: Effect where +-- Op1 :: Int -> m a -> E m a +-- Op2 :: IOE :> es => Int -> E (Eff es) () +-- Op3 :: (forall r. m r -> m r) -> E m Int +-- makeEffect ''E +-- :} +-- +-- >>> :kind! DispatchOf E +-- DispatchOf E :: Dispatch +-- = 'Dynamic +-- +-- >>> :i op1 +-- op1 :: (HasCallStack, E :> es) => Int -> Eff es a -> Eff es a +-- ... +-- +-- >>> :i op2 +-- op2 :: (HasCallStack, E :> es, IOE :> es) => Int -> Eff es () +-- ... +-- +-- >>> :i op3 +-- op3 :: +-- (HasCallStack, E :> es) => +-- (forall r. Eff es r -> Eff es r) -> Eff es Int +-- ... +-- +-- The naming rule changes the first uppercase letter in the constructor name to +-- lowercase or removes the @:@ symbol in case of operators. Any fixity +-- annotations defined for the constructors are preserved for the corresponding +-- definitions. +makeEffect :: Name -> Q [Dec] +makeEffect = makeEffectImpl True + +-- | Like 'makeEffect', but doesn't generate type signatures. This is useful +-- when you want to attach Haddock documentation to function signatures: +-- +-- >>> :{ +-- data Noop :: Effect where +-- Noop :: Noop m () +-- makeEffect_ ''Noop +-- -- | Perform nothing at all. +-- noop :: Noop :> es => Eff es () +-- :} +-- +-- /Note:/ function signatures must be added /after/ the call to 'makeEffect_'. +makeEffect_ :: Name -> Q [Dec] +makeEffect_ = makeEffectImpl False + +makeEffectImpl :: Bool -> Name -> Q [Dec] +makeEffectImpl makeSig effName = do + checkRequiredExtensions + info <- reifyDatatype effName + dispatch <- do + e <- getEff (ConT $ datatypeName info) (datatypeInstTypes info) + let dispatchE = ConT ''DispatchOf `AppT` e + dynamic = PromotedT 'Dynamic + pure . TySynInstD $ TySynEqn Nothing dispatchE dynamic + ops <- traverse (makeCon makeSig) (constructorName <$> datatypeCons info) + pure $ dispatch : concat (reverse ops) + where + getEff :: Type -> [Type] -> Q Type + getEff e = \case + [m, r] -> do + 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 + _ -> 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 + | k == expected -> pure () + | otherwise -> fail + $ "Expected " ++ which ++ " type parameter to have a kind " + ++ pprint expected ++ ", got " ++ pprint k + -- Weird type, let it through and see what happens. + _ -> pure () + +-- | Generate a single definition of an effect operation. +makeCon :: Bool -> Name -> Q [Dec] +makeCon makeSig name = do + fixity <- reifyFixity name + typ <- reify name >>= \case + DataConI _ typ _ -> pure typ + _ -> fail $ "Not a data constructor: " ++ nameBase name + + (actionParams, (effTy, ename, resTy)) <- extractParams typ + + -- The 'ename' can be either: + -- + -- - A variable for the monad, in which case we need to generate the @es@ + -- variable and substitute it later for 'Eff es'. + -- + -- - A variable 'es' for the local 'Eff es' if the monad parameter was locally + -- substituted in the contructor. + -- + -- For example in the following effect: + -- + -- data E :: Effect where + -- E1 :: Int -> E m () + -- E2 :: IOE :> es => E (Eff es) () + -- + -- Processing 'E1' will yield 'Right m', but 'E2' will yield 'Left es'. + -- + -- In the first case we need to substitute the variable ourselves in a few + -- places, but in the second we're good since it was already substituted. + (esName, maybeMonadName) <- case ename of + Left esName -> pure (esName, Nothing) + Right monadName -> (, Just monadName) <$> newName "es" + + let fnName = mkName . toSmartConName $ nameBase name + fnArgs <- traverse (const $ newName "x") actionParams + + let esVar = VarT esName + + substM :: Type -> Type + substM = case maybeMonadName of + Just m -> applySubstitution . Map.singleton m $ ConT ''Eff `AppT` esVar + Nothing -> id + + (origActionVars, actionCtx) = extractCtx typ + actionVars = case maybeMonadName of + Just m -> filter ((m /=) . tvName) origActionVars + ++ [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: + -- + -- e x1 .. xN = send (E @ty1 .. @tyN x1 .. xN) + -- + -- because specificities of constructor variables are exposed. + -- + -- This allows 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 + 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 + 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 + let fnSig = ForallT actionVars + (ConT ''HasCallStack : UInfixT effTy ''(:>) esVar : actionCtx) + (makeTyp esVar substM resTy actionParams) + + let rest = FunD fnName [Clause (VarP <$> fnArgs) (NormalB fnBody) []] + : maybeToList ((`InfixD` name) <$> fixity) + (++ rest) <$> withHaddock name [SigD fnName fnSig | makeSig] + +---------------------------------------- +-- Helpers + +toSmartConName :: String -> String +toSmartConName = \case + (':' : xs) -> xs + (x : xs) -> toLower x : xs + _ -> error "empty constructor name" + +extractCtx :: Type -> ([TyVarBndrSpec], Cxt) +extractCtx = \case + ForallT vars ctx _ -> (vars, ctx) + ty -> error $ "unexpected type: " ++ show ty + +extractParams :: Type -> Q ([Type], (Type, Either Name Name, Type)) +extractParams = \case + ForallT _ _ ty -> extractParams ty + SigT ty _ -> extractParams ty + ParensT ty -> extractParams ty + 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 + | eff == ''Eff -> pure ([], (effTy, Left esName, resTy)) + ty -> fail $ "Invalid instantiation of the monad parameter: " ++ pprint ty + ty -> fail $ "Unexpected type: " ++ pprint ty + +makeTyp :: Type -> (Type -> Type) -> Type -> [Type] -> Type +makeTyp esVar substM resTy = \case + [] -> ConT ''Eff `AppT` esVar `AppT` substM resTy + (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 + +checkRequiredExtensions :: Q () +checkRequiredExtensions = do + missing <- filterM (fmap not . isExtEnabled) exts + let ppMissing = map (\ext -> "{-# LANGUAGE " <> show ext <> " #-}") missing + unless (null missing) . fail . unlines $ + [ "Generating functions requires additional language extensions.\n" + , "You can enable them by adding them to the 'default-extensions'" + , "field in the .cabal file or the following pragmas to the beginning" + , "of the source file:\n" + ] ++ ppMissing + 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 new file mode 100644 --- /dev/null +++ b/tests/ThTests.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Data.Kind (Type) +import GHC.TypeLits + +import Effectful +import Effectful.TH + +main :: IO () +main = pure () -- only compilation tests + +data SimpleADT (m :: Type -> Type) (a :: Type) + = SimpleADTC1 Int + | SimpleADTC2 String + +makeEffect ''SimpleADT + +data ADTSyntax1 (m :: Type -> Type) (a :: Type) + = a ~ Int => ADTSyntax1C String + +makeEffect ''ADTSyntax1 + +data ADTSyntax2 (m :: Type -> Type) (a :: Type) + = a ~ Int => ADTSyntax2C1 Int + | a ~ String => ADTSyntax2C2 String + +makeEffect ''ADTSyntax2 + +data ADTSyntax3 (m :: Type -> Type) (a :: Type) + = Show a => ADTSyntax3C a + +makeEffect ''ADTSyntax3 + +data GADTSyntax :: Effect where + GADTSyntaxC1 :: Int -> GADTSyntax m Int + GADTSyntaxC2 :: String -> GADTSyntax m String + GADTSyntaxC3 :: IOE :> es => Bool -> GADTSyntax (Eff es) a + +makeEffect ''GADTSyntax + +data Fields (m :: Type -> Type) (a :: Type) + = FieldsC { fieldsCF1 :: Int, fieldsCF2 :: String } + +makeEffect ''Fields + +newtype Newtype1 (m :: Type -> Type) (a :: Type) + = Newtype1C Int + +makeEffect ''Newtype1 + +newtype Newtype2 :: Effect where + Newtype2C :: String -> Newtype2 m a + +makeEffect ''Newtype2 + +data Instance = ADTI | GADTI | NTI | MMI + +data family Family (s :: Instance) (m :: Type -> Type) a + +data instance Family 'ADTI _ _ = ADTIC1 Int | ADTIC2 String +makeEffect 'ADTIC1 + +data instance Family 'GADTI _ _ where + GADTIC1 :: Int -> Family 'GADTI m Int + GADTIC2 :: String -> Family 'GADTI m String +makeEffect 'GADTIC1 + +newtype instance Family 'NTI _ _ = NTIC Int +makeEffect 'NTIC + +data instance Family 'MMI m (_ m) where + MMIC1 :: f m -> Family 'MMI m (f m) + MMIC2 :: (forall x. m x -> m (f m)) -> Family 'MMI m (f m) + +makeEffect 'MMIC1 + +data Complex :: Effect where + Mono :: Int -> Complex m Bool + Poly :: a -> Complex m a + PolyIn :: a -> Complex m Bool + PolyOut :: Int -> Complex m a + Lots :: a -> b -> c -> d -> e -> f -> Complex m () + Nested :: Maybe b -> Complex m (Maybe a) + MultiNested :: (Maybe a, [b]) -> Complex m (Maybe a, [b]) + Existential :: (forall e. e -> Maybe e) -> Complex m a + LotsNested :: Maybe a -> [b] -> (c, c) -> Complex m (a, b, c) + Dict :: Ord a => a -> Complex m a + MultiDict :: (Eq a, Ord b, Enum a, Num c) + => a -> b -> c -> Complex m () + IndexedMono :: f 0 -> Complex m Int + IndexedPoly :: forall f (n :: Nat) m . f n -> Complex m (f (n + 1)) + IndexedPolyDict :: KnownNat n => f n -> Complex m Int + +makeEffect ''Complex + +data HOEff :: Effect where + EffArgMono :: m () -> HOEff m () + EffArgPoly :: m a -> HOEff m a + EffArgComb :: m a -> (m a -> m b) -> HOEff m b + EffRank2 :: (forall x. m x -> m (Maybe x)) -> HOEff m a + +makeEffect ''HOEff + +data ComplexEffArgs b c :: Effect where + EffMono :: Int -> ComplexEffArgs Int String m Bool + EffPoly1 :: a -> ComplexEffArgs a b m a + EffPoly2 :: a -> ComplexEffArgs a (Maybe a) m Bool + EffPolyFree :: String -> ComplexEffArgs a b m Int + EffSame1 :: ComplexEffArgs a a m a + EffSame2 :: ComplexEffArgs b b m a + EffHO :: m b -> ComplexEffArgs b Int m String + +makeEffect ''ComplexEffArgs + +data HKEffArgs f g :: Effect where + HKRank2 :: (forall x . f x -> g x) -> HKEffArgs f g m a + +makeEffect ''HKEffArgs + +data ByCon :: Effect where + ByConA :: Int -> ByCon m String + ByConB :: Int -> ByCon m String + +makeEffect 'ByConA + +data ByField :: Effect where + ByFieldA :: { byFieldAf :: Int } -> ByField m Int + ByFieldB :: { byFieldBf :: Int } -> ByField m Int + +makeEffect 'byFieldAf + +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