effects 0.2.2 → 0.2.3

raw patch · 11 files changed

+517/−522 lines, 11 filesdep +newtype-genericsdep −newtypedep ~containerssetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: newtype-generics

Dependencies removed: newtype

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• LICENSE +31/−31
• Setup.lhs +2/−2
• effects.cabal +41/−41
• examples.hs +107/−110
• src/Control/Effects.hs +193/−194
• src/Control/Effects/Cont.hs +12/−12
• src/Control/Effects/Either.hs +13/−13
• src/Control/Effects/Error.hs +13/−13
• src/Control/Effects/NonDet.hs +57/−57
• src/Control/Effects/State.hs +34/−34
• src/Control/Effects/Writer.hs +14/−15

@@ -1,31 +1,31 @@-Copyright Sjoerd Visscher 2011
-
-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 Sjoerd Visscher 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.
-
+Copyright Sjoerd Visscher 2011++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 Sjoerd Visscher 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.+

@@ -1,3 +1,3 @@-#!/usr/bin/env runhaskell
-> import Distribution.Simple
+#!/usr/bin/env runhaskell+> import Distribution.Simple > main = defaultMain

@@ -1,42 +1,42 @@-name:                effects
-version:             0.2.2
-synopsis:            Computational Effects
-
-description:         Control.Effects is a library for programming with effects, like in the the Eff language by 
-                     Andrej Bauer and Matija Pretnar. Effects can be used instead of monad transformers.
-                     .
-                     See the home page for some example code.
-
-category:            Control, Monads
-license:             BSD3
-license-file:        LICENSE
-author:              Sjoerd Visscher
-maintainer:          sjoerd@w3future.com
-stability:           experimental
-homepage:            http://github.com/sjoerdvisscher/effects
-bug-reports:         http://github.com/sjoerdvisscher/effects/issues
-
-build-type:          Simple
-cabal-version:       >= 1.6
-
-Extra-Source-Files:
-  examples.hs
-
-Library
-  HS-Source-Dirs:      src
-  build-depends:       base >= 3 && < 5, 
-                       containers  >= 0.4 && < 0.6,
-                       newtype >= 0.2 && < 0.3,
-                       void
-  exposed-modules:     
-    Control.Effects
-    Control.Effects.Cont
-    Control.Effects.Either
-    Control.Effects.Error
-    Control.Effects.NonDet
-    Control.Effects.State
-    Control.Effects.Writer
-    
-source-repository head
-  type:     git
+name:                effects+version:             0.2.3+synopsis:            Computational Effects++description:         Control.Effects is a library for programming with effects, like in the the Eff language by+                     Andrej Bauer and Matija Pretnar. Effects can be used instead of monad transformers.+                     .+                     See the home page for some example code.++category:            Control, Monads+license:             BSD3+license-file:        LICENSE+author:              Sjoerd Visscher+maintainer:          sjoerd@w3future.com+stability:           experimental+homepage:            http://github.com/sjoerdvisscher/effects+bug-reports:         http://github.com/sjoerdvisscher/effects/issues++build-type:          Simple+cabal-version:       >= 1.6++Extra-Source-Files:+  examples.hs++Library+  HS-Source-Dirs:      src+  build-depends:       base >= 3 && < 5,+                       containers  >= 0.4 && < 0.6,+                       newtype-generics,+                       void+  exposed-modules:+    Control.Effects+    Control.Effects.Cont+    Control.Effects.Either+    Control.Effects.Error+    Control.Effects.NonDet+    Control.Effects.State+    Control.Effects.Writer++source-repository head+  type:     git   location: git://github.com/sjoerdvisscher/effects.git

@@ -1,110 +1,107 @@-module Main where
-
-import Control.Effects
-import Control.Effects.Cont
-import Control.Effects.Either
-import Control.Effects.Error
-import Control.Effects.State
-import Control.Effects.Writer
-import Control.Effects.NonDet
-
-import qualified Data.Set as Set
-import Data.Monoid
-import Control.Applicative
-
-
-testIO :: IO ()
-testIO = runBase $ do
-  base $ putStrLn "What's your name?"
-  name <- base getLine
-  base $ putStrLn $ "Hello, " ++ name
-
-testRefIO :: IO ()
-testRefIO = runBase $ do
-  with (ref 5) $ \x -> do
-    val <- get x
-    base $ print val
-
-testRef :: (Int, Int)
-testRef = run $ do
-  with (ref 5) $ \x -> do
-    with (ref 10) $ \y -> do
-      x =: (+) <$> get x <*> get y
-      y =: (+) <$> get x <*> get y
-      (,) <$> get x <*> get y
-      
-
-testWriter :: (String, (String, Int))
-testWriter = run $ do
-  with writer $ \w1 -> do
-    with writer $ \w2 -> do
-      tell w1 "123"
-      tell w2 "abc"
-      tell w1 "456"
-      tell w2 "def"
-      return 1
-
-
-testSet :: Set.Set Int
-testSet = run $
-  with set $ \s -> do
-    x <- choose s [1, 2]
-    y <- choose s [1, 2]
-    z <- choose s [1, 2]
-    return $ x * x - y * z * x + z * z * z - y * y * x
-
-testAccumulate :: Bool
-testAccumulate = run $
-  with (accumulate Any) $ \s -> do
-    x <- choose s [1, 2]
-    y <- choose s [1, 2]
-    z <- choose s [1, 2]
-    return $ x * x - y * z * x + z * z * z - y * y * x == 0
-
-
-testDfs :: [Int] -> [(Int, Int, Int)]
-testDfs = run . with (dfs return) . triples
-
-testBfs :: [Int] -> [(Int, Int, Int)]
-testBfs = run . with (bfs return) . triples
-
-triples :: (Num a, Monoid e, AutoLift e m n) => [a] -> Effect e m -> n (a, a, a)
-triples range s = do
-  x <- choose s range
-  y <- choose s range
-  z <- choose s range
-  guard s $ x*x + y*y == z*z
-  return (x,y,z)
-
-
-testError :: IO ()
-testError = runBase $ do
-  with (catchError (\e -> base $ putStrLn ("Error: " ++ e))) $ \c -> do
-    base $ putStrLn "before"
-    throwError c "123"
-    base $ putStrLn "after"
-  
-
-testEither :: IO ()
-testEither = runBase $ do
-  with (catchEither (\e -> base $ putStrLn ("Error: " ++ e))) $ \c -> do
-    base $ putStrLn "before"
-    throwEither c "123"
-    base $ putStrLn "after"
-
-
-testReset1 :: Int
-testReset1 = run $ do
-  with reset $ \r -> do
-    x <- shift r (\k -> k (k (k (return 7))))
-    return $ x * 2 + 1
-
-testReset2 :: IO ()
-testReset2 = runBase $ do
-  r <- with reset $ \promptA -> do
-    base $ putStrLn "Batman"
-    with reset $ \promptB -> do
-      shift promptB $ \k -> k (k (shift promptA $ \l -> l (l (return ()))))
-      base $ putStrLn "Robin"
-    base $ putStrLn "Cat woman"
-  base $ print r
+import Control.Effects+import Control.Effects.Cont+import Control.Effects.Either+import Control.Effects.Error+import Control.Effects.State+import Control.Effects.Writer+import Control.Effects.NonDet++import qualified Data.Set as Set+import Data.Monoid+++testIO :: IO ()+testIO = runBase $ do+  base $ putStrLn "What's your name?"+  name <- base getLine+  base $ putStrLn $ "Hello, " ++ name++testRefIO :: IO ()+testRefIO = runBase $ do+  with (ref (5::Int)) $ \x -> do+    val <- get x+    base $ print val++testRef :: (Int, Int)+testRef = run $ do+  with (ref 5) $ \x -> do+    with (ref 10) $ \y -> do+      x =: (+) <$> get x <*> get y+      y =: (+) <$> get x <*> get y+      (,) <$> get x <*> get y+++testWriter :: (String, (String, Int))+testWriter = run $ do+  with writer $ \w1 -> do+    with writer $ \w2 -> do+      tell w1 "123"+      tell w2 "abc"+      tell w1 "456"+      tell w2 "def"+      return 1+++testSet :: Set.Set Int+testSet = run $+  with set $ \s -> do+    x <- choose s [1, 2]+    y <- choose s [1, 2]+    z <- choose s [1, 2]+    return $ x * x - y * z * x + z * z * z - y * y * x++testAccumulate :: Bool+testAccumulate = run $+  with (accumulate Any) $ \s -> do+    x <- choose s [1, 2]+    y <- choose s [1, 2]+    z <- choose s [1, 2]+    return $ x * x - y * z * x + z * z * z - y * y * x == (0::Int)+++testDfs :: [Int] -> [(Int, Int, Int)]+testDfs = run . with (dfs return) . triples++testBfs :: [Int] -> [(Int, Int, Int)]+testBfs = run . with (bfs return) . triples++triples :: (Num a, Eq a, Monoid e, AutoLift e m n) => [a] -> Effect e m -> n (a, a, a)+triples range s = do+  x <- choose s range+  y <- choose s range+  z <- choose s range+  guard s $ x*x + y*y == z*z+  return (x,y,z)+++testError :: IO ()+testError = runBase $ do+  with (catchError (\e -> base $ putStrLn ("Error: " ++ e))) $ \c -> do+    base $ putStrLn "before"+    _ <- throwError c "123"+    base $ putStrLn "after"+++testEither :: IO ()+testEither = runBase $ do+  with (catchEither (\e -> base $ putStrLn ("Error: " ++ e))) $ \c -> do+    base $ putStrLn "before"+    _ <- throwEither c "123"+    base $ putStrLn "after"+++testReset1 :: Int+testReset1 = run $ do+  with reset $ \r -> do+    x <- shift r (\k -> k (k (k (return 7))))+    return $ x * 2 + 1++testReset2 :: IO ()+testReset2 = runBase $ do+  r <- with reset $ \promptA -> do+    base $ putStrLn "Batman"+    with reset $ \promptB -> do+      shift promptB $ \k -> k (k (shift promptA $ \l -> l (l (return ()))))+      base $ putStrLn "Robin"+    base $ putStrLn "Cat woman"+  base $ print r

@@ -1,194 +1,193 @@-{-# LANGUAGE MultiParamTypeClasses, KindSignatures, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
-module Control.Effects (
-
-  -- * Running effects
-  -- $rundoc
-    with
-  , run
-  -- * Defining effects  
-  -- $defdoc
-  , Handler(..)
-  , operation
-  -- * Base monad
-  -- $basedoc
-  , runBase
-  , base
-  -- * Effects machinery
-  -- $macdoc
-  , Layer(..)
-  , Base(..)
-  , Pure(..)
-  , Effect
-  , AutoLift
-  , AutoLiftBase
-
-) where
-
-import Control.Applicative
-import Control.Monad
-import Data.Monoid
-
--- $rundoc
--- Here's an example how to use the state effect from 'Control.Effects.State':
---
--- > example :: Int
--- > example = run $ do
--- >   with (ref 10) $ \u -> do
--- >     val <- get u
--- >     put u (val + 5)
--- >     get u
-
--- | @with@ takes a handler and creates a new effect instance.
---   The @Effect@ is passed on to a function which can use it to do operations with it.
-with :: Monad m => Handler e r m a -> (Effect e m -> Layer e m a) -> m r
-with h f = runLayer (f Effect) (ret h) >>= fin h
-
--- | Unwrap the result of the top-level effect.
-run :: Base Pure a -> a
-run (Base (Pure a)) = a
-
-
--- $defdoc
--- Here's and example how to define the state effect from 'Control.Effects.Writer':
---
--- > writer :: (Monad m, Monoid w) => Handler (w, a) (w, a) m a
--- > writer = Handler
--- >   { ret = \a -> return (mempty, a)
--- >   , fin = return
--- >   }
--- > 
--- > tell :: (AutoLift (w, r) m n, Monoid w) => Effect (w, r) m -> w -> n ()
--- > tell p v = operation p $ \k -> do
--- >   (w, r) <- k ()
--- >   return (mappend v w, r)
-
--- | A @Handler e r m a@ is a handler of effects with type @e@. 
---   The @ret@ field provides a function to lift pure values into the effect.
---   The @fin@ field provides a function to extract a final value of type @r@ from the effect.
---   The parameter @m@ should normally be left polymorphic, it's the monad that handles the other effects.
-data Handler e r m a = Handler
-  { ret :: a -> m e
-  , fin :: e -> m r
-  }
-
--- | @operation@ takes an effect identifier generated by `with` and a function which takes a continuation as parameter.
---   The result is auto-lifted so it can be used inside any other effect.
-operation :: AutoLift e m n => Effect e m -> ((a -> m e) -> m e) -> n a
-operation = operation'
-
-
--- $basedoc
--- The effects are layered on top of a base monad. Here's an example how to use `IO` as a base monad:
--- 
--- > exampleIO :: IO ()
--- > exampleIO = runBase $ do
--- >   with (ref 5) $ \x -> do
--- >     val <- get x
--- >     base $ print val
-
--- | @base@ takes a computation in the base monad and auto-lifts it so it can be used inside any effect.
-base :: AutoLiftBase m n => m a -> n a
-base = base'
-
--- | Unwrap the result of a computation using a base monad.
-runBase :: Base m a -> m a
-runBase (Base m) = m
-
-
--- $macdoc
--- Effects are layered in a stack on top of a base monad. Just like with monad transformers, operations lower in the stack
--- need to be lifted to be able to be used together with operations higher in the stack. But as there are only two  monads
--- in play, `Layer` and `Base`, and because each operation is identified with exactly one layer using the `Effect` type,
--- lifting can be done automatically.
---
--- The following types and classes show up in the type signatures. The compiler should be able to infer them for you.
-
--- | @Layer e m@ is a monad that adds an effect @e@ to the underlying monad @m@.
---   (It is the continuation monad transformer with a friendlier name.)
-newtype Layer e m a = Layer { runLayer :: (a -> m e) -> m e }
-
-instance Functor (Layer e m) where
-  fmap f m = Layer $ \k -> runLayer m (k . f)
-
-instance Applicative (Layer e m) where
-  pure a   = Layer $ \k -> k a
-  m <*> v  = Layer $ \k -> runLayer m (\f -> runLayer v (k . f))
-
-instance (Monoid e, Applicative m) => Alternative (Layer e m) where
-  empty = Layer $ \_ -> pure mempty
-  l <|> r = Layer $ \k -> mappend <$> runLayer l k <*> runLayer r k
-
-instance Monad (Layer e m) where
-  return a = Layer $ \k -> k a
-  m >>= f  = Layer $ \k -> runLayer m (\a -> runLayer (f a) k)
-
-instance (Monoid e, Applicative m) => MonadPlus (Layer e m) where
-  mzero = empty
-  mplus = (<|>)
-
-
--- | @Pure@ is the identity monad and is used when no other base monad is needed.
-newtype Pure a = Pure a
-
-instance Functor Pure where
-  fmap f (Pure a) = Pure (f a)
-
-instance Applicative Pure where
-  pure = Pure
-  Pure f <*> Pure a = Pure (f a)  
-  
-instance Monad Pure where
-  return = Pure
-  Pure a >>= f = f a
-
-
--- | @Base m@ is a newtype wrapper around a monadic computation.
-newtype Base m a = Base (m a)
-
-instance Functor m => Functor (Base m) where
-  fmap f (Base m) = Base (fmap f m)
-
-instance Applicative m => Applicative (Base m) where
-  pure = Base . pure
-  Base m <*> Base v = Base (m <*> v)
-  
-instance Monad m => Monad (Base m) where
-  return = Base . return
-  Base m >>= f = Base $ m >>= runBase . f
-
--- | @Effect e m@ is a proxy for the type checker to be able to work with multiple effects at the same time.
-data Effect e (m :: * -> *) = Effect
-
-
-class (Applicative m, Applicative n, Monad m, Monad n) => AutoLift e m n where
-  operation' :: Effect e m -> ((a -> m e) -> m e) -> n a
-
-instance (Applicative m, Applicative n, Monad m, Monad n, AutoLiftInternal (Layer e m) (Base    n) (Layer e m) (Base    n)) => AutoLift e m (Base    n) where
-  operation' _ f = autolift (Proxy :: Proxy (Layer e m)) (Proxy :: Proxy (Base    n)) (Layer f)
-instance (Applicative m, Applicative n, Monad m, Monad n, AutoLiftInternal (Layer e m) (Layer d n) (Layer e m) (Layer d n)) => AutoLift e m (Layer d n) where
-  operation' _ f = autolift (Proxy :: Proxy (Layer e m)) (Proxy :: Proxy (Layer d n)) (Layer f)
-
-
-class (Applicative m, Applicative n, Monad m, Monad n) => AutoLiftBase m n where
-  base' :: m a -> n a
-
-instance (Applicative m, Applicative n, Monad m, Monad n, AutoLiftInternal (Base    m) (Base    n) (Base    m) (Base    n)) => AutoLiftBase m (Base    n) where
-  base' m        = autolift (Proxy :: Proxy (Base    m)) (Proxy :: Proxy (Base    n)) (Base m)
-instance (Applicative m, Applicative n, Monad m, Monad n, AutoLiftInternal (Base    m) (Layer e n) (Base    m) (Layer e n)) => AutoLiftBase m (Layer e n) where
-  base' m        = autolift (Proxy :: Proxy (Base    m)) (Proxy :: Proxy (Layer e n)) (Base m)
-
-
-data Proxy (m :: * -> *) = Proxy
-
-class (Applicative m1, Applicative m2, Monad m1, Monad m2) =>  AutoLiftInternal m1 m2 n1 n2 where
-  autolift :: Proxy n1 -> Proxy n2 -> m1 a -> m2 a
-
-pre :: Proxy (Layer r m) -> Proxy m
-pre Proxy = Proxy
-
-instance (Applicative m, Monad m)              => AutoLiftInternal m           m   (Base    n)  (Base    n)  where
-  autolift Proxy Proxy = id
-instance (AutoLiftInternal m1 m2 (Base n1) n2) => AutoLiftInternal m1 (Layer r m2) (Base    n1) (Layer s n2) where
-  autolift p1 p2 = Layer . (>>=) . autolift p1 (pre p2)
-instance (AutoLiftInternal m1 m2       n1  n2) => AutoLiftInternal m1          m2  (Layer r n1) (Layer s n2) where
-  autolift p1 p2 = autolift (pre p1) (pre p2)
+{-# LANGUAGE MultiParamTypeClasses, KindSignatures, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+module Control.Effects (++  -- * Running effects+  -- $rundoc+    with+  , run+  -- * Defining effects+  -- $defdoc+  , Handler(..)+  , operation+  -- * Base monad+  -- $basedoc+  , runBase+  , base+  -- * Effects machinery+  -- $macdoc+  , Layer(..)+  , Base(..)+  , Pure(..)+  , Effect+  , AutoLift+  , AutoLiftBase++) where++import Control.Applicative+import Control.Monad++-- $rundoc+-- Here's an example how to use the state effect from 'Control.Effects.State':+--+-- > example :: Int+-- > example = run $ do+-- >   with (ref 10) $ \u -> do+-- >     val <- get u+-- >     put u (val + 5)+-- >     get u++-- | @with@ takes a handler and creates a new effect instance.+--   The @Effect@ is passed on to a function which can use it to do operations with it.+with :: Monad m => Handler e r m a -> (Effect e m -> Layer e m a) -> m r+with h f = runLayer (f Effect) (ret h) >>= fin h++-- | Unwrap the result of the top-level effect.+run :: Base Pure a -> a+run (Base (Pure a)) = a+++-- $defdoc+-- Here's and example how to define the state effect from 'Control.Effects.Writer':+--+-- > writer :: (Monad m, Monoid w) => Handler (w, a) (w, a) m a+-- > writer = Handler+-- >   { ret = \a -> return (mempty, a)+-- >   , fin = return+-- >   }+-- >+-- > tell :: (AutoLift (w, r) m n, Monoid w) => Effect (w, r) m -> w -> n ()+-- > tell p v = operation p $ \k -> do+-- >   (w, r) <- k ()+-- >   return (mappend v w, r)++-- | A @Handler e r m a@ is a handler of effects with type @e@.+--   The @ret@ field provides a function to lift pure values into the effect.+--   The @fin@ field provides a function to extract a final value of type @r@ from the effect.+--   The parameter @m@ should normally be left polymorphic, it's the monad that handles the other effects.+data Handler e r m a = Handler+  { ret :: a -> m e+  , fin :: e -> m r+  }++-- | @operation@ takes an effect identifier generated by `with` and a function which takes a continuation as parameter.+--   The result is auto-lifted so it can be used inside any other effect.+operation :: AutoLift e m n => Effect e m -> ((a -> m e) -> m e) -> n a+operation = operation'+++-- $basedoc+-- The effects are layered on top of a base monad. Here's an example how to use `IO` as a base monad:+--+-- > exampleIO :: IO ()+-- > exampleIO = runBase $ do+-- >   with (ref 5) $ \x -> do+-- >     val <- get x+-- >     base $ print val++-- | @base@ takes a computation in the base monad and auto-lifts it so it can be used inside any effect.+base :: AutoLiftBase m n => m a -> n a+base = base'++-- | Unwrap the result of a computation using a base monad.+runBase :: Base m a -> m a+runBase (Base m) = m+++-- $macdoc+-- Effects are layered in a stack on top of a base monad. Just like with monad transformers, operations lower in the stack+-- need to be lifted to be able to be used together with operations higher in the stack. But as there are only two  monads+-- in play, `Layer` and `Base`, and because each operation is identified with exactly one layer using the `Effect` type,+-- lifting can be done automatically.+--+-- The following types and classes show up in the type signatures. The compiler should be able to infer them for you.++-- | @Layer e m@ is a monad that adds an effect @e@ to the underlying monad @m@.+--   (It is the continuation monad transformer with a friendlier name.)+newtype Layer e m a = Layer { runLayer :: (a -> m e) -> m e }++instance Functor (Layer e m) where+  fmap f m = Layer $ \k -> runLayer m (k . f)++instance Applicative (Layer e m) where+  pure a   = Layer $ \k -> k a+  m <*> v  = Layer $ \k -> runLayer m (\f -> runLayer v (k . f))++instance (Monoid e, Applicative m) => Alternative (Layer e m) where+  empty = Layer $ \_ -> pure mempty+  l <|> r = Layer $ \k -> mappend <$> runLayer l k <*> runLayer r k++instance Monad (Layer e m) where+  return a = Layer $ \k -> k a+  m >>= f  = Layer $ \k -> runLayer m (\a -> runLayer (f a) k)++instance (Monoid e, Applicative m) => MonadPlus (Layer e m) where+  mzero = empty+  mplus = (<|>)+++-- | @Pure@ is the identity monad and is used when no other base monad is needed.+newtype Pure a = Pure a++instance Functor Pure where+  fmap f (Pure a) = Pure (f a)++instance Applicative Pure where+  pure = Pure+  Pure f <*> Pure a = Pure (f a)++instance Monad Pure where+  return = Pure+  Pure a >>= f = f a+++-- | @Base m@ is a newtype wrapper around a monadic computation.+newtype Base m a = Base (m a)++instance Functor m => Functor (Base m) where+  fmap f (Base m) = Base (fmap f m)++instance Applicative m => Applicative (Base m) where+  pure = Base . pure+  Base m <*> Base v = Base (m <*> v)++instance Monad m => Monad (Base m) where+  return = Base . return+  Base m >>= f = Base $ m >>= runBase . f++-- | @Effect e m@ is a proxy for the type checker to be able to work with multiple effects at the same time.+data Effect e (m :: * -> *) = Effect+++class (Applicative m, Applicative n, Monad m, Monad n) => AutoLift e m n where+  operation' :: Effect e m -> ((a -> m e) -> m e) -> n a++instance (Applicative m, Applicative n, Monad m, Monad n, AutoLiftInternal (Layer e m) (Base    n) (Layer e m) (Base    n)) => AutoLift e m (Base    n) where+  operation' _ f = autolift (Proxy :: Proxy (Layer e m)) (Proxy :: Proxy (Base    n)) (Layer f)+instance (Applicative m,                Monad m,          AutoLiftInternal (Layer e m) (Layer d n) (Layer e m) (Layer d n)) => AutoLift e m (Layer d n) where+  operation' _ f = autolift (Proxy :: Proxy (Layer e m)) (Proxy :: Proxy (Layer d n)) (Layer f)+++class (Applicative m, Applicative n, Monad m, Monad n) => AutoLiftBase m n where+  base' :: m a -> n a++instance (Applicative m, Applicative n, Monad m, Monad n, AutoLiftInternal (Base    m) (Base    n) (Base    m) (Base    n)) => AutoLiftBase m (Base    n) where+  base' m        = autolift (Proxy :: Proxy (Base    m)) (Proxy :: Proxy (Base    n)) (Base m)+instance (Applicative m,                Monad m,          AutoLiftInternal (Base    m) (Layer e n) (Base    m) (Layer e n)) => AutoLiftBase m (Layer e n) where+  base' m        = autolift (Proxy :: Proxy (Base    m)) (Proxy :: Proxy (Layer e n)) (Base m)+++data Proxy (m :: * -> *) = Proxy++class (Applicative m1, Applicative m2, Monad m1, Monad m2) =>  AutoLiftInternal m1 m2 n1 n2 where+  autolift :: Proxy n1 -> Proxy n2 -> m1 a -> m2 a++pre :: Proxy (Layer r m) -> Proxy m+pre Proxy = Proxy++instance (Applicative m, Monad m)              => AutoLiftInternal m           m   (Base    n)  (Base    n)  where+  autolift Proxy Proxy = id+instance (AutoLiftInternal m1 m2 (Base n1) n2) => AutoLiftInternal m1 (Layer r m2) (Base    n1) (Layer s n2) where+  autolift p1 p2 = Layer . (>>=) . autolift p1 (pre p2)+instance (AutoLiftInternal m1 m2       n1  n2) => AutoLiftInternal m1          m2  (Layer r n1) (Layer s n2) where+  autolift p1 p2 = autolift (pre p1) (pre p2)

@@ -1,13 +1,13 @@-{-# LANGUAGE FlexibleContexts #-}
-module Control.Effects.Cont where
-
-import Control.Effects
-
-shift :: AutoLift r m n => Effect r m -> ((m a -> m r) -> m r) -> n a
-shift p c = operation p $ \k -> c (>>= k)
-
-reset :: Monad m => Handler a a m a
-reset = Handler
-  { ret = return
-  , fin = return
+{-# LANGUAGE FlexibleContexts #-}+module Control.Effects.Cont where++import Control.Effects++shift :: AutoLift r m n => Effect r m -> ((m a -> m r) -> m r) -> n a+shift p c = operation p $ \k -> c (>>= k)++reset :: Monad m => Handler a a m a+reset = Handler+  { ret = return+  , fin = return   }

@@ -1,14 +1,14 @@-{-# LANGUAGE FlexibleContexts #-}
-module Control.Effects.Either where
-
-import Control.Effects
-import Data.Void
-
-throwEither :: AutoLift (Either e r) m n => Effect (Either e r) m -> e -> n Void
-throwEither p e = operation p $ \_ -> return $ Left e
-
-catchEither :: Monad m => (e -> m a) -> Handler (Either e a) a m a
-catchEither h = Handler
-  { ret = return . return
-  , fin = either h return
+{-# LANGUAGE FlexibleContexts #-}+module Control.Effects.Either where++import Control.Effects+import Data.Void++throwEither :: AutoLift (Either e r) m n => Effect (Either e r) m -> e -> n Void+throwEither p e = operation p $ \_ -> return $ Left e++catchEither :: Monad m => (e -> m a) -> Handler (Either e a) a m a+catchEither h = Handler+  { ret = return . return+  , fin = either h return   }

@@ -1,14 +1,14 @@-{-# LANGUAGE FlexibleContexts #-}
-module Control.Effects.Error where
-
-import Control.Effects
-import Data.Void
-
-throwError :: AutoLift ((e -> m r) -> m r) m n => Effect ((e -> m r) -> m r) m -> e -> n Void
-throwError p e = operation p $ \_ -> return $ \h -> h e
-
-catchError :: Monad m => (e -> m a) -> Handler ((e -> m a) -> m a) a m a
-catchError h = Handler
-  { ret = return . return . return
-  , fin = \f -> f h
+{-# LANGUAGE FlexibleContexts #-}+module Control.Effects.Error where++import Control.Effects+import Data.Void++throwError :: AutoLift ((e -> m r) -> m r) m n => Effect ((e -> m r) -> m r) m -> e -> n Void+throwError p e = operation p $ \_ -> return $ \h -> h e++catchError :: Monad m => (e -> m a) -> Handler ((e -> m a) -> m a) a m a+catchError h = Handler+  { ret = return . return . return+  , fin = \f -> f h   }

@@ -1,58 +1,58 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
-module Control.Effects.NonDet (choose, guard, dfs, set, alternatives, accumulate, bfs) where
-
-import Control.Effects
-import qualified Data.Set as Set
-import Prelude hiding (foldr)
-import Data.Foldable
-import Data.Monoid
-import Control.Applicative
-import Control.Newtype
-
-instance (Applicative m, Monoid r) => Monoid (WrappedMonad m r) where
-  mempty                              = WrapMonad $ pure mempty
-  mappend (WrapMonad a) (WrapMonad b) = WrapMonad $ liftA2 mappend a b
-
-newtype WrappedAlt f a = WrapAlt (f a)
-instance Newtype (WrappedAlt m a) (m a) where
-  pack = WrapAlt
-  unpack (WrapAlt a) = a
-instance Alternative f => Monoid (WrappedAlt f a) where
-  mempty                          = WrapAlt empty
-  mappend (WrapAlt a) (WrapAlt b) = WrapAlt $ a <|> b
-
-choose :: (AutoLift r m n, Monoid r, Foldable f) => Effect r m -> f a -> n a
-choose p as = operation p $ \k -> ala' WrapMonad foldMap k as
-
-guard :: (Monoid r, AutoLift r m n) => Effect r m -> Bool -> n ()
-guard _ True = return ()
-guard p False = choose p []
-
-dfs :: (Monad m, Monoid r) => (a -> r) -> Handler r r m a
-dfs f = Handler
-  { ret = return . f
-  , fin = return
-  }
-
-set :: (Monad m, Ord a) => Handler (Set.Set a) (Set.Set a) m a
-set = dfs Set.singleton
-
-alternatives :: (Monad m, Alternative f) => Handler (WrappedAlt f a) (f a) m a
-alternatives = accumulate (WrapAlt . pure)
-
-accumulate :: (Monad m, Newtype n o) => (a -> n) -> Handler n o m a
-accumulate f = Handler
-  { ret = return . f
-  , fin = return . unpack
-  }
-
-newtype BFS r = BFS (Int -> Maybe r)
-instance Monoid r => Monoid (BFS r) where
-  mempty                = BFS $ \d -> if d == 0 then Just mempty else Nothing
-  BFS f `mappend` BFS g = BFS $ \d -> if d == 0 then f d else f d `mappend` g (d - 1)
-instance Monoid r => Newtype (BFS r) r where
-  pack r                = BFS $ \d -> if d == 0 then Just r else Nothing
-  unpack (BFS f)        = loop 0 where loop d = maybe mempty (`mappend` loop (d + 1)) (f d)
-
-bfs :: (Monad m, Monoid r) => (a -> r) -> Handler (BFS r) r m a
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, TypeFamilies #-}+module Control.Effects.NonDet (choose, guard, dfs, set, alternatives, accumulate, bfs) where++import Control.Effects+import qualified Data.Set as Set+import Prelude hiding (foldr)+import Control.Applicative+import Control.Newtype++instance (Applicative m, Monoid r) => Monoid (WrappedMonad m r) where+  mempty                              = WrapMonad $ pure mempty+  mappend (WrapMonad a) (WrapMonad b) = WrapMonad $ liftA2 mappend a b++newtype WrappedAlt f a = WrapAlt (f a)+instance Newtype (WrappedAlt m a) where+  type O (WrappedAlt m a) = m a+  pack = WrapAlt+  unpack (WrapAlt a) = a+instance Alternative f => Monoid (WrappedAlt f a) where+  mempty                          = WrapAlt empty+  mappend (WrapAlt a) (WrapAlt b) = WrapAlt $ a <|> b++choose :: (AutoLift r m n, Monoid r, Foldable f) => Effect r m -> f a -> n a+choose p as = operation p $ \k -> ala' WrapMonad foldMap k as++guard :: (Monoid r, AutoLift r m n) => Effect r m -> Bool -> n ()+guard _ True = return ()+guard p False = choose p []++dfs :: Monad m => (a -> r) -> Handler r r m a+dfs f = Handler+  { ret = return . f+  , fin = return+  }++set :: Monad m => Handler (Set.Set a) (Set.Set a) m a+set = dfs Set.singleton++alternatives :: (Monad m, Alternative f) => Handler (WrappedAlt f a) (f a) m a+alternatives = accumulate (WrapAlt . pure)++accumulate :: (Monad m, Newtype n) => (a -> n) -> Handler n (O n) m a+accumulate f = Handler+  { ret = return . f+  , fin = return . unpack+  }++newtype BFS r = BFS (Int -> Maybe r)+instance Monoid r => Monoid (BFS r) where+  mempty                = BFS $ \d -> if d == 0 then Just mempty else Nothing+  BFS f `mappend` BFS g = BFS $ \d -> if d == 0 then f d else f d `mappend` g (d - 1)+instance Monoid r => Newtype (BFS r) where+  type O (BFS r) = r+  pack r                = BFS $ \d -> if d == 0 then Just r else Nothing+  unpack (BFS f)        = loop 0 where loop d = maybe mempty (`mappend` loop (d + 1)) (f d)++bfs :: (Monad m, Monoid r) => (a -> r) -> Handler (BFS r) r m a bfs f = accumulate (pack . f)

@@ -1,35 +1,35 @@-{-# LANGUAGE FlexibleContexts #-}
-module Control.Effects.State where
-
-import Control.Effects
-
-type State s m a = s -> m a
-
-get :: AutoLift (State s m a) m n => Effect (State s m a) m -> n s
-get p = operation p $ \k -> return $ \s -> do r <- k s; r s
-
-put :: AutoLift (State s m a) m n => Effect (State s m a) m -> s -> n ()
-put p s = operation p $ \k -> return $ \_ -> do r <- k (); r s
-
-infixr 3 =:
-(=:) :: AutoLift (State s m a) m n => Effect (State s m a) m -> n s -> n ()
-p =: m = m >>= put p
-
-modify :: AutoLift (State s m a) m n => Effect (State s m a) m -> (s -> s) -> n ()
-modify p f = do
-  v <- get p
-  put p (f v)
-
-local :: AutoLift (State s m a) m n => Effect (State s m a) m -> (s -> s) -> n b -> n b
-local p f m = do
-  v <- get p
-  put p (f v)
-  r <- m
-  put p v
-  return r
-
-ref :: Monad m => s -> Handler (State s m a) a m a
-ref s_init = Handler
-  { ret = return . return . return
-  , fin = \f -> f s_init
+{-# LANGUAGE FlexibleContexts #-}+module Control.Effects.State where++import Control.Effects++type State s m a = s -> m a++get :: AutoLift (State s m a) m n => Effect (State s m a) m -> n s+get p = operation p $ \k -> return $ \s -> do r <- k s; r s++put :: AutoLift (State s m a) m n => Effect (State s m a) m -> s -> n ()+put p s = operation p $ \k -> return $ \_ -> do r <- k (); r s++infixr 3 =:+(=:) :: AutoLift (State s m a) m n => Effect (State s m a) m -> n s -> n ()+p =: m = m >>= put p++modify :: AutoLift (State s m a) m n => Effect (State s m a) m -> (s -> s) -> n ()+modify p f = do+  v <- get p+  put p (f v)++local :: AutoLift (State s m a) m n => Effect (State s m a) m -> (s -> s) -> n b -> n b+local p f m = do+  v <- get p+  put p (f v)+  r <- m+  put p v+  return r++ref :: Monad m => s -> Handler (State s m a) a m a+ref s_init = Handler+  { ret = return . return . return+  , fin = \f -> f s_init   }

@@ -1,16 +1,15 @@-{-# LANGUAGE FlexibleContexts #-}
-module Control.Effects.Writer where
-
-import Control.Effects
-import Data.Monoid
-
-tell :: (AutoLift (w, r) m n, Monoid w) => Effect (w, r) m -> w -> n ()
-tell p v = operation p $ \k -> do
-  ~(w, r) <- k ()
-  return (mappend v w, r)
-
-writer :: (Monad m, Monoid w) => Handler (w, a) (w, a) m a
-writer = Handler
-  { ret = \a -> return (mempty, a)
-  , fin = return
+{-# LANGUAGE FlexibleContexts #-}+module Control.Effects.Writer where++import Control.Effects++tell :: (AutoLift (w, r) m n, Monoid w) => Effect (w, r) m -> w -> n ()+tell p v = operation p $ \k -> do+  ~(w, r) <- k ()+  return (mappend v w, r)++writer :: (Monad m, Monoid w) => Handler (w, a) (w, a) m a+writer = Handler+  { ret = \a -> return (mempty, a)+  , fin = return   }