module Pandora.Paradigm.Structure.Ability.Monotonic where

import Pandora.Pattern.Category ((<----))
import Pandora.Pattern.Kernel (constant)
import Pandora.Paradigm.Algebraic.Exponential ((.:..))
import Pandora.Paradigm.Algebraic.Sum ((:+:) (Option, Adoption))

class Monotonic a e where
	{-# MINIMAL reduce #-}
	reduce :: (a -> r -> r) -> r -> e -> r

	-- | Version of `reduce` which ignores accumulator
	resolve :: (a -> r) -> r -> e -> r
	resolve a -> r
g = (a -> r -> r) -> r -> e -> r
forall a e r. Monotonic a e => (a -> r -> r) -> r -> e -> r
reduce ((a -> r -> r) -> r -> e -> r) -> (a -> r -> r) -> r -> e -> r
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<---- a -> r
g (a -> r) -> (a -> r -> a) -> a -> r -> r
forall (target :: * -> * -> *) (v :: * -> * -> *) a c d b.
(Covariant (->) target (v a), Semigroupoid v) =>
v c d -> target (v a (v b c)) (v a (v b d))
.:.. a -> r -> a
forall (m :: * -> * -> *) a i. Kernel m => m a (m i a)
constant

instance Monotonic a a where
	reduce :: (a -> r -> r) -> r -> a -> r
reduce a -> r -> r
f r
r a
x = a -> r -> r
f a
x r
r

instance Monotonic a (o :+: a) where
	reduce :: (a -> r -> r) -> r -> (o :+: a) -> r
reduce a -> r -> r
fun r
def (Adoption a
x) = a -> r -> r
fun a
x r
def
	reduce a -> r -> r
_ r
def (Option o
x) = r
def

instance Monotonic o (o :+: a) where
	reduce :: (o -> r -> r) -> r -> (o :+: a) -> r
reduce o -> r -> r
fun r
def (Option o
x) = o -> r -> r
fun o
x r
def
	reduce o -> r -> r
_ r
def (Adoption a
x) = r
def