git.iko.soy/generic-lens
on master help sign in
Make some more doctests work
2c14f01Matthew Pickering
src/Data/Generics/Internal/Profunctor/Lens.hs−13
compare with master
unifiedsplit
@@ -21,8 +21,6 @@
21-----------------------------------------------------------------------------
21-----------------------------------------------------------------------------
22module Data.Generics.Internal.Profunctor.Lens where
22module Data.Generics.Internal.Profunctor.Lens where
23
23
24−import Control.Applicative (Const(..))
25−import Data.Monoid (First (..))
26import Data.Profunctor (Profunctor(..), Strong(..))
24import Data.Profunctor (Profunctor(..), Strong(..))
27import Data.Bifunctor
25import Data.Bifunctor
28import Data.Profunctor.Unsafe ((#.))
26import Data.Profunctor.Unsafe ((#.))
@@ -36,10 +34,6 @@ type Lens s t a b
36type LensLike p s t a b
34type LensLike p s t a b
37 = p a b -> p s t
35 = p a b -> p s t
38
36
39−-- | Getting
40−(^.) :: s -> ((a -> Const a a) -> s -> Const a s) -> a
41−s ^. l = getConst (l Const s)
42−infixl 8 ^.
43
37
44ravel :: (ALens a b a b -> ALens a b s t) -> Lens s t a b
38ravel :: (ALens a b a b -> ALens a b s t) -> Lens s t a b
45ravel l pab = conv (l idLens) pab
39ravel l pab = conv (l idLens) pab
@@ -69,14 +63,7 @@ idLens :: ALens a b a b
69idLens = ALens (fork (const ()) id) snd
63idLens = ALens (fork (const ()) id) snd
70{-# INLINE idLens #-}
64{-# INLINE idLens #-}
71
65
72−infixr 4 .~
73−(.~) :: ((a -> b) -> s -> t) -> b -> s -> t
74−(.~) f b s = set f (s, b)
75
66
76−infixl 8 ^?
77−(^?) :: s -> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
78−s ^? l = getFirst (fmof l (First #. Just) s)
79− where fmof l' f = getConst #. l' (Const #. f)
80
67
81build :: (Tagged b b -> Tagged t t) -> b -> t
68build :: (Tagged b b -> Tagged t t) -> b -> t
82build p = unTagged . p . Tagged
69build p = unTagged . p . Tagged
src/Data/Generics/Internal/VL/Lens.hs+12−3
@@ -23,8 +23,7 @@ module Data.Generics.Internal.VL.Lens where
23
23
24import Control.Applicative (Const(..))
24import Control.Applicative (Const(..))
25import Data.Functor.Identity (Identity(..))
25import Data.Functor.Identity (Identity(..))
26−import Data.Generics.Internal.Profunctor.Lens (ALens (..), (^.), idLens)
26+import Data.Generics.Internal.Profunctor.Lens (ALens (..), idLens)
27−import GHC.Exts (inline, oneShot)
28
27
29-- | Type alias for lens
28-- | Type alias for lens
30type Lens' s a
29type Lens' s a
@@ -36,8 +35,17 @@ type Lens s t a b
36view :: ((a -> Const a a) -> s -> Const a s) -> s -> a
35view :: ((a -> Const a a) -> s -> Const a s) -> s -> a
37view l s = (^.) s l
36view l s = (^.) s l
38
37
38+-- | Getting
39+(^.) :: s -> ((a -> Const a a) -> s -> Const a s) -> a
40+s ^. l = getConst (l Const s)
41+infixl 8 ^.
42+
43+infixr 4 .~
44+(.~) :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
45+(.~) f b = runIdentity . f (Identity . const b)
46+
39set :: Lens s t a b -> b -> s -> t
47set :: Lens s t a b -> b -> s -> t
40−set l x = runIdentity . l (Identity . const x)
48+set l x = l .~ x
41
49
42lens2lensvl :: ALens a b s t -> Lens s t a b
50lens2lensvl :: ALens a b s t -> Lens s t a b
43lens2lensvl (ALens _get _set) =
51lens2lensvl (ALens _get _set) =
@@ -50,6 +58,7 @@ ravel :: (ALens a b a b -> ALens a b s t)
50 -> Lens s t a b
58 -> Lens s t a b
51ravel l pab = (lens2lensvl $ l idLens) pab
59ravel l pab = (lens2lensvl $ l idLens) pab
52
60
61+
53lens :: (s -> a) -> ((s, b) -> t) -> Lens s t a b
62lens :: (s -> a) -> ((s, b) -> t) -> Lens s t a b
54lens get _set = \f x -> curry _set x <$> f (get x)
63lens get _set = \f x -> curry _set x <$> f (get x)
55{-# INLINE[0] lens #-}
64{-# INLINE[0] lens #-}
src/Data/Generics/Internal/VL/Prism.hs+8
@@ -26,6 +26,8 @@ import Data.Coerce
26import Data.Generics.Internal.Profunctor.Prism (Market (..), plus, idPrism, prismPRavel)
26import Data.Generics.Internal.Profunctor.Prism (Market (..), plus, idPrism, prismPRavel)
27import Data.Tagged
27import Data.Tagged
28import Data.Profunctor.Unsafe ((#.), (.#))
28import Data.Profunctor.Unsafe ((#.), (.#))
29+import Data.Monoid (First (..))
30+import Control.Applicative (Const(..))
29
31
30-- | Type alias for prism
32-- | Type alias for prism
31type Prism s t a b
33type Prism s t a b
@@ -34,6 +36,12 @@ type Prism s t a b
34type Prism' s a
36type Prism' s a
35 = Prism s s a a
37 = Prism s s a a
36
38
39+infixl 8 ^?
40+(^?) :: s -> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
41+s ^? l = getFirst (fmof l (First #. Just) s)
42+ where fmof l' f = getConst #. l' (Const #. f)
43+
44+
37match :: Prism s t a b -> s -> Either t a
45match :: Prism s t a b -> s -> Either t a
38match k = withPrism k $ \_ _match -> _match
46match k = withPrism k $ \_ _match -> _match
39
47
src/Data/Generics/Product/Any.hs+1−1
@@ -41,7 +41,7 @@ import Data.Generics.Product.Typed
41-- >>> :set -XDataKinds
41-- >>> :set -XDataKinds
42-- >>> :set -XDeriveGeneric
42-- >>> :set -XDeriveGeneric
43-- >>> import GHC.Generics
43-- >>> import GHC.Generics
44−-- >>> :m +Data.Generics.Internal.Lens
44+-- >>> :m +Data.Generics.Internal.VL.Lens
45-- >>> :{
45-- >>> :{
46-- data Human = Human
46-- data Human = Human
47-- { name :: String
47-- { name :: String
src/Data/Generics/Product/Fields.hs+1−1
@@ -56,7 +56,7 @@ import Data.Generics.Internal.Profunctor.Lens as P
56-- >>> :set -XGADTs
56-- >>> :set -XGADTs
57-- >>> :set -XFlexibleContexts
57-- >>> :set -XFlexibleContexts
58-- >>> import GHC.Generics
58-- >>> import GHC.Generics
59−-- >>> :m +Data.Generics.Internal.Lens
59+-- >>> :m +Data.Generics.Internal.VL.Lens
60-- >>> :m +Data.Function
60-- >>> :m +Data.Function
61-- >>> :{
61-- >>> :{
62-- data Human a
62-- data Human a
src/Data/Generics/Product/Positions.hs+1−1
@@ -58,7 +58,7 @@ import Data.Generics.Internal.Profunctor.Lens
58-- >>> :set -XGADTs
58-- >>> :set -XGADTs
59-- >>> :set -XFlexibleContexts
59-- >>> :set -XFlexibleContexts
60-- >>> import GHC.Generics
60-- >>> import GHC.Generics
61−-- >>> :m +Data.Generics.Internal.Lens
61+-- >>> :m +Data.Generics.Internal.VL.Lens
62-- >>> :m +Data.Function
62-- >>> :m +Data.Function
63-- >>> :{
63-- >>> :{
64-- data Human = Human
64-- data Human = Human
src/Data/Generics/Product/Subtype.hs+1−1
@@ -50,7 +50,7 @@ import Data.Generics.Internal.Profunctor.Lens
50-- >>> :set -XDeriveGeneric
50-- >>> :set -XDeriveGeneric
51-- >>> :set -XDuplicateRecordFields
51-- >>> :set -XDuplicateRecordFields
52-- >>> import GHC.Generics
52-- >>> import GHC.Generics
53−-- >>> :m +Data.Generics.Internal.Lens
53+-- >>> :m +Data.Generics.Internal.VL.Lens
54-- >>> :{
54-- >>> :{
55-- data Human = Human
55-- data Human = Human
56-- { name :: String
56-- { name :: String
src/Data/Generics/Product/Typed.hs+1−1
@@ -47,7 +47,7 @@ import Data.Generics.Internal.Profunctor.Lens
47-- >>> :set -XDataKinds
47-- >>> :set -XDataKinds
48-- >>> :set -XDeriveGeneric
48-- >>> :set -XDeriveGeneric
49-- >>> import GHC.Generics
49-- >>> import GHC.Generics
50−-- >>> :m +Data.Generics.Internal.Lens
50+-- >>> :m +Data.Generics.Internal.VL.Lens
51-- >>> :{
51-- >>> :{
52-- data Human
52-- data Human
53-- = Human
53-- = Human
src/Data/Generics/Sum/Any.hs+1−1
@@ -39,7 +39,7 @@ import Data.Generics.Internal.VL.Prism
39-- >>> :set -XDataKinds
39-- >>> :set -XDataKinds
40-- >>> :set -XDeriveGeneric
40-- >>> :set -XDeriveGeneric
41-- >>> import GHC.Generics
41-- >>> import GHC.Generics
42−-- >>> :m +Data.Generics.Internal.Lens
42+-- >>> :m +Data.Generics.Internal.VL.Prism
43-- >>> :{
43-- >>> :{
44-- data Animal
44-- data Animal
45-- = Dog Dog
45-- = Dog Dog
src/Data/Generics/Sum/Constructors.hs+1−1
@@ -52,7 +52,7 @@ import Data.Generics.Internal.Profunctor.Prism (prismPRavel)
52-- >>> :set -XFlexibleContexts
52-- >>> :set -XFlexibleContexts
53-- >>> :set -XTypeFamilies
53-- >>> :set -XTypeFamilies
54-- >>> import GHC.Generics
54-- >>> import GHC.Generics
55−-- >>> :m +Data.Generics.Internal.Lens
55+-- >>> :m +Data.Generics.Internal.VL.Prism
56-- >>> :m +Data.Generics.Product.Fields
56-- >>> :m +Data.Generics.Product.Fields
57-- >>> :m +Data.Function
57-- >>> :m +Data.Function
58-- >>> :{
58-- >>> :{
src/Data/Generics/Sum/Typed.hs+1−1
@@ -47,7 +47,7 @@ import Data.Generics.Internal.Profunctor.Prism (prismPRavel)
47-- >>> :set -XDataKinds
47-- >>> :set -XDataKinds
48-- >>> :set -XDeriveGeneric
48-- >>> :set -XDeriveGeneric
49-- >>> import GHC.Generics
49-- >>> import GHC.Generics
50−-- >>> :m +Data.Generics.Internal.Lens
50+-- >>> :m +Data.Generics.Internal.VL.Prism
51-- >>> :{
51-- >>> :{
52-- data Animal
52-- data Animal
53-- = Dog Dog
53-- = Dog Dog