{-# LANGUAGE UndecidableInstances #-}
module Pandora.Paradigm.Primary.Transformer.Day where

import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category ((<--), (<---), (<----))
import Pandora.Pattern.Kernel (constant)
import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))
import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))
import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\)))
import Pandora.Paradigm.Algebraic.Exponential ((.:..))

data Day t u a = forall b c . Day (t b) (u c) (b -> c -> a)

instance Covariant (->) (->) (Day t u) where
	a -> b
f <-|- :: (a -> b) -> Day t u a -> Day t u b
<-|- Day t b
tb u c
uc b -> c -> a
g = t b -> u c -> (b -> c -> b) -> Day t u b
forall (t :: * -> *) (u :: * -> *) a b c.
t b -> u c -> (b -> c -> a) -> Day t u a
Day t b
tb u c
uc ((b -> c -> b) -> Day t u b) -> (b -> c -> b) -> Day t u b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<---- a -> b
f (a -> b) -> (b -> c -> a) -> b -> c -> b
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))
.:.. b -> c -> a
g

instance (Extendable (->) t, Extendable (->) u) => Extendable (->) (Day t u) where
	Day t u a -> b
f <<= :: (Day t u a -> b) -> Day t u a -> Day t u b
<<= day :: Day t u a
day@(Day t b
tb u c
uc b -> c -> a
_) = t b -> u c -> (b -> c -> b) -> Day t u b
forall (t :: * -> *) (u :: * -> *) a b c.
t b -> u c -> (b -> c -> a) -> Day t u a
Day t b
tb u c
uc ((b -> c -> b) -> Day t u b) -> (b -> c -> b) -> Day t u b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- (c -> b) -> b -> c -> b
forall (m :: * -> * -> *) a i. Kernel m => m a (m i a)
constant ((c -> b) -> b -> c -> b) -> (b -> c -> b) -> b -> b -> c -> b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. b -> c -> b
forall (m :: * -> * -> *) a i. Kernel m => m a (m i a)
constant (b -> b -> c -> b) -> b -> b -> c -> b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- Day t u a -> b
f Day t u a
day

instance Hoistable (->) (Day t) where
	forall a. u a -> v a
g /|\ :: (forall a. u a -> v a) -> forall a. Day t u a -> Day t v a
/|\ Day t b
tb u c
uc b -> c -> a
bca = t b -> v c -> (b -> c -> a) -> Day t v a
forall (t :: * -> *) (u :: * -> *) a b c.
t b -> u c -> (b -> c -> a) -> Day t u a
Day t b
tb (v c -> (b -> c -> a) -> Day t v a)
-> v c -> (b -> c -> a) -> Day t v a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- u c -> v c
forall a. u a -> v a
g u c
uc ((b -> c -> a) -> Day t v a) -> (b -> c -> a) -> Day t v a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- b -> c -> a
bca

data Day_ category source target t u r = forall a b .
	Day_ (target (category (source a b) r) (target (t a) (u b)))