data-lens 2.0.4.1 → 2.9.0
raw patch · 14 files changed
+647/−355 lines, 14 filesdep ~comonad-transformersdep ~containersdep ~distributivesetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: comonad-transformers, containers, distributive
API changes (from Hackage documentation)
+ Control.Category.Product: (***) :: Tensor c => c w x -> c y z -> c (w, y) (x, z)
+ Control.Category.Product: class Category c => Tensor c where first = (*** id) second = (id ***)
+ Control.Category.Product: first :: Tensor c => c w x -> c (w, z) (x, z)
+ Control.Category.Product: instance Tensor (->)
+ Control.Category.Product: second :: Tensor c => c y z -> c (w, y) (w, z)
+ Data.Lens.Common: instance Tensor Lens
+ Data.Lens.Common: mergeL :: Lens a c -> Lens b c -> Lens (Either a b) c
+ Data.Lens.Partial.Common: (^$) :: PartialLens a b -> a -> Maybe b
+ Data.Lens.Partial.Common: (^%%=) :: Applicative f => PartialLens a b -> (b -> f b) -> a -> f a
+ Data.Lens.Partial.Common: (^%=) :: PartialLens a b -> (b -> b) -> a -> a
+ Data.Lens.Partial.Common: (^+=, ^*=, ^-=) :: Num b => PartialLens a b -> b -> a -> a
+ Data.Lens.Partial.Common: (^.) :: a -> PartialLens a b -> Maybe b
+ Data.Lens.Partial.Common: (^/=) :: Fractional b => PartialLens a b -> b -> a -> a
+ Data.Lens.Partial.Common: (^=) :: PartialLens a b -> b -> a -> a
+ Data.Lens.Partial.Common: PLens :: (a -> Maybe (Store b a)) -> PartialLens a b
+ Data.Lens.Partial.Common: allPL :: PartialLens a b -> (b -> Bool) -> a -> Bool
+ Data.Lens.Partial.Common: anyPL :: PartialLens a b -> (b -> Bool) -> a -> Bool
+ Data.Lens.Partial.Common: getPL :: PartialLens a b -> a -> Maybe b
+ Data.Lens.Partial.Common: getorAPL :: Applicative f => PartialLens a b -> f b -> a -> f b
+ Data.Lens.Partial.Common: getorEmptyPL :: Monoid o => PartialLens a b -> (b -> o) -> a -> o
+ Data.Lens.Partial.Common: getorPL :: PartialLens a b -> b -> a -> b
+ Data.Lens.Partial.Common: headLens :: PartialLens [a] a
+ Data.Lens.Partial.Common: instance Category PartialLens
+ Data.Lens.Partial.Common: instance Tensor PartialLens
+ Data.Lens.Partial.Common: justLens :: PartialLens (Maybe a) a
+ Data.Lens.Partial.Common: leftLens :: PartialLens (Either a b) a
+ Data.Lens.Partial.Common: mergePL :: PartialLens a c -> PartialLens b c -> PartialLens (Either a b) c
+ Data.Lens.Partial.Common: modPL :: PartialLens a b -> (b -> b) -> a -> a
+ Data.Lens.Partial.Common: newtype PartialLens a b
+ Data.Lens.Partial.Common: null :: PartialLens a b
+ Data.Lens.Partial.Common: nullPL :: PartialLens a b -> a -> Bool
+ Data.Lens.Partial.Common: productPL :: Num c => PartialLens a b -> (b -> c) -> a -> c
+ Data.Lens.Partial.Common: rightLens :: PartialLens (Either a b) b
+ Data.Lens.Partial.Common: runPLens :: PartialLens a b -> a -> (Coproduct Identity (Store b)) a
+ Data.Lens.Partial.Common: setPL :: PartialLens a b -> b -> a -> a
+ Data.Lens.Partial.Common: sumPL :: Num c => PartialLens a b -> (b -> c) -> a -> c
+ Data.Lens.Partial.Common: tailLens :: PartialLens [a] [a]
+ Data.Lens.Partial.Common: totalLens :: Lens a b -> PartialLens a b
+ Data.Lens.Partial.Common: trySetPL :: PartialLens a b -> a -> Maybe (b -> a)
+ Data.Lens.Partial.Lazy: (%%=) :: Monad m => PartialLens a b -> (b -> (c, b)) -> StateT a m (Maybe c)
+ Data.Lens.Partial.Lazy: (%=) :: Monad m => PartialLens a b -> (b -> b) -> StateT a m (Maybe b)
+ Data.Lens.Partial.Lazy: (&&=, ||=) :: Monad m => PartialLens a Bool -> Bool -> StateT a m (Maybe Bool)
+ Data.Lens.Partial.Lazy: (+=, *=, -=) :: (Monad m, Num b) => PartialLens a b -> b -> StateT a m (Maybe b)
+ Data.Lens.Partial.Lazy: (//=) :: (Monad m, Fractional b) => PartialLens a b -> b -> StateT a m (Maybe b)
+ Data.Lens.Partial.Lazy: (~=) :: Monad m => PartialLens a b -> b -> StateT a m (Maybe b)
+ Data.Lens.Partial.Lazy: access :: Monad m => PartialLens a b -> StateT a m (Maybe b)
+ Data.Lens.Partial.Lazy: accessPlus :: MonadPlus m => PartialLens a b -> StateT a m b
+ Data.Lens.Partial.Lazy: joinMaybe :: MonadPlus m => m (Maybe a) -> m a
+ Data.Lens.Partial.Lazy: maybeZero :: MonadPlus m => Maybe a -> m a
Files
- CHANGELOG +5/−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 +36/−19
- 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 +169/−0
- src/Data/Lens/Partial/Lazy.hs +66/−0
- src/Data/Lens/Strict.hs +91/−0
+ CHANGELOG view
@@ -0,0 +1,5 @@+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,38 +1,55 @@-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.9.0+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-2012 Edward A. Kmett, Russell O'Connor & Tony Morris+synopsis: Haskell 98 Lenses+description: 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 +flag DeriveDataTypeable+ manual: False+ default: True+ library build-depends:- base >= 4 && < 5,+ base >= 4 && < 5, comonad >= 1.1.1.3 && < 1.2,- comonad-transformers >= 2.0 && < 2.2,- containers >= 0.3 && < 0.6,+ comonad-transformers >= 2.1 && < 2.2,+ containers >= 0.3 && < 0.5, contravariant >= 0.2.0.1 && < 0.3,- distributive >= 0.2.2 && < 0.3,+ distributive >= 0.2.1 && < 0.3, semigroupoids >= 1.2.4 && < 1.4, transformers >= 0.2.0 && < 0.4 + if flag(DeriveDataTypeable)+ extensions: DeriveDataTypeable+ cpp-options: -DLANGUAGE_DeriveDataTypeable+ extensions: CPP exposed-modules: 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,169 @@+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.Coproduct+import Data.Maybe+import Data.Monoid++newtype PartialLens a b = PLens (a -> Maybe (Store b a))++-- A partial lens is a coalgebra for the Coproduct Identity (Store b) comonad.+runPLens :: PartialLens a b -> a -> (Coproduct Identity (Store b)) a+runPLens (PLens f) a = maybe (left (Identity a)) right (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 = isJust . 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 = getSum . getorEmptyPL l (Sum . p)++-- returns 1 in case of null+productPL :: (Num c) => PartialLens a b -> (b -> c) -> a -> c+productPL l p = getProduct . getorEmptyPL l (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)+