Browse files

Putting most lens operations under the non-exported Mutator class.

  • Loading branch information...
1 parent 4195f6e commit db2ace4ff4bb6ff0a9d3b32bc489df266f7b1f3a @roconnor committed Jun 10, 2012
Showing with 56 additions and 85 deletions.
  1. +2 −0 data-lens.cabal
  2. +15 −46 src/Data/Lens/Common.hs
  3. +3 −2 src/Data/Lens/Multi/Common.hs
  4. +32 −0 src/Data/Lens/Mutator.hs
  5. +4 −37 src/Data/Lens/Partial/Common.hs
View
2 data-lens.cabal
@@ -51,6 +51,8 @@ library
-- Data.Lens.Multi.Strict
Control.Comonad.StaredStore
Control.Category.Product
+ other-Modules:
+ Data.Lens.Mutator
ghc-options: -Wall
View
61 src/Data/Lens/Common.hs
@@ -5,21 +5,16 @@ module Data.Lens.Common
, isoL -- build a lens from an isomorphism
-- * Functional API
, getL
- , setL
- , modL
, fmodL
, mergeL
, unzipL
-- * Operator API
- , (^$), (^$!) -- getter -- :: Lens a b -> a -> b
- , (^.), (^!) -- getter -- :: a -> Lens a b -> b
- , (^=), (^!=) -- setter -- :: Lens a b -> b -> (a -> a)
- , (^%=), (^!%=) -- modify -- :: Lens a b -> (b -> b) -> (a -> a)
- -- * Pseudo-imperatives
- , (^+=), (^!+=) -- addition
- , (^-=), (^!-=) -- subtraction
- , (^*=), (^!*=) -- multiplication
- , (^/=), (^!/=) -- division
+ , (^$), (^$!) -- getter -- :: Lens a b -> a -> b
+ , (^.), (^!) -- getter -- :: a -> Lens a b -> b
+ -- * Mutators
+ , set, setStrict, modify, modifyStrict
+ , (^=), (^!=), (^%=), (^!%=), (^+=), (^!+=), (^-=), (^!-=), (^*=), (^!*=)
+ , (^/=), (^!/=), (^&&=), (^||=), (^!&&=), (^!||=)
-- * Stock lenses
, fstLens
, sndLens
@@ -37,6 +32,7 @@ import Data.Functor.Identity
import Data.Functor.Apply
import Data.Semigroupoid
import Data.Isomorphism
+import Data.Lens.Mutator
import Prelude hiding ((.), id)
import Data.IntMap (IntMap)
import qualified Data.Map as Map
@@ -64,7 +60,7 @@ instance Category Lens where
-- | build a lens out of a getter and setter
lens :: (a -> b) -> (b -> a -> a) -> Lens a b
-lens get set = Lens $ \a -> store (`set` a) (get a)
+lens getter setter = Lens $ \a -> store (`setter` a) (getter a)
-- | build a lens out of an isomorphism
isoL :: Iso (->) a b -> Lens a b
@@ -85,19 +81,13 @@ infixl 9 ^., ^!
a ^. Lens f = pos (f a)
a ^! Lens f = pos (f $! a)
--- | Gets the setter function from a lens.
-setL :: Lens a b -> b -> a -> a
-setL (Lens f) b = peek b . f
-
-infixr 4 ^=, ^!=
-(^=), (^!=) :: Lens a b -> b -> a -> a
-(^=) = setL
-Lens f ^!= b = \a -> case f a of
- StoreT (Identity g) _ -> g $! b
-
--- | Gets the modifier function from a lens.
-modL :: Lens a b -> (b -> b) -> a -> a
-modL (Lens f) g = peeks g . f
+instance Mutator Lens where
+ set (Lens f) b = peek b . f
+ setStrict (Lens f) b = \a -> case f a of
+ StoreT (Identity g) _ -> g $! b
+ modify (Lens f) g = peeks g . f
+ modifyStrict (Lens f) g = \a -> case f a of
+ StoreT (Identity h) b -> h $! g b
fmodL :: Functor f => Lens a b -> (b -> f b) -> a -> f a
fmodL (Lens f) g = \a -> case f a of
@@ -110,27 +100,6 @@ Lens f `mergeL` Lens g =
unzipL :: Lens a (b, c) -> (Lens a b, Lens a c)
unzipL f = (fstLens . f, sndLens . f)
-infixr 4 ^%=, ^!%=
--- | functional modify
-(^%=), (^!%=) :: Lens a b -> (b -> b) -> a -> a
-(^%=) = modL
-Lens f ^!%= g = \a -> case f a of
- StoreT (Identity h) b -> h $! g b
-
-infixr 4 ^+=, ^!+=, ^-=, ^!-=, ^*=, ^!*=
-(^+=), (^!+=), (^-=), (^!-=), (^*=), (^!*=) :: Num b => Lens a b -> b -> a -> a
-l ^+= n = l ^%= (+ n)
-l ^-= n = l ^%= subtract n
-l ^*= n = l ^%= (* n)
-l ^!+= n = l ^!%= (+ n)
-l ^!-= n = l ^!%= subtract n
-l ^!*= n = l ^!%= (* n)
-
-infixr 4 ^/=, ^!/=
-(^/=), (^!/=) :: Fractional b => Lens a b -> b -> a -> a
-l ^/= r = l ^%= (/ r)
-l ^!/= r = l ^!%= (/ r)
-
-- * Stock lenses
fstLens :: Lens (a,b) a
View
5 src/Data/Lens/Multi/Common.hs
@@ -6,6 +6,7 @@ import Control.Applicative.Backwards
import Control.Category
import Data.Lens.Common (Lens(..), fstLens, sndLens)
import Data.Lens.Partial.Common (PartialLens, pLens, runPLens)
+import Data.Lens.Mutator
import Control.Comonad
import Control.Comonad.Trans.Store
import Control.Comonad.StaredStore
@@ -31,8 +32,8 @@ partialML l = MLens $ coproduct (pure . runIdentity) fromStore . runPLens l
getML :: MultiLens a b -> a -> [b]
getML (MLens f) = poss . f
-modML :: MultiLens a b -> (b -> b) -> a -> a
-modML (MLens f) g = peekss g . f
+instance Mutator MultiLens where
+ modify (MLens f) g = peekss g . f
-- | applicative modify
-- (id `fmodML` h) = h
View
32 src/Data/Lens/Mutator.hs
@@ -0,0 +1,32 @@
+module Data.Lens.Mutator where
+
+class Mutator l where
+ modify, modifyStrict, (^%=), (^!%=) :: l a b -> (b -> b) -> a -> a
+ (^%=) = modify
+ (^!%=) = modifyStrict
+ set, setStrict, (^=), (^!=) :: l a b -> b -> (a -> a)
+ set l v = modify l (const v)
+ setStrict l v = modifyStrict l (const v)
+ (^=) = set
+ (^!=) = setStrict
+
+infixr 4 ^+=, ^!+=, ^-=, ^!-=, ^*=, ^!*=
+(^+=), (^!+=), (^-=), (^!-=), (^*=), (^!*=) :: (Mutator l, Num b) => l a b -> b -> a -> a
+l ^+= n = l ^%= (+ n)
+l ^-= n = l ^%= subtract n
+l ^*= n = l ^%= (* n)
+l ^!+= n = l ^!%= (+ n)
+l ^!-= n = l ^!%= subtract n
+l ^!*= n = l ^!%= (* n)
+
+infixr 4 ^/=, ^!/=
+(^/=), (^!/=) :: (Mutator l, Fractional b) => l a b -> b -> a -> a
+l ^/= r = l ^%= (/ r)
+l ^!/= r = l ^!%= (/ r)
+
+infixr 4 ^&&=, ^!&&=, ^||=, ^!||=
+(^&&=), (^||=), (^!&&=), (^!||=) :: Mutator l => l a Bool -> Bool -> a -> a
+l ^&&= b = l ^%= (&& b)
+l ^||= b = l ^%= (|| b)
+l ^!&&= b = l ^!%= (&& b)
+l ^!||= b = l ^!%= (|| b)
View
41 src/Data/Lens/Partial/Common.hs
@@ -5,6 +5,7 @@ import Control.Applicative
import Control.Category
import Control.Category.Product
import Data.Lens.Common (Lens(..), fstLens, sndLens)
+import Data.Lens.Mutator
import Control.Comonad.Trans.Store
import Data.Foldable (any, all)
import Data.Functor.Identity
@@ -84,43 +85,9 @@ allPL l p =
trySetPL :: PartialLens a b -> a -> Maybe (b -> a)
trySetPL (PLens f) a = flip peek <$> f a
--- If the PartialLens is null, then setPL returns the identity function.
-setPL :: PartialLens a b -> b -> a -> a
-setPL (PLens f) b a = maybe a (peek b) (f a)
-
--- If the PartialLens is null, then setPL returns the identity function.
-modPL :: PartialLens a b -> (b -> b) -> a -> a
-modPL (PLens f) g a = maybe a (peeks g) (f a)
-
--- * Operator API
-
-infixr 0 ^$
-(^$) :: PartialLens a b -> a -> Maybe b
-(^$) = getPL
-
-infixl 9 ^.
-(^.) :: a -> PartialLens a b -> Maybe b
-(^.) = flip getPL
-
-infixr 4 ^=
-(^=) :: PartialLens a b -> b -> a -> a
-(^=) = setPL
-
-infixr 4 ^%=
-(^%=) :: PartialLens a b -> (b -> b) -> a -> a
-(^%=) = modPL
-
--- * Pseudo-imperatives
-
-infixr 4 ^+=, ^-=, ^*=
-(^+=), (^-=), (^*=) :: Num b => PartialLens a b -> b -> a -> a
-l ^+= n = l ^%= (+ n)
-l ^-= n = l ^%= subtract n
-l ^*= n = l ^%= (* n)
-
-infixr 4 ^/=
-(^/=) :: Fractional b => PartialLens a b -> b -> a -> a
-l ^/= r = l ^%= (/ r)
+instance Mutator PartialLens where
+ set (PLens f) b a = maybe a (peek b) (f a)
+ modify (PLens f) g a = maybe a (peeks g) (f a)
-- * Stock partial lenses

0 comments on commit db2ace4

Please sign in to comment.