objective 1.0.4 → 1.0.5

raw patch · 6 files changed

+61/−20 lines, 6 filesdep ~witherable

Dependency ranges changed: witherable

Files

• CHANGELOG.md +8/−0
• objective.cabal +2/−2
• src/Control/Object.hs +0/−2
• src/Control/Object/Instance.hs +1/−1
• src/Control/Object/Mortal.hs +2/−1
• src/Control/Object/Object.hs +48/−14

@@ -1,3 +1,11 @@+1.0.5+----+* Added `filterO` and `filteredO`+* Renamed `announcesOf` to `invokesOf`+* Added `invokes`+* Added `(@!=)`+* Shaved unnecessary `Monoid r` off in `apprisesOf`+ 1.0.4 ---- * Simplified `Instance`

@@ -1,5 +1,5 @@ name:                objective-version:             1.0.4+version:             1.0.5 synopsis:            Composable objects description:         Composable objects homepage:            https://github.com/fumieval/objective@@ -40,7 +40,7 @@     , mtl     , profunctors     , void-    , witherable < 0.2+    , witherable >= 0.1.3     , stm     , monad-stm     , monad-skeleton >= 0.1.1 && <0.3

@@ -14,10 +14,8 @@   ( module Control.Object.Object,     module Control.Object.Mortal,     module Control.Object.Instance,-    module Data.Functor.Request,   ) where  import Control.Object.Object import Control.Object.Mortal import Control.Object.Instance-import Data.Functor.Request

@@ -77,7 +77,7 @@  -- | Take a snapshot of an instance. snapshot :: (MonadSTM m, Functor g) => Instance f g -> m (Object f g)-snapshot (InstRef f g v) = liftSTM $ go `fmap` takeTMVar v+snapshot (InstRef f g v) = liftSTM $ go `fmap` readTMVar v   where go (Object m) = Object $ fmap (fmap go) . g . m . f  -- | Create a new instance. This can be used inside 'unsafePerformIO' to create top-level instances.

@@ -91,7 +91,8 @@ {-# INLINE immortal #-}  -- | Send a message to mortals through a filter.-apprisesOf :: (Monad m, Monoid r) => ((Mortal f m b -> WriterT r m (Maybe (Mortal f m b))) -> s -> WriterT r m s)+apprisesOf :: Monad m+  => FilterLike' (WriterT r m) s (Mortal f m b)   -> f a -> (a -> r) -> (b -> r) -> StateT s m r apprisesOf l f p q = StateT $ \t -> liftM swap $ runWriterT $ flip l t     $ \obj -> WriterT $ runEitherT (runMortal obj f) >>= \case

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types, TupleSections, TypeOperators #-}+{-# LANGUAGE GADTs #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Safe #-}@@ -36,8 +37,14 @@   , iterative   , cascadeObject   , cascading-  -- * Masses-  , announcesOf+  -- * Filtering+  , Fallible(..)+  , filteredO+  , filterO+  -- * Manipulation on StateT+  , invokesOf+  , invokes+  , (@!=)   , announce   , withBuilder   ) where@@ -128,8 +135,8 @@  -- | An unwrapped analog of 'stateful' --     @id = unfoldO runObject@---     @iterative = unfoldO iterObject@---     @cascade = unfoldO cascadeObject@+--     @'iterative' = unfoldO 'iterObject'@+--     @'cascading' = unfoldO 'cascadeObject'@ unfoldO :: Functor g => (forall a. r -> f a -> g (a, r)) -> r -> Object f g unfoldO h = go where go r = Object $ fmap (fmap go) . h r {-# INLINE unfoldO #-}@@ -149,7 +156,7 @@ {-# INLINE stateful #-}  -- | Flipped 'stateful'.--- it is convenient to use with the LambdaCase extension.+-- it is super convenient to use with the LambdaCase extension. (@~) :: Monad m => s -> (forall a. t a -> StateT s m a) -> Object t m s @~ h = stateful h s {-# INLINE (@~) #-}@@ -160,8 +167,8 @@ iterObject obj (Pure a) = return (a, obj) iterObject obj (Free f) = runObject obj f >>= \(cont, obj') -> iterObject obj' cont --- | Objects can consume free monads-iterative :: (Monad m) => Object f m -> Object (Free f) m+-- | Objects can consume free monads. 'cascading' is more preferred.+iterative :: Monad m => Object f m -> Object (Free f) m iterative = unfoldOM iterObject {-# INLINE iterative #-} @@ -180,25 +187,38 @@   t :>>= k -> runObject obj t >>= \(a, obj') -> cascadeObject obj' (k a)  -- | Add capability to handle multiple messages at once.-cascading :: (Monad m) => Object t m -> Object (Skeleton t) m+cascading :: Monad m => Object t m -> Object (Skeleton t) m cascading = unfoldOM cascadeObject {-# INLINE cascading #-} --- | Send a message to objects through a traversal.-announcesOf :: (Monad m, Monoid r) => ((Object t m -> WriterT r m (Object t m)) -> s -> WriterT r m s)+-- | Send a message to an object through a lens.+invokesOf :: Monad m+  => ((Object t m -> WriterT r m (Object t m)) -> s -> WriterT r m s)   -> t a -> (a -> r) -> StateT s m r-announcesOf t f c = StateT $ liftM swap . runWriterT+invokesOf t f c = StateT $ liftM swap . runWriterT   . t (\obj -> WriterT $ runObject obj f >>= \(x, obj') -> return (obj', c x))-{-# INLINABLE announcesOf #-}+{-# INLINABLE invokesOf #-} +invokes :: (T.Traversable t, Monad m, Monoid r)+  => f a -> (a -> r) -> StateT (t (Object f m)) m r+invokes = invokesOf T.mapM+{-# INLINE invokes #-}+ -- | Send a message to objects in a traversable container. ----- @announce = withBuilder . announcesOf traverse@+-- @announce = withBuilder . invokesOf traverse@ -- announce :: (T.Traversable t, Monad m) => f a -> StateT (t (Object f m)) m [a]-announce f = withBuilderM (announcesOf T.mapM f)+announce f = withBuilderM (invokes f) {-# INLINABLE announce #-} +-- | A method invocation operator on 'StateT'.+(@!=) :: Monad m+  => ((Object t m -> WriterT a m (Object t m)) -> s -> WriterT a m s)+  -> t a -> StateT s m a+l @!= f = invokesOf l f id+{-# INLINE (@!=) #-}+ withBuilder :: Functor f => ((a -> Endo [a]) -> f (Endo [a])) -> f [a] withBuilder f = fmap (flip appEndo []) (f (Endo . (:))) {-# INLINABLE withBuilder #-}@@ -206,3 +226,17 @@ withBuilderM :: Monad f => ((a -> Endo [a]) -> f (Endo [a])) -> f [a] withBuilderM f = liftM (flip appEndo []) (f (Endo . (:))) {-# INLINABLE withBuilderM #-}++data Fallible t a where+  Fallible :: t a -> Fallible t (Maybe a)++filteredO :: Monad m+       => (forall x. t x -> Bool)+       -> Object t m -> Object (Fallible t) m+filteredO p obj = Object $ \(Fallible t) -> if p t+  then runObject obj t >>= \(a, obj') -> return (Just a, filteredO p obj')+  else return (Nothing, filteredO p obj)++filterO :: (forall x. t x -> Bool) -> Object (Fallible t) (Skeleton t)+filterO p = filteredO p (liftO bone)+{-# INLINE filterO #-}