module Witherable.Lens where
import Data.Functor.Identity (Identity(runIdentity))
import Witherable (Witherable(wither))
import Witherable.Lens.Withering
import Control.Monad.Trans.State.Strict (State, evalState, gets, modify')
import Data.Set (Set)
import qualified Data.Set as S
import Data.Hashable (Hashable)
import Data.HashSet (HashSet)
import qualified Data.HashSet as H
withered
:: (Applicative f, Witherable t)
=> (a -> Withering f b) -> t a -> f (t b)
withered :: forall (f :: * -> *) (t :: * -> *) a b.
(Applicative f, Witherable t) =>
(a -> Withering f b) -> t a -> f (t b)
withered a -> Withering f b
f = (a -> f (Maybe b)) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither (Withering f b -> f (Maybe b)
forall (f :: * -> *) a. Withering f a -> f (Maybe a)
runWithering (Withering f b -> f (Maybe b))
-> (a -> Withering f b) -> a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Withering f b
f)
unwithered :: Functor f => (a -> f b) -> a -> Withering f b
unwithered :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> a -> Withering f b
unwithered a -> f b
f a
s = f (Maybe b) -> Withering f b
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering ((b -> Maybe b) -> f b -> f (Maybe b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just (a -> f b
f a
s))
rewithered
:: (Applicative f, Witherable t)
=> (a -> Withering f b) -> t a -> Withering f (t b)
rewithered :: forall (f :: * -> *) (t :: * -> *) a b.
(Applicative f, Witherable t) =>
(a -> Withering f b) -> t a -> Withering f (t b)
rewithered = (t a -> f (t b)) -> t a -> Withering f (t b)
forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> a -> Withering f b
unwithered ((t a -> f (t b)) -> t a -> Withering f (t b))
-> ((a -> Withering f b) -> t a -> f (t b))
-> (a -> Withering f b)
-> t a
-> Withering f (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Withering f b) -> t a -> f (t b)
forall (f :: * -> *) (t :: * -> *) a b.
(Applicative f, Witherable t) =>
(a -> Withering f b) -> t a -> f (t b)
withered
decayed :: Applicative f => pafb -> s -> Withering f t
decayed :: forall (f :: * -> *) pafb s t.
Applicative f =>
pafb -> s -> Withering f t
decayed pafb
_ s
_ = Withering f t
forall (f :: * -> *) a. Applicative f => Withering f a
empty
guarded
:: Applicative f
=> (a -> Bool) -> (a -> Withering f b)
-> a -> Withering f b
guarded :: forall (f :: * -> *) a b.
Applicative f =>
(a -> Bool) -> (a -> Withering f b) -> a -> Withering f b
guarded a -> Bool
p a -> Withering f b
f a
a
| a -> Bool
p a
a = a -> Withering f b
f a
a
| Bool
otherwise = Withering f b
forall (f :: * -> *) a. Applicative f => Withering f a
empty
witherOf
:: ((a -> Withering f b) -> s -> f t)
-> (a -> f (Maybe b)) -> s -> f t
witherOf :: forall a (f :: * -> *) b s t.
((a -> Withering f b) -> s -> f t)
-> (a -> f (Maybe b)) -> s -> f t
witherOf (a -> Withering f b) -> s -> f t
w a -> f (Maybe b)
p = (a -> Withering f b) -> s -> f t
w (f (Maybe b) -> Withering f b
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering (f (Maybe b) -> Withering f b)
-> (a -> f (Maybe b)) -> a -> Withering f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f (Maybe b)
p)
forMaybeOf
:: ((a -> Withering f b) -> s -> f t)
-> s -> (a -> f (Maybe b)) -> f t
forMaybeOf :: forall a (f :: * -> *) b s t.
((a -> Withering f b) -> s -> f t)
-> s -> (a -> f (Maybe b)) -> f t
forMaybeOf (a -> Withering f b) -> s -> f t
w s
s a -> f (Maybe b)
p = ((a -> Withering f b) -> s -> f t)
-> (a -> f (Maybe b)) -> s -> f t
forall a (f :: * -> *) b s t.
((a -> Withering f b) -> s -> f t)
-> (a -> f (Maybe b)) -> s -> f t
witherOf (a -> Withering f b) -> s -> f t
w a -> f (Maybe b)
p s
s
mapMaybeOf
:: ((a -> Withering Identity b) -> s -> Identity t)
-> (a -> Maybe b) -> s -> t
mapMaybeOf :: forall a b s t.
((a -> Withering Identity b) -> s -> Identity t)
-> (a -> Maybe b) -> s -> t
mapMaybeOf (a -> Withering Identity b) -> s -> Identity t
w a -> Maybe b
p = 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
. (a -> Withering Identity b) -> s -> Identity t
w (Identity (Maybe b) -> Withering Identity b
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering (Identity (Maybe b) -> Withering Identity b)
-> (a -> Identity (Maybe b)) -> a -> Withering Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> Identity (Maybe b)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> Identity (Maybe b))
-> (a -> Maybe b) -> a -> Identity (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
p)
catMaybesOf
:: ((Maybe a -> Withering Identity a) -> s -> Identity t)
-> s -> t
catMaybesOf :: forall a s t.
((Maybe a -> Withering Identity a) -> s -> Identity t) -> s -> t
catMaybesOf (Maybe a -> Withering Identity a) -> s -> Identity t
w = 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
. (Maybe a -> Withering Identity a) -> s -> Identity t
w Maybe a -> Withering Identity a
forall {f :: * -> *} {a}. Applicative f => Maybe a -> Withering f a
toWithering
where
toWithering :: Maybe a -> Withering f a
toWithering Maybe a
Nothing = Withering f a
forall (f :: * -> *) a. Applicative f => Withering f a
empty
toWithering (Just a
x) = a -> Withering f a
forall a. a -> Withering f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
filterAOf
:: Applicative f
=> ((a -> Withering f a) -> s -> f s)
-> (a -> f Bool) -> s -> f s
filterAOf :: forall (f :: * -> *) a s.
Applicative f =>
((a -> Withering f a) -> s -> f s) -> (a -> f Bool) -> s -> f s
filterAOf (a -> Withering f a) -> s -> f s
w a -> f Bool
p = (a -> Withering f a) -> s -> f s
w a -> Withering f a
toWitheringA
where
toWitheringA :: a -> Withering f a
toWitheringA a
a = f (Maybe a) -> Withering f a
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering (f (Maybe a) -> Withering f a) -> f (Maybe a) -> Withering f a
forall a b. (a -> b) -> a -> b
$ (\Bool
x -> if Bool
x 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
p a
a
filterOf
:: ((a -> Withering Identity a) -> s -> Identity s)
-> (a -> Bool) -> s -> s
filterOf :: forall a s.
((a -> Withering Identity a) -> s -> Identity s)
-> (a -> Bool) -> s -> s
filterOf (a -> Withering Identity a) -> s -> Identity s
w a -> Bool
p = 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
. (a -> Withering Identity a) -> s -> Identity s
w a -> Withering Identity a
forall {f :: * -> *}. Applicative f => a -> Withering f a
toWithering
where
toWithering :: a -> Withering f a
toWithering a
a
| a -> Bool
p a
a = a -> Withering f a
forall a. a -> Withering f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
| Bool
otherwise = Withering f a
forall (f :: * -> *) a. Applicative f => Withering f a
empty
ordNubOf
:: Ord a
=> ((a -> Withering (State (Set a)) a) -> s -> State (Set a) s)
-> s -> s
ordNubOf :: forall a s.
Ord a =>
((a -> Withering (State (Set a)) a) -> s -> State (Set a) s)
-> s -> s
ordNubOf (a -> Withering (State (Set a)) a) -> s -> State (Set a) s
w = ((a -> Withering (State (Set a)) a) -> s -> State (Set a) s)
-> (a -> a) -> s -> s
forall b a s.
Ord b =>
((a -> Withering (State (Set b)) a) -> s -> State (Set b) s)
-> (a -> b) -> s -> s
ordNubOnOf (a -> Withering (State (Set a)) a) -> s -> State (Set a) s
w a -> a
forall a. a -> a
id
ordNubOnOf
:: Ord b
=> ((a -> Withering (State (Set b)) a) -> s -> State (Set b) s)
-> (a -> b)
-> s -> s
ordNubOnOf :: forall b a s.
Ord b =>
((a -> Withering (State (Set b)) a) -> s -> State (Set b) s)
-> (a -> b) -> s -> s
ordNubOnOf (a -> Withering (State (Set b)) a) -> s -> State (Set b) s
w a -> b
f s
s = State (Set b) s -> Set b -> s
forall s a. State s a -> s -> a
evalState ((a -> Withering (State (Set b)) a) -> s -> State (Set b) s
w a -> Withering (State (Set b)) a
forall {m :: * -> *}.
Monad m =>
a -> Withering (StateT (Set b) m) a
doWithering s
s) Set b
forall a. Set a
S.empty
where
doWithering :: a -> Withering (StateT (Set b) m) a
doWithering a
x = StateT (Set b) m (Maybe a) -> Withering (StateT (Set b) m) a
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering (StateT (Set b) m (Maybe a) -> Withering (StateT (Set b) m) a)
-> StateT (Set b) m (Maybe a) -> Withering (StateT (Set b) m) a
forall a b. (a -> b) -> a -> b
$ do
let fx :: b
fx = a -> b
f a
x
Bool
seen <- (Set b -> Bool) -> StateT (Set b) m Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member b
fx)
if Bool
seen
then Maybe a -> StateT (Set b) m (Maybe a)
forall a. a -> StateT (Set b) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
else do
(Set b -> Set b) -> StateT (Set b) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
S.insert b
fx)
Maybe a -> StateT (Set b) m (Maybe a)
forall a. a -> StateT (Set b) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
hashNubOf
:: (Eq a, Hashable a)
=> ((a -> Withering (State (HashSet a)) a) -> s -> State (HashSet a) s)
-> s -> s
hashNubOf :: forall a s.
(Eq a, Hashable a) =>
((a -> Withering (State (HashSet a)) a)
-> s -> State (HashSet a) s)
-> s -> s
hashNubOf (a -> Withering (State (HashSet a)) a) -> s -> State (HashSet a) s
w = ((a -> Withering (State (HashSet a)) a)
-> s -> State (HashSet a) s)
-> (a -> a) -> s -> s
forall b a s.
(Eq b, Hashable b) =>
((a -> Withering (State (HashSet b)) a)
-> s -> State (HashSet b) s)
-> (a -> b) -> s -> s
hashNubOnOf (a -> Withering (State (HashSet a)) a) -> s -> State (HashSet a) s
w a -> a
forall a. a -> a
id
hashNubOnOf
:: (Eq b, Hashable b)
=> ((a -> Withering (State (HashSet b)) a) -> s -> State (HashSet b) s)
-> (a -> b)
-> s -> s
hashNubOnOf :: forall b a s.
(Eq b, Hashable b) =>
((a -> Withering (State (HashSet b)) a)
-> s -> State (HashSet b) s)
-> (a -> b) -> s -> s
hashNubOnOf (a -> Withering (State (HashSet b)) a) -> s -> State (HashSet b) s
w a -> b
f s
s = State (HashSet b) s -> HashSet b -> s
forall s a. State s a -> s -> a
evalState ((a -> Withering (State (HashSet b)) a) -> s -> State (HashSet b) s
w a -> Withering (State (HashSet b)) a
forall {m :: * -> *}.
Monad m =>
a -> Withering (StateT (HashSet b) m) a
doWithering s
s) HashSet b
forall a. HashSet a
H.empty
where
doWithering :: a -> Withering (StateT (HashSet b) m) a
doWithering a
x = StateT (HashSet b) m (Maybe a)
-> Withering (StateT (HashSet b) m) a
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering (StateT (HashSet b) m (Maybe a)
-> Withering (StateT (HashSet b) m) a)
-> StateT (HashSet b) m (Maybe a)
-> Withering (StateT (HashSet b) m) a
forall a b. (a -> b) -> a -> b
$ do
let fx :: b
fx = a -> b
f a
x
Bool
seen <- (HashSet b -> Bool) -> StateT (HashSet b) m Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (b -> HashSet b -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
H.member b
fx)
if Bool
seen
then Maybe a -> StateT (HashSet b) m (Maybe a)
forall a. a -> StateT (HashSet b) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
else do
(HashSet b -> HashSet b) -> StateT (HashSet b) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (b -> HashSet b -> HashSet b
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
H.insert b
fx)
Maybe a -> StateT (HashSet b) m (Maybe a)
forall a. a -> StateT (HashSet b) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x)