@@ -19,7 +19,6 @@ module Data.Schematic.Lens
1919 ) where
2020
2121import Data.Profunctor
22−import Data.Proxy
2322import Data.Schematic.Schema
2423import Data.Scientific
2524import Data.Singletons
@@ -36,20 +35,20 @@ type family FIndex (r :: Symbol) (rs :: [(Symbol, Schema)]) :: Nat where
3635 FIndex r ( '(r, s) ': rs) = 'Z
3736 FIndex r ( s ': rs) = 'S (FIndex r rs)
3837
38+type Flens fn f g rs i
39+ = Functor g
40+ => (f '(fn, (ByField fn rs i)) -> g (f '(fn, (ByField fn rs i))))
41+ -> Rec f rs
42+ -> g (Rec f rs)
43+
44+type FGetter fn f rs i = Rec f rs -> f '(fn, (ByField fn rs i))
45+
3946class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i :: Nat) where
4047 type ByField fn rs i :: Schema
41− flens
42− :: Functor g
43− => proxy fn
44− -> (f '(fn, (ByField fn rs i)) -> g (f '(fn, (ByField fn rs i))))
45− -> Rec f rs
46− -> g (Rec f rs)
48+ flens :: Flens fn f g rs i
4749
4850 -- | For Vinyl users who are not using the @lens@ package, we provide a getter.
49− fget
50− :: proxy fn
51− -> Rec f rs
52− -> f '(fn, (ByField fn rs i))
51+ fget :: FGetter fn f rs i
5352
5453 -- | For Vinyl users who are not using the @lens@ package, we also provide a
5554 -- setter. In general, it will be unambiguous what field is being written to,
@@ -62,25 +61,25 @@ class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i ::
6261instance FElem fn ('(fn, r) ': rs) 'Z where
6362 type ByField fn ('(fn, r) ': rs) 'Z = r
6463
65− flens _ f (x :& xs) = fmap (:& xs) (f x)
64+ flens f (x :& xs) = fmap (:& xs) (f x)
6665 {-# INLINE flens #-}
6766
68− fget k = getConst . flens k Const
67+ fget = getConst . flens Const
6968 {-# INLINE fget #-}
7069
71− fput y = getIdentity . flens Proxy (\_ -> Identity y)
70+ fput y = getIdentity . flens (\_ -> Identity y)
7271 {-# INLINE fput #-}
7372
7473instance (FIndex r (s ': rs) ~ 'S i, FElem r rs i) => FElem r (s ': rs) ('S i) where
7574 type ByField r (s ': rs) ('S i) = ByField r rs i
7675
77− flens p f (x :& xs) = fmap (x :&) (flens p f xs)
76+ flens f (x :& xs) = fmap (x :&) (flens f xs)
7877 {-# INLINE flens #-}
7978
80− fget k = getConst . flens k Const
79+ fget = getConst . flens Const
8180 {-# INLINE fget #-}
8281
83− fput y = getIdentity . flens Proxy (\_ -> Identity y)
82+ fput y = getIdentity . flens (\_ -> Identity y)
8483 {-# INLINE fput #-}
8584
8685-- This is an internal convenience helpers stolen from the @lens@ library.
@@ -144,7 +143,7 @@ instance
144143 ( ByField fn ss i ~ s
145144 , FElem fn ss i
146145 , FSubset rs ss is) => FSubset ( '(fn,s) ': rs) ss (i ': is) where
147− fsubset = lens (\ss -> fget Proxy ss :& fcast ss) set
146+ fsubset = lens (\ss -> fget @fn ss :& fcast ss) set
148147 where
149148 set :: Rec f ss -> Rec f ( '(fn,s) ': rs) -> Rec f ss
150149 set ss (r :& rs) = fput r $ freplace rs ss