simple-effects 0.4.0.0 → 0.4.0.1

raw patch · 6 files changed

+96/−62 lines, 6 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• LICENSE +29/−29
• Setup.hs +2/−2
• simple-effects.cabal +2/−1
• src/Control/Effects/Early.hs +29/−0
• src/Control/Effects/List.hs +18/−22
• src/Control/Effects/State.hs +16/−8

@@ -1,30 +1,30 @@-Copyright Author name here (c) 2016
-
-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 Author name here 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
+Copyright Author name here (c) 2016++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 Author name here 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,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain

@@ -1,5 +1,5 @@ name:                simple-effects
-version:             0.4.0.0
+version:             0.4.0.1
 synopsis:            A simple effect system that integrates with MTL
 description:         Please see README.md
 homepage:            https://gitlab.com/LukaHorvat/simple-effects
@@ -19,6 +19,7 @@                      , Control.Effects.Reader
                      , Control.Effects.List
                      , Control.Effects.Signal
+                     , Control.Effects.Early
   hs-source-dirs:      src
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5

@@ -0,0 +1,29 @@+{-# LANGUAGE RankNTypes, TypeFamilies, FlexibleContexts, ScopedTypeVariables, MultiParamTypeClasses #-}
+module Control.Effects.Early (module Control.Effects, Early, earlyReturn, handleEarly) where
+
+import Interlude
+import Prelude (Show(..))
+import Control.Monad.Trans.Except
+
+import Control.Effects
+
+data Early a
+type instance EffectMsg (Early a) = a
+type instance EffectRes (Early a) = Void
+
+instance Monad m => MonadEffect (Early a) (ExceptT a m) where
+    effect _ = throwE
+
+-- | Allows you to return early from a function. Make sure you 'handleEarly' to get the actual
+--   result out
+earlyReturn :: forall a b m. MonadEffect (Early a) m => a -> m b
+earlyReturn = fmap absurd . effect (Proxy :: Proxy (Early a))
+
+collapseEither :: Either a a -> a
+collapseEither (Left a) = a
+collapseEither (Right a) = a
+
+-- | Get the result from a computation. Either the early returned one, or the regular result.
+handleEarly :: Monad m => ExceptT a m a -> m a
+handleEarly = fmap collapseEither
+            . runExceptT

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, FlexibleContexts, MultiParamTypeClasses #-}
 module Control.Effects.List
     ( module Control.Effects.List
     , module ListT ) where
@@ -15,6 +15,9 @@ type instance EffectRes1 NonDeterministic = Identity
 type instance EffectCon1 NonDeterministic a = ()
 
+instance Monad m => MonadEffect1 NonDeterministic (ListT m) where
+    effect1 _ = fmap Identity . fromFoldable
+
 -- | Runs the rest of the computation for every value in the list
 choose :: MonadEffect1 NonDeterministic m => [a] -> m a
 choose = fmap runIdentity . effect1 (Proxy :: Proxy NonDeterministic)
@@ -23,37 +26,30 @@ deadEnd :: MonadEffect1 NonDeterministic m => m a
 deadEnd = choose []
 
--- | A generic handler for the NonDeterministic effect. Takes a handler for the ListT transformer
---   as a param.
-handleList :: Monad m => (ListT m a -> m b) -> EffectHandler1 NonDeterministic (ListT m) a -> m b
-handleList f = f . handleEffect1 (fmap Identity . fromFoldable)
-
 -- | Execute all the effects and collect the result in a list.
 --   Note that this forces all the results, no matter which elements of the result list you end
 --   up actually using. For lazyer behavior use the other handlers.
-evaluateToList :: Monad m => EffectHandler1 NonDeterministic (ListT m) a -> m [a]
-evaluateToList = handleList toList
+evaluateToList :: Monad m => ListT m a -> m [a]
+evaluateToList = toList
 
 -- | Given a function, apply it to all the results.
-traverseAllResults :: Monad m => (a -> m ()) -> EffectHandler1 NonDeterministic (ListT m) a -> m ()
-traverseAllResults handler = handleList (traverse_ handler)
+traverseAllResults :: Monad m => (a -> m ()) -> ListT m a -> m ()
+traverseAllResults = traverse_
 
 -- | Given a folding function, fold over every result. If you want to terminate eary, use the
---   `foldWithEarlyTermination` instead.
-foldAllResults :: Monad m => (r -> a -> m r) -> r
-               -> EffectHandler1 NonDeterministic (ListT m) a -> m r
-foldAllResults f i = handleList (fold f i)
+--   'foldWithEarlyTermination' instead.
+foldAllResults :: Monad m => (r -> a -> m r) -> r -> ListT m a -> m r
+foldAllResults = fold
 
--- | Same as `foldAllResults` but the folding function has the ability to terminate eary by
+-- | Same as 'foldAllResults' but the folding function has the ability to terminate eary by
 --   returning Nothing.
-foldWithEarlyTermination :: Monad m => (r -> a -> m (Maybe r)) -> r
-                                    -> EffectHandler1 NonDeterministic (ListT m) a -> m r
-foldWithEarlyTermination f i = handleList (foldMaybe f i)
+foldWithEarlyTermination :: Monad m => (r -> a -> m (Maybe r)) -> r -> ListT m a -> m r
+foldWithEarlyTermination = foldMaybe
 
 -- | Executes only the effects needed to produce the first n results.
-evaluateNResults :: Monad m => Int -> EffectHandler1 NonDeterministic (ListT m) a -> m [a]
-evaluateNResults n = handleList (fmap fst . splitAt n)
+evaluateNResults :: Monad m => Int -> ListT m a -> m [a]
+evaluateNResults n = fmap fst . splitAt n
 
 -- | Executes only the effects needed to produce a single result.
-evaluateOneResult :: Monad m => EffectHandler1 NonDeterministic (ListT m) a -> m (Maybe a)
-evaluateOneResult = handleList head
+evaluateOneResult :: Monad m => ListT m a -> m (Maybe a)
+evaluateOneResult = head

@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, ScopedTypeVariables, FlexibleContexts, Rank2Types, ConstraintKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 module Control.Effects.State (module Control.Effects.State, module Control.Effects) where
 
 import Interlude
@@ -17,41 +18,48 @@ type instance EffectMsg (SetState s) = s
 type instance EffectRes (SetState s) = ()
 
+instance Monad m => MonadEffect (GetState s) (StateT s m) where
+    effect _ _ = get
+
+instance Monad m => MonadEffect (SetState s) (StateT s m) where
+    effect _ = put
+
 type MonadEffectState s m = (MonadEffect (GetState s) m, MonadEffect (SetState s) m)
 type EffectHandlerState s m = EffectHandler (GetState s) (EffectHandler (SetState s) m)
 
-{-# INLINE getState #-}
 getState :: forall s m. MonadEffect (GetState s) m => m s
+{-# INLINE getState #-}
 getState = effect (Proxy :: Proxy (GetState s)) ()
 
-{-# INLINE setState #-}
 setState :: forall s m. MonadEffect (SetState s) m => s -> m ()
+{-# INLINE setState #-}
 setState = effect (Proxy :: Proxy (SetState s))
 
-{-# INLINE modifyState #-}
 modifyState :: forall s m. MonadEffectState s m => (s -> s) -> m ()
+{-# INLINE modifyState #-}
 modifyState f = setState . f =<< getState
 
-{-# INLINE handleGetState #-}
 handleGetState :: Monad m => m s -> EffectHandler (GetState s) m a -> m a
+{-# INLINE handleGetState #-}
 handleGetState = handleEffect . const
 
-{-# INLINE handleSetState #-}
 handleSetState :: Monad m => (s -> m ()) -> EffectHandler (SetState s) m a -> m a
+{-# INLINE handleSetState #-}
 handleSetState = handleEffect
 
-{-# INLINE handleState #-}
 handleState :: Monad m => m s -> (s -> m ()) -> EffectHandlerState s m a -> m a
+{-# INLINE handleState #-}
 handleState getter setter = handleSetState setter . handleGetState (lift getter)
 
 handleStateIO :: MonadIO m => s -> EffectHandlerState s m a -> m a
+{-# INLINE handleStateIO #-}
 handleStateIO initial m = do
     ref <- liftIO (newIORef initial)
     m & handleState (liftIO (readIORef  ref)) (liftIO . writeIORef ref)
 
+handleStateT :: Monad m => s -> StateT s m a -> m a
 {-# INLINE handleStateT #-}
-handleStateT :: Monad m => s -> EffectHandlerState s (StateT s m) a -> m a
-handleStateT initial m = evalStateT (handleSetState put $ handleGetState get m) initial
+handleStateT = flip evalStateT
 
 handleSubstate :: MonadEffectState s m => Lens' s t -> t -> EffectHandlerState t m a -> m a
 handleSubstate lensST initial m = do