git.iko.soy/generic-lens
on master help sign in
Record field lenses work on sum types, if all patterns have the field. (#5)
commit9511ddaa6c15706c20dac7ff1efd89b870fdb944 authorTobyShaw <toby.shaw.96@gmail.com> dateSun 11 Jun 2017, 14:46 (9 years ago) parentf76283d
4 files changed+14−5
compare with master
unifiedsplit
generic-lens.cabal−2 src/Data/Generics/Internal/Lens.hs+5−1 src/Data/Generics/Record/HasField.hs+3 src/Data/Generics/Record/Internal/Contains.hs+6−2
generic-lens.cabal−2
@@ -53,8 +53,6 @@ library
5353
5454 -- Other library packages from which modules are imported.
5555 build-depends: base >= 4.9 && <= 5.0
56− , lens
57− , kan-extensions
5856
5957 -- Directories containing source files.
6058 hs-source-dirs: src
src/Data/Generics/Internal/Lens.hs+5−1
@@ -16,7 +16,7 @@
1616module Data.Generics.Internal.Lens where
1717
1818import Control.Applicative ( Const (..) )
19−import GHC.Generics ( (:*:) (..), Generic (..), M1 (..), Rep )
19+import GHC.Generics ( (:*:) (..), Generic (..), M1 (..), Rep, (:+:) (..) )
2020
2121-- | Identity functor
2222newtype Identity a
@@ -51,6 +51,10 @@ second :: Lens' ((a :*: b) x) (b x)
5151second f (a :*: b)
5252 = fmap (a :*:) (f b)
5353
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+
5458-- | A type and its generic representation are isomorphic
5559repIso :: Generic a => Lens' a (Rep a x)
5660repIso 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
118118instance (GHasFieldProd field s s' a (Contains field s)) => GHasField field (s :*: s') a where
119119 glabel = prodLabel @field @_ @_ @_ @(Contains field s)
120120
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+
121124instance GHasField field (S1 ('MetaSel ('Just field) p f b) (Rec0 a)) a where
122125 glabel = lensM . glabel @field
123126
src/Data/Generics/Record/Internal/Contains.hs+6−2
@@ -1,11 +1,9 @@
11{-# LANGUAGE AllowAmbiguousTypes #-}
22{-# LANGUAGE DataKinds #-}
33{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE FunctionalDependencies #-}
54{-# LANGUAGE PolyKinds #-}
65{-# LANGUAGE Rank2Types #-}
76{-# LANGUAGE ScopedTypeVariables #-}
8−{-# LANGUAGE TypeApplications #-}
97{-# LANGUAGE TypeFamilies #-}
108{-# LANGUAGE TypeOperators #-}
119{-# LANGUAGE UndecidableInstances #-}
@@ -38,6 +36,8 @@ type family Contains (field :: Symbol) f :: Maybe Type where
3836 = 'Just t
3937 Contains field (f :*: g)
4038 = Contains field f <|> Contains field g
39+ Contains field (f :+: g)
40+ = Contains field f <&> Contains field g
4141 Contains field (S1 _ _)
4242 = 'Nothing
4343 Contains field (C1 m f)
@@ -57,3 +57,7 @@ type family (a :: Maybe k) <|> (b :: Maybe k) :: Maybe k where
5757 'Just x <|> _ = 'Just x
5858 _ <|> b = b
5959
60+type family (a :: Maybe k) <&> (b :: Maybe k) :: Maybe k where
61+ 'Just x <&> 'Just x = 'Just x
62+ _ <&> _ = 'Nothing
63+