From ed7d78cb3953d95bb8a53955c0af58bf74f078af Mon Sep 17 00:00:00 2001 From: Edward Kmett Date: Tue, 28 Jun 2011 09:33:30 -0400 Subject: [PATCH] repo initialized --- Data/Lens/Common.hs | 140 ++++++++++++++++++++++++++++++++++++++++++++ Data/Lens/Lazy.hs | 90 ++++++++++++++++++++++++++++ Data/Lens/Strict.hs | 90 ++++++++++++++++++++++++++++ LICENSE | 30 ++++++++++ lens.cabal | 48 +++++++++++++++ 5 files changed, 398 insertions(+) create mode 100644 Data/Lens/Common.hs create mode 100644 Data/Lens/Lazy.hs create mode 100644 Data/Lens/Strict.hs create mode 100644 LICENSE create mode 100644 lens.cabal diff --git a/Data/Lens/Common.hs b/Data/Lens/Common.hs new file mode 100644 index 0000000..bb45498 --- /dev/null +++ b/Data/Lens/Common.hs @@ -0,0 +1,140 @@ +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 + , (^$), (^$!) -- 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) + +infixr 0 ^$, ^$! + +-- | functional getter +(^$), (^$!) :: Lens a b -> a -> b +Lens f ^$ a = pos (f a) +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) + +infixr 4 ^=, ^!= +-- | functional setter +(^=), (^!=) :: Lens a b -> b -> a -> a +Lens f ^= b = peek b . f +Lens f ^!= b = \a -> case f a of + StoreT (Identity g) _ -> g $! b + +infixr 4 ^%=, ^!%= +-- | functional modify +(^%=), (^!%=) :: Lens a b -> (b -> b) -> a -> a +Lens f ^%= g = peeks g . f +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.delete k m else Set.insert k m + ) (Set.member k m) + +intSetLens :: Int -> Lens IntSet Bool +intSetLens k = Lens $ \m -> store (\mv -> + if mv then IntSet.delete k m else IntSet.insert k m + ) (IntSet.member k m) diff --git a/Data/Lens/Lazy.hs b/Data/Lens/Lazy.hs new file mode 100644 index 0000000..0ba256c --- /dev/null +++ b/Data/Lens/Lazy.hs @@ -0,0 +1,90 @@ +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) + diff --git a/Data/Lens/Strict.hs b/Data/Lens/Strict.hs new file mode 100644 index 0000000..0917120 --- /dev/null +++ b/Data/Lens/Strict.hs @@ -0,0 +1,90 @@ +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) + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..3bb1c86 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright 2008-2011 Edward Kmett + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/lens.cabal b/lens.cabal new file mode 100644 index 0000000..7c2be86 --- /dev/null +++ b/lens.cabal @@ -0,0 +1,48 @@ +name: lens +category: Control, Comonads +version: 1.8.0 +license: BSD3 +cabal-version: >= 1.6 +license-file: LICENSE +author: Edward A. Kmett +maintainer: Edward A. Kmett +stability: provisional +homepage: git://github.com/ekmett/lens/ +copyright: Copyright (C) 2008-2011 Edward A. Kmett +synopsis: Haskell 98 Lenses +description: Haskell 98 Lenses +build-type: Simple +extra-source-files: coq/Store.v + +source-repository head + type: git + location: git://github.com/ekmett/comonad-transformers.git + +flag DeriveDataTypeable + manual: False + default: True + +library + build-depends: + base >= 4 && < 4.4, + comonad >= 1.1 && < 1.2, + comonad-transformers >= 1.8.0 && < 1.9, + containers >= 0.3 && < 0.5, + contravariant >= 0.1.2 && < 0.2, + distributive >= 0.2 && < 0.3, + semigroupoids >= 1.2.2 && < 1.3, + semigroups >= 0.5 && < 0.6, + transformers >= 0.2.0 && <= 0.3 + + if flag(DeriveDataTypeable) + extensions: DeriveDataTypeable + cpp-options: -DLANGUAGE_DeriveDataTypeable + + extensions: CPP + + exposed-modules: + Data.Lens.Common + Data.Lens.Lazy + Data.Lens.Strict + + ghc-options: -Wall