module Data.Witherable where
import qualified Data.Maybe as Maybe
import qualified Data.IntMap.Lazy as IM
import qualified Data.Map.Lazy as M
import qualified Data.Sequence as S
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HM
import Control.Applicative
import qualified Data.Traversable as T
import qualified Data.Foldable as F
import Data.Hashable
import Data.Functor.Identity
import Control.Monad.Trans.Maybe
import Data.Monoid
#if (MIN_VERSION_base(4,7,0))
import Data.Proxy
#endif
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
mapMaybe :: (a -> Maybe b) -> t a -> t b
mapMaybe f = runIdentity . wither (Identity . f)
catMaybes :: t (Maybe a) -> t a
catMaybes = mapMaybe id
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 :: (Monad m, Witherable t) => t a -> (a -> MaybeT m b) -> m (t b)
blightM = flip witherM
instance Witherable Maybe where
wither _ Nothing = pure Nothing
wither f (Just a) = f a
instance Monoid e => Witherable (Either e) where
wither _ (Left e) = pure (Left e)
wither f (Right a) = fmap (maybe (Left mempty) Right) (f a)
instance Witherable [] where
wither f = fmap Maybe.catMaybes . T.traverse f
catMaybes = Maybe.catMaybes
filter = Prelude.filter
instance Witherable IM.IntMap where
wither f = fmap IM.fromAscList . wither (\(i, a) -> fmap ((,) i) <$> f a) . IM.toList
mapMaybe = IM.mapMaybe
filter = IM.filter
instance Ord k => Witherable (M.Map k) where
wither f = fmap M.fromAscList . wither (\(i, a) -> fmap ((,) i) <$> f a) . M.toList
mapMaybe = M.mapMaybe
filter = M.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
filter = HM.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)
instance Witherable V.Vector where
wither f = fmap V.fromList . wither f . V.toList
filter = V.filter
instance Witherable S.Seq where
wither f = fmap S.fromList . wither f . F.toList
filter = S.filter