compactable 0.1.0.4 → 0.1.1.0

raw patch · 2 files changed

+94/−8 lines, 2 filesdep +bifunctorsPVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctors

API changes (from Hackage documentation)

Files

• compactable.cabal +2/−1
• src/Control/Compactable.hs +92/−7

@@ -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

@@ -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