module Data.Diverse.Profunctor.Which (
faceted
, faceted'
, injected
, (+||+)
, (>||>)
, (<||<)
) where
import qualified Control.Category as C
import Control.Lens
import Data.Diverse.Which
import Data.Diverse.TypeLevel
import Data.Proxy
faceted
:: ( Profunctor w
, Choice w
, UniqueMember a a'
, UniqueMember b b'
, Diversify (Complement a' '[a]) b'
)
=> w a b -> w (Which a') (Which b')
faceted w = dimap trial (either diversify pick) (right' w)
faceted' :: (Profunctor w, Choice w) => w a b -> w (Which '[a]) (Which '[b])
faceted' w = dimap trial (either impossible pick) (right' w)
injected
:: ( Profunctor w
, Choice w
, Reinterpret a a'
, Diversify b (AppendUnique (Complement a' a) b)
, Diversify (Complement a' a) (AppendUnique (Complement a' a) b)
, Complement a a' ~ '[]
)
=> proxy a'
-> w (Which a) (Which b)
-> w (Which a') (Which (AppendUnique (Complement a' a) b))
injected _ w = dimap reinterpret (either diversify diversify) (right' w)
(+||+)
:: forall w a1 b1 a2 b2.
( C.Category w
, Profunctor w
, Choice w
, Reinterpret a2 (Append a1 a2)
, a1 ~ Complement (Append a1 a2) a2
, Diversify b1 (AppendUnique b1 b2)
, Diversify b2 (AppendUnique b1 b2)
)
=> w (Which a1) (Which b1)
-> w (Which a2) (Which b2)
-> w (Which (Append a1 a2)) (Which (AppendUnique b1 b2))
x +||+ y =
rmap
(either diversify diversify)
(lmap (reinterpret @a2 @(Append a1 a2)) (left' x) C.>>> right' y)
infixr 2 +||+
(>||>)
:: forall w a b c d.
( C.Category w
, Profunctor w
, Choice w
, Reinterpret c b
, Diversify d (AppendUnique (Complement b c) d)
, Diversify (Complement b c) (AppendUnique (Complement b c) d)
, Complement c b ~ '[])
=> w a (Which b)
-> w (Which c) (Which d)
-> w a (Which (AppendUnique (Complement b c) d))
(>||>) hdl1 hdl2 = hdl1 C.>>> injected (Proxy @b) hdl2
infixr 2 >||>
(<||<)
:: ( C.Category w
, Profunctor w
, Choice w
, Reinterpret c b
, Diversify d (AppendUnique (Complement b c) d)
, Diversify (Complement b c) (AppendUnique (Complement b c) d)
, Complement c b ~ '[])
=> w (Which c) (Which d)
-> w a (Which b)
-> w a (Which (AppendUnique (Complement b c) d))
(<||<) = flip (>||>)
infixl 2 <||<