{-# 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 <[email protected]>
-- 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 a -> Maybe b
f = forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
f
  {-# INLINE mapMaybe #-}

  -- | @'catMaybes' ≡ 'mapMaybe' 'id'@
  catMaybes :: f (Maybe a) -> f a
  catMaybes = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe forall a. a -> a
id
  {-# INLINE catMaybes #-}

  -- | @'filter' f . 'filter' g ≡ filter ('liftA2' ('&&') g f)@
  filter :: (a -> Bool) -> f a -> f a
  filter a -> Bool
f = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe forall a b. (a -> b) -> a -> b
$ \a
a -> if a -> Bool
f a
a then forall a. a -> Maybe a
Just a
a else forall a. Maybe a
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 a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f (Maybe b)
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 = forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither

  filterA :: Applicative f => (a -> f Bool) -> t a -> f (t a)
  filterA a -> f Bool
f = forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither forall a b. (a -> b) -> a -> b
$ \a
a -> (\Bool
b -> if Bool
b then forall a. a -> Maybe a
Just a
a else forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f Bool
f a
a

  witherMap :: (Applicative m) => (t b -> r) -> (a -> m (Maybe b)) -> t a -> m r
  witherMap t b -> r
p a -> m (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t b -> r
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> m (Maybe b)
f
  {-# INLINE witherMap #-}

  {-# MINIMAL #-}

instance Filterable Maybe where
  mapMaybe :: forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
mapMaybe a -> Maybe b
f = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe b
f)
  {-# INLINE mapMaybe #-}

instance Witherable Maybe where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Maybe a -> f (Maybe b)
wither a -> f (Maybe b)
_ Maybe a
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  wither a -> f (Maybe b)
f (Just a
a) = a -> f (Maybe b)
f a
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 :: forall a b. (a -> Maybe b) -> Either e a -> Either e b
mapMaybe a -> Maybe b
_ (Left e
e) = forall a b. a -> Either a b
Left e
e
  mapMaybe a -> Maybe b
f (Right a
a) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a. Monoid a => a
mempty) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ a -> Maybe b
f a
a
  {-# INLINABLE mapMaybe #-}

instance Monoid e => Witherable (Either e) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Either e a -> f (Either e b)
wither a -> f (Maybe b)
_ (Left e
e) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left e
e)
  wither a -> f (Maybe b)
f (Right a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a. Monoid a => a
mempty) forall a b. b -> Either a b
Right) (a -> f (Maybe b)
f a
a)
  {-# INLINABLE wither #-}

instance Filterable [] where
  mapMaybe :: forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe = forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
  catMaybes :: forall a. [Maybe a] -> [a]
catMaybes = forall a. [Maybe a] -> [a]
Maybe.catMaybes
  filter :: forall a. (a -> Bool) -> [a] -> [a]
filter = forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter

instance Filterable ZipList where
  mapMaybe :: forall a b. (a -> Maybe b) -> ZipList a -> ZipList b
mapMaybe a -> Maybe b
f = forall a. [a] -> ZipList a
ZipList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ZipList a -> [a]
getZipList
  catMaybes :: forall a. ZipList (Maybe a) -> ZipList a
catMaybes = forall a. [a] -> ZipList a
ZipList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
Maybe.catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ZipList a -> [a]
getZipList
  filter :: forall a. (a -> Bool) -> ZipList a -> ZipList a
filter a -> Bool
f = forall a. [a] -> ZipList a
ZipList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ZipList a -> [a]
getZipList

-- | Methods are good consumers for fusion.
instance Witherable [] where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
wither a -> f (Maybe b)
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> f [b] -> f [b]
go (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) where
    go :: a -> f [b] -> f [b]
go a
x f [b]
r = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:)) (a -> f (Maybe b)
f a
x) f [b]
r
  {-# INLINE wither #-}
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
witherM a -> m (Maybe b)
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> m [b] -> m [b]
go (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) where
    go :: a -> m [b] -> m [b]
go a
x m [b]
r = a -> m (Maybe b)
f a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      (\Maybe b
z -> case Maybe b
z of
        Maybe b
Nothing -> m [b]
r
        Just b
y -> ((:) b
y) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [b]
r
      )
  {-# INLINE witherM #-}

  -- Compared to the default, this fuses an fmap into a liftA2.
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> [a] -> f [a]
filterA a -> f Bool
p = [a] -> f [a]
go where
    go :: [a] -> f [a]
go (a
x:[a]
xs) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a. a -> a -> Bool -> a
bool forall a. a -> a
id (a
x forall a. a -> [a] -> [a]
:)) (a -> f Bool
p a
x) ([a] -> f [a]
go [a]
xs)
    go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance Witherable ZipList where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> ZipList a -> f (ZipList b)
wither a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> ZipList a
ZipList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ZipList a -> [a]
getZipList

instance Filterable IM.IntMap where
  mapMaybe :: forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
mapMaybe = forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IM.mapMaybe
  filter :: forall a. (a -> Bool) -> IntMap a -> IntMap a
filter = forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter

instance Witherable IM.IntMap where

instance Filterable (M.Map k) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Map k a -> Map k b
mapMaybe = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe
  filter :: forall a. (a -> Bool) -> Map k a -> Map k a
filter = forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter

instance Witherable (M.Map k) where
#if MIN_VERSION_containers(0,5,8)
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Map k a -> f (Map k b)
wither a -> f (Maybe b)
f = forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
M.traverseMaybeWithKey (forall a b. a -> b -> a
const a -> f (Maybe b)
f)
#endif

instance (Eq k, Hashable k) => Filterable (HM.HashMap k) where
  mapMaybe :: forall a b. (a -> Maybe b) -> HashMap k a -> HashMap k b
mapMaybe = forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe
  filter :: forall a. (a -> Bool) -> HashMap k a -> HashMap k a
filter = forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter

instance (Eq k, Hashable k) => Witherable (HM.HashMap k) where

instance Filterable Proxy where
 mapMaybe :: forall a b. (a -> Maybe b) -> Proxy a -> Proxy b
mapMaybe a -> Maybe b
_ Proxy a
Proxy = forall {k} (t :: k). Proxy t
Proxy

instance Witherable Proxy where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Proxy a -> f (Proxy b)
wither a -> f (Maybe b)
_ Proxy a
Proxy = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (t :: k). Proxy t
Proxy

instance Filterable (Const r) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Const r a -> Const r b
mapMaybe a -> Maybe b
_ (Const r
r) = forall {k} a (b :: k). a -> Const a b
Const r
r
  {-# INLINABLE mapMaybe #-}

instance Witherable (Const r) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Const r a -> f (Const r b)
wither a -> f (Maybe b)
_ (Const r
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} a (b :: k). a -> Const a b
Const r
r)
  {-# INLINABLE wither #-}

instance Filterable V.Vector where
  filter :: forall a. (a -> Bool) -> Vector a -> Vector a
filter   = forall a. (a -> Bool) -> Vector a -> Vector a
V.filter
  mapMaybe :: forall a b. (a -> Maybe b) -> Vector a -> Vector b
mapMaybe = forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe

instance Witherable V.Vector where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Vector a -> f (Vector b)
wither a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList
  {-# INLINABLE wither #-}

  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Vector a -> m (Vector b)
witherM = forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Vector a -> m (Vector b)
V.mapMaybeM
  {-# INLINE witherM #-}

instance Filterable S.Seq where
  mapMaybe :: forall a b. (a -> Maybe b) -> Seq a -> Seq b
mapMaybe a -> Maybe b
f = forall a. [a] -> Seq a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  {-# INLINABLE mapMaybe #-}
  filter :: forall a. (a -> Bool) -> Seq a -> Seq a
filter = forall a. (a -> Bool) -> Seq a -> Seq a
S.filter

instance Witherable S.Seq where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Seq a -> f (Seq b)
wither a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Seq a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
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 :: forall a b. (a -> Maybe b) -> Compose f g a -> Compose f g b
mapMaybe a -> Maybe b
f = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  filter :: forall a. (a -> Bool) -> Compose f g a -> Compose f g a
filter a -> Bool
p = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  catMaybes :: forall a. Compose f g (Maybe a) -> Compose f g a
catMaybes = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (T.Traversable f, Witherable g) => Witherable (Compose f g) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Compose f g a -> f (Compose f g b)
wither a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Compose f g a -> m (Compose f g b)
witherM a -> m (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Compose f g a -> f (Compose f g a)
filterA a -> f Bool
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (Filterable f, Filterable g) => Filterable (P.Product f g) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Product f g a -> Product f g b
mapMaybe a -> Maybe b
f (P.Pair f a
x g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f f a
x) (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f g a
y)
  filter :: forall a. (a -> Bool) -> Product f g a -> Product f g a
filter a -> Bool
p (P.Pair f a
x g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
p f a
x) (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
p g a
y)
  catMaybes :: forall a. Product f g (Maybe a) -> Product f g a
catMaybes (P.Pair f (Maybe a)
x g (Maybe a)
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes f (Maybe a)
x) (forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes g (Maybe a)
y)

instance (Witherable f, Witherable g) => Witherable (P.Product f g) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Product f g a -> f (Product f g b)
wither a -> f (Maybe b)
f (P.Pair f a
x g a
y) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f f a
x) (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f g a
y)
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Product f g a -> m (Product f g b)
witherM a -> m (Maybe b)
f (P.Pair f a
x g a
y) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f f a
x) (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f g a
y)
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Product f g a -> f (Product f g a)
filterA a -> f Bool
p (P.Pair f a
x g a
y) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
p f a
x) (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
p g a
y)

instance (Filterable f, Filterable g) => Filterable (Sum.Sum f g) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Sum f g a -> Sum f g b
mapMaybe a -> Maybe b
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f f a
x)
  mapMaybe a -> Maybe b
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f g a
y)

  catMaybes :: forall a. Sum f g (Maybe a) -> Sum f g a
catMaybes (Sum.InL f (Maybe a)
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL (forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes f (Maybe a)
x)
  catMaybes (Sum.InR g (Maybe a)
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR (forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes g (Maybe a)
y)

  filter :: forall a. (a -> Bool) -> Sum f g a -> Sum f g a
filter a -> Bool
p (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
p f a
x)
  filter a -> Bool
p (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
p g a
y)

instance (Witherable f, Witherable g) => Witherable (Sum.Sum f g) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Sum f g a -> f (Sum f g b)
wither a -> f (Maybe b)
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f f a
x
  wither a -> f (Maybe b)
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f g a
y

  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Sum f g a -> m (Sum f g b)
witherM a -> m (Maybe b)
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f f a
x
  witherM a -> m (Maybe b)
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f g a
y

  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Sum f g a -> f (Sum f g a)
filterA a -> f Bool
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f f a
x
  filterA a -> f Bool
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f g a
y

deriving instance Filterable f => Filterable (IdentityT f)

instance Witherable f => Witherable (IdentityT f) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> IdentityT f a -> f (IdentityT f b)
wither a -> f (Maybe b)
f (IdentityT f a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f f a
m
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> IdentityT f a -> m (IdentityT f b)
witherM a -> m (Maybe b)
f (IdentityT f a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f f a
m
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> IdentityT f a -> f (IdentityT f a)
filterA a -> f Bool
p (IdentityT f a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
p f a
m

instance Functor f => Filterable (MaybeT f) where
  mapMaybe :: forall a b. (a -> Maybe b) -> MaybeT f a -> MaybeT f b
mapMaybe a -> Maybe b
f = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

instance (T.Traversable t) => Witherable (MaybeT t) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> MaybeT t a -> f (MaybeT t b)
wither a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> MaybeT t a -> m (MaybeT t b)
witherM a -> m (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> m (Maybe b)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

deriving instance Filterable t => Filterable (Reverse t)

-- | Wither from right to left.
instance Witherable t => Witherable (Reverse t) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Reverse t a -> f (Reverse t b)
wither a -> f (Maybe b)
f (Reverse t a
t) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither (coerce :: forall a b. Coercible a b => a -> b
coerce a -> f (Maybe b)
f) t a
t
  -- We can't do anything special with witherM, because Backwards m is not
  -- generally a Monad.
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Reverse t a -> f (Reverse t a)
filterA a -> f Bool
f (Reverse t a
t) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA (coerce :: forall a b. Coercible a b => a -> b
coerce a -> f Bool
f) t a
t

deriving instance Filterable t => Filterable (Backwards t)

instance Witherable t => Witherable (Backwards t) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Backwards t a -> f (Backwards t b)
wither a -> f (Maybe b)
f (Backwards t a
xs) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f t a
xs
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Backwards t a -> m (Backwards t b)
witherM a -> m (Maybe b)
f (Backwards t a
xs) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f t a
xs
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Backwards t a -> f (Backwards t a)
filterA a -> f Bool
f (Backwards t a
xs) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f t a
xs

instance Filterable Generics.V1 where
  mapMaybe :: forall a b. (a -> Maybe b) -> V1 a -> V1 b
mapMaybe a -> Maybe b
_ V1 a
v = case V1 a
v of {}
  catMaybes :: forall a. V1 (Maybe a) -> V1 a
catMaybes V1 (Maybe a)
v = case V1 (Maybe a)
v of {}
  filter :: forall a. (a -> Bool) -> V1 a -> V1 a
filter a -> Bool
_ V1 a
v = case V1 a
v of {}

instance Witherable Generics.V1 where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> V1 a -> f (V1 b)
wither a -> f (Maybe b)
_ V1 a
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case V1 a
v of {}
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> V1 a -> f (V1 a)
filterA a -> f Bool
_ V1 a
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case V1 a
v of {}

instance Filterable Generics.U1 where
  mapMaybe :: forall a b. (a -> Maybe b) -> U1 a -> U1 b
mapMaybe a -> Maybe b
_ U1 a
_ = forall k (p :: k). U1 p
Generics.U1
  catMaybes :: forall a. U1 (Maybe a) -> U1 a
catMaybes U1 (Maybe a)
_ = forall k (p :: k). U1 p
Generics.U1
  filter :: forall a. (a -> Bool) -> U1 a -> U1 a
filter a -> Bool
_ U1 a
_ = forall k (p :: k). U1 p
Generics.U1

instance Witherable Generics.U1 where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> U1 a -> f (U1 b)
wither a -> f (Maybe b)
_ U1 a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
Generics.U1
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> U1 a -> f (U1 a)
filterA a -> f Bool
_ U1 a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
Generics.U1

instance Filterable (Generics.K1 i c) where
  mapMaybe :: forall a b. (a -> Maybe b) -> K1 i c a -> K1 i c b
mapMaybe a -> Maybe b
_ (Generics.K1 c
a) = forall k i c (p :: k). c -> K1 i c p
Generics.K1 c
a
  catMaybes :: forall a. K1 i c (Maybe a) -> K1 i c a
catMaybes (Generics.K1 c
a) = forall k i c (p :: k). c -> K1 i c p
Generics.K1 c
a
  filter :: forall a. (a -> Bool) -> K1 i c a -> K1 i c a
filter a -> Bool
_ (Generics.K1 c
a) = forall k i c (p :: k). c -> K1 i c p
Generics.K1 c
a

instance Witherable (Generics.K1 i c) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> K1 i c a -> f (K1 i c b)
wither a -> f (Maybe b)
_ (Generics.K1 c
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k i c (p :: k). c -> K1 i c p
Generics.K1 c
a)
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> K1 i c a -> f (K1 i c a)
filterA a -> f Bool
_ (Generics.K1 c
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k i c (p :: k). c -> K1 i c p
Generics.K1 c
a)

instance Filterable f => Filterable (Generics.Rec1 f) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Rec1 f a -> Rec1 f b
mapMaybe a -> Maybe b
f (Generics.Rec1 f a
a) = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Generics.Rec1 (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f f a
a)
  catMaybes :: forall a. Rec1 f (Maybe a) -> Rec1 f a
catMaybes (Generics.Rec1 f (Maybe a)
a) = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Generics.Rec1 (forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes f (Maybe a)
a)
  filter :: forall a. (a -> Bool) -> Rec1 f a -> Rec1 f a
filter a -> Bool
f (Generics.Rec1 f a
a) = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Generics.Rec1 (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
f f a
a)

instance Witherable f => Witherable (Generics.Rec1 f) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Rec1 f a -> f (Rec1 f b)
wither a -> f (Maybe b)
f (Generics.Rec1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Generics.Rec1 (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f f a
a)
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Rec1 f a -> m (Rec1 f b)
witherM a -> m (Maybe b)
f (Generics.Rec1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Generics.Rec1 (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f f a
a)
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Rec1 f a -> f (Rec1 f a)
filterA a -> f Bool
f (Generics.Rec1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Generics.Rec1 (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f f a
a)

instance Filterable f => Filterable (Generics.M1 i c f) where
  mapMaybe :: forall a b. (a -> Maybe b) -> M1 i c f a -> M1 i c f b
mapMaybe a -> Maybe b
f (Generics.M1 f a
a) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f f a
a)
  catMaybes :: forall a. M1 i c f (Maybe a) -> M1 i c f a
catMaybes (Generics.M1 f (Maybe a)
a) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 (forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes f (Maybe a)
a)
  filter :: forall a. (a -> Bool) -> M1 i c f a -> M1 i c f a
filter a -> Bool
f (Generics.M1 f a
a) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
f f a
a)

instance Witherable f => Witherable (Generics.M1 i c f) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> M1 i c f a -> f (M1 i c f b)
wither a -> f (Maybe b)
f (Generics.M1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f f a
a)
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> M1 i c f a -> m (M1 i c f b)
witherM a -> m (Maybe b)
f (Generics.M1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f f a
a)
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> M1 i c f a -> f (M1 i c f a)
filterA a -> f Bool
f (Generics.M1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f f a
a)

instance (Filterable f, Filterable g) => Filterable ((Generics.:*:) f g) where
  mapMaybe :: forall a b. (a -> Maybe b) -> (:*:) f g a -> (:*:) f g b
mapMaybe a -> Maybe b
f (f a
a Generics.:*: g a
b) = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f f a
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
Generics.:*: forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f g a
b
  catMaybes :: forall a. (:*:) f g (Maybe a) -> (:*:) f g a
catMaybes (f (Maybe a)
a Generics.:*: g (Maybe a)
b) = forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes f (Maybe a)
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
Generics.:*: forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes g (Maybe a)
b
  filter :: forall a. (a -> Bool) -> (:*:) f g a -> (:*:) f g a
filter a -> Bool
f (f a
a Generics.:*: g a
b) = forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
f f a
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
Generics.:*: forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
f g a
b

instance (Witherable f, Witherable g) => Witherable ((Generics.:*:) f g) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> (:*:) f g a -> f ((:*:) f g b)
wither a -> f (Maybe b)
f (f a
a Generics.:*: g a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(Generics.:*:) (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f f a
a) (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f g a
b)
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> (:*:) f g a -> m ((:*:) f g b)
witherM a -> m (Maybe b)
f (f a
a Generics.:*: g a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(Generics.:*:) (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f f a
a) (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f g a
b)
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> (:*:) f g a -> f ((:*:) f g a)
filterA a -> f Bool
f (f a
a Generics.:*: g a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(Generics.:*:) (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f f a
a) (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f g a
b)

instance (Filterable f, Filterable g) => Filterable ((Generics.:+:) f g) where
  mapMaybe :: forall a b. (a -> Maybe b) -> (:+:) f g a -> (:+:) f g b
mapMaybe a -> Maybe b
f (Generics.L1 f a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
Generics.L1 (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f f a
a)
  mapMaybe a -> Maybe b
f (Generics.R1 g a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
Generics.R1 (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f g a
a)
  catMaybes :: forall a. (:+:) f g (Maybe a) -> (:+:) f g a
catMaybes (Generics.L1 f (Maybe a)
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
Generics.L1 (forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes f (Maybe a)
a)
  catMaybes (Generics.R1 g (Maybe a)
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
Generics.R1 (forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes g (Maybe a)
a)
  filter :: forall a. (a -> Bool) -> (:+:) f g a -> (:+:) f g a
filter a -> Bool
f (Generics.L1 f a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
Generics.L1 (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
f f a
a)
  filter a -> Bool
f (Generics.R1 g a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
Generics.R1 (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
f g a
a)

instance (Witherable f, Witherable g) => Witherable ((Generics.:+:) f g) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> (:+:) f g a -> f ((:+:) f g b)
wither a -> f (Maybe b)
f (Generics.L1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
Generics.L1 (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f f a
a)
  wither a -> f (Maybe b)
f (Generics.R1 g a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
Generics.R1 (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f g a
a)
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> (:+:) f g a -> m ((:+:) f g b)
witherM a -> m (Maybe b)
f (Generics.L1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
Generics.L1 (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f f a
a)
  witherM a -> m (Maybe b)
f (Generics.R1 g a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
Generics.R1 (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f g a
a)
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> (:+:) f g a -> f ((:+:) f g a)
filterA a -> f Bool
f (Generics.L1 f a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
Generics.L1 (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f f a
a)
  filterA a -> f Bool
f (Generics.R1 g a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
Generics.R1 (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f g a
a)

instance (Functor f, Filterable g) => Filterable ((Generics.:.:) f g) where
  mapMaybe :: forall a b. (a -> Maybe b) -> (:.:) f g a -> (:.:) f g b
mapMaybe a -> Maybe b
f = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Generics.Comp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
Generics.unComp1
  catMaybes :: forall a. (:.:) f g (Maybe a) -> (:.:) f g a
catMaybes = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Generics.Comp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
Generics.unComp1
  filter :: forall a. (a -> Bool) -> (:.:) f g a -> (:.:) f g a
filter a -> Bool
f = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Generics.Comp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter a -> Bool
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
Generics.unComp1

instance (T.Traversable f, Witherable g) => Witherable ((Generics.:.:) f g) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> (:.:) f g a -> f ((:.:) f g b)
wither a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Generics.Comp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
Generics.unComp1
  witherM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> (:.:) f g a -> m ((:.:) f g b)
witherM a -> m (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Generics.Comp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM a -> m (Maybe b)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
Generics.unComp1
  filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> (:.:) f g a -> f ((:.:) f g a)
filterA a -> f Bool
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Generics.Comp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
filterA a -> f Bool
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
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 i -> a -> Maybe b
f = forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> Maybe b
f
  {-# INLINE imapMaybe #-}

  -- | @'ifilter' f . 'ifilter' g ≡ ifilter (\i -> 'liftA2' ('&&') (f i) (g i))@
  ifilter :: (i -> a -> Bool) -> t a -> t a
  ifilter i -> a -> Bool
f = forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe forall a b. (a -> b) -> a -> b
$ \i
i a
a -> if i -> a -> Bool
f i
i a
a then forall a. a -> Maybe a
Just a
a else forall a. Maybe a
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 i -> a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse i -> a -> f (Maybe b)
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 = forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither

  ifilterA :: (Applicative f) => (i -> a -> f Bool) -> t a -> f (t a)
  ifilterA i -> a -> f Bool
f = forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither (\i
i a
a -> (\Bool
b -> if Bool
b then forall a. a -> Maybe a
Just a
a else forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f Bool
f i
i a
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 :: forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b
imapMaybe = forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b
IM.mapMaybeWithKey
  ifilter :: forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
ifilter = forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IM.filterWithKey

instance WitherableWithIndex Int IM.IntMap where

instance FilterableWithIndex k (M.Map k) where
  imapMaybe :: forall a b. (k -> a -> Maybe b) -> Map k a -> Map k b
imapMaybe = forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey
  ifilter :: forall a. (k -> a -> Bool) -> Map k a -> Map k a
ifilter = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey

instance WitherableWithIndex k (M.Map k) where
#if MIN_VERSION_containers(0,5,8)
  iwither :: forall (f :: * -> *) a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
iwither = forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
M.traverseMaybeWithKey
#endif

instance (Eq k, Hashable k) => FilterableWithIndex k (HM.HashMap k) where
  imapMaybe :: forall a b. (k -> a -> Maybe b) -> HashMap k a -> HashMap k b
imapMaybe = forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybeWithKey
  ifilter :: forall a. (k -> a -> Bool) -> HashMap k a -> HashMap k a
ifilter = forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
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 :: forall a b. (Int -> a -> Maybe b) -> Vector a -> Vector b
imapMaybe = forall a b. (Int -> a -> Maybe b) -> Vector a -> Vector b
V.imapMaybe
  ifilter :: forall a. (Int -> a -> Bool) -> Vector a -> Vector a
ifilter = forall a. (Int -> a -> Bool) -> Vector a -> Vector a
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 :: forall a b.
((i, j) -> a -> Maybe b) -> Compose f g a -> Compose f g b
imapMaybe (i, j) -> a -> Maybe b
f = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
i -> forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe (\j
j -> (i, j) -> a -> Maybe b
f (i
i, j
j))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  ifilter :: forall a. ((i, j) -> a -> Bool) -> Compose f g a -> Compose f g a
ifilter (i, j) -> a -> Bool
p = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
i -> forall i (t :: * -> *) a.
FilterableWithIndex i t =>
(i -> a -> Bool) -> t a -> t a
ifilter (\j
j -> (i, j) -> a -> Bool
p (i
i, j
j))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (TraversableWithIndex i f, WitherableWithIndex j g) => WitherableWithIndex (i, j) (Compose f g) where
  iwither :: forall (f :: * -> *) a b.
Applicative f =>
((i, j) -> a -> f (Maybe b)) -> Compose f g a -> f (Compose f g b)
iwither (i, j) -> a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\i
i -> forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither (\j
j -> (i, j) -> a -> f (Maybe b)
f (i
i, j
j))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  iwitherM :: forall (m :: * -> *) a b.
Monad m =>
((i, j) -> a -> m (Maybe b)) -> Compose f g a -> m (Compose f g b)
iwitherM (i, j) -> a -> m (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) (m :: * -> *) a b.
(TraversableWithIndex i t, Monad m) =>
(i -> a -> m b) -> t a -> m (t b)
imapM (\i
i -> forall i (t :: * -> *) (m :: * -> *) a b.
(WitherableWithIndex i t, Monad m) =>
(i -> a -> m (Maybe b)) -> t a -> m (t b)
iwitherM (\j
j -> (i, j) -> a -> m (Maybe b)
f (i
i, j
j))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  ifilterA :: forall (f :: * -> *) a.
Applicative f =>
((i, j) -> a -> f Bool) -> Compose f g a -> f (Compose f g a)
ifilterA (i, j) -> a -> f Bool
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\i
i -> forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA (\j
j -> (i, j) -> a -> f Bool
p (i
i, j
j))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (FilterableWithIndex i f, FilterableWithIndex j g) => FilterableWithIndex (Either i j) (P.Product f g) where
  imapMaybe :: forall a b.
(Either i j -> a -> Maybe b) -> Product f g a -> Product f g b
imapMaybe Either i j -> a -> Maybe b
f (P.Pair f a
x g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe (Either i j -> a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x) (forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe (Either i j -> a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y)
  ifilter :: forall a.
(Either i j -> a -> Bool) -> Product f g a -> Product f g a
ifilter Either i j -> a -> Bool
p (P.Pair f a
x g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall i (t :: * -> *) a.
FilterableWithIndex i t =>
(i -> a -> Bool) -> t a -> t a
ifilter (Either i j -> a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x) (forall i (t :: * -> *) a.
FilterableWithIndex i t =>
(i -> a -> Bool) -> t a -> t a
ifilter (Either i j -> a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y)

instance (WitherableWithIndex i f, WitherableWithIndex j g) => WitherableWithIndex (Either i j) (P.Product f g) where
  iwither :: forall (f :: * -> *) a b.
Applicative f =>
(Either i j -> a -> f (Maybe b))
-> Product f g a -> f (Product f g b)
iwither Either i j -> a -> f (Maybe b)
f (P.Pair f a
x g a
y) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither (Either i j -> a -> f (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x) (forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither (Either i j -> a -> f (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y)
  iwitherM :: forall (m :: * -> *) a b.
Monad m =>
(Either i j -> a -> m (Maybe b))
-> Product f g a -> m (Product f g b)
iwitherM Either i j -> a -> m (Maybe b)
f (P.Pair f a
x g a
y) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall i (t :: * -> *) (m :: * -> *) a b.
(WitherableWithIndex i t, Monad m) =>
(i -> a -> m (Maybe b)) -> t a -> m (t b)
iwitherM (Either i j -> a -> m (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x) (forall i (t :: * -> *) (m :: * -> *) a b.
(WitherableWithIndex i t, Monad m) =>
(i -> a -> m (Maybe b)) -> t a -> m (t b)
iwitherM (Either i j -> a -> m (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y)
  ifilterA :: forall (f :: * -> *) a.
Applicative f =>
(Either i j -> a -> f Bool) -> Product f g a -> f (Product f g a)
ifilterA Either i j -> a -> f Bool
p (P.Pair f a
x g a
y) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair (forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA (Either i j -> a -> f Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x) (forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA (Either i j -> a -> f Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y)

instance (FilterableWithIndex i f, FilterableWithIndex j g) => FilterableWithIndex (Either i j) (Sum.Sum f g) where
  imapMaybe :: forall a b. (Either i j -> a -> Maybe b) -> Sum f g a -> Sum f g b
imapMaybe Either i j -> a -> Maybe b
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL (forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe (Either i j -> a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x)
  imapMaybe Either i j -> a -> Maybe b
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR (forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe (Either i j -> a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y)

  ifilter :: forall a. (Either i j -> a -> Bool) -> Sum f g a -> Sum f g a
ifilter Either i j -> a -> Bool
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL (forall i (t :: * -> *) a.
FilterableWithIndex i t =>
(i -> a -> Bool) -> t a -> t a
ifilter (Either i j -> a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x)
  ifilter Either i j -> a -> Bool
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR (forall i (t :: * -> *) a.
FilterableWithIndex i t =>
(i -> a -> Bool) -> t a -> t a
ifilter (Either i j -> a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y)

instance (WitherableWithIndex i f, WitherableWithIndex j g) => WitherableWithIndex (Either i j) (Sum.Sum f g) where
  iwither :: forall (f :: * -> *) a b.
Applicative f =>
(Either i j -> a -> f (Maybe b)) -> Sum f g a -> f (Sum f g b)
iwither Either i j -> a -> f (Maybe b)
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither (Either i j -> a -> f (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x
  iwither Either i j -> a -> f (Maybe b)
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither (Either i j -> a -> f (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y

  iwitherM :: forall (m :: * -> *) a b.
Monad m =>
(Either i j -> a -> m (Maybe b)) -> Sum f g a -> m (Sum f g b)
iwitherM Either i j -> a -> m (Maybe b)
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (m :: * -> *) a b.
(WitherableWithIndex i t, Monad m) =>
(i -> a -> m (Maybe b)) -> t a -> m (t b)
iwitherM (Either i j -> a -> m (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x
  iwitherM Either i j -> a -> m (Maybe b)
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (m :: * -> *) a b.
(WitherableWithIndex i t, Monad m) =>
(i -> a -> m (Maybe b)) -> t a -> m (t b)
iwitherM (Either i j -> a -> m (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y

  ifilterA :: forall (f :: * -> *) a.
Applicative f =>
(Either i j -> a -> f Bool) -> Sum f g a -> f (Sum f g a)
ifilterA Either i j -> a -> f Bool
f (Sum.InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Sum.InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA (Either i j -> a -> f Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
x
  ifilterA Either i j -> a -> f Bool
f (Sum.InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Sum.InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA (Either i j -> a -> f Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
y

deriving instance (FilterableWithIndex i f) => FilterableWithIndex i (IdentityT f)

instance (WitherableWithIndex i f) => WitherableWithIndex i (IdentityT f) where
  iwither :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f (Maybe b)) -> IdentityT f a -> f (IdentityT f b)
iwither i -> a -> f (Maybe b)
f (IdentityT f a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither i -> a -> f (Maybe b)
f f a
m
  iwitherM :: forall (m :: * -> *) a b.
Monad m =>
(i -> a -> m (Maybe b)) -> IdentityT f a -> m (IdentityT f b)
iwitherM i -> a -> m (Maybe b)
f (IdentityT f a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (m :: * -> *) a b.
(WitherableWithIndex i t, Monad m) =>
(i -> a -> m (Maybe b)) -> t a -> m (t b)
iwitherM i -> a -> m (Maybe b)
f f a
m
  ifilterA :: forall (f :: * -> *) a.
Applicative f =>
(i -> a -> f Bool) -> IdentityT f a -> f (IdentityT f a)
ifilterA i -> a -> f Bool
p (IdentityT f a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA i -> a -> f Bool
p f a
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 :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f (Maybe b)) -> Reverse t a -> f (Reverse t b)
iwither i -> a -> f (Maybe b)
f (Reverse t a
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards forall a b. (a -> b) -> a -> b
$ forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither (\i
i -> forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> f (Maybe b)
f i
i) t a
t
  -- We can't do anything special with iwitherM, because Backwards m is not
  -- generally a Monad.
  ifilterA :: forall (f :: * -> *) a.
Applicative f =>
(i -> a -> f Bool) -> Reverse t a -> f (Reverse t a)
ifilterA i -> a -> f Bool
p (Reverse t a
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards forall a b. (a -> b) -> a -> b
$ forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA (\i
i -> forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> f Bool
p i
i) t a
t

deriving instance FilterableWithIndex i t => FilterableWithIndex i (Backwards t)

instance WitherableWithIndex i t => WitherableWithIndex i (Backwards t) where
  iwither :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f (Maybe b)) -> Backwards t a -> f (Backwards t b)
iwither i -> a -> f (Maybe b)
f (Backwards t a
xs) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither i -> a -> f (Maybe b)
f t a
xs
  iwitherM :: forall (m :: * -> *) a b.
Monad m =>
(i -> a -> m (Maybe b)) -> Backwards t a -> m (Backwards t b)
iwitherM i -> a -> m (Maybe b)
f (Backwards t a
xs) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (m :: * -> *) a b.
(WitherableWithIndex i t, Monad m) =>
(i -> a -> m (Maybe b)) -> t a -> m (t b)
iwitherM i -> a -> m (Maybe b)
f t a
xs
  ifilterA :: forall (f :: * -> *) a.
Applicative f =>
(i -> a -> f Bool) -> Backwards t a -> f (Backwards t a)
ifilterA i -> a -> f Bool
f (Backwards t a
xs) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA i -> a -> f Bool
f t a
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
<$?> :: forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
(<$?>) = forall (f :: * -> *) a b.
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
f a
as <&?> :: forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
<&?> a -> Maybe b
f = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f f a
as
infixl 1 <&?>

-- | @'forMaybe' = 'flip' 'wither'@
forMaybe :: (Witherable t, Applicative f) => t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe :: forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
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 :: forall (t :: * -> *) a. (Witherable t, Ord a) => t a -> t a
ordNub = forall (t :: * -> *) b a.
(Witherable t, Ord b) =>
(a -> b) -> t a -> t a
ordNubOn forall a. a -> a
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 :: forall (t :: * -> *) b a.
(Witherable t, Ord b) =>
(a -> b) -> t a -> t a
ordNubOn a -> b
p t a
t = forall s a. State s a -> s -> a
evalState (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM forall {m :: * -> *}. Monad m => a -> StateT (Set b) m (Maybe a)
f t a
t) forall a. Set a
Set.empty where
    f :: a -> StateT (Set b) m (Maybe a)
f a
a = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \Set b
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 forall a (f :: * -> *).
(Ord a, Functor f) =>
(Bool -> f Bool) -> a -> Set a -> f (Set a)
Set.alterF (\Bool
x -> forall a. Bool -> a -> BoolPair a
BoolPair Bool
x Bool
True) (a -> b
p a
a) Set b
s of
        BoolPair Bool
True  Set b
s' -> (forall a. Maybe a
Nothing, Set b
s')
        BoolPair Bool
False Set b
s' -> (forall a. a -> Maybe a
Just a
a,  Set b
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 :: forall (t :: * -> *) a.
(Witherable t, Eq a, Hashable a) =>
t a -> t a
hashNub = forall (t :: * -> *) b a.
(Witherable t, Eq b, Hashable b) =>
(a -> b) -> t a -> t a
hashNubOn forall a. a -> a
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 :: forall (t :: * -> *) b a.
(Witherable t, Eq b, Hashable b) =>
(a -> b) -> t a -> t a
hashNubOn a -> b
p t a
t = forall s a. State s a -> s -> a
evalState (forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
witherM forall {m :: * -> *}.
Monad m =>
a -> StateT (HashSet b) m (Maybe a)
f t a
t) forall a. HashSet a
HSet.empty
  where
    f :: a -> StateT (HashSet b) m (Maybe a)
f a
a = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \HashSet b
s ->
      let g :: Maybe a -> BoolPair (Maybe ())
g Maybe a
Nothing  = forall a. Bool -> a -> BoolPair a
BoolPair Bool
False (forall a. a -> Maybe a
Just ())
          g (Just a
_) = forall a. Bool -> a -> BoolPair a
BoolPair Bool
True  (forall a. a -> Maybe a
Just ())
      -- there is no HashSet.alterF, but toMap / fromMap are newtype wrappers.
      in case forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HM.alterF forall {a}. Maybe a -> BoolPair (Maybe ())
g (a -> b
p a
a) (forall a. HashSet a -> HashMap a ()
HSet.toMap HashSet b
s) of
        BoolPair Bool
True  HashMap b ()
s' -> (forall a. Maybe a
Nothing, forall a. HashMap a () -> HashSet a
HSet.fromMap HashMap b ()
s')
        BoolPair Bool
False HashMap b ()
s' -> (forall a. a -> Maybe a
Just a
a,  forall a. HashMap a () -> HashSet a
HSet.fromMap HashMap b ()
s')
{-# INLINE hashNubOn #-}

-- used to implement *Nub functions.
data BoolPair a = BoolPair !Bool a deriving forall a b. a -> BoolPair b -> BoolPair a
forall a b. (a -> b) -> BoolPair a -> BoolPair b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BoolPair b -> BoolPair a
$c<$ :: forall a b. a -> BoolPair b -> BoolPair a
fmap :: forall a b. (a -> b) -> BoolPair a -> BoolPair b
$cfmap :: forall a b. (a -> b) -> BoolPair a -> BoolPair b
Functor

-- | A default implementation for 'mapMaybe'.
mapMaybeDefault :: (F.Foldable f, Alternative f) => (a -> Maybe b) -> f a -> f b
mapMaybeDefault :: forall (f :: * -> *) a b.
(Foldable f, Alternative f) =>
(a -> Maybe b) -> f a -> f b
mapMaybeDefault a -> Maybe b
p = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\a
x f b
xs -> case a -> Maybe b
p a
x of
    Just b
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f b
xs
    Maybe b
_ -> f b
xs) forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINABLE mapMaybeDefault #-}

-- | A default implementation for 'imapMaybe'.
imapMaybeDefault :: (FoldableWithIndex i f, Alternative f) => (i -> a -> Maybe b) -> f a -> f b
imapMaybeDefault :: forall i (f :: * -> *) a b.
(FoldableWithIndex i f, Alternative f) =>
(i -> a -> Maybe b) -> f a -> f b
imapMaybeDefault i -> a -> Maybe b
p = forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
ifoldr (\i
i a
x f b
xs -> case i -> a -> Maybe b
p i
i a
x of
    Just b
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f b
xs
    Maybe b
_ -> f b
xs) forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINABLE imapMaybeDefault #-}

newtype WrappedFoldable f a = WrapFilterable {forall (f :: * -> *) a. WrappedFoldable f a -> f a
unwrapFoldable :: f a}
  deriving (forall a b. a -> WrappedFoldable f b -> WrappedFoldable f a
forall a b. (a -> b) -> WrappedFoldable f a -> WrappedFoldable f b
forall (f :: * -> *) a b.
Functor f =>
a -> WrappedFoldable f b -> WrappedFoldable f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> WrappedFoldable f a -> WrappedFoldable f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WrappedFoldable f b -> WrappedFoldable f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> WrappedFoldable f b -> WrappedFoldable f a
fmap :: forall a b. (a -> b) -> WrappedFoldable f a -> WrappedFoldable f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> WrappedFoldable f a -> WrappedFoldable f b
Functor, forall a. Eq a => a -> WrappedFoldable f a -> Bool
forall a. Num a => WrappedFoldable f a -> a
forall a. Ord a => WrappedFoldable f a -> a
forall m. Monoid m => WrappedFoldable f m -> m
forall a. WrappedFoldable f a -> Bool
forall a. WrappedFoldable f a -> Int
forall a. WrappedFoldable f a -> [a]
forall a. (a -> a -> a) -> WrappedFoldable f a -> a
forall m a. Monoid m => (a -> m) -> WrappedFoldable f a -> m
forall b a. (b -> a -> b) -> b -> WrappedFoldable f a -> b
forall a b. (a -> b -> b) -> b -> WrappedFoldable f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> WrappedFoldable f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
WrappedFoldable f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WrappedFoldable f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
WrappedFoldable f m -> m
forall (f :: * -> *) a. Foldable f => WrappedFoldable f a -> Bool
forall (f :: * -> *) a. Foldable f => WrappedFoldable f a -> Int
forall (f :: * -> *) a. Foldable f => WrappedFoldable f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WrappedFoldable f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WrappedFoldable f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WrappedFoldable f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WrappedFoldable f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => WrappedFoldable f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
WrappedFoldable f a -> a
sum :: forall a. Num a => WrappedFoldable f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
WrappedFoldable f a -> a
minimum :: forall a. Ord a => WrappedFoldable f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WrappedFoldable f a -> a
maximum :: forall a. Ord a => WrappedFoldable f a -> a
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WrappedFoldable f a -> a
elem :: forall a. Eq a => a -> WrappedFoldable f a -> Bool
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> WrappedFoldable f a -> Bool
length :: forall a. WrappedFoldable f a -> Int
$clength :: forall (f :: * -> *) a. Foldable f => WrappedFoldable f a -> Int
null :: forall a. WrappedFoldable f a -> Bool
$cnull :: forall (f :: * -> *) a. Foldable f => WrappedFoldable f a -> Bool
toList :: forall a. WrappedFoldable f a -> [a]
$ctoList :: forall (f :: * -> *) a. Foldable f => WrappedFoldable f a -> [a]
foldl1 :: forall a. (a -> a -> a) -> WrappedFoldable f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WrappedFoldable f a -> a
foldr1 :: forall a. (a -> a -> a) -> WrappedFoldable f a -> a
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WrappedFoldable f a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> WrappedFoldable f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WrappedFoldable f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WrappedFoldable f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WrappedFoldable f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WrappedFoldable f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WrappedFoldable f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WrappedFoldable f a -> b
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WrappedFoldable f a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> WrappedFoldable f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WrappedFoldable f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WrappedFoldable f a -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WrappedFoldable f a -> m
fold :: forall m. Monoid m => WrappedFoldable f m -> m
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
WrappedFoldable f m -> m
F.Foldable, forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall {f :: * -> *}. Traversable f => Functor (WrappedFoldable f)
forall {f :: * -> *}. Traversable f => Foldable (WrappedFoldable f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
WrappedFoldable f (m a) -> m (WrappedFoldable f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
WrappedFoldable f (f a) -> f (WrappedFoldable f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> WrappedFoldable f a -> m (WrappedFoldable f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> WrappedFoldable f a -> f (WrappedFoldable f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WrappedFoldable f a -> f (WrappedFoldable f b)
sequence :: forall (m :: * -> *) a.
Monad m =>
WrappedFoldable f (m a) -> m (WrappedFoldable f a)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
WrappedFoldable f (m a) -> m (WrappedFoldable f a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WrappedFoldable f a -> m (WrappedFoldable f b)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> WrappedFoldable f a -> m (WrappedFoldable f b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WrappedFoldable f (f a) -> f (WrappedFoldable f a)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
WrappedFoldable f (f a) -> f (WrappedFoldable f a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WrappedFoldable f a -> f (WrappedFoldable f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> WrappedFoldable f a -> f (WrappedFoldable f b)
T.Traversable, forall a. a -> WrappedFoldable f a
forall a b.
WrappedFoldable f a -> WrappedFoldable f b -> WrappedFoldable f a
forall a b.
WrappedFoldable f a -> WrappedFoldable f b -> WrappedFoldable f b
forall a b.
WrappedFoldable f (a -> b)
-> WrappedFoldable f a -> WrappedFoldable f b
forall a b c.
(a -> b -> c)
-> WrappedFoldable f a
-> WrappedFoldable f b
-> WrappedFoldable f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {f :: * -> *}. Applicative f => Functor (WrappedFoldable f)
forall (f :: * -> *) a. Applicative f => a -> WrappedFoldable f a
forall (f :: * -> *) a b.
Applicative f =>
WrappedFoldable f a -> WrappedFoldable f b -> WrappedFoldable f a
forall (f :: * -> *) a b.
Applicative f =>
WrappedFoldable f a -> WrappedFoldable f b -> WrappedFoldable f b
forall (f :: * -> *) a b.
Applicative f =>
WrappedFoldable f (a -> b)
-> WrappedFoldable f a -> WrappedFoldable f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c)
-> WrappedFoldable f a
-> WrappedFoldable f b
-> WrappedFoldable f c
<* :: forall a b.
WrappedFoldable f a -> WrappedFoldable f b -> WrappedFoldable f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
WrappedFoldable f a -> WrappedFoldable f b -> WrappedFoldable f a
*> :: forall a b.
WrappedFoldable f a -> WrappedFoldable f b -> WrappedFoldable f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
WrappedFoldable f a -> WrappedFoldable f b -> WrappedFoldable f b
liftA2 :: forall a b c.
(a -> b -> c)
-> WrappedFoldable f a
-> WrappedFoldable f b
-> WrappedFoldable f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c)
-> WrappedFoldable f a
-> WrappedFoldable f b
-> WrappedFoldable f c
<*> :: forall a b.
WrappedFoldable f (a -> b)
-> WrappedFoldable f a -> WrappedFoldable f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
WrappedFoldable f (a -> b)
-> WrappedFoldable f a -> WrappedFoldable f b
pure :: forall a. a -> WrappedFoldable f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> WrappedFoldable f a
Applicative, forall a. WrappedFoldable f a
forall a. WrappedFoldable f a -> WrappedFoldable f [a]
forall a.
WrappedFoldable f a -> WrappedFoldable f a -> WrappedFoldable f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall {f :: * -> *}.
Alternative f =>
Applicative (WrappedFoldable f)
forall (f :: * -> *) a. Alternative f => WrappedFoldable f a
forall (f :: * -> *) a.
Alternative f =>
WrappedFoldable f a -> WrappedFoldable f [a]
forall (f :: * -> *) a.
Alternative f =>
WrappedFoldable f a -> WrappedFoldable f a -> WrappedFoldable f a
many :: forall a. WrappedFoldable f a -> WrappedFoldable f [a]
$cmany :: forall (f :: * -> *) a.
Alternative f =>
WrappedFoldable f a -> WrappedFoldable f [a]
some :: forall a. WrappedFoldable f a -> WrappedFoldable f [a]
$csome :: forall (f :: * -> *) a.
Alternative f =>
WrappedFoldable f a -> WrappedFoldable f [a]
<|> :: forall a.
WrappedFoldable f a -> WrappedFoldable f a -> WrappedFoldable f a
$c<|> :: forall (f :: * -> *) a.
Alternative f =>
WrappedFoldable f a -> WrappedFoldable f a -> WrappedFoldable f a
empty :: forall a. WrappedFoldable f a
$cempty :: forall (f :: * -> *) a. Alternative f => WrappedFoldable f a
Alternative)

instance (FunctorWithIndex i f) => FunctorWithIndex i (WrappedFoldable f) where
  imap :: forall a b.
(i -> a -> b) -> WrappedFoldable f a -> WrappedFoldable f b
imap i -> a -> b
f = forall (f :: * -> *) a. f a -> WrappedFoldable f a
WrapFilterable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. WrappedFoldable f a -> f a
unwrapFoldable

instance (FoldableWithIndex i f) => FoldableWithIndex i (WrappedFoldable f) where
  ifoldMap :: forall m a. Monoid m => (i -> a -> m) -> WrappedFoldable f a -> m
ifoldMap i -> a -> m
f = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap i -> a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. WrappedFoldable f a -> f a
unwrapFoldable

instance (TraversableWithIndex i f) => TraversableWithIndex i (WrappedFoldable f) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> WrappedFoldable f a -> f (WrappedFoldable f b)
itraverse i -> a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. f a -> WrappedFoldable f a
WrapFilterable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse i -> a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. WrappedFoldable f a -> f a
unwrapFoldable

instance (F.Foldable f, Alternative f) => Filterable (WrappedFoldable f) where
    {-#INLINE mapMaybe#-}
    mapMaybe :: forall a b.
(a -> Maybe b) -> WrappedFoldable f a -> WrappedFoldable f b
mapMaybe = forall (f :: * -> *) a b.
(Foldable f, Alternative f) =>
(a -> Maybe b) -> f a -> f b
mapMaybeDefault

instance (FunctorWithIndex i f, FoldableWithIndex i f, Alternative f) => FilterableWithIndex i (WrappedFoldable f) where
  {-# INLINE imapMaybe #-}
  imapMaybe :: forall a b.
(i -> a -> Maybe b) -> WrappedFoldable f a -> WrappedFoldable f b
imapMaybe = forall i (f :: * -> *) a b.
(FoldableWithIndex i f, Alternative f) =>
(i -> a -> Maybe b) -> f a -> f b
imapMaybeDefault

instance (Alternative f, T.Traversable f) => Witherable (WrappedFoldable f)