{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE InstanceSigs #-}

{-# LANGUAGE ImpredicativeTypes #-}
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)