lens-family-core-2.0.0/0000755000175000001440000000000013514352273015742 5ustar00roconnorusers00000000000000lens-family-core-2.0.0/src/0000755000175000001440000000000013514352273016531 5ustar00roconnorusers00000000000000lens-family-core-2.0.0/src/Lens/0000755000175000001440000000000013514352273017432 5ustar00roconnorusers00000000000000lens-family-core-2.0.0/src/Lens/Family.hs0000644000175000001440000004014013514352273021206 0ustar00roconnorusers00000000000000-- | This is the main module for end-users of lens-families-core. -- 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 -- -- | This module provides '^.' for accessing fields and '.~' and '%~' for setting and modifying fields. -- Lenses are composed with `Prelude..` from the @Prelude@ and `Prelude.id` is the identity lens. -- -- Lens composition in this library enjoys the following identities. -- -- * @x^.l1.l2 === x^.l1^.l2@ -- -- * @l1.l2 %~ f === l1 %~ l2 %~ f@ -- -- The identity lens behaves as follows. -- -- * @x^.id === x@ -- -- * @id %~ f === f@ -- -- The '&' operator, allows for a convenient way to sequence record updating: -- -- @record & l1 .~ value1 & l2 .~ value2@ -- -- Lenses are implemented in van Laarhoven style. -- Lenses have type @'Functor' f => (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. -- -- > _2 id :: Functor f => (a, f b) -> f (a, b) -- -- Here is an example of code that uses the 'Maybe' functor to preserves sharing during update when possible. -- -- > -- | 'sharedUpdate' returns the *identical* object if the update doesn't change anything. -- > -- This is useful for preserving sharing. -- > sharedUpdate :: Eq a => LensLike' Maybe s a -> (a -> a) -> s -> s -- > sharedUpdate l f s = fromMaybe s (l f' s) -- > where -- > f' a | b == a = Nothing -- > | otherwise = Just b -- > where -- > b = f a -- * Traversals -- -- | '^.' can be used with traversals to access monoidal fields. -- The result will be a 'Data.Monid.mconcat' of all the fields referenced. -- The various @fooOf@ functions can be used to access different monoidal summaries of some kinds of values. -- -- '^?' can be used to access the first value of a traversal. -- 'Nothing' is returned when the traversal has no references. -- -- '^..' can be used with a traversals and will return a list of all fields referenced. -- -- When '.~' is used with a traversal, all referenced fields will be set to the same value, and when '%~' is used with a traversal, all referenced fields will be modified with the same function. -- -- 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 => (a -> f a) -> s -> f s@ and traversal families have type @'Applicative' f => (a i -> f (a j)) -> s i -> f (s j)@. -- -- * Grates -- -- | '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: -- -- * -- -- * -- -- * -- -- * -- -- * -- * Documentation to, view, (^.) , folding, views, (^..), (^?) , toListOf, allOf, anyOf, firstOf, lastOf, sumOf, productOf , lengthOf, nullOf , 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 -- * Re-exports , Constant, Identity, Prod , All, Any, Sum, Product ) where 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 import Lens.Family.Unchecked type Prod = Data.Functor.Product.Product newtype PCont i j a = PCont ((a -> j) -> i) 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 :: (s -> a) -> Getter s t a b -- @ -- -- 'to' promotes a projection function to a read-only lens called a getter. -- To demote a lens to a projection function, use the section @(^.l)@ or @view l@. -- -- >>> (3 :+ 4, "example")^._1.to(abs) -- 5.0 :+ 0.0 to p f = coerce . f . p view :: FoldLike a s t a b -> s -> a -- ^ @ -- view :: Getter s t a b -> s -> a -- @ -- -- Demote a lens or getter to a projection function. -- -- @ -- 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) => (s -> g a) -> LensLike f s t a b -- ^ @ -- folding :: (s -> [a]) -> Fold s t a b -- @ -- -- 'folding' promotes a \"toList\" function to a read-only traversal called a fold. -- -- To demote a traversal or fold to a \"toList\" function use the section @(^..l)@ or @toListOf l@. folding p f = coerce . traverse_ f . p views :: FoldLike r s t a b -> (a -> r) -> s -> 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 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 s = f (view l s) -- @ views l f = getConstant . l (Constant . f) toListOf :: FoldLike [a] s t a b -> s -> [a] -- ^ @ -- 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 s t a b -> (a -> Bool) -> s -> 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 s t a b -> (a -> Bool) -> s -> 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 a) s t a b -> s -> Maybe a -- ^ @ -- firstOf :: Fold s t a b -> s -> Maybe a -- @ -- -- Returns 'Just' the first referenced value. -- Returns 'Nothing' if there are no referenced values. -- See '^?' for an infix version of 'firstOf' firstOf l = getFirst . views l (First . Just) lastOf :: FoldLike (Last a) s t a b -> s -> Maybe a -- ^ @ -- 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 a => FoldLike (Sum a) s t a b -> s -> a -- ^ @ -- 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 a => FoldLike (Product a) s t a b -> s -> a -- ^ @ -- 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) s t a b -> s -> 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 s t a b -> s -> Bool -- ^ @ -- nullOf :: Fold s t a b -> s -> Bool -- @ -- -- Returns true if the number of references in the input is zero. nullOf l = allOf l (const False) infixl 8 ^. (^.) :: s -> FoldLike a s t a b -> a -- ^ @ -- (^.) :: s -> Getter s t a b -> a -- @ -- -- Access the value referenced by a getter or lens. -- -- @ -- (^.) :: Monoid a => s -> Fold s t a b -> a -- @ -- -- Access the monoidal summary referenced by a traversal or a fold. s^.l = getConstant $ l Constant s infixl 8 ^.. (^..) :: s -> FoldLike [a] s t a b -> [a] -- ^ @ -- (^..) :: s -> Fold s t a b -> [a] -- @ -- -- Returns a list of all of the referenced values in order. s^..l = toListOf l s infixl 8 ^? (^?) :: s -> FoldLike (First a) s t a b -> Maybe a -- ^ @ -- (^?) :: s -> Fold s t a b -> Maybe a -- @ -- -- Returns 'Just' the first referenced value. -- Returns 'Nothing' if there are no referenced values. s^?l = firstOf l s matching :: LensLike (Either a) s t a b -> s -> Either t a -- ^ @ -- matching :: Traversal s t a b -> s -> Either t a -- @ -- -- 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. -- -- @ -- 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 -- @ -- -- Demote a grate to its normal, higher-order function, form. -- -- @ -- degrating . grate = id -- grate . degrating = id -- @ degrating l = l runPCont . PCont 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 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 s t a b -> b -> s -> t l .~ b = l %~ const b -- | Set all referenced fields to the given value. set :: ASetter s t a b -> b -> s -> t set = (.~) infixl 1 & -- | A flipped version of @($)@. (&) :: s -> (s -> t) -> t (&) = flip ($) infixr 4 +~, -~, *~ (+~), (-~), (*~) :: 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 a => ASetter s t a a -> a -> s -> t l //~ a = l %~ (/ a) infixr 4 &&~, ||~ (&&~), (||~) :: 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 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 lens-family-core-2.0.0/src/Lens/Family/0000755000175000001440000000000013514352273020653 5ustar00roconnorusers00000000000000lens-family-core-2.0.0/src/Lens/Family/Phantom.hs0000644000175000001440000000114513514352273022616 0ustar00roconnorusers00000000000000module Lens.Family.Phantom where import Control.Applicative.Backwards (Backwards(..)) import Control.Applicative (Const(..)) import Data.Functor.Constant (Constant(..)) import Data.Functor.Compose (Compose(..)) class Functor f => Phantom f where coerce :: f a -> f b instance Phantom f => Phantom (Backwards f) where coerce (Backwards x) = Backwards (coerce x) instance Phantom (Const a) where coerce (Const x) = (Const x) instance Phantom (Constant a) where coerce (Constant x) = (Constant x) instance (Phantom f, Functor g) => Phantom (Compose f g) where coerce (Compose x) = Compose (coerce x) lens-family-core-2.0.0/src/Lens/Family/Stock.hs0000644000175000001440000003302313514352273022273 0ustar00roconnorusers00000000000000-- | 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 ( -- * Stock Lenses _1, _2 , chosen , ix , at, intAt , at', intAt' , contains, intContains -- * Stock Prisms , lft, rgt , some, none -- * Stock Grids , both , 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' , GrateLike, GrateLike' , Identical, Backwards , FiniteBits ) where import Control.Arrow (first, second) 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.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 s0 t0 a b -> LensLike f s1 t1 a b -> LensLike f (Either s0 s1) (Either t0 t1) a b -- ^ @ -- choosing :: Lens s0 t0 a b -> Lens s1 t1 a b -> Lens (Either s0 s1) (Either t0 t1) a b -- @ -- -- @ -- choosing :: Traversal s0 t0 a b -> Traversal s1 t1 a b -> Traversal (Either s0 s1) (Either t0 t1) a b -- @ -- -- @ -- choosing :: Getter s0 t0 a b -> Getter s1 t1 a b -> Getter (Either s0 s1) (Either t0 t1) a b -- @ -- -- @ -- choosing :: Fold s0 t0 a b -> Fold s1 t1 a b -> Fold (Either s0 s1) (Either t0 t1) a b -- @ -- -- @ -- 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 <$> la f a choosing _ lb f (Right b) = Right <$> lb f b _1 :: Functor f => LensLike f (a, r) (b, r) a b -- ^ @ -- _1 :: Lens (a, r) (b, r) a b -- @ -- -- Lens on the first element of a pair. _1 f (a, r) = (\b -> (b, r)) <$> f a _2 :: Functor f => LensLike f (r, a) (r, b) a b -- ^ @ -- _2 :: Lens (r, a) (r, b) a b -- @ -- -- Lens on the second element of a pair. _2 f (r, a) = (\b -> (r, b)) <$> f a chosen :: Functor f => LensLike f (Either a a) (Either b b) a b -- ^ @ -- chosen :: Lens (Either a a) (Either b b) a b -- @ -- -- Lens on the Left or Right element of an ('Either' a a). chosen = choosing id id ix :: (Eq k, Functor f) => k -> LensLike' f (k -> v) v -- ^ @ -- ix :: Eq k => k -> Lens' (k -> v) v -- @ -- -- Lens on a given point of a function. ix k f g = (\v' x -> if (k == x) then v' else g x) <$> f (g k) at :: (Ord k, Functor f) => k -> LensLike' f (Map.Map k v) (Maybe v) -- ^ @ -- at :: Ord k => k -> Lens' (Map.Map k v) (Maybe v) -- @ -- -- Lens on a given point of a 'Map.Map'. at = flip Map.alterF intAt :: Functor f => Int -> LensLike' f (IntMap.IntMap v) (Maybe v) -- ^ @ -- intAt :: Int -> Lens (IntMap.IntMap v) (Maybe v) -- @ -- -- Lens on a given point of a 'IntMap.IntMap'. intAt = flip IntMap.alterF at' :: (Ord k, Functor f) => k -> LensLike' f (Map.Map k v) (Maybe v) -- ^ @ -- at :: Ord k => k -> Lens' (Map.Map k v) (Maybe v) -- @ -- -- Lens providing strict access to a given point of a 'Map.Map'. at' = flip Map'.alterF intAt' :: Functor f => Int -> LensLike' f (IntMap.IntMap v) (Maybe v) -- ^ @ -- intAt :: Int -> Lens (IntMap.IntMap v) (Maybe v) -- @ -- -- Lens providing strict access to a given point of a 'IntMap.IntMap'. intAt' = flip IntMap'.alterF contains :: (Ord k, Functor f) => k -> LensLike' f (Set.Set k) Bool -- ^ @ -- contains :: Ord => k -> Lens' (Set.Set k) Bool -- @ -- -- Lens on a given point of a 'Set.Set'. contains k = lens (Set.member k) (\m nv -> if nv then Set.insert k m else Set.delete k m) intContains :: Functor f => Int -> LensLike' f IntSet.IntSet Bool -- ^ @ -- intContains :: Int -> Lens' IntSet.IntSet Bool -- @ -- -- Lens on a given point of a 'IntSet.IntSet'. intContains k = lens (IntSet.member k) (\m nv -> if nv then IntSet.insert k m else IntSet.delete k m) cod :: Functor g => GrateLike g (r -> a) (r -> b) a b -- ^ @ -- 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'. -- -- @ -- lft_ = under lft -- @ lft_ = under lft rgt :: (Applicative f, Traversable g) => AdapterLike f g (Either r a) (Either r b) a 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'. -- -- @ -- rgt_ = under rgt -- @ rgt_ = under rgt some :: (Applicative f, Traversable g) => AdapterLike f g (Maybe a) (Maybe b) a b -- ^ @ -- 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'. some_ = under some none :: (Applicative f, Traversable g) => AdapterLike' f g (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'. none_ = under none both :: (Applicative f, Functor g) => AdapterLike f g (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_ = under both -- @ both_ = beside_ id id lend :: (FiniteBits b, Applicative f, Functor g) => AdapterLike' f g b Bool -- ^ @ -- 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 -- @ -- -- 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. -- -- @ -- 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 = under $ beside (resetting la) (resetting lb) ignored :: Applicative f => null -> s -> f s -- ^ @ -- 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)) instance Functor f => Functor (AlongsideLeft f a) where fmap f (AlongsideLeft x) = AlongsideLeft (fmap (first f) x) instance Phantom f => Phantom (AlongsideLeft f a) where coerce (AlongsideLeft x) = AlongsideLeft (coerce x) newtype AlongsideRight f a b = AlongsideRight (f (a, b)) instance Functor f => Functor (AlongsideRight f a) where fmap f (AlongsideRight x) = AlongsideRight (fmap (second f) x) instance Phantom f => Phantom (AlongsideRight f a) where coerce (AlongsideRight x) = AlongsideRight (coerce x) alongside :: Functor f => LensLike (AlongsideLeft f 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 s0 t0 a0 b0 -> Lens s1 t1 a1 b1 -> Lens (s0, s1) (t0, t1) (a0, a1) (b0, b1) -- @ -- -- @ -- 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 l0 l1 f (s0, s1) = ft0t1 where AlongsideRight ft0t1 = l1 f1 s1 f1 a1 = AlongsideRight ft0a1 where 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) lens-family-core-2.0.0/src/Lens/Family/Clone.hs0000644000175000001440000001236213514352273022253 0ustar00roconnorusers00000000000000-- | 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' 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 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. -- -- '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 ( cloneAdapter, cloneLens, cloneGrate, cloneTraversal, cloneSetter, cloneResetter, cloneGetter, cloneFold -- * Types , AnAdapter, AnAdapter' , ALens, ALens' , ATraversal, ATraversal' , AGetter, AGetter' , AFold, AFold' , PStore, PKleeneStore -- * Re-exports , LensLike, LensLike', GrateLike, GrateLike', FoldLike, FoldLike', AGrate, ASetter, AResetter , Phantom, Identical ) where import Lens.Family.Unchecked import Lens.Family data PStore i j a = PStore (j -> a) i instance Functor (PStore i j) where fmap f (PStore g i) = PStore (f . g) i -- | 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 -- | 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 s t a b -> LensLike f s t a b cloneLens univ f = experiment f . univ (PStore id) experiment :: Functor f => (a -> f b) -> PStore a b t -> f t experiment f (PStore g a) = g <$> f a data PKleeneStore i j a = Unit a | Battery (PKleeneStore i j (j -> a)) i instance Functor (PKleeneStore i j) where fmap f (Unit a) = Unit (f a) fmap f (Battery g i) = Battery (fmap (f .) g) i instance Applicative (PKleeneStore i j) where pure = Unit Unit f <*> a = f <$> a Battery f b <*> a = Battery (flip <$> f <*> a) 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' s a = LensLike' (PKleeneStore a a) s a -- | Converts a universal traversal instance back into a polymorphic traversal. 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 => (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 s t a b -> LensLike f s t a b cloneSetter = setting . over -- | 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 s t a b -> LensLike f s t a b cloneFold univ = folding (toListOf univ) -- | 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 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 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 lens-family-core-2.0.0/src/Lens/Family/State.hs0000644000175000001440000000014413514352273022266 0ustar00roconnorusers00000000000000module Lens.Family.State ( module Lens.Family.State.Lazy ) where import Lens.Family.State.Lazy lens-family-core-2.0.0/src/Lens/Family/State/0000755000175000001440000000000013514352273021733 5ustar00roconnorusers00000000000000lens-family-core-2.0.0/src/Lens/Family/State/Strict.hs0000644000175000001440000001147013514352273023542 0ustar00roconnorusers00000000000000-- | Lenses allow you to use fields of the state of a state monad as if they were variables in an imperative language. -- 'use' is used to retrieve the value of a variable, and '.=' and '%=' allow you to set and modify a variable. -- C-style compound assignments are also provided. module Lens.Family.State.Strict ( zoom , use, uses , (%=) , assign, (.=) , (%%=) , (<~) -- * Compound Assignments , (+=), (-=), (*=) , (//=) , (&&=), (||=) , (<>=) -- * Strict Assignments , (%!=) , (+!=), (-!=), (*!=) , (//!=) , (&&!=), (||!=) , (<>!=) -- * Types , Zooming -- * Re-exports , LensLike, LensLike' , FoldLike, Constant , ASetter, ASetter', Identity , StateT, Writer ) where 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 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) s a -> StateT a m c -> StateT s 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 :: (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' 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 a s t a b -> StateT s m a -- ^ @ -- use :: Monad m => Getter s t a b -> StateT s m a -- @ -- -- Retrieve a field of the state -- -- @ -- 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 s t a b -> (a -> r) -> StateT s 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 :: a -> 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 :: a -> r@. -- -- @uses l f = f \<$> use l@ uses l f = views l f `liftM` get infix 4 %= -- | Modify a field of the state. (%=) :: Monad m => ASetter 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 s s a b -> b -> StateT s m () l .= v = l %= const v -- | Set a field of the state. 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) s s a b -> (a -> (c, b)) -> StateT s 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 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. l %%= f = state (swap . runWriter . l (writer . swap . 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 <>= -- | Monoidally append a value to all referenced fields of the state. (<>=) :: (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) lens-family-core-2.0.0/src/Lens/Family/State/Lazy.hs0000644000175000001440000001146413514352273023214 0ustar00roconnorusers00000000000000-- | Lenses allow you to use fields of the state of a state monad as if they were variables in an imperative language. -- 'use' is used to retrieve the value of a variable, and '.=' and '%=' allow you to set and modify a variable. -- C-style compound assignments are also provided. module Lens.Family.State.Lazy ( zoom , use, uses , (%=) , assign, (.=) , (%%=) , (<~) -- * Compound Assignments , (+=), (-=), (*=) , (//=) , (&&=), (||=) , (<>=) -- * Strict Assignments , (%!=) , (+!=), (-!=), (*!=) , (//!=) , (&&!=), (||!=) , (<>!=) -- * Types , Zooming -- * Re-exports , LensLike, LensLike' , FoldLike, Constant , ASetter, ASetter', Identity , StateT, Writer ) where 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 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) s a -> StateT a m c -> StateT s 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 :: (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' 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 a s t a b -> StateT s m a -- ^ @ -- use :: Monad m => Getter s t a b -> StateT s m a -- @ -- -- Retrieve a field of the state -- -- @ -- 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 s t a b -> (a -> r) -> StateT s 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 :: a -> 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 :: a -> r@. -- -- @uses l f = f \<$> use l@ uses l f = views l f `liftM` get infix 4 %= -- | Modify a field of the state. (%=) :: Monad m => ASetter 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 s s a b -> b -> StateT s m () l .= v = l %= const v -- | Set a field of the state. 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) s s a b -> (a -> (c, b)) -> StateT s 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 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. l %%= f = state (swap . runWriter . l (writer . swap . 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 <>= -- | Monoidally append a value to all referenced fields of the state. (<>=) :: (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) lens-family-core-2.0.0/src/Lens/Family/State/Zoom.hs0000644000175000001440000000065713514352273023223 0ustar00roconnorusers00000000000000module Lens.Family.State.Zoom where import Control.Monad (liftM) newtype Zooming m c a = Zooming { unZooming :: m (c, a) } instance Monad m => Functor (Zooming m c) where fmap f (Zooming m) = Zooming (liftM (fmap f) m) instance (Monoid c, Monad m) => Applicative (Zooming m c) where pure a = Zooming (return (mempty, a)) Zooming f <*> Zooming x = Zooming $ do (a, f') <- f (b, x') <- x return (a <> b, f' x') lens-family-core-2.0.0/src/Lens/Family/Unchecked.hs0000644000175000001440000003147613514352273023113 0ustar00roconnorusers00000000000000-- | /Caution/: Improper use of this module can lead to unexpected behaviour if the preconditions of the functions are not met. module Lens.Family.Unchecked ( -- * 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 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, _myInt :: Int } -- > -- > -- 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 _myInt is monomorphic, so we can use a 'LensLike'' type. -- > -- However, the structure of the function is exactly the same as for LensLike. -- > myInt :: Functor f => LensLike' f (MyRecord a) Int -- > myInt f (MyRecord a i) = (\i' -> MyRecord a i') <$> f i -- -- 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. -- -- > 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 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 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, _myC :: Bool } -- > -- > -- myInts is a traversal over both fields of MyRecord. -- > myInts :: Applicative f => LensLike' f MyRecord Int -- > 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 polymrphic traversals. -- Consider the following example of a record with two 'Maybe' fields. -- -- > data MyRecord a = MyRecord { _myA0 :: Maybe a, _myA1 :: Maybe a, myC :: Bool } -- > -- > -- 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/: It is possible to build traversals without even depending on @lens-family-core@ by expanding away the type synonym. -- -- > 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 -- -- 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 s t a 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. -- * 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 adapter , lens , prism , grate , setting , resetting -- * Types , AdapterLike, AdapterLike' , LensLike, LensLike' , GrateLike, GrateLike' , Identical ) where import Lens.Family.Identical 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 => (s -> a) -- ^ getter -> (s -> b -> t) -- ^ setter -> LensLike f s t a b -- ^ @ -- lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b -- @ -- -- 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 s a) === a@ -- -- * @setter s (getter s) === s@ -- -- * @setter (setter s a1) a2 === setter s a2@ lens getter setter f s = setter s <$> f (getter s) grate :: Functor g => (((s -> a) -> b) -> t) -- ^ grater -> GrateLike g s t a b -- ^ @ -- grate :: (((s -> a) -> b) -> t) -> Grate s t a b -- @ -- -- Build a grate from a @grater@ family. -- -- /Caution/: In order for the generated grate family to be well-defined, you must ensure that the two grater laws hold: -- -- * @grater ($ s) === s@ -- -- * @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". -- -- >>> [("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 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 => ((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 lens-family-core-2.0.0/src/Lens/Family/Identical.hs0000644000175000001440000000111413514352273023100 0ustar00roconnorusers00000000000000module Lens.Family.Identical where import Control.Applicative.Backwards (Backwards(..)) import Data.Functor.Identity (Identity(..)) import Data.Functor.Compose (Compose(..)) -- It would really be much better if comonads was in tranformers class (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) lens-family-core-2.0.0/Setup.lhs0000644000175000001440000000011713514352273017551 0ustar00roconnorusers00000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain lens-family-core-2.0.0/lens-family-core.cabal0000644000175000001440000000436213514352273022101 0ustar00roconnorusers00000000000000name: lens-family-core category: Data, Lenses version: 2.0.0 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE author: Russell O'Connor maintainer: Russell O'Connor stability: experimental copyright: Copyright (C) 2012,2013,2014,2017,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 Van Laarhoven style supporting the following optics: . * Lenses (view, over) . * Traversals (toListOf, matching, over) . * Setters (over) . * Grates (zipWithOf, under, review) . * 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 cannot support rank 2 polymorphism. source-repository head type: darcs location: https://hub.darcs.net/roconnor/lens-family library build-depends: base >= 4.11 && < 5, containers >= 0.5.8 && < 0.7, transformers >= 0.3.0 && < 0.6 exposed-modules: Lens.Family.Unchecked Lens.Family.Clone Lens.Family Lens.Family.Stock Lens.Family.State.Lazy Lens.Family.State.Strict Lens.Family.State other-modules: Lens.Family.Identical Lens.Family.Phantom Lens.Family.State.Zoom ghc-options: -Wall hs-source-dirs: src lens-family-core-2.0.0/CHANGELOG0000644000175000001440000000570213514352273017160 0ustar00roconnorusers000000000000002.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] [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 1.0.0 (Changes from 0.1.0) ========================= * added support for folds and traversals * renamed all functions to be mostly compatible with the lexicon from lens. 0.1.0 (Changes from 0.0.1) ========================= * added project and sec * added <>= and <>~ * renamed functional modifier operators * renamed LensFamily and Lens to RefFamily and Ref * moving setting to Lens.Family.Unchecked because one needs to verify the functor laws 0.0.1 (Changes from 0.0.0) ========================= * Bump dependency on containers * Fixed dependency on mtl lens-family-core-2.0.0/LICENSE0000644000175000001440000000267113514352273016755 0ustar00roconnorusers00000000000000Copyright 2012,2013,2014 Russell O'Connor All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.