module Pandora.Paradigm.Primary.Transformer.Tap where import Pandora.Pattern.Category ((.), ($), (#)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>))) import Pandora.Pattern.Functor.Avoidable (Avoidable (empty)) import Pandora.Pattern.Functor.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Extractable (Extractable (extract)) import Pandora.Pattern.Functor.Alternative (Alternative ((<+>))) import Pandora.Pattern.Functor.Applicative (Applicative ((<*>))) import Pandora.Pattern.Functor.Traversable (Traversable ((->>))) import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Functor.Bindable (Bindable ((>>=))) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower)) import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist)) import Pandora.Paradigm.Primary.Functor.Function ((%)) data Tap t a = Tap a (t a) instance Covariant t => Covariant (Tap t) where a -> b f <$> :: (a -> b) -> Tap t a -> Tap t b <$> Tap a x t a xs = b -> t b -> Tap t b forall (t :: * -> *) a. a -> t a -> Tap t a Tap (b -> t b -> Tap t b) -> b -> t b -> Tap t b forall (m :: * -> * -> *). Category m => m ~~> m # a -> b f a x (t b -> Tap t b) -> t b -> Tap t b forall (m :: * -> * -> *). Category m => m ~~> m # a -> b f (a -> b) -> t a -> t b forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> t a xs instance Avoidable t => Pointable (Tap t) where point :: a :=> Tap t point = a -> t a -> Tap t a forall (t :: * -> *) a. a -> t a -> Tap t a Tap (a -> t a -> Tap t a) -> t a -> a :=> Tap t forall a b c. (a -> b -> c) -> b -> a -> c % t a forall (t :: * -> *) a. Avoidable t => t a empty instance Covariant t => Extractable (Tap t) where extract :: a <:= Tap t extract (Tap a x t a _) = a x instance Applicative t => Applicative (Tap t) where Tap a -> b f t (a -> b) fs <*> :: Tap t (a -> b) -> Tap t a -> Tap t b <*> Tap a x t a xs = b -> t b -> Tap t b forall (t :: * -> *) a. a -> t a -> Tap t a Tap (b -> t b -> Tap t b) -> b -> t b -> Tap t b forall (m :: * -> * -> *). Category m => m ~~> m # a -> b f a x (t b -> Tap t b) -> t b -> Tap t b forall (m :: * -> * -> *). Category m => m ~~> m # t (a -> b) fs t (a -> b) -> t a -> t b forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b <*> t a xs instance Traversable t => Traversable (Tap t) where Tap a x t a xs ->> :: Tap t a -> (a -> u b) -> (u :. Tap t) := b ->> a -> u b f = b -> t b -> Tap t b forall (t :: * -> *) a. a -> t a -> Tap t a Tap (b -> t b -> Tap t b) -> u b -> u (t b -> Tap t b) forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> a -> u b f a x u (t b -> Tap t b) -> u (t b) -> (u :. Tap t) := b forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b <*> t a xs t a -> (a -> u b) -> u (t b) forall (t :: * -> *) (u :: * -> *) a b. (Traversable t, Pointable u, Applicative u) => t a -> (a -> u b) -> (u :. t) := b ->> a -> u b f instance (Extractable t, Alternative t, Bindable t) => Bindable (Tap t) where Tap a x t a xs >>= :: Tap t a -> (a -> Tap t b) -> Tap t b >>= a -> Tap t b f = case a -> Tap t b f a x of ~(Tap b y t b ys) -> b -> t b -> Tap t b forall (t :: * -> *) a. a -> t a -> Tap t a Tap b y (t b -> Tap t b) -> t b -> Tap t b forall (m :: * -> * -> *). Category m => m ~~> m $ t b ys t b -> t b -> t b forall (t :: * -> *) a. Alternative t => t a -> t a -> t a <+> (t a xs t a -> (a -> t b) -> t b forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b >>= Tap t b -> t b forall (t :: (* -> *) -> * -> *) (u :: * -> *). (Lowerable t, Covariant u) => t u ~> u lower (Tap t b -> t b) -> (a -> Tap t b) -> a -> t b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . a -> Tap t b f) instance Extendable t => Extendable (Tap t) where Tap t a x =>> :: Tap t a -> (Tap t a -> b) -> Tap t b =>> Tap t a -> b f = b -> t b -> Tap t b forall (t :: * -> *) a. a -> t a -> Tap t a Tap (b -> t b -> Tap t b) -> b -> t b -> Tap t b forall (m :: * -> * -> *). Category m => m ~~> m # Tap t a -> b f Tap t a x (t b -> Tap t b) -> t b -> Tap t b forall (m :: * -> * -> *). Category m => m ~~> m $ Tap t a -> t a forall (t :: (* -> *) -> * -> *) (u :: * -> *). (Lowerable t, Covariant u) => t u ~> u lower Tap t a x t a -> (t a -> b) -> t b forall (t :: * -> *) a b. Extendable t => t a -> (t a -> b) -> t b =>> Tap t a -> b f (Tap t a -> b) -> (t a -> Tap t a) -> t a -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . a -> t a -> Tap t a forall (t :: * -> *) a. a -> t a -> Tap t a Tap (a <:= Tap t forall (t :: * -> *) a. Extractable t => a <:= t extract Tap t a x) instance Lowerable Tap where lower :: Tap u ~> u lower (Tap a _ u a xs) = u a xs instance Hoistable Tap where hoist :: (u ~> v) -> Tap u ~> Tap v hoist u ~> v f (Tap a x u a xs) = a -> v a -> Tap v a forall (t :: * -> *) a. a -> t a -> Tap t a Tap a x (v a -> Tap v a) -> v a -> Tap v a forall (m :: * -> * -> *). Category m => m ~~> m # u a -> v a u ~> v f u a xs