@@ -31,99 +31,86 @@ module Data.Generics.Product.Types
3131 --
3232 -- $example
3333 HasTypes (..)
34− , HasTypesDeep (..)
3534 ) where
3635
37−import Data.Generics.Product.Internal.Types
3836import Data.Kind
3937import Data.Type.Bool
4038
4139import GHC.Generics
4240import Data.Generics.Internal.VL.Traversal
43−import Data.Generics.Internal.VL.Iso
4441
4542class HasTypes a s where
4643 types :: Traversal' s a
4744
48−instance
49− ( Generic s
50− , GHasTypes (Rep s) '[a]
51− ) => HasTypes a s where
52− types = confusing (\f -> (repIso . gtypes) (f :> HNil))
45+ default types :: Traversal' s a
46+ types _ = pure
5347 {-# INLINE types #-}
5448
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−
6249instance
63− ( HasTypesDeep1 (Interesting s a) a s
64− ) => HasTypesDeep a s where
65− typesDeep = typesDeep1 @(Interesting s a)
66− {-# INLINE typesDeep #-}
50+ ( HasTypes1 (Interesting s a) a s
51+ ) => HasTypes a s where
52+ types = types1 @(Interesting s a)
53+ {-# INLINE types #-}
6754
68−class HasTypesDeep1 (t :: Bool) a s where
69− typesDeep1 :: Traversal' s a
55+class HasTypes1 (t :: Bool) a s where
56+ types1 :: Traversal' s a
7057
7158instance
72− ( GHasTypesDeep a (Rep s)
59+ ( GHasTypes a (Rep s)
7360 , Generic s
74− ) => HasTypesDeep1 'True a s where
75− typesDeep1 f s = to <$> gtypesDeep f (from s)
76− --{-# INLINE typesDeep1 #-}
77−
78−instance HasTypesDeep1 'False a s where
79− typesDeep1 _ = pure
80− --{-# INLINE typesDeep1 #-}
81−
82−instance {-# OVERLAPPING #-} HasTypesDeep a Bool
83−instance {-# OVERLAPPING #-} HasTypesDeep a Char
84−instance {-# OVERLAPPING #-} HasTypesDeep a Double
85−instance {-# OVERLAPPING #-} HasTypesDeep a Float
86−instance {-# OVERLAPPING #-} HasTypesDeep a Int
87−instance {-# OVERLAPPING #-} HasTypesDeep a Integer
88−instance {-# OVERLAPPING #-} HasTypesDeep a Ordering
61+ ) => HasTypes1 'True a s where
62+ types1 f s = to <$> gtypes f (from s)
63+ --{-# INLINE types1 #-}
64+
65+instance HasTypes1 'False a s where
66+ types1 _ = pure
67+ --{-# INLINE types1 #-}
68+
69+instance {-# OVERLAPPING #-} HasTypes a Bool
70+instance {-# OVERLAPPING #-} HasTypes a Char
71+instance {-# OVERLAPPING #-} HasTypes a Double
72+instance {-# OVERLAPPING #-} HasTypes a Float
73+instance {-# OVERLAPPING #-} HasTypes a Int
74+instance {-# OVERLAPPING #-} HasTypes a Integer
75+instance {-# OVERLAPPING #-} HasTypes a Ordering
8976
9077--------------------------------------------------------------------------------
9178
92−class GHasTypesDeep a s where
93− gtypesDeep :: Traversal' (s x) a
79+class GHasTypes a s where
80+ gtypes :: Traversal' (s x) a
9481
9582instance
96− ( GHasTypesDeep a l
97− , GHasTypesDeep a r
98− ) => GHasTypesDeep a (l :*: r) where
99− gtypesDeep f (l :*: r) = (:*:) <$> gtypesDeep f l <*> gtypesDeep f r
100− {-# INLINE gtypesDeep #-}
83+ ( GHasTypes a l
84+ , GHasTypes a r
85+ ) => GHasTypes a (l :*: r) where
86+ gtypes f (l :*: r) = (:*:) <$> gtypes f l <*> gtypes f r
87+ {-# INLINE gtypes #-}
10188
10289instance
103− ( GHasTypesDeep a l
104− , GHasTypesDeep a r
105− ) => GHasTypesDeep a (l :+: r) where
106− gtypesDeep f (L1 l) = L1 <$> gtypesDeep f l
107− gtypesDeep f (R1 r) = R1 <$> gtypesDeep f r
108− {-# INLINE gtypesDeep #-}
109−
110−instance (GHasTypesDeep a s) => GHasTypesDeep a (M1 m meta s) where
111− gtypesDeep f (M1 s) = M1 <$> gtypesDeep f s
112− {-# INLINE gtypesDeep #-}
113−
114−instance {-# OVERLAPPING #-} GHasTypesDeep a (Rec0 a) where
115− gtypesDeep f (K1 x) = K1 <$> f x
116− {-# INLINE gtypesDeep #-}
117−
118−instance HasTypesDeep a b => GHasTypesDeep a (Rec0 b) where
119− gtypesDeep f (K1 x) = K1 <$> typesDeep @a f x
120− {-# INLINE gtypesDeep #-}
121−
122−instance GHasTypesDeep a U1 where
123− gtypesDeep _ _ = pure U1
124− {-# INLINE gtypesDeep #-}
125−
126−--instance GHasTypesDeep a V1 where
90+ ( GHasTypes a l
91+ , GHasTypes a r
92+ ) => GHasTypes a (l :+: r) where
93+ gtypes f (L1 l) = L1 <$> gtypes f l
94+ gtypes f (R1 r) = R1 <$> gtypes f r
95+ {-# INLINE gtypes #-}
96+
97+instance (GHasTypes a s) => GHasTypes a (M1 m meta s) where
98+ gtypes f (M1 s) = M1 <$> gtypes f s
99+ {-# INLINE gtypes #-}
100+
101+instance {-# OVERLAPPING #-} GHasTypes a (Rec0 a) where
102+ gtypes f (K1 x) = K1 <$> f x
103+ {-# INLINE gtypes #-}
104+
105+instance HasTypes a b => GHasTypes a (Rec0 b) where
106+ gtypes f (K1 x) = K1 <$> types @a f x
107+ {-# INLINE gtypes #-}
108+
109+instance GHasTypes a U1 where
110+ gtypes _ _ = pure U1
111+ {-# INLINE gtypes #-}
112+
113+--instance GHasTypes a V1 where
127114
128115type Interesting f a = Interesting' f (Rep f) a
129116