diff --git a/compactable.cabal b/compactable.cabal
--- a/compactable.cabal
+++ b/compactable.cabal
@@ -1,5 +1,5 @@
 name:                compactable
-version:             0.1.0.4
+version:             0.1.1.0
 synopsis:            A typeclass for structures which can be catMaybed, filtered, and partitioned.
 description:         This provides polymorphic implimentations for filter, compact (catMaybes), and separate. It allows for higher performance implimentations to be used in place of defaults for all data structures, and endeavors to centerally document those implimentations. Compactable aims to be as general and unconstrained as possible, providing instances for non-Functors like Set, as well as some Contravariants (though not published here). Compactable fully subsumes Data.Witherable, offers more laws, and is more general.
 license:             BSD3
@@ -25,6 +25,7 @@
                      , containers   >= 0.5.7  && < 0.6
                      , transformers >= 0.5.2  && < 0.6
                      , vector       >= 0.11   && < 0.13
+                     , bifunctors   >= 5.4.2  && < 5.5
 
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/src/Control/Compactable.hs b/src/Control/Compactable.hs
--- a/src/Control/Compactable.hs
+++ b/src/Control/Compactable.hs
@@ -1,7 +1,8 @@
-{-# LANGUAGE ConstrainedClassMethods #-}
-{-# LANGUAGE DefaultSignatures       #-}
-{-# LANGUAGE KindSignatures          #-}
-{-# LANGUAGE LambdaCase              #-}
+{-# LANGUAGE ConstrainedClassMethods    #-}
+{-# LANGUAGE DefaultSignatures          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE LambdaCase                 #-}
 
 module Control.Compactable
   ( Compactable (..)
@@ -15,15 +16,21 @@
   , bindMaybeM
   , traverseMaybeM
   , altDefaultCompact
-  , altDefaultSeparate ) where
+  , altDefaultSeparate
+  , mfold'
+  , mlefts
+  , mrights
+  , CompactFold (..)) where
 
 import           Control.Applicative
-import           Control.Monad                   (join)
+import           Control.Arrow
+import           Control.Monad                   (MonadPlus (..), join)
 import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Maybe
+import           Data.Bifoldable
 import           Data.Bifunctor                  (bimap)
 import           Data.Either                     (partitionEithers)
-import           Data.Foldable                   (foldl')
+import           Data.Foldable                   as F (foldl', toList)
 import           Data.Functor.Compose
 import qualified Data.Functor.Product            as FP
 import qualified Data.IntMap                     as IntMap
@@ -362,6 +369,84 @@
     {-# INLINABLE separate #-}
     filter = Set.filter
     {-# INLINABLE filter  #-}
+
+instance (ArrowApply a, ArrowPlus a) => Compactable (ArrowMonad a) where
+    compact = compactFold
+    {-# INLINE compact #-}
+    separate = separateFold
+    {-# INLINE separate #-}
+
+
+newtype MonadSum f a = MonadSum { unMonadSum :: f a }
+    deriving (Functor, Applicative, Alternative, Monad, MonadPlus)
+
+instance MonadPlus f => Monoid (MonadSum f a) where
+    mempty = mzero
+    MonadSum a `mappend` MonadSum b = MonadSum (mplus a b)
+
+class Compactable f => CompactFold (f :: * -> *) where
+    compactFold :: Foldable g => f (g a) -> f a
+    default compactFold :: (MonadPlus f, Foldable g) => f (g a) -> f a
+    compactFold = (>>= mfold')
+    {-# INLINEABLE compactFold #-}
+
+    separateFold :: Bifoldable g => f (g a b) -> (f a, f b)
+    default separateFold :: (MonadPlus f, Bifoldable g) => f (g a b) -> (f a, f b)
+    separateFold xs = (xs >>= mlefts, xs >>= mrights)
+    {-# INLINEABLE separateFold #-}
+
+    fmapFold :: (Functor f, Foldable g) => (a -> g b) -> f a -> f b
+    fmapFold f = compactFold . fmap f
+    {-# INLINABLE fmapFold #-}
+
+    fmapBifold :: (Functor f, Bifoldable g) => (a -> g l r) -> f a -> (f l, f r)
+    fmapBifold f = separateFold . fmap f
+    {-# INLINABLE fmapBifold #-}
+
+    applyFold :: (Applicative f, Foldable g) => f (a -> g b) -> f a -> f b
+    applyFold f = compactFold . (f <*>)
+    {-# INLINABLE applyFold #-}
+
+    applyBifold :: (Applicative f, Bifoldable g) => f (a -> g l r) -> f a -> (f l, f r)
+    applyBifold fa = separateFold . (fa <*>)
+    {-# INLINABLE applyBifold #-}
+
+    bindFold :: (Monad f, Foldable g) => f a -> (a -> f (g b)) -> f b
+    bindFold f = compactFold . (f >>=)
+    {-# INLINABLE bindFold #-}
+
+    bindBifold :: (Monad f, Bifoldable g) => f a -> (a -> f (g l r)) -> (f l, f r)
+    bindBifold f = separateFold . (f >>=)
+    {-# INLINABLE bindBifold  #-}
+
+    traverseFold :: (Applicative h, Foldable g, Traversable f) => (a -> h (g b)) -> f a -> h (f b)
+    traverseFold f = fmap compactFold . traverse f
+    {-# INLINABLE traverseFold #-}
+
+    traverseBifold :: (Applicative h, Bifoldable g, Traversable f) => (a -> h (g l r)) -> f a -> h (f l, f r)
+    traverseBifold f = fmap separateFold . traverse f
+    {-# INLINABLE traverseBifold #-}
+
+
+mfold' :: (Foldable f, MonadPlus m) => f a -> m a
+mfold' = unMonadSum . foldMap (MonadSum . pure)
+
+mlefts :: (Bifoldable f, MonadPlus m) => f a b -> m a
+mlefts = unMonadSum . bifoldMap (MonadSum . pure) (const mempty)
+
+mrights :: (Bifoldable f, MonadPlus m) => f a b -> m b
+mrights = unMonadSum . bifoldMap (const mempty) (MonadSum . pure)
+
+
+instance CompactFold [] where
+    compactFold = concat . fmap F.toList
+    {-# INLINEABLE compactFold #-}
+
+instance CompactFold Maybe
+instance CompactFold ReadP
+instance CompactFold ReadPrec
+instance CompactFold STM
+instance (ArrowApply a, ArrowPlus a) => CompactFold (ArrowMonad a)
 
 
 fforMaybe :: (Compactable f, Functor f) => f a -> (a -> Maybe b) -> f b