#if __GLASGOW_HASKELL__ >= 702
#endif
module Data.Witherable (Witherable(..)
, witherM
, blightM
, ordNub
, hashNub
, forMaybe
, FilterLike, Filter, FilterLike', Filter'
, witherOf
, forMaybeOf
, mapMaybeOf
, catMaybesOf
, filterAOf
, filterOf
, ordNubOf
, hashNubOf
, cloneFilter
, Peat(..)
, Chipped(..)
)
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 qualified Data.Set as Set
import qualified Data.HashSet as HSet
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 Control.Monad.Trans.State.Strict
import Data.Monoid
import Data.Orphans ()
#if (MIN_VERSION_base(4,7,0))
import Data.Proxy
#endif
import Prelude
type FilterLike f s t a b = (a -> f (Maybe b)) -> s -> f t
type Filter s t a b = forall f. Applicative f => FilterLike f s t a b
type FilterLike' f s a = FilterLike f s s a a
type Filter' s a = forall f. Applicative f => FilterLike' f s a
newtype Peat a b t = Peat { runPeat :: forall f. Applicative f => (a -> f (Maybe b)) -> f t }
instance Functor (Peat a b) where
fmap f (Peat k) = Peat (fmap f . k)
instance Applicative (Peat a b) where
pure a = Peat $ const (pure a)
Peat f <*> Peat g = Peat $ \h -> f h <*> g h
cloneFilter :: FilterLike (Peat a b) s t a b -> Filter s t a b
cloneFilter l f = (`runPeat` f) . l (\a -> Peat $ \g -> g a)
witherOf :: FilterLike f s t a b -> (a -> f (Maybe b)) -> s -> f t
witherOf = id
forMaybeOf :: FilterLike f s t a b -> s -> (a -> f (Maybe b)) -> f t
forMaybeOf = flip
mapMaybeOf :: FilterLike Identity s t a b -> (a -> Maybe b) -> s -> t
mapMaybeOf w f = runIdentity . w (Identity . f)
catMaybesOf :: FilterLike Identity s t (Maybe a) a -> s -> t
catMaybesOf w = mapMaybeOf w id
filterAOf :: Functor f => FilterLike' f s a -> (a -> f Bool) -> s -> f s
filterAOf w f = w $ \a -> (\b -> if b then Just a else Nothing) <$> f a
filterOf :: FilterLike' Identity s a -> (a -> Bool) -> s -> s
filterOf w f = runIdentity . filterAOf w (Identity . f)
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 = mapMaybeOf wither
catMaybes :: t (Maybe a) -> t a
catMaybes = mapMaybe id
filterA :: Applicative f => (a -> f Bool) -> t a -> f (t a)
filterA = filterAOf wither
filter :: (a -> Bool) -> t a -> t a
filter = filterOf wither
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707
#endif
forMaybe :: (Witherable t, Applicative f) => t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe = flip wither
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
ordNubOf :: Ord a => FilterLike' (State (Set.Set a)) s a -> s -> s
ordNubOf w t = evalState (w f t) Set.empty
where
f a = state $ \s -> if Set.member a s
then (Nothing, s)
else (Just a, Set.insert a s)
hashNubOf :: (Eq a, Hashable a) => FilterLike' (State (HSet.HashSet a)) s a -> s -> s
hashNubOf w t = evalState (w f t) HSet.empty
where
f a = state $ \s -> if HSet.member a s
then (Nothing, s)
else (Just a, HSet.insert a s)
ordNub :: (Witherable t, Ord a) => t a -> t a
ordNub = ordNubOf wither
hashNub :: (Witherable t, Eq a, Hashable a) => t a -> t a
hashNub = hashNubOf wither
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 = go where
go (x:xs) = maybe id (:) <$> f x <*> go xs
go [] = pure []
mapMaybe = Maybe.mapMaybe
catMaybes = Maybe.catMaybes
filter = Prelude.filter
instance Witherable IM.IntMap where
mapMaybe = IM.mapMaybe
filter = IM.filter
instance Ord k => Witherable (M.Map k) where
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
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
newtype Chipped t a = Chipped { getChipped :: t (Maybe a) } deriving (Functor, F.Foldable, T.Traversable)
deriving instance Show (t (Maybe a)) => Show (Chipped t a)
deriving instance Read (t (Maybe a)) => Read (Chipped t a)
deriving instance Eq (t (Maybe a)) => Eq (Chipped t a)
deriving instance Ord (t (Maybe a)) => Ord (Chipped t a)
instance Applicative t => Applicative (Chipped t) where
pure a = Chipped (pure (pure a))
Chipped f <*> Chipped t = Chipped (liftA2 (<*>) f t)
instance T.Traversable t => Witherable (Chipped t) where
wither f = fmap Chipped . T.traverse (wither f) . getChipped