data-lens 2.0.4.1 → 2.11.2
raw patch · 14 files changed
Files
- CHANGELOG +65/−0
- Data/Lens/Common.hs +0/−153
- Data/Lens/Lazy.hs +0/−90
- Data/Lens/Strict.hs +0/−90
- LICENSE +1/−1
- Setup.hs +0/−2
- Setup.lhs +4/−0
- data-lens.cabal +27/−21
- src/Control/Category/Product.hs +18/−0
- src/Data/Lens/Common.hs +166/−0
- src/Data/Lens/Lazy.hs +91/−0
- src/Data/Lens/Partial/Common.hs +170/−0
- src/Data/Lens/Partial/Lazy.hs +66/−0
- src/Data/Lens/Strict.hs +91/−0
+ CHANGELOG view
@@ -0,0 +1,65 @@+2.11.2 (Changes from 2.11.2)+=========================+* Bump dependency on semigroupoids++2.11.1 (Changes from 2.11.0.1)+=========================+* Missing imports prevened data-lens from working on base earlier than 4.8. This is now fixed.++2.11.0.1 (Changes from 2.11)+=========================+* Bump lower bound on transformers++2.11 (Changes from 2.10.7)+=========================+* Bump dependency on semigroupoids+* Bump dependency on transformers+* Bump dependency on comonad+ * Moving to comonad 0.5 requires moving from Data.Functor.Coproduct to Data.Functor.Sum.+ This requires a change in the signature for Data.Lens.Partial.Common.runPLens.++2.10.7 (Changes from 2.10.6)+=========================+* Bump dependency on semigroupoids++2.10.6 (Changes from 2.10.5)+=========================+* Bump dependency on semigroupoids++2.10.5 (Changes from 2.10.4)+=========================+* Bump dependency on comonad+* Bump dependency on transformers++2.10.4 (Changes from 2.10.3)+=========================+* Reset comonad depenency to 4.0+* Reset semigroupoids dependency to 4.0+* Remove comonad-transformers dependency++2.10.3 (Changes from 2.10.2)+=========================+* Bump dependency on comonad+* Bump dependency on comonad-transformers+* Bump dependency on semigroupoids++2.10.2 (Changes from 2.10.1)+=========================+* Bump dependency on comonad-transformers+* Bump dependency on containers+* Bump dependency on semigroupoids++2.10.1 (Changes from 2.10)+=========================+* Bump dependency on comonad++2.10 (Changes from 2.9.0)+=========================+* Removed unused depencencies+* Fixed bug in the definition of nullPL++2.9.0 (Changes from 2.0.3)+==========================+* Introduced partial/nullable lenses (Data.Lens.Partial).+* Altered the associativity of (^.) and (^!) from right to left.+* Introduced Tensor type-class to Control.Category -- instanced by Lens and PartialLens.
− Data/Lens/Common.hs
@@ -1,153 +0,0 @@-module Data.Lens.Common- ( Lens(..)- -- * Lens construction- , lens -- build a lens from a getter and setter- , iso -- build a lens from an isomorphism- -- * Functional API- , getL- , setL- , modL- -- * 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)- , (^%%=) -- modify -- :: Functor f => Lens a b -> (b -> f b) -> a -> f a- -- * Pseudo-imperatives- , (^+=), (^!+=) -- addition- , (^-=), (^!-=) -- subtraction- , (^*=), (^!*=) -- multiplication- , (^/=), (^!/=) -- division- -- * Stock lenses- , fstLens- , sndLens- , mapLens- , intMapLens- , setLens- , intSetLens- ) where--import Control.Applicative-import Control.Comonad.Trans.Store-import Control.Category-import Data.Functor.Identity-import Data.Functor.Apply-import Data.Semigroupoid-import Prelude hiding ((.), id)-import Data.IntMap (IntMap)-import qualified Data.Map as Map-import Data.Set (Set)-import qualified Data.IntMap as IntMap-import Data.Map (Map)-import qualified Data.Set as Set-import Data.IntSet (IntSet)-import qualified Data.IntSet as IntSet--newtype Lens a b = Lens { runLens :: a -> Store b a }--instance Semigroupoid Lens where- Lens f `o` Lens g = Lens $ \a -> case g a of- StoreT wba b -> case f b of- StoreT wcb c -> StoreT ((.) <$> wba <.> wcb) c--instance Category Lens where- id = Lens $ StoreT (pure id)- Lens f . Lens g = Lens $ \a -> case g a of- StoreT wba b -> case f b of- StoreT wcb c -> StoreT ((.) <$> wba <*> wcb) c---- * Lens construction---- | build a lens out of a getter and setter-lens :: (a -> b) -> (b -> a -> a) -> Lens a b-lens get set = Lens $ \a -> store (\b -> set b a) (get a)---- | build a lens out of an isomorphism-iso :: (a -> b) -> (b -> a) -> Lens a b-iso f g = Lens (store g . f)---- | Gets the getter function from a lens.-getL :: Lens a b -> a -> b-getL (Lens f) a = pos (f a)--infixr 0 ^$, ^$!-(^$), (^$!) :: Lens a b -> a -> b-(^$) = getL-Lens f ^$! a = pos (f $! a)--infixr 9 ^., ^!--- | functional getter, which acts like a field accessor-(^.), (^!) :: a -> Lens a b -> b-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--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 ^%%=--- | functorial modify-(^%%=) :: Functor f => Lens a b -> (b -> f b) -> a -> f a-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-fstLens = Lens $ \(a,b) -> store (\ a' -> (a', b)) a--sndLens :: Lens (a,b) b-sndLens = Lens $ \(a,b) -> store (\ b' -> (a, b')) b--mapLens :: Ord k => k -> Lens (Map k v) (Maybe v)-mapLens k = Lens $ \m -> store (\mv -> case mv of- Nothing -> Map.delete k m- Just v' -> Map.insert k v' m- ) (Map.lookup k m)--intMapLens :: Int -> Lens (IntMap v) (Maybe v)-intMapLens k = Lens $ \m -> store (\mv -> case mv of- Nothing -> IntMap.delete k m- Just v' -> IntMap.insert k v' m- ) (IntMap.lookup k m)--setLens :: Ord k => k -> Lens (Set k) Bool-setLens k = Lens $ \m -> store (\mv ->- if mv then Set.insert k m else Set.delete k m- ) (Set.member k m)--intSetLens :: Int -> Lens IntSet Bool-intSetLens k = Lens $ \m -> store (\mv ->- if mv then IntSet.insert k m else IntSet.delete k m- ) (IntSet.member k m)
− Data/Lens/Lazy.hs
@@ -1,90 +0,0 @@-module Data.Lens.Lazy- ( module Data.Lens.Common- -- * State API- , access -- getter -- :: Monad m => Lens a b -> StateT a m b- , (~=), (!=) -- setter -- :: Monad m => Lens a b -> b -> StateT a m b- , (%=), (!%=) -- modify -- :: Monad m => Lens a b -> (b -> b) -> StateT a m b- , (%%=), (!%%=) -- modify -- :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c- , (+=), (!+=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b- , (-=), (!-=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b- , (*=), (!*=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b- , (//=), (!/=) -- modify -- :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b- , (&&=), (!&&=) -- modify -- :: Monad m => Lens a Bool -> Bool -> StateT a m Bool- , (||=), (!||=) -- modify -- :: Monad m => Lens a Bool -> Bool -> StateT a m Bool- , focus -- modify -- :: Monad m => Lens a b -> StateT m b c -> StateT m a c- ) where--import Control.Comonad.Trans.Store-import Control.Monad.Trans.State-import Control.Monad (liftM)-import Data.Functor.Identity-import Data.Lens.Common---- * State actions---- | get the value of a lens into state-access :: Monad m => Lens a b -> StateT a m b-access (Lens f) = gets (pos . f)-{-# INLINE access #-}--focus :: Monad m => Lens a b -> StateT b m c -> StateT a m c-focus (Lens f) (StateT g) = StateT $ \a -> case f a of- StoreT (Identity h) b -> liftM (\(c, b') -> (c, h b')) (g b)--infixr 4 ~=, !=---- | set a value using a lens into state-(~=), (!=) :: Monad m => Lens a b -> b -> StateT a m b-Lens f ~= b = StateT $ \a -> let c = peek b (f a) in - return (b, c)-Lens f != b = StateT $ \a -> case f a of- StoreT (Identity h) _ -> let c = h $! b in- return (b, c)--infixr 4 %=, !%=- --- | infix modification a value through a lens into state-(%=), (!%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m b-Lens f %= g = StateT $ \a -> case f a of - StoreT (Identity h) b -> let b' = g b in- return (b', h b')-Lens f !%= g = StateT $ \a -> case f a of- StoreT (Identity h) b -> let b' = g b in- b' `seq` return (b', h b')--infixr 4 %%=, !%%=---- | infix modification of a value through a lens into state--- with a supplemental response-(%%=), (!%%=) :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c-Lens f %%= g = StateT $ \a -> case f a of- StoreT (Identity h) b -> case g b of- (c, b') -> return (c, h b')-Lens f !%%= g = StateT $ \a -> case f a of- StoreT (Identity h) b -> case g b of- (c, b') -> return (c, h $! b')--infixr 4 +=, !+=, -=, !-=, *=, !*=--(+=), (!+=), (-=), (!-=), (*=), (!*=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b-f += b = f %= (+ b)-f -= b = f %= subtract b-f *= b = f %= (* b)-f !+= b = f !%= (+ b)-f !-= b = f !%= subtract b-f !*= b = f !%= (* b)--infixr 4 //=, !/=--(//=), (!/=) :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b-f //= b = f %= (/ b)-f !/= b = f !%= (/ b)--infixr 4 &&=, !&&=, ||=, !||=--(&&=), (||=), (!&&=), (!||=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool-f &&= b = f %= (&& b)-f ||= b = f %= (|| b)-f !&&= b = f !%= (&& b)-f !||= b = f !%= (|| b)-
− Data/Lens/Strict.hs
@@ -1,90 +0,0 @@-module Data.Lens.Strict- ( module Data.Lens.Common- -- * State API- , access -- getter -- :: Monad m => Lens a b -> StateT a m b- , (~=), (!=) -- setter -- :: Monad m => Lens a b -> b -> StateT a m b- , (%=), (!%=) -- modify -- :: Monad m => Lens a b -> (b -> b) -> StateT a m b- , (%%=), (!%%=) -- modify -- :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c- , (+=), (!+=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b- , (-=), (!-=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b- , (*=), (!*=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b- , (//=), (!/=) -- modify -- :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b- , (&&=), (!&&=) -- modify -- :: Monad m => Lens a Bool -> Bool -> StateT a m Bool- , (||=), (!||=) -- modify -- :: Monad m => Lens a Bool -> Bool -> StateT a m Bool- , focus -- modify -- :: Monad m => Lens a b -> StateT m b c -> StateT m a c- ) where--import Control.Comonad.Trans.Store-import Control.Monad.Trans.State.Strict-import Control.Monad (liftM)-import Data.Functor.Identity-import Data.Lens.Common---- * State actions---- | get the value of a lens into state-access :: Monad m => Lens a b -> StateT a m b-access (Lens f) = gets (pos . f)-{-# INLINE access #-}--focus :: Monad m => Lens a b -> StateT b m c -> StateT a m c-focus (Lens f) (StateT g) = StateT $ \a -> case f a of- StoreT (Identity h) b -> liftM (\(c, b') -> (c, h b')) (g b)--infixr 4 ~=, !=---- | set a value using a lens into state-(~=), (!=) :: Monad m => Lens a b -> b -> StateT a m b-Lens f ~= b = StateT $ \a -> let c = peek b (f a) in - return (b, c)-Lens f != b = StateT $ \a -> case f a of- StoreT (Identity h) _ -> let c = h $! b in- return (b, c)--infixr 4 %=, !%=- --- | infix modification a value through a lens into state-(%=), (!%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m b-Lens f %= g = StateT $ \a -> case f a of - StoreT (Identity h) b -> let b' = g b in- return (b', h b')-Lens f !%= g = StateT $ \a -> case f a of- StoreT (Identity h) b -> let b' = g b in- b' `seq` return (b', h b')--infixr 4 %%=, !%%=---- | infix modification of a value through a lens into state--- with a supplemental response-(%%=), (!%%=) :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c-Lens f %%= g = StateT $ \a -> case f a of- StoreT (Identity h) b -> case g b of- (c, b') -> return (c, h b')-Lens f !%%= g = StateT $ \a -> case f a of- StoreT (Identity h) b -> case g b of- (c, b') -> return (c, h $! b')--infixr 4 +=, !+=, -=, !-=, *=, !*=--(+=), (!+=), (-=), (!-=), (*=), (!*=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b-f += b = f %= (+ b)-f -= b = f %= subtract b-f *= b = f %= (* b)-f !+= b = f !%= (+ b)-f !-= b = f !%= subtract b-f !*= b = f !%= (* b)--infixr 4 //=, !/=--(//=), (!/=) :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b-f //= b = f %= (/ b)-f !/= b = f !%= (/ b)--infixr 4 &&=, !&&=, ||=, !||=--(&&=), (||=), (!&&=), (!||=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool-f &&= b = f %= (&& b)-f ||= b = f %= (|| b)-f !&&= b = f !%= (&& b)-f !||= b = f !%= (|| b)-
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2008-2011 Edward Kmett+Copyright 2008-2012 Edward A. Kmett, Russell O'Connor & Tony Morris All rights reserved.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell+ +> import Distribution.Simple+> main = defaultMain
data-lens.cabal view
@@ -1,32 +1,30 @@-name: data-lens-category: Control, Comonads-version: 2.0.4.1-license: BSD3-cabal-version: >= 1.6-license-file: LICENSE-author: Edward A. Kmett-maintainer: Edward A. Kmett <ekmett@gmail.com>-stability: provisional-homepage: http://github.com/ekmett/data-lens/-copyright: Copyright (C) 2008-2011 Edward A. Kmett-synopsis: Haskell 98 Lenses-description: Haskell 98 Lenses-build-type: Simple+name: data-lens+category: Control, Comonads+version: 2.11.2+license: BSD3+cabal-version: >= 1.6+license-file: LICENSE+author: Russell O'Connor, Edward A. Kmett & Tony Morris+maintainer: Russell O'Connor <roconnor@theorem.ca>+stability: provisional+homepage: http://github.com/roconnor/data-lens/+copyright: Copyright (C) 2008-2014 Edward A. Kmett, Russell O'Connor & Tony Morris+synopsis: Used to be Haskell 98 Lenses+description: Used to be Haskell 98 Lenses+build-type: Simple+extra-source-files: CHANGELOG source-repository head type: git- location: git://github.com/ekmett/data-lens.git+ location: git://github.com/roconnor/data-lens.git library build-depends: base >= 4 && < 5,- comonad >= 1.1.1.3 && < 1.2,- comonad-transformers >= 2.0 && < 2.2,+ comonad >= 4.0 && < 5.1, containers >= 0.3 && < 0.6,- contravariant >= 0.2.0.1 && < 0.3,- distributive >= 0.2.2 && < 0.3,- semigroupoids >= 1.2.4 && < 1.4,- transformers >= 0.2.0 && < 0.4+ semigroupoids >= 4.0 && < 5.3,+ transformers >= 0.4 && < 0.6 extensions: CPP @@ -34,5 +32,13 @@ Data.Lens.Common Data.Lens.Lazy Data.Lens.Strict+ Data.Lens.Partial.Common+ Data.Lens.Partial.Lazy+ -- Data.Lens.Partial.Strict+ Control.Category.Product ghc-options: -Wall++ hs-source-dirs:+ src+
+ src/Control/Category/Product.hs view
@@ -0,0 +1,18 @@+module Control.Category.Product where++import Prelude hiding (id)+import Control.Category++infixr 3 ***++class Category c => Tensor c where+ -- requires (fl *** fr) . (gl *** gr) === (fl . gl) *** (fr . gr)+ -- and id *** id === id+ (***) :: c w x -> c y z -> c (w, y) (x, z)+ first :: c w x -> c (w,z) (x,z)+ first = (*** id)+ second :: c y z -> c (w,y) (w,z)+ second = (id ***)++instance Tensor (->) where+ (***) f g (w, y) = (f w, g y)
+ src/Data/Lens/Common.hs view
@@ -0,0 +1,166 @@+module Data.Lens.Common+ ( Lens(..)+ -- * Lens construction+ , lens -- build a lens from a getter and setter+ , iso -- build a lens from an isomorphism+ -- * Functional API+ , getL+ , setL+ , modL+ , mergeL+ -- * 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)+ , (^%%=) -- modify -- :: Functor f => Lens a b -> (b -> f b) -> a -> f a+ -- * Pseudo-imperatives+ , (^+=), (^!+=) -- addition+ , (^-=), (^!-=) -- subtraction+ , (^*=), (^!*=) -- multiplication+ , (^/=), (^!/=) -- division+ -- * Stock lenses+ , fstLens+ , sndLens+ , mapLens+ , intMapLens+ , setLens+ , intSetLens+ ) where++import Control.Applicative+import Control.Comonad.Trans.Store+import Control.Category+import Control.Category.Product+import Data.Functor.Identity+import Data.Functor.Apply+import Data.Semigroupoid+import Prelude hiding ((.), id)+import Data.IntMap (IntMap)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.IntMap as IntMap+import Data.Map (Map)+import qualified Data.Set as Set+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet++newtype Lens a b = Lens { runLens :: a -> Store b a }++instance Semigroupoid Lens where+ Lens f `o` Lens g = Lens $ \a -> case g a of+ StoreT wba b -> case f b of+ StoreT wcb c -> StoreT ((.) <$> wba <.> wcb) c++instance Category Lens where+ id = Lens $ StoreT (pure id)+ Lens f . Lens g = Lens $ \a -> case g a of+ StoreT wba b -> case f b of+ StoreT wcb c -> StoreT ((.) <$> wba <*> wcb) c++-- * Lens construction++-- | 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)++-- | build a lens out of an isomorphism+iso :: (a -> b) -> (b -> a) -> Lens a b+iso f g = Lens (store g . f)++-- | Gets the getter function from a lens.+getL :: Lens a b -> a -> b+getL (Lens f) a = pos (f a)++infixr 0 ^$, ^$!+(^$), (^$!) :: Lens a b -> a -> b+(^$) = getL+Lens f ^$! a = pos (f $! a)++infixl 9 ^., ^!+-- | functional getter, which acts like a field accessor+(^.), (^!) :: a -> Lens a b -> b+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++mergeL :: Lens a c -> Lens b c -> Lens (Either a b) c+Lens f `mergeL` Lens g = + Lens $ either (\a -> Left <$> f a) (\b -> Right <$> g b)++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 ^%%=+-- | functorial modify+(^%%=) :: Functor f => Lens a b -> (b -> f b) -> a -> f a+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+fstLens = Lens $ \(a,b) -> store (\ a' -> (a', b)) a++sndLens :: Lens (a,b) b+sndLens = Lens $ \(a,b) -> store (\ b' -> (a, b')) b++mapLens :: Ord k => k -> Lens (Map k v) (Maybe v)+mapLens k = Lens $ \m -> store (\mv -> case mv of+ Nothing -> Map.delete k m+ Just v' -> Map.insert k v' m+ ) (Map.lookup k m)++intMapLens :: Int -> Lens (IntMap v) (Maybe v)+intMapLens k = Lens $ \m -> store (\mv -> case mv of+ Nothing -> IntMap.delete k m+ Just v' -> IntMap.insert k v' m+ ) (IntMap.lookup k m)++setLens :: Ord k => k -> Lens (Set k) Bool+setLens k = Lens $ \m -> store (\mv ->+ if mv then Set.insert k m else Set.delete k m+ ) (Set.member k m)++intSetLens :: Int -> Lens IntSet Bool+intSetLens k = Lens $ \m -> store (\mv ->+ if mv then IntSet.insert k m else IntSet.delete k m+ ) (IntSet.member k m)++instance Tensor Lens where+ Lens f *** Lens g =+ Lens $ \(a, c) ->+ let x = f a+ y = g c+ in store (\(b, d) -> (peek b x, peek d y)) (pos x, pos y)
+ src/Data/Lens/Lazy.hs view
@@ -0,0 +1,91 @@+module Data.Lens.Lazy+ ( module Data.Lens.Common+ -- * State API+ , access -- getter -- :: Monad m => Lens a b -> StateT a m b+ , (~=), (!=) -- setter -- :: Monad m => Lens a b -> b -> StateT a m b+ , (%=), (!%=) -- modify -- :: Monad m => Lens a b -> (b -> b) -> StateT a m b+ , (%%=), (!%%=) -- modify -- :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c+ , (+=), (!+=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b+ , (-=), (!-=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b+ , (*=), (!*=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b+ , (//=), (!/=) -- modify -- :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b+ , (&&=), (!&&=) -- modify -- :: Monad m => Lens a Bool -> Bool -> StateT a m Bool+ , (||=), (!||=) -- modify -- :: Monad m => Lens a Bool -> Bool -> StateT a m Bool+ , focus -- modify -- :: Monad m => Lens a b -> StateT m b c -> StateT m a c+ ) where++import Control.Category.Product+import Control.Comonad.Trans.Store+import Control.Monad.Trans.State+import Control.Monad (liftM)+import Data.Functor.Identity+import Data.Lens.Common++-- * State actions++-- | get the value of a lens into state+access :: Monad m => Lens a b -> StateT a m b+access (Lens f) = gets (pos . f)+{-# INLINE access #-}++focus :: Monad m => Lens a b -> StateT b m c -> StateT a m c+focus (Lens f) (StateT g) = StateT $ \a -> case f a of+ StoreT (Identity h) b -> liftM (second h) (g b)++infixr 4 ~=, !=++-- | set a value using a lens into state+(~=), (!=) :: Monad m => Lens a b -> b -> StateT a m b+Lens f ~= b = StateT $ \a -> let c = peek b (f a) in + return (b, c)+Lens f != b = StateT $ \a -> case f a of+ StoreT (Identity h) _ -> let c = h $! b in+ return (b, c)++infixr 4 %=, !%=+ +-- | infix modification a value through a lens into state+(%=), (!%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m b+Lens f %= g = StateT $ \a -> case f a of + StoreT (Identity h) b -> let b' = g b in+ return (b', h b')+Lens f !%= g = StateT $ \a -> case f a of+ StoreT (Identity h) b -> let b' = g b in+ b' `seq` return (b', h b')++infixr 4 %%=, !%%=++-- | infix modification of a value through a lens into state+-- with a supplemental response+(%%=), (!%%=) :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c+Lens f %%= g = StateT $ \a -> case f a of+ StoreT (Identity h) b -> case g b of+ (c, b') -> return (c, h b')+Lens f !%%= g = StateT $ \a -> case f a of+ StoreT (Identity h) b -> case g b of+ (c, b') -> return (c, h $! b')++infixr 4 +=, !+=, -=, !-=, *=, !*=++(+=), (!+=), (-=), (!-=), (*=), (!*=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b+f += b = f %= (+ b)+f -= b = f %= subtract b+f *= b = f %= (* b)+f !+= b = f !%= (+ b)+f !-= b = f !%= subtract b+f !*= b = f !%= (* b)++infixr 4 //=, !/=++(//=), (!/=) :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b+f //= b = f %= (/ b)+f !/= b = f !%= (/ b)++infixr 4 &&=, !&&=, ||=, !||=++(&&=), (||=), (!&&=), (!||=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool+f &&= b = f %= (&& b)+f ||= b = f %= (|| b)+f !&&= b = f !%= (&& b)+f !||= b = f !%= (|| b)+
+ src/Data/Lens/Partial/Common.hs view
@@ -0,0 +1,170 @@+module Data.Lens.Partial.Common where++import Prelude hiding ((.), id, null, any, all)+import Control.Applicative+import Control.Category+import Control.Category.Product+import Data.Lens.Common (Lens(..))+import Control.Comonad.Trans.Store+import Data.Foldable (any, all)+import Data.Functor.Identity+import Data.Functor.Sum+import Data.Maybe+import Data.Monoid (Monoid, mempty)+import qualified Data.Monoid (Sum(..), Product(..))++newtype PartialLens a b = PLens (a -> Maybe (Store b a))++-- A partial lens is a coalgebra for the Sum Identity (Store b) comonad.+runPLens :: PartialLens a b -> a -> (Sum Identity (Store b)) a+runPLens (PLens f) a = maybe (InL (Identity a)) InR (f a)++instance Category PartialLens where+ id = totalLens id+ PLens f . PLens g = PLens $ \a -> do+ (StoreT wba b) <- g a+ (StoreT wcb c) <- f b+ return (StoreT ((.) <$> wba <*> wcb) c)++null :: PartialLens a b+null = PLens (const Nothing)++-- totalLens is a homomorphism of categories; ie a functor.+totalLens :: Lens a b -> PartialLens a b+totalLens (Lens f) = PLens (Just . f)++-- * Functional API++getPL :: PartialLens a b -> a -> Maybe b+getPL (PLens f) a = pos <$> f a++-- If the PartialLens is null, then return the given default value.+getorPL :: PartialLens a b -> b -> a -> b+getorPL l b = fromMaybe b . getPL l++-- If the PartialLens is null, then return the given default value.+getorAPL :: Applicative f => PartialLens a b -> f b -> a -> f b+getorAPL l b = maybe b pure . getPL l++mergePL :: PartialLens a c -> PartialLens b c -> PartialLens (Either a b) c+(PLens f) `mergePL` (PLens g) =+ PLens $ either (\a -> (fmap Left) <$> f a) (\b -> (fmap Right) <$> g b)++-- If the Partial is null.+nullPL :: PartialLens a b -> a -> Bool+nullPL l = isNothing . getPL l++getorEmptyPL :: (Monoid o) => PartialLens a b -> (b -> o) -> a -> o+getorEmptyPL l p = maybe mempty p . getPL l++-- returns 0 in case of null+sumPL :: (Num c) => PartialLens a b -> (b -> c) -> a -> c+sumPL l p = Data.Monoid.getSum . getorEmptyPL l (Data.Monoid.Sum . p)++-- returns 1 in case of null+productPL :: (Num c) => PartialLens a b -> (b -> c) -> a -> c+productPL l p = Data.Monoid.getProduct . getorEmptyPL l (Data.Monoid.Product . p)++anyPL :: PartialLens a b -> (b -> Bool) -> a -> Bool+anyPL l p =+ any p . getPL l++allPL :: PartialLens a b -> (b -> Bool) -> a -> Bool+allPL l p =+ all p . getPL l++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++infixr 4 ^%%=+-- | applicative modify+(^%%=) :: Applicative f => PartialLens a b -> (b -> f b) -> a -> f a+PLens f ^%%= g = \a -> case f a of+ Nothing -> pure a+ Just (StoreT (Identity h) b) -> h <$> g b++-- * 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)++-- * Stock partial lenses++justLens :: PartialLens (Maybe a) a+justLens = PLens $ \ma -> do+ a <- ma+ return (store Just a)++leftLens :: PartialLens (Either a b) a+leftLens = PLens $ either (Just . store Left) (const Nothing)++rightLens :: PartialLens (Either a b) b+rightLens = PLens $ either (const Nothing) (Just . store Right)++headLens :: PartialLens [a] a+headLens = PLens f+ where+ f [] = Nothing+ f (h:t) = Just (store (:t) h)++tailLens :: PartialLens [a] [a]+tailLens = PLens f+ where+ f [] = Nothing+ f (h:t) = Just (store (h:) t)++{- Other Examples++nthLens :: Int -> PartialLens [a] a+nthLens n | n < 0 = null+ | n == 0 = headLens+ | otherwise = nthLens (n-1) . tailLens++-- setPL does not insert into a Map! it only modifies a value if the key already exists in the map+mapPLens :: Ord k => k -> PartialLens (Map.Map k v) v+mapPLens k = justLens . totalLens (mapLens k)++-- setPL does not insert into a IntMap! it only modifies a value if the key already exists in the map+intMapPLens :: Int -> PartialLens (IntMap v) v+intMapPLens k = justLens . totalLens (intMapLens k)+-}++instance Tensor PartialLens where+ PLens f *** PLens g =+ PLens $ \(a, c) ->+ do x <- f a+ y <- g c+ return $ store (\(b, d) -> (peek b x, peek d y)) (pos x, pos y)
+ src/Data/Lens/Partial/Lazy.hs view
@@ -0,0 +1,66 @@+module Data.Lens.Partial.Lazy where++import Control.Monad+import Control.Comonad.Trans.Store+import Control.Monad.Trans.State+import Data.Functor.Identity+import Data.Lens.Partial.Common++maybeZero :: MonadPlus m => Maybe a -> m a+maybeZero Nothing = mzero+maybeZero (Just a) = return a++joinMaybe :: MonadPlus m => m (Maybe a) -> m a+joinMaybe = (maybeZero =<<)++-- * State actions++-- | get the value of a partial lens into state+access :: Monad m => PartialLens a b -> StateT a m (Maybe b)+access pl = getPL pl `liftM` get++-- | returns mzero in case of a null reference+accessPlus :: MonadPlus m => PartialLens a b -> StateT a m b+accessPlus = joinMaybe . access++-- | set a value using a partial lens into state+-- returns 'Nothing' in case of a null reference+(~=) :: Monad m => PartialLens a b -> b -> StateT a m (Maybe b)+(PLens f) ~= b = StateT $ \a -> return $ case f a of+ Nothing -> (Nothing, a)+ Just st -> (Just b, peek b st)++-- | infix modification a value through a partial lens into state+-- returns 'Nothing' in case of a null reference+(%=) :: Monad m => PartialLens a b -> (b -> b) -> StateT a m (Maybe b)+(PLens f) %= g = StateT $ \a -> return $ case f a of+ Nothing -> (Nothing, a)+ Just (StoreT (Identity h) b) -> let b' = g b in+ (Just b', h b')++-- | infix modification of a value through a partial lens into state+-- with a supplemental response.+-- returns 'Nothing' in case of a null reference+(%%=) :: Monad m => PartialLens a b -> (b -> (c, b)) -> StateT a m (Maybe c)+PLens f %%= g = StateT $ \a -> return $ case f a of+ Nothing -> (Nothing, a)+ Just (StoreT (Identity h) b) -> let (c,b') = g b in+ (Just c, h b')++infixr 4 +=, -=, *=++(+=), (-=), (*=) :: (Monad m, Num b) => PartialLens a b -> b -> StateT a m (Maybe b)+f += b = f %= (+ b)+f -= b = f %= subtract b+f *= b = f %= (* b)++infixr 4 //=++(//=) :: (Monad m, Fractional b) => PartialLens a b -> b -> StateT a m (Maybe b)+f //= b = f %= (/ b)++infixr 4 &&=, ||=++(&&=), (||=) :: Monad m => PartialLens a Bool -> Bool -> StateT a m (Maybe Bool)+f &&= b = f %= (&& b)+f ||= b = f %= (|| b)
+ src/Data/Lens/Strict.hs view
@@ -0,0 +1,91 @@+module Data.Lens.Strict+ ( module Data.Lens.Common+ -- * State API+ , access -- getter -- :: Monad m => Lens a b -> StateT a m b+ , (~=), (!=) -- setter -- :: Monad m => Lens a b -> b -> StateT a m b+ , (%=), (!%=) -- modify -- :: Monad m => Lens a b -> (b -> b) -> StateT a m b+ , (%%=), (!%%=) -- modify -- :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c+ , (+=), (!+=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b+ , (-=), (!-=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b+ , (*=), (!*=) -- modify -- :: (Monad m, Num b) => Lens a b -> b -> StateT a m b+ , (//=), (!/=) -- modify -- :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b+ , (&&=), (!&&=) -- modify -- :: Monad m => Lens a Bool -> Bool -> StateT a m Bool+ , (||=), (!||=) -- modify -- :: Monad m => Lens a Bool -> Bool -> StateT a m Bool+ , focus -- modify -- :: Monad m => Lens a b -> StateT m b c -> StateT m a c+ ) where++import Control.Category.Product+import Control.Comonad.Trans.Store+import Control.Monad.Trans.State.Strict+import Control.Monad (liftM)+import Data.Functor.Identity+import Data.Lens.Common++-- * State actions++-- | get the value of a lens into state+access :: Monad m => Lens a b -> StateT a m b+access (Lens f) = gets (pos . f)+{-# INLINE access #-}++focus :: Monad m => Lens a b -> StateT b m c -> StateT a m c+focus (Lens f) (StateT g) = StateT $ \a -> case f a of+ StoreT (Identity h) b -> liftM (second h) (g b)++infixr 4 ~=, !=++-- | set a value using a lens into state+(~=), (!=) :: Monad m => Lens a b -> b -> StateT a m b+Lens f ~= b = StateT $ \a -> let c = peek b (f a) in + return (b, c)+Lens f != b = StateT $ \a -> case f a of+ StoreT (Identity h) _ -> let c = h $! b in+ return (b, c)++infixr 4 %=, !%=+ +-- | infix modification a value through a lens into state+(%=), (!%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m b+Lens f %= g = StateT $ \a -> case f a of + StoreT (Identity h) b -> let b' = g b in+ return (b', h b')+Lens f !%= g = StateT $ \a -> case f a of+ StoreT (Identity h) b -> let b' = g b in+ b' `seq` return (b', h b')++infixr 4 %%=, !%%=++-- | infix modification of a value through a lens into state+-- with a supplemental response+(%%=), (!%%=) :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c+Lens f %%= g = StateT $ \a -> case f a of+ StoreT (Identity h) b -> case g b of+ (c, b') -> return (c, h b')+Lens f !%%= g = StateT $ \a -> case f a of+ StoreT (Identity h) b -> case g b of+ (c, b') -> return (c, h $! b')++infixr 4 +=, !+=, -=, !-=, *=, !*=++(+=), (!+=), (-=), (!-=), (*=), (!*=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b+f += b = f %= (+ b)+f -= b = f %= subtract b+f *= b = f %= (* b)+f !+= b = f !%= (+ b)+f !-= b = f !%= subtract b+f !*= b = f !%= (* b)++infixr 4 //=, !/=++(//=), (!/=) :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b+f //= b = f %= (/ b)+f !/= b = f !%= (/ b)++infixr 4 &&=, !&&=, ||=, !||=++(&&=), (||=), (!&&=), (!||=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool+f &&= b = f %= (&& b)+f ||= b = f %= (|| b)+f !&&= b = f !%= (&& b)+f !||= b = f !%= (|| b)+