module Proton.Algebraic ( MStrong(..) , AlgebraicLens , AlgebraicLens' , algebraic , listLens , altLens , (>-) , (?.) ) where import Data.Profunctor import Data.Profunctor.MStrong import Proton.Types import Data.Monoid import Control.Applicative import Control.Arrow type AlgebraicLens s t a b = forall p. MStrong p => p a b -> p s t type AlgebraicLens' s a = AlgebraicLens s s a a algebraic :: forall m p s t a b . (Monoid m, MStrong p) => (s -> m) -> (s -> a) -> (m -> b -> t) -> Optic p s t a b algebraic :: (s -> m) -> (s -> a) -> (m -> b -> t) -> Optic p s t a b algebraic inject :: s -> m inject project :: s -> a project flatten :: m -> b -> t flatten p :: p a b p = (s -> (m, s)) -> ((m, b) -> t) -> p (m, s) (m, b) -> p s t forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap (s -> m inject (s -> m) -> (s -> s) -> s -> (m, s) forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& s -> s forall a. a -> a id) ((m -> b -> t) -> (m, b) -> t forall a b c. (a -> b -> c) -> (a, b) -> c uncurry m -> b -> t flatten) (p (m, s) (m, b) -> p s t) -> p (m, s) (m, b) -> p s t forall a b. (a -> b) -> a -> b $ p (m, s) (m, b) strengthened where strengthened :: p (m, s) (m, b) strengthened :: p (m, s) (m, b) strengthened = p s b -> p (m, s) (m, b) forall (p :: * -> * -> *) m a b. (MStrong p, Monoid m) => p a b -> p (m, a) (m, b) msecond' ((s -> a) -> p a b -> p s b forall (p :: * -> * -> *) a b c. Profunctor p => (a -> b) -> p b c -> p a c lmap s -> a project p a b p) listLens :: MStrong p => (s -> a) -> ([s] -> b -> t) -> Optic p s t a b listLens :: (s -> a) -> ([s] -> b -> t) -> Optic p s t a b listLens = (s -> [s]) -> (s -> a) -> ([s] -> b -> t) -> Optic p s t a b forall m (p :: * -> * -> *) s t a b. (Monoid m, MStrong p) => (s -> m) -> (s -> a) -> (m -> b -> t) -> Optic p s t a b algebraic s -> [s] forall (f :: * -> *) a. Applicative f => a -> f a pure altLens :: (Alternative f, MStrong p) => (s -> a) -> (f s -> b -> t) -> Optic p s t a b altLens :: (s -> a) -> (f s -> b -> t) -> Optic p s t a b altLens project :: s -> a project flatten :: f s -> b -> t flatten = (s -> Alt f s) -> (s -> a) -> (Alt f s -> b -> t) -> Optic p s t a b forall m (p :: * -> * -> *) s t a b. (Monoid m, MStrong p) => (s -> m) -> (s -> a) -> (m -> b -> t) -> Optic p s t a b algebraic (f s -> Alt f s forall k (f :: k -> *) (a :: k). f a -> Alt f a Alt (f s -> Alt f s) -> (s -> f s) -> s -> Alt f s forall b c a. (b -> c) -> (a -> b) -> a -> c . s -> f s forall (f :: * -> *) a. Applicative f => a -> f a pure) s -> a project (f s -> b -> t flatten (f s -> b -> t) -> (Alt f s -> f s) -> Alt f s -> b -> t forall b c a. (b -> c) -> (a -> b) -> a -> c . Alt f s -> f s forall k (f :: k -> *) (a :: k). Alt f a -> f a getAlt) infixr 4 ?. (?.) :: Optic (Costar f) s t a b -> b -> f s -> t ?. :: Optic (Costar f) s t a b -> b -> f s -> t (?.) opt :: Optic (Costar f) s t a b opt b :: b b xs :: f s xs = (Costar f s t -> f s -> t forall (f :: * -> *) d c. Costar f d c -> f d -> c runCostar (Costar f s t -> f s -> t) -> Costar f s t -> f s -> t forall a b. (a -> b) -> a -> b $ Optic (Costar f) s t a b opt ((f a -> b) -> Costar f a b forall (f :: * -> *) d c. (f d -> c) -> Costar f d c Costar (b -> f a -> b forall a b. a -> b -> a const b b))) f s xs infixr 4 >- (>-) :: Optic (Costar f) s t a b -> (f a -> b) -> f s -> t >- :: Optic (Costar f) s t a b -> (f a -> b) -> f s -> t (>-) opt :: Optic (Costar f) s t a b opt aggregator :: f a -> b aggregator xs :: f s xs = (Costar f s t -> f s -> t forall (f :: * -> *) d c. Costar f d c -> f d -> c runCostar (Costar f s t -> f s -> t) -> Costar f s t -> f s -> t forall a b. (a -> b) -> a -> b $ Optic (Costar f) s t a b opt ((f a -> b) -> Costar f a b forall (f :: * -> *) d c. (f d -> c) -> Costar f d c Costar f a -> b aggregator)) f s xs