lens-family-core 1.2.3 → 2.0.0

raw patch · 11 files changed

+1039/−399 lines, 11 filesdep ~basedep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG +33/−0
• lens-family-core.cabal +25/−14
• src/Lens/Family.hs +259/−94
• src/Lens/Family/Clone.hs +75/−49
• src/Lens/Family/Identical.hs +1/−1
• src/Lens/Family/State.hs +1/−1
• src/Lens/Family/State/Lazy.hs +45/−51
• src/Lens/Family/State/Strict.hs +46/−52
• src/Lens/Family/State/Zoom.hs +1/−3
• src/Lens/Family/Stock.hs +318/−71
• src/Lens/Family/Unchecked.hs +235/−63

@@ -1,3 +1,36 @@+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,41 +1,52 @@ name:               lens-family-core category:           Data, Lenses-version:            1.2.3+version:            2.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,2013,2014,2017 Russell O'Connor-synopsis:           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   build-depends:-    base                 >= 4.8     && < 5,+    base                 >= 4.11    && < 5,     containers           >= 0.5.8   && < 0.7,-    transformers         >= 0.2.0   && < 0.6+    transformers         >= 0.3.0   && < 0.6    exposed-modules:     Lens.Family.Unchecked

@@ -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 --@@ -55,15 +55,78 @@ -- -- 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 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,49 +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+  , AdapterLike, AdapterLike'   , LensLike, LensLike'   , FoldLike, FoldLike'+  , GrateLike, GrateLike'+  , AGrate, AGrate'   , ASetter, ASetter'+  , AResetter, AResetter'+  , PCont+  , First, Last   , Phantom-  , Constant, Identity -- * Re-exports-  , Applicative, Foldable, Monoid-  , Backwards, All, Any, First, Last, Sum, Product+  , Constant, Identity, Prod+  , All, Any, Sum, Product   ) where -import Control.Applicative (Applicative)-import Control.Applicative.Backwards (Backwards(..))-import Data.Foldable (Foldable, traverse_)-import Data.Functor.Identity (Identity(..))+import Data.Foldable (traverse_) import Data.Functor.Constant (Constant(..))-import Data.Monoid ( Monoid, mappend-                   , All(..), Any(..)-                   , First(..), Last(..)+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.Unchecked ( LensLike, LensLike' )+import Lens.Family.Phantom+import Lens.Family.Unchecked -type FoldLike r a a' b b' = LensLike (Constant r) a a' b b'-type FoldLike' r a b = LensLike' (Constant r) a b-type ASetter a a' b b' = LensLike Identity a a' b b'-type ASetter' a b = LensLike' Identity a b+type Prod = Data.Functor.Product.Product+newtype PCont i j a = PCont ((a -> j) -> i) -to :: Phantom f => (a -> b) -> LensLike f a a' b b'+instance Functor (PCont i j) where+  fmap f (PCont h) = PCont $ \k -> h (k . f)++runPCont :: PCont i a a -> i+runPCont (PCont h) = h id++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 => (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.@@ -125,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.@@ -149,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 = 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.@@ -201,42 +283,42 @@ -- 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.@@ -244,104 +326,187 @@  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 = getConstant $ l Constant x+-- Access the monoidal summary referenced by a traversal or a fold.+s^.l = getConstant $ l Constant s  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  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'--- backwards :: Setter a a' b b' -> Setter 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, getters or setters.-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 :: ASetter 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.-(%~) :: ASetter a a' b b' -> (b -> b') -> a -> a'+(%~) :: 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.-(.~) :: ASetter 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 :: ASetter 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 => ASetter' 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 => ASetter' 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 &&~, ||~ -(&&~), (||~) :: ASetter' 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) => ASetter' 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+

@@ -1,119 +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', 'cloneSetter', and 'cloneFold' provides similar functionality for traversals, getters, setters, and folds respectively.+-- '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, cloneSetter, 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, LensLike', FoldLike, FoldLike', ASetter-  , Applicative, Phantom, Identical+  , LensLike, LensLike', GrateLike, GrateLike', FoldLike, FoldLike', AGrate, ASetter, AResetter+  , Phantom, Identical   ) where -import Control.Applicative (Applicative, pure, (<*>), (<$>))-import Lens.Family.Unchecked (Identical, setting)-import Lens.Family ( LensLike, LensLike'-                   , ASetter, over-                   , FoldLike, FoldLike', toListOf, folding-                   , to, view-                   , Phantom-                   )+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 = LensLike' (IStore b b) a 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 = LensLike' (IKleeneStore b b) a 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  -- | Converts a universal setter instance back into a polymorphic setter.-cloneSetter :: Identical f => ASetter a a' b b' -> LensLike f a a' b b'+cloneSetter :: Identical f => ASetter s t a b -> LensLike f s t a b cloneSetter = setting . over --- | AFold a a' b b' is a universal Fold' a a' b b' instance-type AFold a a' b b' = FoldLike [b] a a' b b'+-- | AFold 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' a b is a universal Fold' a b instance-type AFold' a b = FoldLike' [b] 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 = FoldLike' b a 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

@@ -5,7 +5,7 @@ import Data.Functor.Compose (Compose(..))  -- It would really be much better if comonads was in tranformers-class Applicative f => Identical f where+class (Traversable f, Applicative f) => Identical f where   extract :: f a -> a  instance Identical Identity where

@@ -1,4 +1,4 @@-module Lens.Family.State +module Lens.Family.State   ( module Lens.Family.State.Lazy   ) where 

@@ -26,70 +26,64 @@   , FoldLike, Constant   , ASetter, ASetter', Identity   , StateT, Writer-  , Monoid   ) where -import Data.Monoid (Monoid, mappend)-import Data.Tuple (swap) import Control.Monad (liftM) import Control.Monad.Trans.Writer.Lazy (Writer, writer, runWriter) import Control.Monad.Trans.State.Lazy (StateT(..), state, get, modify, modify')-import Lens.Family ( LensLike, LensLike'-                   , FoldLike, Constant-                   , ASetter, ASetter', Identity-                   , view, views, (%~)-                   )-import Lens.Family.State.Zoom (Zooming(..))+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, Monad 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 = views l f `liftM` get@@ -97,36 +91,36 @@ infix 4 %=  -- | Modify a field of the state.-(%=) :: Monad m => ASetter 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 => ASetter 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 => ASetter 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 a a b b' -> StateT a m b' -> StateT a m ()+(<~) :: 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.@@ -134,53 +128,53 @@  infixr 4 +=, -=, *= -(+=), (-=), (*=) :: (Monad m, Num b) => ASetter' a b -> b -> StateT a m ()-f += b = f %= (+ b)-f -= b = f %= subtract b-f *= b = f %= (* b)+(+=), (-=), (*=) :: (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) => ASetter' 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 => ASetter' 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) => ASetter' 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 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)  infixr 4 +!=, -!=, *!= -(+!=), (-!=), (*!=) :: (Monad m, Num b) => ASetter' a b -> b -> StateT a m ()-f +!= b = f %!= (+ b)-f -!= b = f %!= subtract b-f *!= b = f %!= (* b)+(+!=), (-!=), (*!=) :: (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) => ASetter' 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 => ASetter' 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 <>!= -(<>!=) :: (Monoid o, Monad m) => ASetter' 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)

@@ -26,70 +26,64 @@   , FoldLike, Constant   , ASetter, ASetter', Identity   , StateT, Writer-  , Monoid   ) where -import Data.Monoid (Monoid, mappend)-import Data.Tuple (swap) import Control.Monad (liftM)-import Control.Monad.Trans.Writer.Lazy (Writer, writer, runWriter) import Control.Monad.Trans.State.Strict (StateT(..), state, get, modify, modify')-import Lens.Family ( LensLike, LensLike'-                   , FoldLike, Constant-                   , ASetter, ASetter', Identity-                   , view, views, (%~)-                   )-import Lens.Family.State.Zoom (Zooming(..))+import Control.Monad.Trans.Writer.Lazy (Writer, writer, runWriter)+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, Monad 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 = views l f `liftM` get@@ -97,36 +91,36 @@ infix 4 %=  -- | Modify a field of the state.-(%=) :: Monad m => ASetter 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 => ASetter 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 => ASetter 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 a a b b' -> StateT a m b' -> StateT a m ()+(<~) :: 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.@@ -134,53 +128,53 @@  infixr 4 +=, -=, *= -(+=), (-=), (*=) :: (Monad m, Num b) => ASetter' a b -> b -> StateT a m ()-f += b = f %= (+ b)-f -= b = f %= subtract b-f *= b = f %= (* b)+(+=), (-=), (*=) :: (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) => ASetter' 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 => ASetter' 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) => ASetter' 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 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)  infixr 4 +!=, -!=, *!= -(+!=), (-!=), (*!=) :: (Monad m, Num b) => ASetter' a b -> b -> StateT a m ()-f +!= b = f %!= (+ b)-f -!= b = f %!= subtract b-f *!= b = f %!= (* b)+(+!=), (-!=), (*!=) :: (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) => ASetter' 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 => ASetter' 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 <>!= -(<>!=) :: (Monoid o, Monad m) => ASetter' 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)

@@ -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')

@@ -1,83 +1,106 @@--- | 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+    _1, _2   , chosen   , ix   , at, intAt   , at', intAt'   , contains, intContains--- * Stock Traversals+-- * Stock Prisms+  , lft, rgt+  , some, none+-- * Stock Grids   , both-  , _Left, _Right-  , _Just, _Nothing+  , bend, lend+-- * Stock Grates+  , cod+  , both'+  , bend', lend'+-- * Stock Traversals+  , both_+  , bend_, lend_+  , lft_, rgt_+  , some_, none_   , 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, Identical+  , GrateLike, GrateLike'+  , Identical, Backwards+  , FiniteBits   ) where  import Control.Arrow (first, second)-import Control.Applicative (Applicative, pure, (<$>), (<*>))-import Lens.Family (LensLike, LensLike')-import Lens.Family.Unchecked (lens, setting, Identical)-import Lens.Family.Phantom (Phantom, coerce)-import qualified Data.Map as Map+import 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.Map.Strict as Map' import qualified Data.IntMap.Strict as IntMap'-import qualified Data.Set as Set 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 -- ^ @@@ -93,7 +116,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) -- ^ @@@ -143,82 +166,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++lft :: (Applicative f, Traversable g) => AdapterLike f g (Either a r) (Either b r) a b+-- ^ @+-- lft :: Prism (Either a r) (Either b r) a b+-- @+--+-- A prism on the 'Left' element of an 'Either'.+lft f = either (pure . Right) (fmap Left . f) . traverse switch+ where+  switch = either Right Left++lft_ :: Applicative f => LensLike f (Either a r) (Either b r) a b+-- ^ @+-- lft_ :: 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)+--+-- @+-- lft_ = under lft+-- @+lft_ = under lft -_Right :: Applicative f => LensLike f (Either a b) (Either a b') b b'+rgt :: (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'+-- rgt :: Prism (Either r a) (Either r b) a b -- @ --+-- A prism on the 'Right' element of an 'Either'.+rgt f = either (pure . Left) (fmap Right . f) . sequenceA++rgt_ :: Applicative f => LensLike f (Either r a) (Either r b) a b+-- ^ @+-- rgt_ :: 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)+--+-- @+-- rgt_ = under rgt+-- @+rgt_ = under rgt -_Just :: Applicative f => LensLike f (Maybe a) (Maybe a') a a'+some :: (Applicative f, Traversable g) => AdapterLike f g (Maybe a) (Maybe b) a b -- ^ @--- _Just :: Traversal (Maybe a) (Maybe a') a a'+-- some :: Prism (Maybe a) (Maybe b) a b -- @ --+-- A prism on the 'Just' element of a 'Maybe'.+some f = maybe (pure Nothing) (fmap Just . f) . sequenceA++some_ :: Applicative f => LensLike f (Maybe a) (Maybe b) a b+-- ^ @+-- some_ :: 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+some_ = under some -_Nothing :: Applicative f => LensLike' f (Maybe a) ()+none :: (Applicative f, Traversable g) => AdapterLike' f g (Maybe a) () -- ^ @--- _Nothing :: Traversal' (Maybe a) ()+-- none :: Prism' (Maybe a) () -- @ --+-- A prism on the 'Nothing' element of a 'Maybe'.+none = prism (maybe (Right ()) (Left . Just)) (const Nothing)++none_ :: Applicative f => LensLike' f (Maybe a) ()+-- ^ @+-- none_ :: Traversal' (Maybe a) ()+-- @+-- -- Traversal on the 'Nothing' element of a 'Maybe'.-_Nothing f Nothing = const Nothing <$> f ()-_Nothing _ j = pure j+none_ = under none -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 g) => LensLike f (g a) (g a') a a'+mapped :: (Identical f, Functor h) => LensLike f (h a) (h b) a b -- ^ @--- mapped :: Functor g => Setter (g a) (g a') a a'+-- 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))@@ -237,22 +447,59 @@ 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)

@@ -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,69 +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 (Stream a) -> Stream b) -> g a -> 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'+  , GrateLike, GrateLike'   , Identical   ) where -import Control.Applicative (pure)-import Lens.Family.Identical (Identical, extract)+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) +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 @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 :: Identical f-        => ((b -> b') -> a -> a') -- ^ sec (semantic editor combinator)-        -> LensLike f a a' b b'-setting s f = pure . s (extract . 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