packages feed

lens-family-core 0.1.0 → 1.0.0

raw patch · 12 files changed

+937/−246 lines, 12 files

Files

CHANGELOG view
@@ -1,3 +1,8 @@+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
lens-family-core.cabal view
@@ -1,13 +1,13 @@ name:               lens-family-core category:           Data, Lenses-version:            0.1.0+version:            1.0.0 license:            BSD3 cabal-version:      >= 1.6 license-file:       LICENSE author:             Russell O'Connor maintainer:         Russell O'Connor <roconnor@theorem.ca> stability:          experimental-copyright:          Copyright (C) 2012 Russell O'Connor+copyright:          Copyright (C) 2012,2013 Russell O'Connor synopsis:           Haskell 98 Lens Families description:        Haskell 98 Lens Families build-type:         Simple@@ -17,12 +17,16 @@                     .                     * Polymorphic updating                     .+                    * Traversals+                    .                     * Cast projection functions to read-only lenses                     .-                    * Cast semantic editor combinators to modify-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 for those who require Haskell 98.+                    "Lens.Family.Clone" allows for first-class support of lenses and traversals for those who require Haskell 98.  source-repository head   type:     darcs@@ -43,7 +47,8 @@     Lens.Family.State.Strict     Lens.Family.State   other-modules:-    Lens.Family.State.Focus+    Lens.Family.Phantom+    Lens.Family.State.Zoom     Lens.Family.Setting    ghc-options:      -Wall
src/Lens/Family.hs view
@@ -1,44 +1,69 @@--- | 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.+-- | 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. ----- /Warning/: Lenses are composed in the opposite order than most lens packages.--- Lenses in this library enjoy the following identities.+-- Lens composition in this library enjoys the following identities. ----- * @x ^. l1 . l2 === x ^. l1 ^. l2@+-- * @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@+-- * @x^.id === x@ -- -- * @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')@.+-- The '&' operator, allows for a convenient way to sequence record updating: ----- Remember that lenses and lens families can be used directly for functorial updates.--- For example, @sndL id@ gives you strength.+-- @record & l1 .~ value1 & l2 .~ value2@ ----- > sndL id :: Functor f => (a, f b) -> f (a, b)+-- 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 => Ref Maybe a b -> (b -> b) -> a -> a--- > sharedUpdate lens f a = fromMaybe a (lens f' a)+-- > 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 ----- For stock lenses, see "Lens.Family.Stock".+-- | '^.' 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. ----- To build your own lenses, see "Lens.Family.Unchecked".+-- '^?' can be used to access the first value of a traverasal.+-- '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 traveral, 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: -- -- * <http://www.twanvl.nl/blog/haskell/cps-functional-references>@@ -48,80 +73,283 @@ -- * <http://comonad.com/reader/2012/mirrored-lenses/> -- -- * <http://conal.net/blog/posts/semantic-editor-combinators>-module Lens.Family-  ( getting, project, (^.)-  , sec, (%~), (<~)-  -- * Pseudo-imperatives-  , (+~), (*~), (-~), (/~), (&&~), (||~), (<>~)-  -- * Types-  , GetterFamily, Getter-  , SetterFamily, Setter++-- * Documentation+    to, view, (^.)+  , folding, views, (^..), (^?)+  , toListOf, allOf, anyOf, firstOf, lastOf, sumOf, productOf+  , lengthOf, nullOf+  , backwards+  , over, (%~), set, (.~)+  , (&)+-- * Pseudo-imperatives+  , (+~), (*~), (-~), (//~), (&&~), (||~), (<>~)+-- * Types+  , Setter, Setter'+  , LensLike, LensLike'+  , FoldLike, FoldLike'+  , Getting, Setting+  , Phantom+-- * Re-exports+  , Applicative, Foldable, Monoid+  , Backwards, All, Any, First, Last, Sum, Product   ) where -import Data.Monoid (Monoid, mappend)+import Control.Applicative (Applicative, pure, (<*>))+import Control.Applicative.Backwards (Backwards(..))+import Data.Foldable (Foldable, traverse_)+import Data.Monoid ( Monoid, mempty, mappend+                   , All(..), Any(..)+                   , First(..), Last(..)+                   , Sum(..), Product(..)+                   )+import Lens.Family.Phantom (Phantom, coerce) import Lens.Family.Setting (Setting(..))-import Lens.Family.Unchecked (RefFamily, SetterFamily, Setter)+import Lens.Family.Unchecked ( LensLike, LensLike'+                             , Setter, Setter')  newtype Getting c a = Getting { unGetting :: c } instance Functor (Getting c) where   fmap _ (Getting c) = Getting c -type GetterFamily a a' b b' = RefFamily (Getting b) a a' b b'-type Getter a b = GetterFamily a a b b+instance Phantom (Getting c) where+  coerce (Getting c) = Getting c --- | 'getting' promotes a projection function to a read-only lens.--- To demote a lens to a projection function, use the section @(^. l)@ or @project l@.+instance Monoid c => Applicative (Getting c) where+  pure _ = Getting mempty+  Getting a <*> Getting b = Getting (a `mappend` b)++type FoldLike r a a' b b' = LensLike (Getting r) a a' b b'+type FoldLike' r a b = LensLike (Getting r) a a b b++to :: Phantom f => (a -> b) -> LensLike f a a' b b'+-- ^ @+-- to :: (a -> b) -> Getter a a' b b'+-- @ ----- >>> (3 :+ 4, "example") ^. fstL . getting abs+-- '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-getting :: (a -> b) -> GetterFamily a a' b b'-getting p _ = Getting . p+to p f = coerce . f . p --- | Demote a getter to a projection function.-project :: GetterFamily a a' b b' -> a -> b-project l = (^. l)+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 = unGetting . l (Getting . 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 = getAll . views l (const (All False))+ infixr 8 ^. --- | Access a field.-(^.) :: a -> GetterFamily a a' b b' -> b-x ^. l = unGetting $ l Getting x+(^.) :: 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 = unGetting $ l Getting x +infixr 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++infixr 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'+-- @+--+-- No effect on lenses or getters.+backwards l f = forwards . l (Backwards . f)+ -- | Demote a setter to a semantic editor combinator.-sec :: SetterFamily a a' b b' -> (b -> b') -> a -> a'-sec l = (l %~)+over :: Setter a a' b b' -> (b -> b') -> a -> a'+over l = (l %~)  infixr 4 %~ --- | Modify a field.-(%~) :: SetterFamily a a' b b' -> (b -> b') -> a -> a'+-- | Modify all referenced fields.+(%~) :: Setter 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+-- | Set all referenced fields to the given value.+(.~) :: Setter a a' b b' -> b' -> a -> a'+l .~ b = l %~ const b +-- | Set all referenced fields to the given value.+set :: Setter a a' b b' -> b' -> a -> a'+set = (.~)++infixl 1 &++-- | A flipped version of @($)@.+(&) :: a -> (a -> b) -> b+(&) = flip ($)+ infixr 4 +~, -~, *~ -(+~), (-~), (*~) :: Num b => Setter a b -> b -> a -> a+(+~), (-~), (*~) :: 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 &&~, ||~ -(&&~), (||~) :: Setter a Bool -> Bool -> a -> a+(&&~), (||~) :: Setter' a Bool -> Bool -> a -> a f &&~ b = f %~ (&& b) f ||~ b = f %~ (|| b)  infixr 4 <>~ -(<>~) :: (Monoid o) => Setter a o -> o -> a -> a+-- | Monoidally append a value to all referenced fields.+(<>~) :: (Monoid o) => Setter' a o -> o -> a -> a f <>~ o = f %~ (`mappend` o)
src/Lens/Family/Clone.hs view
@@ -1,39 +1,112 @@--- | This module is only provided for Haskell 98 compatibility.--- If you are able to use @Rank2Types@, I strongly advise you to instead use 'Lens.Family2.Stock.LensFamily' and 'Lens.Family2.Stock.Lens' from the lens-family package instead.--- --- 'clone' 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 @'ClonerFamily' a a' b b'@ (or @'Cloner' a b@).--- Then, inside a @where@ clause, you use 'clone' to create a 'LensFamily' type.+-- | 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'@+--+-- * @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 :: ClonerFamily a a' b b' -> Example--- > example l = ... x ^. cl ... cl ^= y ...+-- > example :: ALens a a' b b' -> Example+-- > example l = ... x^.cl ... cl .~ y ... -- >  where--- >   cl x = clone l x+-- >   cl x = cloneLens l x -- -- /Note/: It is important to eta-expand the definition of 'cl' to avoid the dreaded monomorphism restriction. ----- /Note/: Cloning is only need if you use both @Getter@s and @Setter@s in the function.--- Otherwise you only need to use the monomorphic 'Lens.Family.GetterFamily' \/ 'Lens.Family.Getter' or 'Lens.Family.SetterFamily' \/ 'Lens.Family.Setter'.+-- 'cloneTraversal', 'cloneGetter', and 'cloneFold' provides similar functionality for traversals, getters and folds respectively.+-- Setters are already monomorphic, so do not need to be cloned.+--+-- /Note/: Cloning is only need if you use a functional reference multiple times with different instances. module Lens.Family.Clone-  ( clone+  ( cloneLens, cloneTraversal, cloneGetter, cloneFold   -- * Types-  , RefFamily-  , ClonerFamily, Cloner+  , ALens, ALens'+  , ATraversal, ATraversal'+  , AGetter, AGetter'+  , AFold, AFold'+  , IStore, IKleeneStore+  -- * Re-exports+  , LensLike, FoldLike+  , Applicative, Phantom   ) where -import Lens.Family.Unchecked (RefFamily)+import Control.Applicative (Applicative, pure, (<*>), (<$>))+import Lens.Family ( LensLike+                   , FoldLike, toListOf, folding+                   , to, view+                   , Phantom+                   ) -data Cloning b' b a = Cloning (b' -> a) b-instance Functor (Cloning b' b) where-  fmap f (Cloning g b) = Cloning (f . g) b+data IStore b b' a = IStore (b' -> a) b+instance Functor (IStore b b') where+  fmap f (IStore g b) = IStore (f . g) b -type ClonerFamily a a' b b' = RefFamily (Cloning b' b) a a' b b'-type Cloner a b = ClonerFamily a a b 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 = ALens a a b b+ -- | Converts a universal lens instance back into a polymorphic lens.-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+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 = ALens a a b 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++-- | 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 = AFold a a b 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 = AGetter a a b 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)
+ src/Lens/Family/Phantom.hs view
@@ -0,0 +1,21 @@+module 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)
src/Lens/Family/Setting.hs view
@@ -1,5 +1,12 @@ module Lens.Family.Setting where +import Control.Applicative (Applicative, pure, (<*>))+ newtype Setting a = Setting { unSetting :: a }+ instance Functor Setting where   fmap f (Setting a) = Setting (f a)++instance Applicative Setting where+  pure = Setting+  Setting f <*> Setting a = Setting (f a)
− src/Lens/Family/State/Focus.hs 
@@ -1,10 +0,0 @@-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)
src/Lens/Family/State/Lazy.hs view
@@ -1,76 +1,144 @@ -- | Lenses allow you to use fields of the state of a state monad as if they were variables in an imperative language.--- 'access' is used to retrieve the value of a variable, and '~=' and '%=' allow you to set and modify a variable.+-- '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 -  ( focus-  , access+module Lens.Family.State.Lazy+  ( zoom+  , use, uses   , (%=)-  , (~=)+  , assign, (.=)   , (%%=)-  -- * Compound Assignments+-- * Compound Assignments   , (+=), (-=), (*=)   , (//=)   , (&&=), (||=)   , (<>=)-  -- * Types-  , Focusing+-- * Types+  , Zooming+-- * Re-exports+  , LensLike, LensLike'+  , FoldLike+  , Setter, Setter'+  , StateT, Writer+  , Monoid   ) where  import Data.Monoid (Monoid, mappend)+import Data.Tuple (swap) import Control.Monad (liftM)-import Control.Monad.Trans.State.Lazy (StateT(..), get, modify)-import Lens.Family (Getter, Setter, (^.), (%~))-import Lens.Family.Stock (Ref)-import Lens.Family.State.Focus (Focusing(..))+import Control.Monad.Trans.Writer.Lazy (Writer, writer, runWriter)+import Control.Monad.Trans.State.Lazy (StateT(..), state, get, modify)+import Lens.Family ( LensLike, LensLike'+                   , FoldLike+                   , Setter, Setter'+                   , view, views, (%~)+                   )+import Lens.Family.State.Zoom (Zooming(..)) -{- all these Monad constraints could be weakened to Functor constraints -}+{- all these Monad constraints could be weakened to Functor or Applicative constraints -} --- | Lift a stateful operation on a field to a stateful operation on the whole state.+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.-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))+--+-- @+-- zoom :: (Monoid c, Moand 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)) --- | Retrieve a field of the state-access :: Monad m => Getter a b -> StateT a m b-access l = (^. l) `liftM` get+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 => Setter a b -> (b -> b) -> StateT a m ()+-- | Modify a field of the state.+(%=) :: Monad m => Setter a a b b' -> (b -> b') -> StateT a m () l %= f = modify (l %~ f) -infix 4 ~=+infix 4 .= --- | Set a field of the state-(~=) :: Monad m => Setter a b -> b -> StateT a m ()-l ~= v = l %= const v+-- | Set a field of the state.+(.=) :: Monad m => Setter a a b b' -> b' -> StateT a m ()+l .= v = l %= const v +-- | Set a field of the state.+assign :: Monad m => Setter a a b b' -> b' -> StateT a m ()+assign = (.=)+ infix 4 %%= --- | Modify a field of the state while returning another value-(%%=) :: Monad m => Ref (Focusing m c) a b -> (b -> (c, b)) -> StateT a m c-l %%= f = focus l (StateT (return . f))+(%%=) :: 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) => Setter a b -> b -> StateT a m ()+(+=), (-=), (*=) :: (Monad m, Num b) => Setter' 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) => Setter a b -> b -> StateT a m ()+(//=) :: (Monad m, Fractional b) => Setter' a b -> b -> StateT a m () f //= b = f %= (/ b)  infixr 4 &&=, ||= -(&&=), (||=) :: Monad m => Setter a Bool -> Bool -> StateT a m ()+(&&=), (||=) :: 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 ()+-- | Monoidally append a value to all referenced fields of the state.+(<>=) :: (Monoid o, Monad m) => Setter' a o -> o -> StateT a m () f <>= b = f %= (`mappend` b)
src/Lens/Family/State/Strict.hs view
@@ -1,76 +1,144 @@ -- | Lenses allow you to use fields of the state of a state monad as if they were variables in an imperative language.--- 'access' is used to retrieve the value of a variable, and '~=' and '%=' allow you to set and modify a variable.+-- '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 -  ( focus-  , access+module Lens.Family.State.Strict+  ( zoom+  , use, uses   , (%=)-  , (~=)+  , assign, (.=)   , (%%=)-  -- * Compound Assignments+-- * Compound Assignments   , (+=), (-=), (*=)   , (//=)   , (&&=), (||=)   , (<>=)-  -- * Types-  , Focusing+-- * Types+  , Zooming+-- * Re-exports+  , LensLike, LensLike'+  , FoldLike+  , Setter, Setter'+  , StateT, Writer+  , Monoid   ) where  import Data.Monoid (Monoid, mappend)+import Data.Tuple (swap) import Control.Monad (liftM)-import Control.Monad.Trans.State.Strict (StateT(..), get, modify)-import Lens.Family (Getter, Setter, (^.), (%~))-import Lens.Family.Stock (Ref)-import Lens.Family.State.Focus (Focusing(..))+import Control.Monad.Trans.Writer.Lazy (Writer, writer, runWriter)+import Control.Monad.Trans.State.Strict (StateT(..), state, get, modify)+import Lens.Family ( LensLike, LensLike'+                   , FoldLike+                   , Setter, Setter'+                   , view, views, (%~)+                   )+import Lens.Family.State.Zoom (Zooming(..)) -{- all these Monad constraints could be weakened to Functor constraints -}+{- all these Monad constraints could be weakened to Functor or Applicative constraints -} --- | Lift a stateful operation on a field to a stateful operation on the whole state.+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.-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))+--+-- @+-- zoom :: (Monoid c, Moand 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)) --- | Retrieve a field of the state-access :: Monad m => Getter a b -> StateT a m b-access l = (^. l) `liftM` get+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 => Setter a b -> (b -> b) -> StateT a m ()+-- | Modify a field of the state.+(%=) :: Monad m => Setter a a b b' -> (b -> b') -> StateT a m () l %= f = modify (l %~ f) -infix 4 ~=+infix 4 .= --- | Set a field of the state-(~=) :: Monad m => Setter a b -> b -> StateT a m ()-l ~= v = l %= const v+-- | Set a field of the state.+(.=) :: Monad m => Setter a a b b' -> b' -> StateT a m ()+l .= v = l %= const v +-- | Set a field of the state.+assign :: Monad m => Setter a a b b' -> b' -> StateT a m ()+assign = (.=)+ infix 4 %%= --- | Modify a field of the state while returning another value-(%%=) :: Monad m => Ref (Focusing m c) a b -> (b -> (c, b)) -> StateT a m c-l %%= f = focus l (StateT (return . f))+(%%=) :: 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) => Setter a b -> b -> StateT a m ()+(+=), (-=), (*=) :: (Monad m, Num b) => Setter' 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) => Setter a b -> b -> StateT a m ()+(//=) :: (Monad m, Fractional b) => Setter' a b -> b -> StateT a m () f //= b = f %= (/ b)  infixr 4 &&=, ||= -(&&=), (||=) :: Monad m => Setter a Bool -> Bool -> StateT a m ()+(&&=), (||=) :: 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 ()+-- | Monoidally append a value to all referenced fields of the state.+(<>=) :: (Monoid o, Monad m) => Setter' a o -> o -> StateT a m () f <>= b = f %= (`mappend` b)
+ src/Lens/Family/State/Zoom.hs view
@@ -0,0 +1,17 @@+module 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')
src/Lens/Family/Stock.hs view
@@ -1,63 +1,228 @@--- | This module contains lenses for common structures in Haskell.--- It also contains the lens combinators 'mergeL' and '***'.-module Lens.Family.Stock-  ( -- * Lens Combinators-    mergeL-  , (***)-  -- * Stock Lenses-  , fstL, sndL-  , funL-  , mapL, intMapL-  , setL, intSetL-  -- * Types-  , RefFamily, Ref+-- | 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, both+  , chosen+  , ix+  , at, intAt+  , contains, intContains+-- * Stock Traversals+  , _Left, _Right+  , _Just, _Nothing+  , ignored+-- * Types+  , AlongsideLeft, AlongsideRight+-- * Re-exports+  , LensLike, LensLike'+  , Applicative   ) where -import Lens.Family.Unchecked (RefFamily, Ref, mkLens)-import Lens.Family ((^.), (<~))-import Lens.Family.Clone (ClonerFamily, clone)+import Control.Arrow (first, second)+import Control.Applicative (Applicative, pure, (<$>), (<*>))+import Lens.Family (LensLike, LensLike')+import Lens.Family.Unchecked (lens)+import Lens.Family.Phantom (Phantom, coerce) import qualified Data.Map as Map import qualified Data.IntMap as IntMap import qualified Data.Set as Set 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 => 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+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 --- 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' -> 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+_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 --- | Lens on the first element of a pair.-fstL :: Functor f => RefFamily f (a, b) (a', b) a a'-fstL 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 --- | Lens on the second element of a pair.-sndL :: Functor f => RefFamily f (a, b) (a, b') b b'-sndL 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 --- | Lens on a given point of a function.-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)+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) --- | Lens on a given point of a 'Map.Map'.-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))+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 k = lens (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 -> 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))+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 k = lens (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 -> 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)+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) --- | Lens on a given point of a 'IntSet.IntSet'.-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)+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++{- 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))
src/Lens/Family/Unchecked.hs view
@@ -1,21 +1,22 @@ -- | /Caution/: Improper use of this module can lead to unexpected behaviour if the preconditions of the functions are not met.--- --- A lens family is created by separating a substructure from the rest of its structure by a functor.+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 => RefFamily f (MyRecord a) (MyRecord a') a a'+-- > 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 plain Ref type.--- > -- However, the structure of the function is exactly the same as for RefFamily.--- > myB :: Functor f => Ref f (MyRecord a) Int+-- > -- 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 'RefFamily' and 'Ref', and even they are optional.+-- 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.@@ -25,38 +26,81 @@ -- > 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 => RefFamily f a a' b b'@ is well-defined when it satisfies the two van Laarhoven lens laws:+-- Any value @l :: Functor f => LensLike f a a' b b'@ is well-defined when it satisfies the two van Laarhoven lens laws: ----- * @lens Identity === Identity@+-- * @l Identity === Identity@ ----- * @--- lens (composeCoalgebroid f g) === composeCoalgebroid (lens f) (lens g)---  where---   composeCoalgebroid :: (Functor f, Functor g) => (b -> f c) -> (a -> g b) -> a -> (Compose g f) c---   composeCoalgebroid f g a = Compose $ f \`fmap\` g a === id--- @+-- * @l (Compose . fmap f . g) === Compose . fmap (l f) . (l g)@ ----- The functions 'mkLens' and 'mkIsoLens' can also be used to construct lenses.+-- 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.-module Lens.Family.Unchecked -  ( mkLens-  , mkIsoLens-  , Setting, setting-  -- * Types-  , RefFamily, Ref-  , SetterFamily, Setter++-- * 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'+  , Setter, Setter'+  , Setting   ) where  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+type LensLike f a a' b b' = (b -> f b') -> (a -> f a')+type LensLike' f a b = (b -> f b) -> (a -> f a) --- | Build a lens from a @getter@ and @setter@ families.+type Setter a a' b b' = LensLike Setting a a' b b'+type Setter' a b = Setter a a b b++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@@@ -64,24 +108,24 @@ -- * @setter a (getter a) === a@ -- -- * @setter (setter a b1) b2) === setter a b2@-mkLens :: Functor f-       => (a -> b) -- ^ getter-       -> (a -> b' -> a') -- ^ setter-       -> RefFamily f a a' b b'-mkLens getter setter f a = fmap (setter a) (f (getter a))+lens getter setter f a = fmap (setter a) (f (getter a)) --- | Build a lens from isomorphism families.+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@-mkIsoLens :: Functor f -          => (a -> b) -- ^ yin-          -> (b' -> a') -- ^ yang-          -> RefFamily f a a' b b'-mkIsoLens getter setter = mkLens getter (const setter)+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 @sec l@.@@ -95,5 +139,5 @@ -- -- * @sec f . sec g === sec (f . g)@ setting :: ((b -> b') -> a -> a') -- ^ sec (semantic editor combinator)-        -> SetterFamily a a' b b'+        -> Setter a a' b b' setting s f = Setting . s (unSetting . f)