{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Witherable
-- Copyright   :  (c) Fumiaki Kinoshita 2015
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Data.Witherable {-# DEPRECATED "Use Witherable instead" #-}
  ( Filterable(..)
  , (<$?>)
  , (<&?>)
  , Witherable(..)
  , ordNub
  , ordNubOn
  , hashNub
  , hashNubOn
  , forMaybe
  -- * Indexed variants
  , FilterableWithIndex(..)
  , WitherableWithIndex(..)
  -- * Generalization
  , WitherLike, Wither, WitherLike', Wither'
  , FilterLike, Filter, FilterLike', Filter'
  , witherOf
  , forMaybeOf
  , mapMaybeOf
  , catMaybesOf
  , filterAOf
  , filterOf
  , ordNubOf
  , ordNubOnOf
  , hashNubOf
  , hashNubOnOf
   -- * Cloning
  , cloneFilter
  , Peat(..)
  -- * Wrapper
  , WrappedFoldable(..)
  ) where

import Control.Applicative
import Data.Functor.Identity
import Witherable
import qualified Data.Set as Set
import qualified Data.HashSet as HSet
import Control.Monad.Trans.State.Strict
import Data.Hashable
import Data.Coerce

type Filter s t a b = Wither s t a b
{-# DEPRECATED Filter "Use Wither instead" #-}
type FilterLike f s t a b = WitherLike f s t a b
{-# DEPRECATED FilterLike "Use WitherLike instead" #-}
type Filter' s a = Wither' s a
{-# DEPRECATED Filter' "Use Filter' instead" #-}
type FilterLike' f s a = WitherLike' f s a
{-# DEPRECATED FilterLike' "Use WitherLike' instead" #-}

-- | This type allows combinators to take a 'Filter' specializing the parameter @f@.
type WitherLike f s t a b = (a -> f (Maybe b)) -> s -> f t

-- | A 'Wither' is like a <http://hackage.haskell.org/package/lens-4.13.2.1/docs/Control-Lens-Type.html#t:Traversal Traversal>,
-- but you can also remove targets.
type Wither s t a b = forall f. Applicative f => WitherLike f s t a b

-- | A simple 'WitherLike'.
type WitherLike' f s a = WitherLike f s s a a

-- | A simple 'Wither'.
type Wither' s a = forall f. Applicative f => WitherLike' f s a

-- | This is used to characterize and clone a 'Filter'.
-- Since @FilterLike (Peat a b) s t a b@ is monomorphic, it can be used to store a filter in a container.
newtype Peat a b t = Peat { Peat a b t
-> forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f t
runPeat :: forall f. Applicative f => (a -> f (Maybe b)) -> f t }

instance Functor (Peat a b) where
  fmap :: (a -> b) -> Peat a b a -> Peat a b b
fmap a -> b
f (Peat forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f a
k) = (forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f b)
-> Peat a b b
forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f t)
-> Peat a b t
Peat ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (f a -> f b)
-> ((a -> f (Maybe b)) -> f a) -> (a -> f (Maybe b)) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Maybe b)) -> f a
forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f a
k)
  {-# INLINE fmap #-}

instance Applicative (Peat a b) where
  pure :: a -> Peat a b a
pure a
a = (forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f a)
-> Peat a b a
forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f t)
-> Peat a b t
Peat ((forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f a)
 -> Peat a b a)
-> (forall (f :: * -> *).
    Applicative f =>
    (a -> f (Maybe b)) -> f a)
-> Peat a b a
forall a b. (a -> b) -> a -> b
$ f a -> (a -> f (Maybe b)) -> f a
forall a b. a -> b -> a
const (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
  {-# INLINE pure #-}
  Peat forall (f :: * -> *).
Applicative f =>
(a -> f (Maybe b)) -> f (a -> b)
f <*> :: Peat a b (a -> b) -> Peat a b a -> Peat a b b
<*> Peat forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f a
g = (forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f b)
-> Peat a b b
forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f t)
-> Peat a b t
Peat ((forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f b)
 -> Peat a b b)
-> (forall (f :: * -> *).
    Applicative f =>
    (a -> f (Maybe b)) -> f b)
-> Peat a b b
forall a b. (a -> b) -> a -> b
$ \a -> f (Maybe b)
h -> (a -> f (Maybe b)) -> f (a -> b)
forall (f :: * -> *).
Applicative f =>
(a -> f (Maybe b)) -> f (a -> b)
f a -> f (Maybe b)
h f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f (Maybe b)) -> f a
forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f a
g a -> f (Maybe b)
h
  {-# INLINE (<*>) #-}
#if MIN_VERSION_base(4,10,0)
  liftA2 :: (a -> b -> c) -> Peat a b a -> Peat a b b -> Peat a b c
liftA2 a -> b -> c
f (Peat forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f a
xs) (Peat forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f b
ys) = (forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f c)
-> Peat a b c
forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f t)
-> Peat a b t
Peat ((forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f c)
 -> Peat a b c)
-> (forall (f :: * -> *).
    Applicative f =>
    (a -> f (Maybe b)) -> f c)
-> Peat a b c
forall a b. (a -> b) -> a -> b
$ \a -> f (Maybe b)
h -> (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f ((a -> f (Maybe b)) -> f a
forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f a
xs a -> f (Maybe b)
h) ((a -> f (Maybe b)) -> f b
forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f b
ys a -> f (Maybe b)
h)
  {-# INLINE liftA2 #-}
#endif

-- | Reconstitute a 'Filter' from its monomorphic form.
cloneFilter :: FilterLike (Peat a b) s t a b -> Filter s t a b
cloneFilter :: FilterLike (Peat a b) s t a b -> Filter s t a b
cloneFilter FilterLike (Peat a b) s t a b
l a -> f (Maybe b)
f = (\Peat a b t
a -> Peat a b t
a Peat a b t -> (a -> f (Maybe b)) -> f t
forall a b t.
Peat a b t
-> forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f t
`runPeat` a -> f (Maybe b)
f) (Peat a b t -> f t) -> (s -> Peat a b t) -> s -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterLike (Peat a b) s t a b
l (\a
a -> (forall (f :: * -> *).
 Applicative f =>
 (a -> f (Maybe b)) -> f (Maybe b))
-> Peat a b (Maybe b)
forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f (Maybe b)) -> f t)
-> Peat a b t
Peat ((forall (f :: * -> *).
  Applicative f =>
  (a -> f (Maybe b)) -> f (Maybe b))
 -> Peat a b (Maybe b))
-> (forall (f :: * -> *).
    Applicative f =>
    (a -> f (Maybe b)) -> f (Maybe b))
-> Peat a b (Maybe b)
forall a b. (a -> b) -> a -> b
$ \a -> f (Maybe b)
g -> a -> f (Maybe b)
g a
a)
{-# INLINABLE cloneFilter #-}

-- | 'witherOf' is actually 'id', but left for consistency.
witherOf :: FilterLike f s t a b -> (a -> f (Maybe b)) -> s -> f t
witherOf :: FilterLike f s t a b -> FilterLike f s t a b
witherOf = FilterLike f s t a b -> FilterLike f s t a b
forall a. a -> a
id
{-# INLINE witherOf #-}

-- | @'forMaybeOf' ≡ 'flip'@
forMaybeOf :: FilterLike f s t a b -> s -> (a -> f (Maybe b)) -> f t
forMaybeOf :: FilterLike f s t a b -> s -> (a -> f (Maybe b)) -> f t
forMaybeOf = FilterLike f s t a b -> s -> (a -> f (Maybe b)) -> f t
forall a b c. (a -> b -> c) -> b -> a -> c
flip
{-# INLINE forMaybeOf #-}

-- In case mapMaybeOf or filterOf is called with a function of
-- unknown arity, we don't want to slow things down to raise
-- its arity.
idDot :: (a -> b) -> a -> Identity b
idDot :: (a -> b) -> a -> Identity b
idDot = (a -> b) -> a -> Identity b
coerce

-- | 'mapMaybe' through a filter.
mapMaybeOf :: FilterLike Identity s t a b -> (a -> Maybe b) -> s -> t
mapMaybeOf :: FilterLike Identity s t a b -> (a -> Maybe b) -> s -> t
mapMaybeOf FilterLike Identity s t a b
w a -> Maybe b
f = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterLike Identity s t a b
w ((a -> Maybe b) -> a -> Identity (Maybe b)
forall a b. (a -> b) -> a -> Identity b
idDot a -> Maybe b
f)
{-# INLINE mapMaybeOf #-}

-- | 'catMaybes' through a filter.
catMaybesOf :: FilterLike Identity s t (Maybe a) a -> s -> t
catMaybesOf :: FilterLike Identity s t (Maybe a) a -> s -> t
catMaybesOf FilterLike Identity s t (Maybe a) a
w = FilterLike Identity s t (Maybe a) a
-> (Maybe a -> Maybe a) -> s -> t
forall s t a b.
FilterLike Identity s t a b -> (a -> Maybe b) -> s -> t
mapMaybeOf FilterLike Identity s t (Maybe a) a
w Maybe a -> Maybe a
forall a. a -> a
id
{-# INLINE catMaybesOf #-}

-- | 'filterA' through a filter.
filterAOf :: Functor f => FilterLike' f s a -> (a -> f Bool) -> s -> f s
filterAOf :: FilterLike' f s a -> (a -> f Bool) -> s -> f s
filterAOf FilterLike' f s a
w a -> f Bool
f = FilterLike' f s a
w FilterLike' f s a -> FilterLike' f s a
forall a b. (a -> b) -> a -> b
$ \a
a -> (\Bool
b -> if Bool
b then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing) (Bool -> Maybe a) -> f Bool -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f Bool
f a
a
{-# INLINABLE filterAOf #-}

-- | Filter each element of a structure targeted by a 'Filter'.
filterOf :: FilterLike' Identity s a -> (a -> Bool) -> s -> s
filterOf :: FilterLike' Identity s a -> (a -> Bool) -> s -> s
filterOf FilterLike' Identity s a
w a -> Bool
f = Identity s -> s
forall a. Identity a -> a
runIdentity (Identity s -> s) -> (s -> Identity s) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterLike' Identity s a -> (a -> Identity Bool) -> s -> Identity s
forall (f :: * -> *) s a.
Functor f =>
FilterLike' f s a -> (a -> f Bool) -> s -> f s
filterAOf FilterLike' Identity s a
w ((a -> Bool) -> a -> Identity Bool
forall a b. (a -> b) -> a -> Identity b
idDot a -> Bool
f)
{-# INLINE filterOf #-}

-- | Remove the duplicate elements through a filter.
ordNubOf :: Ord a => FilterLike' (State (Set.Set a)) s a -> s -> s
ordNubOf :: FilterLike' (State (Set a)) s a -> s -> s
ordNubOf FilterLike' (State (Set a)) s a
w = FilterLike' (State (Set a)) s a -> (a -> a) -> s -> s
forall b s a.
Ord b =>
FilterLike' (State (Set b)) s a -> (a -> b) -> s -> s
ordNubOnOf FilterLike' (State (Set a)) s a
w a -> a
forall a. a -> a
id

-- | Remove the duplicate elements through a filter.
ordNubOnOf :: Ord b => FilterLike' (State (Set.Set b)) s a -> (a -> b) -> s -> s
ordNubOnOf :: FilterLike' (State (Set b)) s a -> (a -> b) -> s -> s
ordNubOnOf FilterLike' (State (Set b)) s a
w a -> b
p s
t = State (Set b) s -> Set b -> s
forall s a. State s a -> s -> a
evalState (FilterLike' (State (Set b)) s a
w a -> StateT (Set b) Identity (Maybe a)
forall (m :: * -> *). Monad m => a -> StateT (Set b) m (Maybe a)
f s
t) Set b
forall a. Set a
Set.empty
  where
    f :: a -> StateT (Set b) m (Maybe a)
f a
a = let b :: b
b = a -> b
p a
a in (Set b -> (Maybe a, Set b)) -> StateT (Set b) m (Maybe a)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Set b -> (Maybe a, Set b)) -> StateT (Set b) m (Maybe a))
-> (Set b -> (Maybe a, Set b)) -> StateT (Set b) m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Set b
s -> if b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member b
b Set b
s
      then (Maybe a
forall a. Maybe a
Nothing, Set b
s)
      else (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
b Set b
s)
{-# INLINE ordNubOf #-}

-- | Remove the duplicate elements through a filter.
-- It is often faster than 'ordNubOf', especially when the comparison is expensive.
hashNubOf :: (Eq a, Hashable a) => FilterLike' (State (HSet.HashSet a)) s a -> s -> s
hashNubOf :: FilterLike' (State (HashSet a)) s a -> s -> s
hashNubOf FilterLike' (State (HashSet a)) s a
w = FilterLike' (State (HashSet a)) s a -> (a -> a) -> s -> s
forall b s a.
(Eq b, Hashable b) =>
FilterLike' (State (HashSet b)) s a -> (a -> b) -> s -> s
hashNubOnOf FilterLike' (State (HashSet a)) s a
w a -> a
forall a. a -> a
id

-- | Remove the duplicate elements through a filter.
hashNubOnOf :: (Eq b, Hashable b) => FilterLike' (State (HSet.HashSet b)) s a -> (a -> b) -> s -> s
hashNubOnOf :: FilterLike' (State (HashSet b)) s a -> (a -> b) -> s -> s
hashNubOnOf FilterLike' (State (HashSet b)) s a
w a -> b
p s
t = State (HashSet b) s -> HashSet b -> s
forall s a. State s a -> s -> a
evalState (FilterLike' (State (HashSet b)) s a
w a -> StateT (HashSet b) Identity (Maybe a)
forall (m :: * -> *).
Monad m =>
a -> StateT (HashSet b) m (Maybe a)
f s
t) HashSet b
forall a. HashSet a
HSet.empty
  where
    f :: a -> StateT (HashSet b) m (Maybe a)
f a
a = let b :: b
b = a -> b
p a
a in (HashSet b -> (Maybe a, HashSet b))
-> StateT (HashSet b) m (Maybe a)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((HashSet b -> (Maybe a, HashSet b))
 -> StateT (HashSet b) m (Maybe a))
-> (HashSet b -> (Maybe a, HashSet b))
-> StateT (HashSet b) m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \HashSet b
s -> if b -> HashSet b -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HSet.member b
b HashSet b
s
      then (Maybe a
forall a. Maybe a
Nothing, HashSet b
s)
      else (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b -> HashSet b -> HashSet b
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HSet.insert b
b HashSet b
s)
{-# INLINE hashNubOf #-}