effects 0.1 → 0.2

raw patch · 9 files changed

+229/−87 lines, 9 filesdep +newtypedep −transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: newtype

Dependencies removed: transformers

API changes (from Hackage documentation)

Files

• effects.cabal +7/−4
• src/Control/Effects.hs +132/−52
• src/Control/Effects/Cont.hs +2/−2
• src/Control/Effects/Either.hs +2/−2
• src/Control/Effects/Error.hs +2/−2
• src/Control/Effects/NonDet.hs +55/−0
• src/Control/Effects/Set.hs +0/−17
• src/Control/Effects/State.hs +24/−5
• src/Control/Effects/Writer.hs +5/−3

@@ -1,8 +1,11 @@ name:                effects-version:             0.1+version:             0.2 synopsis:            Computational Effects -description:         An alternative to Monad Transformers.+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@@ -20,14 +23,14 @@   HS-Source-Dirs:      src   build-depends:       base >= 3 && < 5,                         containers  >= 0.4 && < 0.5,-                       transformers >= 0.2 && < 0.3,+                       newtype >= 0.2 && < 0.3,                        void   exposed-modules:          Control.Effects     Control.Effects.Cont     Control.Effects.Either     Control.Effects.Error-    Control.Effects.Set+    Control.Effects.NonDet     Control.Effects.State     Control.Effects.Writer     

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses, KindSignatures, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} module Control.Effects (    -- * Running effects@@ -9,19 +9,22 @@   -- $defdoc   , Handler(..)   , operation-  -- * I/O-  , runIO-  , io+  -- * Base monad+  -- $basedoc+  , runBase+  , base   -- * Effects machinery-  , ContT-  , Proxy+  -- $macdoc+  , Layer+  , Base+  , Pure+  , Effect   , AutoLift+  , AutoLiftBase  ) where -import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Cont-import Data.Functor.Identity+import Control.Applicative  -- $rundoc -- Here's an example how to use the state effect from 'Control.Effects.State'.@@ -33,28 +36,30 @@ -- >     put u (val + 5) -- >     get u --- | @with@ takes a handler and creates a new @Proxy@ (effect identifier).---   The @Proxy@ is passed on to a function which can use it to do operations with it.-with :: Monad m => Handler e r m a -> (Proxy (ContT e m) -> ContT e m a) -> m r-with h f = runContT (f Proxy) (ret h) >>= fin h+-- | @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 :: Identity a -> a-run = runIdentity+run :: Base Pure a -> a+run (Base (Pure a)) = a   -- $defdoc--- Here's and example how to define the state effect from 'Control.Effects.State'.+-- Here's and example how to define the state effect from 'Control.Effects.Writer'. ----- > ref :: Monad m => s -> Handler (s -> m a) a m a--- > ref s_init = Handler--- >   { ret = return . return . return--- >   , fin = \f -> f s_init+-- > writer :: (Monad m, Monoid w) => Handler (w, a) (w, a) m a+-- > writer = Handler+-- >   { ret = \a -> return (mempty, a)+-- >   , fin = return -- >   }--- >--- > get p   = operation p $ \k -> return $ \s -> do r <- k s; r s--- > put p s = operation p $ \k -> return $ \_ -> do r <- k (); r s- +-- > +-- > 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.@@ -64,41 +69,116 @@   , fin :: e -> m r   } --- | Define an operation, which is autolifted so it can be used inside other effects.-operation :: forall c m n a e. (c ~ ContT e m, AutoLift c n) => Proxy c -> ((a -> m e) -> m e) -> n a-operation p f = autolift p (Proxy :: Proxy n) (ContT f)+-- | @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'  --- | Variant of 'run' that allows I/O effects. (Just the identity function, but it helps the type checker.)-runIO :: IO () -> IO ()-runIO = id+-- $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 --- | Convert an 'IO' action to an I/O effect operation.-io :: AutoLift IO n => IO a -> n a-io m = autolift (Proxy :: Proxy IO) (Proxy :: Proxy n) m+-- | @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 -data Proxy (m :: * -> *) = Proxy -class AutoLift' m1 m2 n1 n2 where-  autolift' :: Proxy n1 -> Proxy n2 -> m1 a -> m2 a+-- $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. -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+-- | @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 } -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 Functor (Layer r m) where+  fmap f m = Layer $ \k -> runLayer m (k . f) -instance (AutoLift' m1 m2 n1 n2) => AutoLift' m1 m2 (ContT r1 n1) (ContT r2 n2) where-  autolift' p1 p2 = autolift' (pre p1) (pre p2)+instance Applicative (Layer r m) where+  pure a   = Layer $ \k -> k a+  m <*> v  = Layer $ \k -> runLayer m (\f -> runLayer v (k . f)) -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'+instance Monad (Layer e m) where+  return a = Layer $ \k -> k a+  m >>= f  = Layer $ \k -> runLayer m (\a -> runLayer (f a) k)+++-- | @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 (Monad m, Monad n) => AutoLift e m n where+  operation' :: Effect e m -> ((a -> m e) -> m e) -> n a++instance (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 (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 (Monad m, Monad n) => AutoLiftBase m n where+  base' :: m a -> n a++instance (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 (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 (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 (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,9 +1,9 @@-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE 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 :: 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

@@ -1,10 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-} module Control.Effects.Either where  import Control.Effects import Data.Void -throwEither :: (c ~ ContT (Either e r) m, AutoLift c n, Monad m) => Proxy c -> e -> n 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

@@ -1,10 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE 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 :: 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

@@ -0,0 +1,55 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}+module Control.Effects.NonDet (choose, 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.Monad+import Control.Newtype++instance (Monad m, Monoid r) => Monoid (WrappedMonad m r) where+  mempty                              = WrapMonad $ return mempty+  mappend (WrapMonad a) (WrapMonad b) = WrapMonad $ liftM2 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++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 { unBFS :: 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+bfs f = accumulate (pack . f)

@@ -1,17 +0,0 @@-{-# 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) (Set.Set a) m a-set = Handler-  { ret = return . Set.singleton-  , fin = return-  }

@@ -1,15 +1,34 @@-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE 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+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 :: (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'+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 -ref :: Monad m => s -> Handler (s -> m a) a m a+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,11 +1,13 @@-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE 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)+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