git.iko.soy/schematic
on master help sign in
FLens with TypeApplications
5d5b577Denis Redozubov
src/Data/Schematic/Lens.hs+17−18
compare with master
unifiedsplit
@@ -19,7 +19,6 @@ module Data.Schematic.Lens
19 ) where
19 ) where
20
20
21import Data.Profunctor
21import Data.Profunctor
22−import Data.Proxy
23import Data.Schematic.Schema
22import Data.Schematic.Schema
24import Data.Scientific
23import Data.Scientific
25import Data.Singletons
24import Data.Singletons
@@ -36,20 +35,20 @@ type family FIndex (r :: Symbol) (rs :: [(Symbol, Schema)]) :: Nat where
36 FIndex r ( '(r, s) ': rs) = 'Z
35 FIndex r ( '(r, s) ': rs) = 'Z
37 FIndex r ( s ': rs) = 'S (FIndex r rs)
36 FIndex r ( s ': rs) = 'S (FIndex r rs)
38
37
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+
39class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i :: Nat) where
46class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i :: Nat) where
40 type ByField fn rs i :: Schema
47 type ByField fn rs i :: Schema
41− flens
48+ flens :: Flens fn f g rs i
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)
47
49
48 -- | For Vinyl users who are not using the @lens@ package, we provide a getter.
50 -- | For Vinyl users who are not using the @lens@ package, we provide a getter.
49− fget
51+ fget :: FGetter fn f rs i
50− :: proxy fn
51− -> Rec f rs
52− -> f '(fn, (ByField fn rs i))
53
52
54 -- | For Vinyl users who are not using the @lens@ package, we also provide a
53 -- | For Vinyl users who are not using the @lens@ package, we also provide a
55 -- setter. In general, it will be unambiguous what field is being written to,
54 -- 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 ::
62instance FElem fn ('(fn, r) ': rs) 'Z where
61instance FElem fn ('(fn, r) ': rs) 'Z where
63 type ByField fn ('(fn, r) ': rs) 'Z = r
62 type ByField fn ('(fn, r) ': rs) 'Z = r
64
63
65− flens _ f (x :& xs) = fmap (:& xs) (f x)
64+ flens f (x :& xs) = fmap (:& xs) (f x)
66 {-# INLINE flens #-}
65 {-# INLINE flens #-}
67
66
68− fget k = getConst . flens k Const
67+ fget = getConst . flens Const
69 {-# INLINE fget #-}
68 {-# INLINE fget #-}
70
69
71− fput y = getIdentity . flens Proxy (\_ -> Identity y)
70+ fput y = getIdentity . flens (\_ -> Identity y)
72 {-# INLINE fput #-}
71 {-# INLINE fput #-}
73
72
74instance (FIndex r (s ': rs) ~ 'S i, FElem r rs i) => FElem r (s ': rs) ('S i) where
73instance (FIndex r (s ': rs) ~ 'S i, FElem r rs i) => FElem r (s ': rs) ('S i) where
75 type ByField r (s ': rs) ('S i) = ByField r rs i
74 type ByField r (s ': rs) ('S i) = ByField r rs i
76
75
77− flens p f (x :& xs) = fmap (x :&) (flens p f xs)
76+ flens f (x :& xs) = fmap (x :&) (flens f xs)
78 {-# INLINE flens #-}
77 {-# INLINE flens #-}
79
78
80− fget k = getConst . flens k Const
79+ fget = getConst . flens Const
81 {-# INLINE fget #-}
80 {-# INLINE fget #-}
82
81
83− fput y = getIdentity . flens Proxy (\_ -> Identity y)
82+ fput y = getIdentity . flens (\_ -> Identity y)
84 {-# INLINE fput #-}
83 {-# INLINE fput #-}
85
84
86-- This is an internal convenience helpers stolen from the @lens@ library.
85-- This is an internal convenience helpers stolen from the @lens@ library.
@@ -144,7 +143,7 @@ instance
144 ( ByField fn ss i ~ s
143 ( ByField fn ss i ~ s
145 , FElem fn ss i
144 , FElem fn ss i
146 , FSubset rs ss is) => FSubset ( '(fn,s) ': rs) ss (i ': is) where
145 , 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
148 where
147 where
149 set :: Rec f ss -> Rec f ( '(fn,s) ': rs) -> Rec f ss
148 set :: Rec f ss -> Rec f ( '(fn,s) ': rs) -> Rec f ss
150 set ss (r :& rs) = fput r $ freplace rs ss
149 set ss (r :& rs) = fput r $ freplace rs ss
test/LensSpec.hs+4−4
@@ -303,15 +303,15 @@ spec = do
303 newFooVal = FieldRepr $ ReprArray [ReprNumber 15]
303 newFooVal = FieldRepr $ ReprArray [ReprNumber 15]
304 fooProxy = Proxy @"foo"
304 fooProxy = Proxy @"foo"
305 it "gets the field from an object" $ do
305 it "gets the field from an object" $ do
306− fget fooProxy objectData `shouldBe` arrayField
306+ fget @"foo" objectData `shouldBe` arrayField
307 it "sets the object field" $ do
307 it "sets the object field" $ do
308− fget fooProxy (fput newFooVal objectData) `shouldBe` newFooVal
308+ fget @"foo" (fput newFooVal objectData) `shouldBe` newFooVal
309
309
310 describe "(using lens library) " $ do
310 describe "(using lens library) " $ do
311 it "get the field from an object" $ do
311 it "get the field from an object" $ do
312− objectData ^. flens (Proxy @"foo") `shouldBe` arrayField
312+ objectData ^. flens @"foo" `shouldBe` arrayField
313 it "sets the object field" $ do
313 it "sets the object field" $ do
314− set (flens (Proxy @"foo")) newFooVal objectData ^. flens (Proxy @"foo")
314+ set (flens @"foo") newFooVal objectData ^. flens @"foo"
315 `shouldBe` newFooVal
315 `shouldBe` newFooVal
316
316
317main :: IO ()
317main :: IO ()