git.iko.soy/typeable/schematic
on master help sign in
Fix RIndex type family
de87c91Denis Redozubov
src/Data/Schematic/Lens.hs+16−12
@@ -3,7 +3,12 @@
3{-# LANGUAGE AllowAmbiguousTypes #-}
3{-# LANGUAGE AllowAmbiguousTypes #-}
4{-# LANGUAGE InstanceSigs #-}
4{-# LANGUAGE InstanceSigs #-}
5
5
6−module Data.Schematic.Lens where
6+module Data.Schematic.Lens
7+ ( FIndex
8+ , FElem(..)
9+ , FImage
10+ , FSubset(..)
11+ ) where
7
12
8import Data.Proxy
13import Data.Proxy
9import Data.Schematic.Schema
14import Data.Schematic.Schema
@@ -15,15 +20,15 @@ import GHC.TypeLits (Symbol)
15
20
16-- | A partial relation that gives the index of a value in a list.
21-- | A partial relation that gives the index of a value in a list.
17type family FIndex (r :: Symbol) (rs :: [(Symbol, Schema)]) :: Nat where
22type family FIndex (r :: Symbol) (rs :: [(Symbol, Schema)]) :: Nat where
18− FIndex r ( '(fn, s) ': rs) = 'Z
23+ FIndex r ( '(r, s) ': rs) = 'Z
19− FIndex r ( s ': rs) = 'S (FIndex r rs)
24+ FIndex r ( s ': rs) = 'S (FIndex r rs)
20
25
21class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i :: Nat) where
26class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i :: Nat) where
22− type ByRevision fn rs i :: Schema
27+ type ByField fn rs i :: Schema
23 flens
28 flens
24 :: Functor g
29 :: Functor g
25 => proxy fn
30 => proxy fn
26− -> (FieldRepr '(fn, (ByRevision fn rs i)) -> g (FieldRepr '(fn, (ByRevision fn rs i))))
31+ -> (FieldRepr '(fn, (ByField fn rs i)) -> g (FieldRepr '(fn, (ByField fn rs i))))
27 -> Rec FieldRepr rs
32 -> Rec FieldRepr rs
28 -> g (Rec FieldRepr rs)
33 -> g (Rec FieldRepr rs)
29
34
@@ -31,18 +36,18 @@ class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i ::
31 fget
36 fget
32 :: proxy fn
37 :: proxy fn
33 -> Rec FieldRepr rs
38 -> Rec FieldRepr rs
34− -> FieldRepr '(fn, (ByRevision fn rs i))
39+ -> FieldRepr '(fn, (ByField fn rs i))
35
40
36 -- | For Vinyl users who are not using the @lens@ package, we also provide a
41 -- | For Vinyl users who are not using the @lens@ package, we also provide a
37 -- setter. In general, it will be unambiguous what field is being written to,
42 -- setter. In general, it will be unambiguous what field is being written to,
38 -- and so we do not take a proxy argument here.
43 -- and so we do not take a proxy argument here.
39 fput
44 fput
40− :: FieldRepr '(fn, ByRevision fn rs i)
45+ :: FieldRepr '(fn, ByField fn rs i)
41 -> Rec FieldRepr rs
46 -> Rec FieldRepr rs
42 -> Rec FieldRepr rs
47 -> Rec FieldRepr rs
43
48
44instance FElem fn ('(fn, r) ': rs) 'Z where
49instance FElem fn ('(fn, r) ': rs) 'Z where
45− type ByRevision fn ('(fn, r) ': rs) 'Z = r
50+ type ByField fn ('(fn, r) ': rs) 'Z = r
46
51
47 flens _ f (x :& xs) = fmap (:& xs) (f x)
52 flens _ f (x :& xs) = fmap (:& xs) (f x)
48 {-# INLINE flens #-}
53 {-# INLINE flens #-}
@@ -54,7 +59,7 @@ instance FElem fn ('(fn, r) ': rs) 'Z where
54 {-# INLINE fput #-}
59 {-# INLINE fput #-}
55
60
56instance (FIndex r (s ': rs) ~ 'S i, FElem r rs i) => FElem r (s ': rs) ('S i) where
61instance (FIndex r (s ': rs) ~ 'S i, FElem r rs i) => FElem r (s ': rs) ('S i) where
57− type ByRevision r (s ': rs) ('S i) = ByRevision r rs i
62+ type ByField r (s ': rs) ('S i) = ByField r rs i
58
63
59 flens p f (x :& xs) = fmap (x :&) (flens p f xs)
64 flens p f (x :& xs) = fmap (x :&) (flens p f xs)
60 {-# INLINE flens #-}
65 {-# INLINE flens #-}
@@ -113,10 +118,9 @@ instance FSubset '[] ss '[] where
113 fsubset = lens (const RNil) const
118 fsubset = lens (const RNil) const
114
119
115instance
120instance
116− ( ByRevision fn ss i ~ s
121+ ( ByField fn ss i ~ s
117 , FElem fn ss i
122 , FElem fn ss i
118− , FSubset rs ss is
119− ) => FSubset ( '(fn,s) ': rs) ss (i ': is) where
123+ , FSubset rs ss is) => FSubset ( '(fn,s) ': rs) ss (i ': is) where
120 fsubset = lens (\ss -> fget Proxy ss :& fcast ss) set
124 fsubset = lens (\ss -> fget Proxy ss :& fcast ss) set
121 where
125 where
122 set :: Rec FieldRepr ss -> Rec FieldRepr ( '(fn,s) ': rs) -> Rec FieldRepr ss
126 set :: Rec FieldRepr ss -> Rec FieldRepr ( '(fn,s) ': rs) -> Rec FieldRepr ss
test/LensSpec.hs+3−3
@@ -13,7 +13,7 @@ type ArraySchema = 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10])
13type ArrayField = '("foo", ArraySchema)
13type ArrayField = '("foo", ArraySchema)
14
14
15type FieldsSchema =
15type FieldsSchema =
16− '[ ArrayField, '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
16+ '[ '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]])), ArrayField]
17
17
18type SchemaExample = 'SchemaObject FieldsSchema
18type SchemaExample = 'SchemaObject FieldsSchema
19
19
@@ -24,8 +24,8 @@ arrayField :: FieldRepr ArrayField
24arrayField = FieldRepr arrayData
24arrayField = FieldRepr arrayData
25
25
26objectData :: Rec FieldRepr FieldsSchema
26objectData :: Rec FieldRepr FieldsSchema
27−objectData = FieldRepr arrayData
28− :& FieldRepr (ReprOptional (Just (ReprText "foo")))
27+objectData = FieldRepr (ReprOptional (Just (ReprText "foo")))
28+ :& FieldRepr arrayData
29 :& RNil
29 :& RNil
30
30
31exampleData :: JsonRepr SchemaExample
31exampleData :: JsonRepr SchemaExample