{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
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)
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 (fs, gs, hs) (x, y, z)
= ( case hs of Just h -> liftA2 (curry h) y z
Nothing -> mempty
, case gs of Just g -> liftA2 (curry g) x z
Nothing -> mempty
, case fs of Just f -> liftA2 (curry f) x y
Nothing -> mempty
)
instance Zipping Intersect Intersectable where
zipWithR (fs, gs, hs) (x, y, z)
= ( case hs of Just h -> Intersect.lift2 (curry h) y z
Nothing -> mempty
, case gs of Just g -> Intersect.lift2 (curry g) x z
Nothing -> mempty
, case fs of Just f -> Intersect.lift2 (curry f) x y
Nothing -> mempty
)