simple-effects 0.2.0.1 → 0.3.0.0

raw patch · 5 files changed

+33/−26 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• bench/Bench.hs +4/−3
• simple-effects.cabal +1/−1
• src/Control/Effects.hs +2/−0
• src/Control/Effects/List.hs +17/−18
• src/Control/Effects/State.hs +9/−4

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, TypeApplications #-} import Interlude  import GHC.IO.Encoding (setLocaleEncoding, utf16)@@ -13,11 +13,12 @@  effectsSimple :: (MonadEffect (GetState Int) m, MonadEffect (SetState Int) m) => m () effectsSimple = replicateM_ 1000000 effectsSimple'-    where effectsSimple' = setState . (+ (1 :: Int)) =<< getState+    where effectsSimple' = modifyState (+ (1 :: Int))  main :: IO () main =     defaultMain         [ bench "MTL state" $ nfIO (execStateT mtlSimple 0)-        , bench "Effects state" $ nfIO (handleStateIO (0 :: Int) (effectsSimple >> getState) :: IO Int)+        , bench "Effects state" $ nfIO effState         ]+    where effState = handleStateIO @_ @Int @Int 0 (effectsSimple >> getState)

@@ -1,5 +1,5 @@ name:                simple-effects-version:             0.2.0.1+version:             0.3.0.0     synopsis:            A simple effect system that integrates with MTL description:         Please see README.md homepage:            https://gitlab.com/LukaHorvat/simple-effects

@@ -40,9 +40,11 @@  instance {-# OVERLAPPABLE #-} (MonadEffect eff m, MonadTrans t, Monad (t m))          => MonadEffect eff (t m) where+    {-# INLINE effect #-}     effect p msg = lift (effect p msg)  instance Monad m => MonadEffect eff (EffectHandler eff m) where+    {-# INLINE effect #-}     effect _ msg = EffectHandler (ReaderT ($ msg))  -- | Handle the effect described by 'eff'.

@@ -9,52 +9,51 @@ 
 import Control.Effects
 
-data List
+data NonDeterministic
 
-type instance EffectMsg1 List = []
-type instance EffectRes1 List = Identity
-type instance EffectCon1 List a = ()
+type instance EffectMsg1 NonDeterministic = []
+type instance EffectRes1 NonDeterministic = Identity
+type instance EffectCon1 NonDeterministic a = ()
 
 -- | Runs the rest of the computation for every value in the list
-choose :: MonadEffect1 List m => [a] -> m a
-choose = fmap runIdentity . effect1 (Proxy :: Proxy List)
+choose :: MonadEffect1 NonDeterministic m => [a] -> m a
+choose = fmap runIdentity . effect1 (Proxy :: Proxy NonDeterministic)
 
 -- | Signals that this branch of execution failed to produce a result.
-deadEnd :: MonadEffect1 List m => m a
+deadEnd :: MonadEffect1 NonDeterministic m => m a
 deadEnd = choose []
 
--- | A generic handler for the List effect. Takes a handler for the ListT transformer as a param.
-handleList :: Monad m => (ListT m a -> m b) -> EffectHandler1 List (ListT m) a -> m b
+-- | 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 List (ListT m) a -> m [a]
+evaluateToList :: Monad m => EffectHandler1 NonDeterministic (ListT m) a -> m [a]
 evaluateToList = handleList toList
 
 -- | Given a function, apply it to all the results.
-traverseAllResults :: Monad m => (a -> m ()) -> EffectHandler1 List (ListT m) a -> m ()
+traverseAllResults :: Monad m => (a -> m ()) -> EffectHandler1 NonDeterministic (ListT m) a -> m ()
 traverseAllResults handler = handleList (traverse_ handler)
 
 -- | 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 List (ListT m) a -> m r
+foldAllResults :: Monad m => (r -> a -> m r) -> r
+               -> EffectHandler1 NonDeterministic (ListT m) a -> m r
 foldAllResults f i = handleList (fold f i)
 
 -- | 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 List (ListT m) a -> m r
+                                    -> EffectHandler1 NonDeterministic (ListT m) a -> m r
 foldWithEarlyTermination f i = handleList (foldMaybe f i)
 
 -- | Executes only the effects needed to produce the first n results.
-evaluateNResults :: Monad m => Int -> EffectHandler1 List (ListT m) a -> m [a]
+evaluateNResults :: Monad m => Int -> EffectHandler1 NonDeterministic (ListT m) a -> m [a]
 evaluateNResults n = handleList (fmap fst . splitAt n)
 
 -- | Executes only the effects needed to produce a single result.
-evaluateOneResult :: Monad m => EffectHandler1 List (ListT m) a -> m (Maybe a)
+evaluateOneResult :: Monad m => EffectHandler1 NonDeterministic (ListT m) a -> m (Maybe a)
 evaluateOneResult = handleList head
-
-test :: IO (Maybe Int)
-test = evaluateOneResult (return 1)

@@ -17,32 +17,37 @@ type instance EffectMsg (SetState s) = s type instance EffectRes (SetState s) = () +{-# INLINE getState #-} getState :: forall m s. MonadEffect (GetState s) m => m s getState = effect (Proxy :: Proxy (GetState s)) () +{-# INLINE setState #-} setState :: forall m s. MonadEffect (SetState s) m => s -> m () setState = effect (Proxy :: Proxy (SetState s)) +{-# INLINE modifyState #-} modifyState :: forall m s. (MonadEffect (GetState s) m, MonadEffect (SetState s) m) => (s -> s) -> m () modifyState f = setState . f =<< getState +{-# INLINE handleGetState #-} handleGetState :: Monad m => m s -> EffectHandler (GetState s) m a -> m a handleGetState = handleEffect . const +{-# INLINE handleSetState #-} handleSetState :: Monad m => (s -> m ()) -> EffectHandler (SetState s) m a -> m a handleSetState = handleEffect -handleStateIO :: MonadIO m => s-                           -> EffectHandler (GetState s) (EffectHandler (SetState s) m) a-                           -> m a+handleStateIO :: forall m s a. MonadIO m+              => s -> EffectHandler (GetState s) (EffectHandler (SetState s) m) a -> m a handleStateIO initial m = do     ref <- liftIO (newIORef initial)     m & handleGetState (liftIO  (readIORef  ref))       & handleSetState (liftIO . writeIORef ref) +{-# INLINE handleState #-} handleState :: Monad m => s                        -> EffectHandler (GetState s)-                         (EffectHandler (SetState s) +                         (EffectHandler (SetState s)                          (StateT s m)) a                        -> m a handleState initial m = evalStateT (handleSetState put $ handleGetState get m) initial