9511dda · generic-lens

generic-lens.cabal−2

compare with master

unifiedsplit

@@ -53,8 +53,6 @@ library

53

54 -- Other library packages from which modules are imported.

55 build-depends: base >= 4.9 && <= 5.0

56− , lens

57− , kan-extensions

58

56

59 -- Directories containing source files.

57 -- Directories containing source files.

60 hs-source-dirs: src

58 hs-source-dirs: src

src/Data/Generics/Internal/Lens.hs+5−1

@@ -16,7 +16,7 @@

16module Data.Generics.Internal.Lens where

17

18import Control.Applicative ( Const (..) )

19−import GHC.Generics ( (:*:) (..), Generic (..), M1 (..), Rep )

19+import GHC.Generics ( (:*:) (..), Generic (..), M1 (..), Rep, (:+:) (..) )

20

21-- | Identity functor

22newtype Identity a

@@ -51,6 +51,10 @@ second :: Lens' ((a :*: b) x) (b x)

51second f (a :*: b)

52 = fmap (a :*:) (f b)

53

54+combine :: Lens' (s x) a -> Lens' (t x) a -> Lens' ((:+:) s t x) a

55+combine sa _ f (L1 s) = fmap (\a -> L1 (set sa a s)) (f (s ^. sa))

56+combine _ ta f (R1 t) = fmap (\a -> R1 (set ta a t)) (f (t ^. ta))

57+

54-- | A type and its generic representation are isomorphic

58-- | A type and its generic representation are isomorphic

55repIso :: Generic a => Lens' a (Rep a x)

59repIso :: Generic a => Lens' a (Rep a x)

56repIso a = fmap to . a . from

60repIso a = fmap to . a . from

src/Data/Generics/Record/HasField.hs+3

@@ -118,6 +118,9 @@ class GHasField (field :: Symbol) (s :: Type -> Type) a | field s -> a where

118instance (GHasFieldProd field s s' a (Contains field s)) => GHasField field (s :*: s') a where

119 glabel = prodLabel @field @_ @_ @_ @(Contains field s)

120

121+instance (GHasField field s a, GHasField field s' a) => GHasField field (s :+: s') a where

122+ glabel = combine (glabel @field @s) (glabel @field @s')

123+

121instance GHasField field (S1 ('MetaSel ('Just field) p f b) (Rec0 a)) a where

124instance GHasField field (S1 ('MetaSel ('Just field) p f b) (Rec0 a)) a where

122 glabel = lensM . glabel @field

125 glabel = lensM . glabel @field

123

126

src/Data/Generics/Record/Internal/Contains.hs+6−2

@@ -1,11 +1,9 @@

1{-# LANGUAGE AllowAmbiguousTypes #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE FlexibleInstances #-}

4−{-# LANGUAGE FunctionalDependencies #-}

5{-# LANGUAGE PolyKinds #-}

4{-# LANGUAGE PolyKinds #-}

6{-# LANGUAGE Rank2Types #-}

5{-# LANGUAGE Rank2Types #-}

7{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE ScopedTypeVariables #-}

8−{-# LANGUAGE TypeApplications #-}

9{-# LANGUAGE TypeFamilies #-}

7{-# LANGUAGE TypeFamilies #-}

10{-# LANGUAGE TypeOperators #-}

8{-# LANGUAGE TypeOperators #-}

11{-# LANGUAGE UndecidableInstances #-}

9{-# LANGUAGE UndecidableInstances #-}

@@ -38,6 +36,8 @@ type family Contains (field :: Symbol) f :: Maybe Type where

38 = 'Just t

36 = 'Just t

39 Contains field (f :*: g)

37 Contains field (f :*: g)

40 = Contains field f <|> Contains field g

38 = Contains field f <|> Contains field g

39+ Contains field (f :+: g)

40+ = Contains field f <&> Contains field g

41 Contains field (S1 _ _)

42 = 'Nothing

43 Contains field (C1 m f)

@@ -57,3 +57,7 @@ type family (a :: Maybe k) <|> (b :: Maybe k) :: Maybe k where

57 'Just x <|> _ = 'Just x

58 _ <|> b = b

59

60+type family (a :: Maybe k) <&> (b :: Maybe k) :: Maybe k where

61+ 'Just x <&> 'Just x = 'Just x

62+ _ <&> _ = 'Nothing

63+