lens-family-core 0.0.1 → 0.1.0

raw patch · 10 files changed

+146/−92 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +8/−0
• lens-family-core.cabal +5/−2
• src/Lens/Family.hs +42/−44
• src/Lens/Family/Clone.hs +4/−4
• src/Lens/Family/Setting.hs +5/−0
• src/Lens/Family/State/Focus.hs +10/−0
• src/Lens/Family/State/Lazy.hs +13/−9
• src/Lens/Family/State/Strict.hs +13/−9
• src/Lens/Family/Stock.hs +13/−13
• src/Lens/Family/Unchecked.hs +33/−11

@@ -1,3 +1,11 @@+0.1.0 (Changes from 0.0.1)+=========================+* added project and sec+* added <>= and <>~+* renamed functional modifier operators+* renamed LensFamily and Lens to RefFamily and Ref+* moving setting to Lens.Family.Unchecked because one needs to verify the functor laws+ 0.0.1 (Changes from 0.0.0) ========================= * Bump dependency on containers

@@ -1,6 +1,6 @@ name:               lens-family-core-category:           Data-version:            0.0.1+category:           Data, Lenses+version:            0.1.0 license:            BSD3 cabal-version:      >= 1.6 license-file:       LICENSE@@ -42,6 +42,9 @@     Lens.Family.State.Lazy     Lens.Family.State.Strict     Lens.Family.State+  other-modules:+    Lens.Family.State.Focus+    Lens.Family.Setting    ghc-options:      -Wall 

@@ -1,6 +1,6 @@ -- | This is the main module for end-users of lens-families. -- If you are not building your own lenses, but just using top-level defined lenses made by others, this is the only module you need.--- It provides '^.' for accessing fields and '^=' and '^%=' for setting and modifying fields.+-- It provides '^.' for accessing fields and '<~' and '%~' for setting and modifying fields. -- Lenses are composed with `Prelude..` from the @Prelude@ and `Prelude.id` is the identity lens. -- -- /Warning/: Lenses are composed in the opposite order than most lens packages.@@ -8,13 +8,13 @@ -- -- * @x ^. l1 . l2 === x ^. l1 ^. l2@ ----- * @l1 . l2 ^%= f === l1 ^%= l2 ^%= f@+-- * @l1 . l2 %~ f === l1 %~ l2 %~ f@ -- -- The identity lens behaves as follows. -- -- * @x ^. id === x@ ----- * @id ^%= f === f@+-- * @id %~ f === f@ -- -- Lenses are implemented in van Laarhoven style.  Lenses have type @'Functor' f => (b -> f b) -> a -> f a@ and lens families have type @'Functor' f => (b x -> f (b x')) -> a x -> f (a x')@. --@@ -27,7 +27,7 @@ -- -- > -- | 'sharedUpdate' returns the *identical* object if the update doesn't change anything. -- > -- This is useful for preserving sharing.--- > sharedUpdate :: Eq b => Lens Maybe a b -> (b -> b) -> a -> a+-- > sharedUpdate :: Eq b => Ref Maybe a b -> (b -> b) -> a -> a -- > sharedUpdate lens f a = fromMaybe a (lens f' a) -- >  where -- >   f' b | fb == b  = Nothing@@ -49,48 +49,37 @@ -- -- * <http://conal.net/blog/posts/semantic-editor-combinators> module Lens.Family-  ( getting, setting-  , (^.)-  , (^%=)-  , (^=)+  ( getting, project, (^.)+  , sec, (%~), (<~)   -- * Pseudo-imperatives-  , (^+=), (^*=), (^-=), (^/=), (^&&=), (^||=)+  , (+~), (*~), (-~), (/~), (&&~), (||~), (<>~)   -- * Types   , GetterFamily, Getter   , SetterFamily, Setter   ) where -import Lens.Family.Unchecked (LensFamily)+import Data.Monoid (Monoid, mappend)+import Lens.Family.Setting (Setting(..))+import Lens.Family.Unchecked (RefFamily, SetterFamily, Setter)  newtype Getting c a = Getting { unGetting :: c } instance Functor (Getting c) where   fmap _ (Getting c) = Getting c -newtype Setting a = Setting { unSetting :: a }-instance Functor Setting where-  fmap f (Setting a) = Setting (f a)--type GetterFamily a a' b b' = LensFamily (Getting b) a a' b b'+type GetterFamily a a' b b' = RefFamily (Getting b) a a' b b' type Getter a b = GetterFamily a a b b -type SetterFamily a a' b b' = LensFamily Setting a a' b b'-type Setter a b = SetterFamily a a b b- -- | 'getting' promotes a projection function to a read-only lens.--- To demote a lens to a projection function, use the section @(^. l)@.+-- To demote a lens to a projection function, use the section @(^. l)@ or @project l@. -- -- >>> (3 :+ 4, "example") ^. fstL . getting abs -- 5.0 :+ 0.0 getting :: (a -> b) -> GetterFamily a a' b b' getting p _ = Getting . p --- | 'setting' promotes a \"semantic editor combinator\" to a modify-only lens.--- To demote a lens to a semantic edit combinator, use the section @(l ^%=)@.------ >>> setting map . fstL ^%= length $ [("The",0),("quick",1),("brown",1),("fox",2)]--- [(3,0),(5,1),(5,1),(3,2)]-setting :: ((b -> b') -> a -> a') -> SetterFamily a a' b b'-setting s f = Setting . s (unSetting . f)+-- | Demote a getter to a projection function.+project :: GetterFamily a a' b b' -> a -> b+project l = (^. l)  infixr 8 ^. @@ -98,32 +87,41 @@ (^.) :: a -> GetterFamily a a' b b' -> b x ^. l = unGetting $ l Getting x -infixr 4 ^%=+-- | Demote a setter to a semantic editor combinator.+sec :: SetterFamily a a' b b' -> (b -> b') -> a -> a'+sec l = (l %~) +infixr 4 %~+ -- | Modify a field.-(^%=) :: SetterFamily a a' b b' -> (b -> b') -> a -> a'-l ^%= f = unSetting . l (Setting . f)+(%~) :: SetterFamily a a' b b' -> (b -> b') -> a -> a'+l %~ f = unSetting . l (Setting . f)  -- | Set a field.-infixr 4 ^=+infixr 4 <~ -(^=) :: SetterFamily a a' b b' -> b' -> a -> a'-l ^= b = l ^%= const b+(<~) :: SetterFamily a a' b b' -> b' -> a -> a'+l <~ b = l %~ const b -infixr 4 ^+=, ^-=, ^*=+infixr 4 +~, -~, *~ -(^+=), (^-=), (^*=) :: Num b => Setter a b -> b -> a -> a-f ^+= b = f ^%= (+ b)-f ^-= b = f ^%= subtract b-f ^*= b = f ^%= (* b)+(+~), (-~), (*~) :: Num b => Setter a b -> b -> a -> a+f +~ b = f %~ (+ b)+f -~ b = f %~ subtract b+f *~ b = f %~ (* b) -infixr 4 ^/=+infixr 4 /~ -(^/=) :: Fractional b => Setter a b -> b -> a -> a-f ^/= b = f ^%= (/ b)+(/~) :: Fractional b => Setter a b -> b -> a -> a+f /~ b = f %~ (/ b) -infixr 4 ^&&=, ^||=+infixr 4 &&~, ||~ -(^&&=), (^||=) :: Setter a Bool -> Bool -> a -> a-f ^&&= b = f ^%= (&& b)-f ^||= b = f ^%= (|| b)+(&&~), (||~) :: Setter a Bool -> Bool -> a -> a+f &&~ b = f %~ (&& b)+f ||~ b = f %~ (|| b)++infixr 4 <>~++(<>~) :: (Monoid o) => Setter a o -> o -> a -> a+f <>~ o = f %~ (`mappend` o)

@@ -19,21 +19,21 @@ module Lens.Family.Clone   ( clone   -- * Types-  , LensFamily+  , RefFamily   , ClonerFamily, Cloner   ) where -import Lens.Family.Unchecked (LensFamily)+import Lens.Family.Unchecked (RefFamily)  data Cloning b' b a = Cloning (b' -> a) b instance Functor (Cloning b' b) where   fmap f (Cloning g b) = Cloning (f . g) b -type ClonerFamily a a' b b' = LensFamily (Cloning b' b) a a' b b'+type ClonerFamily a a' b b' = RefFamily (Cloning b' b) a a' b b' type Cloner a b = ClonerFamily a a b b  -- | Converts a universal lens instance back into a polymorphic lens.-clone :: Functor f => ClonerFamily a a' b b' -> LensFamily f a a' b b'+clone :: Functor f => ClonerFamily a a' b b' -> RefFamily f a a' b b' clone univ f a = fmap g (f b)   where     Cloning g b = univ (Cloning id) a

@@ -0,0 +1,5 @@+module Lens.Family.Setting where++newtype Setting a = Setting { unSetting :: a }+instance Functor Setting where+  fmap f (Setting a) = Setting (f a)

@@ -0,0 +1,10 @@+module Lens.Family.State.Focus where++import Control.Applicative (Applicative, pure, (<*>))+import Control.Monad (liftM)+import Data.Monoid (Monoid, mempty, mappend)++newtype Focusing m c a = Focusing { unFocusing :: m (c, a) }++instance Monad m => Functor (Focusing m c) where+  fmap f (Focusing m) = Focusing (liftM (fmap f) m)

@@ -11,24 +11,23 @@   , (+=), (-=), (*=)   , (//=)   , (&&=), (||=)+  , (<>=)   -- * Types   , Focusing   ) where +import Data.Monoid (Monoid, mappend) import Control.Monad (liftM) import Control.Monad.Trans.State.Lazy (StateT(..), get, modify)-import Lens.Family (Getter, Setter, (^.), (^%=))-import Lens.Family.Stock (Lens)+import Lens.Family (Getter, Setter, (^.), (%~))+import Lens.Family.Stock (Ref)+import Lens.Family.State.Focus (Focusing(..))  {- all these Monad constraints could be weakened to Functor constraints -} -newtype Focusing m c a = Focusing { unFocusing :: m (c, a) }-instance Monad m => Functor (Focusing m c) where-  fmap f (Focusing m) = Focusing (liftM (fmap f) m)- -- | Lift a stateful operation on a field to a stateful operation on the whole state. -- This is a good way to call a \"subroutine\" that only needs access to part of the state.-focus :: Monad m => Lens (Focusing m c) a b -> StateT b m c -> StateT a m c+focus :: Monad m => Ref (Focusing m c) a b -> StateT b m c -> StateT a m c focus l m = StateT $ unFocusing . l (Focusing . (runStateT m))  -- | Retrieve a field of the state@@ -39,7 +38,7 @@  -- | Modify a field of the state (%=) :: Monad m => Setter a b -> (b -> b) -> StateT a m ()-l %= f = modify (l ^%= f)+l %= f = modify (l %~ f)  infix 4 ~= @@ -50,7 +49,7 @@ infix 4 %%=  -- | Modify a field of the state while returning another value-(%%=) :: Monad m => Lens (Focusing m c) a b -> (b -> (c, b)) -> StateT a m c+(%%=) :: Monad m => Ref (Focusing m c) a b -> (b -> (c, b)) -> StateT a m c l %%= f = focus l (StateT (return . f))  infixr 4 +=, -=, *=@@ -70,3 +69,8 @@ (&&=), (||=) :: Monad m => Setter a Bool -> Bool -> StateT a m () f &&= b = f %= (&& b) f ||= b = f %= (|| b)++infixr 4 <>=++(<>=) :: (Monoid o, Monad m) => Setter a o -> o -> StateT a m ()+f <>= b = f %= (`mappend` b)

@@ -11,24 +11,23 @@   , (+=), (-=), (*=)   , (//=)   , (&&=), (||=)+  , (<>=)   -- * Types   , Focusing   ) where +import Data.Monoid (Monoid, mappend) import Control.Monad (liftM) import Control.Monad.Trans.State.Strict (StateT(..), get, modify)-import Lens.Family (Getter, Setter, (^.), (^%=))-import Lens.Family.Stock (Lens)+import Lens.Family (Getter, Setter, (^.), (%~))+import Lens.Family.Stock (Ref)+import Lens.Family.State.Focus (Focusing(..))  {- all these Monad constraints could be weakened to Functor constraints -} -newtype Focusing m c a = Focusing { unFocusing :: m (c, a) }-instance Monad m => Functor (Focusing m c) where-  fmap f (Focusing m) = Focusing (liftM (fmap f) m)- -- | Lift a stateful operation on a field to a stateful operation on the whole state. -- This is a good way to call a \"subroutine\" that only needs access to part of the state.-focus :: Monad m => Lens (Focusing m c) a b -> StateT b m c -> StateT a m c+focus :: Monad m => Ref (Focusing m c) a b -> StateT b m c -> StateT a m c focus l m = StateT $ unFocusing . l (Focusing . (runStateT m))  -- | Retrieve a field of the state@@ -39,7 +38,7 @@  -- | Modify a field of the state (%=) :: Monad m => Setter a b -> (b -> b) -> StateT a m ()-l %= f = modify (l ^%= f)+l %= f = modify (l %~ f)  infix 4 ~= @@ -50,7 +49,7 @@ infix 4 %%=  -- | Modify a field of the state while returning another value-(%%=) :: Monad m => Lens (Focusing m c) a b -> (b -> (c, b)) -> StateT a m c+(%%=) :: Monad m => Ref (Focusing m c) a b -> (b -> (c, b)) -> StateT a m c l %%= f = focus l (StateT (return . f))  infixr 4 +=, -=, *=@@ -70,3 +69,8 @@ (&&=), (||=) :: Monad m => Setter a Bool -> Bool -> StateT a m () f &&= b = f %= (&& b) f ||= b = f %= (|| b)++infixr 4 <>=++(<>=) :: (Monoid o, Monad m) => Setter a o -> o -> StateT a m ()+f <>= b = f %= (`mappend` b)

@@ -10,11 +10,11 @@   , mapL, intMapL   , setL, intSetL   -- * Types-  , LensFamily, Lens+  , RefFamily, Ref   ) where -import Lens.Family.Unchecked (LensFamily, Lens, mkLens)-import Lens.Family ((^.), (^=))+import Lens.Family.Unchecked (RefFamily, Ref, mkLens)+import Lens.Family ((^.), (<~)) import Lens.Family.Clone (ClonerFamily, clone) import qualified Data.Map as Map import qualified Data.IntMap as IntMap@@ -22,42 +22,42 @@ import qualified Data.IntSet as IntSet  -- | Given two lens\/getter\/setter families with the same substructure, make a new lens\/getter\/setter on 'Either'.-mergeL :: Functor f => LensFamily f a a' c c' -> LensFamily f b b' c c' -> LensFamily f (Either a b) (Either a' b') c c'+mergeL :: Functor f => RefFamily f a a' c c' -> RefFamily f b b' c c' -> RefFamily f (Either a b) (Either a' b') c c' mergeL la _  f (Left a)  = Left  `fmap` la f a mergeL _  lb f (Right b) = Right `fmap` lb f b  -- I suspect there is a more clever way to define this function. -- | Given two lens families, make a new lens on their product.-(***) :: Functor f => ClonerFamily a1 a1' b1 b1' -> ClonerFamily a2 a2' b2 b2' -> LensFamily f (a1, a2) (a1', a2') (b1, b2) (b1', b2')-(***) l1 l2 f (a1, a2) = (\(v'1, v'2) -> (cl1 ^= v'1 $ a1, cl2 ^= v'2 $ a2)) `fmap` f (a1 ^. cl1, a2 ^. cl2)+(***) :: Functor f => ClonerFamily a1 a1' b1 b1' -> ClonerFamily a2 a2' b2 b2' -> RefFamily f (a1, a2) (a1', a2') (b1, b2) (b1', b2')+(***) l1 l2 f (a1, a2) = (\(v'1, v'2) -> (cl1 <~ v'1 $ a1, cl2 <~ v'2 $ a2)) `fmap` f (a1 ^. cl1, a2 ^. cl2)   where     cl1 x = clone l1 x     cl2 x = clone l2 x  -- | Lens on the first element of a pair.-fstL :: Functor f => LensFamily f (a, b) (a', b) a a'+fstL :: Functor f => RefFamily f (a, b) (a', b) a a' fstL f (a, b) = (\a' -> (a', b)) `fmap` f a  -- | Lens on the second element of a pair.-sndL :: Functor f => LensFamily f (a, b) (a, b') b b'+sndL :: Functor f => RefFamily f (a, b) (a, b') b b' sndL f (a, b) = (\b' -> (a, b')) `fmap` f b  -- | Lens on a given point of a function.-funL :: (Eq k, Functor f) => k -> Lens f (k -> v) v+funL :: (Eq k, Functor f) => k -> Ref f (k -> v) v funL k f g = (\v' x -> if (k == x) then v' else g x) `fmap` f (g k)  -- | Lens on a given point of a 'Map.Map'.-mapL :: (Ord k, Functor f) => k -> Lens f (Map.Map k v) (Maybe v)+mapL :: (Ord k, Functor f) => k -> Ref f (Map.Map k v) (Maybe v) mapL k = mkLens (Map.lookup k) (\m -> maybe (Map.delete k m) (\v' -> Map.insert k v' m))  -- | Lens on a given point of a 'IntMap.IntMap'.-intMapL :: (Functor f) => Int -> Lens f (IntMap.IntMap v) (Maybe v)+intMapL :: (Functor f) => Int -> Ref f (IntMap.IntMap v) (Maybe v) intMapL k = mkLens (IntMap.lookup k) (\m -> maybe (IntMap.delete k m) (\v' -> IntMap.insert k v' m))  -- | Lens on a given point of a 'Set.Set'.-setL :: (Ord k, Functor f) => k -> Lens f (Set.Set k) Bool+setL :: (Ord k, Functor f) => k -> Ref f (Set.Set k) Bool setL k = mkLens (Set.member k) (\m nv -> if nv then Set.insert k m else Set.delete k m)  -- | Lens on a given point of a 'IntSet.IntSet'.-intSetL :: (Functor f) => Int -> Lens f IntSet.IntSet Bool+intSetL :: (Functor f) => Int -> Ref f IntSet.IntSet Bool intSetL k = mkLens (IntSet.member k) (\m nv -> if nv then IntSet.insert k m else IntSet.delete k m)

@@ -6,16 +6,16 @@ -- > data MyRecord a = MyRecord { _myA :: a, _myB :: Int } -- > -- > -- The use of type variables a and a' allow for polymorphic updates.--- > myA :: Functor f => LensFamily f (MyRecord a) (MyRecord a') a a'+-- > myA :: Functor f => RefFamily f (MyRecord a) (MyRecord a') a a' -- > myA f (MyRecord a b) = (\a' -> MyRecord a' b) `fmap` (f a) -- >--- > -- The field _myB is monomorphic, so we can use a plain Lens type.--- > -- However, the structure of the function is exactly the same as for LensFamily.--- > myB :: Functor f => Lens f (MyRecord a) Int+-- > -- The field _myB is monomorphic, so we can use a plain Ref type.+-- > -- However, the structure of the function is exactly the same as for RefFamily.+-- > myB :: Functor f => Ref f (MyRecord a) Int -- > myB f (MyRecord a b) = (\b' -> MyRecord a b') `fmap` (f b) -- -- By following this template you can safely build your own lenses.--- To use this template, you do not need anything from this module other than the type synonyms 'LensFamily' and 'Lens', and even they are optional.+-- To use this template, you do not need anything from this module other than the type synonyms 'RefFamily' and 'Ref', and even they are optional. -- See the @lens-family-th@ package to generate this code using Template Haskell. -- -- /Note/: It is possible to build lenses without even depending on @lens-family-core@ by expanding away the type synonym.@@ -25,7 +25,7 @@ -- > myA f (MyRecord a b) = (\a' -> MyRecord a' b) `fmap` (f a) -- -- You can build lenses for more than just fields of records.--- Any value @lens :: Functor f => LensFamily f a a' b b'@ is well-defined when it satisfies the two van Laarhoven lens laws:+-- Any value @lens :: Functor f => RefFamily f a a' b b'@ is well-defined when it satisfies the two van Laarhoven lens laws: -- -- * @lens Identity === Identity@ --@@ -41,13 +41,20 @@ module Lens.Family.Unchecked    ( mkLens   , mkIsoLens+  , Setting, setting   -- * Types-  , LensFamily, Lens+  , RefFamily, Ref+  , SetterFamily, Setter   ) where -type LensFamily f a a' b b' = (b -> f b') -> (a -> f a')-type Lens f a b = LensFamily f a a b b+import Lens.Family.Setting (Setting(..))+  +type RefFamily f a a' b b' = (b -> f b') -> (a -> f a')+type Ref f a b = RefFamily f a a b b +type SetterFamily a a' b b' = RefFamily Setting a a' b b'+type Setter a b = SetterFamily a a b b+ -- | Build a lens from a @getter@ and @setter@ families. -- -- /Caution/: In order for the generated lens family to be well-defined, you must ensure that the three lens laws hold:@@ -60,7 +67,7 @@ mkLens :: Functor f        => (a -> b) -- ^ getter        -> (a -> b' -> a') -- ^ setter-       -> LensFamily f a a' b b'+       -> RefFamily f a a' b b' mkLens getter setter f a = fmap (setter a) (f (getter a))  -- | Build a lens from isomorphism families.@@ -73,5 +80,20 @@ mkIsoLens :: Functor f            => (a -> b) -- ^ yin           -> (b' -> a') -- ^ yang-          -> LensFamily f a a' b b'+          -> RefFamily f a a' b b' mkIsoLens getter setter = mkLens getter (const setter)++-- | 'setting' promotes a \"semantic editor combinator\" to a modify-only lens.+-- To demote a lens to a semantic edit combinator, use the section @(l %~)@ or @sec l@.+--+-- >>> setting map . fstL %~ length $ [("The",0),("quick",1),("brown",1),("fox",2)]+-- [(3,0),(5,1),(5,1),(3,2)]+--+-- /Caution/: In order for the generated setter family to be well-defined, you must ensure that the two functors laws hold:+-- +-- * @sec id === id@+--+-- * @sec f . sec g === sec (f . g)@+setting :: ((b -> b') -> a -> a') -- ^ sec (semantic editor combinator)+        -> SetterFamily a a' b b'+setting s f = Setting . s (unSetting . f)