packages feed

transformers-eff (empty) → 0.1.0.0

raw patch · 11 files changed

+535/−0 lines, 11 filesdep +basedep +criteriondep +effect-interpreterssetup-changed

Dependencies added: base, criterion, effect-interpreters, free, mmorph, mtl, pipes, transformers

Files

+ Control/Effect.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}++module Control.Effect+       ( -- * Core API+         Eff(..), translate, Interprets, interpret, IsEff) where++import Control.Monad+import Control.Monad.Morph+import Control.Monad.Trans.Cont (ContT(..))+import Data.Functor.Sum+import GHC.Exts (Constraint)++-- | The 'Eff' monad transformer is used to write programs that require access to+-- specific effects. In this library, effects are combined by stacking multiple+-- 'Eff's together, just as you would do with traditional monad transformers.+-- 'Eff's are parameterized by an effect /algebra/. This is a+-- description of programs in a single effect, such as non-determinism (@[]@)or+-- exceptions (@Either e@). As 'Eff' is a monad transformer, @m@ is the monad+-- that 'Eff' transforms, which can itself be another instance of 'Eff'.+newtype Eff f m a =+  Eff (forall g r. (forall x. Sum f m x -> Cont (g r) x) -> Cont (g r) a)++-- | The 'IsEff' type family is used to make sure that a given monad stack+-- is based around 'Eff'. This is important, as it allows us to reason about+-- Eff-based type classes, knowing that /only/ 'Eff' implements them, thus+-- giving us the orthogonal-handling properties that we desire.+type family IsEff (m :: * -> *) :: Constraint where+  IsEff (Eff f m) = ()++-- NOTE The second argument to Eff is statically determined in translate,+-- but moving this into the 'MonadTrans' definition seems to half the+-- performance in benchmarks.++-- | In order to run 'Eff' computations, we need to provide a way to run its+-- effects in a specific monad transformer. Notice that 'run' eliminates one+-- layer of 'Eff', returning you with the original @a@ now captured under the+-- result of the effects described by the @effect@ functor.+translate :: (Monad m,Monad (t m),MonadTrans t)+          => (forall x r. f x -> ContT r (t m) x)+          -> Eff f m a+          -> t m a+translate step (Eff go) =+  runCont (go (\sum ->+                 case sum of+                   InL a -> cont (runContT (step a))+                   InR a -> cont (\k -> join (lift (fmap k a)))))+          return+{-# INLINE translate #-}++-- | 'LiftProgram' defines an @mtl@-style type class for automatically lifting+-- effects into 'Eff' stacks. When exporting libraries that you intend to+-- publish on Hackage, it's suggested that you still provide your own type class+-- (such as 'MonadThrow' or 'MonadHTTP') to avoid locking people into this+-- library, but 'interpret' can be useful to define your own instances of+-- that type class for 'Eff'.+class (IsEff m, Monad m) => Interprets p m | m -> p where+  interpret :: p a -> m a++instance Monad m => Interprets f (Eff f m) where+  interpret p = Eff (\i -> i (InL p))+  {-# INLINE interpret #-}++instance (Monad m, Interprets f (Eff h m)) => Interprets f (Eff g (Eff h m)) where+  interpret = lift . interpret+  {-# INLINE interpret #-}++instance Functor (Eff f m) where+  fmap f (Eff g) = Eff (\a -> fmap f (g a))+  {-# INLINE fmap #-}++instance Applicative (Eff f m) where+  pure a = Eff (\_ -> pure a)+  {-# INLINE pure #-}+  (<*>) = ap+  {-# INLINE (<*>) #-}++instance Monad (Eff f m) where+  return = pure+  {-# INLINE return #-}+  Eff a >>= f = Eff (\u -> a u >>= \b -> case f b of Eff g -> g u)+  {-# INLINE (>>=) #-}++instance MonadTrans (Eff f) where+  lift m = Eff (\l -> l (InR m))+  {-# INLINE lift #-}++{-++Welcome to @effect-interpreters@, a composable approach to managing effects in+Haskell. @effect-interpreters@ is a small abstraction over the ideas of monad+transformers, the @mtl@, and algebraic effects made popular through free monads+and various implementations of extensible effects. Rather than defining the+whole program within a free monad and duplicating code on how to interpret+well defined effects, this library leverages the tools of the monad transformer+library to deliver something that is familiar, compatible with other libraries+and as fast as vanilla monad transformers.++With the marketting pitch out of the way, you may be asking yourself: why does+this library exist? Firstly, if you use restrict yourself to only using monad+transformers you incur a lot of boilerplate code by having to specify all the+necessary @lift@s to move between layers. On top of this, the resulting code+is extremely difficult to compose with different effects - if you're lucky+the transformer will be an instance of @MFunctor@ and can be mapped between+different effects, but again - this is boilerplate that we'd ideally like to+avoid. The monad transformer library (@mtl@) solves some of these problems by+moving operations into a type class, but introduces a more subtle problem along+the way. Consider the following:++@+lookupPerson :: PersonName -> +@++. @effect-interpreters@ provides you with a toolkit to+write programs that are polymorphic over the choice of monad, stipulating that+whatever monad is chosen has access to certain underlying effects.+@effect-interpreters@ comes with the 'Eff' monad to eliminate individual effects+one-by-one, and allows you to easily define your own effects and multiple+interpretations. In this short guide, I'll demonstrate how to get started with+this library.++Within @effect-interpreters@, effects consist of:++1. A language to write programs using operations within the given effect+2. Interpretations of these effects using only the effects of a "smaller" monad.++To start, let's walk through the construction of an effect for failure. You're+probably already familiar with the language to write failing programs - it's the+'Maybe' monad! Within the 'Maybe' monad, we have the ability to fail earlier+by using 'Nothing', or we can produce successful values with 'Just' or 'return'.+Importantly, we can combine multiple 'Maybe' programs together by using its+'Monad' instance.++Now that we have our language, we need to write interpretations of 'Maybe'. One+such interpretation in any bigger monad is to run the program down to @Maybe a@.+That is, we seek a combinator with a type similar to:++@+attempt :: PotentiallyFailing a -> m (Maybe a)+@++Here @attempt@ will attempt to run a program and handle the case when it+attempts to fail. We can build this combinator using @effect-interpreters@ with+'handle':++@+attempt :: Eff Maybe m a -> m (Maybe a)+attempt =+  handle Intepretation { run = \continue p -> case p of+                                                Just a -> continue a+                                                Nothing -> return Nothing+                       , finalize = Just}+@++Let's take this line by line. On the first line with the type. It's similar to+the type I suggested earlier, but to speak specifically about+@PotentiallyFailing@ programs means to be working in an 'Eff' monad transformer+that has the ability to interpret to 'Maybe' programs.++Next, we build our 'Interpretation' and eliminate the 'Maybe' effect by calling+'handle' with this interpretation. An 'Intepreration' consists of a way to run+effectful computations, and a way to lift pure values into the final return+type.++To understand 'run', let's specialize the type of it given what we know. We know+that the 'Intepreration' we are building has type+'Interpretation Maybe Maybe m'. This means that 'run' has the type:++@+run :: forall a b. (a -> m (Maybe b)) -> Maybe a -> m (Maybe b)+@++The first argument to 'run' is a /continuation/. Whenever we try and lift a+an effect into 'Eff', we are given the rest of the program - it's then up to the+'Interpretation' if it will actually continue. In the case of failing programs,+it depends. If we're lifting a successful program - that is, @Just a@ - then we+can continue, but if we're lifting a failure then we certainly can't continue.+If you now return to our definition of run, you'll see that we pattern match+on the effectful program that we have to run, continuing or failing as+appropriate.++The other part of an 'Interpretation' is a description of what happens if we+never use the effect that we have access to. That is, what if we are told to+run an 'Eff Maybe' program that never actually uses the ability to fail? In this+case, we have to provide a way to lift pure values into the same context as+'run' - so we simply treat it as success.++-}++-- Redefinition of Control.Monad.Trans.Cont because, surprise surprise, it has+-- no inline pragmas.++cont :: ((a -> r) -> r) -> Cont r a+cont = Cont+{-# INLINE cont #-}++newtype Cont r a = Cont { runCont :: (a -> r) -> r }++instance Functor (Cont r) where+  fmap f m = Cont $ \c -> runCont m (c . f)+  {-# INLINE fmap #-}++instance Applicative (Cont r) where+  pure x = Cont ($ x)+  {-# INLINE pure #-}+  f <*> v = Cont $ \c -> runCont f $ \g -> runCont v (c . g)+  {-# INLINE (<*>) #-}++instance Monad (Cont r) where+  return x = Cont ($ x)+  {-# INLINE return #-}+  m >>= k = Cont $ \c -> runCont m (\x -> runCont (k x) c)+  {-# INLINE (>>=) #-}
+ Control/Effect/Environment.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}++module Control.Effect.Environment+       (EffEnvironment, runInEnvironment, ask, asks, mapEnvironment, liftReader,+        effToReaderT, readerTToEff)+       where++import Control.Effect+import Control.Monad.Morph (lift, hoist, generalize)+import Control.Monad.Trans.Reader (Reader, ReaderT(..))+import qualified Control.Monad.Trans.Reader as Reader++class (Monad m) => EffEnvironment env m | m -> env where+  liftReader :: Reader env a -> m a++instance Monad m => EffEnvironment env (Eff (Reader env) m) where+  liftReader = interpret+  {-# INLINE liftReader #-}++instance {-# OVERLAPPABLE #-} (EffEnvironment env m) => EffEnvironment env (Eff effects m) where+  liftReader = lift . liftReader+  {-# INLINE liftReader #-}++ask :: (EffEnvironment env m) => m env+ask = liftReader Reader.ask+{-# INLINE ask #-}++asks :: (EffEnvironment a m) => (a -> b) -> m b+asks f = fmap f ask+{-# INLINE asks #-}++runInEnvironment+  :: Monad m+  => Eff (Reader env) m a -> env -> m a+runInEnvironment = runReaderT . effToReaderT+{-# INLINE runInEnvironment #-}++mapEnvironment+  :: (EffEnvironment env m)+  => (env -> env') -> Eff (Reader env') m a -> m a+mapEnvironment f m = ask >>= runInEnvironment m . f+{-# INLINE mapEnvironment #-}++effToReaderT :: Monad m => Eff (Reader e) m a -> ReaderT e m a+effToReaderT = translate (lift . hoist generalize)+{-# INLINE effToReaderT #-}++readerTToEff :: (Monad m, EffEnvironment e m) => ReaderT e m a -> m a+readerTToEff m = ask >>= runReaderT m+{-# INLINE readerTToEff#-}
+ Control/Effect/Exception.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}++module Control.Effect.Exception+       (EffException, try, throw, liftEither, effToExceptT, exceptTToEff) where++import Control.Effect+import Control.Monad ((>=>))+import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.Trans.Except++class Monad m => EffException e m | m -> e where+  liftEither :: Either e a -> m a++instance Monad m => EffException e (Eff (Either e) m) where+  liftEither = interpret+  {-# INLINE liftEither #-}++instance {-# OVERLAPPABLE #-} (EffException e m) => EffException e (Eff f m) where+  liftEither = lift . liftEither+  {-# INLINE liftEither #-}++throw :: EffException e m => e -> m a+throw = liftEither . Left+{-# INLINE throw #-}++try :: Monad m => Eff (Either e) m a -> m (Either e a)+try = runExceptT . effToExceptT+{-# INLINE try #-}++effToExceptT :: Monad m => Eff (Either e) m a -> ExceptT e m a+effToExceptT = translate (lift . ExceptT . return)+{-# INLINE effToExceptT #-}++exceptTToEff :: (Monad m, EffException e m) => ExceptT e m a -> m a+exceptTToEff = runExceptT >=> liftEither+{-# INLINE exceptTToEff#-}
+ Control/Effect/IO.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Control.Effect.IO (UIO, runUIO, syncIO, EffUIO(..), runExceptionalIO) where++import Control.Effect+import Control.Exception (SomeException, throwIO, try)+import Control.Monad ((>=>))+import Control.Monad.Trans.Class (lift)+import qualified Control.Effect.Exception as Ex++-- | Lift an 'IO' action and explictly throw an synchronous IO exceptions that+-- occur.+syncIO :: (Interprets (Either SomeException) m,EffUIO m)+       => IO a -> m a+syncIO io = liftUIO (UIO (try io)) >>= interpret -- TODO This is catching async++runExceptionalIO+  :: Eff (Either SomeException) IO a -> IO a+runExceptionalIO = Ex.try >=> either throwIO return++newtype UIO a =+  UIO {runUIO :: IO a}+  deriving (Functor,Applicative,Monad)++class Monad m => EffUIO m where+  liftUIO :: UIO a -> m a++instance EffUIO IO where+  liftUIO (UIO io) = io++instance EffUIO UIO where+  liftUIO = id++instance EffUIO m => EffUIO (Eff r m) where+  liftUIO = lift . liftUIO
+ Control/Effect/Identity.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE FlexibleInstances #-}++module Control.Effect.Identity where++import Control.Effect+import qualified Data.Functor.Identity as Id+import qualified Control.Monad.Trans.Identity as Id++runIdentity+  :: Monad m+  => Eff Id.Identity m a -> m a+runIdentity = Id.runIdentityT . translate (return . Id.runIdentity)+{-# INLINE runIdentity #-}
+ Control/Effect/Nondeterminism.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++module Control.Effect.Nondeterminism where++import Control.Monad (join)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Cont (shiftT)+import Control.Effect+import qualified Pipes as P+import qualified Pipes.Prelude as P++-- TODO Can probably generalize over any foldable.++class Monad m => Nondeterministic m where+  liftNondeterminism :: [a] -> m a++instance Monad m => Nondeterministic (Eff [] m) where+  liftNondeterminism = interpret+  {-# INLINE liftNondeterminism #-}++instance {-# OVERLAPPABLE #-} (Nondeterministic m) => Nondeterministic (Eff f m) where+  liftNondeterminism = lift . liftNondeterminism+  {-# INLINE liftNondeterminism #-}++choose :: Nondeterministic m => [a] -> m a+choose = liftNondeterminism+{-# INLINE choose #-}++runNondeterminism :: Monad m => Eff [] m a -> m [a]+runNondeterminism eff = P.toListM (P.enumerate (translate makeChoice eff))+  where makeChoice choices =+          shiftT (\k ->+                    lift (P.Select (P.for (P.each choices)+                                          (P.enumerate . k))))+{-# INLINE runNondeterminism #-}++-- TODO Non-conflicting names?++mzero :: Nondeterministic m => m a+mzero = choose mempty++mplus :: Nondeterministic m => m a -> m a -> m a+mplus l r = join (choose [l,r])
+ Control/Effect/State.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleContexts #-}++module Control.Effect.State where++import Control.Effect+import Control.Monad.Morph+import Control.Monad.Trans.State.Strict (State, StateT(..))+import qualified Control.Monad.Trans.State.Strict as State++runState :: Monad m+         => Eff (State s) m a -> s -> m (a,s)+runState =+  runStateT . translate (lift . hoist generalize)+{-# INLINE runState #-}++evalState :: Monad m => Eff (State s) m a -> s -> m a+evalState m s = fmap fst (runState m s)+{-# INLINE evalState #-}++execState :: Monad m => Eff (State s) m a -> s -> m s+execState m s = fmap snd (runState m s)+{-# INLINE execState #-}++get :: (Interprets (State state) m) => m state+get = interpret (State.get)+{-# INLINE get #-}++put :: (Interprets (State state) m) => state -> m ()+put x = interpret (State.put x)+{-# INLINE put #-}++modify :: (Interprets (State state) m) => (state -> state) -> m ()+modify f = interpret (State.modify f)+{-# INLINE modify #-}++modify' :: (Interprets (State state) m) => (state -> state) -> m ()+modify' f = interpret (State.modify' f)+{-# INLINE modify' #-}++gets :: (Interprets (State state) m) => (state -> state) -> m state+gets f = interpret (State.gets f)+{-# INLINE gets #-}
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Ollie Charles++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 Ollie Charles 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmark/Bench.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleContexts #-}++import qualified BenchMe+import qualified BenchTransformers+import qualified Criterion+import qualified Criterion.Main as Criterion++main :: IO ()+main =+  Criterion.defaultMain+    [Criterion.bgroup "right1" $+     let numbers = take 10000 (cycle [2,3,5,7])+     in map ($ numbers)+            [Criterion.bench "effect-interpreters" .+             Criterion.whnf BenchMe.right1+            ,Criterion.bench "transformers" .+             Criterion.whnf BenchTransformers.right1]+    ,Criterion.bgroup "right2" $+     let numbers = take 10000 (cycle [2,3,5,7]) ++ [11]+     in map ($numbers)+            [Criterion.bench "effect-interpreters" .+             Criterion.whnf BenchMe.right2+            ,Criterion.bench "transformers" .+             Criterion.whnf BenchTransformers.right2]+    ,Criterion.bgroup "sum-env" $+     [Criterion.bench "effect-interpreters"+                      (Criterion.whnf BenchMe.sumEnv 1000)]+    ,Criterion.bgroup "sum-env-nondet" $+     [Criterion.bench "effect-interpreters"+                      (Criterion.whnf BenchMe.sumEnvNondet 1000)+     ,Criterion.bench "transformers"+                      (Criterion.whnf BenchTransformers.sumEnv 1000)]]
+ transformers-eff.cabal view
@@ -0,0 +1,29 @@+name:                transformers-eff+synopsis:            An approach to managing composable effects, ala mtl/transformers/extensible-effects/Eff+version:             0.1.0.0+homepage:            https://github.com/ocharles/transformers-eff+license:             BSD3+license-file:        LICENSE+author:              Ollie Charles+maintainer:          ollie@ocharles.org.uk+-- copyright:           +category:            Control+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Control.Effect, Control.Effect.Environment, Control.Effect.Nondeterminism, Control.Effect.Exception, Control.Effect.IO, Control.Effect.State, Control.Effect.Identity+  -- other-modules:       +  other-extensions:    TypeOperators, DeriveDataTypeable, DefaultSignatures, DeriveFunctor, StandaloneDeriving, ExistentialQuantification, FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, RankNTypes, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving+  build-depends:       base >=4.8 && <4.9, transformers >=0.4 && <0.5, pipes, free, mmorph+  -- hs-source-dirs:      +  default-language:    Haskell2010+  ghc-options: -Wall++benchmark oleg+  build-depends: base, effect-interpreters, criterion, mtl, pipes, transformers+  hs-source-dirs: benchmark+  main-is: Bench.hs+  type: exitcode-stdio-1.0+  ghc-options: -O2