{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveFunctor #-}
module Data.Profunctor.Day(
  Day(..)
) where

import Data.Profunctor (Profunctor (..))
import Data.Profunctor.Monad (ProfunctorFunctor (..))

data Day t p q a b where
  Day :: p a1 b1 -> q a2 b2 -> (a -> t a1 a2) -> (t b1 b2 -> b) -> Day t p q a b

deriving instance Functor (Day t p q a)

instance Profunctor (Day t p q) where
    dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Day t p q b c -> Day t p q a d
dimap a -> b
f c -> d
g (Day p a1 b1
p q a2 b2
q b -> t a1 a2
opA t b1 b2 -> c
opB) = p a1 b1
-> q a2 b2 -> (a -> t a1 a2) -> (t b1 b2 -> d) -> Day t p q a d
forall (p :: * -> * -> *) a1 b1 (q :: * -> * -> *) a2 b2 a
       (t :: * -> * -> *) b.
p a1 b1
-> q a2 b2 -> (a -> t a1 a2) -> (t b1 b2 -> b) -> Day t p q a b
Day p a1 b1
p q a2 b2
q (b -> t a1 a2
opA (b -> t a1 a2) -> (a -> b) -> a -> t a1 a2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (c -> d
g (c -> d) -> (t b1 b2 -> c) -> t b1 b2 -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b1 b2 -> c
opB)

instance ProfunctorFunctor (Day t p) where
    promap :: forall (p :: * -> * -> *) (q :: * -> * -> *).
Profunctor p =>
(p :-> q) -> Day t p p :-> Day t p q
promap p :-> q
qr (Day p a1 b1
p p a2 b2
q a -> t a1 a2
opA t b1 b2 -> b
opB) = p a1 b1
-> q a2 b2 -> (a -> t a1 a2) -> (t b1 b2 -> b) -> Day t p q a b
forall (p :: * -> * -> *) a1 b1 (q :: * -> * -> *) a2 b2 a
       (t :: * -> * -> *) b.
p a1 b1
-> q a2 b2 -> (a -> t a1 a2) -> (t b1 b2 -> b) -> Day t p q a b
Day p a1 b1
p (p a2 b2 -> q a2 b2
p :-> q
qr p a2 b2
q) a -> t a1 a2
opA t b1 b2 -> b
opB