diff --git a/src/Control/Monad/Weighted.hs b/src/Control/Monad/Weighted.hs
--- a/src/Control/Monad/Weighted.hs
+++ b/src/Control/Monad/Weighted.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE PatternSynonyms            #-}
+{-# LANGUAGE UndecidableInstances       #-}
 {-# LANGUAGE ViewPatterns               #-}
 
 module Control.Monad.Weighted
@@ -16,18 +18,32 @@
   ,evalWeighted)
   where
 
+
 import           Control.Applicative
 import           Control.Monad.Identity
 import           Control.Monad.State.Strict
+
+import           Control.Monad.Cont.Class
+import           Control.Monad.Error.Class
+import           Control.Monad.Fail
+import           Control.Monad.Reader.Class
 import           Control.Monad.Writer.Class
+
+import           Control.Monad.Weighted.Class
+
 import           Data.Coerce
+import           Data.Functor.Classes
+
+import           Data.Monoid
 import           Data.Semiring
 
 -- | A monad transformer similar to 'WriterT', except that it does not leak
 -- space, and it uses the 'Semiring' class, rather than 'Monoid'.
 newtype WeightedT s m a =
     WeightedT_ (StateT s m a)
-    deriving (Functor,Applicative,Monad,MonadTrans)
+    deriving (Functor,Applicative,Monad,MonadTrans,MonadCont,MonadError e
+             ,MonadReader r,MonadFix,MonadFail,MonadIO,Alternative,MonadPlus
+             ,MonadWriter w)
 
 runWeightedT
     :: Semiring s
@@ -37,59 +53,146 @@
         (`runStateT` one)
 {-# INLINE runWeightedT #-}
 
-pattern WeightedT :: (Functor m, Semiring s) => m (a, s) -> WeightedT s m a
-pattern WeightedT x <- (runWeightedT -> x) where
-  WeightedT y = WeightedT_ (StateT (\s -> (fmap.fmap) (s<.>) y))
 
+pattern WeightedT :: (Functor m, Semiring s) =>
+        m (a, s) -> WeightedT s m a
+
+pattern WeightedT x <- (runWeightedT -> x)
+  where WeightedT y
+          = WeightedT_ (StateT (\ s -> (fmap . fmap) (s<.>) y))
+
 type Weighted s = WeightedT s Identity
 
 pattern Weighted :: Semiring s => (a, s) -> Weighted s a
-pattern Weighted x <- (runWeighted -> x) where
-  Weighted (y,p) = WeightedT_ (StateT (\s -> Identity (y, p<.>s)))
 
+pattern Weighted x <- (runWeighted -> x)
+  where Weighted (y, p)
+          = WeightedT_ (StateT (\ s -> Identity (y, (<.>) p s)))
+
 runWeighted
     :: Semiring s
     => Weighted s a -> (a, s)
 runWeighted =
     (coerce :: (WeightedT s Identity a -> Identity (a, s)) -> (WeightedT s Identity a -> (a, s)))
         runWeightedT
+
 {-# INLINE runWeighted #-}
 
-instance (Semiring s, Monad m) => MonadWriter (Mul s) (WeightedT s m) where
-  writer (x, Mul s) = WeightedT (pure (x, s))
-  {-# INLINE writer #-}
-  listen (WeightedT_ s) = WeightedT_ ((,) <$> s <*> gets Mul)
-  {-# INLINE listen #-}
-  pass (WeightedT_ s) = WeightedT_ (passS s) where
-    passS = (=<<) (uncurry (<$) . fmap (modify . coerce))
-  {-# INLINE pass #-}
+instance MonadState s m =>
+         MonadState s (WeightedT w m) where
+    get = lift get
+    put = lift . put
+    state = lift . state
 
-evalWeightedT :: (Monad m, Semiring s) => WeightedT s m a -> m a
+evalWeightedT
+    :: (Monad m, Semiring s)
+    => WeightedT s m a -> m a
 evalWeightedT =
     (coerce :: (StateT s m a -> m a) -> WeightedT s m a -> m a)
         (`evalStateT` one)
+
 {-# INLINE evalWeightedT #-}
 
-execWeightedT :: (Monad m, Semiring s) => WeightedT s m a -> m s
+execWeightedT
+    :: (Monad m, Semiring s)
+    => WeightedT s m a -> m s
 execWeightedT =
     (coerce :: (StateT s m a -> m s) -> WeightedT s m a -> m s)
         (`execStateT` one)
+
 {-# INLINE execWeightedT #-}
 
-evalWeighted :: Semiring s => Weighted s a -> a
+evalWeighted
+    :: Semiring s
+    => Weighted s a -> a
 evalWeighted =
-    (coerce :: (State s a -> a) -> Weighted s a -> a)
-        (`evalState` one)
+    (coerce :: (State s a -> a) -> Weighted s a -> a) (`evalState` one)
+
 {-# INLINE evalWeighted #-}
 
-execWeighted :: Semiring s => Weighted s a -> s
+execWeighted
+    :: Semiring s
+    => Weighted s a -> s
 execWeighted =
-    (coerce :: (State s a -> s) -> Weighted s a -> s)
-        (`execState` one)
+    (coerce :: (State s a -> s) -> Weighted s a -> s) (`execState` one)
+
 {-# INLINE execWeighted #-}
 
-instance (Alternative m, Monad m, Semiring s) => Alternative (WeightedT s m) where
-  empty = WeightedT empty
-  WeightedT x <|> WeightedT y = WeightedT (x <|> y)
-  _ <|> _ = undefined
+instance (Foldable m, Semiring w) =>
+         Foldable (WeightedT w m) where
+    foldMap f =
+        foldMap
+            (\(x,_) ->
+                  f x) .
+        runWeightedT
+
+first_
+    :: Applicative f
+    => (a -> f b) -> (a, c) -> f (b, c)
+first_ f (x,y) = flip (,) y <$> f x
+
+instance (Traversable m, Semiring w) =>
+         Traversable (WeightedT w m) where
+    traverse f x = WeightedT <$> (traverse . first_) f (runWeightedT x)
+
+instance (Eq1 m, Eq w, Semiring w) =>
+         Eq1 (WeightedT w m) where
+    liftEq eq x y =
+        liftEq
+            (\(xx,xy) (yx,yy) ->
+                  eq xx yx && xy == yy)
+            (runWeightedT x)
+            (runWeightedT y)
+
+instance (Ord1 m, Ord w, Semiring w) =>
+         Ord1 (WeightedT w m) where
+    liftCompare cmp x y =
+        liftCompare
+            (\(xx,xy) (yx,yy) ->
+                  cmp xx yx <> compare xy yy)
+            (runWeightedT x)
+            (runWeightedT y)
+
+instance (Read w, Read1 m, Semiring w, Functor m) =>
+         Read1 (WeightedT w m) where
+    liftReadsPrec rp rl =
+        readsData $ readsUnaryWith (liftReadsPrec rp' rl') "WeightedT" WeightedT
+      where
+        rp' = liftReadsPrec2 rp rl readsPrec readList
+        rl' = liftReadList2 rp rl readsPrec readList
+
+instance (Show w, Show1 m, Semiring w) =>
+         Show1 (WeightedT w m) where
+    liftShowsPrec sp sl d m =
+        showsUnaryWith (liftShowsPrec sp' sl') "WeightedT" d (runWeightedT m)
+      where
+        sp' = liftShowsPrec2 sp sl showsPrec showList
+        sl' = liftShowList2 sp sl showsPrec showList
+
+instance (Eq w, Eq1 m, Eq a, Semiring w) =>
+         Eq (WeightedT w m a) where
+    (==) = eq1
+
+instance (Ord w, Ord1 m, Ord a, Semiring w) =>
+         Ord (WeightedT w m a) where
+    compare = compare1
+
+instance (Read w, Read1 m, Read a, Semiring w, Functor m) =>
+         Read (WeightedT w m a) where
+    readsPrec = readsPrec1
+
+instance (Show w, Show1 m, Show a, Semiring w) =>
+         Show (WeightedT w m a) where
+    showsPrec = showsPrec1
+
+instance (Semiring w, Monad m) => MonadWeighted w (WeightedT w m) where
+    weighted (x,s) = WeightedT (pure (x, s))
+    {-# INLINE weighted #-}
+    weigh (WeightedT_ s) = WeightedT_ ((,) <$> s <*> get)
+    {-# INLINE weigh #-}
+    scale (WeightedT_ s) = WeightedT_ (scaleS s)
+      where
+        scaleS = (=<<) (uncurry (<$) . fmap modify)
+    {-# INLINE scale #-}
+
 
diff --git a/src/Control/Monad/Weighted/Class.hs b/src/Control/Monad/Weighted/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Weighted/Class.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+module Control.Monad.Weighted.Class where
+
+import qualified Control.Monad.Trans.Identity as Identity
+import qualified Control.Monad.Trans.Except as Except
+import qualified Control.Monad.Trans.State.Strict as StateStrict
+import qualified Control.Monad.Trans.State.Lazy as StateLazy
+import qualified Control.Monad.Trans.Maybe as Maybe
+import qualified Control.Monad.Trans.Reader as Reader
+
+import Control.Monad.Trans (lift)
+
+import Data.Semiring
+
+import Data.Coerce
+
+class (Semiring w, Monad m) => MonadWeighted w m | m -> w where
+    {-# MINIMAL (weighted | weight), weigh, scale #-}
+    -- | @'weighted' (a,w)@ embeds a simple weighted action.
+    weighted :: (a,w) -> m a
+    weighted ~(a, w) = do
+      weight w
+      return a
+
+    -- | @'weight' w@ is an action that produces the output @w@.
+    weight   :: w -> m ()
+    weight w = weighted ((),w)
+
+    -- | @'weigh' m@ is an action that executes the action @m@ and adds
+    -- its output to the value of the computation.
+    weigh :: m a -> m (a, w)
+    -- | @'scale' m@ is an action that executes the action @m@, which
+    -- returns a value and a function, and returns the value, applying
+    -- the function to the output.
+    scale   :: m (a, w -> w) -> m a
+
+instance MonadWeighted w m => MonadWeighted w (Except.ExceptT e m) where
+    weighted = lift . weighted
+    weight   = lift . weight
+    weigh    = Except.liftListen weigh
+    scale    = Except.liftPass scale
+
+instance MonadWeighted w m => MonadWeighted w (Identity.IdentityT m) where
+    weighted = lift . weighted
+    weight   = lift . weight
+    weigh    = Identity.mapIdentityT weigh
+    scale    = Identity.mapIdentityT scale
+
+instance MonadWeighted w m => MonadWeighted w (StateStrict.StateT s m) where
+    weighted = lift . weighted
+    weight   = lift . weight
+    weigh    = StateStrict.liftListen weigh
+    scale    = StateStrict.liftPass scale
+
+instance MonadWeighted w m => MonadWeighted w (StateLazy.StateT s m) where
+    weighted = lift . weighted
+    weight   = lift . weight
+    weigh    = StateLazy.liftListen weigh
+    scale    = StateLazy.liftPass scale
+
+instance MonadWeighted w m => MonadWeighted w (Maybe.MaybeT m) where
+    weighted = lift . weighted
+    weight   = lift . weight
+    weigh    = Maybe.liftListen weigh
+    scale    = Maybe.liftPass scale
+
+instance MonadWeighted w m => MonadWeighted w (Reader.ReaderT r m) where
+    weighted = lift . weighted
+    weight   = lift . weight
+    weigh    = Reader.mapReaderT weigh
+    scale    = Reader.mapReaderT scale
+
+collect :: (Foldable m, MonadWeighted w m) => m a -> w
+collect = getAdd  #. foldMap (Add #. snd) . weigh
+
+infixr 9 #.
+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
+(#.) _ = coerce
+
+toCont :: (Foldable m, MonadWeighted w m) => (a -> w) -> m a -> w
+toCont f xs = collect (weight . f =<< xs)
diff --git a/src/Control/Monad/Weighted/Filter.hs b/src/Control/Monad/Weighted/Filter.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Weighted/Filter.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE PatternSynonyms            #-}
+{-# LANGUAGE ViewPatterns               #-}
+
+module Control.Monad.Weighted.Filter
+  (catchZero
+  ,FilterT
+  ,pattern FilterT
+  ,runFilterT
+  ,evalFilterT
+  ,execFilterT)
+  where
+
+import           Data.Semiring
+
+import           Data.Functor.Classes
+
+import           Control.Applicative
+
+import           Control.Monad.State.Strict
+
+import           Control.Monad.Cont.Class
+import           Control.Monad.Error.Class
+import           Control.Monad.Fail
+import           Control.Monad.Reader.Class
+import           Control.Monad.Weighted.Class
+import           Control.Monad.Writer.Class
+
+import           Control.Arrow                (first)
+import           Data.Coerce
+import           Data.Monoid
+
+catchZero :: (DetectableZero s, Alternative m) => (s -> m a) -> s -> m a
+catchZero f s | isZero s = empty
+              | otherwise = f s
+
+remZeroes :: (DetectableZero s, Alternative m, Monad m) => m (a, s) -> m (a, s)
+remZeroes xs = xs >>=  (\(x,p) -> if isZero p then empty else pure (x,p))
+
+-- | Discards results which are zero
+newtype FilterT s m a =
+    FilterT_ { unFilterT :: StateT s m a }
+    deriving (MonadTrans,MonadCont,MonadError e
+             ,MonadReader r,MonadFix,MonadFail,MonadIO,Alternative,MonadPlus
+             ,MonadWriter w)
+
+instance (Alternative m, DetectableZero s) => Functor (FilterT s m) where
+    fmap f (FilterT_ (StateT st)) =
+        (FilterT_ . StateT . catchZero) ((fmap . first) f . st)
+    {-# INLINE fmap #-}
+
+instance (Alternative m, Monad m, DetectableZero s) =>
+         Applicative (FilterT s m) where
+    pure x = (FilterT_ . StateT) (catchZero (pure . (,) x))
+    {-# INLINE pure #-}
+    FilterT_ (StateT fs) <*> FilterT_ (StateT xs) =
+        FilterT_ . StateT . catchZero $
+        \s -> do
+            (f,s') <- fs s
+            (x,s'') <- catchZero xs s'
+            catchZero
+                (\s''' ->
+                      pure (f x, s'''))
+                s''
+    {-# INLINE (<*>) #-}
+
+instance (Alternative m, Monad m, DetectableZero s) =>
+         Monad (FilterT s m) where
+    FilterT_ (StateT st) >>= f =
+        FilterT_ . StateT . catchZero $
+        \s -> do
+            (x,s') <- st s
+            (y,s'') <- catchZero (runStateT (unFilterT (f x))) s'
+            catchZero
+                (\s''' ->
+                      pure (y, s'''))
+                s''
+    {-# INLINE (>>=) #-}
+
+runFilterT
+    :: (DetectableZero s, Alternative m, Monad m)
+    => FilterT s m a -> m (a, s)
+runFilterT = remZeroes .
+    (coerce :: (StateT s m a -> m (a, s)) -> FilterT s m a -> m (a, s))
+        (`runStateT` one)
+
+{-# INLINE runFilterT #-}
+
+evalFilterT
+    :: (Monad m, Semiring s)
+    => FilterT s m a -> m a
+evalFilterT =
+    (coerce :: (StateT s m a -> m a) -> FilterT s m a -> m a)
+        (`evalStateT` one)
+
+{-# INLINE evalFilterT #-}
+
+execFilterT
+    :: (Monad m, Semiring s)
+    => FilterT s m a -> m s
+execFilterT =
+    (coerce :: (StateT s m a -> m s) -> FilterT s m a -> m s)
+        (`execStateT` one)
+
+{-# INLINE execFilterT #-}
+
+pattern FilterT :: (Alternative m, DetectableZero s, Monad m) => m (a, s) -> FilterT s m a
+pattern FilterT x <- (runFilterT -> x)
+  where FilterT y = FilterT_ . StateT . catchZero $ \s -> (fmap.fmap) (s<.>) y
+
+instance (DetectableZero w, Monad m, Alternative m) => MonadWeighted w (FilterT w m) where
+    weighted (x,s) = FilterT (pure (x, s))
+    {-# INLINE weighted #-}
+    weigh (FilterT_ s) = FilterT_ ((,) <$> s <*> get)
+    {-# INLINE weigh #-}
+    scale (FilterT_ s) = FilterT_ (scaleS s)
+      where
+        scaleS = (=<<) (uncurry (<$) . fmap modify)
+    {-# INLINE scale #-}
+
+instance (Foldable m, DetectableZero w, Alternative m, Monad m) =>
+         Foldable (FilterT w m) where
+    foldMap f =
+        foldMap
+            (\(x,p) ->
+                  if isZero p
+                      then mempty
+                      else f x) .
+        runFilterT
+
+first_
+    :: Applicative f
+    => (a -> f b) -> (a, c) -> f (b, c)
+first_ f (x,y) = flip (,) y <$> f x
+
+instance (Traversable m, DetectableZero w, Alternative m, Monad m) =>
+         Traversable (FilterT w m) where
+    traverse f x = FilterT <$> (traverse . first_) f (runFilterT x)
+
+instance (Eq1 m, Eq w, DetectableZero w, Monad m, Alternative m) =>
+         Eq1 (FilterT w m) where
+    liftEq eq x y =
+        liftEq
+            (\(xx,xy) (yx,yy) ->
+                  eq xx yx && xy == yy)
+            (runFilterT x)
+            (runFilterT y)
+
+instance (Ord1 m, Ord w, DetectableZero w, Monad m, Alternative m) =>
+         Ord1 (FilterT w m) where
+    liftCompare cmp x y =
+        liftCompare
+            (\(xx,xy) (yx,yy) ->
+                  cmp xx yx <> compare xy yy)
+            (runFilterT x)
+            (runFilterT y)
+
+instance (Read w, Read1 m, DetectableZero w, Alternative m, Monad m) =>
+         Read1 (FilterT w m) where
+    liftReadsPrec rp rl =
+        readsData $ readsUnaryWith (liftReadsPrec rp' rl') "FilterT" FilterT
+      where
+        rp' = liftReadsPrec2 rp rl readsPrec readList
+        rl' = liftReadList2 rp rl readsPrec readList
+
+instance (Show w, Show1 m, DetectableZero w, Monad m, Alternative m) =>
+         Show1 (FilterT w m) where
+    liftShowsPrec sp sl d m =
+        showsUnaryWith (liftShowsPrec sp' sl') "FilterT" d (runFilterT m)
+      where
+        sp' = liftShowsPrec2 sp sl showsPrec showList
+        sl' = liftShowList2 sp sl showsPrec showList
+
+instance (Eq w, Eq1 m, Eq a, DetectableZero w, Monad m, Alternative m) =>
+         Eq (FilterT w m a) where
+    (==) = eq1
+
+instance (Ord w, Ord1 m, Ord a, DetectableZero w, Monad m, Alternative m) =>
+         Ord (FilterT w m a) where
+    compare = compare1
+
+instance (Read w, Read1 m, Read a, DetectableZero w, Alternative m, Monad m) =>
+         Read (FilterT w m a) where
+    readsPrec = readsPrec1
+
+instance (Show w, Show1 m, Show a, DetectableZero w, Alternative m, Monad m) =>
+         Show (FilterT w m a) where
+    showsPrec = showsPrec1
+
+instance (Alternative m, MonadState s m, DetectableZero w) =>
+         MonadState s (FilterT w m) where
+    get = lift get
+    put = lift . put
+    state = lift . state
diff --git a/weighted.cabal b/weighted.cabal
--- a/weighted.cabal
+++ b/weighted.cabal
@@ -1,5 +1,5 @@
 name:                weighted
-version:             0.1.0.1
+version:             0.3.0.0
 synopsis:            Writer monad which uses semiring constraint
 description:         Writer monad which uses semiring constraint
 homepage:            https://github.com/oisdk/weighted
@@ -15,9 +15,12 @@
 library
   hs-source-dirs:      src
   exposed-modules:     Control.Monad.Weighted
+                     , Control.Monad.Weighted.Filter
+                     , Control.Monad.Weighted.Class
   build-depends:       base >= 4.9 && < 5
-                     , semiring-num >= 0.5.1.1
+                     , semiring-num >= 0.9
                      , mtl >= 2.2
+                     , transformers >= 0.5
   default-language:    Haskell2010
 
 source-repository head