git.iko.soy/generic-lens
on master help sign in
Rename typesDeep to types and remove old types
3e9221cMatthew Pickering
src/Data/Generics/Product/Internal/Types.hs+5−4
compare with master
unifiedsplit
@@ -26,9 +26,8 @@
26-----------------------------------------------------------------------------
26-----------------------------------------------------------------------------
27
27
28module Data.Generics.Product.Internal.Types
28module Data.Generics.Product.Internal.Types
29− ( GHasTypes
29+ (
30− , GHasConstraints (..)
30+ GHasConstraints (..)
31− , gtypes
32 , HList (..)
31 , HList (..)
33 ) where
32 ) where
34
33
@@ -60,15 +59,17 @@ instance GHasConstraints c U1 where
60--------------------------------------------------------------------------------
59--------------------------------------------------------------------------------
61
60
62-- | Multi-traversal
61-- | Multi-traversal
63−type GHasTypes rep as = GHasConstraints (Contains as) rep
62+--type GHasTypes rep as = GHasConstraints (Contains as) rep
64
63
65-- Try to use a function from the list, or default to 'pure' if not present
64-- Try to use a function from the list, or default to 'pure' if not present
65+{-
66gtypes
66gtypes
67 :: forall as x f g.
67 :: forall as x f g.
68 ( GHasTypes f as
68 ( GHasTypes f as
69 , Applicative g
69 , Applicative g
70 ) => HList (Functions as g) -> f x -> g (f x)
70 ) => HList (Functions as g) -> f x -> g (f x)
71gtypes hl s = gconstraints @(Contains as) (pick hl) s
71gtypes hl s = gconstraints @(Contains as) (pick hl) s
72+-}
72
73
73--------------------------------------------------------------------------------
74--------------------------------------------------------------------------------
74
75
src/Data/Generics/Product/Types.hs+55−68
@@ -31,99 +31,86 @@ module Data.Generics.Product.Types
31 --
31 --
32 -- $example
32 -- $example
33 HasTypes (..)
33 HasTypes (..)
34− , HasTypesDeep (..)
35 ) where
34 ) where
36
35
37−import Data.Generics.Product.Internal.Types
38import Data.Kind
36import Data.Kind
39import Data.Type.Bool
37import Data.Type.Bool
40
38
41import GHC.Generics
39import GHC.Generics
42import Data.Generics.Internal.VL.Traversal
40import Data.Generics.Internal.VL.Traversal
43−import Data.Generics.Internal.VL.Iso
44
41
45class HasTypes a s where
42class HasTypes a s where
46 types :: Traversal' s a
43 types :: Traversal' s a
47
44
48−instance
45+ default types :: Traversal' s a
49− ( Generic s
46+ types _ = pure
50− , GHasTypes (Rep s) '[a]
51− ) => HasTypes a s where
52− types = confusing (\f -> (repIso . gtypes) (f :> HNil))
53 {-# INLINE types #-}
47 {-# INLINE types #-}
54
48
55−class HasTypesDeep a s where
56− typesDeep :: Traversal' s a
57−
58− default typesDeep :: Traversal' s a
59− typesDeep _ = pure
60− {-# INLINE typesDeep #-}
61−
62instance
49instance
63− ( HasTypesDeep1 (Interesting s a) a s
50+ ( HasTypes1 (Interesting s a) a s
64− ) => HasTypesDeep a s where
51+ ) => HasTypes a s where
65− typesDeep = typesDeep1 @(Interesting s a)
52+ types = types1 @(Interesting s a)
66− {-# INLINE typesDeep #-}
53+ {-# INLINE types #-}
67
54
68−class HasTypesDeep1 (t :: Bool) a s where
55+class HasTypes1 (t :: Bool) a s where
69− typesDeep1 :: Traversal' s a
56+ types1 :: Traversal' s a
70
57
71instance
58instance
72− ( GHasTypesDeep a (Rep s)
59+ ( GHasTypes a (Rep s)
73 , Generic s
60 , Generic s
74− ) => HasTypesDeep1 'True a s where
61+ ) => HasTypes1 'True a s where
75− typesDeep1 f s = to <$> gtypesDeep f (from s)
62+ types1 f s = to <$> gtypes f (from s)
76− --{-# INLINE typesDeep1 #-}
63+ --{-# INLINE types1 #-}
77−
64+
78−instance HasTypesDeep1 'False a s where
65+instance HasTypes1 'False a s where
79− typesDeep1 _ = pure
66+ types1 _ = pure
80− --{-# INLINE typesDeep1 #-}
67+ --{-# INLINE types1 #-}
81−
68+
82−instance {-# OVERLAPPING #-} HasTypesDeep a Bool
69+instance {-# OVERLAPPING #-} HasTypes a Bool
83−instance {-# OVERLAPPING #-} HasTypesDeep a Char
70+instance {-# OVERLAPPING #-} HasTypes a Char
84−instance {-# OVERLAPPING #-} HasTypesDeep a Double
71+instance {-# OVERLAPPING #-} HasTypes a Double
85−instance {-# OVERLAPPING #-} HasTypesDeep a Float
72+instance {-# OVERLAPPING #-} HasTypes a Float
86−instance {-# OVERLAPPING #-} HasTypesDeep a Int
73+instance {-# OVERLAPPING #-} HasTypes a Int
87−instance {-# OVERLAPPING #-} HasTypesDeep a Integer
74+instance {-# OVERLAPPING #-} HasTypes a Integer
88−instance {-# OVERLAPPING #-} HasTypesDeep a Ordering
75+instance {-# OVERLAPPING #-} HasTypes a Ordering
89
76
90--------------------------------------------------------------------------------
77--------------------------------------------------------------------------------
91
78
92−class GHasTypesDeep a s where
79+class GHasTypes a s where
93− gtypesDeep :: Traversal' (s x) a
80+ gtypes :: Traversal' (s x) a
94
81
95instance
82instance
96− ( GHasTypesDeep a l
83+ ( GHasTypes a l
97− , GHasTypesDeep a r
84+ , GHasTypes a r
98− ) => GHasTypesDeep a (l :*: r) where
85+ ) => GHasTypes a (l :*: r) where
99− gtypesDeep f (l :*: r) = (:*:) <$> gtypesDeep f l <*> gtypesDeep f r
86+ gtypes f (l :*: r) = (:*:) <$> gtypes f l <*> gtypes f r
100− {-# INLINE gtypesDeep #-}
87+ {-# INLINE gtypes #-}
101
88
102instance
89instance
103− ( GHasTypesDeep a l
90+ ( GHasTypes a l
104− , GHasTypesDeep a r
91+ , GHasTypes a r
105− ) => GHasTypesDeep a (l :+: r) where
92+ ) => GHasTypes a (l :+: r) where
106− gtypesDeep f (L1 l) = L1 <$> gtypesDeep f l
93+ gtypes f (L1 l) = L1 <$> gtypes f l
107− gtypesDeep f (R1 r) = R1 <$> gtypesDeep f r
94+ gtypes f (R1 r) = R1 <$> gtypes f r
108− {-# INLINE gtypesDeep #-}
95+ {-# INLINE gtypes #-}
109−
96+
110−instance (GHasTypesDeep a s) => GHasTypesDeep a (M1 m meta s) where
97+instance (GHasTypes a s) => GHasTypes a (M1 m meta s) where
111− gtypesDeep f (M1 s) = M1 <$> gtypesDeep f s
98+ gtypes f (M1 s) = M1 <$> gtypes f s
112− {-# INLINE gtypesDeep #-}
99+ {-# INLINE gtypes #-}
113−
100+
114−instance {-# OVERLAPPING #-} GHasTypesDeep a (Rec0 a) where
101+instance {-# OVERLAPPING #-} GHasTypes a (Rec0 a) where
115− gtypesDeep f (K1 x) = K1 <$> f x
102+ gtypes f (K1 x) = K1 <$> f x
116− {-# INLINE gtypesDeep #-}
103+ {-# INLINE gtypes #-}
117−
104+
118−instance HasTypesDeep a b => GHasTypesDeep a (Rec0 b) where
105+instance HasTypes a b => GHasTypes a (Rec0 b) where
119− gtypesDeep f (K1 x) = K1 <$> typesDeep @a f x
106+ gtypes f (K1 x) = K1 <$> types @a f x
120− {-# INLINE gtypesDeep #-}
107+ {-# INLINE gtypes #-}
121−
108+
122−instance GHasTypesDeep a U1 where
109+instance GHasTypes a U1 where
123− gtypesDeep _ _ = pure U1
110+ gtypes _ _ = pure U1
124− {-# INLINE gtypesDeep #-}
111+ {-# INLINE gtypes #-}
125−
112+
126−--instance GHasTypesDeep a V1 where
113+--instance GHasTypes a V1 where
127
114
128type Interesting f a = Interesting' f (Rep f) a
115type Interesting f a = Interesting' f (Rep f) a
129
116
test/syb/Tree.hs+3−3
@@ -50,7 +50,7 @@ poly = PCons 10 (PCons "hello" (PCons 20 (PCons "world" PNil)))
50-- So (1.) confuses leafs and weights whereas (2.) does not.
50-- So (1.) confuses leafs and weights whereas (2.) does not.
51tests :: Test
51tests :: Test
52tests = TestList
52tests = TestList
53− [ toListOf (typesDeep @Int) mytree ~=? [42,1,88,37,2]
53+ [ toListOf (types @Int) mytree ~=? [42,1,88,37,2]
54 , toListOf (param @1) mytree ~=? [42,88,37]
54 , toListOf (param @1) mytree ~=? [42,88,37]
55
55
56 -- Things not (easily) doable in SYB:
56 -- Things not (easily) doable in SYB:
@@ -59,9 +59,9 @@ tests = TestList
59 -- collect values in poly corresponding to the first param
59 -- collect values in poly corresponding to the first param
60 , toListOf (param @0) poly ~=? ["hello", "world"]
60 , toListOf (param @0) poly ~=? ["hello", "world"]
61 -- collect all Ints inside poly
61 -- collect all Ints inside poly
62− , toListOf (typesDeep @Int) poly ~=? [10, 20]
62+ , toListOf (types @Int) poly ~=? [10, 20]
63 -- map length over the Strings, then collect all Ints
63 -- map length over the Strings, then collect all Ints
64− , toListOf (typesDeep @Int) (poly & param @0 %~ length) ~=? [10, 5, 20, 5]
64+ , toListOf (types @Int) (poly & param @0 %~ length) ~=? [10, 5, 20, 5]
65 -- map length over the Strings, then collect all the resulting Ints
65 -- map length over the Strings, then collect all the resulting Ints
66 , toListOf (param @0) (poly & param @0 %~ length) ~=? [5,5]
66 , toListOf (param @0) (poly & param @0 %~ length) ~=? [5,5]
67 ]
67 ]