lens-family-core-1.2.3/0000755000175000001440000000000013353041217015740 5ustar00roconnorusers00000000000000lens-family-core-1.2.3/src/0000755000175000001440000000000013353041217016527 5ustar00roconnorusers00000000000000lens-family-core-1.2.3/src/Lens/0000755000175000001440000000000013353041217017430 5ustar00roconnorusers00000000000000lens-family-core-1.2.3/src/Lens/Family.hs0000644000175000001440000002423713353041217021215 0ustar00roconnorusers00000000000000-- | This is the main module for end-users of lens-families-core. -- If you are not building your own lenses or traversals, but just using functional references made by others, this is the only module you need. module Lens.Family ( -- * Lenses -- -- | This module 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. -- -- Lens composition in this library enjoys the following identities. -- -- * @x^.l1.l2 === x^.l1^.l2@ -- -- * @l1.l2 %~ f === l1 %~ l2 %~ f@ -- -- The identity lens behaves as follows. -- -- * @x^.id === x@ -- -- * @id %~ f === f@ -- -- The '&' operator, allows for a convenient way to sequence record updating: -- -- @record & l1 .~ value1 & l2 .~ value2@ -- -- 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 i -> f (b j)) -> a i -> f (a j)@. -- -- Keep in mind that lenses and lens families can be used directly for functorial updates. -- For example, @_2 id@ gives you strength. -- -- > _2 id :: Functor f => (a, f b) -> f (a, b) -- -- Here is an example of code that uses the 'Maybe' functor to preserves sharing during update when possible. -- -- > -- | 'sharedUpdate' returns the *identical* object if the update doesn't change anything. -- > -- This is useful for preserving sharing. -- > sharedUpdate :: Eq b => LensLike' Maybe a b -> (b -> b) -> a -> a -- > sharedUpdate l f a = fromMaybe a (l f' a) -- > where -- > f' b | fb == b = Nothing -- > | otherwise = Just fb -- > where -- > fb = f b -- * Traversals -- -- | '^.' can be used with traversals to access monoidal fields. -- The result will be a 'Data.Monid.mconcat' of all the fields referenced. -- The various @fooOf@ functions can be used to access different monoidal summaries of some kinds of values. -- -- '^?' can be used to access the first value of a traversal. -- 'Nothing' is returned when the traversal has no references. -- -- '^..' can be used with a traversals and will return a list of all fields referenced. -- -- When '.~' is used with a traversal, all referenced fields will be set to the same value, and when '%~' is used with a traversal, all referenced fields will be modified with the same function. -- -- Like lenses, traversals can be composed with '.', and because every lens is automatically a traversal, lenses and traversals can be composed with '.' yielding a traversal. -- -- Traversals are implemented in van Laarhoven style. -- Traversals have type @'Applicative' f => (b -> f b) -> a -> f a@ and traversal families have type @'Applicative' f => (b i -> f (b j)) -> a i -> f (a j)@. -- -- For stock lenses and traversals, see "Lens.Family.Stock". -- -- To build your own lenses and traversals, see "Lens.Family.Unchecked". -- -- References: -- -- * -- -- * -- -- * -- -- * -- * Documentation to, view, (^.) , folding, views, (^..), (^?) , toListOf, allOf, anyOf, firstOf, lastOf, sumOf, productOf , lengthOf, nullOf , backwards , over, (%~), set, (.~) , (&) -- * Pseudo-imperatives , (+~), (*~), (-~), (//~), (&&~), (||~), (<>~) -- * Types , LensLike, LensLike' , FoldLike, FoldLike' , ASetter, ASetter' , Phantom , Constant, Identity -- * Re-exports , Applicative, Foldable, Monoid , Backwards, All, Any, First, Last, Sum, Product ) where import Control.Applicative (Applicative) import Control.Applicative.Backwards (Backwards(..)) import Data.Foldable (Foldable, traverse_) import Data.Functor.Identity (Identity(..)) import Data.Functor.Constant (Constant(..)) import Data.Monoid ( Monoid, mappend , All(..), Any(..) , First(..), Last(..) , Sum(..), Product(..) ) import Lens.Family.Phantom (Phantom, coerce) import Lens.Family.Unchecked ( LensLike, LensLike' ) type FoldLike r a a' b b' = LensLike (Constant r) a a' b b' type FoldLike' r a b = LensLike' (Constant r) a b type ASetter a a' b b' = LensLike Identity a a' b b' type ASetter' a b = LensLike' Identity a b to :: Phantom f => (a -> b) -> LensLike f a a' b b' -- ^ @ -- to :: (a -> b) -> Getter a a' b b' -- @ -- -- 'to' promotes a projection function to a read-only lens called a getter. -- To demote a lens to a projection function, use the section @(^.l)@ or @view l@. -- -- >>> (3 :+ 4, "example")^._1.to(abs) -- 5.0 :+ 0.0 to p f = coerce . f . p view :: FoldLike b a a' b b' -> a -> b -- ^ @ -- view :: Getter a a' b b' -> a -> b -- @ -- -- Demote a lens or getter to a projection function. -- -- @ -- view :: Monoid b => Fold a a' b b' -> a -> b -- @ -- -- Returns the monoidal summary of a traversal or a fold. view l = (^.l) folding :: (Foldable g, Phantom f, Applicative f) => (a -> g b) -> LensLike f a a' b b' -- ^ @ -- folding :: (a -> [b]) -> Fold a a' b b' -- @ -- -- 'folding' promotes a \"toList\" function to a read-only traversal called a fold. -- -- To demote a traversal or fold to a \"toList\" function use the section @(^..l)@ or @toListOf l@. folding p f = coerce . traverse_ f . p views :: FoldLike r a a' b b' -> (b -> r) -> a -> r -- ^ @ -- views :: Monoid r => Fold a a' b b' -> (b -> r) -> a -> r -- @ -- -- Given a fold or traversal, return the 'foldMap' of all the values using the given function. -- -- @ -- views :: Getter a a' b b' -> (b -> r) -> a -> r -- @ -- -- 'views' is not particularly useful for getters or lenses, but given a getter or lens, it returns the referenced value passed through the given function. -- -- @ -- views l f a = f (view l a) -- @ views l f = getConstant . l (Constant . f) toListOf :: FoldLike [b] a a' b b' -> a -> [b] -- ^ @ -- toListOf :: Fold a a' b b' -> a -> [b] -- @ -- -- Returns a list of all of the referenced values in order. toListOf l = views l (:[]) allOf :: FoldLike All a a' b b' -> (b -> Bool) -> a -> Bool -- ^ @ -- allOf :: Fold a a' b b' -> (b -> Bool) -> a -> Bool -- @ -- -- Returns true if all of the referenced values satisfy the given predicate. allOf l p = getAll . views l (All . p) anyOf :: FoldLike Any a a' b b' -> (b -> Bool) -> a -> Bool -- ^ @ -- anyOf :: Fold a a' b b' -> (b -> Bool) -> a -> Bool -- @ -- -- Returns true if any of the referenced values satisfy the given predicate. anyOf l p = getAny . views l (Any . p) firstOf :: FoldLike (First b) a a' b b' -> a -> Maybe b -- ^ @ -- firstOf :: Fold a a' b b' -> a -> Maybe b -- @ -- -- Returns 'Just' the first referenced value. -- Returns 'Nothing' if there are no referenced values. -- See '^?' for an infix version of 'firstOf' firstOf l = getFirst . views l (First . Just) lastOf :: FoldLike (Last b) a a' b b' -> a -> Maybe b -- ^ @ -- lastOf :: Fold a a' b b' -> a -> Maybe b -- @ -- -- Returns 'Just' the last referenced value. -- Returns 'Nothing' if there are no referenced values. lastOf l = getLast . views l (Last . Just) sumOf :: Num b => FoldLike (Sum b) a a' b b' -> a -> b -- ^ @ -- sumOf :: Num b => Fold a a' b b' -> a -> b -- @ -- -- Returns the sum of all the referenced values. sumOf l = getSum . views l Sum productOf :: Num b => FoldLike (Product b) a a' b b' -> a -> b -- ^ @ -- productOf :: Num b => Fold a a' b b' -> a -> b -- @ -- -- Returns the product of all the referenced values. productOf l = getProduct . views l Product lengthOf :: Num r => FoldLike (Sum r) a a' b b' -> a -> r -- ^ @ -- lengthOf :: Num r => Fold a a' b b' -> a -> r -- @ -- -- Counts the number of references in a traversal or fold for the input. lengthOf l = getSum . views l (const (Sum 1)) nullOf :: FoldLike All a a' b b' -> a -> Bool -- ^ @ -- nullOf :: Fold a a' b b' -> a -> Bool -- @ -- -- Returns true if the number of references in the input is zero. nullOf l = allOf l (const False) infixl 8 ^. (^.) :: a -> FoldLike b a a' b b' -> b -- ^ @ -- (^.) :: a -> Getter a a' b b' -> b -- @ -- -- Access the value referenced by a getter or lens. -- -- @ -- (^.) :: Monoid b => a -> Fold a a' b b' -> b -- @ -- -- Access the monoidal summary referenced by a getter or lens. x^.l = getConstant $ l Constant x infixl 8 ^.. (^..) :: a -> FoldLike [b] a a' b b' -> [b] -- ^ @ -- (^..) :: a -> Getter a a' b b' -> [b] -- @ -- -- Returns a list of all of the referenced values in order. x^..l = toListOf l x infixl 8 ^? (^?) :: a -> FoldLike (First b) a a' b b' -> Maybe b -- ^ @ -- (^?) :: a -> Fold a a' b b' -> Maybe b -- @ -- -- Returns 'Just' the first referenced value. -- Returns 'Nothing' if there are no referenced values. x^?l = firstOf l x backwards :: LensLike (Backwards f) a a' b b' -> LensLike f a a' b b' -- ^ @ -- backwards :: Traversal a a' b b' -> Traversal a a' b b' -- backwards :: Fold a a' b b' -> Fold a a' b b' -- @ -- -- Given a traversal or fold, reverse the order that elements are traversed. -- -- @ -- backwards :: Lens a a' b b' -> Lens a a' b b' -- backwards :: Getter a a' b b' -> Getter a a' b b' -- backwards :: Setter a a' b b' -> Setter a a' b b' -- @ -- -- No effect on lenses, getters or setters. backwards l f = forwards . l (Backwards . f) -- | Demote a setter to a semantic editor combinator. over :: ASetter a a' b b' -> (b -> b') -> a -> a' over l = (l %~) infixr 4 %~ -- | Modify all referenced fields. (%~) :: ASetter a a' b b' -> (b -> b') -> a -> a' l %~ f = runIdentity . l (Identity . f) infixr 4 .~ -- | Set all referenced fields to the given value. (.~) :: ASetter a a' b b' -> b' -> a -> a' l .~ b = l %~ const b -- | Set all referenced fields to the given value. set :: ASetter a a' b b' -> b' -> a -> a' set = (.~) infixl 1 & -- | A flipped version of @($)@. (&) :: a -> (a -> b) -> b (&) = flip ($) infixr 4 +~, -~, *~ (+~), (-~), (*~) :: Num b => ASetter' a b -> b -> a -> a f +~ b = f %~ (+ b) f -~ b = f %~ subtract b f *~ b = f %~ (* b) infixr 4 //~ (//~) :: Fractional b => ASetter' a b -> b -> a -> a f //~ b = f %~ (/ b) infixr 4 &&~, ||~ (&&~), (||~) :: ASetter' a Bool -> Bool -> a -> a f &&~ b = f %~ (&& b) f ||~ b = f %~ (|| b) infixr 4 <>~ -- | Monoidally append a value to all referenced fields. (<>~) :: (Monoid o) => ASetter' a o -> o -> a -> a f <>~ o = f %~ (`mappend` o) lens-family-core-1.2.3/src/Lens/Family/0000755000175000001440000000000013353041217020651 5ustar00roconnorusers00000000000000lens-family-core-1.2.3/src/Lens/Family/Phantom.hs0000644000175000001440000000114513353041217022614 0ustar00roconnorusers00000000000000module Lens.Family.Phantom where import Control.Applicative.Backwards (Backwards(..)) import Control.Applicative (Const(..)) import Data.Functor.Constant (Constant(..)) import Data.Functor.Compose (Compose(..)) class Functor f => Phantom f where coerce :: f a -> f b instance Phantom f => Phantom (Backwards f) where coerce (Backwards x) = Backwards (coerce x) instance Phantom (Const a) where coerce (Const x) = (Const x) instance Phantom (Constant a) where coerce (Constant x) = (Constant x) instance (Phantom f, Functor g) => Phantom (Compose f g) where coerce (Compose x) = Compose (coerce x) lens-family-core-1.2.3/src/Lens/Family/Stock.hs0000644000175000001440000001664513353041217022304 0ustar00roconnorusers00000000000000-- | This module contains lenses and traversals for common structures in Haskell. -- It also contains the combinators for lenses and traversals. module Lens.Family.Stock ( -- * Lens Combinators choosing , alongside , beside -- * Stock Lenses , _1, _2 , chosen , ix , at, intAt , at', intAt' , contains, intContains -- * Stock Traversals , both , _Left, _Right , _Just, _Nothing , ignored -- * Stock SECs , mapped -- * Types , AlongsideLeft, AlongsideRight -- * Re-exports , LensLike, LensLike' , Applicative, Identical ) where import Control.Arrow (first, second) import Control.Applicative (Applicative, pure, (<$>), (<*>)) import Lens.Family (LensLike, LensLike') import Lens.Family.Unchecked (lens, setting, Identical) import Lens.Family.Phantom (Phantom, coerce) import qualified Data.Map as Map import qualified Data.IntMap as IntMap import qualified Data.Map.Strict as Map' import qualified Data.IntMap.Strict as IntMap' import qualified Data.Set as Set import qualified Data.IntSet as IntSet choosing :: Functor f => LensLike f a a' c c' -> LensLike f b b' c c' -> LensLike f (Either a b) (Either a' b') c c' -- ^ @ -- choosing :: Lens a a' c c' -> Lens b b' c c' -> Lens (Either a b) (Either a' b') c c' -- @ -- -- @ -- choosing :: Traversal a a' c c' -> Traversal b b' c c' -> Traversal (Either a b) (Either a' b') c c' -- @ -- -- @ -- choosing :: Getter a a' c c' -> Getter b b' c c' -> Getter (Either a b) (Either a' b') c c' -- @ -- -- @ -- choosing :: Fold a a' c c' -> Fold b b' c c' -> Fold (Either a b) (Either a' b') c c' -- @ -- -- @ -- choosing :: Setter a a' c c' -> Setter b b' c c' -> Setter (Either a b) (Either a' b') c c' -- @ -- -- Given two lens\/traversal\/getter\/fold\/setter families with the same substructure, make a new lens\/traversal\/getter\/fold\/setter on 'Either'. choosing la _ f (Left a) = Left `fmap` la f a choosing _ lb f (Right b) = Right `fmap` lb f b _1 :: Functor f => LensLike f (a, b) (a', b) a a' -- ^ @ -- _1 :: Lens (a, b) (a', b) a a' -- @ -- -- Lens on the first element of a pair. _1 f (a, b) = (\a' -> (a', b)) `fmap` f a _2 :: Functor f => LensLike f (a, b) (a, b') b b' -- ^ @ -- _2 :: Lens (a, b) (a, b') b b' -- @ -- -- Lens on the second element of a pair. _2 f (a, b) = (\b' -> (a, b')) `fmap` f b chosen :: Functor f => LensLike f (Either a a) (Either b b) a b -- ^ @ -- chosen :: Lens (Either a a) (Either b b) a b -- @ -- -- Lens on the Left or Right element of an ('Either' a a). chosen = choosing id id ix :: (Eq k, Functor f) => k -> LensLike' f (k -> v) v -- ^ @ -- ix :: Eq k => k -> Lens' (k -> v) v -- @ -- -- Lens on a given point of a function. ix k f g = (\v' x -> if (k == x) then v' else g x) `fmap` f (g k) at :: (Ord k, Functor f) => k -> LensLike' f (Map.Map k v) (Maybe v) -- ^ @ -- at :: Ord k => k -> Lens' (Map.Map k v) (Maybe v) -- @ -- -- Lens on a given point of a 'Map.Map'. at = flip Map.alterF intAt :: Functor f => Int -> LensLike' f (IntMap.IntMap v) (Maybe v) -- ^ @ -- intAt :: Int -> Lens (IntMap.IntMap v) (Maybe v) -- @ -- -- Lens on a given point of a 'IntMap.IntMap'. intAt = flip IntMap.alterF at' :: (Ord k, Functor f) => k -> LensLike' f (Map.Map k v) (Maybe v) -- ^ @ -- at :: Ord k => k -> Lens' (Map.Map k v) (Maybe v) -- @ -- -- Lens providing strict access to a given point of a 'Map.Map'. at' = flip Map'.alterF intAt' :: Functor f => Int -> LensLike' f (IntMap.IntMap v) (Maybe v) -- ^ @ -- intAt :: Int -> Lens (IntMap.IntMap v) (Maybe v) -- @ -- -- Lens providing strict access to a given point of a 'IntMap.IntMap'. intAt' = flip IntMap'.alterF contains :: (Ord k, Functor f) => k -> LensLike' f (Set.Set k) Bool -- ^ @ -- contains :: Ord => k -> Lens' (Set.Set k) Bool -- @ -- -- Lens on a given point of a 'Set.Set'. contains k = lens (Set.member k) (\m nv -> if nv then Set.insert k m else Set.delete k m) intContains :: Functor f => Int -> LensLike' f IntSet.IntSet Bool -- ^ @ -- intContains :: Int -> Lens' IntSet.IntSet Bool -- @ -- -- Lens on a given point of a 'IntSet.IntSet'. intContains k = lens (IntSet.member k) (\m nv -> if nv then IntSet.insert k m else IntSet.delete k m) _Left :: Applicative f => LensLike f (Either a b) (Either a' b) a a' -- ^ @ -- _Left :: Traversal (Either a b) (Either a' b) a a' -- @ -- -- Traversal on the 'Left' element of an 'Either'. _Left f (Left a) = Left <$> f a _Left _ (Right b) = pure (Right b) _Right :: Applicative f => LensLike f (Either a b) (Either a b') b b' -- ^ @ -- _Right :: Traversal (Either a b) (Either a b') b b' -- @ -- -- Traversal on the 'Right' element of an 'Either'. _Right f (Right b) = Right <$> f b _Right _ (Left a) = pure (Left a) _Just :: Applicative f => LensLike f (Maybe a) (Maybe a') a a' -- ^ @ -- _Just :: Traversal (Maybe a) (Maybe a') a a' -- @ -- -- Traversal on the 'Just' element of a 'Maybe'. _Just f (Just a) = Just <$> f a _Just _ Nothing = pure Nothing _Nothing :: Applicative f => LensLike' f (Maybe a) () -- ^ @ -- _Nothing :: Traversal' (Maybe a) () -- @ -- -- Traversal on the 'Nothing' element of a 'Maybe'. _Nothing f Nothing = const Nothing <$> f () _Nothing _ j = pure j both :: Applicative f => LensLike f (a,a) (b,b) a b -- ^ @ -- both :: Traversal (a,a) (b,b) a b -- @ -- -- Traversals on both elements of a pair @(a,a)@. both f (x,y) = (,) <$> f x <*> f y beside :: Applicative f => LensLike f a a' c c' -> LensLike f b b' c c' -> LensLike f (a,b) (a',b') c c' -- ^ @ -- beside :: Traversal a a' c c' -> Traversal b' b' c c' -> Traversal (a,b) (a',b') c c' -- @ -- -- @ -- beside :: Fold a a' c c' -> Fold b' b' c c' -> Fold (a,b) (a',b') c c' -- @ -- -- @ -- beside :: Setter a a' c c' -> Setter b' b' c c' -> Setter (a,b) (a',b') c c' -- @ -- -- Given two traversals\/folds\/setters referencing a type 'c', create a traversal\/fold\/setter on the pair referencing 'c'. beside la lb f (x,y) = (,) <$> la f x <*> lb f y ignored :: Applicative f => null -> a -> f a -- ^ @ -- ignored :: Traversal a a b b' -- @ -- -- The empty traversal on any type. ignored _ = pure mapped :: (Identical f, Functor g) => LensLike f (g a) (g a') a a' -- ^ @ -- mapped :: Functor g => Setter (g a) (g a') a a' -- @ -- -- An SEC referencing the parameter of a functor. mapped = setting fmap {- Alongside -} newtype AlongsideLeft f b a = AlongsideLeft (f (a, b)) instance Functor f => Functor (AlongsideLeft f a) where fmap f (AlongsideLeft x) = AlongsideLeft (fmap (first f) x) instance Phantom f => Phantom (AlongsideLeft f a) where coerce (AlongsideLeft x) = AlongsideLeft (coerce x) newtype AlongsideRight f a b = AlongsideRight (f (a, b)) instance Functor f => Functor (AlongsideRight f a) where fmap f (AlongsideRight x) = AlongsideRight (fmap (second f) x) instance Phantom f => Phantom (AlongsideRight f a) where coerce (AlongsideRight x) = AlongsideRight (coerce x) alongside :: Functor f => LensLike (AlongsideLeft f b2') a1 a1' b1 b1' -> LensLike (AlongsideRight f a1') a2 a2' b2 b2' -> LensLike f (a1, a2) (a1', a2') (b1, b2) (b1', b2') -- ^ @ -- alongside :: Lens a1 a1' b1 b1' -> Lens a2 a2' b2 b2' -> Lens (a1, a2) (a1', a2') (b1, b2) (b1', b2') -- @ -- -- @ -- alongside :: Getter a1 a1' b1 b1' -> Getter a2 a2' b2 b2' -> Getter (a1, a2) (a1', a2') (b1, b2) (b1', b2') -- @ -- -- Given two lens\/getter families, make a new lens\/getter on their product. alongside l1 l2 f (a1, a2) = fa1'a2' where AlongsideRight fa1'a2' = l2 f2 a2 f2 b2 = AlongsideRight fa1'b2' where AlongsideLeft fa1'b2' = l1 f1 a1 f1 b1 = AlongsideLeft (f (b1, b2)) lens-family-core-1.2.3/src/Lens/Family/Clone.hs0000644000175000001440000001051613353041217022250 0ustar00roconnorusers00000000000000-- | This module is provided for Haskell 98 compatibility. -- If you are able to use @Rank2Types@, I advise you to instead use the rank 2 aliases -- -- * @Lens@, @Lens'@ -- -- * @Traversal@, @Traversal'@ -- -- * @Setter@, @Setter'@ -- -- * @Fold@, @Fold'@ -- -- * @Getter@, @Getter'@ -- -- from the @lens-family@ package instead. -- -- 'cloneLens' allows one to circumvent the need for rank 2 types by allowing one to take a universal monomorphic lens instance and rederive a polymorphic instance. -- When you require a lens family parameter you use the type @'ALens' a a' b b'@ (or @'ALens'' a b@). -- Then, inside a @where@ clause, you use 'cloneLens' to create a 'Lens' type. -- -- For example. -- -- > example :: ALens a a' b b' -> Example -- > example l = ... x^.cl ... cl .~ y ... -- > where -- > cl x = cloneLens l x -- -- /Note/: It is important to eta-expand the definition of 'cl' to avoid the dreaded monomorphism restriction. -- -- 'cloneTraversal', 'cloneGetter', 'cloneSetter', and 'cloneFold' provides similar functionality for traversals, getters, setters, and folds respectively. -- -- /Note/: Cloning is only need if you use a functional reference multiple times with different instances. module Lens.Family.Clone ( cloneLens, cloneTraversal, cloneSetter, cloneGetter, cloneFold -- * Types , ALens, ALens' , ATraversal, ATraversal' , AGetter, AGetter' , AFold, AFold' , IStore, IKleeneStore -- * Re-exports , LensLike, LensLike', FoldLike, FoldLike', ASetter , Applicative, Phantom, Identical ) where import Control.Applicative (Applicative, pure, (<*>), (<$>)) import Lens.Family.Unchecked (Identical, setting) import Lens.Family ( LensLike, LensLike' , ASetter, over , FoldLike, FoldLike', toListOf, folding , to, view , Phantom ) data IStore b b' a = IStore (b' -> a) b instance Functor (IStore b b') where fmap f (IStore g b) = IStore (f . g) b -- | ALens a a' b b' is a universal Lens a a' b b' instance type ALens a a' b b' = LensLike (IStore b b') a a' b b' -- | ALens' a b is a universal Lens' a b instance type ALens' a b = LensLike' (IStore b b) a b -- | Converts a universal lens instance back into a polymorphic lens. cloneLens :: Functor f => ALens a a' b b' -> LensLike f a a' b b' cloneLens univ f = experiment f . univ (IStore id) experiment :: Functor f => (b -> f b') -> IStore b b' a -> f a experiment f (IStore g b) = g <$> f b data IKleeneStore b b' a = Unit a | Battery (IKleeneStore b b' (b' -> a)) b instance Functor (IKleeneStore b b') where fmap f (Unit a) = Unit (f a) fmap f (Battery g b) = Battery (fmap (f .) g) b instance Applicative (IKleeneStore b b') where pure = Unit Unit f <*> a = fmap f a Battery f b <*> a = Battery (flip <$> f <*> a) b -- | ATraversal a a' b b' is a universal Traversal a a' b b' instance type ATraversal a a' b b' = LensLike (IKleeneStore b b') a a' b b' -- | ATraversal' a b is a universal Traversal' a b instance type ATraversal' a b = LensLike' (IKleeneStore b b) a b -- | Converts a universal traversal instance back into a polymorphic traversal. cloneTraversal :: Applicative f => ATraversal a a' b b' -> LensLike f a a' b b' cloneTraversal univ f = research f . univ (Battery (Unit id)) research :: Applicative f => (b -> f b') -> IKleeneStore b b' a -> f a research _ (Unit a) = pure a research f (Battery g b) = research f g <*> f b -- | Converts a universal setter instance back into a polymorphic setter. cloneSetter :: Identical f => ASetter a a' b b' -> LensLike f a a' b b' cloneSetter = setting . over -- | AFold a a' b b' is a universal Fold' a a' b b' instance type AFold a a' b b' = FoldLike [b] a a' b b' -- | AFold' a b is a universal Fold' a b instance type AFold' a b = FoldLike' [b] a b -- | Converts a universal fold instance back into a polymorphic fold. cloneFold :: (Phantom f, Applicative f) => AFold a a' b b' -> LensLike f a a' b b' cloneFold univ = folding (toListOf univ) -- | AGetter a a' b b' is a universal Fold a a' b b' instance type AGetter a a' b b' = FoldLike b a a' b b' -- | AGetter' a b is a universal Fold' a b instance type AGetter' a b = FoldLike' b a b -- | Converts a universal getter instance back into a polymorphic getter. cloneGetter :: Phantom f => AGetter a a' b b' -> LensLike f a a' b b' cloneGetter univ = to (view univ) lens-family-core-1.2.3/src/Lens/Family/State.hs0000644000175000001440000000014413353041217022264 0ustar00roconnorusers00000000000000module Lens.Family.State ( module Lens.Family.State.Lazy ) where import Lens.Family.State.Lazylens-family-core-1.2.3/src/Lens/Family/State/0000755000175000001440000000000013353041217021731 5ustar00roconnorusers00000000000000lens-family-core-1.2.3/src/Lens/Family/State/Strict.hs0000644000175000001440000001211313353041217023533 0ustar00roconnorusers00000000000000-- | Lenses allow you to use fields of the state of a state monad as if they were variables in an imperative language. -- 'use' is used to retrieve the value of a variable, and '.=' and '%=' allow you to set and modify a variable. -- C-style compound assignments are also provided. module Lens.Family.State.Strict ( zoom , use, uses , (%=) , assign, (.=) , (%%=) , (<~) -- * Compound Assignments , (+=), (-=), (*=) , (//=) , (&&=), (||=) , (<>=) -- * Strict Assignments , (%!=) , (+!=), (-!=), (*!=) , (//!=) , (&&!=), (||!=) , (<>!=) -- * Types , Zooming -- * Re-exports , LensLike, LensLike' , FoldLike, Constant , ASetter, ASetter', Identity , StateT, Writer , Monoid ) where import Data.Monoid (Monoid, mappend) import Data.Tuple (swap) import Control.Monad (liftM) import Control.Monad.Trans.Writer.Lazy (Writer, writer, runWriter) import Control.Monad.Trans.State.Strict (StateT(..), state, get, modify, modify') import Lens.Family ( LensLike, LensLike' , FoldLike, Constant , ASetter, ASetter', Identity , view, views, (%~) ) import Lens.Family.State.Zoom (Zooming(..)) {- all these Monad constraints could be weakened to Functor or Applicative constraints -} zoom :: Monad m => LensLike' (Zooming m c) a b -> StateT b m c -> StateT a m c -- ^ @ -- zoom :: Monad m => Lens' a b -> StateT b m c -> StateT a m c -- @ -- -- 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. -- -- @ -- zoom :: (Monoid c, Monad m) => Traversal' a b -> StateT b m c -> StateT a m c -- @ -- -- Run the \"subroutine\" on each element of the traversal in turn and 'mconcat' all the results together. -- -- @ -- zoom :: Monad m => Traversal' a b -> StateT b m () -> StateT a m () -- @ -- -- Run the \"subroutine\" on each element the traversal in turn. zoom l m = StateT $ unZooming . l (Zooming . (runStateT m)) use :: Monad m => FoldLike b a a' b b' -> StateT a m b -- ^ @ -- use :: Monad m => Getter a a' b b' -> StateT a m b -- @ -- -- Retrieve a field of the state -- -- @ -- use :: (Monoid b, Monad m) => Fold a a' b b' -> StateT a m b -- @ -- -- Retrieve a monoidal summary of all the referenced fields from the state use l = view l `liftM` get uses :: Monad m => FoldLike r a a' b b' -> (b -> r) -> StateT a m r -- ^ @ -- uses :: (Monoid r, Monad m) => Fold a a' b b' -> (b -> r) -> StateT a m r -- @ -- -- Retrieve all the referenced fields from the state and foldMap the results together with @f :: b -> r@. -- -- @ -- uses :: Monad m => Getter a a' b b' -> (b -> r) -> StateT a m r -- @ -- -- Retrieve a field of the state and pass it through the function @f :: b -> r@. -- -- @uses l f = f \<$> use l@ uses l f = views l f `liftM` get infix 4 %= -- | Modify a field of the state. (%=) :: Monad m => ASetter a a b b' -> (b -> b') -> StateT a m () l %= f = modify (l %~ f) infix 4 .= -- | Set a field of the state. (.=) :: Monad m => ASetter a a b b' -> b' -> StateT a m () l .= v = l %= const v -- | Set a field of the state. assign :: Monad m => ASetter a a b b' -> b' -> StateT a m () assign = (.=) infixr 2 <~ -- | Set a field of the state using the result of executing a stateful command. (<~) :: Monad m => ASetter a a b b' -> StateT a m b' -> StateT a m () l <~ v = assign l =<< v infix 4 %%= (%%=) :: Monad m => LensLike (Writer c) a a b b' -> (b -> (c, b')) -> StateT a m c -- ^ @ -- (%%=) :: Monad m => Lens a a b b' -> (b -> (c, b')) -> StateT a m c -- @ -- -- Modify a field of the state while returning another value. -- -- @ -- (%%=) :: (Monad m, Monoid c) => Traversal a a b b' -> (b -> (c, b')) -> StateT a m c -- @ -- -- Modify each field of the state and return the 'mconcat' of the other values. l %%= f = state (swap . runWriter . l (writer . swap . f)) infixr 4 +=, -=, *= (+=), (-=), (*=) :: (Monad m, Num b) => ASetter' a b -> b -> StateT a m () f += b = f %= (+ b) f -= b = f %= subtract b f *= b = f %= (* b) infixr 4 //= (//=) :: (Monad m, Fractional b) => ASetter' a b -> b -> StateT a m () f //= b = f %= (/ b) infixr 4 &&=, ||= (&&=), (||=) :: Monad m => ASetter' a Bool -> Bool -> StateT a m () f &&= b = f %= (&& b) f ||= b = f %= (|| b) infixr 4 <>= -- | Monoidally append a value to all referenced fields of the state. (<>=) :: (Monoid o, Monad m) => ASetter' a o -> o -> StateT a m () f <>= b = f %= (`mappend` b) infix 4 %!= -- | Strictly modify a field of the state. (%!=) :: Monad m => ASetter a a b b' -> (b -> b') -> StateT a m () l %!= f = modify' (l %~ f) infixr 4 +!=, -!=, *!= (+!=), (-!=), (*!=) :: (Monad m, Num b) => ASetter' a b -> b -> StateT a m () f +!= b = f %!= (+ b) f -!= b = f %!= subtract b f *!= b = f %!= (* b) infixr 4 //!= (//!=) :: (Monad m, Fractional b) => ASetter' a b -> b -> StateT a m () f //!= b = f %!= (/ b) infixr 4 &&!=, ||!= (&&!=), (||!=) :: Monad m => ASetter' a Bool -> Bool -> StateT a m () f &&!= b = f %!= (&& b) f ||!= b = f %!= (|| b) infixr 4 <>!= (<>!=) :: (Monoid o, Monad m) => ASetter' a o -> o -> StateT a m () f <>!= b = f %!= (`mappend` b) lens-family-core-1.2.3/src/Lens/Family/State/Lazy.hs0000644000175000001440000001210713353041217023205 0ustar00roconnorusers00000000000000-- | Lenses allow you to use fields of the state of a state monad as if they were variables in an imperative language. -- 'use' is used to retrieve the value of a variable, and '.=' and '%=' allow you to set and modify a variable. -- C-style compound assignments are also provided. module Lens.Family.State.Lazy ( zoom , use, uses , (%=) , assign, (.=) , (%%=) , (<~) -- * Compound Assignments , (+=), (-=), (*=) , (//=) , (&&=), (||=) , (<>=) -- * Strict Assignments , (%!=) , (+!=), (-!=), (*!=) , (//!=) , (&&!=), (||!=) , (<>!=) -- * Types , Zooming -- * Re-exports , LensLike, LensLike' , FoldLike, Constant , ASetter, ASetter', Identity , StateT, Writer , Monoid ) where import Data.Monoid (Monoid, mappend) import Data.Tuple (swap) import Control.Monad (liftM) import Control.Monad.Trans.Writer.Lazy (Writer, writer, runWriter) import Control.Monad.Trans.State.Lazy (StateT(..), state, get, modify, modify') import Lens.Family ( LensLike, LensLike' , FoldLike, Constant , ASetter, ASetter', Identity , view, views, (%~) ) import Lens.Family.State.Zoom (Zooming(..)) {- all these Monad constraints could be weakened to Functor or Applicative constraints -} zoom :: Monad m => LensLike' (Zooming m c) a b -> StateT b m c -> StateT a m c -- ^ @ -- zoom :: Monad m => Lens' a b -> StateT b m c -> StateT a m c -- @ -- -- 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. -- -- @ -- zoom :: (Monoid c, Monad m) => Traversal' a b -> StateT b m c -> StateT a m c -- @ -- -- Run the \"subroutine\" on each element of the traversal in turn and 'mconcat' all the results together. -- -- @ -- zoom :: Monad m => Traversal' a b -> StateT b m () -> StateT a m () -- @ -- -- Run the \"subroutine\" on each element the traversal in turn. zoom l m = StateT $ unZooming . l (Zooming . (runStateT m)) use :: Monad m => FoldLike b a a' b b' -> StateT a m b -- ^ @ -- use :: Monad m => Getter a a' b b' -> StateT a m b -- @ -- -- Retrieve a field of the state -- -- @ -- use :: (Monoid b, Monad m) => Fold a a' b b' -> StateT a m b -- @ -- -- Retrieve a monoidal summary of all the referenced fields from the state use l = view l `liftM` get uses :: Monad m => FoldLike r a a' b b' -> (b -> r) -> StateT a m r -- ^ @ -- uses :: (Monoid r, Monad m) => Fold a a' b b' -> (b -> r) -> StateT a m r -- @ -- -- Retrieve all the referenced fields from the state and foldMap the results together with @f :: b -> r@. -- -- @ -- uses :: Monad m => Getter a a' b b' -> (b -> r) -> StateT a m r -- @ -- -- Retrieve a field of the state and pass it through the function @f :: b -> r@. -- -- @uses l f = f \<$> use l@ uses l f = views l f `liftM` get infix 4 %= -- | Modify a field of the state. (%=) :: Monad m => ASetter a a b b' -> (b -> b') -> StateT a m () l %= f = modify (l %~ f) infix 4 .= -- | Set a field of the state. (.=) :: Monad m => ASetter a a b b' -> b' -> StateT a m () l .= v = l %= const v -- | Set a field of the state. assign :: Monad m => ASetter a a b b' -> b' -> StateT a m () assign = (.=) infixr 2 <~ -- | Set a field of the state using the result of executing a stateful command. (<~) :: Monad m => ASetter a a b b' -> StateT a m b' -> StateT a m () l <~ v = assign l =<< v infix 4 %%= (%%=) :: Monad m => LensLike (Writer c) a a b b' -> (b -> (c, b')) -> StateT a m c -- ^ @ -- (%%=) :: Monad m => Lens a a b b' -> (b -> (c, b')) -> StateT a m c -- @ -- -- Modify a field of the state while returning another value. -- -- @ -- (%%=) :: (Monad m, Monoid c) => Traversal a a b b' -> (b -> (c, b')) -> StateT a m c -- @ -- -- Modify each field of the state and return the 'mconcat' of the other values. l %%= f = state (swap . runWriter . l (writer . swap . f)) infixr 4 +=, -=, *= (+=), (-=), (*=) :: (Monad m, Num b) => ASetter' a b -> b -> StateT a m () f += b = f %= (+ b) f -= b = f %= subtract b f *= b = f %= (* b) infixr 4 //= (//=) :: (Monad m, Fractional b) => ASetter' a b -> b -> StateT a m () f //= b = f %= (/ b) infixr 4 &&=, ||= (&&=), (||=) :: Monad m => ASetter' a Bool -> Bool -> StateT a m () f &&= b = f %= (&& b) f ||= b = f %= (|| b) infixr 4 <>= -- | Monoidally append a value to all referenced fields of the state. (<>=) :: (Monoid o, Monad m) => ASetter' a o -> o -> StateT a m () f <>= b = f %= (`mappend` b) infix 4 %!= -- | Strictly modify a field of the state. (%!=) :: Monad m => ASetter a a b b' -> (b -> b') -> StateT a m () l %!= f = modify' (l %~ f) infixr 4 +!=, -!=, *!= (+!=), (-!=), (*!=) :: (Monad m, Num b) => ASetter' a b -> b -> StateT a m () f +!= b = f %!= (+ b) f -!= b = f %!= subtract b f *!= b = f %!= (* b) infixr 4 //!= (//!=) :: (Monad m, Fractional b) => ASetter' a b -> b -> StateT a m () f //!= b = f %!= (/ b) infixr 4 &&!=, ||!= (&&!=), (||!=) :: Monad m => ASetter' a Bool -> Bool -> StateT a m () f &&!= b = f %!= (&& b) f ||!= b = f %!= (|| b) infixr 4 <>!= (<>!=) :: (Monoid o, Monad m) => ASetter' a o -> o -> StateT a m () f <>!= b = f %!= (`mappend` b) lens-family-core-1.2.3/src/Lens/Family/State/Zoom.hs0000644000175000001440000000103113353041217023204 0ustar00roconnorusers00000000000000module Lens.Family.State.Zoom where import Control.Applicative (Applicative, pure, (<*>)) import Control.Monad (liftM) import Data.Monoid (Monoid, mempty, mappend) newtype Zooming m c a = Zooming { unZooming :: m (c, a) } instance Monad m => Functor (Zooming m c) where fmap f (Zooming m) = Zooming (liftM (fmap f) m) instance (Monoid c, Monad m) => Applicative (Zooming m c) where pure a = Zooming (return (mempty, a)) Zooming f <*> Zooming x = Zooming $ do (a, f') <- f (b, x') <- x return (a `mappend` b, f' x') lens-family-core-1.2.3/src/Lens/Family/Unchecked.hs0000644000175000001440000001327313353041217023104 0ustar00roconnorusers00000000000000-- | /Caution/: Improper use of this module can lead to unexpected behaviour if the preconditions of the functions are not met. module Lens.Family.Unchecked ( -- * Lenses -- | A lens family is created by separating a substructure from the rest of its structure by a functor. -- How to create a lens family is best illustrated by the common example of a field of a record: -- -- > data MyRecord a = MyRecord { _myA :: a, _myB :: Int } -- > -- > -- The use of type variables a and a' allow for polymorphic updates. -- > myA :: Functor f => LensLike 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 'LensLike'' type. -- > -- However, the structure of the function is exactly the same as for LensLike. -- > myB :: Functor f => LensLike' 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 'LensLike' and 'LensLike'', 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. -- -- > -- A lens definition that only requires the Haskell "Prelude". -- > myA :: Functor f => (a -> f a') -> (MyRecord a) -> f (MyRecord a') -- > 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 @l :: Functor f => LensLike f a a' b b'@ is well-defined when it satisfies the two van Laarhoven lens laws: -- -- * @l Identity === Identity@ -- -- * @l (Compose . fmap f . g) === Compose . fmap (l f) . (l g)@ -- -- The functions 'lens' and 'iso' can also be used to construct lenses. -- The resulting lenses will be well-defined so long as their preconditions are satisfied. -- * Traversals -- -- | If you have zero or more fields of the same type of a record, a traversal can be used to refer to all of them in order. -- Multiple references are made by replacing the 'Functor' constraint of lenses with an 'Control.Applicative.Applicative' constraint. -- Consider the following example of a record with two 'Int' fields. -- -- > data MyRecord = MyRecord { _myA :: Int, _myB :: Int } -- > -- > -- myInts is a traversal over both fields of MyRecord. -- > myInts :: Applicative f => LensLike' f MyRecord Int -- > myInts f (MyRecord a b) = MyRecord <$> f a <*> f b -- -- If the record and the referenced fields are parametric, you can can build traversals with polymorphic updating. -- Consider the following example of a record with two 'Maybe' fields. -- -- > data MyRecord a = MyRecord { _myA :: Maybe a, _myB :: Maybe a } -- > -- > -- myInts is a traversal over both fields of MyRecord. -- > myMaybes :: Applicative f => LensLike f (MyRecord a) (MyRecord a') (Maybe a) (Maybe a') -- > myMaybes f (MyRecord a b) = MyRecord <$> f a <*> f b -- -- /Note/: As with lenses, is possible to build traversals without even depending on @lens-family-core@ by expanding away the type synonym. -- -- > -- A traversal definition that only requires the Haskell "Prelude". -- > myMaybes :: Applicative f => (Maybe a -> f (Maybe a')) -> MyRecord a -> f (MyRecord a') -- > myMaybes f (MyRecord a b) = MyRecord <$> f a <*> f b -- -- Unfortuantely, there are no helper functions for making traversals. -- You must make them by hand. -- -- Any value @t :: Applicative f => LensLike f a a' b b'@ is well-defined when it satisfies the two van Laarhoven traversal laws: -- -- * @t Identity === Identity@ -- -- * @t (Compose . fmap f . g) === Compose . fmap (t f) . (t g)@ -- -- 'Data.Traversable.traverse' is the canonical traversal for various containers. -- * Documentation lens , iso , setting -- * Types , LensLike, LensLike' , Identical ) where import Control.Applicative (pure) import Lens.Family.Identical (Identical, extract) type LensLike f a a' b b' = (b -> f b') -> (a -> f a') type LensLike' f a b = (b -> f b) -> (a -> f a) lens :: Functor f => (a -> b) -- ^ getter -> (a -> b' -> a') -- ^ setter -> LensLike f a a' b b' -- ^ @ -- lens :: (a -> b) -> (a -> b' -> a') -> Lens 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: -- -- * @getter (setter a b) === b@ -- -- * @setter a (getter a) === a@ -- -- * @setter (setter a b1) b2) === setter a b2@ lens getter setter f a = fmap (setter a) (f (getter a)) iso :: Functor f => (a -> b) -- ^ yin -> (b' -> a') -- ^ yang -> LensLike f a a' b b' -- ^ @ -- iso :: (a -> b) -> (b' -> a') -> Lens a a' b b' -- @ -- -- Build a lens from isomorphism families. -- -- /Caution/: In order for the generated lens family to be well-defined, you must ensure that the two isomorphism laws hold: -- -- * @yin . yang === id@ -- -- * @yang . yin === id@ iso getter setter = lens 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 @over l@ from "Lens.Family". -- -- >>> 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 :: Identical f => ((b -> b') -> a -> a') -- ^ sec (semantic editor combinator) -> LensLike f a a' b b' setting s f = pure . s (extract . f) lens-family-core-1.2.3/src/Lens/Family/Identical.hs0000644000175000001440000000107313353041217023102 0ustar00roconnorusers00000000000000module Lens.Family.Identical where import Control.Applicative.Backwards (Backwards(..)) import Data.Functor.Identity (Identity(..)) import Data.Functor.Compose (Compose(..)) -- It would really be much better if comonads was in tranformers class Applicative f => Identical f where extract :: f a -> a instance Identical Identity where extract (Identity x) = x instance Identical f => Identical (Backwards f) where extract (Backwards x) = extract x instance (Identical f, Identical g) => Identical (Compose f g) where extract (Compose x) = extract (extract x) lens-family-core-1.2.3/Setup.lhs0000644000175000001440000000011713353041217017547 0ustar00roconnorusers00000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain lens-family-core-1.2.3/lens-family-core.cabal0000644000175000001440000000373013353041217022075 0ustar00roconnorusers00000000000000name: lens-family-core category: Data, Lenses version: 1.2.3 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE author: Russell O'Connor maintainer: Russell O'Connor stability: experimental copyright: Copyright (C) 2012,2013,2014,2017 Russell O'Connor synopsis: Haskell 98 Lens Families build-type: Simple extra-source-files: CHANGELOG description: This package provides first class(†) functional references. In addition to the usual operations of getting, setting and composition, plus integration with the state monad, lens families provide some unique features: . * Polymorphic updating . * Traversals . * Cast projection functions to read-only lenses . * Cast \"toList\" functions to read-only traversals . * Cast semantic editor combinators to modify-only traversals. . (†) For optimal first-class support use the @lens-family@ package with rank 2 / rank N polymorphism. "Lens.Family.Clone" allows for first-class support of lenses and traversals for those who require Haskell 98. source-repository head type: darcs location: http://r6.ca/lens-family library build-depends: base >= 4.8 && < 5, containers >= 0.5.8 && < 0.7, transformers >= 0.2.0 && < 0.6 exposed-modules: Lens.Family.Unchecked Lens.Family.Clone Lens.Family Lens.Family.Stock Lens.Family.State.Lazy Lens.Family.State.Strict Lens.Family.State other-modules: Lens.Family.Identical Lens.Family.Phantom Lens.Family.State.Zoom ghc-options: -Wall hs-source-dirs: src lens-family-core-1.2.3/CHANGELOG0000644000175000001440000000306613353041217017157 0ustar00roconnorusers000000000000001.2.3 (Changes from 1.2.2) ========================= * Bump dependency on containers 1.2.2 (Changes from 1.2.1) ========================== * Added strict versions of assignments to Lens.Family.State modules. * Added strict versions of at' and intAt'. * Min dependencies raised to take advantage of adjustF from Data.Map. 1.2.1 (Changes from 1.2.0) ========================= * Bump dependency on transformers 1.2.0 (Changes from 1.1.0) ========================= * Corrected associativity of ^. ^.. and ^? from right to left. 1.1.0 (Changes from 1.0.1) ========================= * Some type synonym definitions have been altered, but should be equivalent. * Removed Getting and Setting functors and instead use the equivalent standard functors Const and Identity. * Renamed Setter to ASetter and generalized Setters to be a LensLike constrained to an "Identical" functor. * Added the (<~) operator. * Corrected the definition of ATraversal' 1.0.1 (Changes from 1.0.0) ========================= * Bump dependency on transformers 1.0.0 (Changes from 0.1.0) ========================= * added support for folds and traversals * renamed all functions to be mostly compatible with the lexicon from lens. 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 * Fixed dependency on mtl lens-family-core-1.2.3/LICENSE0000644000175000001440000000267113353041217016753 0ustar00roconnorusers00000000000000Copyright 2012,2013,2014 Russell O'Connor 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.