Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

renaming ^%%= to fmodL and fmodML.

Removing ^%%= for partial lens.  Instead promote the partiallens to a multilens and use fmodML.
  • Loading branch information...
commit 3af3d68dfe04ca52d3c63274436fa025ca1455d9 1 parent d91d5dc
roconnor authored
12  src/Data/Lens/Common.hs
@@ -7,6 +7,7 @@ module Data.Lens.Common
7 7
   , getL
8 8
   , setL
9 9
   , modL
  10
+  , fmodL
10 11
   , mergeL
11 12
   , unzipL
12 13
   -- * Operator API
@@ -14,7 +15,6 @@ module Data.Lens.Common
14 15
   , (^.),  (^!)    -- getter -- :: a -> Lens a b -> b
15 16
   , (^=),  (^!=)   -- setter -- :: Lens a b -> b -> (a -> a)
16 17
   , (^%=), (^!%=)  -- modify -- :: Lens a b -> (b -> b) -> (a -> a)
17  
-  , (^%%=)         -- modify -- :: Functor f => Lens a b -> (b -> f b) -> a -> f a
18 18
   -- * Pseudo-imperatives
19 19
   , (^+=), (^!+=) -- addition
20 20
   , (^-=), (^!-=) -- subtraction
@@ -98,6 +98,10 @@ Lens f ^!= b = \a -> case f a of
98 98
 modL :: Lens a b -> (b -> b) -> a -> a
99 99
 modL (Lens f) g = peeks g . f
100 100
 
  101
+fmodL :: Functor f => Lens a b -> (b -> f b) -> a -> f a
  102
+fmodL (Lens f) g = \a -> case f a of
  103
+  StoreT (Identity h) b -> h <$> g b
  104
+  
101 105
 mergeL :: Lens a c -> Lens b c -> Lens (Either a b) c
102 106
 Lens f `mergeL` Lens g = 
103 107
   Lens $ either (\a -> Left <$> f a) (\b -> Right <$> g b)
@@ -112,12 +116,6 @@ infixr 4 ^%=, ^!%=
112 116
 Lens f ^!%= g = \a -> case f a of
113 117
   StoreT (Identity h) b -> h $! g b
114 118
 
115  
-infixr 4 ^%%=
116  
--- | functorial modify
117  
-(^%%=) :: Functor f => Lens a b -> (b -> f b) -> a -> f a
118  
-Lens f ^%%= g = \a -> case f a of
119  
-  StoreT (Identity h) b -> h <$> g b
120  
-
121 119
 infixr 4 ^+=, ^!+=, ^-=, ^!-=, ^*=, ^!*=
122 120
 (^+=), (^!+=), (^-=), (^!-=), (^*=), (^!*=) :: Num b => Lens a b -> b -> a -> a
123 121
 l ^+= n = l ^%= (+ n)
13  src/Data/Lens/Multi/Common.hs
@@ -18,7 +18,7 @@ newtype MultiLens a b = MLens {runMLens :: a -> StaredStore b a}
18 18
 
19 19
 instance Category MultiLens where
20 20
   id = totalML id
21  
-  MLens f . g = MLens $ g ^%%= f
  21
+  MLens f . g = MLens $ g `fmodML` f
22 22
    
23 23
 -- totalLens is a homomorphism of categories; ie a functor.
24 24
 totalML :: Lens a b -> MultiLens a b
@@ -34,19 +34,18 @@ getML (MLens f) = poss . f
34 34
 modML :: MultiLens a b -> (b -> b) -> a -> a
35 35
 modML (MLens f) g = peekss g . f
36 36
 
37  
-infixr 4 ^%%=
38 37
 -- | applicative modify
39  
--- (id ^%%= h) = h
40  
--- (f . g) ^%%= h) = (g ^%%= (f ^%%= h))
41  
-(^%%=) :: Applicative f => MultiLens a b -> (b -> f b) -> a -> f a
42  
-MLens f ^%%= g = eekss g . f 
  38
+-- (id `fmodML` h) = h
  39
+-- ((f . g) `fmodML`  h) = g `amodL` (f `amodL` h))
  40
+fmodML :: Applicative f => MultiLens a b -> (b -> f b) -> a -> f a
  41
+MLens f `fmodML` g = eekss g . f 
43 42
 
44 43
 frontPL :: MultiLens a b -> PartialLens a b
45 44
 frontPL (MLens f) = pLens $
46 45
   coproduct left (right . uncurry store . (extract *** id) . runStoreT) . runStaredStore . f
47 46
 
48 47
 reverseML :: MultiLens a b -> MultiLens a b
49  
-reverseML l = MLens (forwards . (l ^%%= (Backwards . runMLens id)))
  48
+reverseML l = MLens (forwards . (l `fmodML` (Backwards . runMLens id)))
50 49
 
51 50
 backPL :: MultiLens a b -> PartialLens a b
52 51
 backPL = frontPL . reverseML
7  src/Data/Lens/Partial/Common.hs
@@ -110,13 +110,6 @@ infixr 4 ^%=
110 110
 (^%=) :: PartialLens a b -> (b -> b) -> a -> a
111 111
 (^%=) = modPL
112 112
 
113  
-infixr 4 ^%%=
114  
--- | applicative modify
115  
-(^%%=) :: Applicative f => PartialLens a b -> (b -> f b) -> a -> f a
116  
-PLens f ^%%= g = \a -> case f a of
117  
-  Nothing                      -> pure a
118  
-  Just (StoreT (Identity h) b) -> h <$> g b
119  
-
120 113
 -- * Pseudo-imperatives
121 114
 
122 115
 infixr 4 ^+=, ^-=, ^*=

0 notes on commit 3af3d68

Please sign in to comment.
Something went wrong with that request. Please try again.