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.Lens.Many
import Data.Diverse.TypeLevel
import Data.Profunctor
type Itemized w a b s t =
( Profunctor w
, Strong w
, HasItem a b s t
, HasItem' a s
)
itemized
:: forall w a b s t. (Itemized w 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 w a1 a2 b1 b2 =
( Profunctor w
, Strong w
, Select a1 a2
, Amend a1 b1 a2
, b2 ~ Replaces a1 b1 a2
)
projected
:: forall proxy w a1 a2 b1 b2. (Projected w 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 w a1 a2 a3 b1 b2 b3 =
( C.Category w
, Profunctor w
, Strong w
, 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. (SelectWith w 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 w a2 b1 b2 b3 =
( C.Category w
, Profunctor w
, Strong w
, Select (Complement b1 a2) b1
, Select a2 b1
, b3 ~ Append (Complement b1 a2) b2
)
(>&&>)
:: forall w a a2 b1 b2 b3.
(ThenSelect w 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 >&&>
(<&&<) ::
(ThenSelect w a2 b1 b2 b3)
=> w (Many a2) (Many b2)
-> w a (Many b1)
-> w a (Many b3)
(<&&<) = flip (>&&>)
infixl 2 <&&<