module Data.Diverse.Lens.Many (
_Many
, _Many'
, HasItem(..)
, item'
, itemL
, itemL'
, itemTag
, itemTag'
, genericItemTag
, itemN
, itemN'
, project
, project'
, projectL
, projectL'
, projectN
, projectN'
) where
import Control.Lens
import Data.Tagged
import Data.Diverse.Many
import Data.Diverse.TypeLevel
import Data.Generics.Product
import GHC.TypeLits
_Many :: IsMany t xs a => Iso' (Many xs) (t xs a)
_Many = iso fromMany toMany
_Many' :: IsMany Tagged xs a => Iso' (Many xs) a
_Many' = iso fromMany' toMany'
class HasItem' a s where
item' :: Lens' s a
default item' :: (HasType a s) => Lens' s a
item' = typed
instance UniqueMember x xs => HasItem' x (Many xs) where
item' = lens fetch replace'
class HasItem a b s t | s a b -> t, t a b -> s where
item :: Lens s t a b
instance (UniqueMember x xs, ys ~ Replace x y xs) => HasItem x y (Many xs) (Many ys) where
item = lens fetch (replace @x @y)
class HasItemL' (l :: k) a s | s l -> a where
itemL' :: Lens' s a
instance (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => HasItemL' l x (Many xs) where
itemL' = lens (fetchL @l) (replaceL' @l)
class HasItemL (l :: k) a b s t | s l -> a, t l -> b, s l b -> t, t l a -> s where
itemL :: Lens s t a b
instance (UniqueLabelMember l xs, x ~ KindAtLabel l xs, ys ~ Replace x y xs)
=> HasItemL l x y (Many xs) (Many ys) where
itemL = lens (fetchL @l) (replaceL @l)
class HasItemTag' (l :: k) a s | s l -> a where
itemTag' :: Lens' s a
instance (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs) => HasItemTag' l x (Many xs) where
itemTag' = lens (fetchTag @l) (replaceTag' @l)
class HasItemTag (l :: k) a b s t | s l -> a, t l -> b, s l b -> t, t l a -> s where
itemTag :: Lens s t a b
genericItemTag :: forall l a b s t. (HasField l s t a b) => Lens s t a b
genericItemTag = field @l
instance (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs, ys ~ Replace (Tagged l x) (Tagged l y) xs)
=> HasItemTag l x y (Many xs) (Many ys) where
itemTag = lens (fetchTag @l) (replaceTag @l)
class HasItemN' (n :: Nat) a s | s n -> a where
itemN' :: Lens' s a
instance (MemberAt n x xs) => HasItemN' n x (Many xs) where
itemN' = lens (fetchN @n) (replaceN' @n)
class HasItemN (n :: Nat) a b s t | s n -> a, t n -> b, s n b -> t, t n a -> s where
itemN :: Lens s t a b
default itemN :: (HasPosition n s t a b) => Lens s t a b
itemN = position @n
instance (MemberAt n x xs, ys ~ ReplaceIndex n y xs)
=> HasItemN n x y (Many xs) (Many ys) where
itemN = lens (fetchN @n) (replaceN @n)
class HasProject' (as :: k) (ss :: k) a s | a -> as, s -> ss, s as -> a, a ss -> s where
project' :: Lens' s a
default project' :: (Subtype a s) => Lens' s a
project' = super
instance (Select smaller larger, Amend' smaller larger)
=> HasProject' smaller larger (Many smaller) (Many larger) where
project' = lens select amend'
class HasProject (as :: k) (bs :: k) (ss :: k) (ts :: k) a b s t
| a -> as, b -> bs, s -> ss, t -> ts
, b as -> a, s as -> a, t as -> a
, a bs -> b, s bs -> b, t bs -> b
, a ss -> s, b ss -> s, t ss -> s
, a ts -> t, b ts -> t, s ts -> t
, s a b -> t, t a b -> s where
project :: Lens s t a b
instance (Select smaller larger, Amend smaller smaller' larger, larger' ~ Replaces smaller smaller' larger)
=> HasProject smaller smaller' larger larger' (Many smaller) (Many smaller') (Many larger) (Many larger') where
project = lens select (amend @smaller @smaller')
class HasProjectL' (ls :: k1) (as :: k) (ss :: k) a s | a -> as, s -> ss, s as -> a, a ss -> s, s ls -> as where
projectL' :: Lens' s a
instance ( Select smaller larger
, Amend' smaller larger
, smaller ~ KindsAtLabels ls larger
, IsDistinct ls
, UniqueLabels ls larger) => HasProjectL' ls smaller larger (Many smaller) (Many larger) where
projectL' = lens (selectL @ls) (amendL' @ls)
class HasProjectL (ls :: k1) (as :: k) (bs :: k) (ss :: k) (ts :: k) a b s t
| a -> as, b -> bs, s -> ss, t -> ts
, b as -> a, s as -> a, t as -> a
, a bs -> b, s bs -> b, t bs -> b
, a ss -> s, b ss -> s, t ss -> s
, a ts -> t, b ts -> t, s ts -> t
, s ls -> as, t ls -> bs, s ls b -> t, t ls a -> s where
projectL :: Lens s t a b
instance ( Select smaller larger
, Amend smaller smaller' larger
, smaller ~ KindsAtLabels ls larger
, IsDistinct ls
, UniqueLabels ls larger
, larger' ~ Replaces smaller smaller' larger)
=> HasProjectL ls smaller smaller' larger larger' (Many smaller) (Many smaller') (Many larger) (Many larger') where
projectL = lens (selectL @ls) (amendL @ls)
class HasProjectN' (ns :: [Nat]) (as :: k) (ss :: k) a s | a -> as, s -> ss, s as -> a, a ss -> s, s ns -> as where
projectN' :: Lens' s a
instance (SelectN ns smaller larger, AmendN' ns smaller larger)
=> HasProjectN' ns smaller larger (Many smaller) (Many larger) where
projectN' = lens (selectN @ns) (amendN' @ns)
class HasProjectN (ns :: [Nat]) (as :: k) (bs :: k) (ss :: k) (ts :: k) a b s t
| a -> as, b -> bs, s -> ss, t -> ts
, b as -> a, s as -> a, t as -> a
, a bs -> b, s bs -> b, t bs -> b
, a ss -> s, b ss -> s, t ss -> s
, a ts -> t, b ts -> t, s ts -> t
, s ns -> as, t ns -> bs, s ns b -> t, t ns a -> s where
projectN :: Lens s t a b
instance (SelectN ns smaller larger, AmendN ns smaller smaller' larger, larger' ~ ReplacesIndex ns smaller' larger)
=> HasProjectN ns smaller smaller' larger larger' (Many smaller) (Many smaller') (Many larger) (Many larger') where
projectN = lens (selectN @ns) (amendN @ns)