packages feed

effects (empty) → 0

raw patch · 10 files changed

+213/−0 lines, 10 filesdep +basedep +containersdep +transformerssetup-changed

Dependencies added: base, containers, transformers, void

Files

+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ effects.cabal view
@@ -0,0 +1,36 @@+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.6++Library+  HS-Source-Dirs:      src+  build-depends:       base >= 3 && < 5, +                       containers  >= 0.4 && < 0.5,+                       transformers >= 0.2 && < 0.3,+                       void+  exposed-modules:     +    Control.Effects+    Control.Effects.Cont+    Control.Effects.Either+    Control.Effects.Error+    Control.Effects.Set+    Control.Effects.State+    Control.Effects.Writer+    +source-repository head+  type:     git+  location: git://github.com/sjoerdvisscher/effects.git
+ src/Control/Effects.hs view
@@ -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'
+ src/Control/Effects/Cont.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+module Control.Effects.Cont where++import Control.Effects++shift :: (c ~ ContT r m, AutoLift c n, Monad m) => Proxy c -> ((m a -> m r) -> m r) -> n a+shift p c = operation p $ \k -> c (>>= k)++reset :: Monad m => Handler a m a a+reset = Handler+  { ret = return+  , fin = return+  }
+ src/Control/Effects/Either.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+module Control.Effects.Either where++import Control.Effects+import Data.Void++throwEither :: (c ~ ContT (m (Either e r)) m, AutoLift c n, Monad m) => Proxy c -> e -> n Void+throwEither p e = operation p $ \_ -> return . return $ Left e++catchEither :: Monad m => (e -> m a) -> Handler (m (Either e a)) m a a+catchEither h = Handler+  { ret = return . return . return+  , fin = \m -> m >>= either h return+  }
+ src/Control/Effects/Error.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+module Control.Effects.Error where++import Control.Effects+import Data.Void++throwError :: (c ~ ContT ((e -> m r) -> m r) m, AutoLift c n, Monad m) => Proxy c -> e -> n Void+throwError p e = operation p $ \_ -> return $ \h -> h e++catchError :: Monad m => (e -> m a) -> Handler ((e -> m a) -> m a) m a a+catchError h = Handler+  { ret = return . return . return+  , fin = \f -> f h+  }
+ src/Control/Effects/Set.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+module Control.Effects.Set where++import Control.Effects+import qualified Data.Set as Set++choose :: (c ~ ContT (Set.Set r) m, AutoLift c n, Monad m, Ord r) +       => Proxy c -> [a] -> n a+choose p as = operation p $ \k -> do+  sets <- mapM k as+  return $ Set.unions sets++set :: (Monad m, Ord a) => Handler (Set.Set a) m a (Set.Set a)+set = Handler+  { ret = return . Set.singleton+  , fin = return+  }
+ src/Control/Effects/State.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+module Control.Effects.State where++import Control.Effects++get :: (c ~ ContT (s -> m r) m, AutoLift c n, Monad m) => Proxy c -> n s+get p = operation p $ \k -> return $ \s -> do r <- k s; r s++put :: (c ~ ContT (s -> m r) m, AutoLift c n, Monad m) => Proxy c -> s -> n ()+put p s' = operation p $ \k -> return $ \_ -> do r <- k (); r s'++ref :: Monad m => s -> Handler (s -> m a) m a a+ref s_init = Handler+  { ret = return . return . return+  , fin = \f -> f s_init+  }
+ src/Control/Effects/Writer.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+module Control.Effects.Writer where++import Control.Effects+import Data.Monoid++tell :: (c ~ ContT (w, r) m, AutoLift c n, Monad m, Monoid w) => Proxy c -> w -> n ()+tell p w = operation p $ \k -> do (w', r) <- k (); return (w `mappend` w', r)++writer :: (Monad m, Monoid w) => Handler (w, a) m a (w, a)+writer = Handler+  { ret = \a -> return (mempty, a)+  , fin = return+  }