summaryrefslogtreecommitdiff log msg author committer range
path: root/Data/Filtrable.hs
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142  module Data.Filtrable ( Filtrable (..) , (<$?>), (<*?>) , nub, nubBy, nubOrd, nubOrdBy ) where import Prelude hiding (filter) import Control.Applicative import Control.Applicative.Backwards import Control.Monad import qualified Control.Monad.Trans.State as M import Data.Bool (bool) import Data.Functor.Compose import Data.Functor.Product import Data.Functor.Reverse import Data.Functor.Sum import Data.Proxy import Data.Traversable import qualified Data.Set.Private as Set -- | Class of filtrable containers, i.e. containers we can map over while selectively dropping elements. -- -- Laws: -- -- * @'mapMaybe' 'Just' = id@ -- -- * @'mapMaybe' f = 'catMaybes' ∘ 'fmap' f@ -- -- * @'catMaybes' = 'mapMaybe' id@ -- -- * @'filter' f = 'mapMaybe' (\\ x -> 'bool' 'Nothing' ('Just' x) (f x))@ -- -- * @'mapMaybe' g . 'mapMaybe' f = 'mapMaybe' (g '<=<' f)@ -- -- Laws if @'Foldable' f@: -- -- * @'foldMap' g . 'filter' f = 'foldMap' (\\ x -> 'bool' 'mempty' (g x) (f x))@ class Functor f => Filtrable f where {-# MINIMAL mapMaybe | catMaybes #-} -- | Map the container with the given function, dropping the elements for which it returns 'Nothing'. mapMaybe :: (a -> Maybe b) -> f a -> f b mapMaybe f = catMaybes . fmap f -- | @'catMaybes' = 'mapMaybe' 'id'@ catMaybes :: f (Maybe a) -> f a catMaybes = mapMaybe id -- | Drop the elements for which the given predicate is 'False'. filter :: (a -> Bool) -> f a -> f a filter f = mapMaybe ((<$) <*> guard . f) -- | Traverse the container with the given function, dropping the elements for which it returns 'Nothing'. mapMaybeA :: (Traversable f, Applicative p) => (a -> p (Maybe b)) -> f a -> p (f b) mapMaybeA f xs = catMaybes <$> traverse f xs -- | Drop the elements for which the given predicate is 'False'. filterA :: (Traversable f, Applicative p) => (a -> p Bool) -> f a -> p (f a) filterA f = mapMaybeA (\ x -> (x <$) . guard <$> f x) -- | Map the container with the given function, collecting the 'Left's and the 'Right's separately. mapEither :: (a -> Either b c) -> f a -> (f b, f c) mapEither f = (,) <$> mapMaybe (either Just (pure Nothing) . f) <*> mapMaybe (either (pure Nothing) Just . f) -- | Traverse the container with the given function, collecting the 'Left's and the 'Right's separately. mapEitherA :: (Traversable f, Applicative p) => (a -> p (Either b c)) -> f a -> p (f b, f c) mapEitherA f = liftA2 (,) <$> mapMaybeA (fmap (Just either pure Nothing) . f) <*> mapMaybeA (fmap (pure Nothing either Just) . f) -- | @'partitionEithers' = 'mapEither' 'id'@ partitionEithers :: f (Either a b) -> (f a, f b) partitionEithers = mapEither id instance Filtrable [] where mapMaybe f = foldr (maybe id (:) . f) [] mapMaybeA _ [] = pure [] mapMaybeA f (x:xs) = maybe id (:) <$> f x <*> mapMaybeA f xs instance Filtrable Maybe where mapMaybe = (=<<) catMaybes = join instance Filtrable Proxy where mapMaybe _ Proxy = Proxy instance Filtrable (Const a) where mapMaybe _ (Const x) = Const x instance (Filtrable f, Filtrable g) => Filtrable (Product f g) where mapMaybe f (Pair as bs) = Pair (mapMaybe f as) (mapMaybe f bs) instance (Filtrable f, Filtrable g) => Filtrable (Sum f g) where mapMaybe f = \ case InL as -> InL (mapMaybe f as) InR bs -> InR (mapMaybe f bs) instance (Functor f, Filtrable g) => Filtrable (Compose f g) where mapMaybe f = Compose . (fmap . mapMaybe) f . getCompose instance Filtrable f => Filtrable (Backwards f) where mapMaybe f = Backwards . mapMaybe f . forwards instance Filtrable f => Filtrable (Reverse f) where mapMaybe f = Reverse . mapMaybe f . getReverse infixl 4 <$?>, <*?> (<$?>) :: Filtrable f => (a -> Maybe b) -> f a -> f b (<$?>) = mapMaybe (<*?>) :: (Applicative p, Filtrable p) => p (a -> Maybe b) -> p a -> p b f <*?> a = catMaybes (f <*> a) -- | $$\mathcal{O}(n^2)$$ -- Delete all but the first copy of each element, special case of 'nubBy'. nub :: (Filtrable f, Traversable f, Eq a) => f a -> f a nub = nubBy (==) -- | $$\mathcal{O}(n^2)$$ -- Delete all but the first copy of each element, with the given relation. nubBy :: (Filtrable f, Traversable f) => (a -> a -> Bool) -> f a -> f a nubBy eq = fmap (flip M.evalState []) . filterA$ \ a -> do as <- M.get let b = all (not . eq a) as b <$when b (M.modify (a:)) -- | $$\mathcal{O}(n\;\mathrm{log}\;n)$$ -- Delete all but the first copy of each element, special case of 'nubOrdBy'. nubOrd :: (Filtrable f, Traversable f, Ord a) => f a -> f a nubOrd = nubOrdBy compare -- | $$\mathcal{O}(n\;\mathrm{log}\;n)$$ -- Delete all but the first copy of each element, with the given relation. nubOrdBy :: (Filtrable f, Traversable f) => (a -> a -> Ordering) -> f a -> f a nubOrdBy compare = fmap (flip M.evalState Set.empty) . filterA$ \ a -> M.state \$ \ as -> case Set.insertBy' compare a as of Nothing -> (False, as) Just as' -> (True, as')