effin 0.2.1.2 → 0.2.1.3

raw patch · 14 files changed

+173/−196 lines, 14 files

Files

effin.cabal +82/−79
src/Control/Effect/Bracket.hs +23/−26
src/Control/Effect/Coroutine.hs +1/−3
src/Control/Effect/Exception.hs +2/−4
src/Control/Effect/Lift.hs +1/−10
src/Control/Effect/List.hs +4/−7
src/Control/Effect/Reader.hs +12/−11
src/Control/Effect/State.hs +1/−3
src/Control/Effect/Thread.hs +4/−6
src/Control/Effect/Witness.hs +3/−7
src/Control/Effect/Writer.hs +7/−7
src/Control/Monad/Effect.hs +28/−25
src/Data/Index.hs +2/−2
src/Data/Union.hs +3/−6

effin.cabal view

@@ -1,79 +1,82 @@-name:                effin-version:             0.2.1.2-synopsis:            A Typeable-free implementation of extensible effects-homepage:            https://github.com/YellPika/effin-license:             BSD3-license-file:        LICENSE-author:              Anthony Vandikas-maintainer:          yellpika@gmail.com-copyright:           (c) 2014 Anthony Vandikas-category:            Control, Effect-build-type:          Simple-cabal-version:       >=1.10-description:-  This package implements extensible effects, and alternative to monad-  transformers. The original paper can be found at-  <http://okmij.org/ftp/Haskell/extensible/exteff.pdf>. The main differences-  between this library and the one described in the paper are that this library-  does not use the Typeable type class, and has a simpler API for handling-  effects.-  .-  For example, the following code implements a handler for exceptions:-  .-  > runException :: Effect (Exception e ': es) a -> Effect es (Either e a)-  > runException = eliminate-  >     (\x -> return (Right x))-  >     (\(Exception e) -> return (Left e))-  .-  Compare this to the corresponding code in extensible-effects-  (<http://hackage.haskell.org/package/extensible-effects>):-  .-  > runExc :: Typeable e => Eff (Exc e :> r) a -> Eff r (Either e a)-  > runExc = loop . admin-  >   where-  >     loop (Val x) = return (Right x)-  >     loop (E u)   = handleRelay u loop (\(Exc e) -> return (Left e))-  .-  In particular, effect implementors are not required to do any recursion,-  thereby making effect handlers more composeable.--flag mtl-  description: Enable MTL support-  default: True-  manual: True--library-  exposed-modules:-    Control.Effect,-    Control.Effect.Bracket,-    Control.Effect.Coroutine,-    Control.Effect.Exception,-    Control.Effect.Reader,-    Control.Effect.Lift,-    Control.Effect.List,-    Control.Effect.State,-    Control.Effect.Thread,-    Control.Effect.Witness,-    Control.Effect.Writer,-    Control.Monad.Effect--  other-modules:-    Data.Index,-    Data.Type.Row,-    Data.Type.Nat-    Data.Union--  build-depends: base >= 4.7 && < 4.8-  if flag(mtl)-    build-depends: mtl >= 2.1 && < 3--  hs-source-dirs: src-  default-language: Haskell2010-  ghc-options: -Wall--  if flag(mtl)-    cpp-options: -DMTL--source-repository head-  type:     git-  location: git://github.com/YellPika/effin.git+name:                effin
+version:             0.2.1.3
+synopsis:            A Typeable-free implementation of extensible effects
+homepage:            https://github.com/YellPika/effin
+license:             BSD3
+license-file:        LICENSE
+author:              Anthony Vandikas
+maintainer:          yellpika@gmail.com
+copyright:           (c) 2014 Anthony Vandikas
+category:            Control, Effect
+build-type:          Simple
+cabal-version:       >=1.10
+description:
+  This package implements extensible effects, and alternative to monad
+  transformers. The original paper can be found at
+  <http://okmij.org/ftp/Haskell/extensible/exteff.pdf>. The main differences
+  between this library and the one described in the paper are that this library
+  does not use the Typeable type class, does not require that effects implement
+  the Functor type class, and has a simpler API for handling
+  effects.
+  .
+  For example, the following code implements a handler for exceptions:
+  .
+  > newtype Exception e = Throw e
+  >
+  > runException :: Effect (Exception e :+ es) a -> Effect es (Either e a)
+  > runException = eliminate
+  >     (\x -> return (Right x))
+  >     (\(Throw e) k -> return (Left e))
+  .
+  Compare this to the corresponding code in extensible-effects
+  (<http://hackage.haskell.org/package/extensible-effects>):
+  .
+  > runExc :: Typeable e => Eff (Exc e :> r) a -> Eff r (Either e a)
+  > runExc = loop . admin
+  >   where
+  >     loop (Val x) = return (Right x)
+  >     loop (E u)   = handleRelay u loop (\(Exc e) -> return (Left e))
+  .
+  In particular, effect implementors are not required to do any recursion,
+  thereby making effect handlers more composeable.
+
+flag mtl
+  description: Enable MTL support
+  default: True
+  manual: True
+
+library
+  exposed-modules:
+    Control.Effect,
+    Control.Effect.Bracket,
+    Control.Effect.Coroutine,
+    Control.Effect.Exception,
+    Control.Effect.Reader,
+    Control.Effect.Lift,
+    Control.Effect.List,
+    Control.Effect.State,
+    Control.Effect.Thread,
+    Control.Effect.Witness,
+    Control.Effect.Writer,
+    Control.Monad.Effect
+
+  other-modules:
+    Data.Index,
+    Data.Type.Row,
+    Data.Type.Nat
+    Data.Union
+
+  build-depends: base >= 4.7 && < 4.8
+  if flag(mtl)
+    build-depends: mtl >= 2.1 && < 3
+
+  hs-source-dirs: src
+  default-language: Haskell2010
+  ghc-options: -Wall
+
+  if flag(mtl)
+    cpp-options: -DMTL
+
+source-repository head
+  type:     git
+  location: git://github.com/YellPika/effin.git

src/Control/Effect/Bracket.hs view

@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -23,8 +22,9 @@ 
 -- | Provides a base effect for exceptions. This effect allows the dynamic
 -- generation of exception classes at runtime.
-newtype Bracket s a = Bracket { unBracket :: Union (Raise s :+ Witness s :+ Nil) a }
-  deriving Functor
+data Bracket s a where
+    Raise :: Tag s b -> b -> Bracket s a
+    BWitness :: Witness s a -> Bracket s a
 
 -- | The type of placeholder values indicating an exception class.
 data Tag s a = Tag (a -> String) (Token s a)
@@ -44,11 +44,11 @@ -- | Creates a new tag. The function parameter describes the error message that
 -- is shown in the case of an uncaught exception.
 newTag :: EffectBracket s l => (a -> String) -> Effect l (Tag s a)
-newTag toString = mask' $ Tag toString <$> newToken
+newTag toString = conceal $ Tag toString <$> rename BWitness newToken
 
 -- | Raises an exception of the specified class and value.
 raiseWith :: EffectBracket s l => Tag s b -> b -> Effect l a
-raiseWith tag value = mask' $ send $ Raise tag value
+raiseWith tag value = send $ Raise tag value
 
 -- | Specifies a handler for exceptions of a given class.
 exceptWith :: EffectBracket s l => Tag s b -> Effect l a -> (b -> Effect l a) -> Effect l a
@@ -75,9 +75,13 @@ -- The most common use case for catching all exceptions is to do cleanup, which
 -- is what bracket is for.
 exceptAll :: EffectBracket s l => Effect l a -> (forall b. Tag s b -> b -> Effect l a) -> Effect l a
-exceptAll effect handler = mask' $ run $ unmask' effect
-  where
-    run = intercept return $ \(Raise t x) -> unmask' (handler t x)
+exceptAll effect handler = intercept
+    return
+    (\b k ->
+        case b of
+            Raise t x -> handler t x
+            _ -> send b >>= k)
+    effect
 
 -- | Executes a computation with a resource, and ensures that the resource is
 -- cleaned up afterwards.
@@ -105,22 +109,15 @@ -- | Executes a `Bracket` effect. The Rank-2 type ensures that `Tag`s do not
 -- escape their scope.
 runBracket :: (forall s. Effect (Bracket s :+ l) a) -> Effect l a
-runBracket effect =
-    runWitness
-    $ eliminate return (\(Raise (Tag f _) x) -> error (f x))
-    $ flatten
-    $ rename unBracket effect
-
--- A couple helper functions for getting in and out of the base effects.
-mask' :: EffectBracket s l => Effect (Raise s :+ Witness s :+ l) a -> Effect l a
-mask' = mask Bracket
-
-unmask' :: EffectBracket s l => Effect l a -> Effect (Raise s :+ Witness s :+ l) a
-unmask' = unmask unBracket
-
--- Quick and dirty exceptions (because Union works with existing functors).
-data Raise s a where
-    Raise :: Tag s b -> b -> Raise s a
+runBracket effect = runWitness (convert effect)
 
-instance Functor (Raise s) where
-    fmap _ (Raise n x) = Raise n x
+convert :: Effect (Bracket s :+ l) a -> Effect (Witness s :+ l) a
+convert =
+    eliminate
+        return
+        (\t k ->
+            case t of
+                Raise (Tag f _) x -> error (f x)
+                BWitness w -> send w >>= k)
+    . swap
+    . extend

src/Control/Effect/Coroutine.hs view

@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -16,7 +15,6 @@ 
 -- | An effect describing a suspendable computation.
 data Coroutine i o a = Coroutine (o -> a) i
-  deriving Functor
 
 type instance Is Coroutine f = IsCoroutine f
 
@@ -34,7 +32,7 @@ 
 -- | Converts a `Coroutine` effect into an `Iterator`.
 runCoroutine :: Effect (Coroutine i o :+ l) a -> Effect l (Iterator i o l a)
-runCoroutine = eliminate (return . Done) (\(Coroutine f k) -> return (Next f k))
+runCoroutine = eliminate (return . Done) (\(Coroutine f x) k -> return (Next (k . f) x))
 
 -- | A suspended computation.
 data Iterator i o l a

src/Control/Effect/Exception.hs view

@@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -31,7 +30,6 @@ 
 -- | An effect that describes the possibility of failure.
 data Exception e a = Raise e | Catch a (e -> a)
-  deriving Functor
 
 type instance Is Exception f = IsException f
 
@@ -60,5 +58,5 @@         (eliminate (return . Right) (bind tag) effect)
         (return . Left)
   where
-    bind tag (Raise e) = raiseWith tag e
-    bind tag (Catch x f) = exceptWith tag x f
+    bind tag (Raise e) _ = raiseWith tag e
+    bind tag (Catch x f) k = exceptWith tag (k x) (k . f)

src/Control/Effect/Lift.hs view

@@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -18,7 +16,6 @@ ) where
 
 import Control.Monad.Effect
-import Control.Monad (join, liftM)
 
 #ifdef MTL
 import Control.Monad.Trans (MonadIO (..))
@@ -28,14 +25,8 @@ #endif
 
 -- | An effect described by a monad.
--- All monads are functors, but not all `Monad`s have `Functor` instances.
--- By wrapping a monad in the `Lift` effect, all monads can be used without
--- having to provide a `Functor` instance for each one.
 newtype Lift m a = Lift { unLift :: m a }
 
-instance Monad m => Functor (Lift m) where
-    fmap f = Lift . liftM f . unLift
-
 type instance Is Lift f = IsLift f
 
 type family IsLift f where
@@ -58,4 +49,4 @@ runLift :: Monad m => Effect (Lift m :+ Nil) a -> m a
 runLift = runEffect . eliminate
     (return . return)
-    (return . join . liftM runEffect . unLift)
+    (\(Lift m) k -> return $ m >>= runEffect . k)

src/Control/Effect/List.hs view

@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -21,8 +20,7 @@ import Control.Monad (MonadPlus (..), (<=<), join)
 
 -- | A nondeterminism (backtracking) effect.
-newtype List a = List { unList :: [a] }
-  deriving Functor
+newtype List a = List [a]
 
 type instance Is List f = IsList f
 
@@ -48,7 +46,7 @@ -- | Obtains all possible values from a computation
 -- parameterized by a nondeterminism effect.
 runList :: Effect (List :+ l) a -> Effect l [a]
-runList = eliminate (return . return) (fmap concat . sequence . unList)
+runList = eliminate (return . return) (\(List xs) k -> concat <$> mapM k xs)
 
 instance EffectList l => Alternative (Effect l) where
     empty = never
@@ -61,7 +59,6 @@ -- | Describes a Prolog-like cut effect.
 -- This effect must be used with the `List` effect.
 data Cut a = CutFalse
-  deriving Functor
 
 class (EffectList l, Member Cut l) => CutEffect l
 instance (EffectList l, Member Cut l) => CutEffect l
@@ -91,10 +88,10 @@     -- should stop.
     reifyCut :: EffectList l => Effect (Cut :+ l) a -> Effect l (Bool, [a])
     reifyCut =
-        intercept return (runAll . unList) .
+        intercept return (\(List xs) k -> runAll (map k xs)) .
         eliminate
             (\x -> return (False, [x]))
-            (\CutFalse -> return (True, []))
+            (\CutFalse _ -> return (True, []))
 
     runAll [] = return (False, [])
     runAll (x:xs) = do

src/Control/Effect/Reader.hs view

@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
@@ -20,6 +20,7 @@ 
 import Control.Effect.State
 import Control.Monad.Effect
+import Control.Applicative ((<$>))
 
 #ifdef MTL
 import Data.Type.Row
@@ -32,11 +33,8 @@ #endif
 
 -- | An effect that provides an implicit environment.
-newtype Reader r a = Reader (r -> a)
-  deriving Functor
-
-unReader :: r -> Reader r a -> a
-unReader x (Reader f) = f x
+data Reader r a where
+    Ask :: Reader r r
 
 type instance Is Reader f = IsReader f
 
@@ -49,24 +47,27 @@ 
 -- | Retrieves the current environment.
 ask :: EffectReader r l => Effect l r
-ask = asks id
+ask = send Ask
 
 -- | Retrieves a value that is a function of the current environment.
 asks :: EffectReader r l => (r -> a) -> Effect l a
-asks = send . Reader
+asks f = f <$> ask
 
 -- | Runs a computation with a modified environment.
 local :: EffectReader r l => (r -> r) -> Effect l a -> Effect l a
 local f effect = do
     env <- asks f
-    intercept return (unReader env) effect
+    intercept return (bind env) effect
 
 -- | Executes a reader computation which obtains
 -- its environment value from a state effect.
 stateReader :: EffectState s l => Effect (Reader s :+ l) a -> Effect l a
-stateReader = eliminate return (\(Reader f) -> get >>= f)
+stateReader = eliminate return (\Ask k -> get >>= k)
 
 -- | Completely handles a `Reader` effect by providing an
 -- environment value to be used throughout the computation.
 runReader :: r -> Effect (Reader r :+ l) a -> Effect l a
-runReader env = eliminate return (unReader env)
+runReader env = eliminate return (bind env)
+
+bind :: r -> Reader r a -> (a -> s) -> s
+bind env Ask k = k env

src/Control/Effect/State.hs view

@@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -35,7 +34,6 @@ 
 -- | An effect where a state value is threaded throughout the computation.
 newtype State s a = State (s -> (a, s))
-  deriving Functor
 
 type instance Is State f = IsState f
 
@@ -84,7 +82,7 @@ runState :: s -> Effect (State s :+ l) a -> Effect l (a, s)
 runState = flip $ eliminate
     (\x s -> return (x, s))
-    (\(State k) s -> let (k', s') = k s in k' s')
+    (\(State f) k s -> let (x, s') = f s in k x s')
 
 -- | Completely handles a `State` effect, and discards the final state.
 evalState :: s -> Effect (State s :+ l) a -> Effect l a

src/Control/Effect/Thread.hs view

@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeOperators #-}
@@ -19,7 +18,6 @@ 
 -- | An effect that describes concurrent computation.
 data Thread a = Yield a | Fork a a | Abort
-  deriving Functor
 
 class Member Thread l => EffectThread l
 instance Member Thread l => EffectThread l
@@ -97,8 +95,8 @@ -- different backends to interpret calls to fork/yield/abort as they please. See
 -- the implementations of runAsync, runSync, and runMain.
 toAST :: Effect (Thread :+ l) () -> Effect l (ThreadAST l)
-toAST = eliminate (\() -> return AbortAST) bind
+toAST = eliminate (\_ -> return AbortAST) bind
   where
-    bind Abort = return AbortAST
-    bind (Yield k) = return (YieldAST k)
-    bind (Fork child parent) = return (ForkAST child parent)
+    bind Abort _ = return AbortAST
+    bind (Yield x) k = return (YieldAST (k x))
+    bind (Fork child parent) k = return (ForkAST (k child) (k parent))

src/Control/Effect/Witness.hs view

@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -36,10 +35,7 @@ 
 -- | An effect describing the generation of unique identifiers.
 data Witness s a where
-    Witness :: (Token s b -> a) -> Witness s a
-
-instance Functor (Witness s) where
-    fmap f (Witness g) = Witness (f . g)
+    NewToken :: Witness s (Token s a)
 
 type instance Is Witness f = IsWitness f
 
@@ -56,12 +52,12 @@ 
 -- | Generates a new, unique `Token`.
 newToken :: EffectWitness s l => Effect l (Token s a)
-newToken = send (Witness id)
+newToken = send NewToken
 
 -- | Completely handles a `Witness` effect. The Rank-2 quantifier ensures that
 -- unique identifiers cannot escape the context in which they were created.
 runWitness :: (forall s. Effect (Witness s :+ l) a) -> Effect l a
 runWitness effect = run effect
   where
-    run = eliminate return $ \(Witness k) ->
+    run = eliminate return $ \NewToken k ->
         k $ Token $ unsafePerformIO newUnique

src/Control/Effect/Writer.hs view

@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
@@ -35,8 +35,8 @@ #endif
 
 -- | An effect that allows accumulating output.
-data Writer w a = Writer w a
-  deriving Functor
+data Writer w a where
+    Tell :: w -> Writer w ()
 
 type instance Is Writer f = IsWriter f
 
@@ -49,7 +49,7 @@ 
 -- | Writes a value to the output.
 tell :: EffectWriter w l => w -> Effect l ()
-tell x = send (Writer x ())
+tell = send . Tell
 
 -- | Executes a computation, and obtains the writer output.
 -- The writer output of the inner computation is still
@@ -80,7 +80,7 @@ 
 -- | Executes a writer computation which sends its output to a state effect.
 stateWriter :: (Monoid s, EffectState s l) => Effect (Writer s :+ l) a -> Effect l a
-stateWriter = eliminate return (\(Writer l x) -> modify (mappend l) >> x)
+stateWriter = eliminate return (\(Tell l) k -> modify (mappend l) >> k ())
 
 -- | Completely handles a writer effect. The writer value must be a `Monoid`.
 -- `mempty` is used as an initial value, and `mappend` is used to combine values.
@@ -91,5 +91,5 @@ point :: Monoid w => a -> Effect l (a, w)
 point x = return (x, mempty)
 
-bind :: Monoid w => Writer w (Effect l (b, w)) -> Effect l (b, w)
-bind (Writer l k) = second (mappend l) <$> k
+bind :: Monoid w => Writer w a -> (a -> Effect l (b, w)) -> Effect l (b, w)
+bind (Tell l) k = second (mappend l) <$> k ()

src/Control/Monad/Effect.hs view

@@ -37,7 +37,7 @@  import Data.Type.Row -import Control.Applicative (Applicative (..), (<$>))+import Control.Applicative (Applicative (..)) import Control.Monad (join)  -- | An effectful computation. An @Effect l a@ may perform any of the effects@@ -49,9 +49,9 @@ --     Done :: a -> Effect l a --     Side :: `Union` l (Effect l a) -> Effect l a -- @-newtype Effect l a = Effect (forall r. (a -> r) -> (Union l r -> r) -> r)+newtype Effect l a = Effect (forall r. (a -> r) -> (forall b. Union l b -> (b -> r) -> r) -> r) -unEffect :: (a -> r) -> (Union l r -> r) -> Effect l a -> r+unEffect :: (a -> r) -> (forall b. Union l b -> (b -> r) -> r) -> Effect l a -> r unEffect point bind (Effect f) = f point bind  instance Functor (Effect l) where@@ -72,15 +72,15 @@ runEffect (Effect f) = f id Union.absurd  -- | Executes an effect of type @f@ that produces a return value of type @a@.-send :: (Functor f, Member f l) => f a -> Effect l a-send x = Effect $ \point bind -> bind $ point <$> Union.inject x -- Inlined for efficiency (from relay).+send :: Member f l => f a -> Effect l a+send x = Effect $ \point bind -> bind (Union.inject x) point  -- | Executes an effect of type @f@ that produces a return value of type @r@. -- Note that a specific instance of this function is of type--- @(Functor f, Member f l) => f (Effect l a) -> Effect l a@, which allows users+-- @Member f l => f (Effect l a) -> Effect l a@, which allows users -- to send effects parameterized by effects.-sendEffect :: (Functor f, Member f l, Effectful l r) => f r -> r-sendEffect = relay . Union.inject+sendEffect :: (Member f l, Effectful l r) => f r -> r+sendEffect x = relay (Union.inject x) id  -- | The class of types which result in an effect. That is: --@@ -92,36 +92,35 @@     -- | Determines the effects associated with the return type of a function.     type family EffectsOf r :: Row (* -> *) -    relay :: Union l r -> r+    relay :: Union l a -> (a -> r) -> r      -- Prevents the `Minimal Complete Definition` box from showing.     relay = undefined  instance Effectful l (Effect l a) where     type EffectsOf (Effect l a) = l-    relay u = join $ Effect $ \point bind -> bind $ point <$> u+    relay u f = join $ Effect $ \point bind -> bind u (point . f)  instance Effectful l r => Effectful l (a -> r) where     type EffectsOf (a -> r) = EffectsOf r-    relay u x = relay (fmap ($ x) u)+    relay u f y = relay u (\x -> f x y) --- | Handles an effect without eliminating it. The given function is passed an--- effect value parameterized by the output type (i.e. the return type of--- `handle`).+-- | Handles an effect without eliminating it. The second function parameter is+-- passed an effect value and a continuation function. -- -- The most common instantiation of this function is: -- -- > (a -> Effect l b) -> (f (Effect l b) -> Effect l b) -> Effect l a -> Effect l b-intercept :: (Effectful l r, Member f l) => (a -> r) -> (f r -> r) -> Effect l a -> r+intercept :: (Effectful l r, Member f l) => (a -> r) -> (forall b. f b -> (b -> r) -> r) -> Effect l a -> r intercept point bind = unEffect point $ \u -> maybe (relay u) bind (Union.project u) --- | Completely handles an effect. The given function is passed an effect value--- parameterized by the output type (i.e. the return type of `handle`).+-- | Completely handles an effect. The second function parameter is passed an+-- effect value and a continuation function. -- -- The most common instantiation of this function is: -- -- > (a -> Effect l b) -> (f (Effect l b) -> Effect l b) -> Effect (f ': l) a -> Effect l b-eliminate :: Effectful l r => (a -> r) -> (f r -> r) -> Effect (f :+ l) a -> r+eliminate :: Effectful l r => (a -> r) -> (forall b. f b -> (b -> r) -> r) -> Effect (f :+ l) a -> r eliminate point bind = unEffect point (either bind relay . Union.pop)  -- | Adds an arbitrary effect to the head of the effect list.@@ -132,18 +131,22 @@ enable :: Effect (f :- l) a -> Effect l a enable = translate Union.enable --- | Hides an effect @g@ by translating each instance of @g@ into an instance of--- another effect @f@.+-- | Hides an effect @f@ by translating each instance of the effect into an+-- equivalent effect further into the effect list.+--+-- prop> conceal = eliminate return (\x k -> send x >>= k) conceal :: Member f l => Effect (f :+ l) a -> Effect l a conceal = translate Union.conceal --- | Hides an effect @g@ by translating each instance of another effect @f@ into--- an instance of @g@.+-- | Hides an effect @f@ by translating each instance of the effect into an+-- equivalent effect at the head of the effect list. reveal :: Member f l => Effect l a -> Effect (f :+ l) a reveal = translate Union.reveal  -- | Translates the first effect in the effect list into another effect.-rename :: Functor g => (forall r. f r -> g r) -> Effect (f :+ l) a -> Effect (g :+ l) a+--+-- prop> rename f = eliminate return (\x k -> send (f x) >>= k) . swap . extend+rename :: (forall r. f r -> g r) -> Effect (f :+ l) a -> Effect (g :+ l) a rename f = translate (either (Union.inject . f) Union.push . Union.pop)  -- | Reorders the first two effects in a computation.@@ -168,13 +171,13 @@ -- | Converts a set of effects @l@ into a single effect @f@. -- -- @ mask f = `conceal` . `rename` f . `unflatten` @-mask :: (Functor f, KnownLength l, Member f m) => (forall r. Union l r -> f r) -> Effect (l :++ m) a -> Effect m a+mask :: (KnownLength l, Member f m) => (forall r. Union l r -> f r) -> Effect (l :++ m) a -> Effect m a mask f = conceal . rename f . unflatten  -- | Converts an effect @f@ into a set of effects @l@. -- -- @ unmask f = `flatten` . `rename` f . `reveal` @-unmask :: (Functor f, Inclusive l, Member f m) => (forall r. f r -> Union l r) -> Effect m a -> Effect (l :++ m) a+unmask :: (Inclusive l, Member f m) => (forall r. f r -> Union l r) -> Effect m a -> Effect (l :++ m) a unmask f = flatten . rename f . reveal  -- | A refined `Member`ship constraint that can infer @f@ from @l@, given

src/Data/Index.hs view

@@ -81,8 +81,8 @@ rotate :: Index (e :+ f :+ g :+ l) h -> Index (f :+ g :+ e :+ l) h
 rotate (Index i)
     | i == 0 = Index 2
-    | i == 1 = Index 1
-    | i == 2 = Index 0
+    | i == 1 = Index 0
+    | i == 2 = Index 1
     | otherwise = Index i
 
 prepend :: KnownLength l => proxy l -> Index m e -> Index (l :++ m) e

src/Data/Union.hs view

@@ -26,21 +26,18 @@ -- corresponding effect. From the user's perspective, it provides a way to -- encapsulate multiple effects. data Union l a where-    Union :: Functor f => Index l f -> f a -> Union l a--instance Functor (Union l) where-    fmap f (Union i x) = Union i (fmap f x)+    Union :: Index l f -> f a -> Union l a  absurd :: Union Nil a -> b absurd (Union i _) = Index.absurd i -wrap :: Functor f => f a -> Union (f :+ l) a+wrap :: f a -> Union (f :+ l) a wrap = inject  unwrap :: Union (f :+ Nil) a -> f a unwrap (Union i x) = gcastWith (Index.trivial i) x -inject :: (Functor f, Member f l) => f a -> Union l a+inject :: Member f l => f a -> Union l a inject = Union Index.index  project :: Member f l => Union l a -> Maybe (f a)