packages feed

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 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)+