module Data.Profunctor.Withering where import Data.Profunctor import Data.Profunctor.Traversing import Control.Applicative class (Traversing p) => Withering p where cull :: (forall f. Alternative f => (a -> f b) -> (s -> f t)) -> p a b -> p s t instance Alternative f => Withering (Star f) where cull :: (forall (f :: * -> *). Alternative f => (a -> f b) -> s -> f t) -> Star f a b -> Star f s t cull f :: forall (f :: * -> *). Alternative f => (a -> f b) -> s -> f t f (Star amb :: a -> f b amb) = (s -> f t) -> Star f s t forall (f :: * -> *) d c. (d -> f c) -> Star f d c Star ((a -> f b) -> s -> f t forall (f :: * -> *). Alternative f => (a -> f b) -> s -> f t f a -> f b amb) instance Monoid m => Withering (Forget m) where cull :: (forall (f :: * -> *). Alternative f => (a -> f b) -> s -> f t) -> Forget m a b -> Forget m s t cull f :: forall (f :: * -> *). Alternative f => (a -> f b) -> s -> f t f (Forget h :: a -> m h) = (s -> m) -> Forget m s t forall r a b. (a -> r) -> Forget r a b Forget (AltConst m t -> m forall p b. Monoid p => AltConst p b -> p getAnnihilation (AltConst m t -> m) -> (s -> AltConst m t) -> s -> m forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> AltConst m b) -> s -> AltConst m t forall (f :: * -> *). Alternative f => (a -> f b) -> s -> f t f (Maybe m -> AltConst m b forall a b. Maybe a -> AltConst a b AltConst (Maybe m -> AltConst m b) -> (a -> Maybe m) -> a -> AltConst m b forall b c a. (b -> c) -> (a -> b) -> a -> c . m -> Maybe m forall a. a -> Maybe a Just (m -> Maybe m) -> (a -> m) -> a -> Maybe m forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> m h)) where getAnnihilation :: AltConst p b -> p getAnnihilation (AltConst Nothing) = p forall a. Monoid a => a mempty getAnnihilation (AltConst (Just m :: p m)) = p m newtype AltConst a b = AltConst (Maybe a) deriving stock (AltConst a b -> AltConst a b -> Bool (AltConst a b -> AltConst a b -> Bool) -> (AltConst a b -> AltConst a b -> Bool) -> Eq (AltConst a b) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall a b. Eq a => AltConst a b -> AltConst a b -> Bool /= :: AltConst a b -> AltConst a b -> Bool $c/= :: forall a b. Eq a => AltConst a b -> AltConst a b -> Bool == :: AltConst a b -> AltConst a b -> Bool $c== :: forall a b. Eq a => AltConst a b -> AltConst a b -> Bool Eq, Eq (AltConst a b) Eq (AltConst a b) => (AltConst a b -> AltConst a b -> Ordering) -> (AltConst a b -> AltConst a b -> Bool) -> (AltConst a b -> AltConst a b -> Bool) -> (AltConst a b -> AltConst a b -> Bool) -> (AltConst a b -> AltConst a b -> Bool) -> (AltConst a b -> AltConst a b -> AltConst a b) -> (AltConst a b -> AltConst a b -> AltConst a b) -> Ord (AltConst a b) AltConst a b -> AltConst a b -> Bool AltConst a b -> AltConst a b -> Ordering AltConst a b -> AltConst a b -> AltConst a b forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall a b. Ord a => Eq (AltConst a b) forall a b. Ord a => AltConst a b -> AltConst a b -> Bool forall a b. Ord a => AltConst a b -> AltConst a b -> Ordering forall a b. Ord a => AltConst a b -> AltConst a b -> AltConst a b min :: AltConst a b -> AltConst a b -> AltConst a b $cmin :: forall a b. Ord a => AltConst a b -> AltConst a b -> AltConst a b max :: AltConst a b -> AltConst a b -> AltConst a b $cmax :: forall a b. Ord a => AltConst a b -> AltConst a b -> AltConst a b >= :: AltConst a b -> AltConst a b -> Bool $c>= :: forall a b. Ord a => AltConst a b -> AltConst a b -> Bool > :: AltConst a b -> AltConst a b -> Bool $c> :: forall a b. Ord a => AltConst a b -> AltConst a b -> Bool <= :: AltConst a b -> AltConst a b -> Bool $c<= :: forall a b. Ord a => AltConst a b -> AltConst a b -> Bool < :: AltConst a b -> AltConst a b -> Bool $c< :: forall a b. Ord a => AltConst a b -> AltConst a b -> Bool compare :: AltConst a b -> AltConst a b -> Ordering $ccompare :: forall a b. Ord a => AltConst a b -> AltConst a b -> Ordering $cp1Ord :: forall a b. Ord a => Eq (AltConst a b) Ord, Int -> AltConst a b -> ShowS [AltConst a b] -> ShowS AltConst a b -> String (Int -> AltConst a b -> ShowS) -> (AltConst a b -> String) -> ([AltConst a b] -> ShowS) -> Show (AltConst a b) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall a b. Show a => Int -> AltConst a b -> ShowS forall a b. Show a => [AltConst a b] -> ShowS forall a b. Show a => AltConst a b -> String showList :: [AltConst a b] -> ShowS $cshowList :: forall a b. Show a => [AltConst a b] -> ShowS show :: AltConst a b -> String $cshow :: forall a b. Show a => AltConst a b -> String showsPrec :: Int -> AltConst a b -> ShowS $cshowsPrec :: forall a b. Show a => Int -> AltConst a b -> ShowS Show, (a -> b) -> AltConst a a -> AltConst a b (forall a b. (a -> b) -> AltConst a a -> AltConst a b) -> (forall a b. a -> AltConst a b -> AltConst a a) -> Functor (AltConst a) forall a b. a -> AltConst a b -> AltConst a a forall a b. (a -> b) -> AltConst a a -> AltConst a b forall a a b. a -> AltConst a b -> AltConst a a forall a a b. (a -> b) -> AltConst a a -> AltConst a b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> AltConst a b -> AltConst a a $c<$ :: forall a a b. a -> AltConst a b -> AltConst a a fmap :: (a -> b) -> AltConst a a -> AltConst a b $cfmap :: forall a a b. (a -> b) -> AltConst a a -> AltConst a b Functor) instance Monoid a => Applicative (AltConst a) where pure :: a -> AltConst a a pure _ = (Maybe a -> AltConst a a forall a b. Maybe a -> AltConst a b AltConst (a -> Maybe a forall a. a -> Maybe a Just a forall a. Monoid a => a mempty)) (AltConst Nothing) <*> :: AltConst a (a -> b) -> AltConst a a -> AltConst a b <*> _ = (Maybe a -> AltConst a b forall a b. Maybe a -> AltConst a b AltConst Maybe a forall a. Maybe a Nothing) _ <*> (AltConst Nothing) = (Maybe a -> AltConst a b forall a b. Maybe a -> AltConst a b AltConst Maybe a forall a. Maybe a Nothing) (AltConst (Just a :: a a)) <*> (AltConst (Just b :: a b)) = Maybe a -> AltConst a b forall a b. Maybe a -> AltConst a b AltConst (a -> Maybe a forall a. a -> Maybe a Just (a a a -> a -> a forall a. Semigroup a => a -> a -> a <> a b)) instance (Semigroup a) => Semigroup (AltConst a x) where (AltConst Nothing) <> :: AltConst a x -> AltConst a x -> AltConst a x <> _ = (Maybe a -> AltConst a x forall a b. Maybe a -> AltConst a b AltConst Maybe a forall a. Maybe a Nothing) _ <> (AltConst Nothing) = (Maybe a -> AltConst a x forall a b. Maybe a -> AltConst a b AltConst Maybe a forall a. Maybe a Nothing) (AltConst (Just a :: a a)) <> (AltConst (Just b :: a b)) = Maybe a -> AltConst a x forall a b. Maybe a -> AltConst a b AltConst (a -> Maybe a forall a. a -> Maybe a Just (a a a -> a -> a forall a. Semigroup a => a -> a -> a <> a b)) instance (Monoid a) => Monoid (AltConst a x) where mempty :: AltConst a x mempty = (Maybe a -> AltConst a x forall a b. Maybe a -> AltConst a b AltConst (a -> Maybe a forall a. a -> Maybe a Just a forall a. Monoid a => a mempty)) instance Monoid m => Alternative (AltConst m) where empty :: AltConst m a empty = (Maybe m -> AltConst m a forall a b. Maybe a -> AltConst a b AltConst Maybe m forall a. Maybe a Nothing) (AltConst Nothing) <|> :: AltConst m a -> AltConst m a -> AltConst m a <|> a :: AltConst m a a = AltConst m a a a :: AltConst m a a <|> (AltConst Nothing) = AltConst m a a (AltConst (Just a :: m a)) <|> (AltConst (Just b :: m b)) = (Maybe m -> AltConst m a forall a b. Maybe a -> AltConst a b AltConst (m -> Maybe m forall a. a -> Maybe a Just (m a m -> m -> m forall a. Semigroup a => a -> a -> a <> m b)))