module Data.Diverse.Profunctor.Many (
itemized
, itemized'
, projected
, (*&&*)
, (>&&>)
, (<&&<)
) where
import qualified Control.Category as C
import Control.Arrow
import Control.Lens
import Data.Diverse.Many
import Data.Diverse.TypeLevel
import Data.Profunctor
import Data.Proxy
itemized
:: forall a' w a b. ( Profunctor w
, Strong w
, UniqueMember a a'
, UniqueMember b (Replace a b a')
)
=> w a b -> w (Many a') (Many (Replace a b a'))
itemized w = dimap (\c -> (fetch c, c)) (\(b, c) -> replace' (Proxy @a) c b) (first' w)
itemized' :: Profunctor w => w a b -> w (Many '[a]) (Many '[b])
itemized' w = dimap fetch single w
projected
:: forall a' proxy w a b. ( Profunctor w
, Strong w
, Select a a'
, Amend' a b a'
)
=> proxy a' -> w (Many a) (Many b) -> w (Many a') (Many (Replaces a b a'))
projected _ w = dimap (\c -> (select c, c)) (\(b, c) -> amend' (Proxy @a) c b) (first' w)
(*&&*)
:: forall w a1 b1 a2 b2. ( C.Category w
, Profunctor w
, Strong w
, Select a1 (AppendUnique a1 a2)
, Select a2 (AppendUnique a1 a2)
)
=> w (Many a1) (Many b1)
-> w (Many a2) (Many b2)
-> w (Many (AppendUnique a1 a2)) (Many (Append b1 b2))
x *&&* y = rmap (uncurry (/./)) (lmap (select @a1 &&& select @a2) (first' x) C.>>> second' y)
infixr 3 *&&*
(>&&>)
:: forall w a b1 a2 b2.
( C.Category w
, Profunctor w
, Strong w
, Select (Complement b1 a2) b1
, Select a2 b1
)
=> w a (Many b1)
-> w (Many a2) (Many b2)
-> w a (Many (Append (Complement b1 a2) b2))
x >&&> y = rmap (uncurry (/./)) (rmap (select @(Complement b1 a2) &&& select @a2) x C.>>> (second' y))
infixr 3 >&&>
(<&&<) ::
( C.Category w
, Profunctor w
, Strong w
, Select (Complement b1 a2) b1
, Select a2 b1
)
=> w (Many a2) (Many b2)
-> w a (Many b1)
-> w a (Many (Append (Complement b1 a2) b2))
(<&&<) = flip (>&&>)
infixl 2 <&&<