module Data.Diverse.Profunctor.Many (
Itemized
, itemized
, itemized'
, Projected
, projected
, SelectWith
, (*&&*)
, ThenSelect
, (>&&>)
, (<&&<)
) where
import qualified Control.Category as C
import Control.Arrow
import Control.Lens
import Data.Diverse.Many
import Data.Diverse.Lens.Many
import Data.Diverse.TypeLevel
import Data.Profunctor
type Itemized a b s t =
( HasItem a b s t
, HasItem' a s
)
itemized ::
forall w a b s t.
( Profunctor w
, Strong w
, Itemized a b s t
)
=> w a b -> w s t
itemized w = dimap (\c -> (view item' c, c)) (\(b, c) -> set (item @a) b c) (first' w)
itemized' :: Profunctor w => w a b -> w (Many '[a]) (Many '[b])
itemized' w = dimap fetch single w
type Projected a1 a2 b1 b2 =
( Select a1 a2
, Amend a1 b1 a2
, b2 ~ Replaces a1 b1 a2
)
projected :: forall proxy w a1 a2 b1 b2.
( Profunctor w
, Strong w
, Projected a1 a2 b1 b2
)
=> proxy a2 -> w (Many a1) (Many b1) -> w (Many a2) (Many b2)
projected _ w = dimap (\c -> (select c, c)) (\(b, c) -> amend @a1 c b) (first' w)
type SelectWith a1 a2 a3 b1 b2 b3 =
( Select a1 (AppendUnique a1 a2)
, Select a2 (AppendUnique a1 a2)
, a3 ~ AppendUnique a1 a2
, b3 ~ Append b1 b2
)
(*&&*)
:: forall w a1 a2 a3 b1 b2 b3.
( C.Category w
, Profunctor w
, Strong w
, SelectWith a1 a2 a3 b1 b2 b3
)
=> w (Many a1) (Many b1)
-> w (Many a2) (Many b2)
-> w (Many a3) (Many b3)
x *&&* y = rmap (uncurry (/./)) (lmap (select @a1 &&& select @a2) (first' x) C.>>> second' y)
infixr 3 *&&*
type ThenSelect a2 b1 b2 b3 =
( Select (Complement b1 a2) b1
, Select a2 b1
, b3 ~ Append (Complement b1 a2) b2
)
(>&&>)
:: forall w a a2 b1 b2 b3.
( C.Category w
, Profunctor w
, Strong w
, ThenSelect a2 b1 b2 b3
)
=> w a (Many b1)
-> w (Many a2) (Many b2)
-> w a (Many b3)
x >&&> y = rmap (uncurry (/./)) (rmap (select @(Complement b1 a2) &&& select @a2) x C.>>> (second' y))
infixr 3 >&&>
(<&&<) ::
( C.Category w
, Profunctor w
, Strong w
, ThenSelect a2 b1 b2 b3
)
=> w (Many a2) (Many b2)
-> w a (Many b1)
-> w a (Many b3)
(<&&<) = flip (>&&>)
infixl 2 <&&<