{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}

{-|
Module      : Data.JoinSemilattice.Class.Zipping
Description : Computing knowledge from multiple parameters.
Copyright   : (c) Tom Harding, 2020
License     : MIT
-}
module Data.JoinSemilattice.Class.Zipping (Zipping (..)) where

import Control.Applicative (liftA2)
import Data.JoinSemilattice.Class.Mapping (Mapping)
import Data.JoinSemilattice.Defined (Defined)
import Data.JoinSemilattice.Intersect (Intersect, Intersectable)
import qualified Data.JoinSemilattice.Intersect as Intersect
import Data.Kind (Constraint, Type)

-- | Lift a relationship between three values over some @f@ (usually a
-- parameter type).
class Mapping f c => Zipping (f :: Type -> Type) (c :: Type -> Constraint) | f -> c where
  zipWithR
    :: (c x, c y, c z)
    => ( Maybe ((x, y) -> z)
       , Maybe ((x, z) -> y)
       , Maybe ((y, z) -> x)
       )
    -> ((f x, f y, f z) -> (f x, f y, f z))

instance Zipping Defined Eq where
  zipWithR :: (Maybe ((x, y) -> z), Maybe ((x, z) -> y), Maybe ((y, z) -> x))
-> (Defined x, Defined y, Defined z)
-> (Defined x, Defined y, Defined z)
zipWithR (Maybe ((x, y) -> z)
fs, Maybe ((x, z) -> y)
gs, Maybe ((y, z) -> x)
hs) (Defined x
x, Defined y
y, Defined z
z)
    = ( case Maybe ((y, z) -> x)
hs of Just (y, z) -> x
h  -> (y -> z -> x) -> Defined y -> Defined z -> Defined x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((y, z) -> x) -> y -> z -> x
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (y, z) -> x
h) Defined y
y Defined z
z
                   Maybe ((y, z) -> x)
Nothing -> Defined x
forall a. Monoid a => a
mempty

      , case Maybe ((x, z) -> y)
gs of Just (x, z) -> y
g  -> (x -> z -> y) -> Defined x -> Defined z -> Defined y
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((x, z) -> y) -> x -> z -> y
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (x, z) -> y
g) Defined x
x Defined z
z
                   Maybe ((x, z) -> y)
Nothing -> Defined y
forall a. Monoid a => a
mempty

      , case Maybe ((x, y) -> z)
fs of Just (x, y) -> z
f  -> (x -> y -> z) -> Defined x -> Defined y -> Defined z
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((x, y) -> z) -> x -> y -> z
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (x, y) -> z
f) Defined x
x Defined y
y
                   Maybe ((x, y) -> z)
Nothing -> Defined z
forall a. Monoid a => a
mempty
      )

instance Zipping Intersect Intersectable where
  zipWithR :: (Maybe ((x, y) -> z), Maybe ((x, z) -> y), Maybe ((y, z) -> x))
-> (Intersect x, Intersect y, Intersect z)
-> (Intersect x, Intersect y, Intersect z)
zipWithR (Maybe ((x, y) -> z)
fs, Maybe ((x, z) -> y)
gs, Maybe ((y, z) -> x)
hs) (Intersect x
x, Intersect y
y, Intersect z
z)
    = ( case Maybe ((y, z) -> x)
hs of Just (y, z) -> x
h  -> (y -> z -> x) -> Intersect y -> Intersect z -> Intersect x
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
Intersect.lift2 (((y, z) -> x) -> y -> z -> x
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (y, z) -> x
h) Intersect y
y Intersect z
z
                   Maybe ((y, z) -> x)
Nothing -> Intersect x
forall a. Monoid a => a
mempty

      , case Maybe ((x, z) -> y)
gs of Just (x, z) -> y
g  -> (x -> z -> y) -> Intersect x -> Intersect z -> Intersect y
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
Intersect.lift2 (((x, z) -> y) -> x -> z -> y
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (x, z) -> y
g) Intersect x
x Intersect z
z
                   Maybe ((x, z) -> y)
Nothing -> Intersect y
forall a. Monoid a => a
mempty

      , case Maybe ((x, y) -> z)
fs of Just (x, y) -> z
f  -> (x -> y -> z) -> Intersect x -> Intersect y -> Intersect z
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
Intersect.lift2 (((x, y) -> z) -> x -> y -> z
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (x, y) -> z
f) Intersect x
x Intersect y
y
                   Maybe ((x, y) -> z)
Nothing -> Intersect z
forall a. Monoid a => a
mempty
      )