witherable-0.4.2/0000755000000000000000000000000007346545000012034 5ustar0000000000000000witherable-0.4.2/CHANGELOG.md0000644000000000000000000000474007346545000013652 0ustar00000000000000000.4.2 ------- * Supported GHC 9.2 * Improved the instances for `vector` 0.4.1 ------- * Added `ordNubBy`, `hashNubBy`, `ordNubByOf`, and `hashNubByOf`. * Use `alterF` for nub-function implementations * Implement `witherM` in `Witherable Vector` instance. * Mark modules as Trustworthy * `ordNub` and `hashNub` are productive, start to produce results immediately and work for infinite lists. 0.4 ------- * `FilterableWithIndex` and `WitherableWithIndex` are now subclasses of the ones from [indexed-traversable](https://hackage.haskell.org/package/indexed-traversable) * Removed the orphan instances for `MonoidalMap` 0.3.5 ------- * Make `wither` and `witherM` methods of `Witherable []` instance good consumers for list fusion. * Added instances for `Reverse`, `Backwards`, `ZipList`, and types from `GHC.Generics` * Added `Wither`, `WitherLike`, `Wither'` and `WitherLike'`, deprecating `Filter` and the variants * Moved `Filterable` and `Witherable` into a separate package, `witherable-class` 0.3.4 ------- * Exported `WrappedFoldable` 0.3.3 ------- * Added `FilterableWithIndex` and `WitherableWithIndex`. * Added `WrappedFoldable` 0.3.2 ---------- * Added `Filterable (MonoidalMap k)` and `Witherable (MonoidalMap k)` 0.3.1 ------- * Added `(<$?>)` as an alias for `mapMaybe`, with fixity matching `(<$>)`. * Added `(<&?>) = flip (<$?>)`, with fixity matching `(<&>)`. 0.3 ------- * Added `(Filterable f, Filterable g) => Filterable (Product f g)` * Added `(Witherable f, Witherable g) => Witherable (Product f g)` * Added `(Filterable f, Filterable g) => Filterable (Sum f g)` * Added `(Witherable f, Witherable g) => Witherable (Sum f g)` * Added `Filterable f => Filterable (IdentityT f)` * Added `Witherable f => Witherable (IdentityT f)` * Switched from strict `HashMap` operations to lazy ones. This matches the behavior of the rest of the instances. * Changed the definition of `witherM` 0.2 ------- * Added `Traversable t => Witherable (MaybeT t)` * New class: `Filterable` * `Witherable t` is equivalent to `(Traversable t, Filterable t)` * Removed `Chipped` 0.1.3.3 ------- * Added `forMaybeOf` and `forMaybe` 0.1.3.2 ------- * Exported `witherM`, `blightM` * Fixed the default definition of `catMaybes` 0.1.3 ------- * Now `witherable` depends on `base-orphans` to prevent a tragedy of duplicate orphans * Added generalized combinators according to the `lens` convention 0.1.2.3 ------- * Added `ordNub`, `hashNub` * Data.Witherable is now Trustworthy 0.1.2.2 ------- * Added `Chipped` witherable-0.4.2/LICENSE0000644000000000000000000000277407346545000013053 0ustar0000000000000000Copyright (c) 2014, Fumiaki Kinoshita All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Fumiaki Kinoshita nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. witherable-0.4.2/Setup.hs0000644000000000000000000000005607346545000013471 0ustar0000000000000000import Distribution.Simple main = defaultMain witherable-0.4.2/src/Data/0000755000000000000000000000000007346545000013474 5ustar0000000000000000witherable-0.4.2/src/Data/Witherable.hs0000644000000000000000000001245507346545000016125 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Witherable -- Copyright : (c) Fumiaki Kinoshita 2015 -- License : BSD3 -- -- Maintainer : Fumiaki Kinoshita -- Stability : provisional -- Portability : non-portable -- ----------------------------------------------------------------------------- module Data.Witherable {-# DEPRECATED "Use Witherable instead" #-} ( Filterable(..) , (<$?>) , (<&?>) , Witherable(..) , ordNub , ordNubOn , hashNub , hashNubOn , forMaybe -- * Indexed variants , FilterableWithIndex(..) , WitherableWithIndex(..) -- * Generalization , WitherLike, Wither, WitherLike', Wither' , FilterLike, Filter, FilterLike', Filter' , witherOf , forMaybeOf , mapMaybeOf , catMaybesOf , filterAOf , filterOf , ordNubOf , ordNubOnOf , hashNubOf , hashNubOnOf -- * Cloning , cloneFilter , Peat(..) -- * Wrapper , WrappedFoldable(..) ) where import Control.Applicative import Data.Functor.Identity import Witherable import qualified Data.Set as Set import qualified Data.HashSet as HSet import Control.Monad.Trans.State.Strict import Data.Hashable import Data.Coerce type Filter s t a b = Wither s t a b {-# DEPRECATED Filter "Use Wither instead" #-} type FilterLike f s t a b = WitherLike f s t a b {-# DEPRECATED FilterLike "Use WitherLike instead" #-} type Filter' s a = Wither' s a {-# DEPRECATED Filter' "Use Filter' instead" #-} type FilterLike' f s a = WitherLike' f s a {-# DEPRECATED FilterLike' "Use WitherLike' instead" #-} -- | This type allows combinators to take a 'Filter' specializing the parameter @f@. type WitherLike f s t a b = (a -> f (Maybe b)) -> s -> f t -- | A 'Wither' is like a , -- but you can also remove targets. type Wither s t a b = forall f. Applicative f => WitherLike f s t a b -- | A simple 'WitherLike'. type WitherLike' f s a = WitherLike f s s a a -- | A simple 'Wither'. type Wither' s a = forall f. Applicative f => WitherLike' f s a -- | This is used to characterize and clone a 'Filter'. -- Since @FilterLike (Peat a b) s t a b@ is monomorphic, it can be used to store a filter in a container. 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) {-# INLINE fmap #-} instance Applicative (Peat a b) where pure a = Peat $ const (pure a) {-# INLINE pure #-} Peat f <*> Peat g = Peat $ \h -> f h <*> g h {-# INLINE (<*>) #-} #if MIN_VERSION_base(4,10,0) liftA2 f (Peat xs) (Peat ys) = Peat $ \h -> liftA2 f (xs h) (ys h) {-# INLINE liftA2 #-} #endif -- | Reconstitute a 'Filter' from its monomorphic form. cloneFilter :: FilterLike (Peat a b) s t a b -> Filter s t a b cloneFilter l f = (\a -> a `runPeat` f) . l (\a -> Peat $ \g -> g a) {-# INLINABLE cloneFilter #-} -- | 'witherOf' is actually 'id', but left for consistency. witherOf :: FilterLike f s t a b -> (a -> f (Maybe b)) -> s -> f t witherOf = id {-# INLINE witherOf #-} -- | @'forMaybeOf' ≡ 'flip'@ forMaybeOf :: FilterLike f s t a b -> s -> (a -> f (Maybe b)) -> f t forMaybeOf = flip {-# INLINE forMaybeOf #-} -- In case mapMaybeOf or filterOf is called with a function of -- unknown arity, we don't want to slow things down to raise -- its arity. idDot :: (a -> b) -> a -> Identity b idDot = coerce -- | 'mapMaybe' through a filter. mapMaybeOf :: FilterLike Identity s t a b -> (a -> Maybe b) -> s -> t mapMaybeOf w f = runIdentity . w (idDot f) {-# INLINE mapMaybeOf #-} -- | 'catMaybes' through a filter. catMaybesOf :: FilterLike Identity s t (Maybe a) a -> s -> t catMaybesOf w = mapMaybeOf w id {-# INLINE catMaybesOf #-} -- | 'filterA' through a filter. 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 {-# INLINABLE filterAOf #-} -- | Filter each element of a structure targeted by a 'Filter'. filterOf :: FilterLike' Identity s a -> (a -> Bool) -> s -> s filterOf w f = runIdentity . filterAOf w (idDot f) {-# INLINE filterOf #-} -- | Remove the duplicate elements through a filter. ordNubOf :: Ord a => FilterLike' (State (Set.Set a)) s a -> s -> s ordNubOf w = ordNubOnOf w id -- | Remove the duplicate elements through a filter. ordNubOnOf :: Ord b => FilterLike' (State (Set.Set b)) s a -> (a -> b) -> s -> s ordNubOnOf w p t = evalState (w f t) Set.empty where f a = let b = p a in state $ \s -> if Set.member b s then (Nothing, s) else (Just a, Set.insert b s) {-# INLINE ordNubOf #-} -- | Remove the duplicate elements through a filter. -- It is often faster than 'ordNubOf', especially when the comparison is expensive. hashNubOf :: (Eq a, Hashable a) => FilterLike' (State (HSet.HashSet a)) s a -> s -> s hashNubOf w = hashNubOnOf w id -- | Remove the duplicate elements through a filter. hashNubOnOf :: (Eq b, Hashable b) => FilterLike' (State (HSet.HashSet b)) s a -> (a -> b) -> s -> s hashNubOnOf w p t = evalState (w f t) HSet.empty where f a = let b = p a in state $ \s -> if HSet.member b s then (Nothing, s) else (Just a, HSet.insert b s) {-# INLINE hashNubOf #-} witherable-0.4.2/src/0000755000000000000000000000000007346545000012623 5ustar0000000000000000witherable-0.4.2/src/Witherable.hs0000644000000000000000000006304007346545000015250 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} {-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances, FlexibleContexts, GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | -- Module : Witherable -- Copyright : (c) Fumiaki Kinoshita 2020 -- License : BSD3 -- -- Maintainer : Fumiaki Kinoshita -- Stability : provisional -- Portability : non-portable -- ----------------------------------------------------------------------------- module Witherable ( Filterable(..) , (<$?>) , (<&?>) , Witherable(..) , ordNub , ordNubOn , hashNub , hashNubOn , forMaybe -- * Indexed variants , FilterableWithIndex(..) , WitherableWithIndex(..) -- * Wrapper , WrappedFoldable(..) ) where import Control.Applicative import Control.Applicative.Backwards (Backwards (..)) import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Control.Monad.Trans.State.Lazy (evalState, state) import Data.Bool (bool) import Data.Coerce (coerce) import Data.Foldable.WithIndex import Data.Functor.Compose import Data.Functor.Product as P import Data.Functor.Reverse (Reverse (..)) import Data.Functor.Sum as Sum import Data.Functor.WithIndex import Data.Functor.WithIndex.Instances () import Data.Hashable import Data.Monoid import Data.Orphans () import Data.Proxy #if !MIN_VERSION_base(4,16,0) import Data.Semigroup (Option (..)) #endif import Data.Traversable.WithIndex import Data.Void import Prelude hiding (filter) import qualified Data.Foldable as F import qualified Data.HashMap.Lazy as HM import qualified Data.HashSet as HSet import qualified Data.IntMap.Lazy as IM import qualified Data.Map.Lazy as M import qualified Data.Maybe as Maybe import qualified Data.Sequence as S import qualified Data.Set as Set import qualified Data.Traversable as T import qualified Data.Vector as V import qualified GHC.Generics as Generics import qualified Prelude -- | Like 'Functor', but you can remove elements instead of updating them. -- -- Formally, the class 'Filterable' represents a functor from @Kleisli Maybe@ to @Hask@. -- -- A definition of 'mapMaybe' must satisfy the following laws: -- -- [/conservation/] -- @'mapMaybe' (Just . f) ≡ 'fmap' f@ -- -- [/composition/] -- @'mapMaybe' f . 'mapMaybe' g ≡ 'mapMaybe' (f <=< g)@ class Functor f => Filterable f where -- | Like 'Maybe.mapMaybe'. mapMaybe :: (a -> Maybe b) -> f a -> f b mapMaybe f = catMaybes . fmap f {-# INLINE mapMaybe #-} -- | @'catMaybes' ≡ 'mapMaybe' 'id'@ catMaybes :: f (Maybe a) -> f a catMaybes = mapMaybe id {-# INLINE catMaybes #-} -- | @'filter' f . 'filter' g ≡ filter ('liftA2' ('&&') g f)@ filter :: (a -> Bool) -> f a -> f a filter f = mapMaybe $ \a -> if f a then Just a else Nothing {-# INLINE filter #-} {-# MINIMAL mapMaybe | catMaybes #-} -- | An enhancement of 'Traversable' with 'Filterable' -- -- A definition of 'wither' must satisfy the following laws: -- -- [/identity/] -- @'wither' ('Data.Functor.Identity' . Just) ≡ 'Data.Functor.Identity'@ -- -- [/composition/] -- @'Compose' . 'fmap' ('wither' f) . 'wither' g ≡ 'wither' ('Compose' . 'fmap' ('wither' f) . g)@ -- -- Parametricity implies the naturality law: -- -- [/naturality/] -- @t . 'wither' f ≡ 'wither' (t . f)@ -- -- Where @t@ is an //applicative transformation// in the sense described in the -- 'Traversable' documentation. -- -- In the relation to superclasses, these should satisfy too: -- -- [/conservation/] -- @'wither' ('fmap' Just . f) = 'T.traverse' f@ -- -- [/pure filter/] -- @'wither' ('Data.Functor.Identity' . f) = 'Data.Functor.Identity' . 'mapMaybe' f@ -- -- See the @Properties.md@ and @Laws.md@ files in the git distribution for more -- in-depth explanation about properties of @Witherable@ containers. -- -- The laws and restrictions are enough to -- constrain @'wither'@ to be uniquely determined as the following default implementation. -- -- @wither f = fmap 'catMaybes' . 'T.traverse' f@ -- -- If not to provide better-performing implementation, -- it's not necessary to implement any one method of -- @Witherable@. For example, if a type constructor @T@ -- already has instances of 'T.Traversable' and 'Filterable', -- the next one line is sufficient to provide the @Witherable T@ instance. -- -- > instance Witherable T class (T.Traversable t, Filterable t) => Witherable t where -- | Effectful 'mapMaybe'. -- -- @'wither' ('pure' . f) ≡ 'pure' . 'mapMaybe' f@ -- wither :: Applicative f => (a -> f (Maybe b)) -> t a -> f (t b) wither f = fmap catMaybes . T.traverse f {-# INLINE wither #-} -- | @Monadic variant of 'wither'. This may have more efficient implementation.@ witherM :: Monad m => (a -> m (Maybe b)) -> t a -> m (t b) witherM = wither 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 witherMap :: (Applicative m) => (t b -> r) -> (a -> m (Maybe b)) -> t a -> m r witherMap p f = fmap p . wither f {-# INLINE witherMap #-} {-# MINIMAL #-} instance Filterable Maybe where mapMaybe f = (>>= f) {-# INLINE mapMaybe #-} instance Witherable Maybe where wither _ Nothing = pure Nothing wither f (Just a) = f a {-# INLINABLE wither #-} #if !MIN_VERSION_base(4,16,0) instance Filterable Option where mapMaybe f = (>>= Option . f) {-# INLINE mapMaybe #-} instance Witherable Option where wither f (Option x) = Option <$> wither f x {-# INLINE wither #-} -- Option doesn't have the necessary instances in Lens --instance FilterableWithIndex () Option --instance WitherableWithIndex () Option #endif instance Monoid e => Filterable (Either e) where mapMaybe _ (Left e) = Left e mapMaybe f (Right a) = maybe (Left mempty) Right $ f a {-# INLINABLE mapMaybe #-} 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 Filterable [] where mapMaybe = Maybe.mapMaybe catMaybes = Maybe.catMaybes filter = Prelude.filter instance Filterable ZipList where mapMaybe f = ZipList . Maybe.mapMaybe f . getZipList catMaybes = ZipList . Maybe.catMaybes . getZipList filter f = ZipList . Prelude.filter f . getZipList -- | Methods are good consumers for fusion. instance Witherable [] where wither f = foldr go (pure []) where go x r = liftA2 (maybe id (:)) (f x) r {-# INLINE wither #-} witherM f = foldr go (pure []) where go x r = f x >>= (\z -> case z of Nothing -> r Just y -> ((:) y) <$> r ) {-# INLINE witherM #-} -- Compared to the default, this fuses an fmap into a liftA2. filterA p = go where go (x:xs) = liftA2 (bool id (x :)) (p x) (go xs) go [] = pure [] instance Witherable ZipList where wither f = fmap ZipList . wither f . getZipList instance Filterable IM.IntMap where mapMaybe = IM.mapMaybe filter = IM.filter instance Witherable IM.IntMap where instance Filterable (M.Map k) where mapMaybe = M.mapMaybe filter = M.filter instance Witherable (M.Map k) where #if MIN_VERSION_containers(0,5,8) wither f = M.traverseMaybeWithKey (const f) #endif instance (Eq k, Hashable k) => Filterable (HM.HashMap k) where mapMaybe = HM.mapMaybe filter = HM.filter instance (Eq k, Hashable k) => Witherable (HM.HashMap k) where instance Filterable Proxy where mapMaybe _ Proxy = Proxy instance Witherable Proxy where wither _ Proxy = pure Proxy instance Filterable (Const r) where mapMaybe _ (Const r) = Const r {-# INLINABLE mapMaybe #-} instance Witherable (Const r) where wither _ (Const r) = pure (Const r) {-# INLINABLE wither #-} instance Filterable V.Vector where filter = V.filter mapMaybe = V.mapMaybe instance Witherable V.Vector where wither f = fmap V.fromList . wither f . V.toList {-# INLINABLE wither #-} witherM = V.mapMaybeM {-# INLINE witherM #-} instance Filterable S.Seq where mapMaybe f = S.fromList . mapMaybe f . F.toList {-# INLINABLE mapMaybe #-} filter = S.filter instance Witherable S.Seq where wither f = fmap S.fromList . wither f . F.toList {-# INLINABLE wither #-} {- -- TODO: try to figure out whether the following is better or worse for -- typical applications. It builds the sequence incrementally rather than -- building a list and converting. This is basically the same approach -- currently used by Data.Sequence.filter. witherM f = F.foldlM go S.empty where --go :: S.Seq b -> a -> m (S.Seq b) go s a = do mb <- f a case mb of Nothing -> pure s Just b -> pure $! s S.|> b {-# INLINABLE witherM #-} -} -- The instances for Compose, Product, and Sum are not entirely -- unique. Any particular composition, product, or sum of functors -- may support a variety of 'wither' implementations. instance (Functor f, Filterable g) => Filterable (Compose f g) where mapMaybe f = Compose . fmap (mapMaybe f) . getCompose filter p = Compose . fmap (filter p) . getCompose catMaybes = Compose . fmap catMaybes . getCompose instance (T.Traversable f, Witherable g) => Witherable (Compose f g) where wither f = fmap Compose . T.traverse (wither f) . getCompose witherM f = fmap Compose . T.mapM (witherM f) . getCompose filterA p = fmap Compose . T.traverse (filterA p) . getCompose instance (Filterable f, Filterable g) => Filterable (P.Product f g) where mapMaybe f (P.Pair x y) = P.Pair (mapMaybe f x) (mapMaybe f y) filter p (P.Pair x y) = P.Pair (filter p x) (filter p y) catMaybes (P.Pair x y) = P.Pair (catMaybes x) (catMaybes y) instance (Witherable f, Witherable g) => Witherable (P.Product f g) where wither f (P.Pair x y) = liftA2 P.Pair (wither f x) (wither f y) witherM f (P.Pair x y) = liftA2 P.Pair (witherM f x) (witherM f y) filterA p (P.Pair x y) = liftA2 P.Pair (filterA p x) (filterA p y) instance (Filterable f, Filterable g) => Filterable (Sum.Sum f g) where mapMaybe f (Sum.InL x) = Sum.InL (mapMaybe f x) mapMaybe f (Sum.InR y) = Sum.InR (mapMaybe f y) catMaybes (Sum.InL x) = Sum.InL (catMaybes x) catMaybes (Sum.InR y) = Sum.InR (catMaybes y) filter p (Sum.InL x) = Sum.InL (filter p x) filter p (Sum.InR y) = Sum.InR (filter p y) instance (Witherable f, Witherable g) => Witherable (Sum.Sum f g) where wither f (Sum.InL x) = Sum.InL <$> wither f x wither f (Sum.InR y) = Sum.InR <$> wither f y witherM f (Sum.InL x) = Sum.InL <$> witherM f x witherM f (Sum.InR y) = Sum.InR <$> witherM f y filterA f (Sum.InL x) = Sum.InL <$> filterA f x filterA f (Sum.InR y) = Sum.InR <$> filterA f y deriving instance Filterable f => Filterable (IdentityT f) instance Witherable f => Witherable (IdentityT f) where wither f (IdentityT m) = IdentityT <$> wither f m witherM f (IdentityT m) = IdentityT <$> witherM f m filterA p (IdentityT m) = IdentityT <$> filterA p m instance Functor f => Filterable (MaybeT f) where mapMaybe f = MaybeT . fmap (mapMaybe f) . runMaybeT instance (T.Traversable t) => Witherable (MaybeT t) where wither f = fmap MaybeT . T.traverse (wither f) . runMaybeT witherM f = fmap MaybeT . T.mapM (wither f) . runMaybeT deriving instance Filterable t => Filterable (Reverse t) -- | Wither from right to left. instance Witherable t => Witherable (Reverse t) where wither f (Reverse t) = fmap Reverse . forwards $ wither (coerce f) t -- We can't do anything special with witherM, because Backwards m is not -- generally a Monad. filterA f (Reverse t) = fmap Reverse . forwards $ filterA (coerce f) t deriving instance Filterable t => Filterable (Backwards t) instance Witherable t => Witherable (Backwards t) where wither f (Backwards xs) = Backwards <$> wither f xs witherM f (Backwards xs) = Backwards <$> witherM f xs filterA f (Backwards xs) = Backwards <$> filterA f xs instance Filterable Generics.V1 where mapMaybe _ v = case v of {} catMaybes v = case v of {} filter _ v = case v of {} instance Witherable Generics.V1 where wither _ v = pure $ case v of {} filterA _ v = pure $ case v of {} instance Filterable Generics.U1 where mapMaybe _ _ = Generics.U1 catMaybes _ = Generics.U1 filter _ _ = Generics.U1 instance Witherable Generics.U1 where wither _ _ = pure Generics.U1 filterA _ _ = pure Generics.U1 instance Filterable (Generics.K1 i c) where mapMaybe _ (Generics.K1 a) = Generics.K1 a catMaybes (Generics.K1 a) = Generics.K1 a filter _ (Generics.K1 a) = Generics.K1 a instance Witherable (Generics.K1 i c) where wither _ (Generics.K1 a) = pure (Generics.K1 a) filterA _ (Generics.K1 a) = pure (Generics.K1 a) instance Filterable f => Filterable (Generics.Rec1 f) where mapMaybe f (Generics.Rec1 a) = Generics.Rec1 (mapMaybe f a) catMaybes (Generics.Rec1 a) = Generics.Rec1 (catMaybes a) filter f (Generics.Rec1 a) = Generics.Rec1 (filter f a) instance Witherable f => Witherable (Generics.Rec1 f) where wither f (Generics.Rec1 a) = fmap Generics.Rec1 (wither f a) witherM f (Generics.Rec1 a) = fmap Generics.Rec1 (witherM f a) filterA f (Generics.Rec1 a) = fmap Generics.Rec1 (filterA f a) instance Filterable f => Filterable (Generics.M1 i c f) where mapMaybe f (Generics.M1 a) = Generics.M1 (mapMaybe f a) catMaybes (Generics.M1 a) = Generics.M1 (catMaybes a) filter f (Generics.M1 a) = Generics.M1 (filter f a) instance Witherable f => Witherable (Generics.M1 i c f) where wither f (Generics.M1 a) = fmap Generics.M1 (wither f a) witherM f (Generics.M1 a) = fmap Generics.M1 (witherM f a) filterA f (Generics.M1 a) = fmap Generics.M1 (filterA f a) instance (Filterable f, Filterable g) => Filterable ((Generics.:*:) f g) where mapMaybe f (a Generics.:*: b) = mapMaybe f a Generics.:*: mapMaybe f b catMaybes (a Generics.:*: b) = catMaybes a Generics.:*: catMaybes b filter f (a Generics.:*: b) = filter f a Generics.:*: filter f b instance (Witherable f, Witherable g) => Witherable ((Generics.:*:) f g) where wither f (a Generics.:*: b) = liftA2 (Generics.:*:) (wither f a) (wither f b) witherM f (a Generics.:*: b) = liftA2 (Generics.:*:) (witherM f a) (witherM f b) filterA f (a Generics.:*: b) = liftA2 (Generics.:*:) (filterA f a) (filterA f b) instance (Filterable f, Filterable g) => Filterable ((Generics.:+:) f g) where mapMaybe f (Generics.L1 a) = Generics.L1 (mapMaybe f a) mapMaybe f (Generics.R1 a) = Generics.R1 (mapMaybe f a) catMaybes (Generics.L1 a) = Generics.L1 (catMaybes a) catMaybes (Generics.R1 a) = Generics.R1 (catMaybes a) filter f (Generics.L1 a) = Generics.L1 (filter f a) filter f (Generics.R1 a) = Generics.R1 (filter f a) instance (Witherable f, Witherable g) => Witherable ((Generics.:+:) f g) where wither f (Generics.L1 a) = fmap Generics.L1 (wither f a) wither f (Generics.R1 a) = fmap Generics.R1 (wither f a) witherM f (Generics.L1 a) = fmap Generics.L1 (witherM f a) witherM f (Generics.R1 a) = fmap Generics.R1 (witherM f a) filterA f (Generics.L1 a) = fmap Generics.L1 (filterA f a) filterA f (Generics.R1 a) = fmap Generics.R1 (filterA f a) instance (Functor f, Filterable g) => Filterable ((Generics.:.:) f g) where mapMaybe f = Generics.Comp1 . fmap (mapMaybe f) . Generics.unComp1 catMaybes = Generics.Comp1 . fmap catMaybes . Generics.unComp1 filter f = Generics.Comp1 . fmap (filter f) . Generics.unComp1 instance (T.Traversable f, Witherable g) => Witherable ((Generics.:.:) f g) where wither f = fmap Generics.Comp1 . T.traverse (wither f) . Generics.unComp1 witherM f = fmap Generics.Comp1 . T.mapM (witherM f) . Generics.unComp1 filterA f = fmap Generics.Comp1 . T.traverse (filterA f) . Generics.unComp1 -- | Indexed variant of 'Filterable'. class (FunctorWithIndex i t, Filterable t) => FilterableWithIndex i t | t -> i where imapMaybe :: (i -> a -> Maybe b) -> t a -> t b imapMaybe f = catMaybes . imap f {-# INLINE imapMaybe #-} -- | @'ifilter' f . 'ifilter' g ≡ ifilter (\i -> 'liftA2' ('&&') (f i) (g i))@ ifilter :: (i -> a -> Bool) -> t a -> t a ifilter f = imapMaybe $ \i a -> if f i a then Just a else Nothing {-# INLINE ifilter #-} -- | Indexed variant of 'Witherable'. class (TraversableWithIndex i t, Witherable t) => WitherableWithIndex i t | t -> i where -- | Effectful 'imapMaybe'. -- -- @'iwither' (\ i -> 'pure' . f i) ≡ 'pure' . 'imapMaybe' f@ iwither :: (Applicative f) => (i -> a -> f (Maybe b)) -> t a -> f (t b) iwither f = fmap catMaybes . itraverse f -- | @Monadic variant of 'wither'. This may have more efficient implementation.@ iwitherM :: (Monad m) => (i -> a -> m (Maybe b)) -> t a -> m (t b) iwitherM = iwither ifilterA :: (Applicative f) => (i -> a -> f Bool) -> t a -> f (t a) ifilterA f = iwither (\i a -> (\b -> if b then Just a else Nothing) <$> f i a) instance FilterableWithIndex () Maybe instance WitherableWithIndex () Maybe -- Option doesn't have the necessary instances in Lens --instance FilterableWithIndex () Option --instance WitherableWithIndex () Option instance FilterableWithIndex Int [] instance FilterableWithIndex Int ZipList instance WitherableWithIndex Int [] instance WitherableWithIndex Int ZipList instance FilterableWithIndex Int IM.IntMap where imapMaybe = IM.mapMaybeWithKey ifilter = IM.filterWithKey instance WitherableWithIndex Int IM.IntMap where instance FilterableWithIndex k (M.Map k) where imapMaybe = M.mapMaybeWithKey ifilter = M.filterWithKey instance WitherableWithIndex k (M.Map k) where #if MIN_VERSION_containers(0,5,8) iwither = M.traverseMaybeWithKey #endif instance (Eq k, Hashable k) => FilterableWithIndex k (HM.HashMap k) where imapMaybe = HM.mapMaybeWithKey ifilter = HM.filterWithKey instance (Eq k, Hashable k) => WitherableWithIndex k (HM.HashMap k) where instance FilterableWithIndex Void Proxy instance WitherableWithIndex Void Proxy instance FilterableWithIndex Int V.Vector where imapMaybe = V.imapMaybe ifilter = V.ifilter instance WitherableWithIndex Int V.Vector instance FilterableWithIndex Int S.Seq instance WitherableWithIndex Int S.Seq instance (FunctorWithIndex i f, FilterableWithIndex j g) => FilterableWithIndex (i, j) (Compose f g) where imapMaybe f = Compose . imap (\i -> imapMaybe (\j -> f (i, j))) . getCompose ifilter p = Compose . imap (\i -> ifilter (\j -> p (i, j))) . getCompose instance (TraversableWithIndex i f, WitherableWithIndex j g) => WitherableWithIndex (i, j) (Compose f g) where iwither f = fmap Compose . itraverse (\i -> iwither (\j -> f (i, j))) . getCompose iwitherM f = fmap Compose . imapM (\i -> iwitherM (\j -> f (i, j))) . getCompose ifilterA p = fmap Compose . itraverse (\i -> ifilterA (\j -> p (i, j))) . getCompose instance (FilterableWithIndex i f, FilterableWithIndex j g) => FilterableWithIndex (Either i j) (P.Product f g) where imapMaybe f (P.Pair x y) = P.Pair (imapMaybe (f . Left) x) (imapMaybe (f . Right) y) ifilter p (P.Pair x y) = P.Pair (ifilter (p . Left) x) (ifilter (p . Right) y) instance (WitherableWithIndex i f, WitherableWithIndex j g) => WitherableWithIndex (Either i j) (P.Product f g) where iwither f (P.Pair x y) = liftA2 P.Pair (iwither (f . Left) x) (iwither (f . Right) y) iwitherM f (P.Pair x y) = liftA2 P.Pair (iwitherM (f . Left) x) (iwitherM (f . Right) y) ifilterA p (P.Pair x y) = liftA2 P.Pair (ifilterA (p . Left) x) (ifilterA (p . Right) y) instance (FilterableWithIndex i f, FilterableWithIndex j g) => FilterableWithIndex (Either i j) (Sum.Sum f g) where imapMaybe f (Sum.InL x) = Sum.InL (imapMaybe (f . Left) x) imapMaybe f (Sum.InR y) = Sum.InR (imapMaybe (f . Right) y) ifilter f (Sum.InL x) = Sum.InL (ifilter (f . Left) x) ifilter f (Sum.InR y) = Sum.InR (ifilter (f . Right) y) instance (WitherableWithIndex i f, WitherableWithIndex j g) => WitherableWithIndex (Either i j) (Sum.Sum f g) where iwither f (Sum.InL x) = Sum.InL <$> iwither (f . Left) x iwither f (Sum.InR y) = Sum.InR <$> iwither (f . Right) y iwitherM f (Sum.InL x) = Sum.InL <$> iwitherM (f . Left) x iwitherM f (Sum.InR y) = Sum.InR <$> iwitherM (f . Right) y ifilterA f (Sum.InL x) = Sum.InL <$> ifilterA (f . Left) x ifilterA f (Sum.InR y) = Sum.InR <$> ifilterA (f . Right) y deriving instance (FilterableWithIndex i f) => FilterableWithIndex i (IdentityT f) instance (WitherableWithIndex i f) => WitherableWithIndex i (IdentityT f) where iwither f (IdentityT m) = IdentityT <$> iwither f m iwitherM f (IdentityT m) = IdentityT <$> iwitherM f m ifilterA p (IdentityT m) = IdentityT <$> ifilterA p m deriving instance FilterableWithIndex i t => FilterableWithIndex i (Reverse t) -- | Wither from right to left. instance WitherableWithIndex i t => WitherableWithIndex i (Reverse t) where iwither f (Reverse t) = fmap Reverse . forwards $ iwither (\i -> Backwards . f i) t -- We can't do anything special with iwitherM, because Backwards m is not -- generally a Monad. ifilterA p (Reverse t) = fmap Reverse . forwards $ ifilterA (\i -> Backwards . p i) t deriving instance FilterableWithIndex i t => FilterableWithIndex i (Backwards t) instance WitherableWithIndex i t => WitherableWithIndex i (Backwards t) where iwither f (Backwards xs) = Backwards <$> iwither f xs iwitherM f (Backwards xs) = Backwards <$> iwitherM f xs ifilterA f (Backwards xs) = Backwards <$> ifilterA f xs -- | An infix alias for 'mapMaybe'. The name of the operator alludes -- to '<$>', and has the same fixity. -- -- @since 0.3.1 (<$?>) :: Filterable f => (a -> Maybe b) -> f a -> f b (<$?>) = mapMaybe infixl 4 <$?> -- | Flipped version of '<$?>', the 'Filterable' version of -- 'Data.Functor.<&>'. It has the same fixity as 'Data.Functor.<&>'. -- -- @ -- ('<&?>') = 'flip' 'mapMaybe' -- @ -- -- @since 0.3.1 (<&?>) :: Filterable f => f a -> (a -> Maybe b) -> f b as <&?> f = mapMaybe f as infixl 1 <&?> -- | @'forMaybe' = 'flip' 'wither'@ forMaybe :: (Witherable t, Applicative f) => t a -> (a -> f (Maybe b)) -> f (t b) forMaybe = flip wither {-# INLINE forMaybe #-} -- | Removes duplicate elements from a list, keeping only the first -- occurrence. This is asymptotically faster than using -- 'Data.List.nub' from "Data.List". -- -- >>> ordNub [3,2,1,3,2,1] -- [3,2,1] -- ordNub :: (Witherable t, Ord a) => t a -> t a ordNub = ordNubOn id {-# INLINE ordNub #-} -- | The 'ordNubOn' function behaves just like 'ordNub', -- except it uses a another type to determine equivalence classes. -- -- >>> ordNubOn fst [(True, 'x'), (False, 'y'), (True, 'z')] -- [(True,'x'),(False,'y')] -- ordNubOn :: (Witherable t, Ord b) => (a -> b) -> t a -> t a ordNubOn p t = evalState (witherM f t) Set.empty where f a = state $ \s -> #if MIN_VERSION_containers(0,6,3) -- insert in one go -- having if outside is important for performance, -- \x -> (if x ... , True) -- is slower case Set.alterF (\x -> BoolPair x True) (p a) s of BoolPair True s' -> (Nothing, s') BoolPair False s' -> (Just a, s') #else if Set.member (p a) s then (Nothing, s) else (Just a, Set.insert (p a) s) #endif {-# INLINE ordNubOn #-} -- | Removes duplicate elements from a list, keeping only the first -- occurrence. This is usually faster than 'ordNub', especially for -- things that have a slow comparison (like 'String'). -- -- >>> hashNub [3,2,1,3,2,1] -- [3,2,1] -- hashNub :: (Witherable t, Eq a, Hashable a) => t a -> t a hashNub = hashNubOn id {-# INLINE hashNub #-} -- | The 'hashNubOn' function behaves just like 'ordNub', -- except it uses a another type to determine equivalence classes. -- -- >>> hashNubOn fst [(True, 'x'), (False, 'y'), (True, 'z')] -- [(True,'x'),(False,'y')] -- hashNubOn :: (Witherable t, Eq b, Hashable b) => (a -> b) -> t a -> t a hashNubOn p t = evalState (witherM f t) HSet.empty where f a = state $ \s -> let g Nothing = BoolPair False (Just ()) g (Just _) = BoolPair True (Just ()) -- there is no HashSet.alterF, but toMap / fromMap are newtype wrappers. in case HM.alterF g (p a) (HSet.toMap s) of BoolPair True s' -> (Nothing, HSet.fromMap s') BoolPair False s' -> (Just a, HSet.fromMap s') {-# INLINE hashNubOn #-} -- used to implement *Nub functions. data BoolPair a = BoolPair !Bool a deriving Functor -- | A default implementation for 'mapMaybe'. mapMaybeDefault :: (F.Foldable f, Alternative f) => (a -> Maybe b) -> f a -> f b mapMaybeDefault p = F.foldr (\x xs -> case p x of Just a -> pure a <|> xs _ -> xs) empty {-# INLINABLE mapMaybeDefault #-} -- | A default implementation for 'imapMaybe'. imapMaybeDefault :: (FoldableWithIndex i f, Alternative f) => (i -> a -> Maybe b) -> f a -> f b imapMaybeDefault p = ifoldr (\i x xs -> case p i x of Just a -> pure a <|> xs _ -> xs) empty {-# INLINABLE imapMaybeDefault #-} newtype WrappedFoldable f a = WrapFilterable {unwrapFoldable :: f a} deriving (Functor, F.Foldable, T.Traversable, Applicative, Alternative) instance (FunctorWithIndex i f) => FunctorWithIndex i (WrappedFoldable f) where imap f = WrapFilterable . imap f . unwrapFoldable instance (FoldableWithIndex i f) => FoldableWithIndex i (WrappedFoldable f) where ifoldMap f = ifoldMap f . unwrapFoldable instance (TraversableWithIndex i f) => TraversableWithIndex i (WrappedFoldable f) where itraverse f = fmap WrapFilterable . itraverse f . unwrapFoldable instance (F.Foldable f, Alternative f) => Filterable (WrappedFoldable f) where {-#INLINE mapMaybe#-} mapMaybe = mapMaybeDefault instance (FunctorWithIndex i f, FoldableWithIndex i f, Alternative f) => FilterableWithIndex i (WrappedFoldable f) where {-# INLINE imapMaybe #-} imapMaybe = imapMaybeDefault instance (Alternative f, T.Traversable f) => Witherable (WrappedFoldable f) witherable-0.4.2/tests/0000755000000000000000000000000007346545000013176 5ustar0000000000000000witherable-0.4.2/tests/tests.hs0000644000000000000000000002177107346545000014704 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Main (main) where import Control.Arrow (first) import Control.Monad ((<=<)) import Control.Monad.Trans.State (State, runState, state) import Data.Hashable (Hashable) import Data.Coerce (coerce) import Data.Function (on) import Data.Functor.Compose (Compose (..)) import Data.List (nub, nubBy) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..)) import Data.Typeable (Typeable, typeRep) import Test.QuickCheck (Arbitrary (..), Fun, Property, applyFun, Function (..), functionMap, CoArbitrary, (===)) import Test.QuickCheck.Instances () import Test.Tasty (defaultMain, testGroup, TestTree) import Test.Tasty.QuickCheck (testProperty) import qualified Data.HashMap.Lazy as HashMap import qualified Data.IntMap as IntMap import qualified Data.Map.Lazy as Map import qualified Data.Vector as V import qualified Data.Sequence as Seq import Witherable import Prelude hiding (filter) main :: IO () main = defaultMain $ testGroup "witherable" [ testGroup "Filterable" [ filterableLaws (Proxy @[]) , filterableLaws (Proxy @Maybe) , filterableLaws (Proxy @(Either String)) , filterableLaws (Proxy @V.Vector) , filterableLaws (Proxy @Seq.Seq) , filterableLaws (Proxy @IntMap.IntMap) , filterableLaws (Proxy @(Map.Map K)) , filterableLaws (Proxy @(HashMap.HashMap K)) , filterableLaws (Proxy @Wicked) ] , testGroup "Witherable" [ witherableLaws (Proxy @[]) , witherableLaws (Proxy @Maybe) , witherableLaws (Proxy @(Either String)) , witherableLaws (Proxy @V.Vector) , witherableLaws (Proxy @Seq.Seq) #if MIN_VERSION_containers(0,6,3) -- traverse @IntMap is broken , witherableLaws (Proxy @IntMap.IntMap) #endif , witherableLaws (Proxy @(Map.Map K)) , witherableLaws (Proxy @(HashMap.HashMap K)) -- Wicked is not Witherable, see https://github.com/fumieval/witherable/issues/63#issuecomment-834631975 -- , witherableLaws (Proxy @Wicked) ] , nubProperties ] ------------------------------------------------------------------------------- -- Filterable laws ------------------------------------------------------------------------------- filterableLaws :: forall f. ( Filterable f, Typeable f , Arbitrary (f A), Show (f A), Eq (f A) , Arbitrary (f (Maybe A)), Show (f (Maybe A)) , Show (f B), Eq (f B), Show (f C), Eq (f C) ) => Proxy f -> TestTree filterableLaws p = testGroup (show (typeRep p)) [ testProperty "conservation" prop_conservation , testProperty "composition" prop_composition , testProperty "default filter" prop_default_filter , testProperty "default mapMaybe" prop_default_mapMaybe , testProperty "default catMaybes" prop_default_catMaybes ] where prop_conservation :: Fun A B -> f A -> Property prop_conservation f' xs = mapMaybe (Just . f) xs === fmap f xs where f = applyFun f' prop_composition :: Fun B (Maybe C) -> Fun A (Maybe B) -> f A -> Property prop_composition f' g' xs = mapMaybe f (mapMaybe g xs) === mapMaybe (f <=< g) xs where f = applyFun f' g = applyFun g' prop_default_filter :: Fun A Bool -> f A -> Property prop_default_filter f' xs = filter f xs === mapMaybe (\a -> if f a then Just a else Nothing) xs where f = applyFun f' prop_default_mapMaybe :: Fun A (Maybe B) -> f A -> Property prop_default_mapMaybe f' xs = mapMaybe f xs === catMaybes (fmap f xs) where f = applyFun f' prop_default_catMaybes :: f (Maybe A) -> Property prop_default_catMaybes xs = catMaybes xs === mapMaybe id xs ------------------------------------------------------------------------------- -- Witherable laws ------------------------------------------------------------------------------- witherableLaws :: forall f. ( Witherable f, Typeable f , Arbitrary (f A), Show (f A), Eq (f A) , Arbitrary (f (Maybe A)), Show (f (Maybe A)) , Show (f B), Eq (f B), Show (f C), Eq (f C) ) => Proxy f -> TestTree witherableLaws p = testGroup (show (typeRep p)) [ testProperty "default wither" prop_default_wither , testProperty "default witherM" prop_default_witherM , testProperty "default filterA" prop_default_filterA , testProperty "identity" prop_identity , testProperty "composition" prop_composition ] where prop_default_wither :: S -> Fun (A, S) (Maybe B, S) -> f A -> Property prop_default_wither s0 f' xs = equalState s0 xs (wither f) (fmap catMaybes . traverse f) where f :: A -> State S (Maybe B) f a = state $ \s -> applyFun f' (a, s) prop_default_witherM :: S -> Fun (A, S) (Maybe B, S) -> f A -> Property prop_default_witherM s0 f' xs = equalState s0 xs (witherM f) (wither f) where f a = state $ \s -> applyFun f' (a, s) prop_default_filterA :: S -> Fun (A, S) (Bool, S) -> f A -> Property prop_default_filterA s0 f' xs = equalState s0 xs (filterA f) (wither (\a -> (\b -> if b then Just a else Nothing) <$> f a)) where f a = state $ \s -> applyFun f' (a, s) prop_identity :: S -> Fun (A, S) (B, S) -> f A -> Property prop_identity s0 f' xs = equalState s0 xs (wither (fmap Just . f)) (traverse f) where f a = state $ \s -> applyFun f' (a, s) prop_composition :: S -> S -> Fun (B, S) (Maybe C, S) -> Fun (A, S) (Maybe B, S) -> f A -> Property prop_composition s0 s1 f' g' xs = equalStateC s0 s1 xs (Compose . fmap (wither f) . wither g) (wither (Compose . fmap (wither f) . g)) where f a = state $ \s -> applyFun f' (a, s) g b = state $ \s -> applyFun g' (b, s) equalState :: (Eq b, Show b) => S -> a -> (a -> State S b) -> (a -> State S b) -> Property equalState s0 xs f g = runState (f xs) s0 === runState (g xs) s0 equalStateC :: forall a b. (Eq b, Show b) => S -> S -> a -> (a -> Compose (State S) (State S) b) -> (a -> Compose (State S) (State S) b) -> Property equalStateC s0 s1 xs f g = run (f xs) === run (g xs) where run :: Compose (State S) (State S) b -> ((b, S), S) run m = first (\x -> runState x s1) (runState (getCompose m) s0) ------------------------------------------------------------------------------- -- Nub "laws" ------------------------------------------------------------------------------- nubProperties :: TestTree nubProperties = testGroup "nub" [ testProperty "ordNub" prop_ordNub , testProperty "ordNubOn" prop_ordNubOn , testProperty "hashNub" prop_hashNub , testProperty "hashNubOn" prop_hashNubOn , testProperty "ordNub is lazy" prop_lazy_ordNub , testProperty "hashNub is lazy" prop_lazy_hashNub ] where prop_ordNub :: [A] -> Property prop_ordNub xs = nub xs === ordNub xs prop_hashNub :: [A] -> Property prop_hashNub xs = nub xs === hashNub xs prop_ordNubOn :: Fun A B -> [A] -> Property prop_ordNubOn f' xs = nubBy ((==) `on` f) xs === ordNubOn f xs where f = applyFun f' prop_hashNubOn :: Fun A B -> [A] -> Property prop_hashNubOn f' xs = nubBy ((==) `on` f) xs === hashNubOn f xs where f = applyFun f' prop_lazy_ordNub :: Property prop_lazy_ordNub = take 3 (ordNub ('x' : 'y' : 'z' : 'z' : error "bottom")) === "xyz" prop_lazy_hashNub :: Property prop_lazy_hashNub = take 3 (hashNub ('x' : 'y' : 'z' : 'z' : error "bottom")) === "xyz" ------------------------------------------------------------------------------- -- "Poly" ------------------------------------------------------------------------------- newtype A = A Int deriving (Eq, Ord, Show, Hashable, Arbitrary, CoArbitrary) instance Function A where function = functionMap coerce A newtype B = B Int deriving (Eq, Ord, Show, Hashable, Arbitrary, CoArbitrary) instance Function B where function = functionMap coerce B newtype C = C Int deriving (Eq, Ord, Show, Hashable, Arbitrary, CoArbitrary) instance Function C where function = functionMap coerce C newtype K = K Int deriving (Eq, Ord, Show, Hashable, Arbitrary, CoArbitrary) instance Function K where function = functionMap coerce K newtype S = S Int deriving (Eq, Ord, Show, Hashable, Arbitrary, CoArbitrary) instance Function S where function = functionMap coerce S ------------------------------------------------------------------------------- -- Wicked ------------------------------------------------------------------------------- newtype Wicked a = W [a] deriving (Eq, Show, Functor, Foldable, Traversable) instance Filterable Wicked where -- mapMaybe f (W [a1,a2,...]) = W [b1, b2, ...] -- if all of [f a1, f a2, ...] are Just. Otherwise, it returns (W []). mapMaybe f = fromMaybe (W []) . traverse f -- default implementation in terms of Filterable instance Witherable Wicked instance Arbitrary a => Arbitrary (Wicked a) where arbitrary = W <$> arbitrary shrink (W xs) = map W (shrink xs) witherable-0.4.2/witherable.cabal0000644000000000000000000000432407346545000015151 0ustar0000000000000000cabal-version: 2.4 name: witherable version: 0.4.2 synopsis: filterable traversable description: A stronger variant of `traverse` which can remove elements and generalised mapMaybe, catMaybes, filter homepage: https://github.com/fumieval/witherable license: BSD-3-Clause license-file: LICENSE author: Fumiaki Kinoshita maintainer: Fumiaki Kinoshita copyright: Copyright (c) 2014 Fumiaki Kinoshita category: Data build-type: Simple extra-source-files: CHANGELOG.md tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1 source-repository head type: git location: https://github.com/fumieval/witherable.git subdir: witherable library exposed-modules: Witherable Data.Witherable build-depends: base >=4.9 && <5, base-orphans >=0.8.4 && <0.9, containers >=0.5.7.1 && <0.7, hashable >=1.2.7.0 && <1.4, transformers >=0.5.2.0 && <0.6, unordered-containers >=0.2.12.0 && <0.3, vector >=0.12.2.0 && <0.13, indexed-traversable >=0.1.1 && <0.2, indexed-traversable-instances >=0.1 && <0.2 hs-source-dirs: src ghc-options: -Wall -Wcompat default-language: Haskell2010 test-suite witherable-tests type: exitcode-stdio-1.0 main-is: tests.hs hs-source-dirs: tests ghc-options: -Wall -Wcompat default-language: Haskell2010 build-depends: base, witherable, containers, hashable, QuickCheck >=2.14.2, quickcheck-instances, tasty, tasty-quickcheck, transformers, unordered-containers, vector