bc2c3be · generic-lens

src/Data/Generics/Internal/Families/Count.hs+1

compare with master

unifiedsplit

@@ -6,6 +6,7 @@

6

7module Data.Generics.Internal.Families.Count

8 ( CountType

9+ , Counted (..)

9 ) where

10 ) where

10

11

11import GHC.Generics

12import GHC.Generics

src/Data/Generics/Internal/Families/Find.hs+26

@@ -6,6 +6,7 @@

6

7module Data.Generics.Internal.Families.Find

8 ( FindField

9+ , FindType

9 ) where

10 ) where

10

11

11import Data.Kind (Type)

12import Data.Kind (Type)

@@ -39,6 +40,31 @@ type family FindField (field :: Symbol) f :: Maybe Type where

39 ':<>: 'Text " is not a valid GHC.Generics representation type"

40 ':<>: 'Text " is not a valid GHC.Generics representation type"

40 )

41 )

41

42

43+type family FindType a f :: Maybe Type where

44+ FindType t (S1 meta (Rec0 t))

45+ = 'Just t

46+ FindType t (l :*: r)

47+ = FindType t l <|> FindType t r

48+ FindType t (l :+: r)

49+ = FindType t l <&> FindType t r

50+ FindType t (S1 _ _)

51+ = 'Nothing

52+ FindType t (C1 m f)

53+ = FindType t f

54+ FindType t (D1 m f)

55+ = FindType t f

56+ FindType t (Rec0 _)

57+ = 'Nothing

58+ FindType t U1

59+ = 'Nothing

60+ FindType t V1

61+ = 'Nothing

62+ FindType t f

63+ = TypeError

64+ ( 'ShowType f

65+ ':<>: 'Text " is not a valid GHC.Generics representation type"

66+ )

67+

42-- | Type-level alternative monomorphised to @Maybe@.

68-- | Type-level alternative monomorphised to @Maybe@.

43type family (a :: Maybe k) <|> (b :: Maybe k) :: Maybe k where

69type family (a :: Maybe k) <|> (b :: Maybe k) :: Maybe k where

44 'Just a <|> _ = 'Just a

70 'Just a <|> _ = 'Just a

src/Data/Generics/Product/Fields.hs+10−1

@@ -6,6 +6,7 @@

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE ScopedTypeVariables #-}

8{-# LANGUAGE TypeApplications #-}

9+{-# LANGUAGE TypeFamilies #-}

9{-# LANGUAGE TypeOperators #-}

10{-# LANGUAGE TypeOperators #-}

10{-# LANGUAGE UndecidableInstances #-}

11{-# LANGUAGE UndecidableInstances #-}

11

12

@@ -25,6 +26,14 @@ import GHC.TypeLits

25class HasField (field :: Symbol) a s | s field -> a where

26class HasField (field :: Symbol) a s | s field -> a where

26 field :: Lens' s a

27 field :: Lens' s a

27

28

29+instance (Generic s,

30+ FindField field (Rep s) ~ 'Just a,

31+ GHasField field (Rep s) a)

32+

33+ => HasField field a s where

34+

35+ field = repIso . gfield @field

36+

28class GHasField (field :: Symbol) (f :: Type -> Type) a | field f -> a where

37class GHasField (field :: Symbol) (f :: Type -> Type) a | field f -> a where

29 gfield :: Lens' (f x) a

38 gfield :: Lens' (f x) a

30

39

@@ -50,7 +59,7 @@ instance GHasField field f a => GHasField field (M1 D meta f) a where

50instance GHasField field f a => GHasField field (M1 C meta f) a where

59instance GHasField field f a => GHasField field (M1 C meta f) a where

51 gfield = mIso . gfield @field

60 gfield = mIso . gfield @field

52

61

53−class GProductHasField (field :: Symbol) l r a (contains :: Maybe Type) | field l r -> a where

62+class GProductHasField (field :: Symbol) l r a (found :: Maybe Type) | field l r -> a where

54 gproductField :: Lens' ((l :*: r) x) a

63 gproductField :: Lens' ((l :*: r) x) a

55

64

56instance GHasField field l a => GProductHasField field l r a ('Just a) where

65instance GHasField field l a => GProductHasField field l r a ('Just a) where

src/Data/Generics/Product/Typed.hs+28−1

@@ -1,9 +1,14 @@

1+{-# LANGUAGE AllowAmbiguousTypes #-}

2+{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE FlexibleContexts #-}

1{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

2{-# LANGUAGE KindSignatures #-}

5{-# LANGUAGE KindSignatures #-}

3{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE TypeApplications #-}

8{-# LANGUAGE TypeApplications #-}

9+{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeOperators #-}

10{-# LANGUAGE TypeOperators #-}

11+{-# LANGUAGE UndecidableInstances #-}

7

12

8module Data.Generics.Product.Typed

13module Data.Generics.Product.Typed

9 ( HasType (..)

14 ( HasType (..)

@@ -15,14 +20,27 @@ import Data.Generics.Internal.Lens

15

20

16import Data.Kind (Type)

21import Data.Kind (Type)

17import GHC.Generics

22import GHC.Generics

18−import GHC.TypeLits

19

23

20class HasType a s where

24class HasType a s where

21 typed :: Lens' s a

25 typed :: Lens' s a

22

26

27+instance (Generic s,

28+ FindType a (Rep s) ~ 'Just a,

29+ CountType a (Rep s) ~ 'One,

30+ GHasType (Rep s) a)

31+

32+ => HasType a s where

33+

34+ typed = repIso . gtyped

35+

23class GHasType (f :: Type -> Type) a where

36class GHasType (f :: Type -> Type) a where

24 gtyped :: Lens' (f x) a

37 gtyped :: Lens' (f x) a

25

38

39+instance GProductHasType l r a (FindType a l)

40+ => GHasType (l :*: r) a where

41+

42+ gtyped = gproductTyped @_ @_ @_ @(FindType a l)

43+

26instance (GHasType l a, GHasType r a) => GHasType (l :+: r) a where

44instance (GHasType l a, GHasType r a) => GHasType (l :+: r) a where

27 gtyped = combine (gtyped @l) (gtyped @r)

45 gtyped = combine (gtyped @l) (gtyped @r)

28

46

@@ -37,3 +55,12 @@ instance GHasType f a => GHasType (M1 D meta f) a where

37

55

38instance GHasType f a => GHasType (M1 C meta f) a where

56instance GHasType f a => GHasType (M1 C meta f) a where

39 gtyped = mIso . gtyped

57 gtyped = mIso . gtyped

58+

59+class GProductHasType l r a (found :: Maybe Type) where

60+ gproductTyped :: Lens' ((l :*: r) x) a

61+

62+instance GHasType l a => GProductHasType l r a ('Just a) where

63+ gproductTyped = first . gtyped

64+

65+instance GHasType r a => GProductHasType l r a 'Nothing where

66+ gproductTyped = second . gtyped