diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,12 @@
+1.0.3
+----
+* Added `apprisesOf`
+* Added `(@~)`
+
+1.0.2
+----
+* Made `(.-)` exception-safe
+
 1.0.1
 ----
 * Switched to use TMVar for instances
diff --git a/objective.cabal b/objective.cabal
--- a/objective.cabal
+++ b/objective.cabal
@@ -1,5 +1,5 @@
 name:                objective
-version:             1.0.2
+version:             1.0.3
 synopsis:            Extensible objects
 description:         Stateful effect transducer
 homepage:            https://github.com/fumieval/objective
diff --git a/src/Control/Object/Mortal.hs b/src/Control/Object/Mortal.hs
--- a/src/Control/Object/Mortal.hs
+++ b/src/Control/Object/Mortal.hs
@@ -1,21 +1,17 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE BangPatterns #-}
 module Control.Object.Mortal (
     Mortal(..),
     mortal,
     mortal_,
     runMortal,
     immortal,
-    apprise,
+    apprisesOf,
     apprises,
-    apprises',
-    apprises_,
-    -- * Combinators
-    gatherFst,
-    gatherSnd,
-    buildSingle,
-    buildBoth,
+    apprise,
+    withBuilder,
     ) where
 
 import Control.Object.Object
@@ -77,43 +73,26 @@
 immortal obj = mortal $ \f -> EitherT $ runObject obj f >>= \(a, obj') -> return $ Right (a, immortal obj')
 
 -- | Send a message to mortals in a container.
-apprise :: (Witherable t, Monad m, Applicative m) => f a -> StateT (t (Mortal f m r)) m ([a], [r])
-apprise f = buildBoth (apprises f)
-{-# INLINE apprise #-}
-
--- | Send a message to mortals in a container.
-apprises :: (Witherable t, Monad m, Applicative m, Monoid r) => f a -> (a -> r) -> (b -> r) -> StateT (t (Mortal f m b)) m r
-apprises f p q = StateT $ \t -> do
-  (t', res) <- runWriterT $ flip wither t
+apprisesOf :: (Monad m, Monoid r) => ((Mortal f m b -> WriterT r m (Maybe (Mortal f m b))) -> s -> WriterT r m s)
+  -> f a -> (a -> r) -> (b -> r) -> StateT s m r
+apprisesOf l f p q = StateT $ \t -> do
+  (t', res) <- runWriterT $ flip l t
     $ \obj -> lift (runEitherT $ runMortal obj f) >>= \case
       Left r -> writer (Nothing, q r)
       Right (x, obj') -> writer (Just obj', p x)
   return (res, t')
-{-# INLINE apprises #-}
 
--- | Like apprises, but ignores the final results.
-apprises' :: (Witherable t, Monad m, Applicative m, Monoid r) => f a -> (a -> r) -> StateT (t (Mortal f m b)) m r
-apprises' f c = apprises f c (const mempty)
-{-# INLINE apprises' #-}
-
--- | Like apprises, but ignores the result.
-apprises_ :: (Witherable t, Monad m, Applicative m, Monoid r) => f a -> (b -> r) -> StateT (t (Mortal f m b)) m r
-apprises_ f = apprises f (const mempty)
-{-# INLINE apprises_ #-}
-
-gatherFst :: (Monoid r) => (a -> r) -> ((a -> r) -> (b -> r) -> k) -> k
-gatherFst g f = f g (const mempty)
-{-# INLINE gatherFst #-}
-
-gatherSnd :: (Monoid r) => (b -> r) -> ((a -> r) -> (b -> r) -> k) -> k
-gatherSnd g f = f (const mempty) g
-{-# INLINE gatherSnd #-}
+-- | Send a message to mortals in a container.
+apprises :: (Witherable t, Monad m, Applicative m, Monoid r) => f a -> (a -> r) -> (b -> r) -> StateT (t (Mortal f m b)) m r
+apprises = apprisesOf wither
+{-# INLINE apprises #-}
 
-buildSingle :: Functor f => ((a -> Endo [a]) -> f (Endo [a])) -> f [a]
-buildSingle f = fmap (flip appEndo []) (f (Endo . (:)))
-{-# INLINABLE buildSingle #-}
+-- | Send a message to mortals in a container.
+apprise :: (Witherable t, Monad m, Applicative m) => f a -> StateT (t (Mortal f m r)) m ([a], [r])
+apprise f = fmap (flip appEndo [] *** flip appEndo [])
+  $ apprises f (\a -> (Endo (a:), mempty)) (\b -> (mempty, Endo (b:)))
+{-# INLINE apprise #-}
 
-buildBoth :: Functor f => ((a -> (Endo [a], Endo [b])) -> (b -> (Endo [a], Endo [b])) -> f (Endo [a], Endo [b])) -> f ([a], [b])
-buildBoth f = fmap (flip appEndo [] *** flip appEndo [])
-  $ f (\a -> (Endo (a:), mempty)) (\b -> (mempty, Endo (b:)))
-{-# INLINABLE buildBoth #-}
+withBuilder :: Functor f => ((a -> Endo [a]) -> f (Endo [a])) -> f [a]
+withBuilder f = fmap (flip appEndo []) (f (Endo . (:)))
+{-# INLINABLE withBuilder #-}
diff --git a/src/Control/Object/Object.hs b/src/Control/Object/Object.hs
--- a/src/Control/Object/Object.hs
+++ b/src/Control/Object/Object.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE Rank2Types, CPP, TypeOperators, DataKinds, TupleSections #-}
+{-# LANGUAGE Rank2Types, CPP, TypeOperators, DataKinds, TupleSections, BangPatterns #-}
 #if __GLASGOW_HASKELL__ >= 707
 {-# LANGUAGE DeriveDataTypeable #-}
 #endif
@@ -94,11 +94,17 @@
 -- | Build a stateful object.
 --
 -- @stateful t s = t ^>>@ variable s@
-stateful :: Monad m => (forall a. f a -> StateT s m a) -> s -> Object f m
+stateful :: Monad m => (forall a. t a -> StateT s m a) -> s -> Object t m
 stateful h = go where
   go s = Object $ \f -> runStateT (h f) s >>= \(a, s') -> s' `seq` return (a, go s')
 {-# INLINE stateful #-}
 
+-- | Flipped 'stateful'
+(@~) :: Monad m => s -> (forall a. t a -> StateT s m a) -> Object t m
+s @~ h = stateful h s
+{-# INLINE (@~) #-}
+infix 1 @~
+
 -- | Cascading
 iterObject :: Monad m => Object f m -> Free f a -> m (a, Object f m)
 iterObject obj (Pure a) = return (a, obj)
@@ -111,7 +117,8 @@
 
 -- | A mutable variable.
 variable :: Monad m => s -> Object (StateT s m) m
-variable s = Object $ \m -> liftM (fmap variable) $ runStateT m s
+variable = stateful id
+{-# INLINE variable #-}
 
 -- | Send a message to objects in a container.
 announce :: (T.Traversable t, Monad m) => f a -> StateT (t (Object f m)) m [a]