{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Diverse.Profunctor.Which (
Faceted
, faceted
, facetedK
, Injected
, injected
, injectedK
, ChooseFrom
, ChooseBoth
, chooseBetween
, chooseBetweenK
, thenChoose
, thenChooseK
, chooseWith
) where
import Control.Arrow
import qualified Control.Category as C
import Control.Lens
import Data.Diverse.Lens
type Faceted a as x b bs y =
( MatchingFacet a x y
, AsFacet b y
)
faceted :: forall w a as x b bs y.
( Choice w
, Faceted a as x b bs y
)
=> w a b -> w x y
faceted w = dimap (matchingFacet @a @x @y)
(either id (review facet))
(right' w)
facetedK :: forall m a as x b bs y.
( Monad m
, Faceted a as x b bs y
)
=> (a -> m b) -> (x -> m y)
facetedK f = runKleisli . faceted $ Kleisli f
type Injected a2 a3 b2 b3 =
( Reinterpret a2 a3
, ChooseBoth (Complement a3 a2) b2 b3
, Complement a2 a3 ~ '[]
)
injected :: forall w a2 a3 b2 b3.
( Choice w
, Injected a2 a3 b2 b3
)
=> w (Which a2) (Which b2)
-> w (Which a3) (Which b3)
injected w = dimap (reinterpret @a2 @a3) (either diversify diversify) (right' w)
injectedK :: forall m a2 a3 b2 b3.
( Monad m
, Injected a2 a3 b2 b3
)
=> (Which a2 -> m (Which b2))
-> (Which a3 -> m (Which b3))
injectedK f = runKleisli . injected $ Kleisli f
type ChooseBoth b1 b2 b3 =
( Diversify b1 b3
, Diversify b2 b3
, b3 ~ AppendUnique b1 b2
)
type ChooseFrom a1 a2 a3 =
( Reinterpret a2 a3
, a1 ~ Complement a3 a2
, a3 ~ Append a1 a2
)
chooseBetween :: forall w a1 a2 a3 b1 b2 b3.
( C.Category w
, Choice w
, ChooseFrom a1 a2 a3
, ChooseBoth b1 b2 b3
)
=> w (Which a1) (Which b1)
-> w (Which a2) (Which b2)
-> w (Which a3) (Which b3)
x `chooseBetween` y =
rmap
(either diversify diversify)
(lmap (reinterpret @a2 @a3) (left' x) C.>>> right' y)
infixr 2 `chooseBetween`
chooseBetweenK :: forall m a1 a2 a3 b1 b2 b3.
(Monad m, ChooseFrom a1 a2 a3, ChooseBoth b1 b2 b3)
=> (Which a1 -> m (Which b1))
-> (Which a2 -> m (Which b2))
-> (Which a3 -> m (Which b3))
chooseBetweenK f g = runKleisli $ chooseBetween (Kleisli f) (Kleisli g)
infixr 2 `chooseBetweenK`
thenChoose :: forall w a a2 b1 b2 b3.
( C.Category w
, Choice w
, Injected a2 b1 b2 b3
)
=> w a (Which b1)
-> w (Which a2) (Which b2)
-> w a (Which b3)
hdl1 `thenChoose` hdl2 = hdl1 C.>>> injected hdl2
infixr 2 `thenChoose`
thenChooseK :: forall m a a2 b1 b2 b3.
(Monad m, Injected a2 b1 b2 b3)
=> (a -> m (Which b1))
-> (Which a2 -> m (Which b2))
-> (a -> m (Which b3))
thenChooseK f g = runKleisli $ thenChoose (Kleisli f) (Kleisli g)
infixr 2 `thenChooseK`
chooseWith :: (Functor f, ChooseBoth a1 a2 a3)
=> (f (Which a3) -> f (Which a3) -> f (Which a3)) -> f (Which a1) -> f (Which a2) -> f (Which a3)
chooseWith f x y = (diversify <$> x) `f` (diversify <$> y)
infixr 6 `chooseWith`