{-# LANGUAGE Rank2Types #-} -- | /Caution/: Improper use of this module can lead to unexpected behaviour if the preconditions of the functions are not met. module Lens.Family2.Unchecked ( -- * Lenses -- | A lens family is created by separating a substructure from the rest of its structure by a functor. -- How to create a lens family is best illustrated by the common example of a field of a record: -- -- > data MyRecord a = MyRecord { _myA :: a, _myB :: Int } -- > -- > -- The use of type variables a and a' allow for polymorphic updates. -- > myA :: Lens (MyRecord a) (MyRecord a') a a' -- > myA f (MyRecord a b) = (\a' -> MyRecord a' b) `fmap` (f a) -- > -- > -- The field _myB is monomorphic, so we can use a 'Lens'' type. -- > -- However, the structure of the function is exactly the same as for Lens. -- > myB :: Lens' (MyRecord a) Int -- > myB f (MyRecord a b) = (\b' -> MyRecord a b') `fmap` (f b) -- -- By following this template you can safely build your own lenses. -- To use this template, you do not need anything from this module other than the type synonyms 'Lens' and 'Lens'', and even they are optional. -- See the @lens-family-th@ package to generate this code using Template Haskell. -- -- /Note/: It is possible to build lenses without even depending on @lens-family@ by expanding away the type synonym. -- -- > -- A lens definition that only requires the Haskell "Prelude". -- > myA :: Functor f => (a -> f a') -> (MyRecord a) -> f (MyRecord a') -- > myA f (MyRecord a b) = (\a' -> MyRecord a' b) `fmap` (f a) -- -- You can build lenses for more than just fields of records. -- Any value @l :: Lens a a' b b'@ is well-defined when it satisfies the two van Laarhoven lens laws: -- -- * @l Identity === Identity@ -- -- * @l (Compose . fmap f . g) === Compose . fmap (l f) . (l g)@ -- -- The functions 'lens' and 'iso' can also be used to construct lenses. -- The resulting lenses will be well-defined so long as their preconditions are satisfied. -- * Traversals -- -- | If you have zero or more fields of the same type of a record, a traversal can be used to refer to all of them in order. -- Multiple references are made by replacing the 'Functor' constraint of lenses with an 'Control.Applicative.Applicative' constraint. -- Consider the following example of a record with two 'Int' fields. -- -- > data MyRecord = MyRecord { _myA :: Int, _myB :: Int } -- > -- > -- myInts is a traversal over both fields of MyRecord. -- > myInts :: Traversal' MyRecord Int -- > myInts f (MyRecord a b) = MyRecord <$> f a <*> f b -- -- If the record and the referenced fields are parametric, you can can build traversals with polymorphic updating. -- Consider the following example of a record with two 'Maybe' fields. -- -- > data MyRecord a = MyRecord { _myA :: Maybe a, _myB :: Maybe a } -- > -- > -- myInts is a traversal over both fields of MyRecord. -- > myMaybes :: Traversal (MyRecord a) (MyRecord a') (Maybe a) (Maybe a') -- > myMaybes f (MyRecord a b) = MyRecord <$> f a <*> f b -- -- /Note/: As with lenses, is possible to build traversals without even depending on @lens-family-core@ by expanding away the type synonym. -- -- > -- A traversal definition that only requires the Haskell "Prelude". -- > myMaybes :: Applicative f => (Maybe a -> f (Maybe a')) -> MyRecord a -> f (MyRecord a') -- > myMaybes f (MyRecord a b) = MyRecord <$> f a <*> f b -- -- Unfortuantely, there are no helper functions for making traversals. -- You must make them by hand. -- -- Any value @t :: Traversal a a' b b'@ is well-defined when it satisfies the two van Laarhoven traversal laws: -- -- * @t Identity === Identity@ -- -- * @t (Compose . fmap f . g) === Compose . fmap (t f) . (t g)@ -- -- 'Data.Traversable.traverse' is the canonical traversal for various containers. -- * Documentation lens , iso , setting -- * Types , Lens, Lens' , Traversal, Traversal' , Setter, Setter' , LF.LensLike, LF.LensLike' , LF.Identical -- * Re-exports , Applicative ) where import Control.Applicative (Applicative) import qualified Lens.Family.Unchecked as LF type Lens a a' b b' = forall f. Functor f => LF.LensLike f a a' b b' type Lens' a b = forall f. Functor f => LF.LensLike' f a b type Traversal a a' b b' = forall f. Applicative f => LF.LensLike f a a' b b' type Traversal' a b = forall f. Applicative f => LF.LensLike' f a b type Setter a a' b b' = forall f. LF.Identical f => LF.LensLike f a a' b b' type Setter' a b = forall f. LF.Identical f => LF.LensLike' f a b -- | Build a lens from a @getter@ and @setter@ families. -- -- /Caution/: In order for the generated lens family to be well-defined, you must ensure that the three lens laws hold: -- -- * @getter (setter a b) === b@ -- -- * @setter a (getter a) === a@ -- -- * @setter (setter a b1) b2) === setter a b2@ lens :: (a -> b) -- ^ getter -> (a -> b' -> a') -- ^ setter -> Lens a a' b b' lens = LF.lens -- | Build a lens from isomorphism families. -- -- /Caution/: In order for the generated lens family to be well-defined, you must ensure that the two isomorphism laws hold: -- -- * @yin . yang === id@ -- -- * @yang . yin === id@ iso :: (a -> b) -- ^ yin -> (b' -> a') -- ^ yang -> Lens a a' b b' iso = LF.iso -- | '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.Family2". -- -- >>> setting map . fstL %~ length $ [("The",0),("quick",1),("brown",1),("fox",2)] -- [(3,0),(5,1),(5,1),(3,2)] -- -- /Caution/: In order for the generated setter family to be well-defined, you must ensure that the two functors laws hold: -- -- * @sec id === id@ -- -- * @sec f . sec g === sec (f . g)@ setting :: ((b -> b') -> a -> a') -- ^ sec (semantic editor combinator) -> Setter a a' b b' setting = LF.setting