packages feed

freer-simple 1.1.0.0 → 1.2.1.2

raw patch · 12 files changed

Files

CHANGELOG.md view
@@ -1,3 +1,20 @@+# 1.2.1.2 (January 7th, 2022)++- Compatibility with `template-haskell` versions through 2.18 (which is distributed with GHC 9.2) ([#34](https://github.com/lexi-lambda/freer-simple/issues/34)).++# 1.2.1.1 (October 4th, 2019)++- Loosened bounds on `template-haskell` ([#29](https://github.com/lexi-lambda/freer-simple/issues/29)).+- Made some minor internal changes to better support GHC 8.8.++# 1.2.1.0 (November 15th, 2018)++- Improved `makeEffect` from `Control.Monad.Freer.TH` to support more datatypes ([#17](https://github.com/lexi-lambda/freer-simple/pull/17)).++# 1.2.0.0 (October 23rd, 2018)++- Added `Control.Monad.Freer.TH`, which provides a `makeEffect` function that automatically generates boilerplate operations using `send` for an effect ([#15](https://github.com/lexi-lambda/freer-simple/pull/15)).+ # 1.1.0.0 (February 20th, 2018)  - Changed the implementation of `LastMember` to avoid an issue similar to the one with `Member` fixed in 1.0.1.1 that could cause the constraint to unnecessarily fail to solve ([#6](https://github.com/lexi-lambda/freer-simple/issues/6)).
README.md view
@@ -1,45 +1,37 @@-# Freer: Extensible Effects with Freer Monads [![Build Status](https://travis-ci.org/lexi-lambda/freer-simple.svg?branch=master)](https://travis-ci.org/lexi-lambda/freer-simple)--# Description--The `freer-simple` library (a fork of [`freer-effects`](http://hackage.haskell.org/package/freer-effects)) is an implementation of an effect system for Haskell, which is based on the work of Oleg Kiselyov et al.:--  - [Freer Monads, More Extensible Effects](http://okmij.org/ftp/Haskell/extensible/more.pdf)-  - [Reflection without Remorse](http://okmij.org/ftp/Haskell/zseq.pdf)-  - [Extensible Effects](http://okmij.org/ftp/Haskell/extensible/exteff.pdf)--Much of the implementation is a repackaging and cleaning up of the reference materials provided [here](http://okmij.org/ftp/Haskell/extensible/).+# freer-simple — a friendly effect system for Haskell [![Build Status](https://img.shields.io/github/workflow/status/lexi-lambda/freer-simple/build/master)](https://github.com/lexi-lambda/freer-simple/actions/workflows/build.yml) [![Hackage](https://img.shields.io/badge/hackage-1.2.1.2-5e5184)][hackage] -# Features+The `freer-simple` library is an implementation of an *extensible effect system* for Haskell, a general-purpose way of tracking effects at the type level and handling them in different ways. The concept of an “effect” is very general: it encompasses the things most people consider side-effects, like generating random values, interacting with the file system, and mutating state, but it also includes things like access to an immutable global environment and exception handling.  The key features of `freer-simple` are:    - An efficient effect system for Haskell as a library.-  - Implementations for several common Haskell monads as effects:-    - `Reader`-    - `Writer`-    - `State`-    - `Trace`-    - `Error`-  - Core components for defining your own Effects. -# Example: Console DSL+  - Implementations for several common Haskell monads as effects, including `Reader`, `Writer`, `State`, `Error`, and others. -Here's what using `freer-simple` looks like:+  - A combinator language for defining your own effects, designed to make simple, common use cases easy to read and write. +[**For more details, see the package documentation on Hackage.**][hackage]++## Code example+ ```haskell-{-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}-module Console where+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-} +import qualified Prelude+import qualified System.Exit++import Prelude hiding (putStrLn, getLine)+ import Control.Monad.Freer+import Control.Monad.Freer.TH import Control.Monad.Freer.Error import Control.Monad.Freer.State import Control.Monad.Freer.Writer-import System.Exit hiding (ExitCode(ExitSuccess))  --------------------------------------------------------------------------------                                -- Effect Model --@@ -48,24 +40,16 @@   PutStrLn    :: String -> Console ()   GetLine     :: Console String   ExitSuccess :: Console ()--putStrLn' :: Member Console effs => String -> Eff effs ()-putStrLn' = send . PutStrLn--getLine' :: Member Console effs => Eff effs String-getLine' = send GetLine--exitSuccess' :: Member Console effs => Eff effs ()-exitSuccess' = send ExitSuccess+makeEffect ''Console  --------------------------------------------------------------------------------                           -- Effectful Interpreter -- -------------------------------------------------------------------------------- runConsole :: Eff '[Console, IO] a -> IO a runConsole = runM . interpretM (\case-  PutStrLn msg -> putStrLn msg-  GetLine -> getLine-  ExitSuccess -> exitSuccess)+  PutStrLn msg -> Prelude.putStrLn msg+  GetLine -> Prelude.getLine+  ExitSuccess -> System.Exit.exitSuccess)  --------------------------------------------------------------------------------                              -- Pure Interpreter --@@ -82,37 +66,8 @@     go ExitSuccess = throwError () ``` -# Contributing--Contributions are welcome! Documentation, examples, code, and feedback - they all help.---## Developer Setup--The easiest way to start contributing is to install [stack](https://haskellstack.org/). Stack can install GHC/Haskell for you, and automates common developer tasks.--The key commands are:--  - `stack setup` — install required version of GHC compiler-  - `stack build` — builds project, dependencies are automatically resolved-  - `stack test` — builds project, its tests, and executes the tests-  - `stack bench` — builds project, its benchmarks, and executes the benchamks-  - `stack ghci` — start a REPL instance with a project modules loaded-  - `stack clean`-  - `stack haddock` — builds documentation--More information about `stack` can be found in its [documentation](https://haskellstack.org/).--# Licensing--This project is distributed under a BSD3 license. See the included LICENSE file for more details.--# Acknowledgements--The `freer-simple` package started as a fork of [freer-effects](http://hackage.haskell.org/package/freer-effects) by Ixperta Solutions, which in turn is a fork of [freer](http://hackage.haskell.org/package/freer) by Allele Dev. All implementations are based on the paper and reference implementation by Oleg Kiselyov. In particular:+## Acknowledgements -  - `Data.OpenUnion` maps to [OpenUnion51.hs](http://okmij.org/ftp/Haskell/extensible/OpenUnion51.hs)-  - `Data.FTCQueue` maps to [FTCQueue1](http://okmij.org/ftp/Haskell/extensible/FTCQueue1.hs)-  - `Control.Monad.Freer*` maps to [Eff1.hs](http://okmij.org/ftp/Haskell/extensible/Eff1.hs)+The `freer-simple` package began as a fork of [freer-effects](http://hackage.haskell.org/package/freer-effects) by Ixperta Solutions, which in turn is a fork of [freer](http://hackage.haskell.org/package/freer) by Allele Dev. All implementations are based on the [paper and reference implementation by Oleg Kiselyov](http://okmij.org/ftp/Haskell/extensible/more.pdf). -There will be deviations from the source.+[hackage]: https://hackage.haskell.org/package/freer-simple
bench/Core.hs view
@@ -55,8 +55,8 @@   where go = MTL.get >>= (\n -> if n <= (0 :: Int) then MTL.throwError "wat" else MTL.put (n-1) >> go)  countDownExcEE :: Int -> Either String (Int,Int)-countDownExcEE start = EE.run $ EE.runExc (EE.runState start go)-  where go = EE.get >>= (\n -> if n <= (0 :: Int) then EE.throwExc "wat" else EE.put (n-1) >> go)+countDownExcEE start = EE.run $ EE.runError (EE.runState start go)+  where go = EE.get >>= (\n -> if n <= (0 :: Int) then EE.throwError "wat" else EE.put (n-1) >> go)  --------------------------------------------------------------------------------                           -- Freer: Interpreter --
examples/src/Trace.hs view
@@ -1,13 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NoMonomorphismRestriction #-}  module Trace (module Trace) where -import Control.Applicative ((<$>), (<*>), pure)-import Data.Function (($))-import Data.Int (Int)+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))-import System.IO (IO)-import Text.Show (Show(show))+#endif  import Control.Monad.Freer (Eff, Member) import Control.Monad.Freer.Reader (ask, runReader)
freer-simple.cabal view
@@ -1,128 +1,136 @@--- This file has been generated from package.yaml by hpack version 0.20.0.------ see: https://github.com/sol/hpack------ hash: f02232dd03e2c26a1697a9b46bb32db8b1f332d4d81f5bb5c309a480589ea5d1+cabal-version: 2.4+name: freer-simple+version: 1.2.1.2+category: Control+build-type: Simple -name:           freer-simple-version:        1.1.0.0-synopsis:       Implementation of a friendly effect system for Haskell.-description:    An implementation of an effect system for Haskell (a fork of-                <http://hackage.haskell.org/package/freer-effects freer-effects>), which is-                based on the work of Oleg Kiselyov et al.:-                .-                  * <http://okmij.org/ftp/Haskell/extensible/more.pdf Freer Monads, More Extensible Effects>-                  * <http://okmij.org/ftp/Haskell/zseq.pdf Reflection without Remorse>-                  * <http://okmij.org/ftp/Haskell/extensible/exteff.pdf Extensible Effects>-                .-                The key features are:-                .-                  * An efficient effect system for Haskell - as a library!-                  * Reimplementations of several common Haskell monad transformers as effects.-                  * Core components for defining your own Effects.-category:       Control-homepage:       https://github.com/lexi-lambda/freer-simple#readme-bug-reports:    https://github.com/lexi-lambda/freer-simple/issues-author:         Allele Dev, Ixcom Core Team, Alexis King, and other contributors-maintainer:     Alexis King <lexi.lambda@gmail.com>-copyright:      (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King-license:        BSD3-license-file:   LICENSE-build-type:     Simple-cabal-version:  >= 1.10+synopsis: A friendly effect system for Haskell.+description:+  An implementation of an effect system for Haskell (a fork of+  <http://hackage.haskell.org/package/freer-effects freer-effects>), which is+  based on the work of Oleg Kiselyov et al.:+  .+    * <http://okmij.org/ftp/Haskell/extensible/more.pdf Freer Monads, More Extensible Effects>+    * <http://okmij.org/ftp/Haskell/zseq.pdf Reflection without Remorse>+    * <http://okmij.org/ftp/Haskell/extensible/exteff.pdf Extensible Effects>+  .+  The key features are:+  .+    * An efficient effect system for Haskell - as a library!+    * Reimplementations of several common Haskell monad transformers as effects.+    * Core components for defining your own Effects. +author: Allele Dev, Ixcom Core Team, Alexis King, and other contributors+maintainer: Alexis King <lexi.lambda@gmail.com>+copyright: 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King+license: BSD-3-Clause+license-file: LICENSE+homepage: https://github.com/lexi-lambda/freer-simple+bug-reports: https://github.com/lexi-lambda/freer-simple/issues+ extra-source-files:-    CHANGELOG.md-    README.md+  CHANGELOG.md+  README.md  source-repository head   type: git   location: https://github.com/lexi-lambda/freer-simple +common common+  ghc-options:+    -Wall+    -Wcompat+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wredundant-constraints++  default-language: Haskell2010+  default-extensions:+    ConstraintKinds+    DataKinds+    DeriveFunctor+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    LambdaCase+    MultiParamTypeClasses+    RankNTypes+    ScopedTypeVariables+    TypeApplications+    TypeOperators++  build-depends: base >= 4.9 && < 5+ library-  hs-source-dirs:-      src-  default-extensions: ConstraintKinds DataKinds DeriveFunctor FlexibleContexts FlexibleInstances FunctionalDependencies GADTs LambdaCase MultiParamTypeClasses RankNTypes ScopedTypeVariables TypeApplications TypeOperators-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  import: common+  hs-source-dirs: src+  exposed-modules:+    Control.Monad.Freer+    Control.Monad.Freer.Coroutine+    Control.Monad.Freer.Error+    Control.Monad.Freer.Fresh+    Control.Monad.Freer.Internal+    Control.Monad.Freer.NonDet+    Control.Monad.Freer.Reader+    Control.Monad.Freer.State+    Control.Monad.Freer.TH+    Control.Monad.Freer.Trace+    Control.Monad.Freer.Writer+    Data.FTCQueue+    Data.OpenUnion+    Data.OpenUnion.Internal+   build-depends:-      base >=4.9 && <5-    , natural-transformation >=0.2+    , natural-transformation >= 0.2     , transformers-base-  exposed-modules:-      Control.Monad.Freer-      Control.Monad.Freer.Coroutine-      Control.Monad.Freer.Error-      Control.Monad.Freer.Fresh-      Control.Monad.Freer.Internal-      Control.Monad.Freer.NonDet-      Control.Monad.Freer.Reader-      Control.Monad.Freer.State-      Control.Monad.Freer.Trace-      Control.Monad.Freer.Writer-      Data.FTCQueue-      Data.OpenUnion-      Data.OpenUnion.Internal-  other-modules:-      Paths_freer_simple-  default-language: Haskell2010+    , template-haskell >= 2.11 && < 2.19 -executable freer-examples+executable freer-simple-examples+  import: common+  hs-source-dirs: examples/src   main-is: Main.hs-  hs-source-dirs:-      examples/src-  default-extensions: ConstraintKinds DataKinds DeriveFunctor FlexibleContexts FlexibleInstances FunctionalDependencies GADTs LambdaCase MultiParamTypeClasses RankNTypes ScopedTypeVariables TypeApplications TypeOperators-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints-  build-depends:-      base >=4.9 && <5-    , freer-simple   other-modules:-      Capitalize-      Console-      Coroutine-      Fresh-      Trace-      Paths_freer_simple-  default-language: Haskell2010+    Capitalize+    Console+    Coroutine+    Fresh+    Trace -test-suite unit+  build-depends: freer-simple++test-suite freer-simple-test+  import: common   type: exitcode-stdio-1.0+  hs-source-dirs: tests   main-is: Tests.hs-  hs-source-dirs:-      tests-  default-extensions: ConstraintKinds DataKinds DeriveFunctor FlexibleContexts FlexibleInstances FunctionalDependencies GADTs LambdaCase MultiParamTypeClasses RankNTypes ScopedTypeVariables TypeApplications TypeOperators-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  other-modules:+    Tests.Coroutine+    Tests.Exception+    Tests.Fresh+    Tests.Loop+    Tests.NonDet+    Tests.Reader+    Tests.State+    Tests.TH+   build-depends:-      QuickCheck-    , base >=4.9 && <5+    , QuickCheck     , freer-simple     , tasty     , tasty-hunit     , tasty-quickcheck-  other-modules:-      Tests.Coroutine-      Tests.Exception-      Tests.Fresh-      Tests.Loop-      Tests.NonDet-      Tests.Reader-      Tests.State-      Paths_freer_simple-  default-language: Haskell2010 -benchmark core+benchmark freer-simple-bench+  import: common   type: exitcode-stdio-1.0+  hs-source-dirs: bench   main-is: Core.hs-  hs-source-dirs:-      bench-  default-extensions: ConstraintKinds DataKinds DeriveFunctor FlexibleContexts FlexibleInstances FunctionalDependencies GADTs LambdaCase MultiParamTypeClasses RankNTypes ScopedTypeVariables TypeApplications TypeOperators-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2+  ghc-options: -O2+   build-depends:-      base >=4.9 && <5     , criterion-    , extensible-effects <2+    , extensible-effects     , free     , freer-simple     , mtl-  other-modules:-      Paths_freer_simple-  default-language: Haskell2010
src/Control/Monad/Freer.hs view
@@ -91,7 +91,7 @@       'Just' contents -> 'pure' contents       'Nothing' -> 'error' ("readFile: no such file " ++ path)     WriteFile path contents -> 'Control.Monad.Freer.State.modify' $ \\vfs ->-      (path, contents) : 'Data.List.delete' (path, contents) vfs+      (path, contents) : 'Data.List.deleteBy' (('==') ``Data.Function.on`` 'fst') (path, contents) vfs @  This handler is easy to write, doesn’t require any knowledge of how@@ -161,6 +161,10 @@  …then 'readFile' would /only/ be usable with an 'Eff' computation that /only/ performed @FileSystem@ effects, which isn’t especially useful.++Since writing these functions is entirely mechanical, they can be generated+automatically using Template Haskell; see "Control.Monad.Freer.TH" for more+details. -} module Control.Monad.Freer   ( -- * Effect Monad
src/Control/Monad/Freer/Internal.hs view
@@ -84,7 +84,7 @@ type Arr effs a b = a -> Eff effs b  -- | An effectful function from @a :: *@ to @b :: *@ that is a composition of--- several effectful functions. The paremeter @eff :: [* -> *]@ describes the+-- several effectful functions. The paremeter @effs :: [* -> *]@ describes the -- overall effect. The composition members are accumulated in a type-aligned -- queue. type Arrs effs a b = FTCQueue (Eff effs) a b
+ src/Control/Monad/Freer/TH.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++-- Originally ported from code written by Sandy Maguire (@isovector), available+-- at https://github.com/IxpertaSolutions/freer-effects/pull/28.++{-|+This module provides Template Haskell functions for automatically generating+effect operation functions (that is, functions that use 'send') from a given+effect algebra. For example, using the @FileSystem@ effect from the example in+the module documentation for "Control.Monad.Freer", we can write the following:++@+data FileSystem r where+  ReadFile :: 'FilePath' -> FileSystem 'String'+  WriteFile :: 'FilePath' -> 'String' -> FileSystem ()+'makeEffect' ''FileSystem+@++This will automatically generate the following functions:++@+readFile :: 'Member' FileSystem effs => 'FilePath' -> 'Eff' effs 'String'+readFile a = 'send' (ReadFile a)++writeFile :: 'Member' FileSystem effs => 'FilePath' -> 'String' -> 'Eff' effs ()+writeFile a b = 'send' (WriteFile a b)+@+-}+module Control.Monad.Freer.TH+  ( makeEffect+  , makeEffect_+  )+where++import Control.Monad (forM, unless)+import Control.Monad.Freer (send, Member, Eff)+import Data.Char (toLower)+import Language.Haskell.TH+import Prelude+++-- | If @T@ is a GADT representing an effect algebra, as described in the module+-- documentation for "Control.Monad.Freer", @$('makeEffect' ''T)@ automatically+-- generates a function that uses 'send' with each operation. For more+-- information, see the module documentation for "Control.Monad.Freer.TH".+makeEffect :: Name -> Q [Dec]+makeEffect = genFreer True++-- | Like 'makeEffect', but does not provide type signatures. This can be used+-- to attach Haddock comments to individual arguments for each generated+-- function.+--+-- @+-- data Lang x where+--   Output :: String -> Lang ()+--+-- makeEffect_ ''Lang+--+-- -- | Output a string.+-- output :: Member Lang effs+--        => String    -- ^ String to output.+--        -> Eff effs ()  -- ^ No result.+-- @+--+-- Note that 'makeEffect_' must be used /before/ the explicit type signatures.+makeEffect_ :: Name -> Q [Dec]+makeEffect_ = genFreer False++-- | Generates declarations and possibly signatures for functions to lift GADT+-- constructors into 'Eff' actions.+genFreer :: Bool -> Name -> Q [Dec]+genFreer makeSigs tcName = do+  -- The signatures for the generated definitions require FlexibleContexts.+  isExtEnabled FlexibleContexts+    >>= flip unless (fail "makeEffect requires FlexibleContexts to be enabled")++  reify tcName >>= \case+    TyConI (DataD _ _ _ _ cons _) -> do+      sigs <- filter (const makeSigs) <$> mapM genSig cons+      decs <- mapM genDecl cons+      return $ sigs ++ decs++    _ -> fail "makeEffect expects a type constructor"++-- | Given the name of a GADT constructor, return the name of the corresponding+-- lifted function.+getDeclName :: Name -> Name+getDeclName = mkName . overFirst toLower . nameBase+ where+  overFirst f (a : as) = f a : as+  overFirst _ as       = as++-- | Builds a function definition of the form @x a b c = send $ X a b c@.+genDecl :: Con -> Q Dec+genDecl (ForallC _       _     con) = genDecl con+genDecl (GadtC   [cName] tArgs _  ) = do+  let fnName = getDeclName cName+  let arity  = length tArgs - 1+  dTypeVars <- forM [0 .. arity] $ const $ newName "a"+  return $ FunD fnName . pure $ Clause+    (VarP <$> dTypeVars)+    (NormalB . AppE (VarE 'send) $ foldl+      (\b -> AppE b . VarE)+      (ConE cName)+      dTypeVars+    )+    []+genDecl _ = fail "genDecl expects a GADT constructor"++-- | Generates a function type from the corresponding GADT type constructor+-- @x :: Member (Effect e) effs => a -> b -> c -> Eff effs r@.+genType :: Con -> Q Type+genType (ForallC tyVarBindings conCtx con)+  = ForallT tyVarBindings conCtx <$> genType con+genType (GadtC   _ tArgs' (AppT eff tRet)) = do+  effs <- newName "effs"+  let+    tArgs            = fmap snd tArgs'+    memberConstraint = ConT ''Member `AppT` eff `AppT` VarT effs+    resultType       = ConT ''Eff `AppT` VarT effs `AppT` tRet++  return+#if MIN_VERSION_template_haskell(2,17,0)+    .  ForallT [PlainTV effs SpecifiedSpec] [memberConstraint]+#else+    .  ForallT [PlainTV effs] [memberConstraint]+#endif+    .  foldArrows+    $  tArgs+    ++ [resultType]+-- TODO: Although this should never happen, we obviously need a better error message below.+genType _       = fail "genSig expects a GADT constructor"++-- | Turn all (KindedTV tv StarT) into (PlainTV tv) in the given type+-- This can prevent the need for KindSignatures+simplifyBndrs :: Type -> Type+simplifyBndrs (ForallT bndrs tcxt t) = ForallT (map simplifyBndr bndrs) tcxt (simplifyBndrs t)+simplifyBndrs (AppT t1 t2) = AppT (simplifyBndrs t1) (simplifyBndrs t2)+simplifyBndrs (SigT t k) = SigT (simplifyBndrs t) k+simplifyBndrs (InfixT t1 n t2) = InfixT (simplifyBndrs t1) n (simplifyBndrs t2)+simplifyBndrs (UInfixT t1 n t2) = InfixT (simplifyBndrs t1) n (simplifyBndrs t2)+simplifyBndrs (ParensT t) = ParensT (simplifyBndrs t)+simplifyBndrs t = t++-- | Turn TvVarBndrs of the form (KindedTV tv StarT) into (PlainTV tv)+-- This can prevent the need for KindSignatures+#if MIN_VERSION_template_haskell(2,17,0)+simplifyBndr :: TyVarBndrSpec -> TyVarBndrSpec+simplifyBndr (KindedTV tv f StarT) = PlainTV tv f+#else+simplifyBndr :: TyVarBndr -> TyVarBndr+simplifyBndr (KindedTV tv StarT) = PlainTV tv+#endif+simplifyBndr bndr = bndr++-- | Generates a type signature of the form+-- @x :: Member (Effect e) effs => a -> b -> c -> Eff effs r@.+genSig :: Con -> Q Dec+genSig con = do+  let+    getConName (ForallC _ _ c) = getConName c+    getConName (GadtC [n] _ _) = pure n+    getConName c = fail $ "failed to get GADT name from " ++ show c+  conName <- getConName con+  SigD (getDeclName conName) <$> simplifyBndrs <$> genType con++-- | Folds a list of 'Type's into a right-associative arrow 'Type'.+foldArrows :: [Type] -> Type+foldArrows = foldr1 (AppT . AppT ArrowT)
src/Control/Monad/Freer/Writer.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module:       Control.Monad.Freer.Writer -- Description:  Composable Writer effects.@@ -19,7 +21,10 @@   ) where  import Control.Arrow (second)++#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif  import Control.Monad.Freer.Internal (Eff, Member, handleRelay, send)
src/Data/OpenUnion/Internal.hs view
@@ -32,11 +32,12 @@ -- substitution for @Typeable@. module Data.OpenUnion.Internal where +import Data.Kind (Type) import GHC.TypeLits (TypeError, ErrorMessage(..)) import Unsafe.Coerce (unsafeCoerce)  -- | Open union is a strong sum (existential with an evidence).-data Union (r :: [* -> *]) a where+data Union (r :: [Type -> Type]) a where   Union :: {-# UNPACK #-} !Word -> t a -> Union r a  -- | Takes a request of type @t :: * -> *@, and injects it into the 'Union'.@@ -76,7 +77,7 @@ -- prior to recursion, and it is used to produce better type errors. -- -- This is essentially a compile-time computation without run-time overhead.-class FindElem (t :: * -> *) (r :: [* -> *]) where+class FindElem (t :: Type -> Type) (r :: [Type -> Type]) where   -- | Position of the element @t :: * -> *@ in a type list @r :: [* -> *]@.   --   -- Position is computed during compilation, i.e. there is no run-time@@ -96,7 +97,7 @@  -- | Instance resolution for this class fails with a custom type error -- if @t :: * -> *@ is not in the list @r :: [* -> *]@.-class IfNotFound (t :: * -> *) (r :: [* -> *]) (w :: [* -> *])+class IfNotFound (t :: Type -> Type) (r :: [Type -> Type]) (w :: [Type -> Type])  -- | If we reach an empty list, that’s a failure, since it means the type isn’t -- in the list. For GHC >=8, we can render a custom type error that explicitly@@ -128,7 +129,7 @@ -- @ -- 'Member' ('Control.Monad.Freer.State.State' 'Integer') effs => 'Control.Monad.Freer.Eff' effs () -- @-class FindElem eff effs => Member (eff :: * -> *) effs where+class FindElem eff effs => Member (eff :: Type -> Type) effs where   -- This type class is used for two following purposes:   --   -- * As a @Constraint@ it guarantees that @t :: * -> *@ is a member of a
tests/Tests.hs view
@@ -12,6 +12,7 @@ import qualified Tests.Reader (tests) import qualified Tests.State (tests) import qualified Tests.Loop (tests)+import qualified Tests.TH (tests)  --------------------------------------------------------------------------------                            -- Pure Tests --@@ -38,4 +39,5 @@   , Tests.Reader.tests   , Tests.State.tests   , Tests.Loop.tests+  , Tests.TH.tests   ]
+ tests/Tests/TH.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TemplateHaskell #-}+module Tests.TH where++import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)++import Control.Monad.Freer (Eff, run, interpret, type(~>))+import Control.Monad.Freer.TH (makeEffect)++-- Create a test GADT for our effects.+data Prepender next where+  PrependSomething :: String -> Prepender String++-- Make TH generate our effect functions.+makeEffect ''Prepender++tests :: TestTree+tests = testGroup+  "TH tests"+  [ testProperty "Prepender uses generated effects"+      $ \s -> testGeneratedFunction s == ("prepended: " ++ s)+  ]++--------------------------------------------------------------------------------+                            -- Examples --+--------------------------------------------------------------------------------+runPrepender :: Eff (Prepender ': effs) ~> Eff effs+runPrepender = interpret+  (\case+  PrependSomething s -> pure $ "prepended: " ++ s+  )++testGeneratedFunction :: String -> String+testGeneratedFunction s = run . runPrepender $ prependSomething s++-- Create a more complicated test GADT+data Complicated a where+  Mono :: Int -> Complicated Bool+  Poly :: a -> Complicated a+  PolyIn :: a -> Complicated Bool+  PolyOut :: Int -> Complicated a+  Lots :: a -> b -> c -> d -> e -> f -> Complicated ()+  Nested :: Maybe b -> Complicated (Maybe a)+  MultiNested :: (Maybe a, [b]) -> Complicated (Maybe a, [b])+  Existential :: (forall e. e -> Maybe e) -> Complicated a+  LotsNested :: Maybe a -> [b] -> (c, c) -> Complicated (a, b, c)+  Dict :: (Ord a) => a -> Complicated a+  MultiDict :: (Eq a, Ord b, Enum a, Num c) => a -> b -> c -> Complicated ()++-- Make TH generate our effect functions.+makeEffect ''Complicated