on master help sign in
Fix RIndex type family
commitde87c9132e2b14be1744f00d68e50651bef957b3 authorDenis Redozubov <denis.redozubov@gmail.com> dateTue 3 Oct 2017, 17:21 (9 years ago) parentae16096
2 files changed+19−15
src/Data/Schematic/Lens.hs+16−12 test/LensSpec.hs+3−3
src/Data/Schematic/Lens.hs+16−12
@@ -3,7 +3,12 @@
33{-# LANGUAGE AllowAmbiguousTypes #-}
44{-# LANGUAGE InstanceSigs #-}
55
6−module Data.Schematic.Lens where
6+module Data.Schematic.Lens
7+ ( FIndex
8+ , FElem(..)
9+ , FImage
10+ , FSubset(..)
11+ ) where
712
813import Data.Proxy
914import Data.Schematic.Schema
@@ -15,15 +20,15 @@ import GHC.TypeLits (Symbol)
1520
1621-- | A partial relation that gives the index of a value in a list.
1722type family FIndex (r :: Symbol) (rs :: [(Symbol, Schema)]) :: Nat where
18− FIndex r ( '(fn, s) ': rs) = 'Z
19− FIndex r ( s ': rs) = 'S (FIndex r rs)
23+ FIndex r ( '(r, s) ': rs) = 'Z
24+ FIndex r ( s ': rs) = 'S (FIndex r rs)
2025
2126class 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
2328 flens
2429 :: Functor g
2530 => 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))))
2732 -> Rec FieldRepr rs
2833 -> g (Rec FieldRepr rs)
2934
@@ -31,18 +36,18 @@ class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i ::
3136 fget
3237 :: proxy fn
3338 -> Rec FieldRepr rs
34− -> FieldRepr '(fn, (ByRevision fn rs i))
39+ -> FieldRepr '(fn, (ByField fn rs i))
3540
3641 -- | For Vinyl users who are not using the @lens@ package, we also provide a
3742 -- setter. In general, it will be unambiguous what field is being written to,
3843 -- and so we do not take a proxy argument here.
3944 fput
40− :: FieldRepr '(fn, ByRevision fn rs i)
45+ :: FieldRepr '(fn, ByField fn rs i)
4146 -> Rec FieldRepr rs
4247 -> Rec FieldRepr rs
4348
4449instance 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
4651
4752 flens _ f (x :& xs) = fmap (:& xs) (f x)
4853 {-# INLINE flens #-}
@@ -54,7 +59,7 @@ instance FElem fn ('(fn, r) ': rs) 'Z where
5459 {-# INLINE fput #-}
5560
5661instance (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
5863
5964 flens p f (x :& xs) = fmap (x :&) (flens p f xs)
6065 {-# INLINE flens #-}
@@ -113,10 +118,9 @@ instance FSubset '[] ss '[] where
113118 fsubset = lens (const RNil) const
114119
115120instance
116− ( ByRevision fn ss i ~ s
121+ ( ByField fn ss i ~ s
117122 , 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
120124 fsubset = lens (\ss -> fget Proxy ss :& fcast ss) set
121125 where
122126 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])
1313type ArrayField = '("foo", ArraySchema)
1414
1515type FieldsSchema =
16− '[ ArrayField, '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
16+ '[ '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]])), ArrayField]
1717
1818type SchemaExample = 'SchemaObject FieldsSchema
1919
@@ -24,8 +24,8 @@ arrayField :: FieldRepr ArrayField
2424arrayField = FieldRepr arrayData
2525
2626objectData :: Rec FieldRepr FieldsSchema
27−objectData = FieldRepr arrayData
28− :& FieldRepr (ReprOptional (Just (ReprText "foo")))
27+objectData = FieldRepr (ReprOptional (Just (ReprText "foo")))
28+ :& FieldRepr arrayData
2929 :& RNil
3030
3131exampleData :: JsonRepr SchemaExample