{-# LANGUAGE FunctionalDependencies #-}
module Data.Functor.Contravariant.CPS
( -- * Contravariant continuation-passing style
  ContravariantCPS(..)
, Contravariant(..)
) where

import Data.Functor.Continuation
import Data.Functor.Contravariant
import Data.Profunctor.Fun

-- Contravariant continuation-passing style

class Contravariant k => ContravariantCPS r k | k -> r where
  (<#>) :: (a' ~~r~> a) -> (k a -> k a')

  infixl 4 <#>

instance ContravariantCPS r ((!) r) where
  <#> :: ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
(<#>) = ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
forall r a' a. ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
(#)

instance ContravariantCPS Bool Predicate where
  (a' ~~ Bool) ~> a
f <#> :: ((a' ~~ Bool) ~> a) -> Predicate a -> Predicate a'
<#> Predicate a -> Bool
p = (a' -> Bool) -> Predicate a'
forall a. (a -> Bool) -> Predicate a
Predicate ((a' ~~ Bool) ~> a
f ((a' ~~ Bool) ~> a) -> (Bool ! a) -> Bool ! a'
forall r a' a. ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
# (a -> Bool) -> Bool ! a
forall r a. (a -> r) -> r ! a
K a -> Bool
p (Bool ! a') -> a' -> Bool
forall r a. (r ! a) -> a -> r
!)

instance ContravariantCPS Ordering Comparison where
  (a' ~~ Ordering) ~> a
f <#> :: ((a' ~~ Ordering) ~> a) -> Comparison a -> Comparison a'
<#> Comparison a -> a -> Ordering
c = (a' -> a' -> Ordering) -> Comparison a'
forall a. (a -> a -> Ordering) -> Comparison a
Comparison (\ a'
a a'
b -> (a' ~~ Ordering) ~> a
f ((a' ~~ Ordering) ~> a) -> (Ordering ! a) -> Ordering ! a'
forall r a' a. ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
# (a -> Ordering) -> Ordering ! a
forall r a. (a -> r) -> r ! a
K (\ a
a -> (a' ~~ Ordering) ~> a
f ((a' ~~ Ordering) ~> a) -> (Ordering ! a) -> Ordering ! a'
forall r a' a. ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
# (a -> Ordering) -> Ordering ! a
forall r a. (a -> r) -> r ! a
K (a -> a -> Ordering
c a
a) (Ordering ! a') -> a' -> Ordering
forall r a. (r ! a) -> a -> r
! a'
b) (Ordering ! a') -> a' -> Ordering
forall r a. (r ! a) -> a -> r
! a'
a)

instance ContravariantCPS Bool Equivalence where
  (a' ~~ Bool) ~> a
f <#> :: ((a' ~~ Bool) ~> a) -> Equivalence a -> Equivalence a'
<#> Equivalence a -> a -> Bool
e = (a' -> a' -> Bool) -> Equivalence a'
forall a. (a -> a -> Bool) -> Equivalence a
Equivalence (\ a'
a a'
b -> (a' ~~ Bool) ~> a
f ((a' ~~ Bool) ~> a) -> (Bool ! a) -> Bool ! a'
forall r a' a. ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
# (a -> Bool) -> Bool ! a
forall r a. (a -> r) -> r ! a
K (\ a
a -> (a' ~~ Bool) ~> a
f ((a' ~~ Bool) ~> a) -> (Bool ! a) -> Bool ! a'
forall r a' a. ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
# (a -> Bool) -> Bool ! a
forall r a. (a -> r) -> r ! a
K (a -> a -> Bool
e a
a) (Bool ! a') -> a' -> Bool
forall r a. (r ! a) -> a -> r
! a'
b) (Bool ! a') -> a' -> Bool
forall r a. (r ! a) -> a -> r
! a'
a)

instance ContravariantCPS r (Op r) where
  (a' ~~ r) ~> a
f <#> :: ((a' ~~ r) ~> a) -> Op r a -> Op r a'
<#> Op a -> r
k = (a' -> r) -> Op r a'
forall a b. (b -> a) -> Op a b
Op ((a' ~~ r) ~> a
f ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
forall r a' a. ((a' ~~ r) ~> a) -> (r ! a) -> r ! a'
# (a -> r) -> r ! a
forall r a. (a -> r) -> r ! a
K a -> r
k (r ! a') -> a' -> r
forall r a. (r ! a) -> a -> r
!)