diff --git a/lens.cabal b/lens.cabal --- a/lens.cabal +++ b/lens.cabal @@ -1,6 +1,6 @@ name: lens category: Data, Lenses -version: 1.1.1 +version: 1.2 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE @@ -10,18 +10,22 @@ homepage: http://github.com/ekmett/lens/ bug-reports: http://github.com/ekmett/lens/issues copyright: Copyright (C) 2012 Edward A. Kmett -synopsis: Families of Lenses, Folds and Traversals +synopsis: Lenses, Folds and Traversals description: The combinators in @Control.Lens@ provide a highly generic toolbox for composing families of getters, folds, traversals, setters and lenses. . /Getter/ . - A @'Getter' a b c d@ is just any function @(a -> c)@, which we've flipped into continuation - passing style, @forall r. (c -> r) -> a -> r@ and decorated with 'Const' to obtain + A @'Getter' a c@ is just any function @(a -> c)@, which we've flipped into continuation + passing style, @(c -> r) -> a -> r@ and decorated with 'Const' to obtain . - > type Getter a b c d = forall r. (c -> Const r d) -> a -> Const r b + > type Getting r a b c d = (c -> Const r d) -> a -> Const r b . + If we restrict access to knowledge about the type 'r' and can work for any d and b, we get: + . + > type Getter a c = forall r b d. Getting r a b c d + . Everything you can do with a function, you can do with a 'Getter', but note that because of the continuation passing style (.) composes them in the opposite order. . @@ -30,13 +34,13 @@ . /Fold/ . - A @'Fold' a b c d@ is a generalization of something 'Foldable'. It allows you to + A @'Fold' a c@ is a generalization of something 'Foldable'. It allows you to extract multiple results from a container. A 'Foldable' container can be characterized by the behavior of @foldMap :: (Foldable t, Monoid m) => (c -> m) -> t c -> m@. Since we want to be able to work with monomorphic containers, we generalize this signature to @forall m. 'Monoid' m => (c -> m) -> a -> m@, and then decorate it with 'Const' to obtain . - > type Fold a b c d = forall m. Monoid m => (c -> Const m d) -> a -> Const m b + > type Fold a c = forall m b d. Monoid m => Getting m a b c d . Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' it is passed. . @@ -53,8 +57,9 @@ . > type Traversal a b c d = forall f. Applicative f => (c -> f d) -> a -> f b . - Every 'Traversal' can be used as a valid 'Fold', because given a 'Monoid' @m@, we have an 'Applicative' for @('Const' m)@. - + While a 'Traversal' isn't quite a 'Fold', it _can_ be used for 'Getting' like a 'Fold', because + given a 'Monoid' @m@, we have an 'Applicative' for @('Const' m)@. + . Everything you can do with a 'Traversable' container, you can with with a 'Traversal', and there are combinators that generalize the usual 'Traversable' operations in @Control.Lens@. . @@ -76,8 +81,9 @@ . A @'Lens' a b c d@ is a purely functional reference. . - While a 'Traversal' was a valid 'Fold', it wasn't a valid 'Getter'. To make the 'Applicative' - for 'Const' it required a 'Monoid' for the argument we passed it, which a 'Getter' doesn't recieve. + While a 'Traversal' could be used for 'Getting' like a valid 'Fold', it wasn't a valid 'Getter'. + To make the 'Applicative' for 'Const' it required a 'Monoid' for the argument we passed it, which + a 'Getter' doesn't recieve. . However, the instance of 'Functor' for 'Const' requires no such thing. If we weaken the type requirement from 'Applicative' to 'Functor' for 'Traversal', we obtain @@ -86,16 +92,25 @@ . Every 'Lens' is a valid 'Setter', choosing @f@ = 'Identity'. . - Every 'Lens' is a valid 'Fold' that doesn't use the 'Monoid' it is passed. + Every 'Lens' can be used for 'Getting' like a 'Fold' that doesn't use the 'Monoid' it is passed. . Every 'Lens' is a valid 'Traversal' that only uses the 'Functor' part of the 'Applicative' it is supplied. . - Every 'Lens' is a valid 'Getter', choosing @f@ = 'Const' @r@ for an appropriate @r@ + Every 'Lens' can be used for 'Getting' like a valid 'Getter', choosing @f@ = 'Const' @r@ for an appropriate @r@ . - Since every 'Lens' is a valid 'Getter' it follows that it must view exactly one element in the structure. + Since every 'Lens' can be used for 'Getting' like a valid 'Getter' it follows that it must view exactly one + element in the structure. . The lens laws follow from this property and the desire for it to act like a 'Functor' when used as a 'Setter'. . + /Isomorphisms and Iso/ + . + Control.Isomorphic provides easy overloading of function application for isomorphisms and @Iso a b a d@ uses it + to form isomorphism families that can be composed with other isomorphisms and with lenses, setters, folds, + traversals and getters. + . + > type Iso a b c d = forall k f. (Isomorphic k, Functor f) => k (c -> f d) (a -> f b) + . /Composition/ . Note that all of these types are type aliases, and you can compose these lenses with mere function compositon. @@ -113,7 +128,7 @@ . > type Simple f a b = f a a b b . - to describe a 'Simple' 'Lens', 'Simple' 'Traversal' or 'Simple' 'Setter'. + to describe a 'Simple' 'Setter', 'Simple' 'Traversal', 'Simple' 'Lens' or 'Simple' 'Iso'. . /Avoiding Dependencies/ . @@ -142,14 +157,17 @@ library exposed-modules: Control.Exception.Lens + Control.Isomorphic Control.Lens Control.Lens.Internal Control.Lens.Representable Control.Lens.TH Control.Parallel.Strategies.Lens + Control.Seq.Lens Data.Array.Lens Data.Bits.Lens Data.ByteString.Lens + Data.ByteString.Lazy.Lens Data.Complex.Lens Data.Dynamic.Lens Data.Map.Lens @@ -158,8 +176,11 @@ Data.Sequence.Lens Data.Set.Lens Data.Text.Lens + Data.Text.Lazy.Lens + Data.Time.Calendar.Lens Data.Tree.Lens + -- All dependencies are in the Haskell Platform build-depends: array == 0.4.*, base == 4.*, @@ -169,19 +190,21 @@ parallel == 3.2.*, template-haskell >= 2.4 && < 2.8, text == 0.11.*, + time == 1.4.*, transformers >= 0.2 && < 0.4 other-extensions: CPP + DeriveDataTypeable LiberalTypeSynonyms MultiParamTypeClasses Rank2Types RankNTypes TemplateHaskell + TypeOperators if (impl(ghc>=7.4)) - other-extensions: - Trustworthy + other-extensions: Trustworthy ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields hs-source-dirs: src diff --git a/src/Control/Isomorphic.hs b/src/Control/Isomorphic.hs new file mode 100644 --- /dev/null +++ b/src/Control/Isomorphic.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeOperators #-} +----------------------------------------------------------------------------- +-- | +-- Module : Control.Isomorphic +-- Copyright : (C) 2012 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : rank 2 types +-- +---------------------------------------------------------------------------- +module Control.Isomorphic + ( Isomorphic(..) + , Isomorphism(..) + , from + , via + , (:~>) + ) where + +import Control.Category +import Prelude hiding ((.),id) +import Data.Typeable + +---------------------------------------------------------------------------- +-- Isomorphism Implementation Details +----------------------------------------------------------------------------- + +-- | An isomorphism from a to b, overloaded to permit its use directly as a function. +-- +-- You can use a value of type @(a :~ b)@ as if it were @(a -> b)@ or @Isomorphism a b@. +infixr 0 :~> +type a :~> b = forall k. Isomorphic k => k a b + +-- | Used to provide overloading of isomorphism application +-- +-- This is a 'Category' with a canonical mapping to it from the +-- category of isomorphisms over Haskell types. +class Category k => Isomorphic k where + -- | Build this morphism out of an isomorphism + -- + -- The intention is that by using 'isomorphic', you can supply both halves of an + -- isomorphism, but k can be instantiated to (->), so you can freely use + -- the resulting isomorphism as a function. + isomorphic :: (a -> b) -> (b -> a) -> k a b + + -- | Map a morphism in the target category using an isomorphism between morphisms + -- in Hask. + isomap :: ((a -> b) -> c -> d) -> ((b -> a) -> d -> c) -> k a b -> k c d + +instance Isomorphic (->) where + isomorphic = const + {-# INLINE isomorphic #-} + isomap = const + {-# INLINE isomap #-} + +-- | A concrete data type for isomorphisms. +-- +-- This lets you place an isomorphism inside a container without using @ImpredicativeTypes@. +data Isomorphism a b = Isomorphism (a -> b) (b -> a) + deriving (Typeable) + +instance Category Isomorphism where + id = Isomorphism id id + {-# INLINE id #-} + Isomorphism bc cb . Isomorphism ab ba = Isomorphism (bc . ab) (ba . cb) + {-# INLINE (.) #-} + +instance Isomorphic Isomorphism where + isomorphic = Isomorphism + {-# INLINE isomorphic #-} + isomap abcd badc (Isomorphism ab ba) = Isomorphism (abcd ab) (badc ba) + {-# INLINE isomap #-} + +-- | Invert an isomorphism. +-- +-- Note to compose an isomorphism and receive an isomorphism in turn you'll need to use +-- 'Control.Category.Category' +-- +-- > from (from l) = l +-- +-- If you imported 'Control.Category.(.)', then: +-- +-- > from l . from r = from (r . l) +-- +-- > from :: (a :~> b) -> (b :~> a) +from :: Isomorphic k => Isomorphism a b -> k b a +from (Isomorphism a b) = isomorphic b a +{-# INLINE from #-} +{-# SPECIALIZE from :: Isomorphism a b -> b -> a #-} +{-# SPECIALIZE from :: Isomorphism a b -> Isomorphism b a #-} + +-- | +-- > via :: Isomorphism a b -> (a :~> b) +via :: Isomorphic k => Isomorphism a b -> k a b +via (Isomorphism a b) = isomorphic a b +{-# INLINE via #-} +{-# SPECIALIZE via :: Isomorphism a b -> a -> b #-} +{-# SPECIALIZE via :: Isomorphism a b -> Isomorphism a b #-} diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs --- a/src/Control/Lens.hs +++ b/src/Control/Lens.hs @@ -10,10 +10,10 @@ -- Stability : provisional -- Portability : Rank2Types -- --- This package provides lens families, setters, getters, traversals and folds that --- can all be composed automatically with each other (and other lenses from --- other van Laarhoven lens libraries) using @(.)@ from Prelude, while --- reducing the complexity of the API. +-- This package provides lens families, setters, getters, traversals, +-- isomorphisms, and folds that can all be composed automatically with +-- each other (and other lenses from other van Laarhoven lens libraries) +-- using @(.)@ from Prelude, while reducing the complexity of the API. -- -- For a longer description and motivation of why you should care about lens families, -- see . @@ -55,35 +55,33 @@ , SimpleLens , SimpleTraversal , SimpleLensLike - - -- ** Constructing Lenses - , lens - , iso - - -- * Traversing and Lensing , (%%~), (%%=) - , Focus(..) - , traverseOf, forOf, sequenceAOf - , mapMOf, forMOf, sequenceOf - , transposeOf - , mapAccumLOf, mapAccumROf - , scanr1Of, scanl1Of + , lens -- ** Common Lenses , _1, _2 - , identity , resultAt + -- * Isomorphisms + , Iso + , SimpleIso + , IsoLike + , SimpleIsoLike + , iso + , isos + , Isomorphic(..) + , from + -- * Setters , Setter , SimpleSetter , sets , mapped - , adjust + , adjust, mapOf , set - , (^~), (+~), (-~), (*~), (//~), (||~), (&&~), (%~), (<>~) - , (^=), (+=), (-=), (*=), (//=), (||=), (&&=), (%=), (<>=) , whisper + , (^~), (%~) + , (^=), (%=) -- * Getters and Folds , Getter @@ -124,8 +122,20 @@ , foldr1Of, foldl1Of , foldrMOf, foldlMOf + -- * Setting + , (+~), (-~), (*~), (//~), (||~), (&&~), (<>~) + , (+=), (-=), (*=), (//=), (||=), (&&=), (<>=) + + -- * Traversing and Lensing + , Focus(..) + , traverseOf, forOf, sequenceAOf + , mapMOf, forMOf, sequenceOf + , transposeOf + , mapAccumLOf, mapAccumROf + , scanr1Of, scanl1Of + -- * Common Traversals - , Traversable(..) + , Traversable(traverse) , traverseNothing , traverseLeft , traverseRight @@ -136,9 +146,18 @@ -- * Cloning Lenses , clone + , merged + , bothLenses + + -- ** Common Isomorphisms + , identity + , konst ) where import Control.Applicative as Applicative +import Control.Applicative.Backwards +import Control.Category +import Control.Isomorphic import Control.Lens.Internal import Control.Monad import Control.Monad.Reader.Class as Reader @@ -152,6 +171,7 @@ import Data.Maybe import Data.Monoid import Data.Traversable +import Prelude hiding ((.),id) infixl 8 ^. infixr 4 ^~, +~, *~, -~, //~, &&~, ||~, %~, <>~, %%~ @@ -181,10 +201,9 @@ -- These laws are strong enough that the 4 type parameters of a 'Lens' cannot vary fully independently. For more on -- how they interact, read the "Why is it a Lens Family?" section of . -- --- Every 'Lens' can be used directly as a 'Getter', 'Setter', 'Fold' or 'Traversal'. +-- Every 'Lens' can be used directly as a 'Setter' or 'Traversal'. -- --- > identity :: Lens (Identity a) (Identity b) a b --- > identity f (Identity a) = Identity <$> f a +-- You can also use a 'Lens' for 'Getting' as if it were a 'Fold' or 'Getter'. -- -- > type Lens = forall f. Functor f => LensLike f a b c d type Lens a b c d = forall f. Functor f => (c -> f d) -> a -> f b @@ -203,8 +222,8 @@ -- and the more evocative name suggests their application. -- -- Most of the time the 'Traversal' you will want to use is just 'traverse', but you can also pass any --- 'Lens' -- as a Traversal, and composition of a 'Traversal' (or 'Lens') with a 'Traversal' (or 'Lens') --- using (.) forms a 'Traversal'. +-- 'Lens' or 'Iso' as a Traversal, and composition of a 'Traversal' (or 'Lens' or 'Iso') with a 'Traversal' (or 'Lens' or 'Iso') +-- using (.) forms a valid 'Traversal'. type Traversal a b c d = forall f. Applicative f => (c -> f d) -> a -> f b -- | A @'Simple' 'Lens'@, @'Simple' 'Traversal'@, ... can be used instead of a 'Lens','Traversal', ... @@ -237,13 +256,6 @@ lens ac adb cfd a = adb a <$> cfd (ac a) {-# INLINE lens #-} --- | Built a 'Lens' from an isomorphism family --- --- > iso :: Functor f => (a -> c) -> (d -> b) -> (c -> f d) -> a -> f b -iso :: (a -> c) -> (d -> b) -> Lens a b c d -iso ac db cfd a = db <$> cfd (ac a) -{-# INLINE iso #-} - -------------------------- -- LensLike -------------------------- @@ -270,6 +282,7 @@ -- -- > (%%~) = id -- +-- > (%%~) :: Functor f => Iso a b c d -> (c -> f d) -> a -> f b -- > (%%~) :: Functor f => Lens a b c d -> (c -> f d) -> a -> f b -- > (%%~) :: Applicative f => Traversal a b c d -> (c -> f d) -> a -> f b -- @@ -278,6 +291,7 @@ -- When applied to a 'Traversal', it can edit the targets of the 'Traversals', extracting a -- supplemental monoidal summary of its actions, by choosing f = ((,) m) -- +-- > (%%~) :: Iso a b c d -> (c -> (e, d)) -> a -> (e, b) -- > (%%~) :: Lens a b c d -> (c -> (e, d)) -> a -> (e, b) -- > (%%~) :: Monoid m => Traversal a b c d -> (c -> (m, d)) -> a -> (m, b) (%%~) :: LensLike f a b c d -> (c -> f d) -> a -> f b @@ -293,6 +307,7 @@ -- It may be useful to think of ('%%='), instead, as having either of the following more restricted -- type signatures: -- +-- > (%%=) :: MonadState a m => Iso a a c d -> (c -> (e, d) -> m e -- > (%%=) :: MonadState a m => Lens a a c d -> (c -> (e, d) -> m e -- > (%%=) :: (MonadState a m, Monoid e) => Traversal a a c d -> (c -> (e, d) -> m e (%%=) :: MonadState a m => LensLike ((,) e) a a c d -> (c -> (e, d)) -> m e @@ -310,12 +325,14 @@ -- and a monoidal summary -- of the result is given. -- + -- > focus :: Monad m => Simple Iso a b -> st b m c -> st a m c -- > focus :: Monad m => Simple Lens a b -> st b m c -> st a m c -- > focus :: (Monad m, Monoid c) => Simple Traversal a b -> st b m c -> st a m c focus :: Monad m => LensLike (Focusing m c) a a b b -> st b m c -> st a m c -- | Like 'focus', but discarding any accumulated results as you go. -- + -- > focus_ :: Monad m => Simple Iso a b -> st b m c -> st a m () -- > focus_ :: Monad m => Simple Lens a b -> st b m c -> st a m () -- > focus_ :: (Monad m, Monoid c) => Simple Traversal a b -> st b m c -> st a m () focus_ :: Monad m => LensLike (Focusing m ()) a a b b -> st b m c -> st a m () @@ -361,19 +378,26 @@ -- -- > traverse = traverseOf traverse -- +-- > traverseOf :: Iso a b c d -> (c -> f d) -> a -> f b -- > traverseOf :: Lens a b c d -> (c -> f d) -> a -> f b -- > traverseOf :: Traversal a b c d -> (c -> f d) -> a -> f b -traverseOf :: LensLike f a b c d -> (c -> f d) -> a -> f b +traverseOf :: Category k => k (LensLike f a b c d) ((c -> f d) -> a -> f b) traverseOf = id +{-# INLINE traverseOf #-} +{-# SPECIALIZE traverseOf :: LensLike f a b c d -> (c -> f d) -> a -> f b #-} -- | -- --- > forOf = flip -- > forOf l = flip (traverseOf l) -- -- > for = forOf traverse -forOf :: LensLike f a b c d -> a -> (c -> f d) -> f b -forOf = flip +-- > forOf = morphism flip flip +-- +-- > forOf :: Lens a b c d -> a -> (c -> f d) -> f b +forOf :: Isomorphic k => k (LensLike f a b c d) (a -> (c -> f d) -> f b) +forOf = isomorphic flip flip +{-# INLINE forOf #-} +{-# SPECIALIZE forOf :: LensLike f a b c d -> a -> (c -> f d) -> f b #-} -- | -- Evaluate each action in the structure from left to right, and collect @@ -383,7 +407,8 @@ -- > sequenceAOf l = traverseOf l id -- > sequenceAOf l = l id -- --- > sequenceAOf :: Lens a b (f c) c -> a -> f b +-- > sequenceAOf :: Iso a b (f c) c -> a -> f b +-- > sequenceAOf :: Lens a b (f c) c -> a -> f b -- > sequenceAOf :: Applicative f => Traversal a b (f c) c -> a -> f b sequenceAOf :: LensLike f a b (f c) c -> a -> f b sequenceAOf l = l id @@ -394,6 +419,7 @@ -- -- > mapM = mapMOf traverse -- +-- > mapMOf :: Iso a b c d -> (c -> m d) -> a -> m b -- > mapMOf :: Lens a b c d -> (c -> m d) -> a -> m b -- > mapMOf :: Monad m => Traversal a b c d -> (c -> m d) -> a -> m b mapMOf :: LensLike (WrappedMonad m) a b c d -> (c -> m d) -> a -> m b @@ -404,8 +430,9 @@ -- > forM = forMOf traverse -- > forMOf l = flip (mapMOf l) -- --- > forMOf :: Lens a b c d -> a -> (c -> m d) -> m b --- > forMOf :: Monad m => Lens a b c d -> a -> (c -> m d) -> m b +-- > forMOf :: Iso a b c d -> a -> (c -> m d) -> m b +-- > forMOf :: Lens a b c d -> a -> (c -> m d) -> m b +-- > forMOf :: Monad m => Traversal a b c d -> a -> (c -> m d) -> m b forMOf :: LensLike (WrappedMonad m) a b c d -> a -> (c -> m d) -> m b forMOf l a cmd = unwrapMonad (l (WrapMonad . cmd) a) {-# INLINE forMOf #-} @@ -415,6 +442,7 @@ -- > sequenceOf l = mapMOf l id -- > sequenceOf l = unwrapMonad . l WrapMonad -- +-- > sequenceOf :: Iso a b (m c) c -> a -> m b -- > sequenceOf :: Lens a b (m c) c -> a -> m b -- > sequenceOf :: Monad m => Traversal a b (m c) c -> a -> m b sequenceOf :: LensLike (WrappedMonad m) a b (m c) c -> a -> m b @@ -442,6 +470,7 @@ -- -- 'mapAccumROf' accumulates state from right to left. -- +-- > mapAccumROf :: Iso a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) -- > mapAccumROf :: Lens a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) -- > mapAccumROf :: Traversal a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) mapAccumROf :: LensLike (Lazy.State s) a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) @@ -454,6 +483,7 @@ -- -- 'mapAccumLOf' accumulates state from left to right. -- +-- > mapAccumLOf :: Iso a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) -- > mapAccumLOf :: Lens a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) -- > mapAccumLOf :: Traversal a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) mapAccumLOf :: LensLike (Backwards (Lazy.State s)) a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) @@ -468,6 +498,7 @@ -- -- > scanr1 = scanr1Of traverse -- +-- > scanr1Of :: Iso a b c c -> (c -> c -> c) -> a -> b -- > scanr1Of :: Lens a b c c -> (c -> c -> c) -> a -> b -- > scanr1Of :: Traversal a b c c -> (c -> c -> c) -> a -> b scanr1Of :: LensLike (Lazy.State (Maybe c)) a b c c -> (c -> c -> c) -> a -> b @@ -480,6 +511,7 @@ -- -- > scanl1 = scanl1Of traverse -- +-- > scanr1Of :: Iso a b c c -> (c -> c -> c) -> a -> b -- > scanr1Of :: Lens a b c c -> (c -> c -> c) -> a -> b -- > scanr1Of :: Traversal a b c c -> (c -> c -> c) -> a -> b scanl1Of :: LensLike (Backwards (Lazy.State (Maybe c))) a b c c -> (c -> c -> c) -> a -> b @@ -499,13 +531,18 @@ -- -- You can't 'view' a 'Setter' in general, so the other two laws are irrelevant. -- +-- However, two Functor laws apply to a 'Setter' +-- +-- > adjust l id = id +-- > adjust l f . adjust l g = adjust l (f . g) +-- -- You can compose a 'Setter' with a 'Lens' or a 'Traversal' using @(.)@ from the Prelude -- and the result is always only a 'Setter' and nothing more. -- -- > type Setter a b c d = LensLike Identity a b c d type Setter a b c d = (c -> Identity d) -> a -> Identity b --- | This alias is supplied for those who don't want to bother using {-# LANGUAGE LiberalTypeSynonyms #-} and 'Simple'. +-- | This alias is supplied for those who don't want to use @LiberalTypeSynonyms@ with 'Simple'. -- -- > 'SimpleSetter ' = 'Simple' 'Setter' type SimpleSetter a b = Lens a a b b @@ -523,9 +560,15 @@ -- -- > sets . adjust = id -- > adjust . sets = id -sets :: ((c -> d) -> a -> b) -> Setter a b c d -sets f g a = Identity (f (runIdentity . g) a) +-- > sets = from adjust +-- > adjust = from sets +-- +-- > sets :: ((c -> d) -> a -> b) -> Setter a b c d +sets :: Isomorphic k => k ((c -> d) -> a -> b) (Setter a b c d) +sets = isomorphic (\f g -> Identity . f (runIdentity . g)) + (\l f -> runIdentity . l (Identity . f)) {-# INLINE sets #-} +{-# SPECIALIZE sets :: ((c -> d) -> a -> b) -> Setter a b c d #-} -- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal' -- with a function. @@ -535,14 +578,43 @@ -- -- > sets . adjust = id -- > adjust . sets = id -adjust :: Setter a b c d -> (c -> d) -> a -> b -adjust l f = runIdentity . l (Identity . f) +-- +-- > adjust :: Setter a b c d -> (c -> d) -> a -> b +adjust :: Isomorphic k => k (Setter a b c d) ((c -> d) -> a -> b) +adjust = isomorphic (\l f -> runIdentity . l (Identity . f)) + (\f g -> Identity . f (runIdentity . g)) {-# INLINE adjust #-} +{-# SPECIALIZE adjust :: Setter a b c d -> (c -> d) -> a -> b #-} +-- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal' +-- with a function. This is an alias for adjust that is provided for consistency. +-- +-- > mapOf = adjust +-- +-- > fmap = mapOf mapped +-- > fmapDefault = mapOf traverse +-- +-- > sets . mapOf = id +-- > mapOf . sets = id +-- +-- > mapOf :: Setter a b c d -> (c -> d) -> a -> b +-- > mapOf :: Iso a b c d -> (c -> d) -> a -> b +-- > mapOf :: Lens a b c d -> (c -> d) -> a -> b +-- > mapOf :: Traversal a b c d -> (c -> d) -> a -> b +mapOf :: Isomorphic k => k (Setter a b c d) ((c -> d) -> a -> b) +mapOf = adjust +{-# INLINE mapOf #-} +{-# SPECIALIZE mapOf :: Setter a b c d -> (c -> d) -> a -> b #-} + -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' -- or 'Traversal' with a constant value. -- -- > (<$) = set mapped +-- +-- > set :: Setter a b c d -> d -> a -> b +-- > set :: Iso a b c d -> d -> a -> b +-- > set :: Lens a b c d -> d -> a -> b +-- > set :: Traversal a b c d -> d -> a -> b set :: Setter a b c d -> d -> a -> b set l d = runIdentity . l (\_ -> Identity d) {-# INLINE set #-} @@ -557,8 +629,13 @@ -- -- > ghci> _2 %~ length $ (1,"hello") -- > (1,5) +-- +-- > (%~) :: Setter a b c d -> (c -> d) -> a -> b +-- > (%~) :: Iso a b c d -> (c -> d) -> a -> b +-- > (%~) :: Lens a b c d -> (c -> d) -> a -> b +-- > (%~) :: Traversal a b c d -> (c -> d) -> a -> b (%~) :: Setter a b c d -> (c -> d) -> a -> b -l %~ f = runIdentity . l (Identity . f) +(%~) = adjust {-# INLINE (%~) #-} -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' @@ -570,8 +647,13 @@ -- -- > ghci> bitAt 0 ^~ True $ 0 -- > 1 +-- +-- > (^~) :: Setter a b c d -> d -> a -> b +-- > (^~) :: Iso a b c d -> d -> a -> b +-- > (^~) :: Lens a b c d -> d -> a -> b +-- > (^~) :: Traversal a b c d -> d -> a -> b (^~) :: Setter a b c d -> d -> a -> b -l ^~ v = runIdentity . l (Identity . const v) +(^~) = set {-# INLINE (^~) #-} -- | Increment the target(s) of a numerically valued 'Lens', Setter' or 'Traversal' @@ -582,7 +664,7 @@ l +~ n = adjust l (+ n) {-# INLINE (+~) #-} --- | Multiply the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' +-- | Multiply the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal' -- -- > ghci> _2 *~ 4 $ (1,2) -- > (1,8) @@ -590,7 +672,7 @@ l *~ n = adjust l (* n) {-# INLINE (*~) #-} --- | Decrement the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' +-- | Decrement the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal' -- -- > ghci> _1 -~ 2 $ (1,2) -- > (-1,2) @@ -598,7 +680,7 @@ l -~ n = adjust l (subtract n) {-# INLINE (-~) #-} --- | Divide the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' +-- | Divide the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal' (//~) :: Fractional c => Setter a b c c -> c -> a -> b l //~ n = adjust l (/ n) @@ -632,21 +714,24 @@ -- In practice the @b@ and @d@ are left dangling and unused, and as such is no real point in -- using a @'Simple' 'Getter'@. -- --- type Getter a b c d = forall z. LensLike (Const z) a b c d -type Getter a b c d = forall z. (c -> Const z d) -> a -> Const z b +-- type Getter a c = forall r. LensLike (Const r) a b c d +type Getter a c = forall r b d. (c -> Const r d) -> a -> Const r b -- | Build a 'Getter' from an arbitrary Haskell function. -- -- > to f . to g = to (g . f) -to :: (a -> c) -> Getter a b c d -to f g a = Const (getConst (g (f a))) +-- > to = from view +-- +-- > to . from = id +to :: (a -> c) -> Getter a c +to f g = Const . getConst . g . f {-# INLINE to #-} - -- | -- Most 'Getter' combinators are able to be used with both a 'Getter' or a 'Fold' in -- limited situations, to do so, they need to be monomorphic in what we are going to --- extract with 'Const'. +-- extract with 'Const'. To be compatible with 'Lens', 'Traversal' and 'Iso' we also +-- restricted choices of the irrelevant b and d parameters. -- -- If a function accepts a @Getting r a b c d@, then when @r@ is a Monoid, you can -- pass a 'Fold' (or 'Traversal'), otherwise you can only pass this a 'Getter' or 'Lens'. @@ -658,44 +743,46 @@ -- Getting Values ------------------------------- --- | View the value pointed to by a 'Getter' or 'Lens' or the result of folding over +-- | View the value pointed to by a 'Getter', 'Iso' or 'Lens' or the result of folding over -- all the results of a 'Fold' or 'Traversal' that points at a monoidal values. -- -- It may be useful to think of 'view' as having these more restrictive signatures: -- +-- > view :: Getter a c -> a -> c +-- > view :: Monoid m => Fold a m -> a -> m +-- > view :: Iso a b c d -> a -> c -- > view :: Lens a b c d -> a -> c --- > view :: Getter a b c d -> a -> c --- > view :: Monoid m => Fold a b m d -> a -> m -- > view :: Monoid m => Traversal a b m d -> a -> m --- --- > view :: ((c -> Const c d) -> a -> Const c b) -> a -> c view :: Getting c a b c d -> a -> c -view l a = getConst (l Const a) -{-# INLINE view #-} +view l = getConst . l Const --- | View the value of a 'Getter', 'Lens' or the result of folding over the +-- | View the value of a 'Getter', 'Iso', 'Lens' or the result of folding over the -- result of mapping the targets of a 'Fold' or 'Traversal'. -- -- It may be useful to think of 'views' as having these more restrictive signatures: -- --- > views :: Getter a b c d -> (c -> d) -> a -> d +-- > views :: Getter a c -> (c -> d) -> a -> d +-- > views :: Monoid m => Fold a c -> (c -> m) -> a -> m +-- > views :: Iso a b c d -> (c -> d) -> a -> d -- > views :: Lens a b c d -> (c -> d) -> a -> d --- > views :: Monoid m => Fold a b c d -> (c -> m) -> a -> m -- > views :: Monoid m => Traversal a b c d -> (c -> m) -> a -> m -- -- > views :: ((c -> Const m d) -> a -> Const m b) -> (c -> m) -> a -> m -views :: Getting m a b c d -> (c -> m) -> a -> m -views l f = getConst . l (Const . f) +views :: Isomorphic k => k (Getting m a b c d) ((c -> m) -> a -> m) +views = isomorphic (\l f -> getConst . l (Const . f)) (\l f -> Const . l (getConst . f)) {-# INLINE views #-} +{-# SPECIALIZE views :: Getting m a b c d -> (c -> m) -> a -> m #-} +{-# SPECIALIZE views :: Isomorphism (Getting m a b c d) ((c -> m) -> a -> m) #-} --- | View the value pointed to by a 'Getter' or 'Lens' or the result of folding over +-- | View the value pointed to by a 'Getter', 'Iso' or 'Lens' or the result of folding over -- all the results of a 'Fold' or 'Traversal' that points at a monoidal values. -- -- This is the same operation as 'view', only infix. -- +-- > (^$) :: Getter a c -> a -> c +-- > (^$) :: Monoid m => Fold a m -> a -> m +-- > (^$) :: Iso a b c d -> a -> c -- > (^$) :: Lens a b c d -> a -> c --- > (^$) :: Getter a b c d -> a -> c --- > (^$) :: Monoid m => Fold a b m d -> a -> m -- > (^$) :: Monoid m => Traversal a b m d -> a -> m -- -- > (^$) :: ((c -> Const c d) -> a -> Const c b) -> a -> c @@ -714,9 +801,10 @@ -- > ghci> ((0, 1 :+ 2), 3)^._1._2.to magnitude -- > 2.23606797749979 -- +-- > (^.) :: a -> Getter a c -> c +-- > (^.) :: Monoid m => a -> Fold a m -> m +-- > (^.) :: a -> Iso a b c d -> c -- > (^.) :: a -> Lens a b c d -> c --- > (^.) :: a -> Getter a b c d -> c --- > (^.) :: Monoid m => a -> Fold a b m d -> m -- > (^.) :: Monoid m => a -> Traversal a b m d -> m -- -- > (^.) :: a -> ((c -> Const c d) -> a -> Const c b) -> c @@ -753,10 +841,6 @@ _2 f (c,a) = (,) c <$> f a {-# INLINE _2 #-} --- | This lens can be used to access the contents of the Identity monad -identity :: Lens (Identity a) (Identity b) a b -identity f (Identity a) = Identity <$> f a -{-# INLINE identity #-} -- | This lens can be used to change the result of a function but only where -- the arguments match the key given. @@ -775,9 +859,10 @@ -- -- > whisper l d = tell (set l d mempty) +-- > whisper :: (MonadWriter b m, Monoid a) => Iso a b c d -> d -> m () -- > whisper :: (MonadWriter b m, Monoid a) => Lens a b c d -> d -> m () --- > whisper :: (MonadWriter b m, Monoid a) => Setter a b c d -> d -> m () -- > whisper :: (MonadWriter b m, Monoid a) => Traversal a b c d -> d -> m () +-- > whisper :: (MonadWriter b m, Monoid a) => Setter a b c d -> d -> m () -- -- > whisper :: (MonadWriter b m, Monoid a) => ((c -> Identity d) -> a -> Identity b) -> d -> m () whisper :: (MonadWriter b m, Monoid a) => Setter a b c d -> d -> m () @@ -789,12 +874,13 @@ ------------------------------------------------------------------------------ -- | --- Query the target of a 'Lens' or 'Getter' in the current state, or use a +-- Query the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a -- summary of a 'Fold' or 'Traversal' that points to a monoidal value. -- --- > query :: MonadReader a m => Getter a b c d -> m c +-- > query :: MonadReader a m => Getter a c -> m c +-- > query :: (MonadReader a m, Monoid c) => Fold a c -> m c +-- > query :: MonadReader a m => Iso a b c d -> m c -- > query :: MonadReader a m => Lens a b c d -> m c --- > query :: (MonadReader a m, Monoid c) => Fold a b c d -> m c -- > query :: (MonadReader a m, Monoid c) => Traversal a b c d -> m c -- -- > query :: MonadReader a m => ((c -> Const c d) -> a -> Const c b) -> m c @@ -803,12 +889,13 @@ {-# INLINE query #-} -- | --- Use the target of a 'Lens' or 'Getter' in the current state, or use a +-- Use the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a -- summary of a 'Fold' or 'Traversal' that points to a monoidal value. -- --- > queries :: MonadReader a m => Getter a b c d -> (c -> e) -> m e +-- > queries :: MonadReader a m => Getter a c -> (c -> e) -> m e +-- > queries :: (MonadReader a m, Monoid c) => Fold a c -> (c -> e) -> m e +-- > queries :: MonadReader a m => Iso a b c d -> (c -> e) -> m e -- > queries :: MonadReader a m => Lens a b c d -> (c -> e) -> m e --- > queries :: (MonadReader a m, Monoid c) => Fold a b c d -> (c -> e) -> m e -- > queries :: (MonadReader a m, Monoid c) => Traversal a b c d -> (c -> e) -> m e -- -- > queries :: MonadReader a m => ((c -> Const e d) -> a -> Const e b) -> (c -> e) -> m e @@ -821,13 +908,14 @@ ------------------------------------------------------------------------------ -- | --- Use the target of a 'Lens' or 'Getter' in the current state, or use a +-- Use the target of a 'Lens', 'Iso', or 'Getter' in the current state, or use a -- summary of a 'Fold' or 'Traversal' that points to a monoidal value. -- --- > use :: MonadState a m => Getter a b c d -> m c +-- > use :: MonadState a m => Getter a c -> m c +-- > use :: (MonadState a m, Monoid r) => Fold a r -> m r +-- > use :: MonadState a m => Iso a b c d -> m c -- > use :: MonadState a m => Lens a b c d -> m c --- > use :: (MonadState a m, Monoid c) => Fold a b c d -> m c --- > use :: (MonadState a m, Monoid c) => Traversal a b c d -> m c +-- > use :: (MonadState a m, Monoid r) => Traversal a b r d -> m r -- -- > use :: MonadState a m => ((c -> Const c d) -> a -> Const c b) -> m c use :: MonadState a m => Getting c a b c d -> m c @@ -835,13 +923,14 @@ {-# INLINE use #-} -- | --- Use the target of a 'Lens' or 'Getter' in the current state, or use a +-- Use the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a -- summary of a 'Fold' or 'Traversal' that points to a monoidal value. -- --- > uses :: MonadState a m => Getter a b c d -> (c -> e) -> m e +-- > uses :: MonadState a m => Getter a c -> (c -> e) -> m e +-- > uses :: (MonadState a m, Monoid r) => Fold a c -> (c -> r) -> m r -- > uses :: MonadState a m => Lens a b c d -> (c -> e) -> m e --- > uses :: (MonadState a m, Monoid c) => Fold a b c d -> (c -> e) -> m e --- > uses :: (MonadState a m, Monoid c) => Traversal a b c d -> (c -> e) -> m e +-- > uses :: MonadState a m => Iso a b c d -> (c -> e) -> m e +-- > uses :: (MonadState a m, Monoid r) => Traversal a b c d -> (c -> r) -> m r -- -- > uses :: MonadState a m => ((c -> Const e d) -> a -> Const e b) -> (c -> e) -> m e uses :: MonadState a m => Getting e a b c d -> (c -> e) -> m e @@ -851,16 +940,26 @@ -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic -- state with a new value, irrespective of the old. +-- +-- > (^=) :: MonadState a m => Iso a a c d -> d -> m () +-- > (^=) :: MonadState a m => Lens a a c d -> d -> m () +-- > (^=) :: MonadState a m => Traversal a a c d -> d -> m () +-- > (^=) :: MonadState a m => Setter a a c d -> d -> m () (^=) :: MonadState a m => Setter a a c d -> d -> m () l ^= b = State.modify (l ^~ b) {-# INLINE (^=) #-} -- | Map over the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal in our monadic state. +-- +-- > (%=) :: MonadState a m => Iso a a c d -> (c -> d) -> m () +-- > (%=) :: MonadState a m => Lens a a c d -> (c -> d) -> m () +-- > (%=) :: MonadState a m => Traversal a a c d -> (c -> d) -> m () +-- > (%=) :: MonadState a m => Setter a a c d -> (c -> d) -> m () (%=) :: MonadState a m => Setter a a c d -> (c -> d) -> m () l %= f = State.modify (l %~ f) {-# INLINE (%=) #-} --- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by adding a value +-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by adding a value -- -- Example: -- @@ -871,86 +970,87 @@ l += b = State.modify (l +~ b) {-# INLINE (+=) #-} --- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by subtracting a value +-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by subtracting a value (-=) :: (MonadState a m, Num b) => Simple Setter a b -> b -> m () l -= b = State.modify (l -~ b) {-# INLINE (-=) #-} --- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by multiplying by value +-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by multiplying by value (*=) :: (MonadState a m, Num b) => Simple Setter a b -> b -> m () l *= b = State.modify (l *~ b) {-# INLINE (*=) #-} --- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by dividing by a value +-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by dividing by a value (//=) :: (MonadState a m, Fractional b) => Simple Setter a b -> b -> m () l //= b = State.modify (l //~ b) {-# INLINE (//=) #-} --- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by taking their logical '&&' with a value +-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by taking their logical '&&' with a value (&&=):: MonadState a m => Simple Setter a Bool -> Bool -> m () l &&= b = State.modify (l &&~ b) {-# INLINE (&&=) #-} --- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by taking their logical '||' with a value +-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso, 'Setter' or 'Traversal' by taking their logical '||' with a value (||=) :: MonadState a m => Simple Setter a Bool -> Bool -> m () l ||= b = State.modify (l ||~ b) {-# INLINE (||=) #-} --- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by 'mappend'ing a value. +-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by 'mappend'ing a value. (<>=) :: (MonadState a m, Monoid b) => Simple Setter a b -> b -> m () l <>= b = State.modify (l <>~ b) {-# INLINE (<>=) #-} - - -------------------------- -- Folds -------------------------- -- | A 'Fold' describes how to retrieve multiple values in a way that can be composed -- with other lens-like constructions. -- --- A @'Fold' a b c d@ provides a structure with operations very similar to those of the 'Foldable' +-- A @'Fold' a c@ provides a structure with operations very similar to those of the 'Foldable' -- typeclass, see 'foldMapOf' and the other 'Fold' combinators. -- -- By convention, if there exists a 'foo' method that expects a @'Foldable' (f c)@, then there should be a --- 'fooOf' method that takes a @'Fold' a b c d@ and a value of type @a@. +-- 'fooOf' method that takes a @'Fold' a c@ and a value of type @a@. -- -- A 'Getter' is a legal 'Fold' that just ignores the supplied 'Monoid' -- -- Unlike a 'Traversal' a 'Fold' is read-only. Since a 'Fold' cannot be used to write back --- there are no lens laws that can be applied to it. --- --- In practice the @b@ and @d@ are left dangling and unused, and as such is no real point in a @'Simple' 'Fold'@. +-- there are no lens laws that apply. -- --- > type Fold a b c d = forall m. Monoid m => Getting m a b c d -type Fold a b c d = forall m. Monoid m => (c -> Const m d) -> a -> Const m b +-- > type Fold a c = forall m b d. Monoid m => Getting m a b c d +type Fold a c = forall m b d. Monoid m => (c -> Const m d) -> a -> Const m b -- | Build a 'Getter' or 'Fold' from a 'foldMap'-like function. -- -- > folds :: ((c -> m) -> a -> m) -> (c -> Const m d) -> a -> Const m b -folds :: ((c -> m) -> a -> m) -> Getting m a b c d -folds l f = Const . l (getConst . f) +-- > folds :: ((c -> m) -> a -> m) -> Getting m a b c d +folds :: Isomorphic k => k ((c -> m) -> a -> m) (Getting m a b c d) +folds = isomorphic (\l f -> Const . l (getConst . f)) + (\l f -> getConst . l (Const . f)) +{-# INLINE folds #-} +{-# SPECIALIZE folds :: ((c -> m) -> a -> m) -> Getting m a b c d #-} +{-# SPECIALIZE folds :: Isomorphism ((c -> m) -> a -> m) (Getting m a b c d) #-} -- | Obtain a 'Fold' by lifting an operation that returns a foldable result. -- -- This can be useful to lift operations from @Data.List@ and elsewhere into a 'Fold'. -folding :: Foldable f => (a -> f c) -> Fold a b c d +folding :: Foldable f => (a -> f c) -> Fold a c folding f g = Const . foldMap (getConst . g) . f {-# INLINE folding #-} --- | Obtain a 'Fold' from any 'Foldable' +-- | Obtain a 'Fold' from any 'Foldable'. -- -- > folded = folds foldMap -folded :: Foldable f => Fold (f c) b c d +folded :: Foldable f => Fold (f c) c folded = folds foldMap {-# INLINE folded #-} --- | Obtain a 'Fold' by filtering a 'Lens', 'Getter, 'Fold' or 'Traversal'. +-- | Obtain a 'Fold' by filtering a 'Lens', 'Iso', 'Getter, 'Fold' or 'Traversal'. filtered :: Monoid m => (c -> Bool) -> Getting m a b c d -> Getting m a b c d filtered p l f = l (\c -> if p c then f c else Const mempty) {-# INLINE filtered #-} --- | Obtain a 'Fold' by reversing the order of traversal for a 'Lens', 'Getter', 'Fold' or 'Traversal'. +-- | Obtain a 'Fold' by reversing the order of traversal for a 'Lens', 'Iso', 'Getter', 'Fold' or 'Traversal'. -- -- Of course, reversing a 'Fold' or 'Getter' has no effect. reversed :: Getting (Dual m) a b c d -> Getting m a b c d @@ -960,7 +1060,7 @@ --taking :: Int -> Getting (Taking m) a b c d -> Getting m a b c d --dropping :: Int -> Getting (Dropping m) a b c d -> Getting m a b c d --- | Obtain a 'Fold' by taking elements from another 'Fold', 'Lens', 'Getter' or 'Traversal' while a predicate holds. +-- | Obtain a 'Fold' by taking elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds. -- -- > takeWhile p = toListOf (takingWhile p folded) -- @@ -970,7 +1070,7 @@ takingWhile p l f = Const . foldrOf l (\a r -> if p a then getConst (f a) `mappend` r else mempty) mempty {-# INLINE takingWhile #-} --- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Lens', 'Getter' or 'Traversal' while a predicate holds. +-- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds. -- -- > dropWhile p = toListOf (droppingWhile p folded) -- @@ -988,23 +1088,30 @@ -- > foldMap = foldMapOf folded -- -- > foldMapOf = views +-- > foldMapOf = from folds -- --- > foldMapOf :: Getter a b c d -> (c -> m) -> a -> m +-- > foldMapOf :: Getter a c -> (c -> m) -> a -> m +-- > foldMapOf :: Monoid m => Fold a c -> (c -> m) -> a -> m -- > foldMapOf :: Lens a b c d -> (c -> m) -> a -> m --- > foldMapOf :: Monoid m => Fold a b c d -> (c -> m) -> a -> m +-- > foldMapOf :: Iso a b c d -> (c -> m) -> a -> m -- > foldMapOf :: Monoid m => Traversal a b c d -> (c -> m) -> a -> m -foldMapOf :: Getting m a b c d -> (c -> m) -> a -> m -foldMapOf l f = getConst . l (Const . f) +-- +-- > foldMapOf :: Getting m a b c d -> (c -> m) -> a -> m +foldMapOf :: Isomorphic k => k (Getting m a b c d) ((c -> m) -> a -> m) +foldMapOf = isomorphic (\l f -> getConst . l (Const . f)) + (\l f -> Const . l (getConst . f)) {-# INLINE foldMapOf #-} +{-# SPECIALIZE foldMapOf :: Getting m a b c d -> (c -> m) -> a -> m #-} -- | -- > fold = foldOf folded -- -- > foldOf = view -- --- > foldOf :: Getter a b m d -> a -> m +-- > foldOf :: Getter a m -> a -> m +-- > foldOf :: Monoid m => Fold a m -> a -> m -- > foldOf :: Lens a b m d -> a -> m --- > foldOf :: Monoid m => Fold a b m d -> a -> m +-- > foldOf :: Iso a b m d -> a -> m -- > foldOf :: Monoid m => Traversal a b m d -> a -> m foldOf :: Getting m a b m d -> a -> m foldOf l = getConst . l Const @@ -1015,9 +1122,10 @@ -- -- > foldr = foldrOf folded -- --- > foldrOf :: Getter a b c d -> (c -> e -> e) -> e -> a -> e +-- > foldrOf :: Getter a c -> (c -> e -> e) -> e -> a -> e +-- > foldrOf :: Fold a c -> (c -> e -> e) -> e -> a -> e -- > foldrOf :: Lens a b c d -> (c -> e -> e) -> e -> a -> e --- > foldrOf :: Fold a b c d -> (c -> e -> e) -> e -> a -> e +-- > foldrOf :: Iso a b c d -> (c -> e -> e) -> e -> a -> e -- > foldrOf :: Traversal a b c d -> (c -> e -> e) -> e -> a -> e foldrOf :: Getting (Endo e) a b c d -> (c -> e -> e) -> e -> a -> e foldrOf l f z t = appEndo (foldMapOf l (Endo . f) t) z @@ -1028,9 +1136,10 @@ -- -- > foldl = foldlOf folded -- --- > foldlOf :: Getter a b c d -> (e -> c -> e) -> e -> a -> e +-- > foldlOf :: Getter a c -> (e -> c -> e) -> e -> a -> e +-- > foldlOf :: Fold a c -> (e -> c -> e) -> e -> a -> e -- > foldlOf :: Lens a b c d -> (e -> c -> e) -> e -> a -> e --- > foldlOf :: Fold a b c d -> (e -> c -> e) -> e -> a -> e +-- > foldlOf :: Iso a b c d -> (e -> c -> e) -> e -> a -> e -- > foldlOf :: Traversal a b c d -> (e -> c -> e) -> e -> a -> e foldlOf :: Getting (Dual (Endo e)) a b c d -> (e -> c -> e) -> e -> a -> e foldlOf l f z t = appEndo (getDual (foldMapOf l (Dual . Endo . flip f) t)) z @@ -1039,9 +1148,10 @@ -- | -- > toList = toListOf folded -- --- > toListOf :: Getter a b c d -> a -> [c] +-- > toListOf :: Getter a c -> a -> [c] +-- > toListOf :: Fold a c -> a -> [c] -- > toListOf :: Lens a b c d -> a -> [c] --- > toListOf :: Fold a b c d -> a -> [c] +-- > toListOf :: Iso a b c d -> a -> [c] -- > toListOf :: Traversal a b c d -> a -> [c] toListOf :: Getting [c] a b c d -> a -> [c] toListOf l = foldMapOf l return @@ -1050,9 +1160,10 @@ -- | -- > and = andOf folded -- --- > andOf :: Getter a b Bool d -> a -> Bool +-- > andOf :: Getter a Bool -> a -> Bool +-- > andOf :: Fold a Bool -> a -> Bool -- > andOf :: Lens a b Bool d -> a -> Bool --- > andOf :: Fold a b Bool d -> a -> Bool +-- > andOf :: Iso a b Bool d -> a -> Bool -- > andOf :: Traversl a b Bool d -> a -> Bool andOf :: Getting All a b Bool d -> a -> Bool andOf l = getAll . foldMapOf l All @@ -1061,9 +1172,10 @@ -- | -- > or = orOf folded -- --- > orOf :: Getter a b Bool d -> a -> Bool +-- > orOf :: Getter a Bool -> a -> Bool +-- > orOf :: Fold a Bool -> a -> Bool -- > orOf :: Lens a b Bool d -> a -> Bool --- > orOf :: Fold a b Bool d -> a -> Bool +-- > orOf :: Iso a b Bool d -> a -> Bool -- > orOf :: Traversal a b Bool d -> a -> Bool orOf :: Getting Any a b Bool d -> a -> Bool orOf l = getAny . foldMapOf l Any @@ -1072,9 +1184,10 @@ -- | -- > any = anyOf folded -- --- > anyOf :: Getter a b c d -> (c -> Bool) -> a -> Bool +-- > anyOf :: Getter a c -> (c -> Bool) -> a -> Bool +-- > anyOf :: Fold a c -> (c -> Bool) -> a -> Bool -- > anyOf :: Lens a b c d -> (c -> Bool) -> a -> Bool --- > anyOf :: Fold a b c d -> (c -> Bool) -> a -> Bool +-- > anyOf :: Iso a b c d -> (c -> Bool) -> a -> Bool -- > anyOf :: Traversal a b c d -> (c -> Bool) -> a -> Bool anyOf :: Getting Any a b c d -> (c -> Bool) -> a -> Bool anyOf l f = getAny . foldMapOf l (Any . f) @@ -1083,9 +1196,10 @@ -- | -- > all = allOf folded -- --- > allOf :: Getter a b c d -> (c -> Bool) -> a -> Bool +-- > allOf :: Getter a c -> (c -> Bool) -> a -> Bool +-- > allOf :: Fold a c -> (c -> Bool) -> a -> Bool -- > allOf :: Lens a b c d -> (c -> Bool) -> a -> Bool --- > allOf :: Fold a b c d -> (c -> Bool) -> a -> Bool +-- > allOf :: Iso a b c d -> (c -> Bool) -> a -> Bool -- > allOf :: Traversal a b c d -> (c -> Bool) -> a -> Bool allOf :: Getting All a b c d -> (c -> Bool) -> a -> Bool allOf l f = getAll . foldMapOf l (All . f) @@ -1094,9 +1208,10 @@ -- | -- > product = productOf folded -- --- > productOf :: Getter a b c d -> a -> c +-- > productOf :: Getter a c -> a -> c +-- > productOf :: Num c => Fold a c -> a -> c -- > productOf :: Lens a b c d -> a -> c --- > productOf :: Num c => Fold a b c d -> a -> c +-- > productOf :: Iso a b c d -> a -> c -- > productOf :: Num c => Traversal a b c d -> a -> c productOf :: Getting (Product c) a b c d -> a -> c productOf l = getProduct . foldMapOf l Product @@ -1108,9 +1223,10 @@ -- > sumOf _1 :: (a, b) -> a -- > sumOf (folded._1) :: (Foldable f, Num a) => f (a, b) -> a -- --- > sumOf :: Getter a b c d -> a -> c +-- > sumOf :: Getter a c -> a -> c +-- > sumOf :: Num c => Fold a c -> a -> c -- > sumOf :: Lens a b c d -> a -> c --- > sumOf :: Num c => Fold a b c d -> a -> c +-- > sumOf :: Iso a b c d -> a -> c -- > sumOf :: Num c => Traversal a b c d -> a -> c sumOf :: Getting (Sum c) a b c d -> a -> c sumOf l = getSum . foldMapOf l Sum @@ -1129,9 +1245,10 @@ -- -- The rather specific signature of traverseOf_ allows it to be used as if the signature was either: -- --- > traverseOf_ :: Functor f => Getter a b c d -> (c -> f e) -> a -> f () +-- > traverseOf_ :: Functor f => Getter a c -> (c -> f e) -> a -> f () +-- > traverseOf_ :: Applicative f => Fold a c -> (c -> f e) -> a -> f () -- > traverseOf_ :: Functor f => Lens a b c d -> (c -> f e) -> a -> f () --- > traverseOf_ :: Applicative f => Fold a b c d -> (c -> f e) -> a -> f () +-- > traverseOf_ :: Functor f => Iso a b c d -> (c -> f e) -> a -> f () -- > traverseOf_ :: Applicative f => Traversal a b c d -> (c -> f e) -> a -> f () traverseOf_ :: Functor f => Getting (Traversed f) a b c d -> (c -> f e) -> a -> f () traverseOf_ l f = getTraversed . foldMapOf l (Traversed . void . f) @@ -1140,9 +1257,10 @@ -- | -- > for_ = forOf_ folded -- --- > forOf_ :: Functor f => Getter a b c d -> a -> (c -> f e) -> f () +-- > forOf_ :: Functor f => Getter a c -> a -> (c -> f e) -> f () +-- > forOf_ :: Applicative f => Fold a c -> a -> (c -> f e) -> f () -- > forOf_ :: Functor f => Lens a b c d -> a -> (c -> f e) -> f () --- > forOf_ :: Applicative f => Fold a b c d -> a -> (c -> f e) -> f () +-- > forOf_ :: Functor f => Iso a b c d -> a -> (c -> f e) -> f () -- > forOf_ :: Applicative f => Traversal a b c d -> a -> (c -> f e) -> f () forOf_ :: Functor f => Getting (Traversed f) a b c d -> a -> (c -> f e) -> f () forOf_ l a f = traverseOf_ l f a @@ -1151,9 +1269,10 @@ -- | -- > sequenceA_ = sequenceAOf_ folded -- --- > sequenceAOf_ :: Functor f => Getter a b (f ()) d -> a -> f () +-- > sequenceAOf_ :: Functor f => Getter a (f ()) -> a -> f () +-- > sequenceAOf_ :: Applicative f => Fold a (f ()) -> a -> f () -- > sequenceAOf_ :: Functor f => Lens a b (f ()) d -> a -> f () --- > sequenceAOf_ :: Applicative f => Fold a b (f ()) d -> a -> f () +-- > sequenceAOf_ :: Functor f => Iso a b (f ()) d -> a -> f () -- > sequenceAOf_ :: Applicative f => Traversal a b (f ()) d -> a -> f () sequenceAOf_ :: Functor f => Getting (Traversed f) a b (f ()) d -> a -> f () sequenceAOf_ l = getTraversed . foldMapOf l (Traversed . void) @@ -1162,9 +1281,10 @@ -- | -- > mapM_ = mapMOf_ folded -- --- > mapMOf_ :: Monad m => Getter a b c d -> (c -> m e) -> a -> m () +-- > mapMOf_ :: Monad m => Getter a c -> (c -> m e) -> a -> m () +-- > mapMOf_ :: Monad m => Fold a c -> (c -> m e) -> a -> m () -- > mapMOf_ :: Monad m => Lens a b c d -> (c -> m e) -> a -> m () --- > mapMOf_ :: Monad m => Fold a b c d -> (c -> m e) -> a -> m () +-- > mapMOf_ :: Monad m => Iso a b c d -> (c -> m e) -> a -> m () -- > mapMOf_ :: Monad m => Traversal a b c d -> (c -> m e) -> a -> m () mapMOf_ :: Monad m => Getting (Action m) a b c d -> (c -> m e) -> a -> m () mapMOf_ l f = getAction . foldMapOf l (Action . liftM skip . f) @@ -1173,9 +1293,10 @@ -- | -- > forM_ = forMOf_ folded -- --- > forMOf_ :: Monad m => Getter a b c d -> a -> (c -> m e) -> m () +-- > forMOf_ :: Monad m => Getter a c -> a -> (c -> m e) -> m () +-- > forMOf_ :: Monad m => Fold a c -> a -> (c -> m e) -> m () -- > forMOf_ :: Monad m => Lens a b c d -> a -> (c -> m e) -> m () --- > forMOf_ :: Monad m => Fold a b c d -> a -> (c -> m e) -> m () +-- > forMOf_ :: Monad m => Iso a b c d -> a -> (c -> m e) -> m () -- > forMOf_ :: Monad m => Traversal a b c d -> a -> (c -> m e) -> m () forMOf_ :: Monad m => Getting (Action m) a b c d -> a -> (c -> m e) -> m () forMOf_ l a f = mapMOf_ l f a @@ -1184,9 +1305,10 @@ -- | -- > sequence_ = sequenceOf_ folded -- --- > sequenceOf_ :: Monad m => Getter a b (m b) d -> a -> m () +-- > sequenceOf_ :: Monad m => Getter a (m b) -> a -> m () +-- > sequenceOf_ :: Monad m => Fold a (m b) -> a -> m () -- > sequenceOf_ :: Monad m => Lens a b (m b) d -> a -> m () --- > sequenceOf_ :: Monad m => Fold a b (m b) d -> a -> m () +-- > sequenceOf_ :: Monad m => Iso a b (m b) d -> a -> m () -- > sequenceOf_ :: Monad m => Traversal a b (m b) d -> a -> m () sequenceOf_ :: Monad m => Getting (Action m) a b (m c) d -> a -> m () sequenceOf_ l = getAction . foldMapOf l (Action . liftM skip) @@ -1196,9 +1318,10 @@ -- -- > asum = asumOf folded -- --- > asumOf :: Alternative f => Getter a b c d -> a -> f c +-- > asumOf :: Alternative f => Getter a c -> a -> f c +-- > asumOf :: Alternative f => Fold a c -> a -> f c -- > asumOf :: Alternative f => Lens a b c d -> a -> f c --- > asumOf :: Alternative f => Fold a b c d -> a -> f c +-- > asumOf :: Alternative f => Iso a b c d -> a -> f c -- > asumOf :: Alternative f => Traversal a b c d -> a -> f c asumOf :: Alternative f => Getting (Endo (f c)) a b (f c) d -> a -> f c asumOf l = foldrOf l (<|>) Applicative.empty @@ -1208,9 +1331,10 @@ -- -- > msum = msumOf folded -- --- > msumOf :: MonadPlus m => Getter a b c d -> a -> m c +-- > msumOf :: MonadPlus m => Getter a c -> a -> m c +-- > msumOf :: MonadPlus m => Fold a c -> a -> m c -- > msumOf :: MonadPlus m => Lens a b c d -> a -> m c --- > msumOf :: MonadPlus m => Fold a b c d -> a -> m c +-- > msumOf :: MonadPlus m => Iso a b c d -> a -> m c -- > msumOf :: MonadPlus m => Traversal a b c d -> a -> m c msumOf :: MonadPlus m => Getting (Endo (m c)) a b (m c) d -> a -> m c msumOf l = foldrOf l mplus mzero @@ -1219,9 +1343,10 @@ -- | -- > elem = elemOf folded -- --- > elemOf :: Eq c => Getter a b c d -> c -> a -> Bool +-- > elemOf :: Eq c => Getter a c -> c -> a -> Bool +-- > elemOf :: Eq c => Fold a c -> c -> a -> Bool -- > elemOf :: Eq c => Lens a b c d -> c -> a -> Bool --- > elemOf :: Eq c => Fold a b c d -> c -> a -> Bool +-- > elemOf :: Eq c => Iso a b c d -> c -> a -> Bool -- > elemOf :: Eq c => Traversal a b c d -> c -> a -> Bool elemOf :: Eq c => Getting Any a b c d -> c -> a -> Bool elemOf l = anyOf l . (==) @@ -1230,8 +1355,9 @@ -- | -- > notElem = notElemOf folded -- --- > notElemOf :: Eq c => Getter a b c d -> c -> a -> Bool --- > notElemOf :: Eq c => Fold a b c d -> c -> a -> Bool +-- > notElemOf :: Eq c => Getter a c -> c -> a -> Bool +-- > notElemOf :: Eq c => Fold a c -> c -> a -> Bool +-- > notElemOf :: Eq c => Iso a b c d -> c -> a -> Bool -- > notElemOf :: Eq c => Lens a b c d -> c -> a -> Bool -- > notElemOf :: Eq c => Traversal a b c d -> c -> a -> Bool notElemOf :: Eq c => Getting All a b c d -> c -> a -> Bool @@ -1241,9 +1367,10 @@ -- | -- > concatMap = concatMapOf folded -- --- > concatMapOf :: Getter a b c d -> (c -> [e]) -> a -> [e] +-- > concatMapOf :: Getter a c -> (c -> [e]) -> a -> [e] +-- > concatMapOf :: Fold a c -> (c -> [e]) -> a -> [e] -- > concatMapOf :: Lens a b c d -> (c -> [e]) -> a -> [e] --- > concatMapOf :: Fold a b c d -> (c -> [e]) -> a -> [e] +-- > concatMapOf :: Iso a b c d -> (c -> [e]) -> a -> [e] -- > concatMapOf :: Traversal a b c d -> (c -> [e]) -> a -> [e] concatMapOf :: Getting [e] a b c d -> (c -> [e]) -> a -> [e] concatMapOf l ces a = getConst (l (Const . ces) a) @@ -1252,10 +1379,11 @@ -- | -- > concat = concatOf folded -- --- > concatOf :: Getter a b [e] d -> a -> [e] --- > concatOf :: Lens a b [e] d -> a -> [e] --- > concatOf :: Fold a b [e] d -> a -> [e] --- > concatOf :: a b [e] d -> a -> [e] +-- > concatOf :: Getter a [e] -> a -> [e] +-- > concatOf :: Fold a [e] -> a -> [e] +-- > concatOf :: Iso a b [e] d -> a -> [e] +-- > concatOf :: Lens a b [e] d -> a -> [e] +-- > concatOf :: Traversal a b [e] d -> a -> [e] concatOf :: Getting [e] a b [e] d -> a -> [e] concatOf = view {-# INLINE concatOf #-} @@ -1269,9 +1397,10 @@ -- > lengthOf _1 = 1 -- > lengthOf (folded.folded) :: Foldable f => f (g a) -> Int -- --- > lengthOf :: Getter a b c d -> a -> Int +-- > lengthOf :: Getter a c -> a -> Int +-- > lengthOf :: Fold a c -> a -> Int -- > lengthOf :: Lens a b c d -> a -> Int --- > lengthOf :: Fold a b c d -> a -> Int +-- > lengthOf :: Iso a b c d -> a -> Int -- > lengthOf :: Traversal a b c d -> a -> Int lengthOf :: Getting (Sum Int) a b c d -> a -> Int lengthOf l = getSum . foldMapOf l (\_ -> Sum 1) @@ -1282,9 +1411,10 @@ -- -- > listToMaybe . toList = headOf folded -- --- > headOf :: Getter a b c d -> a -> Maybe c +-- > headOf :: Getter a c -> a -> Maybe c +-- > headOf :: Fold a c -> a -> Maybe c -- > headOf :: Lens a b c d -> a -> Maybe c --- > headOf :: Fold a b c d -> a -> Maybe c +-- > headOf :: Iso a b c d -> a -> Maybe c -- > headOf :: Traversal a b c d -> a -> Maybe c headOf :: Getting (First c) a b c d -> a -> Maybe c headOf l = getFirst . foldMapOf l (First . Just) @@ -1293,9 +1423,10 @@ -- | Perform a safe 'last' of a 'Fold' or 'Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'. -- --- > lastOf :: Getter a b c d -> a -> Maybe c +-- > lastOf :: Getter a c -> a -> Maybe c +-- > lastOf :: Fold a c -> a -> Maybe c -- > lastOf :: Lens a b c d -> a -> Maybe c --- > lastOf :: Fold a b c d -> a -> Maybe c +-- > lastOf :: Iso a b c d -> a -> Maybe c -- > lastOf :: Traversal a b c d -> a -> Maybe c lastOf :: Getting (Last c) a b c d -> a -> Maybe c lastOf l = getLast . foldMapOf l (Last . Just) @@ -1304,7 +1435,7 @@ -- | -- Returns 'True' if this 'Fold' or 'Traversal' has no targets in the given container. -- --- Note: nullOf on a valid 'Lens' or 'Getter' should always return 'False' +-- Note: nullOf on a valid 'Iso', 'Lens' or 'Getter' should always return 'False' -- -- > null = nullOf folded -- @@ -1314,9 +1445,10 @@ -- > nullOf _1 = False -- > nullOf (folded._1.folded) :: Foldable f => f (g a, b) -> Bool -- --- > nullOf :: Getter a b c d -> a -> Bool +-- > nullOf :: Getter a c -> a -> Bool +-- > nullOf :: Fold a c -> a -> Bool +-- > nullOf :: Iso a b c d -> a -> Bool -- > nullOf :: Lens a b c d -> a -> Bool --- > nullOf :: Fold a b c d -> a -> Bool -- > nullOf :: Traversal a b c d -> a -> Bool nullOf :: Getting All a b c d -> a -> Bool nullOf l = getAll . foldMapOf l (\_ -> All False) @@ -1325,13 +1457,14 @@ -- | -- Obtain the maximum element (if any) targeted by a 'Fold' or 'Traversal' -- --- Note: maximumOf on a valid 'Lens' or 'Getter' will always return 'Just' a value. +-- Note: maximumOf on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value. -- -- > maximum = fromMaybe (error "empty") . maximumOf folded -- --- > maximumOf :: Getter a b c d -> a -> Maybe c +-- > maximumOf :: Getter a c -> a -> Maybe c +-- > maximumOf :: Ord c => Fold a c -> a -> Maybe c +-- > maximumOf :: Iso a b c d -> a -> Maybe c -- > maximumOf :: Lens a b c d -> a -> Maybe c --- > maximumOf :: Ord c => Fold a b c d -> a -> Maybe c -- > maximumOf :: Ord c => Traversal a b c d -> a -> Maybe c maximumOf :: Getting (Max c) a b c d -> a -> Maybe c maximumOf l = getMax . foldMapOf l Max @@ -1340,27 +1473,29 @@ -- | -- Obtain the minimum element (if any) targeted by a 'Fold' or 'Traversal' -- --- Note: minimumOf on a valid 'Lens' or 'Getter' will always return 'Just' a value. +-- Note: minimumOf on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value. -- -- > minimum = fromMaybe (error "empty") . minimumOf folded -- --- > minimumOf :: Getter a b c d -> a -> Maybe c +-- > minimumOf :: Getter a c -> a -> Maybe c +-- > minimumOf :: Ord c => Fold a c -> a -> Maybe c +-- > minimumOf :: Iso a b c d -> a -> Maybe c -- > minimumOf :: Lens a b c d -> a -> Maybe c --- > minimumOf :: Ord c => Fold a b c d -> a -> Maybe c -- > minimumOf :: Ord c => Traversal a b c d -> a -> Maybe c minimumOf :: Getting (Min c) a b c d -> a -> Maybe c minimumOf l = getMin . foldMapOf l Min {-# INLINE minimumOf #-} -- | --- Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens' +-- Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso', -- or 'Getter' according to a user supplied ordering. -- -- > maximumBy cmp = fromMaybe (error "empty") . maximumByOf folded cmp -- --- > maximumByOf :: Getter a b c d -> (c -> c -> Ordering) -> a -> Maybe c +-- > maximumByOf :: Getter a c -> (c -> c -> Ordering) -> a -> Maybe c +-- > maximumByOf :: Fold a c -> (c -> c -> Ordering) -> a -> Maybe c +-- > maximumByOf :: Iso a b c d -> (c -> c -> Ordering) -> a -> Maybe c -- > maximumByOf :: Lens a b c d -> (c -> c -> Ordering) -> a -> Maybe c --- > maximumByOf :: Fold a b c d -> (c -> c -> Ordering) -> a -> Maybe c -- > maximumByOf :: Traversal a b c d -> (c -> c -> Ordering) -> a -> Maybe c maximumByOf :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> Ordering) -> a -> Maybe c maximumByOf l cmp = foldrOf l step Nothing where @@ -1369,14 +1504,15 @@ {-# INLINE maximumByOf #-} -- | --- Obtain the minimum element (if any) targeted by a 'Fold', 'Traversal', 'Lens' +-- Obtain the minimum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso' -- or 'Getter' according to a user supplied ordering. -- -- > minimumBy cmp = fromMaybe (error "empty") . minimumByOf folded cmp -- --- > minimumByOf :: Getter a b c d -> (c -> c -> Ordering) -> a -> Maybe c +-- > minimumByOf :: Getter a c -> (c -> c -> Ordering) -> a -> Maybe c +-- > minimumByOf :: Fold a c -> (c -> c -> Ordering) -> a -> Maybe c +-- > minimumByOf :: Iso a b c d -> (c -> c -> Ordering) -> a -> Maybe c -- > minimumByOf :: Lens a b c d -> (c -> c -> Ordering) -> a -> Maybe c --- > minimumByOf :: Fold a b c d -> (c -> c -> Ordering) -> a -> Maybe c -- > minimumByOf :: Traversal a b c d -> (c -> c -> Ordering) -> a -> Maybe c minimumByOf :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> Ordering) -> a -> Maybe c minimumByOf l cmp = foldrOf l step Nothing where @@ -1384,9 +1520,15 @@ step a (Just b) = Just (if cmp a b == GT then b else a) {-# INLINE minimumByOf #-} --- | The 'findOf' function takes a lens, a predicate and a structure and returns --- the leftmost element of the structure matching the predicate, or --- 'Nothing' if there is no such element. +-- | The 'findOf' function takes a lens (or , getter, iso, fold, or traversal), +-- a predicate and a structure and returns the leftmost element of the structure +-- matching the predicate, or 'Nothing' if there is no such element. +-- +-- > findOf :: Getter a c -> (c -> Bool) -> a -> Maybe c +-- > findOf :: Fold a c -> (c -> Bool) -> a -> Maybe c +-- > findOf :: Iso a b c d -> (c -> Bool) -> a -> Maybe c +-- > findOf :: Lens a b c d -> (c -> Bool) -> a -> Maybe c +-- > findOf :: Traversal a b c d -> (c -> Bool) -> a -> Maybe c findOf :: Getting (First c) a b c d -> (c -> Bool) -> a -> Maybe c findOf l p = getFirst . foldMapOf l step where step c @@ -1403,9 +1545,10 @@ -- -- > foldr1 = foldr1Of folded -- --- > foldr1Of :: Getter a b c d -> (c -> c -> c) -> a -> c +-- > foldr1Of :: Getter a c -> (c -> c -> c) -> a -> c +-- > foldr1Of :: Fold a c -> (c -> c -> c) -> a -> c +-- > foldr1Of :: Iso a b c d -> (c -> c -> c) -> a -> c -- > foldr1Of :: Lens a b c d -> (c -> c -> c) -> a -> c --- > foldr1Of :: Fold a b c d -> (c -> c -> c) -> a -> c -- > foldr1Of :: Traversal a b c d -> (c -> c -> c) -> a -> c foldr1Of :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> c) -> a -> c foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure") @@ -1421,9 +1564,10 @@ -- -- > foldl1 = foldl1Of folded -- --- > foldl1Of :: Getter a b c d -> (c -> c -> c) -> a -> c +-- > foldl1Of :: Getter a c -> (c -> c -> c) -> a -> c +-- > foldl1Of :: Fold a c -> (c -> c -> c) -> a -> c +-- > foldl1Of :: Iso a b c d -> (c -> c -> c) -> a -> c -- > foldl1Of :: Lens a b c d -> (c -> c -> c) -> a -> c --- > foldl1Of :: Fold a b c d -> (c -> c -> c) -> a -> c -- > foldl1Of :: Traversal a b c d -> (c -> c -> c) -> a -> c foldl1Of :: Getting (Dual (Endo (Maybe c))) a b c d -> (c -> c -> c) -> a -> c foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where @@ -1435,9 +1579,10 @@ -- -- > foldr' = foldrOf' folded -- --- > foldrOf' :: Getter a b c d -> (c -> e -> e) -> e -> a -> e +-- > foldrOf' :: Getter a c -> (c -> e -> e) -> e -> a -> e +-- > foldrOf' :: Fold a c -> (c -> e -> e) -> e -> a -> e +-- > foldrOf' :: Iso a b c d -> (c -> e -> e) -> e -> a -> e -- > foldrOf' :: Lens a b c d -> (c -> e -> e) -> e -> a -> e --- > foldrOf' :: Fold a b c d -> (c -> e -> e) -> e -> a -> e -- > foldrOf' :: Traversal a b c d -> (c -> e -> e) -> e -> a -> e foldrOf' :: Getting (Dual (Endo (e -> e))) a b c d -> (c -> e -> e) -> e -> a -> e foldrOf' l f z0 xs = foldlOf l f' id xs z0 @@ -1448,10 +1593,11 @@ -- -- > foldl' = foldlOf' folded -- --- > foldlOf' :: Getter a b c d -> (e -> c -> e) -> e -> a -> e --- > foldlOf' :: Lens a b c d -> (e -> c -> e) -> e -> a -> e --- > foldlOf' :: Fold a b c d -> (e -> c -> e) -> e -> a -> e --- > foldlOf' :: Traversal a b c d -> (e -> c -> e) -> e -> a -> e +-- > foldlOf' :: Getter a c -> (e -> c -> e) -> e -> a -> e +-- > foldlOf' :: Fold a c -> (e -> c -> e) -> e -> a -> e +-- > foldlOf' :: Iso a b c d -> (e -> c -> e) -> e -> a -> e +-- > foldlOf' :: Lens a b c d -> (e -> c -> e) -> e -> a -> e +-- > foldlOf' :: Traversal a b c d -> (e -> c -> e) -> e -> a -> e foldlOf' :: Getting (Endo (e -> e)) a b c d -> (e -> c -> e) -> e -> a -> e foldlOf' l f z0 xs = foldrOf l f' id xs z0 where f' x k z = k $! f z x @@ -1462,9 +1608,10 @@ -- -- > foldrM = foldrMOf folded -- --- > foldrMOf :: Monad m => Getter a b c d -> (c -> e -> m e) -> e -> a -> m e +-- > foldrMOf :: Monad m => Getter a c -> (c -> e -> m e) -> e -> a -> m e +-- > foldrMOf :: Monad m => Fold a c -> (c -> e -> m e) -> e -> a -> m e +-- > foldrMOf :: Monad m => Iso a b c d -> (c -> e -> m e) -> e -> a -> m e -- > foldrMOf :: Monad m => Lens a b c d -> (c -> e -> m e) -> e -> a -> m e --- > foldrMOf :: Monad m => Fold a b c d -> (c -> e -> m e) -> e -> a -> m e -- > foldrMOf :: Monad m => Traversal a b c d -> (c -> e -> m e) -> e -> a -> m e foldrMOf :: Monad m => Getting (Dual (Endo (e -> m e))) a b c d @@ -1478,9 +1625,10 @@ -- -- > foldlM = foldlMOf folded -- --- > foldlMOf :: Monad m => Getter a b c d -> (e -> c -> m e) -> e -> a -> m e +-- > foldlMOf :: Monad m => Getter a c -> (e -> c -> m e) -> e -> a -> m e +-- > foldlMOf :: Monad m => Fold a c -> (e -> c -> m e) -> e -> a -> m e +-- > foldlMOf :: Monad m => Iso a b c d -> (e -> c -> m e) -> e -> a -> m e -- > foldlMOf :: Monad m => Lens a b c d -> (e -> c -> m e) -> e -> a -> m e --- > foldlMOf :: Monad m => Fold a b c d -> (e -> c -> m e) -> e -> a -> m e -- > foldlMOf :: Monad m => Traversal a b c d -> (e -> c -> m e) -> e -> a -> m e foldlMOf :: Monad m => Getting (Endo (e -> m e)) a b c d @@ -1502,8 +1650,7 @@ -- | A traversal for tweaking the left-hand value in an Either: -- --- > traverseLeft :: Applicative f --- > => (a -> f b) -> Either a c -> f (Either b c) +-- > traverseLeft :: Applicative f => (a -> f b) -> Either a c -> f (Either b c) traverseLeft :: Traversal (Either a c) (Either b c) a b traverseLeft f (Left a) = Left <$> f a traverseLeft _ (Right c) = pure $ Right c @@ -1511,12 +1658,12 @@ -- | traverse the right-hand value in an Either: -- --- > traverseRight :: Applicative f --- > => (a -> f b) -> Either c a -> f (Either c a) -- > traverseRight = traverse -- -- Unfortunately the instance for 'Traversable (Either c)' is still missing -- from base, so this can't just be 'traverse' +-- +-- > traverseRight :: Applicative f => (a -> f b) -> Either c a -> f (Either c a) traverseRight :: Traversal (Either c a) (Either c b) a b traverseRight _ (Left c) = pure $ Left c traverseRight f (Right a) = Right <$> f a @@ -1531,34 +1678,121 @@ {-# INLINE traverseValue #-} ------------------------------------------------------------------------------ +-- Transforming Traversals +------------------------------------------------------------------------------ + +-- | This allows you to 'traverse' the elements of a 'Traversal' in the +-- opposite order. +-- +-- Note: 'reversed' is similar, but is able to accept a 'Fold' (or 'Getter') +-- and produce a 'Fold' (or 'Getter'). +-- +-- This requires at least a 'Traversal' (or 'Lens') and can produce a +-- 'Traversal' (or 'Lens') in turn. +-- +-- A backwards 'Iso' is the same 'Iso'. If you reverse the direction of +-- the isomorphism use 'from' instead. +backwards :: Isomorphic k => IsoLike k (Backwards f) a b c d -> IsoLike k f a b c d +backwards = isomap + (\l f -> forwards . l (Backwards . f)) + (\l f -> forwards . l (Backwards . f)) +{-# INLINE backwards #-} +{-# SPECIALIZE backwards :: LensLike (Backwards f) a b c d -> LensLike f a b c d #-} +{-# SPECIALIZE backwards :: IsoLike Isomorphism (Backwards f) a b c d -> IsoLike Isomorphism f a b c d #-} + +-- | Merge two lenses, getters, setters, folds or traversals. +merged :: Functor f => LensLike f a b c c -> LensLike f a' b' c c -> LensLike f (Either a a') (Either b b') c c +merged l _ f (Left a) = Left <$> l f a +merged _ r f (Right a') = Right <$> r f a' +{-# INLINE merged #-} + +-- | 'bothLenses' makes a lens from two other lenses (or isomorphisms) +bothLenses :: Lens a b c d -> Lens a' b' c' d' -> Lens (a,a') (b,b') (c,c') (d,d') +bothLenses l r f (a, a') = case l (IndexedStore id) a of + IndexedStore db c -> case r (IndexedStore id) a' of + IndexedStore db' c' -> (\(d,d') -> (db d, db' d')) <$> f (c,c') +{-# INLINE bothLenses #-} + +----------------------------------------------------------------------------- +-- Isomorphisms families as Lenses +----------------------------------------------------------------------------- + +-- | Isomorphim families can be composed with other lenses using either' (.)' and 'id' +-- from the Prelude or from Control.Category. However, if you compose them +-- with each other using '(.)' from the Prelude, they will be dumbed down to a +-- mere 'Lens'. +-- +-- > import Control.Category +-- > import Prelude hiding ((.),id) +-- +-- > type Iso a b c d = forall k f. (Isomorphic k, Functor f) => IsoLike k f a b c d +type Iso a b c d = forall k f. (Isomorphic k, Functor f) => k (c -> f d) (a -> f b) + +-- | > type SimpleIso a b = Simple Iso a b +type SimpleIso a b = Iso a a b b + +-- | > type LensLike f a b c d = IsoLike (->) f a b c d +type IsoLike k f a b c d = k (c -> f d) (a -> f b) + +-- | > type SimpleIsoLike k f a b = Simple (IsoLike k f) a b +type SimpleIsoLike k f a b = IsoLike k f a a b b + +-- | Build an isomorphism family from two pairs of inverse functions +-- +-- > isos :: (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> Iso a b c d +isos :: (Isomorphic k, Functor f) => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> IsoLike k f a b c d +isos ac ca bd db = isomorphic + (\cfd a -> db <$> cfd (ac a)) + (\afb c -> bd <$> afb (ca c)) +{-# INLINE isos #-} +{-# SPECIALIZE isos :: Functor f => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> LensLike f a b c d #-} +{-# SPECIALIZE isos :: Functor f => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> IsoLike Isomorphism f a b c d #-} + +-- | Build a simple isomorphism from a pair of inverse functions +-- +-- > iso :: (a -> b) -> (b -> a) -> Simple Iso a b +iso :: (Isomorphic k, Functor f) => (a -> b) -> (b -> a) -> SimpleIsoLike k f a b +iso ab ba = isos ab ba ab ba +{-# INLINE iso #-} +{-# SPECIALIZE iso :: Functor f => (a -> b) -> (b -> a) -> SimpleLensLike f a b #-} +{-# SPECIALIZE iso :: Functor f => (a -> b) -> (b -> a) -> SimpleIsoLike Isomorphism f a b #-} + +----------------------------------------------------------------------------- +-- Isomorphism +----------------------------------------------------------------------------- + +-- | This isomorphism can be used to wrap or unwrap a value in 'Identity'. +-- +-- > x^.identity = Identity x +-- > Identity x^.from identity = x +identity :: Iso a b (Identity a) (Identity b) +identity = isos Identity runIdentity Identity runIdentity +{-# INLINE identity #-} + +-- | This isomorphism can be used to wrap or unwrap a value in 'Const' +-- +-- > x^.konst = Const x +-- > Const x^.from konst = x +konst :: Iso a b (Const a c) (Const b d) +konst = isos Const getConst Const getConst +{-# INLINE konst #-} + +------------------------------------------------------------------------------ -- Cloning Lenses ------------------------------------------------------------------------------ --- | Cloning a 'Lens' is one way to make sure you arent given +-- | +-- +-- Cloning a 'Lens' is one way to make sure you arent given -- something weaker, such as a 'Traversal' and can be used -- as a way to pass around lenses that have to be monomorphic in 'f'. -- -- Note: This only accepts a proper 'Lens', because 'IndexedStore' lacks its -- (admissable) Applicative instance. +-- clone :: Functor f => LensLike (IndexedStore c d) a b c d -> (c -> f d) -> a -> f b clone f cfd a = case f (IndexedStore id) a of IndexedStore db c -> db <$> cfd c {-# INLINE clone #-} - ------------------------------------------------------------------------------- --- Transforming Traversals ------------------------------------------------------------------------------- - --- | This allows you to 'traverse' the elements of a 'Traversal' in the --- opposite order. --- --- Note: 'reversed' is similar, but is able to accept a 'Fold' (or 'Getter') --- and produce a 'Fold' (or 'Getter'). --- --- This requires at least a 'Traversal' (or 'Lens') and can produce a --- 'Traversal' (or 'Lens') in turn. -backwards :: LensLike (Backwards f) a b c d -> LensLike f a b c d -backwards l f = getBackwards . l (Backwards . f) -{-# INLINE backwards #-} diff --git a/src/Control/Lens/Internal.hs b/src/Control/Lens/Internal.hs --- a/src/Control/Lens/Internal.hs +++ b/src/Control/Lens/Internal.hs @@ -21,7 +21,6 @@ , Traversed(..) , Action(..) , AppliedState(..) - , Backwards(..) , Min(..) , getMin , Max(..) @@ -29,8 +28,14 @@ ) where import Control.Applicative +import Control.Category +import Prelude hiding ((.),id) import Data.Monoid +----------------------------------------------------------------------------- +-- Functors +----------------------------------------------------------------------------- + -- | Used by 'Focus' newtype Focusing m c a = Focusing { unfocusing :: m (c, a) } @@ -113,12 +118,3 @@ getMax NoMax = Nothing getMax (Max a) = Just a --- | Run an Applicative backwards -newtype Backwards f a = Backwards { getBackwards :: f a } - -instance Functor f => Functor (Backwards f) where - fmap f (Backwards as) = Backwards (fmap f as) - -instance Applicative f => Applicative (Backwards f) where - pure = Backwards . pure - Backwards f <*> Backwards a = Backwards (flip id <$> a <*> f) diff --git a/src/Control/Lens/Representable.hs b/src/Control/Lens/Representable.hs --- a/src/Control/Lens/Representable.hs +++ b/src/Control/Lens/Representable.hs @@ -100,7 +100,7 @@ rep :: (Rep f -> a) -> f a instance Representable Identity where - rep f = Identity (f identity) + rep f = Identity (f (from identity)) -- | NB: The Eq requirement on this instance is a consequence of a lens -- rather than 'e' as the representation. diff --git a/src/Control/Parallel/Strategies/Lens.hs b/src/Control/Parallel/Strategies/Lens.hs --- a/src/Control/Parallel/Strategies/Lens.hs +++ b/src/Control/Parallel/Strategies/Lens.hs @@ -12,8 +12,10 @@ -- monomorphic containers. ---------------------------------------------------------------------------- module Control.Parallel.Strategies.Lens - ( evalTraversal - , parTraversal + ( evalOf + , parOf + , after + , meanwhile ) where import Control.Lens @@ -30,19 +32,31 @@ -- > evalTraversal :: Simple Traversal a b -> Strategy b -> Strategy a -- -- > evalTraversal :: (b -> Eval b) -> a -> Eval a) -> Strategy b -> Strategy a -evalTraversal :: LensLike Eval a a b b -> Strategy b -> Strategy a -evalTraversal l = l +evalOf :: LensLike Eval a a b b -> Strategy b -> Strategy a +evalOf l = l -- | Evaluate the targets of a 'Lens' or 'Traversal' according into a -- data structure according to a given 'Strategy' in parallel. -- -- > parTraversable = parTraversal traverse -- --- > parTraversal l s = l (rparWith s) --- -- > parTraversal :: Simple Lens a b -> Strategy b -> Strategy a -- > parTraversal :: Simple Traversal a b -> Strategy b -> Strategy a -- -- > parTraversal :: ((b -> Eval b) -> a -> Eval a) -> Strategy b -> Strategy a -parTraversal :: LensLike Eval a a b b -> Strategy b -> Strategy a -parTraversal l s = l (rparWith s) +parOf :: LensLike Eval a a b b -> Strategy b -> Strategy a +parOf l s = l (rparWith s) + +-- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to +-- first evaluates its argument according to a given strategy, before proceeding. +-- +-- > after rdeepseq traverse +after :: Strategy a -> LensLike f a b c d -> LensLike f a b c d +after s l f = l f $| s + +-- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to +-- evaluate its argument according to a given strategy in parallel with evaluating. +-- +-- > meanwhile rdeepseq traverse +meanwhile :: Strategy a -> LensLike f a b c d -> LensLike f a b c d +meanwhile s l f = l f $|| s diff --git a/src/Control/Seq/Lens.hs b/src/Control/Seq/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Control/Seq/Lens.hs @@ -0,0 +1,24 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Seq.Lens +-- Copyright : (C) 2012 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +-- A 'Fold' can be used to take the role of 'Foldable' in @Control.Seq@ +---------------------------------------------------------------------------- +module Control.Seq.Lens + ( seqOf + ) where + +import Control.Lens +import Control.Seq + +-- | Evaluate the elements targeted by a Lens, Traversal, Getter or Fold +-- according to the given strategy. +-- +-- > seqFoldable = seqOf folded +seqOf :: Getting [c] a b c d -> Strategy c -> Strategy a +seqOf l s = seqList s . toListOf l diff --git a/src/Data/ByteString/Lazy/Lens.hs b/src/Data/ByteString/Lazy/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lazy/Lens.hs @@ -0,0 +1,62 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.ByteString.Lazy.Lens +-- Copyright : (C) 2012 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +-- Lenses for lazy bytestrings +---------------------------------------------------------------------------- +module Data.ByteString.Lazy.Lens + ( packedBytes, bytes + , packedChars, chars + ) where + +import Control.Lens +import Data.ByteString.Lazy as Words +import Data.ByteString.Lazy.Char8 as Char8 +import Data.Word (Word8) + +-- | Pack (or unpack) a list of bytes into a 'ByteString' +-- +-- > pack x = x^.packedBytes +-- > unpack x = x^.from packedBytes +packedBytes :: Simple Iso [Word8] ByteString +packedBytes = iso Words.pack Words.unpack +{-# INLINE packedBytes #-} +{-# SPECIALIZE packedBytes :: Simple Lens [Word8] ByteString #-} + +-- | Traverse the individual bytes in a 'ByteString' +-- +-- > bytes = from packedBytes . traverse +-- +-- > anyOf bytes (==0x80) :: ByteString -> Bool +bytes :: Simple Traversal ByteString Word8 +bytes = from packedBytes . traverse +{-# INLINE bytes #-} + +-- | Pack (or unpack) a list of characters into a 'ByteString' +-- +-- When writing back to the byteString it is assumed that all characters +-- lie between '\x00' and '\xff'. +-- +-- > pack x = x^.packedChars +-- > unpack x = x^.from packedChars +packedChars :: Simple Iso String ByteString +packedChars = iso Char8.pack Char8.unpack +{-# INLINE packedChars #-} +{-# SPECIALIZE packedChars :: Simple Lens String ByteString #-} + +-- | Traverse the individual bytes in a 'ByteString' as characters. +-- +-- When writing back to the byteString it is assumed that all characters +-- lie between '\x00' and '\xff'. +-- +-- > chars = from packed . traverse +-- +-- > anyOf chars (=='c') :: ByteString -> Bool +chars :: Simple Traversal ByteString Char +chars = from packedChars . traverse +{-# INLINE chars #-} diff --git a/src/Data/ByteString/Lens.hs b/src/Data/ByteString/Lens.hs --- a/src/Data/ByteString/Lens.hs +++ b/src/Data/ByteString/Lens.hs @@ -9,23 +9,53 @@ -- ---------------------------------------------------------------------------- module Data.ByteString.Lens - ( TraverseByteString(..) + ( packedBytes, bytes + , packedChars, chars ) where import Control.Lens -import Data.ByteString as Strict -import Data.ByteString.Lazy as Lazy +import Data.ByteString as Words +import Data.ByteString.Char8 as Char8 import Data.Word (Word8) --- | Provides ad hoc overloading for 'traverseByteString' -class TraverseByteString t where - -- | Traverse the individual bytes in a 'ByteString' - -- - -- > anyOf traverseByteString (==0x80) :: TraverseByteString b => b -> Bool - traverseByteString :: Simple Traversal t Word8 +-- | Pack (or unpack) a list of bytes into a 'ByteString' +-- +-- > pack x = x^.packedBytes +-- > unpack x = x^.from packedBytes +packedBytes :: Simple Iso [Word8] ByteString +packedBytes = iso Words.pack Words.unpack +{-# INLINE packedBytes #-} +{-# SPECIALIZE packedBytes :: Simple Lens [Word8] ByteString #-} -instance TraverseByteString Strict.ByteString where - traverseByteString f = fmap Strict.pack . traverse f . Strict.unpack +-- | Traverse the individual bytes in a 'ByteString' +-- +-- > bytes = from packedBytes . traverse +-- +-- > anyOf bytes (==0x80) :: ByteString -> Bool +bytes :: Simple Traversal ByteString Word8 +bytes = from packedBytes . traverse +{-# INLINE bytes #-} -instance TraverseByteString Lazy.ByteString where - traverseByteString f = fmap Lazy.pack . traverse f . Lazy.unpack +-- | Pack (or unpack) a list of characters into a 'ByteString' +-- +-- When writing back to the byteString it is assumed that all characters +-- lie between '\x00' and '\xff'. +-- +-- > pack x = x^.packedChars +-- > unpack x = x^.from packedChars +packedChars :: Simple Iso String ByteString +packedChars = iso Char8.pack Char8.unpack +{-# INLINE packedChars #-} +{-# SPECIALIZE packedChars :: Simple Lens String ByteString #-} + +-- | Traverse the individual bytes in a 'ByteString' as characters. +-- +-- When writing back to the byteString it is assumed that all characters +-- lie between '\x00' and '\xff'. +-- +-- > chars = from packed . traverse +-- +-- > anyOf chars (=='c') :: ByteString -> Bool +chars :: Simple Traversal ByteString Char +chars = from packedChars . traverse +{-# INLINE chars #-} diff --git a/src/Data/Complex/Lens.hs b/src/Data/Complex/Lens.hs --- a/src/Data/Complex/Lens.hs +++ b/src/Data/Complex/Lens.hs @@ -31,13 +31,12 @@ -- | This isn't /quite/ a legal lens. Notably the @view l (set l b a) = b@ law -- is violated when you set a polar value with 0 magnitude and non-zero phase --- as the phase information is lost. So don't do that! Otherwise, this is a +-- as the phase information is lost. So don't do that! Otherwise, this is a -- perfectly cromulent lens. --- --- > polarize :: (RealFloat a, RealFloat b, Functor f) --- > => ((a,a) -> f (b,b)) -> Complex a -> f (Complex b) -polarize :: (RealFloat a, RealFloat b) => Lens (Complex a) (Complex b) (a,a) (b,b) -polarize f c = uncurry mkPolar <$> f (polar c) + +polarize :: (RealFloat a, RealFloat b) => Iso (Complex a) (Complex b) (a,a) (b,b) +polarize = isos polar (uncurry mkPolar) + polar (uncurry mkPolar) -- | Traverse both the real and imaginary parts of a complex number. -- diff --git a/src/Data/Sequence/Lens.hs b/src/Data/Sequence/Lens.hs --- a/src/Data/Sequence/Lens.hs +++ b/src/Data/Sequence/Lens.hs @@ -33,20 +33,24 @@ -- | A 'Seq' is isomorphic to a 'ViewL' -- -- > viewl m = m^.viewL -viewL :: Simple Lens (Seq a) (ViewL a) -viewL f m = go <$> f (viewl m) where - go EmptyL = mempty - go (a :< as) = a <| as +viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b) +viewL = isos viewl unviewl viewl unviewl where + +unviewl :: ViewL a -> Seq a +unviewl EmptyL = mempty +unviewl (a :< as) = a <| as {-# INLINE viewL #-} -- | A 'Seq' is isomorphic to a 'ViewR' -- -- > viewr m = m^.viewR -viewR :: Simple Lens (Seq a) (ViewR a) -viewR f m = go <$> f (viewr m) where - go EmptyR = mempty - go (as :> a) = as |> a +viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b) +viewR = isos viewr unviewr viewr unviewr where {-# INLINE viewR #-} + +unviewr :: ViewR a -> Seq a +unviewr EmptyR = mempty +unviewr (as :> a) = as |> a -- * Traversals diff --git a/src/Data/Text/Lazy/Lens.hs b/src/Data/Text/Lazy/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Lazy/Lens.hs @@ -0,0 +1,33 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Text.Lazy.Lens +-- Copyright : (C) 2012 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +---------------------------------------------------------------------------- +module Data.Text.Lazy.Lens + ( packed + , text + ) where + +import Control.Lens +import Data.Text.Lazy + +-- | Pack (or unpack) 'Text'. +-- +-- > pack x = x^.packed +-- > unpack x = x^.from packed +packed :: Simple Iso String Text +packed = iso pack unpack +{-# INLINE packed #-} +{-# SPECIALIZE packed :: Simple Lens String Text #-} + +-- | Traverse the individual characters in a 'Text'. +-- +-- > anyOf text (=='c') :: Text -> Bool +text :: Simple Traversal Text Char +text = from packed . traverse +{-# INLINE text #-} diff --git a/src/Data/Text/Lens.hs b/src/Data/Text/Lens.hs --- a/src/Data/Text/Lens.hs +++ b/src/Data/Text/Lens.hs @@ -9,22 +9,25 @@ -- ---------------------------------------------------------------------------- module Data.Text.Lens - ( TraverseText(..) + ( packed + , text ) where import Control.Lens -import Data.Text as Strict -import Data.Text.Lazy as Lazy - --- | Provides ad hoc overloading for 'traverseText' for both strict and lazy 'Text'. -class TraverseText t where - -- | Traverse the individual characters in a either strict or lazy 'Text'. - -- - -- > anyOf traverseText (=='c') :: TraverseText b => b -> Bool - traverseText :: Simple Traversal t Char +import Data.Text -instance TraverseText Strict.Text where - traverseText f = fmap Strict.pack . traverse f . Strict.unpack +-- | Pack (or unpack) 'Text'. +-- +-- > pack x = x^.packed +-- > unpack x = x^.from packed +packed :: Simple Iso String Text +packed = iso pack unpack +{-# INLINE packed #-} +{-# SPECIALIZE packed :: Simple Lens String Text #-} -instance TraverseText Lazy.Text where - traverseText f = fmap Lazy.pack . traverse f . Lazy.unpack +-- | Traverse the individual characters in a either strict or lazy 'Text'. +-- +-- > anyOf text (=='c') :: Text -> Bool +text :: Simple Traversal Text Char +text = from packed . traverse +{-# INLINE text #-} diff --git a/src/Data/Time/Calendar/Lens.hs b/src/Data/Time/Calendar/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Calendar/Lens.hs @@ -0,0 +1,179 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LiberalTypeSynonyms #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Time.Calendar.Lens +-- Copyright : (C) 2012 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : LiberalTypeSynonyms +-- +-- Provides fairly ad hoc overloading to access different notions of a 'Day'. +-- +-- To convert from a 'Day': +-- +-- > myDay^.gregorian.year +-- > myDay^.julian.year +-- +---------------------------------------------------------------------------- +module Data.Time.Calendar.Lens + ( modifiedJulianDay + , TraverseDay(..) + , HasYear(..) + , HasMonth(..) + , HasWeek(..) + , HasDay(..) + , Gregorian(..) + , gregorian + , JulianYearAndDay(..) + , julianYearAndDay + , WeekDate(..) + , weekDate + , OrdinalDate(..) + , ordinalDate + ) where + +import Control.Applicative +import Control.Lens +import Data.Data +import Data.Time.Calendar +import Data.Time.Calendar.Julian +import Data.Time.Calendar.WeekDate +import Data.Time.Calendar.OrdinalDate + +-- | Provide ad hoc overloading for traversing the modified Julian day +class TraverseDay t where + -- | Convert the type to a modified Julian day if possible and traverse it. + -- + -- Traverses nothing if the date isn't valid. + traverseDay :: Simple Traversal t Day + +-- | Returns the modified Julian Day as a standard count of days, +-- with zero being the day 1858-11-17. +modifiedJulianDay :: Simple Iso Day Integer +modifiedJulianDay = iso toModifiedJulianDay ModifiedJulianDay + +instance TraverseDay Day where + traverseDay = id + +-- | Ad hoc overloading for accessing the year +class HasYear t where + -- | Get the year of a date + year :: Simple Lens t Integer + +-- | Ad hoc overloading for accessing the month +class HasMonth t where + -- | Get the month of a date + month :: Simple Lens t Int + +-- | Ad hoc overloading for accessing the week (what it is relative to may vary from type to type) +class HasWeek t where + -- | Get the week of a date + week :: Simple Lens t Int + +-- | Ad hoc overloading for accessing the day (what it is relative to may vary from type to type) +class HasDay t where + -- | Get the day of a date + day :: Simple Lens t Int + +-- | Date in the proleptic Gregorian calendar. +data Gregorian = Gregorian + { gregorianYear :: !Integer -- ^ year + , gregorianMonth :: !Int -- ^ month (1-12) + , gregorianDay :: !Int -- ^ day (1-31) + } deriving (Eq,Ord,Show,Read,Typeable,Data) + +uncurry3 :: (a -> b -> c -> d) -> (a,b,c) -> d +uncurry3 f (a,b,c) = f a b c + +-- | Convert to/from a /valid/ date in the proleptic Gregorian calendar +gregorian :: Simple Iso Day Gregorian +gregorian = iso (uncurry3 Gregorian . toGregorian) $ \(Gregorian y m d) -> fromGregorian y m d + +instance TraverseDay Gregorian where + traverseDay f g@(Gregorian y m d) = case fromGregorianValid y m d of + Nothing -> pure g + Just j -> (\i -> case toGregorian i of (y', m', d') -> Gregorian y' m' d') <$> f j + +instance HasYear Gregorian where + year f (Gregorian y m d) = (\y' -> Gregorian y' m d) <$> f y + +instance HasMonth Gregorian where + month f (Gregorian y m d) = (\m' -> Gregorian y m' d) <$> f m + +-- | Day of month +instance HasDay Gregorian where + day f (Gregorian y m d) = Gregorian y m <$> f d + +-- | Proleptic Julian year and day format. +data JulianYearAndDay = JulianYearAndDay + { julianYearAndDayYear :: !Integer -- ^ year (in the proleptic Julian calendar) + , julianYearAndDayDay :: !Int -- ^ day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31. + } deriving (Eq,Ord,Show,Read,Typeable,Data) + +-- | Convert to/from a /valid/ proleptic Julian year and day. +julianYearAndDay :: Simple Iso Day JulianYearAndDay +julianYearAndDay = iso (uncurry JulianYearAndDay . toJulianYearAndDay) $ \(JulianYearAndDay y d) -> fromJulianYearAndDay y d + +instance TraverseDay JulianYearAndDay where + traverseDay f j@(JulianYearAndDay y d) = case fromJulianYearAndDayValid y d of + Nothing -> pure j + Just k -> (\i -> case toJulianYearAndDay i of (y', d') -> JulianYearAndDay y' d') <$> f k + +instance HasYear JulianYearAndDay where + year f (JulianYearAndDay y d) = (`JulianYearAndDay` d) <$> f y + +-- | Day of year +instance HasDay JulianYearAndDay where + day f (JulianYearAndDay y d) = JulianYearAndDay y <$> f d + +-- | ISO 8601 Week Date format. +-- +-- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year. +data WeekDate = WeekDate + { weekDateYear :: !Integer -- ^ year. Note: that "Week" years are not quite the same as Gregorian years, as the first day of the year is always a Monday. + , weekDateWeek :: !Int -- ^ week number (1-53) + , weekDateDay :: !Int -- ^ day of week (1 for Monday to 7 for Sunday). + } deriving (Eq,Ord,Show,Read,Typeable,Data) + +-- | Convert to/from a valid WeekDate +weekDate :: Simple Iso Day WeekDate +weekDate = iso (uncurry3 WeekDate . toWeekDate) $ \(WeekDate y w d) -> fromWeekDate y w d + +instance TraverseDay WeekDate where + traverseDay f wd@(WeekDate y w d) = case fromWeekDateValid y w d of + Nothing -> pure wd + Just k -> (\i -> case toWeekDate i of (y', w', d') -> WeekDate y' w' d') <$> f k + +instance HasYear WeekDate where + year f (WeekDate y w d) = (\y' -> WeekDate y' w d) <$> f y + +instance HasWeek WeekDate where + week f (WeekDate y w d) = (\w' -> WeekDate y w' d) <$> f w + +-- | Day of week +instance HasDay WeekDate where + day f (WeekDate y w d) = WeekDate y w <$> f d + +-- | ISO 8601 Ordinal Date format +data OrdinalDate = OrdinalDate + { ordinalDateYear :: !Integer -- ^ year (proleptic Gregorian calendar) + , ordinalDateDay :: !Int -- ^ day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31. + } deriving (Eq,Ord,Show,Read,Typeable,Data) + +-- | Convert to/from a valid ISO 8601 Ordinal Date format. +ordinalDate :: Simple Iso Day OrdinalDate +ordinalDate = iso (uncurry OrdinalDate . toOrdinalDate) $ \(OrdinalDate y d) -> fromOrdinalDate y d + +instance TraverseDay OrdinalDate where + traverseDay f od@(OrdinalDate y d) = case fromOrdinalDateValid y d of + Nothing -> pure od + Just k -> (\i -> case toOrdinalDate i of (y', d') -> OrdinalDate y' d') <$> f k + +instance HasYear OrdinalDate where + year f (OrdinalDate y d) = (`OrdinalDate` d) <$> f y + +instance HasDay OrdinalDate where + day f (OrdinalDate y d) = OrdinalDate y <$> f d