packages feed

lens-family-core 1.0.1 → 2.1.3

raw patch · 13 files changed

Files

CHANGELOG view
@@ -1,3 +1,80 @@+2.1.3 (Changes from 2.1.2)+=========================+* Bump dependency on containers.++2.1.2 (Changes from 2.1.0)+==========================+* Bump dependency on transformers.++2.1.0 (Changes from 2.0.0)+==========================+This release makes some minor name changes to functions.++* 'lft' and 'rgt' have been renamed as 'left' and 'right'.+* 'some' and 'none' have been renamed as 'just' and 'nothing'.+* Similar name changes for the lens variants of the above prisms.++The old names are depricated and may be removed in the future.++2.0.0 (Changes from 1.2.4)+==========================+This new release continues to explore the design of Van Laarhoven style+optics with new support for adapters, grates, grids[2], and prisms.++To bring support to these new optics necessarily mean moving a little+further away from syntactic compatibility with Kmett's lens library.+In particular, lens-family's 'under' is unrelated to Kmett's lens+library's 'under' combinator.  Nonetheless the 'under' combinator plays+a crucial role in lens-family as a dual to the 'over' combinator and+this naming is hard to resist despite the conflict.++This new version comes with some minor incompatibilities with the version+1.0 library that may require user updates:++* 'backwards' has moved into the "Stock" module.+* '_Left' and '_Right' have been renamed as 'lft_' and 'rgt_'.+* '_Just' and '_Nothing' have been renamed as 'some_' and 'none_'.+* 'both' has been renamed 'both_'.+* 'beside' has been renamed 'beside_'.+* 'iso' has been removed, however its functionality can be replicated by+  a combination of 'adapter' and 'under'.+* Haskell 98 is no longer supportable.++[1]<https://www.twanvl.nl/blog/haskell/cps-functional-references>+[2]A grid is an optic that is both a grate and a traversal.++1.2.4 (Changes from 1.2.3)+==========================+* Add 'matching' operator+* Correct lower bound on transformers+* Expand Applicative imports to broaden compatability++1.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
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2012 Russell O'Connor+Copyright 2012,2013,2014 Russell O'Connor  All rights reserved.
lens-family-core.cabal view
@@ -1,42 +1,53 @@ name:               lens-family-core category:           Data, Lenses-version:            1.0.1+version:            2.1.3 license:            BSD3-cabal-version:      >= 1.6+cabal-version:      >= 1.10 license-file:       LICENSE author:             Russell O'Connor-maintainer:         Russell O'Connor <roconnor@theorem.ca>+maintainer:         Russell O'Connor <roconnor@r6.ca> stability:          experimental-copyright:          Copyright (C) 2012,2013 Russell O'Connor-synopsis:           Haskell 98 Lens Families-description:        Haskell 98 Lens Families+copyright:          Copyright (C) 2012,2013,2014,2017,2018,2019 Russell O'Connor+synopsis:           Haskell 2022 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:+description:        This package provides first class(†) functional references in Van Laarhoven style supporting the following optics:                     .-                    * Polymorphic updating+                    * Lenses (view, over)                     .-                    * Traversals+                    * Traversals (toListOf, matching, over)                     .-                    * Cast projection functions to read-only lenses+                    * Setters (over)                     .-                    * Cast \"toList\" functions to read-only traversals+                    * Grates (zipWithOf, under, review)                     .-                    * Cast semantic editor combinators to modify-only traversals.+                    * Resetters (under)                     .+                    * Adapters (view, review)+                    .+                    * Grids (toListOf, over / under, review)+                    .+                    * Prisms (matching, over / under, review)+                    .+                    * Getters (view)+                    .+                    * Folders (toListOf)+                    .+                    * Reviewers (review)+                    .                     (†) 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.+                    "Lens.Family.Clone" allows for first-class support of lenses and traversals for those who cannot support rank 2 polymorphism.  source-repository head   type:     darcs-  location: http://r6.ca/lens-family+  location: https://hub.darcs.net/roconnor/lens-family  library+  default-language:   Haskell2010   build-depends:-    base                 >= 4       && < 5,-    containers           >= 0.3     && < 0.6,-    transformers         >= 0.2.0   && < 0.5+    base                 >= 4.11    && < 5,+    containers           >= 0.5.8   && < 0.8,+    transformers         >= 0.3.0   && < 0.7    exposed-modules:     Lens.Family.Unchecked@@ -47,9 +58,9 @@     Lens.Family.State.Strict     Lens.Family.State   other-modules:+    Lens.Family.Identical     Lens.Family.Phantom     Lens.Family.State.Zoom-    Lens.Family.Setting    ghc-options:      -Wall
src/Lens/Family.hs view
@@ -1,5 +1,5 @@ -- | 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.+-- If you are not building your own optics such as lenses, traversals, grates, etc., but just using optics made by others, this is the only module you need. module Lens.Family ( -- * Lenses --@@ -23,7 +23,7 @@ -- @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)@.+-- Lenses have type @'Functor' f => (a -> f a) -> s -> f s@ and lens families have type @'Functor' f => (a i -> f (a j)) -> s i -> f (s j)@. -- -- Keep in mind that lenses and lens families can be used directly for functorial updates. -- For example, @_2 id@ gives you strength.@@ -34,13 +34,13 @@ -- -- > -- | '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)+-- > sharedUpdate :: Eq a => LensLike' Maybe s a -> (a -> a) -> s -> s+-- > sharedUpdate l f s = fromMaybe s (l f' s) -- >  where--- >   f' b | fb == b  = Nothing--- >        | otherwise = Just fb+-- >   f' a | b == a    = Nothing+-- >        | otherwise = Just b -- >    where--- >     fb = f b+-- >     b = f a  -- * Traversals --@@ -48,22 +48,85 @@ -- 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 traverasal.+-- '^?' 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 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.+-- 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.+-- A variant of '^?' call 'matching' returns 'Either' a 'Right' value which is the first value of the traversal, or a 'Left' value which is a "proof" that the traversal has no elements.+-- The "proof" consists of the original input structure, but in the case of polymorphic families, the type parameter is replaced with a fresh type variable, thus proving that the type parameter was unused. --+-- Like all optics, 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)@.+-- Traversals have type @'Applicative' f => (a -> f a) -> s -> f s@ and traversal families have type @'Applicative' f => (a i -> f (a j)) -> s i -> f (s j)@. ----- For stock lenses and traversals, see "Lens.Family.Stock".++-- * Grates ----- To build your own lenses and traversals, see "Lens.Family.Unchecked".+-- | 'zipWithOf' can be used with grates to zip two structure together provided a binary operation. --+-- 'under' can be used to modify each value in a structure according to a function.  This works analogous to how 'over' works for lenses and traversals.+--+-- 'review' can be used with grates to construct a constant grate from a single value.  This is like a 0-ary @zipWith@ function.+--+-- 'degrating' can be used to build higher arity @zipWithOf@ functions:+--+-- > zipWith3Of :: AGrate s t a b -> (a -> a -> a -> b) -> s -> s -> s -> t+-- > zipWith3Of l f s1 s2 s3 = degrating l (\k -> f (k s1) (k s2) (k s3))+--+-- Like all optics, grates can be composed with '.', and 'id' is the identity grate.+--+-- Grates are implemented in van Laarhoven style.+--+-- Grates have type @'Functor' g => (g a -> a) -> g s -> s@ and grate families have type @'Functor' g => (g (a i) -> a j) -> g (s i) -> s j@.+--+-- Keep in mind that grates and grate families can be used directly for functorial zipping.  For example,+--+-- > both sum :: Num a => [(a, a)] -> (a, a)+--+-- will take a list of pairs return the sum of the first components and the sum of the second components.  For another example,+--+-- > cod id :: Functor f => f (r -> a) -> r -> f a+--+-- will turn a functor full of functions into a function returning a functor full of results.++-- * Adapters, Grids, and Prisms+--+-- | The Adapter, Prism, and Grid optics are all 'AdapterLike' optics and typically not used directly, but either converted to a 'LensLike' optic using 'under', or into a 'GrateLike' optic using 'over'.+-- See 'under' and 'over' for details about which conversions are possible.+--+-- These optics are implemented in van Laarhoven style.+--+-- * Adapters have type @('Functor' f, 'Functor' g) => (g a -> f a) -> g s -> f s@ and Adapters families have type @('Functor' f, 'Functor' g) => (g (a i) -> f (a j)) -> g (s i) -> f (s j)@.+--+-- * Grids have type @('Applicative' f, 'Functor' g) => (g a -> f a) -> g s -> f s@ and Grids families have type @('Applicative' f, 'Functor' g) => (g (a i) -> f (a j)) -> g (s i) -> f (s j)@.+--+-- * Prisms have type @('Applicative' f, 'Traversable' g) => (g a -> f a) -> g s -> f s@ and Prisms families have type @('Applicative' f, 'Traversable' g) => (g (a i) -> f (a j)) -> g (s i) -> f (s j)@.+--+-- Keep in mind that these optics and their families can sometimes be used directly, without using 'over' and 'under'.  Sometimes you can take advantage of the fact that+--+-- @+--    LensLike f (g s) t (g a) b+--   ==+--    AdapterLike f g s t a b+--   ==+--    GrateLike g s (f t) a (f b)+-- @+--+-- For example, if you have a grid for your structure to another type that has an @Arbitray@ instance, such as grid from a custom word type to 'Bool', e.g. @myWordBitVector :: (Applicative f, Functor g) => AdapterLike' f g MyWord Bool@, you can use the grid to create an @Arbitrary@ instance for your structure by directly applying 'review':+--+-- > instance Arbitrary MyWord where+-- >   arbitrary = review myWordBitVector arbitrary++-- * Building and Finding Optics+--+-- | To build your own optics, see "Lens.Family.Unchecked".+--+-- For stock optics, see "Lens.Family.Stock".+-- -- References: -- -- * <http://www.twanvl.nl/blog/haskell/cps-functional-references>@@ -73,58 +136,68 @@ -- * <http://comonad.com/reader/2012/mirrored-lenses/> -- -- * <http://conal.net/blog/posts/semantic-editor-combinators>+--+-- * <https://r6research.livejournal.com/28050.html>  -- * Documentation     to, view, (^.)   , folding, views, (^..), (^?)   , toListOf, allOf, anyOf, firstOf, lastOf, sumOf, productOf   , lengthOf, nullOf-  , backwards+  , matching   , over, (%~), set, (.~)+  , review, zipWithOf, degrating+  , under, reset   , (&) -- * Pseudo-imperatives   , (+~), (*~), (-~), (//~), (&&~), (||~), (<>~) -- * Types-  , Setter, Setter'+  , AdapterLike, AdapterLike'   , LensLike, LensLike'   , FoldLike, FoldLike'-  , Getting, Setting+  , GrateLike, GrateLike'+  , AGrate, AGrate'+  , ASetter, ASetter'+  , AResetter, AResetter'+  , PCont+  , First, Last   , Phantom -- * Re-exports-  , Applicative, Foldable, Monoid-  , Backwards, All, Any, First, Last, Sum, Product+  , Constant, Identity, Prod+  , All, Any, Sum, Product   ) where -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(..)+import Data.Foldable (traverse_)+import Data.Functor.Constant (Constant(..))+import Data.Functor.Identity (Identity(..))+import qualified Data.Functor.Product+import Data.Monoid ( All(..), Any(..)                    , Sum(..), Product(..)                    )-import Lens.Family.Phantom (Phantom, coerce)-import Lens.Family.Setting (Setting(..))-import Lens.Family.Unchecked ( LensLike, LensLike'-                             , Setter, Setter')+import Lens.Family.Phantom+import Lens.Family.Unchecked -newtype Getting c a = Getting { unGetting :: c }-instance Functor (Getting c) where-  fmap _ (Getting c) = Getting c+type Prod = Data.Functor.Product.Product+newtype PCont i j a = PCont ((a -> j) -> i) -instance Phantom (Getting c) where-  coerce (Getting c) = Getting c+instance Functor (PCont i j) where+  fmap f (PCont h) = PCont $ \k -> h (k . f) -instance Monoid c => Applicative (Getting c) where-  pure _ = Getting mempty-  Getting a <*> Getting b = Getting (a `mappend` b)+runPCont :: PCont i a a -> i+runPCont (PCont h) = h id -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+type FoldLike r s t a b = LensLike (Constant r) s t a b+type FoldLike' r s a = LensLike' (Constant r) s a+type AGrate s t a b = GrateLike (PCont b a) s t a b+type AGrate' s a = GrateLike' (PCont a a) s a+type ASetter s t a b = LensLike Identity s t a b+type ASetter' s a = LensLike' Identity s a+type AResetter s t a b = GrateLike Identity s t a b+type AResetter' s a = GrateLike' Identity s a -to :: Phantom f => (a -> b) -> LensLike f a a' b b'+to :: Phantom f => (s -> a) -> LensLike f s t a b -- ^ @--- to :: (a -> b) -> Getter a a' b b'+-- to :: (s -> a) -> Getter s t a b -- @ -- -- 'to' promotes a projection function to a read-only lens called a getter.@@ -134,23 +207,23 @@ -- 5.0 :+ 0.0 to p f = coerce . f . p -view :: FoldLike b a a' b b' -> a -> b+view :: FoldLike a s t a b -> s -> a -- ^ @--- view :: Getter a a' b b' -> a -> b+-- view :: Getter s t a b -> s -> a -- @ -- -- Demote a lens or getter to a projection function. -- -- @--- view :: Monoid b => Fold a a' b b' -> a -> b+-- view :: Monoid a => Fold s t a b -> s -> a -- @ -- -- 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 :: (Foldable g, Phantom f, Applicative f) => (s -> g a) -> LensLike f s t a b -- ^ @--- folding :: (a -> [b]) -> Fold a a' b b'+-- folding :: (s -> [a]) -> Fold s t a b -- @ -- -- 'folding' promotes a \"toList\" function to a read-only traversal called a fold.@@ -158,51 +231,51 @@ -- 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 :: FoldLike r s t a b -> (a -> r) -> s -> r -- ^ @--- views :: Monoid r => Fold a a' b b' -> (b -> r) -> a -> r+-- views :: Monoid r => Fold s t a b -> (a -> r) -> s -> 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 :: Getter s t a b -> (a -> r) -> s -> 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 s = f (view l s) -- @-views l f = unGetting . l (Getting . f)+views l f = getConstant . l (Constant . f) -toListOf :: FoldLike [b] a a' b b' -> a -> [b]+toListOf :: FoldLike [a] s t a b -> s -> [a] -- ^ @--- toListOf :: Fold a a' b b' -> a -> [b]+-- toListOf :: Fold s t a b -> s -> [a] -- @ -- -- 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 :: FoldLike All s t a b -> (a -> Bool) -> s -> Bool -- ^ @--- allOf :: Fold a a' b b' -> (b -> Bool) -> a -> Bool+-- allOf :: Fold s t a b -> (a -> Bool) -> s -> 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 :: FoldLike Any s t a b -> (a -> Bool) -> s -> Bool -- ^ @--- anyOf :: Fold a a' b b' -> (b -> Bool) -> a -> Bool+-- anyOf :: Fold s t a b -> (a -> Bool) -> s -> 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 :: FoldLike (First a) s t a b -> s -> Maybe a -- ^ @--- firstOf :: Fold a a' b b' -> a -> Maybe b+-- firstOf :: Fold s t a b -> s -> Maybe a -- @ -- -- Returns 'Just' the first referenced value.@@ -210,146 +283,230 @@ -- 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 :: FoldLike (Last a) s t a b -> s -> Maybe a -- ^ @--- lastOf :: Fold a a' b b' -> a -> Maybe b+-- lastOf :: Fold s t a b -> s -> Maybe a -- @ -- -- 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 a => FoldLike (Sum a) s t a b -> s -> a -- ^ @--- sumOf :: Num b => Fold a a' b b' -> a -> b+-- sumOf :: Num a => Fold s t a b -> s -> a -- @ -- -- 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 a => FoldLike (Product a) s t a b -> s -> a -- ^ @--- productOf :: Num b => Fold a a' b b' -> a -> b+-- productOf :: Num a => Fold s t a b -> s -> a -- @ -- -- 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 => FoldLike (Sum r) s t a b -> s -> r -- ^ @--- lengthOf :: Num r => Fold a a' b b' -> a -> r+-- lengthOf :: Num r => Fold s t a b -> s -> 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 :: FoldLike All s t a b -> s -> Bool -- ^ @--- nullOf :: Fold a a' b b' -> a -> Bool+-- nullOf :: Fold s t a b -> s -> Bool -- @ -- -- Returns true if the number of references in the input is zero.-nullOf l = getAll . views l (const (All False))+nullOf l = allOf l (const False) -infixr 8 ^.+infixl 8 ^. -(^.) :: a -> FoldLike b a a' b b' -> b+(^.) :: s -> FoldLike a s t a b -> a -- ^ @--- (^.) :: a -> Getter a a' b b' -> b+-- (^.) :: s -> Getter s t a b -> a -- @ -- -- Access the value referenced by a getter or lens. -- -- @--- (^.) :: Monoid b => a -> Fold a a' b b' -> b+-- (^.) :: Monoid a => s -> Fold s t a b -> a -- @ ----- Access the monoidal summary referenced by a getter or lens.-x^.l = unGetting $ l Getting x+-- Access the monoidal summary referenced by a traversal or a fold.+s^.l = getConstant $ l Constant s -infixr 8 ^..+infixl 8 ^.. -(^..) :: a -> FoldLike [b] a a' b b' -> [b]+(^..) :: s -> FoldLike [a] s t a b -> [a] -- ^ @--- (^..) :: a -> Getter a a' b b' -> [b]+-- (^..) :: s -> Fold s t a b -> [a] -- @ -- -- Returns a list of all of the referenced values in order.-x^..l = toListOf l x+s^..l = toListOf l s -infixr 8 ^?+infixl 8 ^? -(^?) :: a -> FoldLike (First b) a a' b b' -> Maybe b+(^?) :: s -> FoldLike (First a) s t a b -> Maybe a -- ^ @--- (^?) :: a -> Fold a a' b b' -> Maybe b+-- (^?) :: s -> Fold s t a b -> Maybe a -- @ -- -- Returns 'Just' the first referenced value. -- Returns 'Nothing' if there are no referenced values.-x^?l = firstOf l x+s^?l = firstOf l s -backwards :: LensLike (Backwards f) a a' b b' -> LensLike f a a' b b'+matching :: LensLike (Either a) s t a b -> s -> Either t a -- ^ @--- backwards :: Traversal a a' b b' -> Traversal a a' b b'--- backwards :: Fold a a' b b' -> Fold a a' b b'+-- matching :: Traversal s t a b -> s -> Either t a -- @ ----- Given a traversal or fold, reverse the order that elements are traversed.+-- Returns 'Right' of the first referenced value.+-- Returns 'Left' the original value when there are no referenced values.+-- In case there are no referenced values, the result might have a fresh type parameter, thereby proving the original value had no referenced values.+matching l = either Right Left . l Left++review :: GrateLike (Constant ()) s t a b -> b -> t+-- ^ @+-- review :: Grate s t a b -> b -> t+-- review :: Reviewer s t a b -> b -> t+-- @+review l b = l (const b) (Constant ())++zipWithOf :: GrateLike (Prod Identity Identity) s t a b -> (a -> a -> b) -> s -> s -> t+-- ^ @+-- zipWithOf :: Grate s t a b -> (a -> a -> b) -> s -> s -> t+-- @ --+-- Returns a binary instance of a grate.+-- -- @--- backwards :: Lens a a' b b' -> Lens a a' b b'--- backwards :: Getter a a' b b' -> Getter a a' b b'+-- zipWithOf l f x y = degrating l (\k -> f (k x) (k y)) -- @+zipWithOf l f s1 s2 = l (\(Data.Functor.Product.Pair (Identity a1) (Identity a2)) -> f a1 a2)+                        (Data.Functor.Product.Pair (Identity s1) (Identity s2))++degrating :: AGrate s t a b -> ((s -> a) -> b) -> t+-- ^ @+-- degrating :: Grate s t a b -> ((s -> a) -> b) -> t+-- @ ----- No effect on lenses or getters.-backwards l f = forwards . l (Backwards . f)+-- Demote a grate to its normal, higher-order function, form.+--+-- @+-- degrating . grate = id+-- grate . degrating = id+-- @+degrating l = l runPCont . PCont --- | Demote a setter to a semantic editor combinator.-over :: Setter a a' b b' -> (b -> b') -> a -> a'+under :: AResetter s t a b -> (a -> b) -> s -> t+-- ^ @+-- under :: Resetter s t a b -> (a -> b) -> s -> t+-- @+--+-- Demote a resetter to a semantic editor combinator.+--+-- @+-- under :: Prism s t a b -> Traversal s t a b+-- under :: Grid s t a b -> Traversal s t a b+-- under :: Adapter s t a b -> Lens s t a b+-- @+--+-- Covert an 'AdapterLike' optic into a 'LensLike' optic.+--+-- Note: this function is unrelated to the lens package's @under@ function.+under l f = l (f . runIdentity) . Identity++reset :: AResetter s t a b -> b -> s -> t+-- ^ @+-- reset :: Resetter s t a b -> b -> s -> t+-- @+-- Set all referenced fields to the given value.+reset l b = under l (const b)++over :: ASetter s t a b -> (a -> b) -> s -> t+-- ^ @+-- over :: Setter s t a b -> (a -> b) -> s -> t+-- @+-- Demote a setter to a semantic editor combinator.+--+-- @+-- over :: Prism s t a b -> Reviwer s t a b+-- over :: Grid s t a b -> Grate s t a b+-- over :: Adapter s t a b -> Grate s t a b+-- @+--+-- Covert an 'AdapterLike' optic into a 'GrateLike' optic. over l = (l %~)  infixr 4 %~  -- | Modify all referenced fields.-(%~) :: Setter a a' b b' -> (b -> b') -> a -> a'-l %~ f = unSetting . l (Setting . f)+(%~) :: ASetter s t a b -> (a -> b) -> s -> t+l %~ f = runIdentity . l (Identity . f)  infixr 4 .~  -- | Set all referenced fields to the given value.-(.~) :: Setter a a' b b' -> b' -> a -> a'+(.~) :: ASetter s t a b -> b -> s -> t l .~ b = l %~ const b  -- | Set all referenced fields to the given value.-set :: Setter a a' b b' -> b' -> a -> a'+set :: ASetter s t a b -> b -> s -> t set = (.~)  infixl 1 &  -- | A flipped version of @($)@.-(&) :: a -> (a -> b) -> b+(&) :: s -> (s -> t) -> t (&) = flip ($)  infixr 4 +~, -~, *~ -(+~), (-~), (*~) :: Num b => Setter' a b -> b -> a -> a-f +~ b = f %~ (+ b)-f -~ b = f %~ subtract b-f *~ b = f %~ (* b)+(+~), (-~), (*~) :: Num a => ASetter s t a a -> a -> s -> t+l +~ a = l %~ (+ a)+l -~ a = l %~ subtract a+l *~ a = l %~ (* a)  infixr 4 //~ -(//~) :: Fractional b => Setter' a b -> b -> a -> a-f //~ b = f %~ (/ b)+(//~) :: Fractional a => ASetter s t a a -> a -> s -> t+l //~ a = l %~ (/ a)  infixr 4 &&~, ||~ -(&&~), (||~) :: Setter' a Bool -> Bool -> a -> a-f &&~ b = f %~ (&& b)-f ||~ b = f %~ (|| b)+(&&~), (||~) :: ASetter s t Bool Bool -> Bool -> s -> t+l &&~ a = l %~ (&& a)+l ||~ a = l %~ (|| a)  infixr 4 <>~  -- | Monoidally append a value to all referenced fields.-(<>~) :: (Monoid o) => Setter' a o -> o -> a -> a-f <>~ o = f %~ (`mappend` o)+(<>~) :: (Monoid a) => ASetter s t a a -> a -> s -> t+l <>~ a = l %~ (<> a)++-- Local copies of First and Last to hide it from Data.Moniod's pending deprication+newtype First a = First { getFirst :: Maybe a }+newtype Last a = Last { getLast :: Maybe a }++instance Monoid (First a) where+  mempty = First Nothing+  (First Nothing) `mappend` b = b+  a `mappend` _ = a++instance Monoid (Last a) where+  mempty = Last Nothing+  a `mappend` (Last Nothing) = a+  _ `mappend` b = b++instance Semigroup (First a) where+  (<>) = mappend++instance Semigroup (Last a) where+  (<>) = mappend+
src/Lens/Family/Clone.hs view
@@ -1,112 +1,145 @@--- | This module is provided for Haskell 98 compatibility.+-- | This module is provided for "Haskell 2022" compatibility. -- If you are able to use @Rank2Types@, I advise you to instead use the rank 2 aliases --+-- * @Adapter@, @Adapter'@+--+-- * @Prism@, @Prism'@+-- -- * @Lens@, @Lens'@ -- -- * @Traversal@, @Traversal'@ --+-- * @Setter@, @Setter'@+--+-- * @Grate@, @Grate'@+--+-- * @Resetter@, @Resetter'@+--+-- * @Grid@, @Grid'@+-- -- * @Fold@, @Fold'@ -- -- * @Getter@, @Getter'@ --+-- * @Reviewer@, @Reviewer'@+-- -- 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@).+-- When you require a lens family parameter you use the type @'ALens' s t a b@ (or @'ALens'' s a@). -- Then, inside a @where@ clause, you use 'cloneLens' to create a 'Lens' type. -- -- For example. ----- > example :: ALens a a' b b' -> Example+-- > example :: ALens s t a 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', and 'cloneFold' provides similar functionality for traversals, getters and folds respectively.--- Setters are already monomorphic, so do not need to be cloned.+-- 'cloneAdapter', 'cloneGrate', 'cloneTraversal', 'cloneSetter', 'cloneResetter', 'cloneGetter', and 'cloneFold' provides similar functionality for adapters, grates, traversals, setters, resetters, getters, and folds respectively.  Unfortunately, it is not yet known how to clone prisms and grids. -- -- /Note/: Cloning is only need if you use a functional reference multiple times with different instances. module Lens.Family.Clone-  ( cloneLens, cloneTraversal, cloneGetter, cloneFold+  ( cloneAdapter, cloneLens, cloneGrate, cloneTraversal, cloneSetter, cloneResetter, cloneGetter, cloneFold   -- * Types+  , AnAdapter, AnAdapter'   , ALens, ALens'   , ATraversal, ATraversal'   , AGetter, AGetter'   , AFold, AFold'-  , IStore, IKleeneStore+  , PStore, PKleeneStore   -- * Re-exports-  , LensLike, FoldLike-  , Applicative, Phantom+  , LensLike, LensLike', GrateLike, GrateLike', FoldLike, FoldLike', AGrate, ASetter, AResetter+  , Phantom, Identical   ) where -import Control.Applicative (Applicative, pure, (<*>), (<$>))-import Lens.Family ( LensLike-                   , FoldLike, toListOf, folding-                   , to, view-                   , Phantom-                   )+import Lens.Family.Unchecked+import Lens.Family -data IStore b b' a = IStore (b' -> a) b-instance Functor (IStore b b') where-  fmap f (IStore g b) = IStore (f . g) b+data PStore i j a = PStore (j -> a) i+instance Functor (PStore i j) where+  fmap f (PStore g i) = PStore (f . g) i --- | 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'+-- | AnAdapter s t a b is a universal Adapter s t a b instance+type AnAdapter s t a b = AdapterLike (PStore (s -> a) b) ((->) s) s t a b+-- | AnAdapter' s a is a universal Adapter' s a instance+type AnAdapter' s a = AdapterLike' (PStore (s -> a) a) ((->) s) s a --- | ALens' a b is a universal Lens' a b instance-type ALens' a b = ALens a a b b+-- | Converts a universal adapter instance back into a polymorphic adapter.+cloneAdapter :: (Functor f, Functor g) => AnAdapter s t a b -> AdapterLike f g s t a b+cloneAdapter univ = adapter yin yang+ where+  PStore yang yin = univ (PStore id) id +-- | ALens s t a b is a universal Lens s t a b instance+type ALens s t a b = LensLike (PStore a b) s t a b++-- | ALens' s a is a universal Lens' s a instance+type ALens' s a = LensLike' (PStore a a) s a+ -- | 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)+cloneLens :: Functor f => ALens s t a b -> LensLike f s t a b+cloneLens univ f = experiment f . univ (PStore id) -experiment :: Functor f => (b -> f b') -> IStore b b' a -> f a-experiment f (IStore g b) = g <$> f b+experiment :: Functor f => (a -> f b) -> PStore a b t -> f t+experiment f (PStore g a) = g <$> f a -data IKleeneStore b b' a = Unit a-                         | Battery (IKleeneStore b b' (b' -> a)) b+data PKleeneStore i j a = Unit a+                        | Battery (PKleeneStore i j (j -> a)) i -instance Functor (IKleeneStore b b') where+instance Functor (PKleeneStore i j) where   fmap f (Unit a) = Unit (f a)-  fmap f (Battery g b) = Battery (fmap (f .) g) b+  fmap f (Battery g i) = Battery (fmap (f .) g) i -instance Applicative (IKleeneStore b b') where+instance Applicative (PKleeneStore i j) where   pure = Unit-  Unit f <*> a = fmap f a+  Unit f <*> a = 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 s t a b is a universal Traversal s t a b instance+type ATraversal s t a b = LensLike (PKleeneStore a b) s t a b  -- | ATraversal' a b is a universal Traversal' a b instance-type ATraversal' a b = ALens a a b b+type ATraversal' s a = LensLike' (PKleeneStore a a) s a  -- | 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 :: Applicative f => ATraversal s t a b -> LensLike f s t a b cloneTraversal univ f = research f . univ (Battery (Unit id)) -research :: Applicative f => (b -> f b') -> IKleeneStore b b' a -> f a+research :: Applicative f => (a -> f b) -> PKleeneStore a b t -> f t 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'+-- | Converts a universal setter instance back into a polymorphic setter.+cloneSetter :: Identical f => ASetter s t a b -> LensLike f s t a b+cloneSetter = setting . over --- | AFold' a b is a universal Fold' a b instance-type AFold' a b = AFold a a b b+-- | AFold s t a b is a universal Fold s t a b instance+type AFold s t a b = FoldLike [a] s t a b +-- | AFold' s a is a universal Fold' s a instance+type AFold' s a = FoldLike' [a] s a+ -- | 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 :: (Phantom f, Applicative f) => AFold s t a b -> LensLike f s t a 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'+-- | Converts a universal resetter instance back into a polymorphic resetter.+cloneResetter :: Identical f => AResetter s t a b -> GrateLike f s t a b+cloneResetter = resetting . under --- | AGetter' a b is a universal Fold' a b instance-type AGetter' a b = AGetter a a b b+-- | AGetter s t a b is a universal Getter s t a b instance+type AGetter s t a b = FoldLike a s t a b +-- | AGetter' s a is a universal Getter' s a instance+type AGetter' s a = FoldLike' a s a+ -- | 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 :: Phantom f => AGetter s t a b -> LensLike f s t a b cloneGetter univ = to (view univ)++-- | Converts a universal grate instance back into a polymorphic grater.+cloneGrate :: Functor g => AGrate s t a b -> GrateLike g s t a b+cloneGrate = grate . degrating
+ src/Lens/Family/Identical.hs view
@@ -0,0 +1,18 @@+module 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 (Traversable f, 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)
− src/Lens/Family/Setting.hs 
@@ -1,12 +0,0 @@-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.hs view
@@ -1,4 +1,4 @@-module Lens.Family.State +module Lens.Family.State   ( module Lens.Family.State.Lazy   ) where
src/Lens/Family/State/Lazy.hs view
@@ -7,113 +7,120 @@   , (%=)   , assign, (.=)   , (%%=)+  , (<~) -- * Compound Assignments   , (+=), (-=), (*=)   , (//=)   , (&&=), (||=)   , (<>=)+-- * Strict Assignments+  , (%!=)+  , (+!=), (-!=), (*!=)+  , (//!=)+  , (&&!=), (||!=)+  , (<>!=) -- * Types   , Zooming -- * Re-exports   , LensLike, LensLike'-  , FoldLike-  , Setter, Setter'+  , 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)-import Lens.Family ( LensLike, LensLike'-                   , FoldLike-                   , Setter, Setter'-                   , view, views, (%~)-                   )-import Lens.Family.State.Zoom (Zooming(..))+import Control.Monad.Trans.State.Lazy (StateT(..), state, get, modify, modify')+import Data.Tuple (swap)+import Lens.Family+import Lens.Family.State.Zoom  {- 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 => LensLike' (Zooming m c) s a -> StateT a m c -> StateT s m c -- ^ @--- zoom :: Monad m => Lens' a b -> StateT b m c -> StateT a m c+-- zoom :: Monad m => Lens' s a -> StateT a m c -> StateT s 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, Moand m) => Traversal' a b -> StateT b m c -> StateT a m c+-- zoom :: (Monad m, Monoid c) => Traversal' s a -> StateT a m c -> StateT s 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 ()+-- zoom :: Monad m => Traversal' s a -> StateT a m () -> StateT s 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 => FoldLike a s t a b -> StateT s m a -- ^ @--- use :: Monad m => Getter a a' b b' -> StateT a m b+-- use :: Monad m => Getter s t a b -> StateT s m a -- @ -- -- Retrieve a field of the state -- -- @--- use :: (Monoid b, Monad m) => Fold a a' b b' -> StateT a m b+-- use :: (Monad m, Monoid a) => Fold s t a b -> StateT s m a -- @ -- -- 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 :: Monad m => FoldLike r s t a b -> (a -> r) -> StateT s m r -- ^ @--- uses :: (Monoid r, Monad m) => Fold a a' b b' -> (b -> r) -> StateT a m r+-- uses :: (Monad m, Monoid r) => Fold s t a b -> (a -> r) -> StateT s m r -- @ ----- Retrieve all the referenced fields from the state and foldMap the results together with @f :: b -> r@.+-- Retrieve all the referenced fields from the state and foldMap the results together with @f :: a -> r@. -- -- @--- uses :: Monad m => Getter a a' b b' -> (b -> r) -> StateT a m r+-- uses :: Monad m => Getter s t a b -> (a -> r) -> StateT s m r -- @ ----- Retrieve a field of the state and pass it through the function @f :: b -> r@.+-- Retrieve a field of the state and pass it through the function @f :: a -> r@. ----- @uses l f = f <$> use l@+-- @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 a b b' -> (b -> b') -> StateT a m ()+(%=) :: Monad m => ASetter s s a b -> (a -> b) -> StateT s m () l %= f = modify (l %~ f)  infix 4 .=  -- | Set a field of the state.-(.=) :: Monad m => Setter a a b b' -> b' -> StateT a m ()+(.=) :: Monad m => ASetter s s a b -> b -> StateT s 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 :: Monad m => ASetter s s a b -> b -> StateT s m () assign = (.=) +infixr 2 <~++-- | Set a field of the state using the result of executing a stateful command.+(<~) :: Monad m => ASetter s s a b -> StateT s m b -> StateT s 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 => LensLike (Writer c) s s a b -> (a -> (c, b)) -> StateT s m c -- ^ @--- (%%=) :: Monad m => Lens a a b b' -> (b -> (c, b')) -> StateT a m c+-- (%%=) :: Monad m => Lens s s a b -> (a -> (c, b)) -> StateT s 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+-- (%%=) :: (Monad m, Monoid c) => Traversal s s a b -> (a -> (c, b)) -> StateT s m c -- @ -- -- Modify each field of the state and return the 'mconcat' of the other values.@@ -121,24 +128,53 @@  infixr 4 +=, -=, *= -(+=), (-=), (*=) :: (Monad m, Num b) => Setter' a b -> b -> StateT a m ()-f += b = f %= (+ b)-f -= b = f %= subtract b-f *= b = f %= (* b)+(+=), (-=), (*=) :: (Monad m, Num a) => ASetter' s a -> a -> StateT s m ()+l += a = l %= (+ a)+l -= a = l %= subtract a+l *= a = l %= (* a)  infixr 4 //= -(//=) :: (Monad m, Fractional b) => Setter' a b -> b -> StateT a m ()-f //= b = f %= (/ b)+(//=) :: (Monad m, Fractional a) => ASetter' s a -> a -> StateT s m ()+l //= a = l %= (/ a)  infixr 4 &&=, ||= -(&&=), (||=) :: Monad m => Setter' a Bool -> Bool -> StateT a m ()-f &&= b = f %= (&& b)-f ||= b = f %= (|| b)+(&&=), (||=) :: Monad m => ASetter' s Bool -> Bool -> StateT s m ()+l &&= a = l %= (&& a)+l ||= a = l %= (|| a)  infixr 4 <>=  -- | 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)+(<>=) :: (Monad m, Monoid a) => ASetter' s a -> a -> StateT s m ()+l <>= a = l %= (<> a)++infix 4 %!=++-- | Strictly modify a field of the state.+(%!=) :: Monad m => ASetter s s a b -> (a -> b) -> StateT s m ()+l %!= f = modify' (l %~ f)++infixr 4 +!=, -!=, *!=++(+!=), (-!=), (*!=) :: (Monad m, Num a) => ASetter' s a -> a -> StateT s m ()+l +!= a = l %!= (+ a)+l -!= a = l %!= subtract a+l *!= a = l %!= (* a)++infixr 4 //!=++(//!=) :: (Monad m, Fractional a) => ASetter' s a -> a -> StateT s m ()+l //!= a = l %!= (/ a)++infixr 4 &&!=, ||!=++(&&!=), (||!=) :: Monad m => ASetter' s Bool -> Bool -> StateT s m ()+l &&!= a = l %!= (&& a)+l ||!= a = l %!= (|| a)++infixr 4 <>!=++(<>!=) :: (Monad m, Monoid a) => ASetter' s a -> a -> StateT s m ()+l <>!= a = l %!= (<> a)
src/Lens/Family/State/Strict.hs view
@@ -7,113 +7,120 @@   , (%=)   , assign, (.=)   , (%%=)+  , (<~) -- * Compound Assignments   , (+=), (-=), (*=)   , (//=)   , (&&=), (||=)   , (<>=)+-- * Strict Assignments+  , (%!=)+  , (+!=), (-!=), (*!=)+  , (//!=)+  , (&&!=), (||!=)+  , (<>!=) -- * Types   , Zooming -- * Re-exports   , LensLike, LensLike'-  , FoldLike-  , Setter, Setter'+  , 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.State.Strict (StateT(..), state, get, modify, modify') 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(..))+import Data.Tuple (swap)+import Lens.Family+import Lens.Family.State.Zoom  {- 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 => LensLike' (Zooming m c) s a -> StateT a m c -> StateT s m c -- ^ @--- zoom :: Monad m => Lens' a b -> StateT b m c -> StateT a m c+-- zoom :: Monad m => Lens' s a -> StateT a m c -> StateT s 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, Moand m) => Traversal' a b -> StateT b m c -> StateT a m c+-- zoom :: (Monad m, Monoid c) => Traversal' s a -> StateT a m c -> StateT s 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 ()+-- zoom :: Monad m => Traversal' s a -> StateT a m () -> StateT s 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 => FoldLike a s t a b -> StateT s m a -- ^ @--- use :: Monad m => Getter a a' b b' -> StateT a m b+-- use :: Monad m => Getter s t a b -> StateT s m a -- @ -- -- Retrieve a field of the state -- -- @--- use :: (Monoid b, Monad m) => Fold a a' b b' -> StateT a m b+-- use :: (Monad m, Monoid a) => Fold s t a b -> StateT s m a -- @ -- -- 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 :: Monad m => FoldLike r s t a b -> (a -> r) -> StateT s m r -- ^ @--- uses :: (Monoid r, Monad m) => Fold a a' b b' -> (b -> r) -> StateT a m r+-- uses :: (Monad m, Monoid r) => Fold s t a b -> (a -> r) -> StateT s m r -- @ ----- Retrieve all the referenced fields from the state and foldMap the results together with @f :: b -> r@.+-- Retrieve all the referenced fields from the state and foldMap the results together with @f :: a -> r@. -- -- @--- uses :: Monad m => Getter a a' b b' -> (b -> r) -> StateT a m r+-- uses :: Monad m => Getter s t a b -> (a -> r) -> StateT s m r -- @ ----- Retrieve a field of the state and pass it through the function @f :: b -> r@.+-- Retrieve a field of the state and pass it through the function @f :: a -> r@. ----- @uses l f = f <$> use l@+-- @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 a b b' -> (b -> b') -> StateT a m ()+(%=) :: Monad m => ASetter s s a b -> (a -> b) -> StateT s m () l %= f = modify (l %~ f)  infix 4 .=  -- | Set a field of the state.-(.=) :: Monad m => Setter a a b b' -> b' -> StateT a m ()+(.=) :: Monad m => ASetter s s a b -> b -> StateT s 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 :: Monad m => ASetter s s a b -> b -> StateT s m () assign = (.=) +infixr 2 <~++-- | Set a field of the state using the result of executing a stateful command.+(<~) :: Monad m => ASetter s s a b -> StateT s m b -> StateT s 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 => LensLike (Writer c) s s a b -> (a -> (c, b)) -> StateT s m c -- ^ @--- (%%=) :: Monad m => Lens a a b b' -> (b -> (c, b')) -> StateT a m c+-- (%%=) :: Monad m => Lens s s a b -> (a -> (c, b)) -> StateT s 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+-- (%%=) :: (Monad m, Monoid c) => Traversal s s a b -> (a -> (c, b)) -> StateT s m c -- @ -- -- Modify each field of the state and return the 'mconcat' of the other values.@@ -121,24 +128,53 @@  infixr 4 +=, -=, *= -(+=), (-=), (*=) :: (Monad m, Num b) => Setter' a b -> b -> StateT a m ()-f += b = f %= (+ b)-f -= b = f %= subtract b-f *= b = f %= (* b)+(+=), (-=), (*=) :: (Monad m, Num a) => ASetter' s a -> a -> StateT s m ()+l += a = l %= (+ a)+l -= a = l %= subtract a+l *= a = l %= (* a)  infixr 4 //= -(//=) :: (Monad m, Fractional b) => Setter' a b -> b -> StateT a m ()-f //= b = f %= (/ b)+(//=) :: (Monad m, Fractional a) => ASetter' s a -> a -> StateT s m ()+l //= a = l %= (/ a)  infixr 4 &&=, ||= -(&&=), (||=) :: Monad m => Setter' a Bool -> Bool -> StateT a m ()-f &&= b = f %= (&& b)-f ||= b = f %= (|| b)+(&&=), (||=) :: Monad m => ASetter' s Bool -> Bool -> StateT s m ()+l &&= a = l %= (&& a)+l ||= a = l %= (|| a)  infixr 4 <>=  -- | 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)+(<>=) :: (Monad m, Monoid a) => ASetter' s a -> a -> StateT s m ()+l <>= a = l %= (<> a)++infix 4 %!=++-- | Strictly modify a field of the state.+(%!=) :: Monad m => ASetter s s a b -> (a -> b) -> StateT s m ()+l %!= f = modify' (l %~ f)++infixr 4 +!=, -!=, *!=++(+!=), (-!=), (*!=) :: (Monad m, Num a) => ASetter' s a -> a -> StateT s m ()+l +!= a = l %!= (+ a)+l -!= a = l %!= subtract a+l *!= a = l %!= (* a)++infixr 4 //!=++(//!=) :: (Monad m, Fractional a) => ASetter' s a -> a -> StateT s m ()+l //!= a = l %!= (/ a)++infixr 4 &&!=, ||!=++(&&!=), (||!=) :: Monad m => ASetter' s Bool -> Bool -> StateT s m ()+l &&!= a = l %!= (&& a)+l ||!= a = l %!= (|| a)++infixr 4 <>!=++(<>!=) :: (Monad m, Monoid a) => ASetter' s a -> a -> StateT s m ()+l <>!= a = l %!= (<> a)
src/Lens/Family/State/Zoom.hs view
@@ -1,8 +1,6 @@ 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) } @@ -14,4 +12,4 @@   Zooming f <*> Zooming x = Zooming $ do     (a, f') <- f     (b, x') <- x-    return (a `mappend` b, f' x')+    return (a <> b, f' x')
src/Lens/Family/Stock.hs view
@@ -1,77 +1,111 @@--- | This module contains lenses and traversals for common structures in Haskell.--- It also contains the combinators for lenses and traversals.+-- | This module contains lenses, prisms, grids, grates and traversals for common structures in Haskell.+-- It also contains the combinators for various kinds of optics.+--+-- A Function name with @'@ is a grate variant of a grid, and a function name with @_@ is a traversal variants of a grid or prism.+-- For example, 'both'' is the grate variant of 'both' while 'both_' is the traversal variant. module Lens.Family.Stock (--- * Lens Combinators-    choosing-  , alongside-  , beside -- * Stock Lenses-  , _1, _2, both+    _1, _2   , chosen   , ix   , at, intAt+  , at', intAt'   , contains, intContains+-- * Stock Prisms+  , left, right+  , just, nothing+-- * Stock Grids+  , both+  , bend, lend+-- * Stock Grates+  , cod+  , both'+  , bend', lend' -- * Stock Traversals-  , _Left, _Right-  , _Just, _Nothing+  , both_+  , bend_, lend_+  , left_, right_+  , just_, nothing_   , ignored+-- * Stock SECs+  , mapped+-- * Lens Combinators+  , alongside+  , backwards+  , beside, beside', beside_+  , choosing+  , from -- * Types   , AlongsideLeft, AlongsideRight+  , FromF, FromG -- * Re-exports+  , AdapterLike, AdapterLike'   , LensLike, LensLike'-  , Applicative+  , GrateLike, GrateLike'+  , Identical, Backwards+  , FiniteBits+-- * Deprecated names+  , lft, rgt+  , some, none+  , lft_, rgt_+  , some_, none_   ) where  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 Control.Applicative.Backwards (Backwards(..))+import Control.Applicative (liftA2)+import Data.Bits (FiniteBits, (.|.), bit, finiteBitSize, testBit, zeroBits) import qualified Data.IntMap as IntMap-import qualified Data.Set as Set+import qualified Data.IntMap.Strict as IntMap' import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import qualified Data.Map.Strict as Map'+import Data.Proxy (asProxyTypeOf)+import qualified Data.Set as Set+import Lens.Family+import Lens.Family.Phantom+import Lens.Family.Unchecked -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 :: Functor f => LensLike f s0 t0 a b -> LensLike f s1 t1 a b -> LensLike f (Either s0 s1) (Either t0 t1) a b -- ^ @--- choosing :: Lens a a' c c' -> Lens b b' c c' -> Lens (Either a b) (Either a' b') c c'+-- choosing :: Lens s0 t0 a b -> Lens s1 t1 a b -> Lens (Either s0 s1) (Either t0 t1) a b -- @ -- -- @--- choosing :: Traversal a a' c c' -> Traversal b b' c c' -> Traversal (Either a b) (Either a' b') c c'+-- choosing :: Traversal s0 t0 a b -> Traversal s1 t1 a b -> Traversal (Either s0 s1) (Either t0 t1) a b -- @ -- -- @--- choosing :: Getter a a' c c' -> Getter b b' c c' -> Getter (Either a b) (Either a' b') c c'+-- choosing :: Getter s0 t0 a b -> Getter s1 t1 a b -> Getter (Either s0 s1) (Either t0 t1) a b -- @ -- -- @--- choosing :: Fold a a' c c' -> Fold b b' c c' -> Fold (Either a b) (Either a' b') c c'+-- choosing :: Fold s0 t0 a b -> Fold s1 t1 a b -> Fold (Either s0 s1) (Either t0 t1) a b -- @ -- -- @--- choosing :: Setter a a' c c' -> Setter b b' c c' -> Setter (Either a b) (Either a' b') c c'+-- choosing :: Setter s0 t0 a b -> Setter s1 t1 a b -> Setter (Either s0 s1) (Either t0 t1) a b -- @ -- -- 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+choosing la _  f (Left a)  = Left  <$> la f a+choosing _  lb f (Right b) = Right <$> lb f b -_1 :: Functor f => LensLike f (a, b) (a', b) a a'+_1 :: Functor f => LensLike f (a, r) (b, r) a b -- ^ @--- _1 :: Lens (a, b) (a', b) a a'+-- _1 :: Lens (a, r) (b, r) a b -- @ -- -- Lens on the first element of a pair.-_1 f (a, b) = (\a' -> (a', b)) `fmap` f a+_1 f (a, r) = (\b -> (b, r)) <$> f a -_2 :: Functor f => LensLike f (a, b) (a, b') b b'+_2 :: Functor f => LensLike f (r, a) (r, b) a b -- ^ @--- _2 :: Lens (a, b) (a, b') b b'+-- _2 :: Lens (r, a) (r, b) a b -- @ -- -- Lens on the second element of a pair.-_2 f (a, b) = (\b' -> (a, b')) `fmap` f b+_2 f (r, a) = (\b -> (r, b)) <$> f a  chosen :: Functor f => LensLike f (Either a a) (Either b b) a b -- ^ @@@ -87,7 +121,7 @@ -- @ -- -- 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)+ix k f g = (\v' x -> if (k == x) then v' else g x) <$> f (g k)  at :: (Ord k, Functor f) => k -> LensLike' f (Map.Map k v) (Maybe v) -- ^ @@@ -95,7 +129,7 @@ -- @ -- -- 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))+at = flip Map.alterF  intAt :: Functor f => Int -> LensLike' f (IntMap.IntMap v) (Maybe v) -- ^ @@@ -103,8 +137,24 @@ -- @ -- -- 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))+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@@ -121,74 +171,269 @@ -- 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'+cod :: Functor g => GrateLike g (r -> a) (r -> b) a b -- ^ @--- _Left :: Traversal (Either a b) (Either a' b) a a'+-- cod :: Grate (r -> a) (r -> b) a b -- @ --+-- A grate accessing the codomain of a function.+cod f h r = f $ ($ r) <$> h++left :: (Applicative f, Traversable g) => AdapterLike f g (Either a r) (Either b r) a b+-- ^ @+-- left :: Prism (Either a r) (Either b r) a b+-- @+--+-- A prism on the 'Left' element of an 'Either'.+left f = either (pure . Right) (fmap Left . f) . traverse switch+ where+  switch = either Right Left++left_ :: Applicative f => LensLike f (Either a r) (Either b r) a b+-- ^ @+-- left_ :: Traversal (Either a r) (Either b r) a b+-- @+-- -- Traversal on the 'Left' element of an 'Either'.-_Left f (Left a) = Left <$> f a-_Left _ (Right b) = pure (Right b)+--+-- @+-- left_ = under left+-- @+left_ = under left -_Right :: Applicative f => LensLike f (Either a b) (Either a b') b b'+right :: (Applicative f, Traversable g) => AdapterLike f g (Either r a) (Either r b) a b -- ^ @--- _Right :: Traversal (Either a b) (Either a b') b b'+-- right :: Prism (Either r a) (Either r b) a b -- @ --+-- A prism on the 'Right' element of an 'Either'.+right f = either (pure . Left) (fmap Right . f) . sequenceA++right_ :: Applicative f => LensLike f (Either r a) (Either r b) a b+-- ^ @+-- right_ :: Traversal (Either r a) (Either r b) a b+-- @+-- -- Traversal on the 'Right' element of an 'Either'.-_Right f (Right b) = Right <$> f b-_Right _ (Left a) = pure (Left a)+--+-- @+-- right_ = under right+-- @+right_ = under right -_Just :: Applicative f => LensLike f (Maybe a) (Maybe a') a a'+just :: (Applicative f, Traversable g) => AdapterLike f g (Maybe a) (Maybe b) a b -- ^ @--- _Just :: Traversal (Maybe a) (Maybe a') a a'+-- just :: Prism (Maybe a) (Maybe b) a b -- @ --+-- A prism on the 'Just' element of a 'Maybe'.+just f = maybe (pure Nothing) (fmap Just . f) . sequenceA++just_ :: Applicative f => LensLike f (Maybe a) (Maybe b) a b+-- ^ @+-- just_ :: Traversal (Maybe a) (Maybe b) a b+-- @+-- -- Traversal on the 'Just' element of a 'Maybe'.-_Just f (Just a) = Just <$> f a-_Just _ Nothing = pure Nothing+just_ = under just -_Nothing :: Applicative f => LensLike' f (Maybe a) ()+nothing :: (Applicative f, Traversable g) => AdapterLike' f g (Maybe a) () -- ^ @--- _Nothing :: Traversal' (Maybe a) ()+-- nothing :: Prism' (Maybe a) () -- @ --+-- A prism on the 'Nothing' element of a 'Maybe'.+nothing = prism (maybe (Right ()) (Left . Just)) (const 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+nothing_ = under nothing -both :: Applicative f => LensLike f (a,a) (b,b) a b+both :: (Applicative f, Functor g) => AdapterLike f g (a,a) (b,b) a b -- ^ @--- both :: Traversal (a,a) (b,b) a b+-- both :: Grid (a,a) (b,b) a b -- @ --+-- A grid on both elements of a pair @(a,a)@.+both = beside id id++both' :: Functor g => GrateLike g (a,a) (b,b) a b+-- ^ @+-- both' :: Grate (a,a) (b,b) a b+-- @+--+-- A grate on both elements of a pair @(a,a)@.+--+-- @+-- both' = over both+-- @+both' = beside' id id++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+--+-- @+-- both_ = under both+-- @+both_ = beside_ id id -beside :: Applicative f => LensLike f a a' c c' -> LensLike f b b' c c' -> LensLike f (a,b) (a',b') c c'+lend :: (FiniteBits b, Applicative f, Functor g) => AdapterLike' f g b Bool -- ^ @--- beside :: Traversal a a' c c' -> Traversal b' b' c c' -> Traversal (a,b) (a',b') c c'+-- lend :: FiniteBits b => Grid' b Bool -- @ --+-- A grid from the least significant bit to the most significant bit of a 'FiniteBits' type.+--+-- Little endian order.+lend f s = foldr (liftA2 (.|.)) (pure zeroBits) [mask i <$> f (flip testBit i <$> s) | i <- [0..finiteBitSize b-1]]+ where+  mask i True = bit i+  mask _ False = zeroBits+  b = b `asProxyTypeOf` s++lend' :: (FiniteBits b, Functor g) => GrateLike' g b Bool+-- ^ @+-- lend' :: FiniteBits b => Grate' b Bool -- @--- beside :: Fold a a' c c' -> Fold b' b' c c' -> Fold (a,b) (a',b') c c'+--+-- A grate from the least significant bit to the most significant bit of a 'FiniteBits' type.+--+-- Little endian order.+-- -- @+-- lend' = over lend+-- @+lend' = over lend++lend_ :: (FiniteBits b, Applicative f) => LensLike' f b Bool+-- ^ @+-- lend_ :: FiniteBits b => Traversal' b Bool+-- @ --+-- A traversal from the least significant bit to the most significant bit of a 'FiniteBits' type.+--+-- Little endian order.+-- -- @--- beside :: Setter a a' c c' -> Setter b' b' c c' -> Setter (a,b) (a',b') c c'+-- lend_ = under lend -- @+lend_ = under lend++bend :: (FiniteBits b, Applicative f, Functor g) => AdapterLike' f g b Bool+-- ^ @+-- bend :: FiniteBits b => Grid' b Bool+-- @ --+-- A grid from the most significant bit to the least significant bit of a 'FiniteBits' type.+--+-- Big endian order.+bend = backwards lend++bend' :: (FiniteBits b, Functor g) => GrateLike' g b Bool+-- ^ @+-- bend' :: FiniteBits b => Grate' b Bool+-- @+--+-- A grate from the most significant bit to the least significant bit of a 'FiniteBits' type.+--+-- Big endian order.+--+-- @+-- bend' = over bend+-- @+bend' = over bend++bend_ :: (FiniteBits b, Applicative f) => LensLike' f b Bool+-- ^ @+-- bend_ :: FiniteBits b => Traversal' b Bool+-- @+--+-- A traversal from the most significant bit to the least significant bit of a 'FiniteBits' type.+--+-- Big endian order.+--+-- @+-- bend_ = under bend+-- @+bend_ = under bend++beside :: (Applicative f, Functor g) => AdapterLike f g s0 t0 a b -> AdapterLike f g s1 t1 a b -> AdapterLike f g (s0, s1) (t0, t1) a b+-- ^ @+-- beside :: Grid s1 t1 a b -> Grid s2 t2 a b -> Grid (s1, s2) (t1, t2) a b+-- @+--+-- Given two grids referencing a type 'c', create a grid on the pair referencing 'c'.+beside la lb f s = (,) <$> la f (fst <$> s) <*> lb f (snd <$> s)++beside' :: Functor g => GrateLike g s0 t0 a b -> GrateLike g s1 t1 a b -> GrateLike g (s0, s1) (t0, t1) a b+-- ^ @+-- beside' :: Grate s0 t0 a b -> Grate s1 t1 a b -> Grate (s0, s1) (t0, t1) a b+-- @+--+-- @+-- beside' :: Resetter s0 t0 a b -> Resetter s1 t1 a b -> Resetter (s0, s1) (t0, t1) a b+-- @+--+-- Given two grates\/resetters referencing a type 'c', create a grate\/resetter on the pair referencing 'c'.+beside' la lb = over $ beside (setting la) (setting lb)++beside_ :: Applicative f => LensLike f s0 t0 a b -> LensLike f s1 t1 a b -> LensLike f (s0, s1) (t0, t1) a b+-- ^ @+-- beside_ :: Traversal s0 t0 a b -> Traversal s1 t1 a b -> Traversal (s0, s1) (t0, t1) a b+-- @+--+-- @+-- beside_ :: Fold s0 t0 a b -> Fold s1 t1 a b -> Fold (s0, s1) (t0, t1) a b+-- @+--+-- @+-- beside_ :: Setter s0 t0 a b -> Setter s1 t1 a b -> Setter (s0, s1) (t0, t1) a b+-- @+-- -- 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+beside_ la lb = under $ beside (resetting la) (resetting lb) -ignored :: Applicative f => null -> a -> f a+ignored :: Applicative f => null -> s -> f s -- ^ @--- ignored :: Traversal a a b b'+-- ignored :: Traversal s s a b -- @ -- -- The empty traversal on any type. ignored _ = pure +mapped :: (Identical f, Functor h) => LensLike f (h a) (h b) a b+-- ^ @+-- mapped :: Functor h => Setter (h a) (h b) a b+-- @+--+-- An SEC referencing the parameter of a functor.+mapped = setting fmap++backwards :: LensLike (Backwards f) s t a b -> LensLike f s t a b+-- ^ @+-- backwards :: Traversal s t a b -> Traversal s t a b+-- backwards :: Fold s t a b -> Fold s t a b+-- @+--+-- Given a traversal or fold, reverse the order that elements are traversed.+--+-- @+-- backwards :: Lens s t a b -> Lens s t a b+-- backwards :: Getter s t a b -> Getter s t a b+-- backwards :: Setter s t a b -> Setter s t a b+-- @+--+-- No effect on lenses, getters or setters.+backwards l f = forwards . l (Backwards . f)+ {- Alongside -}  newtype AlongsideLeft f b a = AlongsideLeft (f (a, b))@@ -207,22 +452,91 @@ 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 :: Functor f => LensLike (AlongsideLeft f b1) s0 t0 a0 b0+                       -> LensLike (AlongsideRight f t0) s1 t1 a1 b1+                       -> LensLike f (s0, s1) (t0, t1) (a0, a1) (b0, b1) -- ^ @--- alongside :: Lens a1 a1' b1 b1' -> Lens a2 a2' b2 b2' -> Lens (a1, a2) (a1', a2') (b1, b2) (b1', b2')+-- alongside :: Lens s0 t0 a0 b0 -> Lens s1 t1 a1 b1 -> Lens (s0, s1) (t0, t1) (a0, a1) (b0, b1) -- @ -- -- @--- alongside :: Getter a1 a1' b1 b1' -> Getter a2 a2' b2 b2' -> Getter (a1, a2) (a1', a2') (b1, b2) (b1', b2')+-- alongside :: Getter s0 t0 a0 b0 -> Getter s1 t1 a1 b1 -> Getter (s0, s1) (t0, t1) (a0, a1) (b0, b1) -- @ -- -- Given two lens\/getter families, make a new lens\/getter on their product.-alongside l1 l2 f (a1, a2) = fa1'a2'+alongside l0 l1 f (s0, s1) = ft0t1  where-  AlongsideRight fa1'a2' = l2 f2 a2-  f2 b2 = AlongsideRight fa1'b2'+  AlongsideRight ft0t1 = l1 f1 s1+  f1 a1 = AlongsideRight ft0a1    where-    AlongsideLeft fa1'b2' = l1 f1 a1-    f1 b1 = AlongsideLeft (f (b1, b2))+    AlongsideLeft ft0a1 = l0 f0 s0+    f0 a0 = AlongsideLeft (f (a0, a1))++{- From -}++newtype FromF i j g x = FromF ((g x -> j) -> i)++instance Functor g => Functor (FromF i j g) where+  fmap f (FromF h) = FromF $ \k -> h (k . fmap f)++instance Phantom g => Phantom (FromF i j g) where+  coerce (FromF h) = FromF $ \k -> h (k . coerce)++newtype FromG e f x = FromG (e -> f x)++instance Functor f => Functor (FromG e f) where+  fmap f (FromG h) = FromG $ fmap f . h++instance Phantom g => Phantom (FromG e g) where+  coerce (FromG h) = FromG $ coerce . h++from :: (Functor f, Functor g)+     => AdapterLike (FromF (g s -> f t) (f b) g) (FromG (f b) f) b a t s+     -> AdapterLike f g s t a b+-- ^ @+-- from :: Adapter b a t s -> Adapter s t a b+-- @+--+-- Reverses the direction of an adapter.+--+-- @+-- from :: Getter b a t s -> Reviewer s t a b+-- from :: Reviewer b a t s -> Getter s t a b+-- @+--+-- Changes a Getter into a Reviewer and vice versa.+from l = l'+ where+  FromF l' = l (\(FromG h1) -> FromF $ (.) h1) (FromG id)++{-# DEPRECATED lft "Renamed as 'left'." #-}+lft :: (Applicative f, Traversable g) => AdapterLike f g (Either a r) (Either b r) a b+lft = left++{-# DEPRECATED lft_ "Renamed as 'left_'." #-}+lft_ :: Applicative f => LensLike f (Either a r) (Either b r) a b+lft_ = left_++{-# DEPRECATED rgt "Renamed as 'right'." #-}+rgt :: (Applicative f, Traversable g) => AdapterLike f g (Either r a) (Either r b) a b+rgt = right++{-# DEPRECATED rgt_ "Renamed as 'right_'." #-}+rgt_ :: Applicative f => LensLike f (Either r a) (Either r b) a b+rgt_ = right_++{-# DEPRECATED some "Renamed as 'just'." #-}+some :: (Applicative f, Traversable g) => AdapterLike f g (Maybe a) (Maybe b) a b+some = just++{-# DEPRECATED some_ "Renamed as 'just_'." #-}+some_ :: Applicative f => LensLike f (Maybe a) (Maybe b) a b+some_ = just_++{-# DEPRECATED none "Renamed as 'nothing'." #-}+none :: (Applicative f, Traversable g) => AdapterLike' f g (Maybe a) ()+none = nothing++{-# DEPRECATED none_ "Renamed as 'nothing_'." #-}+none_ :: Applicative f => LensLike' f (Maybe a) ()+none_ = nothing_
src/Lens/Family/Unchecked.hs view
@@ -1,71 +1,84 @@ -- | /Caution/: Improper use of this module can lead to unexpected behaviour if the preconditions of the functions are not met. module Lens.Family.Unchecked (+-- * Adapters+-- | An adapter represents a isomorphism between two types or a parametric isomorphism between two families of types.+-- For example we can build an adapter between the type families @'Either' a a@ and @('Bool', a)@ as follows:+--+-- > timesTwo :: (Functor f, Functor g) => AdapterLike f g (Either a a) (Either b b) (Bool, a) (Bool b)+-- > timesTwo f x = fmap yang . f . fmap yin+-- >  where+-- >   yin (True, a) = Left a+-- >   yin (False, a) = Right a+-- >   yang (Left a) = (True, a)+-- >   yang (Right a) = (False, a)+--+-- /Note/: It is possible to adapters without even depending on @lens-family-core@ by expanding away the type synonym.+--+-- > timesTwo :: (Functor f, Functor g) => (g (Either a a) -> f (Either b b)) -> g (Bool, a) -> f (Bool, b)+--+-- The function 'adapter' can also be used to construct adapters from a pair of mutually inverse functions.+ -- * Lenses--- | A lens family is created by separating a substructure from the rest of its structure by a functor.+-- | A lens focuses on a field of record type.+-- Lenses can be used to get and/or set the focused field. -- 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 }+-- > data MyRecord a = MyRecord { _myA :: a, _myInt :: 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 use of type variables a and b allow for polymorphic updates.+-- > myA :: Functor f => LensLike f (MyRecord a) (MyRecord b) a b+-- > myA f (MyRecord a i) = (\b -> MyRecord b i) <$> f a -- >--- > -- The field _myB is monomorphic, so we can use a 'LensLike''  type.+-- > -- The field _myInt 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)+-- > myInt :: Functor f => LensLike' f (MyRecord a) Int+-- > myInt f (MyRecord a i) = (\i' -> MyRecord a i') <$> f i ----- 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.+-- See the @lens-family-th@ package to generate this sort of 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)+-- > myA :: Functor f => (a -> f b) -> (MyRecord a) -> f (MyRecord b) -- -- 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:+-- Any value @l :: Functor f => LensLike f s t a 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 function 'lens' 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 }+-- > data MyRecord = MyRecord { _myA :: Int, _myB :: Int, _myC :: Bool } -- > -- > -- 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+-- > myInts f (MyRecord a b c) = MyRecord <$> f a <*> f b <*> pure c ----- If the record and the referenced fields are parametric, you can can build traversals with polymorphic updating.+-- If the record and the referenced fields are parametric, you can can build polymrphic traversals. -- Consider the following example of a record with two 'Maybe' fields. ----- > data MyRecord a = MyRecord { _myA :: Maybe a, _myB :: Maybe a }+-- > data MyRecord a = MyRecord { _myA0 :: Maybe a, _myA1 :: Maybe a, myC :: Bool } -- >--- > -- 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+-- > -- myMaybes is a traversal over both fields of MyRecord.+-- > myMaybes :: Applicative f => LensLike f (MyRecord a) (MyRecord b) (Maybe a) (Maybe b)+-- > myMaybes f (MyRecord a0 a1 c) = MyRecord <$> f a0 <*> f a1 <*> pure c ----- /Note/: As with lenses, is possible to build traversals without even depending on @lens-family-core@ by expanding away the type synonym.+-- /Note/: It 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+-- > myMaybes :: Applicative f => (Maybe a -> f (Maybe b)) -> MyRecord a -> f (MyRecord b)+-- > myMaybes f (MyRecord a0 a1 c) = MyRecord <$> f a0 <*> f a1 <*> pure c ----- Unfortuantely, there are no helper functions for making traversals.--- You must make them by hand.+-- Unfortunately, there are no helper functions for making traversals.+-- In most cases, 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:+-- Any value @t :: Applicative f => LensLike f s t a b@ is well-defined when it satisfies the two van Laarhoven traversal laws: -- -- * @t Identity === Identity@ --@@ -73,71 +86,228 @@ -- -- 'Data.Traversable.traverse' is the canonical traversal for various containers. +-- * Prisms+-- | A prism focuses on a single variant of a type.+-- They can be used to 'Lens.Family.matching' / 'Lens.Family.review' the focused variant.+-- Consider the following example.+--+-- > data MySum a = MyA a | MyB Int+-- >+-- > -- myA is a prism for the MyA variant of MySum+-- > myA :: (Applicative f, Traversable g) => AdapterLike f g (MySum a) (MySum b) a b+-- > myA f = either pure (fmap MyA . f) . traverse h+-- >  where+-- >   h (MyA a) = Right a+-- >   h (MyB n) = Left (MyB n)+--+-- This prism can be used with 'Lens.Family.matching' via 'Lens.Family.under':+--+-- @ 'Lens.Family.matching' ('Lens.Family.under' myA) :: MySum a -> Either (MySum b) a @+--+-- This prism can be used with 'Lens.Family.review' via 'Lens.Family.over':+--+-- @ 'Lens.Family.review' ('Lens.Family.over' myA) :: a -> MySum a @+--+-- /Note/: It is possible to build prisms without even depending on @lens-family-core@ by expanding away the type synonym.+--+-- > myA :: (Appicative f, Traversable g) => (g a -> f b) -> g (MySum a) -> f (MySum b)+--+-- You can build prism for more than just constructors of sum types.+-- Any value @p :: (Applicative f, Traversable g) => AdapterLike f g s t a b@ is well-defined when it satisfies the prism laws:+--+-- * @matching (under p) (review (over p) b) === Right b@+--+-- * @(id ||| review (over p)) (matching (under p) s) === s@+--+-- * @left (match (under p)) (matching (under p) s) === left Left (matching (under p) s)@+--+-- The function 'prism' can also be used to construct prisms.+-- The resulting prisms will be well-defined so long as their preconditions are satisfied.++-- * Grates+-- | A grate focuses on the contents of a representable functor.+-- In other words, a grate focuses on the codomain of a function type or something isomorphic to a function type.+-- They are used to lift operations on this codomain to operations on the larger structure via zipping.+-- Consider the following example of a stream of 'Int's.+--+-- > data IntStream = IntStream { hd :: Int, tl :: IntStream }+-- >+-- > -- myInts is a grate over the Ints of IntStream.+-- > myInts :: Functor g => GrateLike' g IntStream Int+-- > myInts f s = IntStream (f (hd <$> s)) (myInts f (tl <$> s))+--+-- If the contents are parametric, you can can build polymorphic grates.+-- Consider the following example of a generic stream.+--+-- > data Stream a = Stream { hd :: a, tl :: Stream a }+-- >+-- > -- myStream is a grate over the contents of a Stream.+-- > myStream :: Functor g => GrateLike g (Stream a) (Stream b) a b+-- > myStream f s = Stream (f (hd <$> s)) (myStream f (tl <$> s))+--+-- /Note/: It is possible to build grates without even depending on @lens-family-core@ by expanding away the type synonym.+--+-- > myStream :: Functor g => (g a -> b) -> g (Stream a) -> Stream b+--+-- Any value @t :: Functor g => GrateLike g s t a b@ is a well-defined grate when it satisfies the two van Laarhoven traversal laws:+--+-- * @t runIdentity === runIdentity@+--+-- * @t (f . fmap g . runCompose) === (t f) . fmap (t g) . runCompose@+--+-- The function 'grate' can also be used to construct grates from graters.+-- The resulting grates will be well-defined so long as the preconditions are satisfied.++-- * Grids+-- | A grid is both a traversal and a grate.+-- When you have a type that is isomorphic to a fixed and finite number of copies of another type, a grid can be used to zip or traverse them.+-- Consider the following example of a record with exactly two 'Int' fields.+--+-- > data MyRecord = MyRecord { _myA :: Int, _myB :: Int }+-- >+-- > -- myInts is a grid over both fields of MyRecord.+-- > myInts :: (Applicative f, Functor g) => AdapterLike' f g MyRecord Int+-- > myInts f r = MyRecord <$> f (_myA <$> r) <*> f (_myB <$> r)+--+-- If the record and the referenced fields are parametric, you can can build polymorphic grids.+-- Consider the following example of a record with exactly two 'Maybe' fields.+--+-- > data MyRecord a = MyRecord { _myA0 :: Maybe a, _myA1 :: Maybe a }+-- >+-- > -- myMaybes is a traversal over both fields of MyRecord.+-- > myMaybes :: (Applicative f, Functor g) => AdapterLike f g (MyRecord a) (MyRecord b) (Maybe a) (Maybe b)+-- > myMaybes f r = MyRecord <$> f (_myA0 <$> r) <*> f (_myA1 <$> r)+--+-- A grid is converted into a grate by using the 'Lens.Family.over' function, and it is converted to a traversal by using the 'Lens.Family.under' function.+--+-- /Note/: It is possible to build grids without even depending on @lens-family-core@ by expanding away the type synonym.+--+-- > myMaybes :: (Applicative f, Functor g) => (g (Maybe a) -> f (Maybe b)) -> g (MyRecord a) -> f (MyRecord b)+--+-- Unfortunately, there are no helper functions for making grids.+-- In most cases, you must make them by hand.+ -- * Documentation-    lens-  , iso+    adapter+  , lens+  , prism+  , grate   , setting+  , resetting -- * Types+  , AdapterLike, AdapterLike'   , LensLike, LensLike'-  , Setter, Setter'-  , Setting+  , GrateLike, GrateLike'+  , Identical   ) where -import Lens.Family.Setting (Setting(..))+import Lens.Family.Identical -type LensLike f a a' b b' = (b -> f b') -> (a -> f a')-type LensLike' f a b = (b -> f b) -> (a -> f a)+type AdapterLike f g s t a b = (g a -> f b) -> (g s -> f t)+type AdapterLike' f g s a = (g a -> f a) -> (g s -> f s)+type LensLike f s t a b = (a -> f b) -> (s -> f t)+type LensLike' f s a = (a -> f a) -> (s -> f s)+type GrateLike g s t a b = (g a -> b) -> (g s -> t)+type GrateLike' g s a = (g a -> a) -> (g s -> s) -type Setter a a' b b' = LensLike Setting a a' b b'-type Setter' a b = Setter a a b b+adapter :: (Functor f, Functor g)+        => (s -> a) -- ^ yin+        -> (b -> t) -- ^ yang+        -> AdapterLike f g s t a b+-- ^ @+-- adapter :: (s -> a) -> (b -> t) -> Adapter s t a b+-- @+--+-- Build an adapter from an isomorphism family.+--+-- /Caution/: In order for the generated adapter family to be well-defined, you must ensure that the two isomorphism laws hold:+--+-- * @yin . yang === id@+--+-- * @yang . yin === id@+adapter yin yang f s = yang <$> f (yin <$> s)  lens :: Functor f-     => (a -> b) -- ^ getter-     -> (a -> b' -> a') -- ^ setter-     -> LensLike f a a' b b'+     => (s -> a) -- ^ getter+     -> (s -> b -> t) -- ^ setter+     -> LensLike f s t a b -- ^ @--- lens :: (a -> b) -> (a -> b' -> a') -> Lens a a' b b'+-- lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b -- @ ----- Build a lens from a @getter@ and @setter@ families.+-- Build a lens from a @getter@ and @setter@ family. -- -- /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@+-- * @getter (setter s a) === a@ ----- * @setter (setter a b1) b2) === setter a b2@-lens getter setter f a = fmap (setter a) (f (getter a))+-- * @setter s (getter s) === s@+--+-- * @setter (setter s a1) a2 === setter s a2@+lens getter setter f s = setter s <$> f (getter s) -iso :: Functor f -    => (a -> b) -- ^ yin-    -> (b' -> a') -- ^ yang-    -> LensLike f a a' b b'+grate :: Functor g+      => (((s -> a) -> b) -> t) -- ^ grater+      -> GrateLike g s t a b -- ^ @--- iso :: (a -> b) -> (b' -> a') -> Lens a a' b b'+-- grate :: (((s -> a) -> b) -> t) -> Grate s t a b -- @ ----- Build a lens from isomorphism families.+-- Build a grate from a @grater@ family. ----- /Caution/: In order for the generated lens family to be well-defined, you must ensure that the two isomorphism laws hold:+-- /Caution/: In order for the generated grate family to be well-defined, you must ensure that the two grater laws hold: ----- * @yin . yang === id@+-- * @grater ($ s) === s@ ----- * @yang . yin === id@-iso getter setter = lens getter (const setter)+-- * @grater (\k -> h (k . grater)) === grater (\k -> h ($ k))@+--+-- Note: The grater laws are that of an algebra for the parameterised continuation monad, `Lens.Family.PCont`.+grate grater f s = grater $ \h -> f (h <$> s) +prism :: (Applicative f, Traversable g)+      => (s -> Either t a) -- ^ matcher+      -> (b -> t) -- ^ reviewer+      -> AdapterLike f g s t a b+-- ^ @+-- prism :: (s -> Either t a) -> (b -> t) -> Prism s t a b+-- @+--+-- Build a prism from a @matcher@ and @reviewer@ family.+--+-- /Caution/: In order for the generated prism family to be well-defined, you must ensure that the three prism laws hold:+--+-- * @matcher (reviewer b) === Right b@+--+-- * @(id ||| reviewer) (matcher s) === s@+--+-- * @left matcher (matcher s) === left Left (matcher s)@+prism matcher reviewer f s = either pure (fmap reviewer . f) $ traverse matcher s+ -- | '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@.+-- 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)]+-- >>> [("The",0),("quick",1),("brown",1),("fox",2)] & setting map . fstL %~ length -- [(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:--- +-- /Caution/: In order for the generated family to be well-defined, you must ensure that the two functors laws hold:+-- -- * @sec id === id@ -- -- * @sec f . sec g === sec (f . g)@-setting :: ((b -> b') -> a -> a') -- ^ sec (semantic editor combinator)-        -> Setter a a' b b'-setting s f = Setting . s (unSetting . f)+setting :: Identical f+        => ((a -> b) -> s -> t) -- ^ sec (semantic editor combinator)+        -> LensLike f s t a b+setting sec f = pure . sec (extract . f)++-- | 'resetting' promotes a \"semantic editor combinator\" to a form of grate that can only lift unary functions.+-- To demote a grate to a semantic edit combinator, use @under l@ from "Lens.Family".+--+-- /Caution/: In order for the generated family to be well-defined, you must ensure that the two functors laws hold:+--+-- * @sec id === id@+--+-- * @sec f . sec g === sec (f . g)@+resetting :: Identical g+        => ((a -> b) -> s -> t) -- ^ sec (semantic editor combinator)+        -> GrateLike g s t a b+resetting sec f = sec (f . pure) . extract