witherable 0.1.1.1 → 0.1.2

raw patch · 2 files changed

+90/−14 lines, 2 files

Files

src/Data/Witherable.hs +83/−7
witherable.cabal +7/−7

src/Data/Witherable.hs view

@@ -1,4 +1,16 @@ {-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Witherable
+-- Copyright   :  (c) Fumiaki Kinoshita 2015
+-- License     :  BSD3
+--
+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- This module generalizes filterable containers.
+-----------------------------------------------------------------------------
 module Data.Witherable where
 import qualified Data.Maybe as Maybe
 import qualified Data.IntMap.Lazy as IM
@@ -13,21 +25,45 @@ import Data.Functor.Identity
 import Control.Monad.Trans.Maybe
 import Data.Monoid
+#if (MIN_VERSION_base(4,7,0))
+import Data.Proxy
+#endif
 
 -- | Like `traverse`, but you can remove elements instead of updating them.
--- @traverse f = wither (fmap Just . f)@
+--
+-- @traverse f ≡ wither (fmap Just . f)@
+--
+-- A definition of 'wither' must satisfy the following laws:
+--
+-- [/identity/]
+--   @wither (pure . Just) ≡ pure@
+--
+-- [/composition/]
+--   @Compose . fmap (wither f) . wither g ≡ wither (Compose . fmap (maybe (pure Nothing) f) . g)@
+--
+-- Parametricity implies the naturality law:
+--
+-- @t . wither f = wither (t . f)@
+--
 -- Minimal complete definition: `wither` or `catMaybes`.
+-- The default definitions can be overriden for efficiency.
 class T.Traversable t => Witherable t where
 
   wither :: Applicative f => (a -> f (Maybe b)) -> t a -> f (t b)
   wither f = fmap catMaybes . T.traverse f
 
-  catMaybes :: Witherable t => t (Maybe a) -> t a
+  catMaybes :: t (Maybe a) -> t a
   catMaybes = runIdentity . wither pure
 
-  witherM :: Monad m => (a -> MaybeT m b) -> t a -> m (t b)
-  witherM f = unwrapMonad . wither (WrapMonad . runMaybeT . f)
+  filterA :: Applicative f => (a -> f Bool) -> t a -> f (t a)
+  filterA f = wither (\a -> (\b -> if b then Just a else Nothing) <$> f a)
 
+  filter :: (a -> Bool) -> t a -> t a
+  filter f = runIdentity . filterA (Identity . f)
+
+witherM :: (Witherable t, Monad m) => (a -> MaybeT m b) -> t a -> m (t b)
+witherM f = unwrapMonad . wither (WrapMonad . runMaybeT . f)
+
 -- | 'blightM' is 'witherM' with its arguments flipped.
 blightM :: (Monad m, Witherable t) => t a -> (a -> MaybeT m b) -> m (t b)
 blightM = flip witherM
@@ -36,32 +72,72 @@ instance Witherable Maybe where
   wither _ Nothing = pure Nothing
   wither f (Just a) = f a
+  {-# INLINABLE wither #-}
 
+instance Monoid e => Witherable (Either e) where
+  wither _ (Left e) = pure (Left e)
+  wither f (Right a) = fmap (maybe (Left mempty) Right) (f a)
+  {-# INLINABLE wither #-}
+
 instance Witherable [] where
   wither f = fmap Maybe.catMaybes . T.traverse f
+  {-# INLINABLE wither #-}
+  catMaybes = Maybe.catMaybes
+  {-# INLINABLE catMaybes #-}
+  filter = Prelude.filter
+  {-# INLINABLE filter #-}
 
 instance Witherable IM.IntMap where
-  wither f = fmap IM.fromList . wither (\(i, a) -> fmap ((,) i) <$> f a) . IM.toList
+  wither f = fmap IM.fromAscList . wither (\(i, a) -> fmap ((,) i) <$> f a) . IM.toList
+  {-# INLINABLE wither #-}
+  filter = IM.filter
+  {-# INLINABLE filter #-}
 
 instance Ord k => Witherable (M.Map k) where
-  wither f = fmap M.fromList . wither (\(i, a) -> fmap ((,) i) <$> f a) . M.toList
+  wither f = fmap M.fromAscList . wither (\(i, a) -> fmap ((,) i) <$> f a) . M.toList
+  {-# INLINABLE wither #-}
+  filter = M.filter
+  {-# INLINABLE filter #-}
 
 instance (Eq k, Hashable k) => Witherable (HM.HashMap k) where
   wither f = fmap HM.fromList . wither (\(i, a) -> fmap ((,) i) <$> f a) . HM.toList
+  {-# INLINABLE wither #-}
+  filter = HM.filter
+  {-# INLINABLE filter #-}
 
+#if (MIN_VERSION_base(4,7,0))
+instance Witherable Proxy where
+  wither _ Proxy = pure Proxy
+#endif
+
 #if !(MIN_VERSION_base(4,7,0))
 instance F.Foldable (Const r) where
   foldMap _ _ = mempty
 
 instance T.Traversable (Const r) where
   traverse _ (Const r) = pure (Const r)
+
+instance F.Foldable (Either a) where
+  foldMap _ (Left _) = mempty
+  foldMap f (Right a) = f a
+
+instance T.Traversable (Either a) where
+  traverse _ (Left x) = pure (Left x)
+  traverse f (Right y) = Right <$> f y
 #endif
 
 instance Witherable (Const r) where
   wither _ (Const r) = pure (Const r)
+  {-# INLINABLE wither #-}
 
 instance Witherable V.Vector where
   wither f = fmap V.fromList . wither f . V.toList
+  {-# INLINABLE wither #-}
+  filter = V.filter
+  {-# INLINABLE filter #-}
 
 instance Witherable S.Seq where
-  wither f = fmap S.fromList . wither f . F.toList+  wither f = fmap S.fromList . wither f . F.toList
+  {-# INLINABLE wither #-}
+  filter = S.filter
+  {-# INLINABLE filter #-}

witherable.cabal view

@@ -1,7 +1,7 @@ name:                witherable
-version:             0.1.1.1
-synopsis:            Generalization of catMaybes
--- description:         
+version:             0.1.2
+synopsis:            Generalization of filter and catMaybes
+-- description:
 homepage:            https://github.com/fumieval/witherable
 license:             BSD3
 license-file:        LICENSE
@@ -10,13 +10,13 @@ copyright:           Copyright (c) 2014 Fumiaki Kinoshita
 category:            Data
 build-type:          Simple
--- extra-source-files:  
+-- extra-source-files:
 cabal-version:       >=1.10
 
 library
   exposed-modules:     Data.Witherable
-  -- other-modules:       
-  -- other-extensions:    
+  -- other-modules:
+  -- other-extensions:
   build-depends:       base == 4.*, containers, vector, unordered-containers, hashable, transformers
   hs-source-dirs:      src
-  default-language:    Haskell2010+  default-language:    Haskell2010