{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE InstanceSigs #-} module Proton.Fold where import Data.Profunctor import Data.Profunctor.Traversing import Data.Profunctor.Phantom import Data.Monoid import Proton.Types import Data.Foldable type Fold s t a b = forall p. (Traversing p, Phantom p) => p a b -> p s t folding :: (Foldable f, Phantom p, Traversing p) => (s -> f a) -> p a b -> p s t folding :: (s -> f a) -> p a b -> p s t folding f :: s -> f a f = p s [b] -> p s t forall (p :: * -> * -> *) a x y. Phantom p => p a x -> p a y phantom (p s [b] -> p s t) -> (p a b -> p s [b]) -> p a b -> p s t forall b c a. (b -> c) -> (a -> b) -> a -> c . (s -> [a]) -> p [a] [b] -> p s [b] forall (p :: * -> * -> *) a b c. Profunctor p => (a -> b) -> p b c -> p a c lmap (f a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] toList (f a -> [a]) -> (s -> f a) -> s -> [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . s -> f a f) (p [a] [b] -> p s [b]) -> (p a b -> p [a] [b]) -> p a b -> p s [b] forall b c a. (b -> c) -> (a -> b) -> a -> c . p a b -> p [a] [b] forall (p :: * -> * -> *) (f :: * -> *) a b. (Traversing p, Traversable f) => p a b -> p (f a) (f b) traverse' folded :: (Traversing p, Foldable f, Phantom p) => p a b -> p (f a) t folded :: p a b -> p (f a) t folded = p (f a) [b] -> p (f a) t forall (p :: * -> * -> *) a x y. Phantom p => p a x -> p a y phantom (p (f a) [b] -> p (f a) t) -> (p a b -> p (f a) [b]) -> p a b -> p (f a) t forall b c a. (b -> c) -> (a -> b) -> a -> c . (f a -> [a]) -> p [a] [b] -> p (f a) [b] forall (p :: * -> * -> *) a b c. Profunctor p => (a -> b) -> p b c -> p a c lmap f a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] toList (p [a] [b] -> p (f a) [b]) -> (p a b -> p [a] [b]) -> p a b -> p (f a) [b] forall b c a. (b -> c) -> (a -> b) -> a -> c . p a b -> p [a] [b] forall (p :: * -> * -> *) (f :: * -> *) a b. (Traversing p, Traversable f) => p a b -> p (f a) (f b) traverse' foldOf :: Monoid a => Fold s t a b -> s -> a foldOf :: Fold s t a b -> s -> a foldOf f :: Fold s t a b f = Forget a s t -> s -> a forall r a b. Forget r a b -> a -> r runForget (Forget a a b -> Forget a s t Fold s t a b f ((a -> a) -> Forget a a b forall r a b. (a -> r) -> Forget r a b Forget a -> a forall a. a -> a id)) foldMapOf :: Monoid m => Optic (Forget m) s t a b -> (a -> m) -> s -> m foldMapOf :: Optic (Forget m) s t a b -> (a -> m) -> s -> m foldMapOf f :: Optic (Forget m) s t a b f into :: a -> m into = Forget m s t -> s -> m forall r a b. Forget r a b -> a -> r runForget (Optic (Forget m) s t a b f ((a -> m) -> Forget m a b forall r a b. (a -> r) -> Forget r a b Forget a -> m into)) toListOf :: Optic (Forget [a]) s t a b -> s -> [a] toListOf :: Optic (Forget [a]) s t a b -> s -> [a] toListOf fld :: Optic (Forget [a]) s t a b fld = Optic (Forget [a]) s t a b -> (a -> [a]) -> s -> [a] forall m s t a b. Monoid m => Optic (Forget m) s t a b -> (a -> m) -> s -> m foldMapOf Optic (Forget [a]) s t a b fld a -> [a] forall (f :: * -> *) a. Applicative f => a -> f a pure preview :: Optic (Forget (First a)) s t a b -> s -> Maybe a preview :: Optic (Forget (First a)) s t a b -> s -> Maybe a preview fld :: Optic (Forget (First a)) s t a b fld = First a -> Maybe a forall a. First a -> Maybe a getFirst (First a -> Maybe a) -> (s -> First a) -> s -> Maybe a forall b c a. (b -> c) -> (a -> b) -> a -> c . Optic (Forget (First a)) s t a b -> (a -> First a) -> s -> First a forall m s t a b. Monoid m => Optic (Forget m) s t a b -> (a -> m) -> s -> m foldMapOf Optic (Forget (First a)) s t a b fld (Maybe a -> First a forall a. Maybe a -> First a First (Maybe a -> First a) -> (a -> Maybe a) -> a -> First a forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Maybe a forall a. a -> Maybe a Just) (^?) :: s -> Optic (Forget (First a)) s t a b -> Maybe a ^? :: s -> Optic (Forget (First a)) s t a b -> Maybe a (^?) = (Optic (Forget (First a)) s t a b -> s -> Maybe a) -> s -> Optic (Forget (First a)) s t a b -> Maybe a forall a b c. (a -> b -> c) -> b -> a -> c flip Optic (Forget (First a)) s t a b -> s -> Maybe a forall a s t b. Optic (Forget (First a)) s t a b -> s -> Maybe a preview (^..) :: s -> Optic (Forget [a]) s t a b -> [a] ^.. :: s -> Optic (Forget [a]) s t a b -> [a] (^..) = (Optic (Forget [a]) s t a b -> s -> [a]) -> s -> Optic (Forget [a]) s t a b -> [a] forall a b c. (a -> b -> c) -> b -> a -> c flip Optic (Forget [a]) s t a b -> s -> [a] forall a s t b. Optic (Forget [a]) s t a b -> s -> [a] toListOf (<+>) :: Semigroup r => Optic (Forget r) s t a b -> Optic (Forget r) s t' a b' -> Optic (Forget r) s t a b (fldA :: Optic (Forget r) s t a b fldA <+> :: Optic (Forget r) s t a b -> Optic (Forget r) s t' a b' -> Optic (Forget r) s t a b <+> fldB :: Optic (Forget r) s t' a b' fldB) p :: Forget r a b p = case (Optic (Forget r) s t a b fldA Forget r a b p, Optic (Forget r) s t' a b' fldB (Forget r a b -> Forget r a b' forall (p :: * -> * -> *) a x y. Phantom p => p a x -> p a y phantom Forget r a b p)) of (Forget f :: s -> r f, Forget g :: s -> r g) -> (s -> r) -> Forget r s t forall r a b. (a -> r) -> Forget r a b Forget (\a :: s a -> s -> r f s a r -> r -> r forall a. Semigroup a => a -> a -> a <> s -> r g s a)