Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

First commit

  • Loading branch information...
commit 8627a0f61ee598053b6566325ecda6e4b956d4be 0 parents
@sjoerdvisscher authored
1  .gitignore
@@ -0,0 +1 @@
+dist
31 LICENSE
@@ -0,0 +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.
+
1  README
@@ -0,0 +1 @@
+This is a library based on the Eff language by Andrej Bauer and Matija Pretnar.
28 effects.cabal
@@ -0,0 +1,28 @@
+name: effects
+version: 0
+synopsis: Computational Effects
+
+description: An alternative to Monad Transformers.
+
+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.10
+
+Library
+ HS-Source-Dirs: src
+ build-depends: base >= 3 && < 5, transformers >= 0.2 && < 0.3
+ default-language: Haskell2010
+ exposed-modules:
+ Control.Effects
+
+source-repository head
+ type: git
+ location: git://github.com/sjoerdvisscher/effects.git
56 src/Control/Effects.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+module Control.Effects (Handler(..), with, operation, run, runIO, io, ioHandler, Cont, ContT, Proxy, AutoLift) where
+
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Cont
+import Data.Functor.Identity
+
+data Handler e m a r = Handler
+ { ret :: a -> m e
+ , fin :: e -> m r
+ }
+
+with :: Monad m => Handler e m a r -> (Proxy (ContT e m) -> ContT e m a) -> m r
+with h f = runContT (f Proxy) (ret h) >>= fin h
+
+operation :: forall m m' n a r. (m ~ ContT r m', AutoLift m n) => Proxy m -> ((a -> m' r) -> m' r) -> n a
+operation p f = autolift p (Proxy :: Proxy n) (ContT f)
+
+run :: Cont a a -> a
+run m = runCont m id
+
+
+ioHandler :: Handler a IO a a
+ioHandler = Handler return return
+
+runIO :: ContT () IO () -> IO ()
+runIO m = with ioHandler (const m)
+
+io :: AutoLift (ContT () IO) n => IO a -> n a
+io m = operation (Proxy :: Proxy (ContT () IO)) (m >>=)
+
+
+data Proxy (m :: * -> *) = Proxy
+
+class AutoLift' m1 m2 n1 n2 where
+ autolift' :: Proxy n1 -> Proxy n2 -> m1 a -> m2 a
+
+instance (m1 ~ m2) => AutoLift' m1 m2 IO IO where
+ autolift' Proxy Proxy = id
+instance (m1 ~ m2) => AutoLift' m1 m2 Identity Identity where
+ autolift' Proxy Proxy = id
+
+pre :: Proxy (ContT r m) -> Proxy m
+pre Proxy = Proxy
+instance (AutoLift' m1 m2 IO n, Monad m2) => AutoLift' m1 (ContT r m2) IO (ContT s n) where
+ autolift' p1 p2 = lift . autolift' p1 (pre p2)
+instance (AutoLift' m1 m2 Identity n, Monad m2) => AutoLift' m1 (ContT r m2) Identity (ContT s n) where
+ autolift' p1 p2 = lift . autolift' p1 (pre p2)
+
+instance (AutoLift' m1 m2 n1 n2) => AutoLift' m1 m2 (ContT r1 n1) (ContT r2 n2) where
+ autolift' p1 p2 = autolift' (pre p1) (pre p2)
+
+class AutoLift m1 m2 where
+ autolift :: Proxy m1 -> Proxy m2 -> m1 a -> m2 a
+instance AutoLift' m1 m2 m1 m2 => AutoLift m1 m2 where
+ autolift = autolift'
Please sign in to comment.
Something went wrong with that request. Please try again.