diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -4,7 +4,9 @@ # - mkdir -p ~/.cabal # - cp config ~/.cabal/config # - cabal update - - cabal install --only-dependencies --enable-tests --enable-benchmarks + + # adding the hunit test suite causes us to have to reinstall regex-posix and regex-base + - cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstall install: # we have to configure rather than install to get benchmarks - cabal configure --enable-tests --enable-benchmarks diff --git a/.vim.custom b/.vim.custom --- a/.vim.custom +++ b/.vim.custom @@ -25,7 +25,7 @@ map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving -au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() +" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,20 @@ +2.7 +--- +* Generalized the signature of `Getting`, `Acting` and `IndexedGetting` to help out with the common user code scenario of needing to read + and then write to change types. +* Documentation cleanup and additional examples. +* Renamed `au` to `ala`, introducing further incompatibility with the `newtype` package, but reducing confusion. +* Removed need for `Data.Map.Lens` and `Data.IntMap.Lens` by adding `TraverseMin` and `TraverseMax` to `Control.Lens.IndexedTraversal`. +* Flipped fixity of `~:` and `<~:` +* Added `++~`, `++=`, `<++~` and `<++=` to Data.List.Lens in response to popular demand. +* Added `|>`, `<$!>` and `<$!` to `Control.Lens.Combinators`, which exports combinators that are often useful in lens-based code, but that + don't strictly involve lenses. +* Added an HUnit-based test suite by @orenbenkiki + +2.6.1 +----- +* Fixed bugs in `Traversal` code-generation. + 2.6 --- * Added build option `-f-inlining` to facilitate building with the various TH 2.8 versions used by GHC 7.6 and HEAD. diff --git a/benchmarks/plated.hs b/benchmarks/plated.hs new file mode 100644 --- /dev/null +++ b/benchmarks/plated.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +{-# OPTIONS_GHC -funbox-strict-fields #-} +import Control.Applicative +import Control.Lens +import Control.DeepSeq +import Criterion.Main +import Data.Data +import Data.Data.Lens as Data +#ifdef BENCHMARK_UNIPLATE +import qualified Data.Generics.Uniplate.Direct as Uni +import Data.Generics.Uniplate.Direct ((|*)) +import qualified Data.Generics.Uniplate.DataOnly as UniDataOnly +#endif +import GHC.Generics +import GHC.Generics.Lens as Generic + +data Expr = Val !Int + | Var String + | Neg !Expr + | Add !Expr !Expr + | Sub !Expr !Expr + | Mul !Expr !Expr + | Div !Expr !Expr + deriving (Eq,Show,Data,Typeable,Generic) + +instance NFData Expr where + rnf (Neg a) = rnf a + rnf (Add a b) = rnf a `seq` rnf b + rnf (Sub a b) = rnf a `seq` rnf b + rnf (Mul a b) = rnf a `seq` rnf b + rnf (Div a b) = rnf a `seq` rnf b + rnf (Val i) = rnf i + rnf (Var s) = rnf s + +instance Plated Expr where + plate f (Neg a) = Neg <$> f a + plate f (Add a b) = Add <$> f a <*> f b + plate f (Sub a b) = Sub <$> f a <*> f b + plate f (Mul a b) = Mul <$> f a <*> f b + plate f (Div a b) = Div <$> f a <*> f b + plate _ t = pure t + {-# INLINE plate #-} + +#ifdef BENCHMARK_UNIPLATE +instance Uni.Uniplate Expr where + uniplate (Neg a) = Uni.plate Neg |* a + uniplate (Add a b) = Uni.plate Add |* a |* b + uniplate (Sub a b) = Uni.plate Sub |* a |* b + uniplate (Mul a b) = Uni.plate Mul |* a |* b + uniplate (Div a b) = Uni.plate Div |* a |* b + uniplate (Val i) = Uni.plate (Val i) + uniplate (Var s) = Uni.plate (Var s) + {-# INLINE uniplate #-} +#endif + +main :: IO () +main = defaultMain + [ bench "universe" $ nf (map universe) testsExpr + , bench "universeOf plate" $ nf (map (universeOf plate)) testsExpr + , bench "universeOf Generic.tinplate" $ nf (map (universeOf Generic.tinplate)) testsExpr + , bench "universeOf Data.tinplate" $ nf (map (universeOf Data.tinplate)) testsExpr + , bench "universeOf Data.template" $ nf (map (universeOf Data.template)) testsExpr + , bench "universeOf Data.uniplate" $ nf (map (universeOf Data.uniplate)) testsExpr + , bench "universeOf (cloneTraversal plate)" $ nf (map (universeOf (cloneTraversal plate))) testsExpr +#ifdef BENCHMARK_UNIPLATE + , bench "Direct.universe" $ nf (map Uni.universe) testsExpr + , bench "DataOnly.universe" $ nf (map UniDataOnly.universe) testsExpr +#endif + ] + +testsExpr :: [Expr] +testsExpr = [Val 3,Val 2,Val 6,Neg (Neg (Var "dus")),Mul (Div (Add (Val 4) (Var "kxm")) (Sub (Mul (Div (Var "") (Var "")) (Var "w")) (Var "ed"))) (Var "whpd"),Val 6,Val 4,Val 2,Var "a",Val 1,Div (Var "") (Val 0),Var "",Var "",Val (-3),Val 3,Sub (Var "") (Val 2),Neg (Var "dlp"),Div (Val 0) (Var "sd"),Val (-2),Val (-3),Var "g",Mul (Val 3) (Var "i"),Val 1,Var "ul",Div (Add (Var "") (Var "")) (Mul (Div (Val 0) (Neg (Val 0))) (Neg (Neg (Mul (Var "") (Val 0))))),Var "z",Sub (Neg (Add (Var "") (Val 0))) (Var ""),Neg (Sub (Mul (Val 0) (Val 2)) (Val 5)),Val 0,Val 0,Mul (Val (-4)) (Sub (Val 5) (Neg (Div (Div (Val 0) (Sub (Neg (Sub (Val (-3)) (Mul (Mul (Var "ap") (Val 3)) (Add (Add (Add (Var "owre") (Add (Add (Var "avj") (Val 3)) (Var "vhi"))) (Mul (Val 2) (Var "hak"))) (Val 2))))) (Var "nf"))) (Add (Sub (Val 5) (Sub (Var "pkjyh") (Val 2))) (Var "lsiu"))))),Var "u",Val 1,Neg (Add (Add (Var "") (Val 1)) (Sub (Add (Add (Val (-3)) (Mul (Val 1) (Var "pfe"))) (Var "yv")) (Mul (Var "") (Var "jfq")))),Val 2,Div (Div (Div (Div (Var "xrgykq") (Mul (Var "kyfu") (Val 2))) (Sub (Var "v") (Val 0))) (Sub (Val 6) (Val 2))) (Val 3),Var "",Var "",Add (Var "ob") (Sub (Mul (Neg (Val 2)) (Val 6)) (Add (Mul (Val 6) (Sub (Add (Var "wue") (Mul (Var "hgsuj") (Neg (Div (Var "hr") (Var "ozvsb"))))) (Sub (Var "j") (Div (Var "yeyhvq") (Val (-6)))))) (Var "b"))),Div (Add (Div (Div (Neg (Val 4)) (Var "")) (Var "yfx")) (Div (Sub (Var "") (Sub (Var "np") (Mul (Val 3) (Var "mxr")))) (Mul (Var "m") (Var "kkhbf")))) (Neg (Sub (Var "yie") (Val 1))),Neg (Var ""),Var "liuh",Var "pbqg",Var "",Neg (Div (Sub (Add (Val (-1)) (Var "onynvr")) (Neg (Var "tqjsay"))) (Add (Val 4) (Var "yorkb"))),Val 1,Add (Mul (Neg (Div (Val (-1)) (Var "u"))) (Sub (Var "") (Neg (Val 1)))) (Var "h"),Var "",Add (Mul (Sub (Var "em") (Val 0)) (Add (Val (-2)) (Val 1))) (Var ""),Add (Mul (Add (Div (Add (Val 0) (Mul (Mul (Var "e") (Add (Val 1) (Var ""))) (Neg (Neg (Div (Add (Div (Neg (Val 1)) (Div (Val (-1)) (Mul (Add (Div (Val (-1)) (Mul (Mul (Val 1) (Val 1)) (Mul (Var "t") (Val (-1))))) (Val 1)) (Val 1)))) (Add (Neg (Add (Val 0) (Var "k"))) (Mul (Neg (Div (Sub (Sub (Var "u") (Val 1)) (Val 1)) (Sub (Neg (Var "")) (Sub (Var "b") (Val (-1)))))) (Neg (Var ""))))) (Val 0)))))) (Val 0)) (Var "a")) (Var "")) (Val (-1)),Var "xijsnp",Div (Var "h") (Neg (Val 5)),Div (Var "dmzlh") (Add (Val 6) (Val (-2))),Neg (Add (Val 0) (Var "")),Add (Add (Add (Sub (Val 4) (Var "nfse")) (Var "o")) (Add (Val 2) (Div (Var "mtqdx") (Val (-3))))) (Val 3),Neg (Var "c"),Var "sr",Mul (Add (Sub (Neg (Val 1)) (Sub (Div (Add (Sub (Add (Sub (Sub (Var "gd") (Mul (Var "v") (Var "d"))) (Var "")) (Val 1)) (Add (Val 2) (Var ""))) (Var "kk")) (Div (Var "fw") (Add (Val 1) (Var "f")))) (Var ""))) (Val 2)) (Add (Neg (Div (Var "") (Val 0))) (Add (Var "") (Add (Var "s") (Add (Mul (Var "") (Val (-1))) (Val 1))))),Val 1,Var "",Sub (Var "vbnzahx") (Val (-5)),Var "nl",Val 0,Add (Mul (Neg (Mul (Var "") (Var "mvil"))) (Var "")) (Neg (Var "zxl")),Val (-3),Var "",Var "e",Add (Div (Sub (Val 0) (Add (Val 5) (Val 7))) (Mul (Var "") (Var "qz"))) (Val 4),Add (Val (-1)) (Neg (Var "lk")),Add (Add (Var "u") (Mul (Val 1) (Var "h"))) (Sub (Mul (Div (Val 1) (Div (Var "t") (Neg (Var "")))) (Var "")) (Mul (Val 1) (Neg (Div (Neg (Var "")) (Var ""))))),Val 0,Val 0,Val (-7),Mul (Var "") (Val 0),Mul (Add (Val (-6)) (Add (Val 2) (Sub (Div (Var "z") (Var "gbb")) (Var "vddnpsl")))) (Add (Add (Add (Var "") (Sub (Div (Val 3) (Neg (Div (Add (Var "cfvgz") (Add (Sub (Var "htd") (Sub (Var "mhbl") (Var "un"))) (Val 3))) (Val (-3))))) (Var ""))) (Val 5)) (Neg (Mul (Val 0) (Var "sufvvj")))),Sub (Div (Neg (Add (Add (Neg (Add (Var "") (Val 0))) (Var "")) (Sub (Val 0) (Val 0)))) (Val 0)) (Add (Neg (Div (Div (Add (Sub (Add (Add (Neg (Var "")) (Val 0)) (Val 0)) (Add (Neg (Add (Neg (Var "")) (Neg (Val 0)))) (Val 0))) (Div (Val 0) (Val 0))) (Val 0)) (Val 0))) (Var "")),Var "",Sub (Div (Val 0) (Div (Add (Val 1) (Neg (Div (Neg (Var "y")) (Val 0)))) (Var ""))) (Sub (Div (Var "t") (Var "")) (Neg (Var "s"))),Mul (Div (Sub (Var "") (Var "")) (Add (Val 0) (Sub (Div (Var "yr") (Neg (Var "o"))) (Val 1)))) (Var "u"),Var "odmn",Div (Var "uddqy") (Val 3),Var "",Sub (Val 2) (Neg (Val (-1))),Div (Mul (Var "sox") (Val (-3))) (Val (-3)),Var "qv",Var "xmbnts",Var "j",Mul (Val 6) (Mul (Var "fryndq") (Neg (Val 6))),Var "",Var "",Val (-1),Val 7,Add (Var "dg") (Val 1),Neg (Val 1),Val 0,Var "xnm",Sub (Div (Div (Var "miwi") (Var "mbh")) (Val 3)) (Val 3),Neg (Val (-4)),Var "ndubxoa",Var ""] diff --git a/lens.cabal b/lens.cabal --- a/lens.cabal +++ b/lens.cabal @@ -1,6 +1,6 @@ name: lens category: Data, Lenses -version: 2.6.1 +version: 2.7 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE @@ -37,7 +37,7 @@ . The core of this hierarchy looks like: . - <> + <> . You can compose any two elements of the hierarchy above using (.) from the Prelude, and you can use any element of the hierarchy as any type it links to above it. @@ -119,7 +119,7 @@ -- Generate inline pragmas when using template-haskell. This defaults to enabled, but you can -- --- > cabal install lens -f-inlining +-- > cabal install lens -f-inlining -- -- to shut it off to benchmark the relative performance impact, or as last ditch effort to address compile -- errors resulting from the myriad versions of template-haskell that all purport to be 2.8. @@ -177,10 +177,8 @@ Data.Data.Lens Data.Dynamic.Lens Data.HashSet.Lens - Data.IntMap.Lens Data.IntSet.Lens Data.List.Lens - Data.Map.Lens Data.Monoid.Lens Data.Sequence.Lens Data.Set.Lens @@ -226,11 +224,13 @@ type: exitcode-stdio-1.0 main-is: doctests.hs build-depends: - base == 4.*, - directory >= 1.0 && < 1.2, + base, + directory >= 1.0 && < 1.3, doctest >= 0.8 && <= 0.9, - filepath >= 1.3 && < 1.4 - ghc-options: -Wall -Werror -threaded + filepath + ghc-options: -Wall -threaded + if impl(ghc<7.6.1) + ghc-options: -Werror hs-source-dirs: tests -- Verify that Template Haskell expansion works @@ -240,7 +240,9 @@ build-depends: base, lens - ghc-options: -Wall -Werror -threaded + ghc-options: -Wall -threaded + if impl(ghc<7.6.1) + ghc-options: -Werror hs-source-dirs: tests -- Verify the properties of lenses with QuickCheck @@ -251,7 +253,22 @@ base, lens, QuickCheck >= 2.4 && < 2.6, - transformers >= 0.3 && < 0.5 + transformers + ghc-options: -w -threaded + hs-source-dirs: tests + +test-suite hunit + type: exitcode-stdio-1.0 + main-is: hunit.hs + build-depends: + base, + containers, + HUnit == 1.2.*, + lens, + mtl, + test-framework == 0.6.*, + test-framework-hunit == 0.2.*, + test-framework-th == 0.2.* ghc-options: -w -threaded hs-source-dirs: tests diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs --- a/src/Control/Lens.hs +++ b/src/Control/Lens.hs @@ -41,7 +41,7 @@ -- -- -- --- <> +-- <> ---------------------------------------------------------------------------- module Control.Lens ( module Control.Lens.Type @@ -49,6 +49,7 @@ , module Control.Lens.Getter , module Control.Lens.Setter , module Control.Lens.Action + , module Control.Lens.Combinators , module Control.Lens.Fold , module Control.Lens.Iso , module Control.Lens.Indexed @@ -68,6 +69,7 @@ ) where import Control.Lens.Action +import Control.Lens.Combinators import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Indexed diff --git a/src/Control/Lens/Action.hs b/src/Control/Lens/Action.hs --- a/src/Control/Lens/Action.hs +++ b/src/Control/Lens/Action.hs @@ -48,25 +48,22 @@ type MonadicFold m a c = forall f r. (Effective m r f, Applicative f) => (c -> f c) -> a -> f a -- | Used to evaluate an 'Action'. -type Acting m r a c = (c -> Effect m r c) -> a -> Effect m r a +type Acting m r a b c d = (c -> Effect m r d) -> a -> Effect m r b -- | Perform an 'Action'. -- -- > perform = flip (^!) --- -perform :: Monad m => Acting m c a c -> a -> m c +perform :: Monad m => Acting m c a b c d -> a -> m c perform l = getEffect . l (Effect . return) {-# INLINE perform #-} -- | Perform an 'Action' -- -- >>> import Control.Lens --- -- >>> ["hello","world"]^!folded.act putStrLn -- hello -- world --- -(^!) :: Monad m => a -> Acting m c a c -> m c +(^!) :: Monad m => a -> Acting m c a b c d -> m c a ^! l = getEffect (l (Effect . return) a) {-# INLINE (^!) #-} @@ -80,7 +77,6 @@ -- @'acts' = 'act' 'id'@ -- -- >>> import Control.Lens --- -- >>> (1,"hello")^!_2.acts.to succ -- "ifmmp" acts :: Action m (m a) a @@ -88,6 +84,6 @@ {-# INLINE acts #-} -- | Apply a 'Monad' transformer to an 'Action'. -liftAct :: (MonadTrans t, Monad m) => Acting m c a c -> Action (t m) a c +liftAct :: (MonadTrans t, Monad m) => Acting m c a b c d -> Action (t m) a c liftAct l = act (lift . perform l) {-# INLINE liftAct #-} diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs --- a/src/Control/Lens/Fold.hs +++ b/src/Control/Lens/Fold.hs @@ -21,7 +21,7 @@ -- generalize this signature to @forall m. 'Monoid' m => (c -> m) -> a -> m@, -- and then decorate it with 'Accessor' to obtain -- --- @type 'Fold' a c = forall m. 'Monoid' m => 'Getting' m a c@ +-- @type 'Fold' a c = forall m. 'Monoid' m => 'Getting' m a a c c@ -- -- Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' -- it is passed. @@ -122,13 +122,13 @@ -- | Fold by repeating the input forever. -- --- @'repeat' = 'toListOf' 'repeated'@ +-- @'repeat' ≡ 'toListOf' 'repeated'@ repeated :: Fold a a repeated f a = as where as = f a *> as -- | A fold that replicates its input @n@ times. -- --- @'replicate' n = 'toListOf' ('replicated' n)@ +-- @'replicate' n ≡ 'toListOf' ('replicated' n)@ replicated :: Int -> Fold a a replicated n0 f a = go n0 where m = f a @@ -141,12 +141,12 @@ -- >>> import Control.Lens -- >>> take 6 $ toListOf (cycled traverse) [1,2,3] -- [1,2,3,1,2,3] -cycled :: (Applicative f, Gettable f) => SimpleLensLike f a c -> SimpleLensLike f a c +cycled :: (Applicative f, Gettable f) => LensLike f a b c d -> LensLike f a b c d cycled l f a = as where as = l f a *> as -- | Build a fold that unfolds its values from a seed. -- --- @'Prelude.unfoldr' = 'toListOf' . 'unfolded'@ +-- @'Prelude.unfoldr' ≡ 'toListOf' . 'unfolded'@ unfolded :: (b -> Maybe (a, b)) -> Fold b a unfolded f g b0 = go b0 where go b = case f b of @@ -156,14 +156,14 @@ -- | @x ^. 'iterated' f@ Return an infinite fold of repeated applications of @f@ to @x@. -- --- > toListOf (iterated f) a = iterate f a +-- @'toListOf' ('iterated' f) a ≡ 'iterate' f a@ iterated :: (a -> a) -> Fold a a iterated f g a0 = go a0 where go a = g a *> go (f a) {-# INLINE iterated #-} -- | Obtain a 'Fold' by filtering a 'Lens', 'Control.Lens.Iso.Iso', 'Getter', 'Fold' or 'Control.Lens.Traversal.Traversal'. -filtered :: (Gettable f, Applicative f) => (c -> Bool) -> SimpleLensLike f a c -> SimpleLensLike f a c +filtered :: (Gettable f, Applicative f) => (c -> Bool) -> LensLike f a b c d -> LensLike f a b c d filtered p l f = l $ \c -> if p c then f c else noEffect {-# INLINE filtered #-} @@ -179,28 +179,28 @@ -- | Obtain a 'Fold' by taking elements from another 'Fold', 'Lens', 'Control.Lens.Iso.Iso', 'Getter' or 'Control.Lens.Traversal.Traversal' while a predicate holds. -- --- @'takeWhile' p = 'toListOf' ('takingWhile' p 'folded')@ +-- @'takeWhile' p ≡ 'toListOf' ('takingWhile' p 'folded')@ -- -- >>> toListOf (takingWhile (<=3) folded) [1..] -- [1,2,3] takingWhile :: (Gettable f, Applicative f) => (c -> Bool) - -> Getting (Endo (f a)) a c - -> SimpleLensLike f a c + -> Getting (Endo (f a)) a a c c + -> LensLike f a a c c takingWhile p l f = foldrOf l (\a r -> if p a then f a *> r else noEffect) noEffect {-# INLINE takingWhile #-} -- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Lens', 'Control.Lens.Iso.Iso', 'Getter' or 'Control.Lens.Traversal.Traversal' while a predicate holds. -- --- @'dropWhile' p = 'toListOf' ('droppingWhile' p 'folded')@ +-- @'dropWhile' p ≡ 'toListOf' ('droppingWhile' p 'folded')@ -- -- >>> toListOf (droppingWhile (<=3) folded) [1..6] -- [4,5,6] droppingWhile :: (Gettable f, Applicative f) => (c -> Bool) - -> Getting (Endo (f a)) a c - -> SimpleLensLike f a c + -> Getting (Endo (f a)) a a c c + -> LensLike f a a c c droppingWhile p l f = foldrOf l (\a r -> if p a then r else f a *> r) noEffect {-# INLINE droppingWhile #-} @@ -211,7 +211,7 @@ -- | -- @'Data.Foldable.foldMap' = 'foldMapOf' 'folded'@ -- --- @'foldMapOf' = 'views'@ +-- @'foldMapOf' ≡ 'views'@ -- -- @ -- 'foldMapOf' :: 'Getter' a c -> (c -> r) -> a -> r @@ -220,14 +220,14 @@ -- 'foldMapOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> (c -> r) -> a -> r -- 'foldMapOf' :: 'Monoid' r => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> r) -> a -> r -- @ -foldMapOf :: Getting r a c -> (c -> r) -> a -> r +foldMapOf :: Getting r a b c d -> (c -> r) -> a -> r foldMapOf l f = runAccessor . l (Accessor . f) {-# INLINE foldMapOf #-} -- | -- @'Data.Foldable.fold' = 'foldOf' 'folded'@ -- --- @'foldOf' = 'view'@ +-- @'foldOf' ≡ 'view'@ -- -- @ -- 'foldOf' :: 'Getter' a m -> a -> m @@ -236,14 +236,14 @@ -- 'foldOf' :: 'Simple' 'Control.Lens.Iso.Iso' a m -> a -> m -- 'foldOf' :: 'Monoid' m => 'Simple' 'Control.Lens.Traversal.Traversal' a m -> a -> m -- @ -foldOf :: Getting c a c -> a -> c +foldOf :: Getting c a b c d -> a -> c foldOf l = runAccessor . l Accessor {-# INLINE foldOf #-} -- | -- Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Control.Lens.Traversal.Traversal'. -- --- @'Data.Foldable.foldr' = 'foldrOf' 'folded'@ +-- @'Data.Foldable.foldr' ≡ 'foldrOf' 'folded'@ -- -- @ -- 'foldrOf' :: 'Getter' a c -> (c -> e -> e) -> e -> a -> e @@ -252,14 +252,14 @@ -- 'foldrOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> (c -> e -> e) -> e -> a -> e -- 'foldrOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> e) -> e -> a -> e -- @ -foldrOf :: Getting (Endo e) a c -> (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 {-# INLINE foldrOf #-} -- | -- Left-associative fold of the parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Control.Lens.Traversal.Traversal'. -- --- @'Data.Foldable.foldl' = 'foldlOf' 'folded'@ +-- @'Data.Foldable.foldl' ≡ 'foldlOf' 'folded'@ -- -- @ -- 'foldlOf' :: 'Getter' a c -> (e -> c -> e) -> e -> a -> e @@ -268,16 +268,20 @@ -- 'foldlOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> (e -> c -> e) -> e -> a -> e -- 'foldlOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> e) -> e -> a -> e -- @ -foldlOf :: Getting (Dual (Endo e)) a c -> (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 {-# INLINE foldlOf #-} -- | Extract a list of the targets of a 'Fold'. See also ('^..'). -- -- @ --- 'Data.Foldable.toList' = 'toListOf' 'folded' --- ('^..') = 'flip' 'toListOf' +-- 'Data.Foldable.toList' ≡ 'toListOf' 'folded' +-- ('^..') ≡ 'flip' 'toListOf' -- @ + +-- >>> import Control.Lens +-- >>> toListOf both ("hello","world") +-- ["hello","world"] -- -- @ -- 'toListOf' :: 'Getter' a c -> a -> [c] @@ -286,25 +290,46 @@ -- 'toListOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> [c] -- 'toListOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> [c] -- @ -toListOf :: Getting [c] a c -> a -> [c] +toListOf :: Getting [c] a b c d -> a -> [c] toListOf l = foldMapOf l return {-# INLINE toListOf #-} --- | A convenient infix (flipped) version of 'toListOf'. +-- | -- +-- A convenient infix (flipped) version of 'toListOf'. +-- +-- >>> import Control.Lens +-- >>> [[1,2],[3]]^..traverse.traverse +-- [1,2,3] +-- +-- >>> (1,2)^..both +-- [1,2] +-- -- @ --- 'toListOf' :: a -> 'Getter' a c -> [c] --- 'toListOf' :: a -> 'Fold' a c -> [c] --- 'toListOf' :: a -> 'Simple' 'Lens' a c -> [c] --- 'toListOf' :: a -> 'Simple' 'Control.Lens.Iso.Iso' a c -> [c] --- 'toListOf' :: a -> 'Simple' 'Control.Lens.Traversal.Traversal' a c -> [c] +-- 'Data.Foldable.toList' xs ≡ xs '^..' 'folded' +-- ('^..') ≡ 'flip' 'toListOf' -- @ -(^..) :: a -> Getting [c] a c -> [c] +-- +-- @ +-- ('^..') :: a -> 'Getter' a c -> [c] +-- ('^..') :: a -> 'Fold' a c -> [c] +-- ('^..') :: a -> 'Simple' 'Lens' a c -> [c] +-- ('^..') :: a -> 'Simple' 'Control.Lens.Iso.Iso' a c -> [c] +-- ('^..') :: a -> 'Simple' 'Control.Lens.Traversal.Traversal' a c -> [c] +-- @ +(^..) :: a -> Getting [c] a b c d -> [c] a ^.. l = foldMapOf l return a --- | --- @'Data.Foldable.and' = 'andOf' 'folded'@ +-- | Returns 'True' if every target of a 'Fold' is 'True'. -- +-- >>> import Control.Lens +-- >>> andOf both (True,False) +-- False +-- >>> andOf both (True,True) +-- True +-- +-- @'Data.Foldable.and' ≡ 'andOf' 'folded'@ +-- -- @ -- 'andOf' :: 'Getter' a 'Bool' -> a -> 'Bool' -- 'andOf' :: 'Fold' a 'Bool' -> a -> 'Bool' @@ -312,13 +337,20 @@ -- 'andOf' :: 'Simple' 'Control.Lens.Iso.Iso' a 'Bool' -> a -> 'Bool' -- 'andOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a 'Bool' -> a -> 'Bool' -- @ -andOf :: Getting All a Bool -> a -> Bool +andOf :: Getting All a b Bool d -> a -> Bool andOf l = getAll . foldMapOf l All {-# INLINE andOf #-} --- | --- @'Data.Foldable.or' = 'orOf' 'folded'@ +-- | Returns 'True' if any target of a 'Fold' is 'True'. -- +-- >>> import Control.Lens +-- >>> orOf both (True,False) +-- True +-- >>> orOf both (False,False) +-- False +-- +-- @'Data.Foldable.or' ≡ 'orOf' 'folded'@ +-- -- @ -- 'orOf' :: 'Getter' a 'Bool' -> a -> 'Bool' -- 'orOf' :: 'Fold' a 'Bool' -> a -> 'Bool' @@ -326,13 +358,21 @@ -- 'orOf' :: 'Simple' 'Control.Lens.Iso.Iso' a 'Bool' -> a -> 'Bool' -- 'orOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a 'Bool' -> a -> 'Bool' -- @ -orOf :: Getting Any a Bool -> a -> Bool +orOf :: Getting Any a b Bool d -> a -> Bool orOf l = getAny . foldMapOf l Any {-# INLINE orOf #-} --- | --- @'Data.Foldable.any' = 'anyOf' 'folded'@ +-- | Returns 'True' if any target of a 'Fold' satisfies a predicate. -- +-- >>> import Control.Lens +-- >>> anyOf both (=='x') ('x','y') +-- True +-- >>> import Data.Data.Lens +-- >>> anyOf biplate (== "world") (((),2::Int),"hello",("world",11)) +-- True +-- +-- @'Data.Foldable.any' ≡ 'anyOf' 'folded'@ +-- -- @ -- 'anyOf' :: 'Getter' a c -> (c -> 'Bool') -> a -> 'Bool' -- 'anyOf' :: 'Fold' a c -> (c -> 'Bool') -> a -> 'Bool' @@ -340,13 +380,20 @@ -- 'anyOf' :: 'Simple' 'Control.Lens.Iso.Iso' a b c d -> (c -> 'Bool') -> a -> 'Bool' -- 'anyOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a b c d -> (c -> 'Bool') -> a -> 'Bool' -- @ -anyOf :: Getting Any a c -> (c -> Bool) -> a -> Bool +anyOf :: Getting Any a b c d -> (c -> Bool) -> a -> Bool anyOf l f = getAny . foldMapOf l (Any . f) {-# INLINE anyOf #-} --- | --- @'Data.Foldable.all' = 'allOf' 'folded'@ +-- | Returns 'True' if every target of a 'Fold' satisfies a predicate. -- +-- >>> import Control.Lens +-- >>> allOf both (>=3) (4,5) +-- True +-- >>> allOf folded (>=2) [1..10] +-- False +-- +-- @'Data.Foldable.all' ≡ 'allOf' 'folded'@ +-- -- @ -- 'allOf' :: 'Getter' a c -> (c -> 'Bool') -> a -> 'Bool' -- 'allOf' :: 'Fold' a c -> (c -> 'Bool') -> a -> 'Bool' @@ -354,13 +401,20 @@ -- 'allOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> (c -> 'Bool') -> a -> 'Bool' -- 'allOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> 'Bool') -> a -> 'Bool' -- @ -allOf :: Getting All a c -> (c -> Bool) -> a -> Bool +allOf :: Getting All a b c d -> (c -> Bool) -> a -> Bool allOf l f = getAll . foldMapOf l (All . f) {-# INLINE allOf #-} --- | --- @'Data.Foldable.product' = 'productOf' 'folded'@ +-- | Calculate the product of every number targeted by a 'Fold' -- +-- >>> import Control.Lens +-- >>> productOf both (4,5) +-- 20 +-- >>> productOf folded [1,2,3,4,5] +-- 120 +-- +-- @'Data.Foldable.product' ≡ 'productOf' 'folded'@ +-- -- @ -- 'productOf' :: 'Getter' a c -> a -> c -- 'productOf' :: 'Num' c => 'Fold' a c -> a -> c @@ -368,41 +422,61 @@ -- 'productOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> c -- 'productOf' :: 'Num' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> c -- @ -productOf :: Getting (Product c) a c -> a -> c +productOf :: Getting (Product c) a b c d -> a -> c productOf l = getProduct . foldMapOf l Product {-# INLINE productOf #-} --- | --- @'Data.Foldable.sum' = 'sumOf' 'folded'@ +-- | Calculate the sum of every number targeted by a 'Fold'. -- --- @'sumOf' '_1' :: (a, b) -> a@ +-- >>> import Control.Lens +-- >>> sumOf both (5,6) +-- 11 +-- >>> sumOf folded [1,2,3,4] +-- 10 +-- >>> sumOf (folded.both) [(1,2),(3,4)] +-- 10 +-- >>> import Data.Data.Lens +-- >>> sumOf biplate [(1::Int,[]),(2,[(3::Int,4::Int)])] :: Int +-- 10 -- --- @'sumOf' ('folded' . '_1') :: ('Foldable' f, 'Num' a) => f (a, b) -> a@ +-- @'Data.Foldable.sum' ≡ 'sumOf' 'folded'@ -- -- @ +-- 'sumOf' '_1' :: (a, b) -> a +-- 'sumOf' ('folded' . '_1') :: ('Foldable' f, 'Num' a) => f (a, b) -> a +-- @ +-- +-- @ -- 'sumOf' :: 'Getter' a c -> a -> c -- 'sumOf' :: 'Num' c => 'Fold' a c -> a -> c -- 'sumOf' :: 'Simple' 'Lens' a c -> a -> c -- 'sumOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> c -- 'sumOf' :: 'Num' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> c -- @ -sumOf :: Getting (Sum c) a c -> a -> c +sumOf :: Getting (Sum c) a b c d -> a -> c sumOf l = getSum . foldMapOf l Sum {-# INLINE sumOf #-} --- | --- --- When passed a 'Getter', 'traverseOf_' can work over a 'Functor'. +-- | Traverse over all of the targets of a 'Fold' (or 'Getter'), computing an 'Applicative' (or 'Functor') -based answer, +-- but unlike 'Control.Lens.Traversal.traverseOf' do not construct a new structure. 'traverseOf_' generalizes +-- 'Data.Foldable.traverse_' to work over any 'Fold'. -- --- When passed a 'Fold', 'traverseOf_' requires an 'Applicative'. +-- When passed a 'Getter', 'traverseOf_' can work over any 'Functor', but when passed a 'Fold', 'traverseOf_' requires +-- an 'Applicative'. -- --- @'Data.Foldable.traverse_' = 'traverseOf_' 'folded'@ +-- >>> import Control.Lens +-- >>> traverseOf_ both putStrLn ("hello","world") +-- hello +-- world -- --- @'traverseOf_' '_2' :: 'Functor' f => (c -> f e) -> (c1, c) -> f ()@ +-- @'Data.Foldable.traverse_' ≡ 'traverseOf_' 'folded'@ -- --- @'traverseOf_' 'Data.Either.Lens.traverseLeft' :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f ()@ +-- @ +-- 'traverseOf_' '_2' :: 'Functor' f => (c -> f e) -> (c1, c) -> f () +-- 'traverseOf_' 'Data.Either.Lens.traverseLeft' :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f () +-- @ -- --- The rather specific signature of traverseOf_ allows it to be used as if the signature was either: +-- The rather specific signature of 'traverseOf_' allows it to be used as if the signature was any of: -- -- @ -- 'traverseOf_' :: 'Functor' f => 'Getter' a c -> (c -> f e) -> a -> f () @@ -411,13 +485,21 @@ -- 'traverseOf_' :: 'Functor' f => 'Simple' 'Control.Lens.Iso.Iso' a c -> (c -> f e) -> a -> f () -- 'traverseOf_' :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> f e) -> a -> f () -- @ -traverseOf_ :: Functor f => Getting (Traversed f) a c -> (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) {-# INLINE traverseOf_ #-} --- | --- @'for_' = 'forOf_' 'folded'@ +-- | Traverse over all of the targets of a 'Fold' (or 'Getter'), computing an 'Applicative' (or 'Functor') -based answer, +-- but unlike 'Control.Lens.Traversal.forOf' do not construct a new structure. 'forOf_' generalizes +-- 'Data.Foldable.for_' to work over any 'Fold'. -- +-- When passed a 'Getter', 'forOf_' can work over any 'Functor', but when passed a 'Fold', 'forOf_' requires +-- an 'Applicative'. +-- +-- @'for_' ≡ 'forOf_' 'folded'@ +-- +-- The rather specific signature of 'forOf_' allows it to be used as if the signature was any of: +-- -- @ -- 'forOf_' :: 'Functor' f => 'Getter' a c -> a -> (c -> f e) -> f () -- 'forOf_' :: 'Applicative' f => 'Fold' a c -> a -> (c -> f e) -> f () @@ -425,13 +507,14 @@ -- 'forOf_' :: 'Functor' f => 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> (c -> f e) -> f () -- 'forOf_' :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> (c -> f e) -> f () -- @ -forOf_ :: Functor f => Getting (Traversed f) a c -> a -> (c -> f e) -> f () +forOf_ :: Functor f => Getting (Traversed f) a b c d -> a -> (c -> f e) -> f () forOf_ = flip . traverseOf_ {-# INLINE forOf_ #-} --- | --- @'sequenceA_' = 'sequenceAOf_' 'folded'@ +-- | Evaluate each action in observed by a 'Fold' on a structure from left to right, ignoring the results. -- +-- @'sequenceA_' ≡ 'sequenceAOf_' 'folded'@ +-- -- @ -- 'sequenceAOf_' :: 'Functor' f => 'Getter' a (f ()) -> a -> f () -- 'sequenceAOf_' :: 'Applicative' f => 'Fold' a (f ()) -> a -> f () @@ -439,13 +522,14 @@ -- 'sequenceAOf_' :: 'Functor' f => 'Simple' 'Iso' a (f ()) -> a -> f () -- 'sequenceAOf_' :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a (f ()) -> a -> f () -- @ -sequenceAOf_ :: Functor f => Getting (Traversed f) a (f ()) -> a -> f () +sequenceAOf_ :: Functor f => Getting (Traversed f) a b (f ()) d -> a -> f () sequenceAOf_ l = getTraversed . foldMapOf l (Traversed . void) {-# INLINE sequenceAOf_ #-} --- | --- @'Data.Foldable.mapM_' = 'mapMOf_' 'folded'@ +-- | Map each target of a 'Fold' on a structure to a monadic action, evaluate these actions from left to right, and ignore the results. -- +-- @'Data.Foldable.mapM_' ≡ 'mapMOf_' 'folded'@ +-- -- @ -- 'mapMOf_' :: 'Monad' m => 'Getter' a c -> (c -> m e) -> a -> m () -- 'mapMOf_' :: 'Monad' m => 'Fold' a c -> (c -> m e) -> a -> m () @@ -453,7 +537,7 @@ -- 'mapMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c -> (c -> m e) -> a -> m () -- 'mapMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> m e) -> a -> m () -- @ -mapMOf_ :: Monad m => Getting (Sequenced m) a c -> (c -> m e) -> a -> m () +mapMOf_ :: Monad m => Getting (Sequenced m) a b c d -> (c -> m e) -> a -> m () mapMOf_ l f = getSequenced . foldMapOf l (Sequenced . liftM skip . f) {-# INLINE mapMOf_ #-} @@ -461,9 +545,10 @@ skip _ = () {-# INLINE skip #-} --- | --- @'Data.Foldable.forM_' = 'forMOf_' 'folded'@ +-- | 'forMOf_' is 'mapMOf_' with two of its arguments flipped. -- +-- @'Data.Foldable.forM_' ≡ 'forMOf_' 'folded'@ +-- -- @ -- 'forMOf_' :: 'Monad' m => 'Getter' a c -> a -> (c -> m e) -> m () -- 'forMOf_' :: 'Monad' m => 'Fold' a c -> a -> (c -> m e) -> m () @@ -471,13 +556,14 @@ -- 'forMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> (c -> m e) -> m () -- 'forMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> (c -> m e) -> m () -- @ -forMOf_ :: Monad m => Getting (Sequenced m) a c -> a -> (c -> m e) -> m () +forMOf_ :: Monad m => Getting (Sequenced m) a b c d -> a -> (c -> m e) -> m () forMOf_ = flip . mapMOf_ {-# INLINE forMOf_ #-} --- | --- @'Data.Foldable.sequence_' = 'sequenceOf_' 'folded'@ +-- | Evaluate each monadic action referenced by a 'Fold' on the structure from left to right, and ignore the results. -- +-- @'Data.Foldable.sequence_' ≡ 'sequenceOf_' 'folded'@ +-- -- @ -- 'sequenceOf_' :: 'Monad' m => 'Getter' a (m b) -> a -> m () -- 'sequenceOf_' :: 'Monad' m => 'Fold' a (m b) -> a -> m () @@ -485,13 +571,13 @@ -- 'sequenceOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a (m b) -> a -> m () -- 'sequenceOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a (m b) -> a -> m () -- @ -sequenceOf_ :: Monad m => Getting (Sequenced m) a (m c) -> a -> m () +sequenceOf_ :: Monad m => Getting (Sequenced m) a b (m c) d -> a -> m () sequenceOf_ l = getSequenced . foldMapOf l (Sequenced . liftM skip) {-# INLINE sequenceOf_ #-} -- | The sum of a collection of actions, generalizing 'concatOf'. -- --- @'asum' = 'asumOf' 'folded'@ +-- @'asum' ≡ 'asumOf' 'folded'@ -- -- @ -- 'asumOf' :: 'Alternative' f => 'Getter' a c -> a -> f c @@ -500,13 +586,13 @@ -- 'asumOf' :: 'Alternative' f => 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> f c -- 'asumOf' :: 'Alternative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> f c -- @ -asumOf :: Alternative f => Getting (Endo (f c)) a (f c) -> a -> f c +asumOf :: Alternative f => Getting (Endo (f c)) a b (f c) d -> a -> f c asumOf l = foldrOf l (<|>) Applicative.empty {-# INLINE asumOf #-} -- | The sum of a collection of actions, generalizing 'concatOf'. -- --- @'msum' = 'msumOf' 'folded'@ +-- @'msum' ≡ 'msumOf' 'folded'@ -- -- @ -- 'msumOf' :: 'MonadPlus' m => 'Getter' a c -> a -> m c @@ -515,13 +601,18 @@ -- 'msumOf' :: 'MonadPlus' m => 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> m c -- 'msumOf' :: 'MonadPlus' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> m c -- @ -msumOf :: MonadPlus m => Getting (Endo (m c)) a (m c) -> a -> m c +msumOf :: MonadPlus m => Getting (Endo (m c)) a b (m c) d -> a -> m c msumOf l = foldrOf l mplus mzero {-# INLINE msumOf #-} --- | --- @'elem' = 'elemOf' 'folded'@ +-- | Does the element occur anywhere within a given 'Fold' of the structure? -- +-- >>> import Control.Lens +-- >>> elemOf both "hello" ("hello","world") +-- True +-- +-- @'elem' ≡ 'elemOf' 'folded'@ +-- -- @ -- 'elemOf' :: 'Eq' c => 'Getter' a c -> c -> a -> 'Bool' -- 'elemOf' :: 'Eq' c => 'Fold' a c -> c -> a -> 'Bool' @@ -529,13 +620,14 @@ -- 'elemOf' :: 'Eq' c => 'Simple' 'Control.Lens.Iso.Iso' a c -> c -> a -> 'Bool' -- 'elemOf' :: 'Eq' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> c -> a -> 'Bool' -- @ -elemOf :: Eq c => Getting Any a c -> c -> a -> Bool +elemOf :: Eq c => Getting Any a b c d -> c -> a -> Bool elemOf l = anyOf l . (==) {-# INLINE elemOf #-} --- | --- @'notElem' = 'notElemOf' 'folded'@ +-- | Does the element not occur anywhere within a given 'Fold' of the structure? -- +-- @'notElem' ≡ 'notElemOf' 'folded'@ +-- -- @ -- 'notElemOf' :: 'Eq' c => 'Getter' a c -> c -> a -> 'Bool' -- 'notElemOf' :: 'Eq' c => 'Fold' a c -> c -> a -> 'Bool' @@ -543,13 +635,14 @@ -- 'notElemOf' :: 'Eq' c => 'Simple' 'Lens' a c -> c -> a -> 'Bool' -- 'notElemOf' :: 'Eq' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> c -> a -> 'Bool' -- @ -notElemOf :: Eq c => Getting All a c -> c -> a -> Bool +notElemOf :: Eq c => Getting All a b c d -> c -> a -> Bool notElemOf l = allOf l . (/=) {-# INLINE notElemOf #-} --- | --- @'concatMap' = 'concatMapOf' 'folded'@ +-- | Map a function over all the targets of a 'Fold' of a container and concatenate the resulting lists. -- +-- @'concatMap' ≡ 'concatMapOf' 'folded'@ +-- -- @ -- 'concatMapOf' :: 'Getter' a c -> (c -> [e]) -> a -> [e] -- 'concatMapOf' :: 'Fold' a c -> (c -> [e]) -> a -> [e] @@ -557,14 +650,19 @@ -- 'concatMapOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> (c -> [e]) -> a -> [e] -- 'concatMapOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> [e]) -> a -> [e] -- @ -concatMapOf :: Getting [e] a c -> (c -> [e]) -> a -> [e] +concatMapOf :: Getting [e] a b c d -> (c -> [e]) -> a -> [e] concatMapOf l ces = runAccessor . l (Accessor . ces) {-# INLINE concatMapOf #-} --- | +-- | Concatenate all of the lists targeted by a 'Fold' into a longer list. +-- +-- >>> import Control.Lens +-- >>> concatOf both ("pan","ama") +-- "panama" +-- -- @ --- 'concat' = 'concatOf' 'folded' --- 'concatOf' = 'view' +-- 'concat' ≡ 'concatOf' 'folded' +-- 'concatOf' ≡ 'view' -- @ -- -- @ @@ -574,14 +672,14 @@ -- 'concatOf' :: 'Simple' 'Lens' a [e] -> a -> [e] -- 'concatOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a [e] -> a -> [e] -- @ -concatOf :: Getting [e] a [e] -> a -> [e] +concatOf :: Getting [e] a b [e] d -> a -> [e] concatOf = view {-# INLINE concatOf #-} -- | -- Note: this can be rather inefficient for large containers. -- --- @'length' = 'lengthOf' 'folded'@ +-- @'length' ≡ 'lengthOf' 'folded'@ -- -- >>> import Control.Lens -- >>> lengthOf _1 ("hello",()) @@ -596,14 +694,14 @@ -- 'lengthOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> 'Int' -- 'lengthOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Int' -- @ -lengthOf :: Getting (Sum Int) a c -> a -> Int +lengthOf :: Getting (Sum Int) a b c d -> a -> Int lengthOf l = getSum . foldMapOf l (\_ -> Sum 1) {-# INLINE lengthOf #-} -- | Perform a safe 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'. See also ('^?'). -- --- @'Data.Maybe.listToMaybe' . 'toList' = 'headOf' 'folded'@ +-- @'Data.Maybe.listToMaybe' '.' 'toList' ≡ 'headOf' 'folded'@ -- -- @ -- 'headOf' :: 'Getter' a c -> a -> 'Maybe' c @@ -612,7 +710,7 @@ -- 'headOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> 'Maybe' c -- 'headOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c -- @ -headOf :: Getting (First c) a c -> a -> Maybe c +headOf :: Getting (First c) a b c d -> a -> Maybe c headOf l = getFirst . foldMapOf l (First . Just) {-# INLINE headOf #-} @@ -622,7 +720,7 @@ -- When using a 'Control.Lens.Traversal.Traversal' as a partial 'Control.Lens.Type.Lens', or a 'Fold' as a partial 'Getter' this can be a convenient -- way to extract the optional value. -- --- @('^?') = 'flip' 'headOf'@ +-- @('^?') ≡ 'flip' 'headOf'@ -- -- @ -- ('^?') :: a -> 'Getter' a c -> 'Maybe' c @@ -631,7 +729,7 @@ -- ('^?') :: a -> 'Simple' 'Control.Lens.Iso.Iso' a c -> 'Maybe' c -- ('^?') :: a -> 'Simple' 'Control.Lens.Traversal.Traversal' a c -> 'Maybe' c -- @ -(^?) :: a -> Getting (First c) a c -> Maybe c +(^?) :: a -> Getting (First c) a b c d -> Maybe c a ^? l = getFirst (foldMapOf l (First . Just) a) {-# INLINE (^?) #-} @@ -645,7 +743,7 @@ -- 'lastOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c -> a -> 'Maybe' c -- 'lastOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c -- @ -lastOf :: Getting (Last c) a c -> a -> Maybe c +lastOf :: Getting (Last c) a b c d -> a -> Maybe c lastOf l = getLast . foldMapOf l (Last . Just) {-# INLINE lastOf #-} @@ -654,7 +752,7 @@ -- -- Note: 'nullOf' on a valid 'Control.Lens.Iso.Iso', 'Lens' or 'Getter' should always return 'False' -- --- @'null' = 'nullOf' 'folded'@ +-- @'null' ≡ 'nullOf' 'folded'@ -- -- This may be rather inefficient compared to the 'null' check of many containers. -- @@ -662,7 +760,7 @@ -- >>> nullOf _1 (1,2) -- False -- --- @'nullOf' ('folded' . '_1' . 'folded') :: 'Foldable' f => f (g a, b) -> 'Bool'@ +-- @'nullOf' ('folded' '.' '_1' '.' 'folded') :: 'Foldable' f => f (g a, b) -> 'Bool'@ -- -- @ -- 'nullOf' :: 'Getter' a c -> a -> 'Bool' @@ -671,7 +769,7 @@ -- 'nullOf' :: 'Simple' 'Lens' a c -> a -> 'Bool' -- 'nullOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Bool' -- @ -nullOf :: Getting All a c -> a -> Bool +nullOf :: Getting All a b c d -> a -> Bool nullOf l = getAll . foldMapOf l (\_ -> All False) {-# INLINE nullOf #-} @@ -680,7 +778,7 @@ -- -- Note: maximumOf on a valid 'Control.Lens.Iso.Iso', 'Lens' or 'Getter' will always return 'Just' a value. -- --- @'maximum' = 'fromMaybe' ('error' "empty") . 'maximumOf' 'folded'@ +-- @'maximum' ≡ 'fromMaybe' ('error' "empty") '.' 'maximumOf' 'folded'@ -- -- @ -- 'maximumOf' :: 'Getter' a c -> a -> 'Maybe' c @@ -689,7 +787,7 @@ -- 'maximumOf' :: 'Simple' 'Lens' a c -> a -> 'Maybe' c -- 'maximumOf' :: 'Ord' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c -- @ -maximumOf :: Getting (Max c) a c -> a -> Maybe c +maximumOf :: Getting (Max c) a b c d -> a -> Maybe c maximumOf l = getMax . foldMapOf l Max {-# INLINE maximumOf #-} @@ -698,7 +796,7 @@ -- -- Note: minimumOf on a valid 'Control.Lens.Iso.Iso', 'Lens' or 'Getter' will always return 'Just' a value. -- --- @'minimum' = 'Data.Maybe.fromMaybe' ('error' "empty") . 'minimumOf' 'folded'@ +-- @'minimum' ≡ 'Data.Maybe.fromMaybe' ('error' "empty") '.' 'minimumOf' 'folded'@ -- -- @ -- 'minimumOf' :: 'Getter' a c -> a -> 'Maybe' c @@ -707,7 +805,7 @@ -- 'minimumOf' :: 'Simple' 'Lens' a c -> a -> 'Maybe' c -- 'minimumOf' :: 'Ord' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c -- @ -minimumOf :: Getting (Min c) a c -> a -> Maybe c +minimumOf :: Getting (Min c) a b c d -> a -> Maybe c minimumOf l = getMin . foldMapOf l Min {-# INLINE minimumOf #-} @@ -715,7 +813,7 @@ -- Obtain the maximum element (if any) targeted by a 'Fold', 'Control.Lens.Traversal.Traversal', 'Lens', 'Control.Lens.Iso.Iso', -- or 'Getter' according to a user supplied ordering. -- --- @'Data.Foldable.maximumBy' cmp = 'Data.Maybe.fromMaybe' ('error' "empty") . 'maximumByOf' 'folded' cmp@ +-- @'Data.Foldable.maximumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' "empty") '.' 'maximumByOf' 'folded' cmp@ -- -- @ -- 'maximumByOf' :: 'Getter' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c @@ -724,7 +822,7 @@ -- 'maximumByOf' :: 'Simple' 'Lens' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c -- 'maximumByOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c -- @ -maximumByOf :: Getting (Endo (Maybe c)) a c -> (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 step a Nothing = Just a step a (Just b) = Just (if cmp a b == GT then a else b) @@ -734,7 +832,7 @@ -- Obtain the minimum element (if any) targeted by a 'Fold', 'Control.Lens.Traversal.Traversal', 'Lens', 'Control.Lens.Iso.Iso' -- or 'Getter' according to a user supplied ordering. -- --- > minimumBy cmp = fromMaybe (error "empty") . minimumByOf folded cmp +-- @'minimumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' "empty") '.' 'minimumByOf' 'folded' cmp@ -- -- @ -- 'minimumByOf' :: 'Getter' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c @@ -743,7 +841,7 @@ -- 'minimumByOf' :: 'Simple' 'Lens' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c -- 'minimumByOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c -- @ -minimumByOf :: Getting (Endo (Maybe c)) a c -> (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 step a Nothing = Just a step a (Just b) = Just (if cmp a b == GT then b else a) @@ -760,7 +858,7 @@ -- 'findOf' :: 'Simple' 'Lens' a c -> (c -> 'Bool') -> a -> 'Maybe' c -- 'findOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> 'Bool') -> a -> 'Maybe' c -- @ -findOf :: Getting (First c) a c -> (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 | p c = First (Just c) @@ -772,9 +870,10 @@ -- to lenses and structures such that the lens views at least one element of -- the structure. -- --- @'foldr1Of' l f = 'Prelude.foldr1' f . 'toListOf' l@ --- --- @'Data.Foldable.foldr1' = 'foldr1Of' 'folded'@ +-- @ +-- 'foldr1Of' l f ≡ 'Prelude.foldr1' f '.' 'toListOf' l +-- 'Data.Foldable.foldr1' ≡ 'foldr1Of' 'folded' +-- @ -- -- @ -- 'foldr1Of' :: 'Getter' a c -> (c -> c -> c) -> a -> c @@ -783,7 +882,7 @@ -- 'foldr1Of' :: 'Simple' 'Lens' a c -> (c -> c -> c) -> a -> c -- 'foldr1Of' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> c) -> a -> c -- @ -foldr1Of :: Getting (Endo (Maybe c)) a c -> (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") (foldrOf l mf Nothing xs) where mf x Nothing = Just x @@ -793,9 +892,10 @@ -- | A variant of 'foldlOf' that has no base case and thus may only be applied to lenses and strutures such -- that the lens views at least one element of the structure. -- --- @'foldl1Of' l f = 'Prelude.foldl1Of' l f . 'toList'@ --- --- @'Data.Foldable.foldl1' = 'foldl1Of' 'folded'@ +-- @ +-- 'foldl1Of' l f ≡ 'Prelude.foldl1Of' l f . 'toList' +-- 'Data.Foldable.foldl1' ≡ 'foldl1Of' 'folded' +-- @ -- -- @ -- 'foldl1Of' :: 'Getter' a c -> (c -> c -> c) -> a -> c @@ -804,7 +904,7 @@ -- 'foldl1Of' :: 'Simple' 'Lens' a c -> (c -> c -> c) -> a -> c -- 'foldl1Of' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> c) -> a -> c -- @ -foldl1Of :: Getting (Dual (Endo (Maybe c))) a c -> (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 mf Nothing y = Just y mf (Just x) y = Just (f x y) @@ -812,7 +912,7 @@ -- | Strictly fold right over the elements of a structure. -- --- @'Data.Foldable.foldr'' = 'foldrOf'' 'folded'@ +-- @'Data.Foldable.foldr'' ≡ 'foldrOf'' 'folded'@ -- -- @ -- 'foldrOf'' :: 'Getter' a c -> (c -> e -> e) -> e -> a -> e @@ -821,14 +921,14 @@ -- 'foldrOf'' :: 'Simple' 'Lens' a c -> (c -> e -> e) -> e -> a -> e -- 'foldrOf'' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> e) -> e -> a -> e -- @ -foldrOf' :: Getting (Dual (Endo (e -> e))) a c -> (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 where f' k x z = k $! f x z {-# INLINE foldrOf' #-} -- | Fold over the elements of a structure, associating to the left, but strictly. -- --- @'Data.Foldable.foldl'' = 'foldlOf'' 'folded'@ +-- @'Data.Foldable.foldl'' ≡ 'foldlOf'' 'folded'@ -- -- @ -- 'foldlOf'' :: 'Getter' a c -> (e -> c -> e) -> e -> a -> e @@ -837,7 +937,7 @@ -- 'foldlOf'' :: 'Simple' 'Lens' a c -> (e -> c -> e) -> e -> a -> e -- 'foldlOf'' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> e) -> e -> a -> e -- @ -foldlOf' :: Getting (Endo (e -> e)) a c -> (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 {-# INLINE foldlOf' #-} @@ -845,7 +945,7 @@ -- | Monadic fold over the elements of a structure, associating to the right, -- i.e. from right to left. -- --- @'Data.Foldable.foldrM' = 'foldrMOf' 'folded'@ +-- @'Data.Foldable.foldrM' ≡ 'foldrMOf' 'folded'@ -- -- @ -- 'foldrMOf' :: 'Monad' m => 'Getter' a c -> (c -> e -> m e) -> e -> a -> m e @@ -855,7 +955,7 @@ -- 'foldrMOf' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> m e) -> e -> a -> m e -- @ foldrMOf :: Monad m - => Getting (Dual (Endo (e -> m e))) a c + => Getting (Dual (Endo (e -> m e))) a b c d -> (c -> e -> m e) -> e -> a -> m e foldrMOf l f z0 xs = foldlOf l f' return xs z0 where f' k x z = f x z >>= k @@ -864,7 +964,7 @@ -- | Monadic fold over the elements of a structure, associating to the left, -- i.e. from left to right. -- --- @'Data.Foldable.foldlM' = 'foldlMOf' 'folded'@ +-- @'Data.Foldable.foldlM' ≡ 'foldlMOf' 'folded'@ -- -- @ -- 'foldlMOf' :: 'Monad' m => 'Getter' a c -> (e -> c -> m e) -> e -> a -> m e @@ -874,7 +974,7 @@ -- 'foldlMOf' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> m e) -> e -> a -> m e -- @ foldlMOf :: Monad m - => Getting (Endo (e -> m e)) a c + => Getting (Endo (e -> m e)) a b c d -> (e -> c -> m e) -> e -> a -> m e foldlMOf l f z0 xs = foldrOf l f' return xs z0 where f' x k z = f z x >>= k diff --git a/src/Control/Lens/Getter.hs b/src/Control/Lens/Getter.hs --- a/src/Control/Lens/Getter.hs +++ b/src/Control/Lens/Getter.hs @@ -17,12 +17,12 @@ -- into continuation passing style, @(c -> r) -> a -> r@ and decorated -- with 'Accessor' to obtain: -- --- @type 'Getting' r a c = (c -> 'Accessor' r c) -> a -> 'Accessor' r a@ +-- @type 'Getting' r a b c d = (c -> 'Accessor' r d) -> a -> 'Accessor' r b@ -- -- If we restrict access to knowledge about the type 'r' and can work for -- any d and b, we could get: -- --- @type 'Getter' a c = forall r. 'Getting' r a c@ +-- @type 'Getter' a c = forall r. 'Getting' r a a c c@ -- -- But we actually hide the use of 'Accessor' behind a class 'Gettable' -- to error messages from type class resolution rather than at unification @@ -87,6 +87,13 @@ -- @a '^.' 'to' f = f a@ -- -- >>> import Control.Lens +-- +-- >>> ("hello","world")^.to snd +-- "world" +-- +-- >>> 5^.to succ +-- 6 +-- -- >>> (0, -5)^._2.to abs -- 5 to :: (a -> c) -> Getter a c @@ -101,11 +108,11 @@ -- 'Control.Lens.Iso.Iso' we also restricted choices of the irrelevant @b@ and -- @d@ parameters. -- --- If a function accepts a @'Getting' r a c@, then when @r@ is a 'Monoid', then +-- If a function accepts a @'Getting' r a b c d@, then when @r@ is a 'Monoid', then -- you can pass a 'Control.Lens.Fold.Fold' (or -- 'Control.Lens.Traversal.Traversal'), otherwise you can only pass this a -- 'Getter' or 'Control.Lens.Type.Lens'. -type Getting r a c = (c -> Accessor r c) -> a -> Accessor r a +type Getting r a b c d = (c -> Accessor r d) -> a -> Accessor r b ------------------------------------------------------------------------------- -- Getting Values @@ -122,7 +129,14 @@ -- >>> view _2 (1,"hello") -- "hello" -- --- It may be useful to think of 'view' as having these more restrictive +-- >>> view (to succ) 5 +-- 6 +-- +-- >>> view (_2._1) ("hello",("world","!!!")) +-- "world" +-- +-- +-- It may be useful to think of 'view' as having one of these more restrictive -- signatures: -- -- @ @@ -132,7 +146,7 @@ -- 'view' :: 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> a -> c -- 'view' :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m -> a -> m -- @ -view :: Getting c a c -> a -> c +view :: Getting c a b c d -> a -> c view l = runAccessor . l Accessor {-# INLINE view #-} @@ -144,6 +158,8 @@ -- It may be useful to think of 'views' as having these more restrictive -- signatures: -- +-- @'views' l f = 'view' (l '.' 'to' f)@ +-- -- >>> import Control.Lens -- >>> views _2 length (1,"hello") -- 5 @@ -155,7 +171,7 @@ -- 'views' :: 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> (c -> d) -> a -> d -- 'views' :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> m) -> a -> m -- @ -views :: Getting m a c -> (c -> m) -> a -> m +views :: Getting m a b c d -> (c -> m) -> a -> m views l f = runAccessor . l (Accessor . f) {-# INLINE views #-} @@ -166,6 +182,8 @@ -- -- This is the same operation as 'view', only infix. -- +-- @'to' f '^$' x = f x@ +-- -- >>> import Control.Lens -- >>> _2 ^$ (1, "hello") -- "hello" @@ -177,7 +195,7 @@ -- ('^$') :: 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> a -> c -- ('^$') :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m -> a -> m -- @ -(^$) :: Getting c a c -> a -> c +(^$) :: Getting c a b c d -> a -> c l ^$ a = runAccessor (l Accessor a) {-# INLINE (^$) #-} @@ -190,7 +208,11 @@ -- The fixity and semantics are such that subsequent field accesses can be -- performed with ('Prelude..') -- --- >>> :m + Data.Complex Control.Lens +-- >>> import Control.Lens +-- >>> ("hello","world")^._2 +-- "world" +-- +-- >>> import Data.Complex -- >>> ((0, 1 :+ 2), 3)^._1._2.to magnitude -- 2.23606797749979 -- @@ -201,7 +223,7 @@ -- ('^.') :: a -> 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> c -- ('^.') :: 'Monoid' m => a -> 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m -> m -- @ -(^.) :: a -> Getting c a c -> c +(^.) :: a -> Getting c a b c d -> c a ^. l = runAccessor (l Accessor a) {-# INLINE (^.) #-} @@ -222,7 +244,7 @@ -- 'use' :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> m c -- 'use' :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a r -> m r -- @ -use :: MonadState a m => Getting c a c -> m c +use :: MonadState a m => Getting c a b c d -> m c use l = State.gets (view l) {-# INLINE use #-} @@ -239,7 +261,7 @@ -- 'uses' :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c -> (c -> e) -> m e -- 'uses' :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> r) -> m r -- @ -uses :: MonadState a m => Getting e a c -> (c -> e) -> m e +uses :: MonadState a m => Getting e a b c d -> (c -> e) -> m e uses l f = State.gets (views l f) {-# INLINE uses #-} @@ -260,7 +282,7 @@ -- 'query' :: 'MonadReader' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> m c -- 'query' :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> m c -- @ -query :: MonadReader a m => Getting c a c -> m c +query :: MonadReader a m => Getting c a b c d -> m c query l = Reader.asks (^.l) {-# INLINE query #-} @@ -277,7 +299,7 @@ -- 'queries' :: 'MonadReader' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> (c -> e) -> m e -- 'queries' :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e) -> m e -- @ -queries :: MonadReader a m => Getting e a c -> (c -> e) -> m e +queries :: MonadReader a m => Getting e a b c d -> (c -> e) -> m e queries l f = Reader.asks (views l f) {-# INLINE queries #-} diff --git a/src/Control/Lens/Indexed.hs b/src/Control/Lens/Indexed.hs --- a/src/Control/Lens/Indexed.hs +++ b/src/Control/Lens/Indexed.hs @@ -89,11 +89,11 @@ -- | Transform an Traversal into an IndexedTraversal, a Fold into an IndexedFold, etc. -- -- @ --- 'indexed' :: 'Traversal' a b c d -> 'IndexedTraversal' 'Int' a b c d --- 'indexed' :: 'Lens' a b c d -> 'IndexedLens' 'Int' a b c d --- 'indexed' :: 'Fold' a b -> 'IndexedFold' 'Int' a b --- 'indexed' :: 'Iso' a b c d -> 'IndexedLens' 'Int' a b c d --- 'indexed' :: 'Getter' a b -> 'IndexedGetter' 'Int' a b c d +-- 'indexed' :: 'Control.Lens.Traversal.Traversal' a b c d -> 'Control.Lens.IndexedTraversal.IndexedTraversal' 'Int' a b c d +-- 'indexed' :: 'Control.Lens.Type.Lens' a b c d -> 'Control.Lens.IndexedLens.IndexedLens' 'Int' a b c d +-- 'indexed' :: 'Control.Lens.Fold.Fold' a b -> 'Control.Lens.IndexedFold.IndexedFold' 'Int' a b +-- 'indexed' :: 'Control.Lens.Iso.Iso' a b c d -> 'Control.Lens.IndexedLens.IndexedLens' 'Int' a b c d +-- 'indexed' :: 'Control.Lens.Getter.Getter' a b -> 'Control.Lens.IndexedGetter.IndexedGetter' 'Int' a b c d -- @ indexed :: Indexed Int k => ((c -> Indexing f d) -> a -> Indexing f b) -> k (c -> f d) (a -> f b) indexed l = index $ \icfd a -> case runIndexing (l (\c -> Indexing (\i -> IndexingResult (icfd i c) (i + 1))) a) 0 of diff --git a/src/Control/Lens/IndexedFold.hs b/src/Control/Lens/IndexedFold.hs --- a/src/Control/Lens/IndexedFold.hs +++ b/src/Control/Lens/IndexedFold.hs @@ -70,7 +70,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.foldMapOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.foldMapOf' l = 'ifoldMapOf' l . 'const'@ +-- @'Control.Lens.Fold.foldMapOf' l ≡ 'ifoldMapOf' l '.' 'const'@ -- -- @ -- 'ifoldMapOf' :: 'IndexedGetter' i a c -> (i -> c -> m) -> a -> m @@ -78,7 +78,7 @@ -- 'ifoldMapOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> m) -> a -> m -- 'ifoldMapOf' :: 'Monoid' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> m) -> a -> m -- @ -ifoldMapOf :: IndexedGetting i m a c -> (i -> c -> m) -> a -> m +ifoldMapOf :: IndexedGetting i m a b c d -> (i -> c -> m) -> a -> m ifoldMapOf l f = runAccessor . withIndex l (\i -> Accessor . f i) {-# INLINE ifoldMapOf #-} @@ -88,7 +88,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.foldrOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.foldrOf' l = 'ifoldrOf' l . 'const'@ +-- @'Control.Lens.Fold.foldrOf' l ≡ 'ifoldrOf' l '.' 'const'@ -- -- @ -- 'ifoldrOf' :: 'IndexedGetter' i a c -> (i -> c -> e -> e) -> e -> a -> e @@ -96,7 +96,7 @@ -- 'ifoldrOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> e -> e) -> e -> a -> e -- 'ifoldrOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> e) -> e -> a -> e -- @ -ifoldrOf :: IndexedGetting i (Endo e) a c -> (i -> c -> e -> e) -> e -> a -> e +ifoldrOf :: IndexedGetting i (Endo e) a b c d -> (i -> c -> e -> e) -> e -> a -> e ifoldrOf l f z t = appEndo (ifoldMapOf l (\i -> Endo . f i) t) z {-# INLINE ifoldrOf #-} @@ -106,7 +106,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.foldlOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.foldlOf' l = 'ifoldlOf' l . 'const'@ +-- @'Control.Lens.Fold.foldlOf' l ≡ 'ifoldlOf' l '.' 'const'@ -- -- @ -- 'ifoldlOf' :: 'IndexedGetter' i a c -> (i -> e -> c -> e) -> e -> a -> e @@ -114,7 +114,7 @@ -- 'ifoldlOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> e -> c -> e) -> e -> a -> e -- 'ifoldlOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> e -> c -> e) -> e -> a -> e -- @ -ifoldlOf :: IndexedGetting i (Dual (Endo e)) a c -> (i -> e -> c -> e) -> e -> a -> e +ifoldlOf :: IndexedGetting i (Dual (Endo e)) a b c d -> (i -> e -> c -> e) -> e -> a -> e ifoldlOf l f z t = appEndo (getDual (ifoldMapOf l (\i -> Dual . Endo . flip (f i)) t)) z {-# INLINE ifoldlOf #-} @@ -124,7 +124,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.anyOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.anyOf' l = 'ianyOf' l . 'const'@ +-- @'Control.Lens.Fold.anyOf' l ≡ 'ianyOf' l '.' 'const'@ -- -- @ -- 'ianyOf' :: 'IndexedGetter' i a c -> (i -> c -> 'Bool') -> a -> 'Bool' @@ -132,7 +132,7 @@ -- 'ianyOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> 'Bool') -> a -> 'Bool' -- 'ianyOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> 'Bool') -> a -> 'Bool' -- @ -ianyOf :: IndexedGetting i Any a c -> (i -> c -> Bool) -> a -> Bool +ianyOf :: IndexedGetting i Any a b c d -> (i -> c -> Bool) -> a -> Bool ianyOf l f = getAny . ifoldMapOf l (\i -> Any . f i) {-# INLINE ianyOf #-} @@ -142,7 +142,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.allOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.allOf' l = 'iallOf' l . 'const'@ +-- @'Control.Lens.Fold.allOf' l ≡ 'iallOf' l '.' 'const'@ -- -- @ -- 'iallOf' :: 'IndexedGetter' i a c -> (i -> c -> 'Bool') -> a -> 'Bool' @@ -150,7 +150,7 @@ -- 'iallOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> 'Bool') -> a -> 'Bool' -- 'iallOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> 'Bool') -> a -> 'Bool' -- @ -iallOf :: IndexedGetting i All a c -> (i -> c -> Bool) -> a -> Bool +iallOf :: IndexedGetting i All a b c d -> (i -> c -> Bool) -> a -> Bool iallOf l f = getAll . ifoldMapOf l (\i -> All . f i) {-# INLINE iallOf #-} @@ -159,7 +159,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.traverseOf_' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.traverseOf_' l = 'itraverseOf' l . 'const'@ +-- @'Control.Lens.Fold.traverseOf_' l ≡ 'itraverseOf' l '.' 'const'@ -- -- @ -- 'itraverseOf_' :: 'Functor' f => 'IndexedGetter' i a c -> (i -> c -> f e) -> a -> f () @@ -167,7 +167,7 @@ -- 'itraverseOf_' :: 'Functor' f => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> f e) -> a -> f () -- 'itraverseOf_' :: 'Applicative' f => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> f e) -> a -> f () -- @ -itraverseOf_ :: Functor f => IndexedGetting i (Traversed f) a c -> (i -> c -> f e) -> a -> f () +itraverseOf_ :: Functor f => IndexedGetting i (Traversed f) a b c d -> (i -> c -> f e) -> a -> f () itraverseOf_ l f = getTraversed . ifoldMapOf l (\i -> Traversed . void . f i) {-# INLINE itraverseOf_ #-} @@ -175,11 +175,11 @@ -- Traverse the targets of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index, discarding the results -- (with the arguments flipped). -- --- @'iforOf_' = 'flip' . 'itraverseOf_'@ +-- @'iforOf_' ≡ 'flip' '.' 'itraverseOf_'@ -- -- When you don't need access to the index then 'Control.Lens.Fold.forOf_' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.forOf_' l a = 'iforOf_' l a . 'const'@ +-- @'Control.Lens.Fold.forOf_' l a ≡ 'iforOf_' l a '.' 'const'@ -- -- @ -- 'iforOf_' :: 'Functor' f => 'IndexedGetter' i a c -> a -> (i -> c -> f e) -> f () @@ -187,7 +187,7 @@ -- 'iforOf_' :: 'Functor' f => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> a -> (i -> c -> f e) -> f () -- 'iforOf_' :: 'Applicative' f => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> (i -> c -> f e) -> f () -- @ -iforOf_ :: Functor f => IndexedGetting i (Traversed f) a c -> a -> (i -> c -> f e) -> f () +iforOf_ :: Functor f => IndexedGetting i (Traversed f) a b c d -> a -> (i -> c -> f e) -> f () iforOf_ = flip . itraverseOf_ {-# INLINE iforOf_ #-} @@ -197,7 +197,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.mapMOf_' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.mapMOf_' l = 'imapMOf' l . 'const'@ +-- @'Control.Lens.Fold.mapMOf_' l ≡ 'imapMOf' l '.' 'const'@ -- -- @ -- 'imapMOf_' :: 'Monad' m => 'IndexedGetter' i a c -> (i -> c -> m e) -> a -> m () @@ -205,7 +205,7 @@ -- 'imapMOf_' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> m e) -> a -> m () -- 'imapMOf_' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> m e) -> a -> m () -- @ -imapMOf_ :: Monad m => IndexedGetting i (Sequenced m) a c -> (i -> c -> m e) -> a -> m () +imapMOf_ :: Monad m => IndexedGetting i (Sequenced m) a b c d -> (i -> c -> m e) -> a -> m () imapMOf_ l f = getSequenced . ifoldMapOf l (\i -> Sequenced . liftM skip . f i) {-# INLINE imapMOf_ #-} @@ -217,11 +217,11 @@ -- Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index, -- discarding the results (with the arguments flipped). -- --- @'iforMOf_' = 'flip' . 'imapMOf_'@ +-- @'iforMOf_' ≡ 'flip' '.' 'imapMOf_'@ -- -- When you don't need access to the index then 'Control.Lens.Fold.forMOf_' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.forMOf_' l a = 'iforMOf' l a . 'const'@ +-- @'Control.Lens.Fold.forMOf_' l a ≡ 'iforMOf' l a '.' 'const'@ -- -- @ -- 'iforMOf_' :: 'Monad' m => 'IndexedGetter' i a c -> a -> (i -> c -> m e) -> m () @@ -229,7 +229,7 @@ -- 'iforMOf_' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> a -> (i -> c -> m e) -> m () -- 'iforMOf_' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> (i -> c -> m e) -> m () -- @ -iforMOf_ :: Monad m => IndexedGetting i (Sequenced m) a c -> a -> (i -> c -> m e) -> m () +iforMOf_ :: Monad m => IndexedGetting i (Sequenced m) a b c d -> a -> (i -> c -> m e) -> m () iforMOf_ = flip . imapMOf_ {-# INLINE iforMOf_ #-} @@ -240,8 +240,8 @@ -- When you don't need access to the index then 'Control.Lens.Fold.concatMapOf' is more flexible in what it accepts. -- -- @ --- 'Control.Lens.Fold.concatMapOf' l = 'iconcatMapOf' l . 'const' --- 'iconcatMapOf' = 'ifoldMapOf' +-- 'Control.Lens.Fold.concatMapOf' l ≡ 'iconcatMapOf' l '.' 'const' +-- 'iconcatMapOf' ≡ 'ifoldMapOf' -- @ -- -- @ @@ -250,7 +250,7 @@ -- 'iconcatMapOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> [e]) -> a -> [e] -- 'iconcatMapOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> [e]) -> a -> [e] -- @ -iconcatMapOf :: IndexedGetting i [e] a c -> (i -> c -> [e]) -> a -> [e] +iconcatMapOf :: IndexedGetting i [e] a b c d -> (i -> c -> [e]) -> a -> [e] iconcatMapOf = ifoldMapOf {-# INLINE iconcatMapOf #-} @@ -260,7 +260,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.findOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.findOf' l = 'ifindOf' l . 'const'@ +-- @'Control.Lens.Fold.findOf' l ≡ 'ifindOf' l '.' 'const'@ -- -- @ -- 'ifindOf' :: 'IndexedGetter' a c -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c) @@ -268,7 +268,7 @@ -- 'ifindOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' a c -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c) -- 'ifindOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' a c -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c) -- @ -ifindOf :: IndexedGetting i (First (i, c)) a c -> (i -> c -> Bool) -> a -> Maybe (i, c) +ifindOf :: IndexedGetting i (First (i, c)) a b c d -> (i -> c -> Bool) -> a -> Maybe (i, c) ifindOf l p = getFirst . ifoldMapOf l step where step i c | p i c = First $ Just (i, c) @@ -279,7 +279,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.foldrOf'' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.foldrOf'' l = 'ifoldrOf'' l . 'const'@ +-- @'Control.Lens.Fold.foldrOf'' l ≡ 'ifoldrOf'' l '.' 'const'@ -- -- @ -- 'ifoldrOf'' :: 'IndexedGetter' i a c -> (i -> c -> e -> e) -> e -> a -> e @@ -287,7 +287,7 @@ -- 'ifoldrOf'' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> e -> e) -> e -> a -> e -- 'ifoldrOf'' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> e) -> e -> a -> e -- @ -ifoldrOf' :: IndexedGetting i (Dual (Endo (e -> e))) a c -> (i -> c -> e -> e) -> e -> a -> e +ifoldrOf' :: IndexedGetting i (Dual (Endo (e -> e))) a b c d -> (i -> c -> e -> e) -> e -> a -> e ifoldrOf' l f z0 xs = ifoldlOf l f' id xs z0 where f' i k x z = k $! f i x z {-# INLINE ifoldrOf' #-} @@ -296,7 +296,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.foldlOf'' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.foldlOf'' l = 'ifoldlOf'' l . 'const'@ +-- @'Control.Lens.Fold.foldlOf'' l ≡ 'ifoldlOf'' l '.' 'const'@ -- -- @ -- 'ifoldlOf'' :: 'IndexedGetter' i a c -> (i -> e -> c -> e) -> e -> a -> e @@ -304,7 +304,7 @@ -- 'ifoldlOf'' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> e -> c -> e) -> e -> a -> e -- 'ifoldlOf'' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> e -> c -> e) -> e -> a -> e -- @ -ifoldlOf' :: IndexedGetting i (Endo (e -> e)) a c -> (i -> e -> c -> e) -> e -> a -> e +ifoldlOf' :: IndexedGetting i (Endo (e -> e)) a b c d -> (i -> e -> c -> e) -> e -> a -> e ifoldlOf' l f z0 xs = ifoldrOf l f' id xs z0 where f' i x k z = k $! f i z x {-# INLINE ifoldlOf' #-} @@ -313,7 +313,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.foldrMOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.foldrMOf' l = 'ifoldrMOf' l . 'const'@ +-- @'Control.Lens.Fold.foldrMOf' l ≡ 'ifoldrMOf' l '.' 'const'@ -- -- @ -- 'ifoldrMOf' :: 'Monad' m => 'IndexedGetter' i a c -> (i -> c -> e -> m e) -> e -> a -> e @@ -321,7 +321,7 @@ -- 'ifoldrMOf' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> c -> e -> m e) -> e -> a -> e -- 'ifoldrMOf' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> m e) -> e -> a -> e -- @ -ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (e -> m e))) a c -> (i -> c -> e -> m e) -> e -> a -> m e +ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (e -> m e))) a b c d -> (i -> c -> e -> m e) -> e -> a -> m e ifoldrMOf l f z0 xs = ifoldlOf l f' return xs z0 where f' i k x z = f i x z >>= k {-# INLINE ifoldrMOf #-} @@ -330,7 +330,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.foldlMOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.foldlMOf' l = 'ifoldlMOf' l . 'const'@ +-- @'Control.Lens.Fold.foldlMOf' l ≡ 'ifoldlMOf' l '.' 'const'@ -- -- @ -- 'ifoldlOf'' :: 'Monad' m => 'IndexedGetter' i a c -> (i -> e -> c -> m e) -> e -> a -> e @@ -338,7 +338,7 @@ -- 'ifoldlOf'' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> (i -> e -> c -> m e) -> e -> a -> e -- 'ifoldlOf'' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> e -> c -> m e) -> e -> a -> e -- @ -ifoldlMOf :: Monad m => IndexedGetting i (Endo (e -> m e)) a c -> (i -> e -> c -> m e) -> e -> a -> m e +ifoldlMOf :: Monad m => IndexedGetting i (Endo (e -> m e)) a b c d -> (i -> e -> c -> m e) -> e -> a -> m e ifoldlMOf l f z0 xs = ifoldrOf l f' return xs z0 where f' i x k z = f i z x >>= k {-# INLINE ifoldlMOf #-} @@ -347,7 +347,7 @@ -- -- When you don't need access to the indices in the result, then 'Control.Lens.Fold.toListOf' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.toListOf' l = 'map' 'fst' . 'itoListOf' l@ +-- @'Control.Lens.Fold.toListOf' l ≡ 'map' 'fst' '.' 'itoListOf' l@ -- -- @ -- 'itoListOf' :: 'IndexedGetter' i a c -> a -> [(i,c)] @@ -355,7 +355,7 @@ -- 'itoListOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c -> a -> [(i,c)] -- 'itoListOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> [(i,c)] -- @ -itoListOf :: IndexedGetting i [(i,c)] a c -> a -> [(i,c)] +itoListOf :: IndexedGetting i [(i,c)] a b c d -> a -> [(i,c)] itoListOf l = ifoldMapOf l (\i c -> [(i,c)]) {-# INLINE itoListOf #-} @@ -402,14 +402,14 @@ ------------------------------------------------------------------------------- -- | Obtain an 'IndexedFold' by filtering a 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter', 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal'. -ifiltered :: (Gettable f, Applicative f, Indexed i k) => (i -> c -> Bool) -> Index i (c -> f c) (a -> f a) -> k (c -> f c) (a -> f a) +ifiltered :: (Gettable f, Applicative f, Indexed i k) => (i -> c -> Bool) -> Index i (c -> f c) (a -> f b) -> k (c -> f c) (a -> f b) ifiltered p l = index $ \ f -> withIndex l $ \ i c -> if p i c then f i c else noEffect {-# INLINE ifiltered #-} -- | Obtain an 'IndexedFold' by taking elements from another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' while a predicate holds. itakingWhile :: (Gettable f, Applicative f, Indexed i k) => (i -> c -> Bool) - -> IndexedGetting i (Endo (f a)) a c + -> IndexedGetting i (Endo (f a)) a a c c -> k (c -> f c) (a -> f a) itakingWhile p l = index $ \ f -> ifoldrOf l (\i a r -> if p i a then f i a *> r else noEffect) noEffect {-# INLINE itakingWhile #-} @@ -418,7 +418,7 @@ -- | Obtain an 'IndexedFold' by dropping elements from another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' while a predicate holds. idroppingWhile :: (Gettable f, Applicative f, Indexed i k) => (i -> c -> Bool) - -> IndexedGetting i (Endo (f a)) a c + -> IndexedGetting i (Endo (f a)) a a c c -> k (c -> f c) (a -> f a) idroppingWhile p l = index $ \f -> ifoldrOf l (\i a r -> if p i a then r else f i a *> r) noEffect {-# INLINE idroppingWhile #-} diff --git a/src/Control/Lens/IndexedGetter.hs b/src/Control/Lens/IndexedGetter.hs --- a/src/Control/Lens/IndexedGetter.hs +++ b/src/Control/Lens/IndexedGetter.hs @@ -29,7 +29,7 @@ type IndexedGetter i a c = forall k f. (Indexed i k, Gettable f) => k (c -> f c) (a -> f a) -- | Used to consume an 'Control.Lens.IndexedFold.IndexedFold'. -type IndexedGetting i m a c = Index i (c -> Accessor m c) (a -> Accessor m a) +type IndexedGetting i m a b c d = Index i (c -> Accessor m d) (a -> Accessor m b) -- | Useful for storage. newtype ReifiedIndexedGetter i a c = ReifyIndexedGetter { reflectIndexedGetter :: IndexedGetter i a c } diff --git a/src/Control/Lens/IndexedLens.hs b/src/Control/Lens/IndexedLens.hs --- a/src/Control/Lens/IndexedLens.hs +++ b/src/Control/Lens/IndexedLens.hs @@ -72,8 +72,8 @@ -- If you do not need the intermediate result, you can use ('Control.Lens.Type.%@~') or even ('Control.Lens.Type.%~'). -- -- @ --- ('\<%\@~') :: 'IndexedLens' i a b c d -> (i -> c -> d) -> a -> (d, b) --- ('\<%\@~') :: 'Monoid' d => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> (d, b) +-- ('<%@~') :: 'IndexedLens' i a b c d -> (i -> c -> d) -> a -> (d, b) +-- ('<%@~') :: 'Monoid' d => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> (d, b) -- @ (<%@~) :: Overloaded (Index i) ((,)d) a b c d -> (i -> c -> d) -> a -> (d, b) l <%@~ f = withIndex l $ \i c -> let d = f i c in (d, d) @@ -86,16 +86,16 @@ -- @('%%@~') = 'withIndex'@ -- -- @ --- ('%%\@~') :: 'Functor' f => 'IndexedLens' i a b c d -> (i -> c -> f d) -> a -> f b --- ('%%\@~') :: 'Functor' f => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> f d) -> a -> f b +-- ('%%@~') :: 'Functor' f => 'IndexedLens' i a b c d -> (i -> c -> f d) -> a -> f b +-- ('%%@~') :: 'Functor' f => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> f d) -> a -> f b -- @ -- -- In particular, it is often useful to think of this function as having one of these even more -- restrictive type signatures -- -- @ --- ('%%\@~') :: 'IndexedLens' i a b c d -> (i -> c -> (e, d)) -> a -> (e, b) --- ('%%\@~') :: 'Monoid' e => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> (e, d)) -> a -> (e, b) +-- ('%%@~') :: 'IndexedLens' i a b c d -> (i -> c -> (e, d)) -> a -> (e, b) +-- ('%%@~') :: 'Monoid' e => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> (e, d)) -> a -> (e, b) -- @ (%%@~) :: Overloaded (Index i) f a b c d -> (i -> c -> f d) -> a -> f b (%%@~) = withIndex @@ -108,8 +108,8 @@ -- @l '%%@=' f = 'state' (l '%%@~' f)@ -- -- @ --- ('%%\@=') :: 'MonadState' a m 'IndexedLens' i a a c d -> (i -> c -> (e, d)) -> a -> m e --- ('%%\@=') :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a a c d -> (i -> c -> (e, d)) -> a -> m e +-- ('%%@=') :: 'MonadState' a m 'IndexedLens' i a a c d -> (i -> c -> (e, d)) -> a -> m e +-- ('%%@=') :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a a c d -> (i -> c -> (e, d)) -> a -> m e -- @ (%%@=) :: MonadState a m => Overloaded (Index i) ((,)e) a a c d -> (i -> c -> (e, d)) -> m e #if MIN_VERSION_mtl(2,1,0) @@ -127,8 +127,8 @@ -- return a monoidal summary of the intermediate results. -- -- @ --- ('\<%\@=') :: 'MonadState' a m 'IndexedLens' i a a c d -> (i -> c -> d) -> a -> m d --- ('\<%\@=') :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a a c d -> (i -> c -> d) -> a -> m d +-- ('<%@=') :: 'MonadState' a m 'IndexedLens' i a a c d -> (i -> c -> d) -> a -> m d +-- ('<%@=') :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a a c d -> (i -> c -> d) -> a -> m d -- @ (<%@=) :: MonadState a m => Overloaded (Index i) ((,)d) a a c d -> (i -> c -> d) -> m d l <%@= f = l %%@= \ i c -> let d = f i c in (d, d) diff --git a/src/Control/Lens/IndexedSetter.hs b/src/Control/Lens/IndexedSetter.hs --- a/src/Control/Lens/IndexedSetter.hs +++ b/src/Control/Lens/IndexedSetter.hs @@ -50,7 +50,7 @@ -- -- When you do not need access to the index, then 'mapOf' is more liberal in what it can accept. -- --- @'Control.Lens.Setter.mapOf' l = 'imapOf' l . 'const'@ +-- @'Control.Lens.Setter.mapOf' l ≡ 'imapOf' l '.' 'const'@ -- -- @ -- 'imapOf' :: 'IndexedSetter' i a b c d -> (i -> c -> d) -> a -> b @@ -65,7 +65,7 @@ -- -- When you do not need access to the index, then 'over' is more liberal in what it can accept. -- --- @'Control.Lens.Setter.over' l = 'iover' l . 'const'@ +-- @'Control.Lens.Setter.over' l ≡ 'iover' l '.' 'const'@ -- -- @ -- 'iover' :: 'IndexedSetter' i a b c d -> (i -> c -> d) -> a -> b @@ -81,15 +81,15 @@ -- Your supplied function @f@ is required to satisfy: -- -- @ --- f 'id' = 'id' --- f g '.' f h = f (g '.' h) +-- f 'id' ≡ 'id' +-- f g '.' f h ≡ f (g '.' h) -- @ -- -- Equational reasoning: -- -- @ --- 'isets' . 'iover' = 'id' --- 'iover' . 'isets' = 'id' +-- 'isets' '.' 'iover' ≡ 'id' +-- 'iover' '.' 'isets' ≡ 'id' -- @ -- -- Another way to view 'sets' is that it takes a \"semantic editor combinator\" @@ -101,11 +101,11 @@ -- | Adjust every target of an 'IndexedSetter', 'Control.Lens.IndexedLens.IndexedLens' or 'Control.Lens.IndexedTraversal.IndexedTraversal' -- with access to the index. -- --- @('%@~') = 'imapOf'@ +-- @('%@~') ≡ 'imapOf'@ -- -- When you do not need access to the index then ('%@~') is more liberal in what it can accept. -- --- @l 'Control.Lens.Setter.%~' f = l '%@~' 'const' f@ +-- @l 'Control.Lens.Setter.%~' f ≡ l '%@~' 'const' f@ -- -- @ -- ('%@~') :: 'IndexedSetter' i a b c d -> (i -> c -> d) -> a -> b @@ -119,9 +119,9 @@ -- | Adjust every target in the current state of an 'IndexedSetter', 'Control.Lens.IndexedLens.IndexedLens' or 'Control.Lens.IndexedTraversal.IndexedTraversal' -- with access to the index. -- --- When you do not need access to the index then ('%=') is more liberal in what it can accept. +-- When you do not need access to the index then ('Control.Lens.Setter.%=') is more liberal in what it can accept. -- --- @l 'Control.Lens.Setter.%=' f = l '%@=' 'const' f@ +-- @l 'Control.Lens.Setter.%=' f ≡ l '%@=' 'const' f@ -- -- @ -- ('%@=') :: 'MonadState' a m => 'IndexedSetter' i a a c d -> (i -> c -> d) -> m () diff --git a/src/Control/Lens/IndexedTraversal.hs b/src/Control/Lens/IndexedTraversal.hs --- a/src/Control/Lens/IndexedTraversal.hs +++ b/src/Control/Lens/IndexedTraversal.hs @@ -1,8 +1,14 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} + +#ifndef MIN_VERSION_containers +#define MIN_VERSION_containers(x,y,z) 1 +#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.IndexedTraversal @@ -22,6 +28,8 @@ , traverseAt , iwhereOf , value + , TraverseMin(..) + , TraverseMax(..) -- * Indexed Traversal Combinators , itraverseOf @@ -46,6 +54,8 @@ import Control.Lens.Type import Control.Monad.Trans.State.Lazy as Lazy import Data.Traversable +import Data.IntMap as IntMap +import Data.Map as Map ------------------------------------------------------------------------------ -- Indexed Traversals @@ -67,8 +77,8 @@ -- directly as a function! -- -- @ --- 'itraverseOf' = 'withIndex' --- 'Control.Lens.Traversal.traverseOf' l = 'itraverseOf' l . 'const' = 'id' +-- 'itraverseOf' ≡ 'withIndex' +-- 'Control.Lens.Traversal.traverseOf' l = 'itraverseOf' l '.' 'const' = 'id' -- @ -- -- @ @@ -82,9 +92,10 @@ -- | -- Traverse with an index (and the arguments flipped) -- --- @'Control.Lens.Traversal.forOf' l a = 'iforOf' l a . 'const'@ --- --- @'iforOf' = 'flip' . 'itraverseOf'@ +-- @ +-- 'Control.Lens.Traversal.forOf' l a ≡ 'iforOf' l a '.' 'const' +-- 'iforOf' ≡ 'flip' . 'itraverseOf' +-- @ -- -- @ -- 'iforOf' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d -> a -> (i -> c -> f d) -> f b @@ -100,7 +111,7 @@ -- -- When you don't need access to the index 'mapMOf' is more liberal in what it can accept. -- --- @'Control.Lens.Traversal.mapMOf' l = 'imapMOf' l . 'const'@ +-- @'Control.Lens.Traversal.mapMOf' l ≡ 'imapMOf' l '.' 'const'@ -- -- @ -- 'imapMOf' :: 'Monad' m => 'Control.Lens.IndexedLens.IndexedLens' i a b c d -> (i -> c -> m d) -> a -> m b @@ -115,8 +126,8 @@ -- its position (and the arguments flipped). -- -- @ --- 'Control.Lens.Traversal.forMOf' l a = 'iforMOf' l a . 'const' --- 'iforMOf' = 'flip' . 'imapMOf' +-- 'Control.Lens.Traversal.forMOf' l a ≡ 'iforMOf' l a '.' 'const' +-- 'iforMOf' ≡ 'flip' '.' 'imapMOf' -- @ -- -- @ @@ -131,7 +142,7 @@ -- -- 'imapAccumROf' accumulates state from right to left. -- --- @'Control.Lens.Traversal.mapAccumROf' l = 'imapAccumROf' l . 'const'@ +-- @'Control.Lens.Traversal.mapAccumROf' l ≡ 'imapAccumROf' l '.' 'const'@ -- -- @ -- 'imapAccumROf' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b) @@ -145,7 +156,7 @@ -- -- 'imapAccumLOf' accumulates state from left to right. -- --- @'Control.Lens.Traversal.mapAccumLOf' l = 'imapAccumLOf' l . 'const'@ +-- @'Control.Lens.Traversal.mapAccumLOf' l ≡ 'imapAccumLOf' l '.' 'const'@ -- -- @ -- 'imapAccumLOf' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b) @@ -192,6 +203,48 @@ value :: (k -> Bool) -> SimpleIndexedTraversal k (k, v) v value p = index $ \ f kv@(k,v) -> if p k then (,) k <$> f k v else pure kv {-# INLINE value #-} + +-- | Allows 'IndexedTraversal' the value at the smallest index. +class Ord k => TraverseMin k m | m -> k where + -- | 'IndexedTraversal' of the element with the smallest index. + traverseMin :: SimpleIndexedTraversal k (m v) v + +instance TraverseMin Int IntMap where + traverseMin = index $ \f m -> case IntMap.minViewWithKey m of +#if MIN_VERSION_containers(0,5,0) + Just ((k,a), _) -> (\v -> IntMap.updateMin (const (Just v)) m) <$> f k a +#else + Just ((k,a), _) -> (\v -> IntMap.updateMin (const v) m) <$> f k a +#endif + Nothing -> pure m + {-# INLINE traverseMin #-} + +instance Ord k => TraverseMin k (Map k) where + traverseMin = index $ \f m -> case Map.minViewWithKey m of + Just ((k, a), _) -> (\v -> Map.updateMin (const (Just v)) m) <$> f k a + Nothing -> pure m + {-# INLINE traverseMin #-} + +-- | Allows 'IndexedTraversal' of the value at the largest index. +class Ord k => TraverseMax k m | m -> k where + -- | 'IndexedTraversal' of the element at the largest index. + traverseMax :: SimpleIndexedTraversal k (m v) v + +instance TraverseMax Int IntMap where + traverseMax = index $ \f m -> case IntMap.maxViewWithKey m of +#if MIN_VERSION_containers(0,5,0) + Just ((k,a), _) -> (\v -> IntMap.updateMax (const (Just v)) m) <$> f k a +#else + Just ((k,a), _) -> (\v -> IntMap.updateMax (const v) m) <$> f k a +#endif + Nothing -> pure m + {-# INLINE traverseMax #-} + +instance Ord k => TraverseMax k (Map k) where + traverseMax = index $ \f m -> case Map.maxViewWithKey m of + Just ((k, a), _) -> (\v -> Map.updateMax (const (Just v)) m) <$> f k a + Nothing -> pure m + {-# INLINE traverseMax #-} ------------------------------------------------------------------------------ -- Reifying Indexed Traversals 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 @@ -401,7 +401,7 @@ -- @No instance of ('Control.Lens.Setter.Settable' 'Accessor')@ -- -- when the user attempts to misuse a 'Control.Lens.Setter.Setter' as a --- 'Getter', rather than a monolithic unification error. +-- 'Control.Lens.Getter.Getter', rather than a monolithic unification error. newtype Accessor r a = Accessor { runAccessor :: r } instance Functor (Accessor r) where @@ -455,7 +455,7 @@ class Applicative f => Settable f where untainted :: f a -> a --- | so you can pass our a 'Setter' into combinators from other lens libraries +-- | so you can pass our a 'Control.Lens.Setter.Setter' into combinators from other lens libraries instance Settable Identity where untainted = runIdentity {-# INLINE untainted #-} @@ -485,41 +485,4 @@ instance Applicative Mutator where pure = Mutator Mutator f <*> Mutator a = Mutator (f a) - -{- -data Bazaar c d a - = Buy a - | Trade (Bazaar c d (d -> a)) c - -instance Functor (Bazaar c d) where - fmap f (Buy a) = Buy (f a) - fmap f (Trade k b) = Trade (fmap (f .) k) b - -instance Applicative (Bazaar c d) where - pure = Buy - Buy f <*> m = fmap f m - Trade k c <*> m = Trade (flip <$> k <*> m) c - -instance (c ~ d) => Comonad (Bazaar c d) where - extract (Buy a) = a - extract (Trade z c) = extract z c - duplicate = duplicateBazaar - --- | 'Bazaar' is an indexed 'Comonad'. -duplicateBazaar :: Bazaar c e a -> Bazaar c d (Bazaar d e a) -duplicateBazaar (Buy b) = Buy (Buy b) -duplicateBazaar (Trade z c) = Trade (Trade <$> duplicateBazaar z) c - --- | A trivial 'Bazaar'. -sell :: c -> Bazaar c d d -sell = Trade (Buy id) - -instance (c ~ d) => ComonadApply (Bazaar c d) where - (<@>) = (<*>) - --- | Given an action to run for each matched pair, traverse a bazaar. -bazaar :: Applicative f => (c -> f d) -> Bazaar c d b -> f b -bazaar _ (Buy b) = pure b -bazaar f (Trade k c) = f c <**> bazaar f k --} diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs --- a/src/Control/Lens/Iso.hs +++ b/src/Control/Lens/Iso.hs @@ -15,7 +15,7 @@ Iso , iso , isos - , au + , ala , auf , under -- * Primitive isomorphisms @@ -65,10 +65,10 @@ -- | Build an isomorphism family from two pairs of inverse functions -- -- @ --- 'view' ('isos' ac ca bd db) = ac --- 'view' ('from' ('isos' ac ca bd db)) = ca --- 'set' ('isos' ac ca bd db) cd = db . cd . ac --- 'set' ('from' ('isos' ac ca bd db')) ab = bd . ab . ca +-- 'view' ('isos' ac ca bd db) ≡ ac +-- 'view' ('from' ('isos' ac ca bd db)) ≡ ca +-- 'set' ('isos' ac ca bd db) cd ≡ db '.' cd '.' ac +-- 'set' ('from' ('isos' ac ca bd db')) ab ≡ bd '.' ab '.' ca -- @ -- -- @isos :: (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> 'Iso' a b c d@ @@ -82,10 +82,10 @@ -- -- -- @ --- 'view' ('iso' f g) = f --- 'view' ('from' ('iso' f g)) = g --- 'set' ('isos' f g) h = g . h . f --- 'set' ('from' ('iso' f g')) h = f . h . g +-- 'view' ('iso' f g) ≡ f +-- 'view' ('from' ('iso' f g)) ≡ g +-- 'set' ('isos' f g) h ≡ g '.' h '.' f +-- 'set' ('from' ('iso' f g')) h ≡ f '.' h '.' g -- @ -- -- @iso :: (a -> b) -> (b -> a) -> 'Control.Lens.Type.Simple' 'Iso' a b@ @@ -95,14 +95,12 @@ -- | Based on @ala@ from Conor McBride's work on Epigram. -- --- Mnemonically, /au/ is a French contraction of /à le/. --- -- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable --- >>> au _sum foldMap [1,2,3,4] +-- >>> ala _sum foldMap [1,2,3,4] -- 10 -au :: Simple Iso a b -> ((a -> b) -> c -> b) -> c -> a -au l f e = f (view l) e ^. from l -{-# INLINE au #-} +ala :: Simple Iso a b -> ((a -> b) -> c -> b) -> c -> a +ala l f e = f (view l) e ^. from l +{-# INLINE ala #-} -- | -- Based on @ala'@ from Conor McBride's work on Epigram. @@ -115,7 +113,7 @@ -- | The opposite of working 'over' a Setter is working 'under' an Isomorphism. -- --- @'under' = 'over' . 'from'@ +-- @'under' = 'over' '.' 'from'@ -- -- @'under' :: Iso a b c d -> (a -> b) -> (c -> d)@ under :: Isomorphism (c -> Mutator d) (a -> Mutator b) -> (a -> b) -> c -> d @@ -129,8 +127,8 @@ -- | This isomorphism can be used to wrap or unwrap a value in 'Identity'. -- -- @ --- x^.identity = 'Identity' x --- 'Identity' x '^.' 'from' 'identity' = x +-- x^.identity ≡ 'Identity' x +-- 'Identity' x '^.' 'from' 'identity' ≡ x -- @ identity :: Iso a b (Identity a) (Identity b) identity = isos Identity runIdentity Identity runIdentity @@ -139,8 +137,8 @@ -- | This isomorphism can be used to wrap or unwrap a value in 'Const' -- -- @ --- x '^.' '_const' = 'Const' x --- 'Const' x '^.' 'from' '_const' = x +-- x '^.' '_const' ≡ 'Const' x +-- 'Const' x '^.' 'from' '_const' ≡ x -- @ _const :: Iso a b (Const a c) (Const b d) _const = isos Const getConst Const getConst diff --git a/src/Control/Lens/Isomorphic.hs b/src/Control/Lens/Isomorphic.hs --- a/src/Control/Lens/Isomorphic.hs +++ b/src/Control/Lens/Isomorphic.hs @@ -69,11 +69,11 @@ -- Note to compose an isomorphism and receive an isomorphism in turn you'll need to use -- 'Control.Category.Category' -- --- > from (from l) = l +-- @'from' ('from' l) ≡ l@ -- -- If you imported 'Control.Category..' from @Control.Category@, then: -- --- > from l . from r = from (r . l) +-- @'from' l '.' 'from' r ≡ 'from' (r '.' l)@ from :: Isomorphic k => Isomorphism a b -> k b a from (Isomorphism a b) = isomorphic b a {-# INLINE from #-} diff --git a/src/Control/Lens/Plated.hs b/src/Control/Lens/Plated.hs --- a/src/Control/Lens/Plated.hs +++ b/src/Control/Lens/Plated.hs @@ -163,7 +163,7 @@ -- use the @...OnOf@ variant with 'ignored', though those usecases are much better served -- in most cases by using the existing lens combinators! e.g. -- --- @'toListOf' 'biplate' = 'universeOnOf' 'biplate' 'ignored'@. +-- @'toListOf' 'biplate' ≡ 'universeOnOf' 'biplate' 'ignored'@. -- -- This same ability to explicitly pass the 'Traversal' in question is why there is no -- analogue to uniplate's @Biplate@. @@ -192,17 +192,17 @@ -- | Extract the immediate descendants of a 'Plated' container. -- --- @'children' = 'toListOf' 'plate'@ +-- @'children' ≡ 'toListOf' 'plate'@ children :: Plated a => a -> [a] children = toListOf plate {-# INLINE children #-} -- | Provided for compatibility with @uniplate@. -- --- @'childrenOn' = 'toListOf'@ +-- @'childrenOn' ≡ 'toListOf'@ -- --- @'childrenOn' :: 'Fold' a b -> a -> [b]@ -childrenOn :: Getting [b] a b -> a -> [b] +-- @'childrenOn' :: 'Fold' a c -> a -> [c]@ +childrenOn :: Getting [c] a b c d -> a -> [c] childrenOn = toListOf {-# INLINE childrenOn #-} @@ -303,21 +303,21 @@ -- | Given a fold that knows how to locate immediate children, retrieve all of the transitive descendants of a node, including itself. -- -- @'universeOf' :: 'Fold' a a -> a -> [a]@ -universeOf :: Getting [a] a a -> a -> [a] +universeOf :: Getting [a] a b a b -> a -> [a] universeOf l = go where go a = a : foldMapOf l go a {-# INLINE universeOf #-} -- | Given a 'Fold' that knows how to find 'Plated' parts of a container retrieve them and all of their descendants, recursively. -universeOn :: Plated b => Getting [b] a b -> a -> [b] +universeOn :: Plated c => Getting [c] a b c c -> a -> [c] universeOn b = universeOnOf b plate {-# INLINE universeOn #-} -- | Given a 'Fold' that knows how to locate immediate children, retrieve all of the transitive descendants of a node, including itself that lie -- in a region indicated by another 'Fold'. -- --- @'toListOf' l = 'universeOnOf' l 'ignored'@ -universeOnOf :: Getting [b] a b -> Getting [b] b b -> a -> [b] +-- @'toListOf' l ≡ 'universeOnOf' l 'ignored'@ +universeOnOf :: Getting [c] a b c d -> Getting [c] c d c d -> a -> [c] universeOnOf b = foldMapOf b . universeOf {-# INLINE universeOnOf #-} @@ -404,7 +404,7 @@ -- | Recurse one level into a structure. (a.k.a @composOp@ from Björn Bringert's @compos@) -- --- @'descend' = 'over' 'plate'@ +-- @'descend' ≡ 'over' 'plate'@ descend :: Plated a => (a -> a) -> a -> a descend = over plate {-# INLINE descend #-} @@ -412,7 +412,7 @@ -- | Recurse one level into a structure using a user specified recursion scheme. This is 'over', but it is supplied here -- for consistency with the uniplate API. -- --- @'descendOf' = 'over'@ +-- @'descendOf' ≡ 'over'@ -- -- @ -- 'descendOf' :: 'Simple' 'Setter' a b -> (b -> b) -> a -> a @@ -424,7 +424,7 @@ -- | Recurse one level into the parts delimited by one 'Setter', using another. -- --- @'descendOnOf' b l = 'over' (b '.' l)@ +-- @'descendOnOf' b l ≡ 'over' (b '.' l)@ -- -- @ -- 'descendOnOf' :: 'Simple' 'Setter' a b -> 'Simple' 'Setter' b b -> (b -> b) -> a -> a @@ -437,7 +437,7 @@ -- | Recurse one level into the parts of the structure delimited by a 'Setter'. -- --- @'descendOn' b = 'over' (b '.' 'plate')@ +-- @'descendOn' b ≡ 'over' (b '.' 'plate')@ -- -- @'descendOn' :: 'Plated' c => 'Setter' a b -> (b -> b) -> a -> a@ descendOn :: Plated c => Setting a b c c -> (c -> c) -> a -> b @@ -451,7 +451,7 @@ -- | Recurse one level into a structure with an 'Applicative' effect, this is 'plate', but it is supplied -- for consistency with the uniplate API. -- --- @'descendA' = 'plate'@ +-- @'descendA' ≡ 'plate'@ descendA :: (Applicative f, Plated a) => (a -> f a) -> a -> f a descendA = plate {-# INLINE descendA #-} @@ -459,7 +459,7 @@ -- | Recurse one level into a structure using a user specified recursion scheme and 'Applicative' effects. This is 'id', but it is supplied -- for consistency with the uniplate API. -- --- @'descendAOf' = 'id'@ +-- @'descendAOf' ≡ 'id'@ -- -- @'descendAOf' :: 'Applicative' m => 'Simple' 'Traversal' a b => (b -> m b) -> a -> m a@ descendAOf :: Applicative f => LensLike f a b c d -> (c -> f d) -> a -> f b @@ -468,7 +468,7 @@ -- | Recurse one level into the parts delimited by one 'Traversal', using another with 'Applicative' effects. -- --- @'descendAOnOf' = ('.')@ +-- @'descendAOnOf' ≡ ('.')@ -- -- @'descendAOnOf' :: 'Applicative' f => 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> (b -> f b) -> a -> f a@ descendAOnOf :: Applicative g => LensLike g a b c d -> LensLike g c d e f -> (e -> g f) -> a -> g b @@ -477,7 +477,7 @@ -- | Recurse one level into the parts of the structure delimited by a 'Traversal' with 'Applicative' effects. -- --- @'descendAOn' b = b '.' 'plate'@ +-- @'descendAOn' b ≡ b '.' 'plate'@ -- -- @'descendAOn' :: ('Applicative' f, Plated' c) => 'Simple' 'Traversal' a b -> (b -> f b) -> a -> f a@ descendAOn :: (Applicative f, Plated c) => LensLike f a b c c -> (c -> f c) -> a -> f b @@ -486,7 +486,7 @@ -- | -- --- @'descendA_' = traverseOf_' 'plate'@ +-- @'descendA_' ≡ traverseOf_' 'plate'@ descendA_ :: (Applicative f, Plated a) => (a -> f b) -> a -> f () descendA_ = traverseOf_ plate {-# INLINE descendA_ #-} @@ -495,28 +495,28 @@ -- -- This is just 'traverseOf_', but is provided for consistency. -- --- @'descendAOf_' = 'traverseOf_'@ +-- @'descendAOf_' ≡ 'traverseOf_'@ -- -- @'descendAOf_' :: 'Applicative' f => 'Fold' a b => (b -> f b) -> a -> f ()@ -descendAOf_ :: Applicative f => Getting (Traversed f) a b -> (b -> f c) -> a -> f () +descendAOf_ :: Applicative f => Getting (Traversed f) a b c d -> (c -> f e) -> a -> f () descendAOf_ = traverseOf_ {-# INLINE descendAOf_ #-} -- | Recurse one level into the parts delimited by one 'Fold', using another with 'Applicative' effects, without reconstructing the structure behind you. -- --- @'descendAOnOf_' b l = 'traverseOf_' (b '.' l)@ +-- @'descendAOnOf_' b l ≡ 'traverseOf_' (b '.' l)@ -- -- @'descendAOnOf_' :: 'Applicative' f => 'Fold' a b -> 'Fold' b b -> (b -> f c) -> a -> f ()@ -descendAOnOf_ :: Applicative f => Getting (Traversed f) a b -> Getting (Traversed f) b b -> (b -> f c) -> a -> f () +descendAOnOf_ :: Applicative f => Getting (Traversed f) a b c d -> Getting (Traversed f) c d c d -> (c -> f e) -> a -> f () descendAOnOf_ b l = traverseOf_ (b . l) {-# INLINE descendAOnOf_ #-} -- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects. -- --- @'descendAOn_' b = 'traverseOf_' (b '.' 'plate')@ +-- @'descendAOn_' b ≡ 'traverseOf_' (b '.' 'plate')@ -- -- @'descendAOn_' :: ('Applicative' f, 'Plated' b) => 'Simple' 'Traversal' a b -> (b -> f c) -> a -> f ()@ -descendAOn_ :: (Applicative f, Plated b) => Getting (Traversed f) a b -> (b -> f c) -> a -> f () +descendAOn_ :: (Applicative f, Plated c) => Getting (Traversed f) a b c c -> (c -> f e) -> a -> f () descendAOn_ b = traverseOf_ (b . plate) {-# INLINE descendAOn_ #-} @@ -526,7 +526,7 @@ -- | Recurse one level into a structure with a monadic effect. (a.k.a @composOpM@ from Björn Bringert's @compos@) -- --- @'descendM' = 'mapMOf' 'plate'@ +-- @'descendM' ≡ 'mapMOf' 'plate'@ descendM :: (Monad m, Plated a) => (a -> m a) -> a -> m a descendM = mapMOf plate {-# INLINE descendM #-} @@ -534,7 +534,7 @@ -- | Recurse one level into a structure using a user specified recursion scheme and monadic effects. This is 'id', but it is -- supplied for consistency with the uniplate API. -- --- @'descendMOf' = 'mapMOf'@ +-- @'descendMOf' ≡ 'mapMOf'@ -- -- @'descendMOf' :: 'Monad' m => 'Simple' 'Traversal' a b => (b -> m b) -> a -> m a@ descendMOf :: Monad m => LensLike (WrappedMonad m) a b c d -> (c -> m d) -> a -> m b @@ -543,7 +543,7 @@ -- | Recurse one level into the parts delimited by one 'Traversal', using another with monadic effects. -- --- @'descendMOnOf' b l = 'mapMOf' (b '.' l)@ +-- @'descendMOnOf' b l ≡ 'mapMOf' (b '.' l)@ -- -- @'descendMOnOf' :: 'Monad' m => 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> (b -> m b) -> a -> m a@ descendMOnOf :: Monad m => LensLike (WrappedMonad m) a b c c -> SimpleLensLike (WrappedMonad m) c c -> (c -> m c) -> a -> m b @@ -552,7 +552,7 @@ -- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects. -- --- @'descendMOn' b = 'mapMOf' (b . 'plate')@ +-- @'descendMOn' b ≡ 'mapMOf' (b . 'plate')@ -- -- @'descendMOn' :: ('Monad' m, 'Plated' c) => 'Simple' 'Traversal' a b -> (b -> m b) -> a -> m a@ descendMOn :: (Monad m, Plated c) => LensLike (WrappedMonad m) a b c c -> (c -> m c) -> a -> m b @@ -561,35 +561,35 @@ -- | Descend one level into a structure with monadic effects (a.k.a @composOpM@ from Björn Bringert's @compos@) -- --- @'descendM_' = mapMOf_' 'plate'@ +-- @'descendM_' ≡ mapMOf_' 'plate'@ descendM_ :: (Monad m, Plated a) => (a -> m b) -> a -> m () descendM_ = mapMOf_ plate {-# INLINE descendM_ #-} -- | Recurse one level into a structure using a user specified recursion scheme and monadic effects. This is just 'mapMOf_', but is provided for consistency. -- --- @'descendMOf_' = 'mapMOf_'@ +-- @'descendMOf_' ≡ 'mapMOf_'@ -- -- @'descendMOf_' :: 'Monad' m => 'Fold' a b => (b -> m b) -> a -> m ()@ -descendMOf_ :: Monad m => Getting (Sequenced m) a b -> (b -> m c) -> a -> m () +descendMOf_ :: Monad m => Getting (Sequenced m) a b c d -> (c -> m e) -> a -> m () descendMOf_ = mapMOf_ {-# INLINE descendMOf_ #-} -- | Recurse one level into the parts delimited by one 'Traversal', using another with monadic effects. -- --- @'descendMOnOf_' b l = 'mapMOf_' (b '.' l)@ +-- @'descendMOnOf_' b l ≡ 'mapMOf_' (b '.' l)@ -- -- @'descendMOnOf_' :: 'Monad' m => 'Fold' a b -> 'Fold' b b -> (b -> m b) -> a -> m ()@ -descendMOnOf_ :: Monad m => Getting (Sequenced m) a b -> Getting (Sequenced m) b b -> (b -> m c) -> a -> m () +descendMOnOf_ :: Monad m => Getting (Sequenced m) a b c d -> Getting (Sequenced m) c d c d -> (c -> m e) -> a -> m () descendMOnOf_ b l = mapMOf_ (b . l) {-# INLINE descendMOnOf_ #-} -- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects. -- --- @'descendMOn_' b = 'mapMOf_' (b '.' 'plate')@ +-- @'descendMOn_' b ≡ 'mapMOf_' (b '.' 'plate')@ -- -- @'descendMOn_' :: ('Monad' m, 'Plated' b) => 'Simple' 'Traversal' a b -> (b -> m c) -> a -> m ()@ -descendMOn_ :: (Monad m, Plated b) => Getting (Sequenced m) a b -> (b -> m c) -> a -> m () +descendMOn_ :: (Monad m, Plated c) => Getting (Sequenced m) a b c c -> (c -> m e) -> a -> m () descendMOn_ b = mapMOf_ (b . plate) {-# INLINE descendMOn_ #-} @@ -604,7 +604,7 @@ -- propId x = 'all' ('==' x) [extract w | w <- 'contexts' x] -- @ -- --- @'contexts' = 'contextsOf' 'plate'@ +-- @'contexts' ≡ 'contextsOf' 'plate'@ contexts :: Plated a => a -> [Context a a a] contexts = contextsOf plate {-# INLINE contexts #-} @@ -627,7 +627,7 @@ -- | Return a list of all of the editable contexts for every location in the structure in an areas indicated by a user supplied 'Traversal', recursively using 'plate'. -- --- @'contextsOn' b = 'contextsOnOf' b 'plate'@ +-- @'contextsOn' b ≡ 'contextsOnOf' b 'plate'@ -- -- @'contextsOn' :: 'Plated' b => 'Simple' 'Traversal' a b -> a -> ['Context' b b a]@ contextsOn :: Plated c => LensLike (Bazaar c c) a b c c -> a -> [Context c c b] @@ -684,7 +684,7 @@ -- | An alias for 'holesOf', provided for consistency with the other combinators. -- --- @'holesOn' = 'holesOf'@ +-- @'holesOn' ≡ 'holesOf'@ -- -- @ -- 'holesOn' :: 'Simple' 'Iso' a b -> a -> ['Context' b b a] @@ -697,7 +697,7 @@ -- | Extract one level of holes from a container in a region specified by one 'Traversal', using another. -- --- @'holesOnOf' b l = 'holesOf' (b '.' l)@ +-- @'holesOnOf' b l ≡ 'holesOf' (b '.' l)@ -- -- @ -- 'holesOnOf' :: 'Simple' 'Iso' a b -> 'Simple' 'Iso' b b -> a -> ['Context' b a] @@ -715,14 +715,14 @@ -- | Perform a fold-like computation on each value, technically a paramorphism. -- -- @'paraOf' :: 'Fold' a a -> (a -> [r] -> r) -> a -> r@ -paraOf :: Getting [a] a a -> (a -> [r] -> r) -> a -> r +paraOf :: Getting [a] a b a b -> (a -> [r] -> r) -> a -> r paraOf l f = go where go a = f a (go <$> toListOf l a) {-# INLINE paraOf #-} -- | Perform a fold-like computation on each value, technically a paramorphism. -- --- @'para' = 'paraOf' 'plate'@ +-- @'para' ≡ 'paraOf' 'plate'@ para :: Plated a => (a -> [r] -> r) -> a -> r para = paraOf plate {-# INLINE para #-} @@ -739,11 +739,11 @@ -- to avoid having even more redundant names for the same operators. For comparison: -- -- @ --- 'composOpMonoid' = 'foldMapOf' 'plate' --- 'composOpMPlus' f = 'msumOf' ('plate' '.' 'to' f) --- 'composOp' = 'descend' = 'over' 'plate' --- 'composOpM' = 'descendM' = 'mapMOf' 'plate' --- 'composOpM_' = 'descendM_' = 'mapMOf_' 'plate' +-- 'composOpMonoid' ≡ 'foldMapOf' 'plate' +-- 'composOpMPlus' f ≡ 'msumOf' ('plate' '.' 'to' f) +-- 'composOp' ≡ 'descend' ≡ 'over' 'plate' +-- 'composOpM' ≡ 'descendM' ≡ 'mapMOf' 'plate' +-- 'composOpM_' ≡ 'descendM_' ≡ 'mapMOf_' 'plate' -- @ -- | Fold the immediate children of a 'Plated' container. @@ -759,7 +759,7 @@ -- | The original @uniplate@ combinator, implemented in terms of 'Plated' as a 'Lens'. -- --- @'parts' = 'partsOf' 'plate'@ +-- @'parts' ≡ 'partsOf' 'plate'@ -- -- The resulting lens is safer to use as it ignores 'over-application' and deals gracefully with under-application, -- but it is only a proper lens if you don't change the list 'length'! @@ -776,9 +776,9 @@ -- So technically, this is only a lens if you do not change the number of results it returns. -- -- @ --- 'partsOf' :: 'Simple' 'Control.Lens.Iso.Iso' a b -> a -> 'Simple' 'Lens' a [b] --- 'partsOf' :: 'Simple' 'Lens' a b -> a -> 'Simple' 'Lens' a [b] --- 'partsOf' :: 'Simple' 'Traversal' a b -> a -> 'Simple' 'Traversal' a [b] +-- 'partsOf' :: 'Simple' 'Control.Lens.Iso.Iso' a b -> 'Simple' 'Lens' a [b] +-- 'partsOf' :: 'Simple' 'Lens' a b -> 'Simple' 'Lens' a [b] +-- 'partsOf' :: 'Simple' 'Traversal' a b -> 'Simple' 'Lens' a [b] -- @ partsOf :: LensLike (Bazaar c c) a b c c -> Lens a b [c] [c] partsOf l f a = outs b <$> f (ins b) where b = l sell a @@ -795,11 +795,14 @@ -- This is unsafe because if you don't supply at least as many @d@'s as you were -- given @c@'s, then the reconstruction of @b@ /will/ result in an error! -- +-- @ +-- 'unsafePartsOf' :: 'Control.Lens.Iso.Iso' a b c d -> 'Lens' a b [c] [d] +-- 'unsafePartsOf' :: 'Lens' a b c d -> 'Lens' a b [c] [d] +-- 'unsafePartsOf' :: 'Traversal' a b c d -> 'Lens' a b [c] [d] +-- @ unsafePartsOf :: LensLike (Bazaar c d) a b c d -> Lens a b [c] [d] unsafePartsOf l f a = unsafeOuts b <$> f (ins b) where b = l sell a {-# INLINE unsafePartsOf #-} - - ------------------------------------------------------------------------------- -- Misc. diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs --- a/src/Control/Lens/Setter.hs +++ b/src/Control/Lens/Setter.hs @@ -12,11 +12,11 @@ -- A @'Setter' a b c d@ is a generalization of 'fmap' from 'Functor'. It allows you to map into a -- structure and change out the contents, but it isn't strong enough to allow you to -- enumerate those contents. Starting with @fmap :: 'Functor' f => (c -> d) -> f c -> f d@ --- we monomorphize the type to obtain @(c -> d) -> a -> b@ and then decorate it with 'Identity' to obtain +-- we monomorphize the type to obtain @(c -> d) -> a -> b@ and then decorate it with 'Data.Functor.Identity.Identity' to obtain -- --- @type 'Setter' a b c d = (c -> 'Identity' d) -> a -> 'Identity' b@ +-- @type 'Setter' a b c d = (c -> 'Data.Functor.Identity.Identity' d) -> a -> 'Data.Functor.Identity.Identity' b@ -- --- Every 'Control.Lens.Traversal.Traversal' is a valid 'Setter', since 'Identity' is 'Applicative'. +-- Every 'Control.Lens.Traversal.Traversal' is a valid 'Setter', since 'Data.Functor.Identity.Identity' is 'Applicative'. -- -- Everything you can do with a 'Functor', you can do with a 'Setter'. There -- are combinators that generalize 'fmap' and ('<$'). @@ -52,7 +52,7 @@ import Control.Applicative import Control.Lens.Internal -import Control.Monad.State.Class as State +import Control.Monad.State.Class as State infixr 4 .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, ||~, %~, <.~ infix 4 .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, ||=, %=, <.= @@ -65,22 +65,22 @@ -- | -- The only 'Control.Lens.Type.Lens'-like law that can apply to a 'Setter' @l@ is that -- --- @'set' l c ('set' l b a) = 'set' l c a@ +-- @'set' l c ('set' l b a) ≡ 'set' l c a@ -- -- You can't 'view' a 'Setter' in general, so the other two laws are irrelevant. -- -- However, two 'Functor' laws apply to a 'Setter': -- -- @ --- 'over' l 'id' = 'id' --- 'over' l f . 'over' l g = 'over' l (f . g) +-- 'over' l 'id' ≡ 'id' +-- 'over' l f '.' 'over' l g ≡ 'over' l (f '.' g) -- @ -- -- These an be stated more directly: -- -- @ --- l 'pure' = 'pure' --- l f . 'untainted' . l g = l (f . 'untainted' . g) +-- l 'pure' ≡ 'pure' +-- l f . 'untainted' . l g ≡ l (f . 'untainted' . g) -- @ -- -- You can compose a 'Setter' with a 'Control.Lens.Type.Lens' or a 'Control.Lens.Traversal.Traversal' using ('.') from the Prelude @@ -93,14 +93,14 @@ -- When consuming a setter directly to perform a mapping, you can use this type, but most -- user code will not need to use this type. -- --- By choosing 'Mutator' rather than 'Identity', we get nicer error messages. +-- By choosing 'Mutator' rather than 'Data.Functor.Identity.Identity', we get nicer error messages. type Setting a b c d = (c -> Mutator d) -> a -> Mutator b -- | -- -- A Simple Setter is just a 'Setter' that doesn't change the types. -- --- These are particularly common when talking about monomorphic containers. e.g. +-- These are particularly common when talking about monomorphic containers. /e.g./ -- -- @'sets' Data.Text.map :: 'SimpleSetter' 'Data.Text.Internal.Text' 'Char'@ -- @@ -122,10 +122,23 @@ -- | This setter can be used to map over all of the values in a 'Functor'. -- -- @ --- 'fmap' = 'over' 'mapped' --- 'Data.Traversable.fmapDefault' = 'over' 'Data.Traversable.traverse' --- ('<$') = 'set' 'mapped' +-- 'fmap' ≡ 'over' 'mapped' +-- 'Data.Traversable.fmapDefault' ≡ 'over' 'Data.Traversable.traverse' +-- ('<$') ≡ 'set' 'mapped' -- @ +-- +-- >>> import Control.Lens +-- >>> over mapped (+1) [1,2,3] +-- [2,3,4] +-- +-- >>> set mapped () [1,2,3] +-- [(),(),()] +-- +-- >>> mapped.mapped %~ (+1) $ [[1,2],[3]] +-- [[2,3],[4]] +-- +-- >>> over (mapped._2) length [("hello","world"),("leaders","!!!")] +-- [("hello",5),("leaders",3)] mapped :: Functor f => Setter (f a) (f b) a b mapped = sets fmap {-# INLINE mapped #-} @@ -135,15 +148,15 @@ -- Your supplied function @f@ is required to satisfy: -- -- @ --- f 'id' = 'id' --- f g '.' f h = f (g '.' h) +-- f 'id' ≡ 'id' +-- f g '.' f h ≡ f (g '.' h) -- @ -- -- Equational reasoning: -- -- @ --- 'sets' . 'over' = 'id' --- 'over' . 'sets' = 'id' +-- 'sets' '.' 'over' ≡ 'id' +-- 'over' '.' 'sets' ≡ 'id' -- @ -- -- Another way to view 'sets' is that it takes a \"semantic editor combinator\" @@ -160,12 +173,19 @@ -- with a function. -- -- @ --- 'fmap' = 'over' 'mapped' --- 'Data.Traversable.fmapDefault' = 'over' 'Data.Traversable.traverse' --- 'sets' . 'over' = 'id' --- 'over' . 'sets' = 'id' +-- 'fmap' ≡ 'over' 'mapped' +-- 'Data.Traversable.fmapDefault' ≡ 'over' 'Data.Traversable.traverse' +-- 'sets' '.' 'over' ≡ 'id' +-- 'over' '.' 'sets' ≡ 'id' -- @ -- +-- >>> import Control.Lens +-- >>> over mapped (*10) [1,2,3] +-- [10,20,30] +-- +-- >>> over _1 show (10,20) +-- ("10",20) +-- -- Another way to view 'over' is to say that it transformers a 'Setter' into a -- \"semantic editor combinator\". -- @@ -178,13 +198,23 @@ -- with a function. This is an alias for 'over' that is provided for consistency. -- -- @ --- 'mapOf' = 'over' --- 'fmap' = 'mapOf' 'mapped' --- 'fmapDefault' = 'mapOf' 'traverse' --- 'sets' . 'mapOf' = 'id' --- 'mapOf' . 'sets' = 'id' +-- 'mapOf' ≡ 'over' +-- 'fmap' ≡ 'mapOf' 'mapped' +-- 'fmapDefault' ≡ 'mapOf' 'traverse' +-- 'sets' '.' 'mapOf' ≡ 'id' +-- 'mapOf' '.' 'sets' ≡ 'id' -- @ -- +-- >>> import Control.Lens +-- >>> mapOf mapped (+1) [1,2,3,4] +-- [2,3,4,5] +-- +-- >>> mapOf _1 (+1) (1,2) +-- (2,2) +-- +-- >>> mapOf both (+1) (1,2) +-- (2,3) +-- -- @ -- 'mapOf' :: 'Setter' a b c d -> (c -> d) -> a -> b -- 'mapOf' :: 'Control.Lens.Iso.Iso' a b c d -> (c -> d) -> a -> b @@ -198,7 +228,7 @@ -- | Replace the target of a 'Control.Lens.Type.Lens' or all of the targets of a 'Setter' -- or 'Control.Lens.Traversal.Traversal' with a constant value. -- --- @('<$') = 'set' 'mapped'@ +-- @('<$') ≡ 'set' 'mapped'@ -- -- >>> import Control.Lens -- >>> set _2 "hello" (1,()) @@ -226,14 +256,23 @@ -- This is an infix version of 'over' -- -- @ --- 'fmap' f = 'mapped' '%~' f --- 'Data.Traversable.fmapDefault' f = 'traverse' '%~' f +-- 'fmap' f ≡ 'mapped' '%~' f +-- 'Data.Traversable.fmapDefault' f ≡ 'traverse' '%~' f -- @ -- -- >>> import Control.Lens -- >>> _2 %~ length $ (1,"hello") -- (1,5) -- +-- >>> traverse %~ (+1) $ [1,2,3] +-- [2,3,4] +-- +-- >>> _2 %~ (+1) $ (3,4) +-- (3,5) +-- +-- >>> traverse.traverse %~ length $ [["hello","world"],["!!!"]] +-- [[5,5],[3]] +-- -- @ -- ('%~') :: 'Setter' a b c d -> (c -> d) -> a -> b -- ('%~') :: 'Control.Lens.Iso.Iso' a b c d -> (c -> d) -> a -> b @@ -249,7 +288,7 @@ -- -- This is an infix version of 'set', provided for consistency with ('.=') -- --- @f '<$' a = 'mapped' '.~' f '$' a@ +-- @f '<$' a ≡ 'mapped' '.~' f '$' a@ -- -- >>> import Control.Lens -- >>> _1 .~ "hello" $ (42,"world") @@ -271,6 +310,14 @@ -- -- If you do not need a copy of the intermediate result, then using @l '.~' d@ directly is a good idea. -- +-- >>> import Control.Lens +-- >>> _3 <.~ "world" $ ("good","morning","vietnam") +-- ("world",("good","morning","world")) +-- +-- >>> import Data.Map as Map +-- >>> _2.at "hello" <.~ Just "world" $ (42,Map.fromList [("goodnight","gracie")]) +-- (Just "world",(42,fromList [("goodnight","gracie"),("hello","world")])) +-- -- @ -- ('<.~') :: 'Setter' a b c d -> d -> a -> (d, b) -- ('<.~') :: 'Control.Lens.Iso.Iso' a b c d -> d -> a -> (d, b) @@ -287,11 +334,14 @@ -- >>> _1 +~ 1 $ (1,2) -- (2,2) -- +-- >>> both +~ 2 $ (5,6) +-- (7,8) +-- -- @ --- ('+~') :: Num c => 'Setter' a b c c -> c -> a -> b --- ('+~') :: Num c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b --- ('+~') :: Num c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b --- ('+~') :: Num c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b +-- ('+~') :: Num b => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> a -> a +-- ('+~') :: Num b => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> a +-- ('+~') :: Num b => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> a -> a +-- ('+~') :: Num b => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> a -> a -- @ (+~) :: Num c => Setting a b c c -> c -> a -> b l +~ n = over l (+ n) @@ -303,11 +353,14 @@ -- >>> _2 *~ 4 $ (1,2) -- (1,8) -- +-- >>> mapped *~ 2 $ Just 24 +-- Just 48 +-- -- @ --- ('*~') :: 'Num' c => 'Setter' a b c c -> c -> a -> b --- ('*~') :: 'Num' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b --- ('*~') :: 'Num' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b --- ('*~') :: 'Num' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b +-- ('*~') :: 'Num' b => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> a -> a +-- ('*~') :: 'Num' b => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> a +-- ('*~') :: 'Num' b => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> a -> a +-- ('*~') :: 'Num' b => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> a -> a -- @ (*~) :: Num c => Setting a b c c -> c -> a -> b l *~ n = over l (* n) @@ -319,11 +372,14 @@ -- >>> _1 -~ 2 $ (1,2) -- (-1,2) -- +-- >>> mapped.mapped -~ 1 $ [[4,5],[6,7]] +-- [[3,4],[5,6]] +-- -- @ --- (-~) :: 'Num' c => 'Setter' a b c c -> c -> a -> b --- (-~) :: 'Num' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b --- (-~) :: 'Num' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b --- (-~) :: 'Num' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b +-- ('-~') :: 'Num' b => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> a -> a +-- ('-~') :: 'Num' b => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> a +-- ('-~') :: 'Num' b => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> a -> a +-- ('-~') :: 'Num' b => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> a -> a -- @ (-~) :: Num c => Setting a b c c -> c -> a -> b l -~ n = over l (subtract n) @@ -331,11 +387,15 @@ -- | Divide the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' -- +-- >>> import Control.Lens +-- >>> _2 //~ 2 $ ("Hawaii",10) +-- ("Hawaii",5.0) +-- -- @ --- ('\/\/~') :: 'Fractional' c => 'Setter' a b c c -> c -> a -> b --- ('\/\/~') :: 'Fractional' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b --- ('\/\/~') :: 'Fractional' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b --- ('\/\/~') :: 'Fractional' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b +-- ('//~') :: 'Fractional' b => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> a -> a +-- ('//~') :: 'Fractional' b => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> a +-- ('//~') :: 'Fractional' b => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> a -> a +-- ('//~') :: 'Fractional' b => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> a -> a -- @ (//~) :: Fractional c => Setting a b c c -> c -> a -> b l //~ n = over l (/ n) @@ -345,6 +405,13 @@ -- >>> import Control.Lens -- >>> _2 ^~ 2 $ (1,3) -- (1,9) +-- +-- @ +-- ('^~') :: ('Num' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Setter' a b -> c -> a -> a +-- ('^~') :: ('Num' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> c -> a -> a +-- ('^~') :: ('Num' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> c -> a -> a +-- ('^~') :: ('Num' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> c -> a -> a +-- @ (^~) :: (Num c, Integral e) => Setting a b c c -> e -> a -> b l ^~ n = over l (^ n) {-# INLINE (^~) #-} @@ -356,10 +423,10 @@ -- (1,0.5) -- -- @ --- ('^^~') :: ('Fractional' c, 'Integral' e) => 'Setter' a b c c -> e -> a -> b --- ('^^~') :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Iso.Iso' a b c c -> e -> a -> b --- ('^^~') :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Type.Lens' a b c c -> e -> a -> b --- ('^^~') :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Traversal.Traversal' a b c c -> e -> a -> b +-- ('^^~') :: ('Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Setter' a b -> c -> a -> a +-- ('^^~') :: ('Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> c -> a -> a +-- ('^^~') :: ('Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> c -> a -> a +-- ('^^~') :: ('Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> c -> a -> a -- @ -- (^^~) :: (Fractional c, Integral e) => Setting a b c c -> e -> a -> b @@ -373,10 +440,10 @@ -- (1,31.54428070019754) -- -- @ --- ('**~') :: 'Floating' c => 'Setter' a b c c -> c -> a -> b --- ('**~') :: 'Floating' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b --- ('**~') :: 'Floating' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b --- ('**~') :: 'Floating' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b +-- ('**~') :: 'Floating' b => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> a -> a +-- ('**~') :: 'Floating' b => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> a +-- ('**~') :: 'Floating' b => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> a -> a +-- ('**~') :: 'Floating' b => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> a -> a -- @ (**~) :: Floating c => Setting a b c c -> c -> a -> b l **~ n = over l (** n) @@ -384,8 +451,7 @@ -- | Logically '||' the target(s) of a 'Bool'-valued 'Control.Lens.Type.Lens' or 'Setter' -- --- >>> :m + Control.Lens --- +-- >>> import Control.Lens -- >>> both ||~ True $ (False,True) -- (True,True) -- @@ -393,10 +459,10 @@ -- (False,True) -- -- @ --- ('||~') :: 'Setter' a b 'Bool' 'Bool' -> 'Bool' -> a -> b --- ('||~') :: 'Control.Lens.Iso.Iso' a b 'Bool' 'Bool' -> 'Bool' -> a -> b --- ('||~') :: 'Control.Lens.Type.Lens' a b 'Bool' 'Bool' -> 'Bool' -> a -> b --- ('||~') :: 'Control.Lens.Traversal.Traversal' a b 'Bool' 'Bool' -> 'Bool' -> a -> b +-- ('||~') :: 'Control.Lens.Type.Simple' 'Setter' a 'Bool' -> 'Bool' -> a -> a +-- ('||~') :: 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a 'Bool' -> 'Bool' -> a -> a +-- ('||~') :: 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a 'Bool' -> 'Bool' -> a -> a +-- ('||~') :: 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a 'Bool' -> 'Bool' -> a -> a -- @ (||~):: Setting a b Bool Bool -> Bool -> a -> b l ||~ n = over l (|| n) @@ -404,8 +470,7 @@ -- | Logically '&&' the target(s) of a 'Bool'-valued 'Control.Lens.Type.Lens' or 'Setter' -- --- >>> :m + Control.Lens --- +-- >>> import Control.Lens -- >>> both &&~ True $ (False, True) -- (False,True) -- @@ -413,10 +478,10 @@ -- (False,False) -- -- @ --- ('&&~') :: 'Setter' a b 'Bool' 'Bool' -> 'Bool' -> a -> b --- ('&&~') :: 'Control.Lens.Iso.Iso' a b 'Bool' 'Bool' -> 'Bool' -> a -> b --- ('&&~') :: 'Control.Lens.Type.Lens' a b 'Bool' 'Bool' -> 'Bool' -> a -> b --- ('&&~') :: 'Control.Lens.Traversal.Traversal' a b 'Bool' 'Bool' -> 'Bool' -> a -> b +-- ('&&~') :: 'Control.Lens.Type.Simple' 'Setter' a 'Bool' -> 'Bool' -> a -> a +-- ('&&~') :: 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a 'Bool' -> 'Bool' -> a -> a +-- ('&&~') :: 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a 'Bool' -> 'Bool' -> a -> a +-- ('&&~') :: 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a 'Bool' -> 'Bool' -> a -> a -- @ (&&~) :: Setting a b Bool Bool -> Bool -> a -> b l &&~ n = over l (&& n) @@ -432,10 +497,10 @@ -- This is an alias for ('.='). -- -- @ --- 'assign' :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> d -> m () --- 'assign' :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> d -> m () --- 'assign' :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> d -> m () --- 'assign' :: 'MonadState' a m => 'Setter' a a c d -> d -> m () +-- 'assign' :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m () +-- 'assign' :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m () +-- 'assign' :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m () +-- 'assign' :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m () -- @ assign :: MonadState a m => Setting a a c d -> d -> m () assign l b = State.modify (set l b) @@ -447,10 +512,10 @@ -- This is an infix version of 'assign'. -- -- @ --- ('.=') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> d -> m () --- ('.=') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> d -> m () --- ('.=') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> d -> m () --- ('.=') :: 'MonadState' a m => 'Setter' a a c d -> d -> m () +-- ('.=') :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m () +-- ('.=') :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m () +-- ('.=') :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m () +-- ('.=') :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m () -- @ -- -- "It puts the state in the monad or it gets the hose again." @@ -461,10 +526,10 @@ -- | Map over the target of a 'Control.Lens.Type.Lens' or all of the targets of a 'Setter' or 'Control.Lens.Traversal.Traversal' in our monadic state. -- -- @ --- ('%=') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> (c -> d) -> m () --- ('%=') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> (c -> d) -> m () --- ('%=') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> (c -> d) -> m () --- ('%=') :: 'MonadState' a m => 'Setter' a a c d -> (c -> d) -> m () +-- ('%=') :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> (b -> b) -> m () +-- ('%=') :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> (b -> b) -> m () +-- ('%=') :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> (b -> b) -> m () +-- ('%=') :: 'MonadState' a m => 'Control.Lens.Type.Simple' 'Setter' a b -> (b -> b) -> m () -- @ (%=) :: MonadState a m => Setting a a c d -> (c -> d) -> m () l %= f = State.modify (l %~ f) @@ -505,8 +570,6 @@ -- | Modify the target(s) of a 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' by multiplying by value. -- --- @ballSpeed '.' 'Control.Lens.Traversal.both' '*=' speedMultiplier@ --- -- @ -- ('*=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m () -- ('*=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m () @@ -592,22 +655,26 @@ -- | Run a monadic action, and set all of the targets of a 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to its result. -- -- @ --- ('\<~') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> m d -> m () --- ('\<~') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> m d -> m () --- ('\<~') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> m d -> m () --- ('\<~') :: 'MonadState' a m => 'Setter' a a c d -> m d -> m () +-- ('<~') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> m d -> m () +-- ('<~') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> m d -> m () +-- ('<~') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> m d -> m () +-- ('<~') :: 'MonadState' a m => 'Setter' a a c d -> m d -> m () -- @ -- -- As a reasonable mnemonic, this lets you store the result of a monadic action in a lens rather than -- in a local variable. -- --- > do foo <- bar --- > ... +-- @ +-- do foo <- bar +-- ... +-- @ -- -- will store the result in a variable, while -- --- > do foo <~ bar --- > ... +-- @ +-- do foo '<~' bar +-- ... +-- @ -- -- will store the result in a 'Control.Lens.Type.Lens', 'Setter', or 'Control.Lens.Traversal.Traversal'. (<~) :: MonadState a m => Setting a a c d -> m d -> m () @@ -623,10 +690,10 @@ -- If you do not need a copy of the intermediate result, then using @l .= d@ will avoid unused binding warnings -- -- @ --- ('\<.=') :: 'MonadState' a m => 'Setter' a a c d -> d -> m d --- ('\<.=') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> d -> m d --- ('\<.=') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> d -> m d --- ('\<.=') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> d -> m d +-- ('<.=') :: 'MonadState' a m => 'Setter' a a c d -> d -> m d +-- ('<.=') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> d -> m d +-- ('<.=') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> d -> m d +-- ('<.=') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> d -> m d -- @ (<.=) :: MonadState a m => Setting a a c d -> d -> m d l <.= d = do diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs --- a/src/Control/Lens/TH.hs +++ b/src/Control/Lens/TH.hs @@ -36,7 +36,7 @@ , lensClass , lensFlags , LensFlag(..) - , simpleLenses, partialLenses, handleSingletons, singletonIso, singletonRequired, createClass, createInstance, classRequired, singletonAndField + , simpleLenses, partialLenses, buildTraversals, handleSingletons, singletonIso, singletonRequired, createClass, createInstance, classRequired, singletonAndField ) where import Control.Applicative @@ -48,6 +48,7 @@ import Control.Lens.Traversal import Control.Lens.Type import Control.Lens.IndexedLens +import Control.Lens.Combinators import Control.Monad import Data.Char (toLower) import Data.Either (lefts) @@ -123,7 +124,6 @@ classRequired :: Simple Lens LensRules Bool classRequired = lensFlags.contains ClassRequired - -- | This configuration describes the options we'll be using to make isomorphisms or lenses. data LensRules = LensRules { _lensIso :: String -> Maybe String @@ -168,24 +168,22 @@ -- | Rules for making fairly simple partial lenses, ignoring the special cases -- for isomorphisms and traversals, and not making any classes. lensRules :: LensRules -lensRules - = lensIso .~ const Nothing - $ lensClass .~ const Nothing - $ handleSingletons .~ True - $ partialLenses .~ False - $ buildTraversals .~ True - $ defaultRules +lensRules = defaultRules + |> lensIso .~ const Nothing + |> lensClass .~ const Nothing + |> handleSingletons .~ True + |> partialLenses .~ False + |> buildTraversals .~ True -- | Rules for making lenses and traversals that precompose another lens. classyRules :: LensRules -classyRules - = lensIso .~ const Nothing - $ handleSingletons .~ False - $ lensClass .~ classy - $ classRequired .~ True - $ partialLenses .~ False - $ buildTraversals .~ True - $ defaultRules +classyRules = defaultRules + |> lensIso .~ const Nothing + |> handleSingletons .~ False + |> lensClass .~ classy + |> classRequired .~ True + |> partialLenses .~ False + |> buildTraversals .~ True where classy :: String -> Maybe (String, String) classy n@(a:as) = Just ("Has" ++ n, toLower a:as) @@ -193,10 +191,9 @@ -- | Rules for making an isomorphism from a data type isoRules :: LensRules -isoRules - = singletonRequired .~ True - $ singletonAndField .~ True - $ defaultRules +isoRules = defaultRules + |> singletonRequired .~ True + |> singletonAndField .~ True -- | Build lenses (and traversals) with a sensible default configuration. -- @@ -256,9 +253,7 @@ -- > makeLensesFor [("_foo", "fooLens"), ("baz", "lbaz")] ''Foo -- > makeLensesFor [("_barX", "bar"), ("_barY", "bar)] ''Bar makeLensesFor :: [(String, String)] -> Name -> Q [Dec] -makeLensesFor fields = makeLensesWith - $ lensField .~ (`Prelude.lookup` fields) - $ lensRules +makeLensesFor fields = makeLensesWith $ lensRules |> lensField .~ (`Prelude.lookup` fields) -- | Derive lenses and traversals, using a named wrapper class, and specifying -- explicit pairings of @(fieldName, traversalName)@. @@ -267,10 +262,9 @@ -- -- > makeClassyFor "HasFoo" "foo" [("_foo", "fooLens"), ("bar", "lbar")] ''Foo makeClassyFor :: String -> String -> [(String, String)] -> Name -> Q [Dec] -makeClassyFor clsName funName fields = makeLensesWith - $ lensClass .~ const (Just (clsName,funName)) - $ lensField .~ (`Prelude.lookup` fields) - $ classyRules +makeClassyFor clsName funName fields = makeLensesWith $ classyRules + |> lensClass .~ const (Just (clsName,funName)) + |> lensField .~ (`Prelude.lookup` fields) -- | Build lenses with a custom configuration. makeLensesWith :: LensRules -> Name -> Q [Dec] @@ -280,19 +274,11 @@ (TyConI decl) -> case deNewtype decl of (DataD ctx tyConName args cons _) -> case cons of [NormalC dataConName [( _,ty)]] - | cfg^.handleSingletons - -> makeIsoLenses cfg ctx tyConName args dataConName Nothing ty - + | cfg^.handleSingletons -> makeIsoLenses cfg ctx tyConName args dataConName Nothing ty [RecC dataConName [(fld,_,ty)]] - | cfg^.handleSingletons - -> makeIsoLenses cfg ctx tyConName args dataConName (Just fld) ty - - _ | cfg^.singletonRequired - -> fail "makeLensesWith: A single-constructor single-argument data type is required" - - | otherwise - -> makeFieldLenses cfg ctx tyConName args cons - + | cfg^.handleSingletons -> makeIsoLenses cfg ctx tyConName args dataConName (Just fld) ty + _ | cfg^.singletonRequired -> fail "makeLensesWith: A single-constructor single-argument data type is required" + | otherwise -> makeFieldLenses cfg ctx tyConName args cons _ -> fail "makeLensesWith: Unsupported data type" _ -> fail "makeLensesWith: Expected the name of a data type or newtype" where @@ -308,18 +294,25 @@ freshMap ns = Map.fromList <$> for (toList ns) (\ n -> (,) n <$> newName (nameBase n)) makeIsoTo :: Name -> ExpQ -makeIsoTo conName = lamE [varP (mkName "f"), conP conName [varP (mkName "a")]] $ - appsE [ return (VarE 'fmap) - , conE conName - , varE (mkName "f") `appE` varE (mkName "a") - ] +makeIsoTo conName = do + f <- newName "f" + a <- newName "a" + lamE [varP f, conP conName [varP a]] $ + appsE [ return (VarE 'fmap) + , conE conName + , varE f `appE` varE a + ] makeIsoFrom :: Name -> ExpQ -makeIsoFrom conName = lamE [varP (mkName "f"), varP (mkName "a")] $ - appsE [ return (VarE 'fmap) - , lamE [conP conName [varP (mkName "b")]] $ varE (mkName "b") - , varE (mkName "f") `appE` (conE conName `appE` varE (mkName "a")) - ] +makeIsoFrom conName = do + f <- newName "f" + a <- newName "a" + b <- newName "b" + lamE [varP f, varP a] $ + appsE [ return (VarE 'fmap) + , lamE [conP conName [varP b]] $ varE b + , varE f `appE` (conE conName `appE` varE a) + ] makeIsoBody :: Name -> Name -> (Name -> ExpQ) -> (Name -> ExpQ) -> DecQ makeIsoBody lensName conName f g = funD lensName [clause [] (normalB body) []] where @@ -412,37 +405,33 @@ makeFieldLensBody isTraversal lensName conList maybeMethodName = case maybeMethodName of Just methodName -> do go <- newName "go" - let expr = infixApp (varE methodName) (varE (mkName ".")) (varE go) + let expr = infixApp (varE methodName) (varE '(Prelude..)) (varE go) funD lensName [ clause [] (normalB expr) [funD go clauses] ] Nothing -> funD lensName clauses where clauses = map buildClause conList - plainClause ps d = clause ps d [] buildClause (con, fields) = do - let allFields :: [Name] - allFields = con^..conNamedFields._1 + f <- newName "_f" + vars <- for (con^..conNamedFields._1) $ \field -> + if field `List.elem` fields + then Left <$> ((,) <$> newName ('_':(nameBase field++"'")) <*> newName ('_':nameBase field)) + else Right <$> newName ('_':nameBase field) + let cpats = map (varP . either fst id) vars -- Deconstruction + cvals = map (varE . either snd id) vars -- Reconstruction + fpats = map (varP . snd) $ lefts vars -- Lambda patterns + fvals = map (appE (varE f) . varE . fst) $ lefts vars -- Functor applications conName = con^.name - conWild = conP conName (replicate (length allFields) wildP) - - if not isTraversal && length fields /= 1 - then plainClause [wildP, conWild] . normalB . appE (varE 'error) . litE . stringL - $ show lensName ++ ": expected a single matching field in " ++ show conName ++ ", found " ++ show (length fields) - else do - vars <- for allFields $ \field -> - if field `List.elem` fields - then fmap Left $ (,) <$> newName (nameBase field) <*> newName (nameBase field ++ "'") - else Right <$> newName (nameBase field) - f <- newName "_f" - let cpats = map (varP . either fst id) vars -- Deconstruction - cvals = map (varE . either snd id) vars -- Reconstruction - fpats = map (varP . snd) $ lefts vars -- Lambda patterns - fvals = map (appE (varE f) . varE . fst) $ lefts vars -- Functor applications - recon = appsE $ conE conName : cvals + recon = appsE $ conE conName : cvals - expr = if List.null fields - then appE (varE 'pure) recon - else uInfixE (lamE fpats recon) (varE '(<$>)) $ List.foldl1 (\l r -> uInfixE l (varE '(<*>)) r) fvals - plainClause [varP f, conP conName cpats] (normalB expr) + expr + | not isTraversal && length fields /= 1 + = appE (varE 'error) . litE . stringL + $ show lensName ++ ": expected a single matching field in " ++ show conName ++ ", found " ++ show (length fields) + | List.null fields + = appE (varE 'pure) recon + | otherwise + = uInfixE (lamE fpats recon) (varE '(<$>)) $ List.foldl1 (\l r -> uInfixE l (varE '(<*>)) r) fvals + clause [varP f, conP conName cpats] (normalB expr) [] makeFieldLenses :: LensRules -> Cxt -- ^ surrounding cxt driven by the data type context @@ -477,14 +466,14 @@ --TODO: there's probably a more efficient way to do this. lensFields <- map (\xs -> (fst $ head xs, map snd xs)) - . groupBy ((==) `on` fst) . sortBy (comparing fst) . concat + . groupBy ((==) `on` fst) . sortBy (comparing fst) + . concat <$> mapM (getLensFields $ view lensField cfg) cons -- varMultiSet knows how many usages of the type variables there are. let varMultiSet = List.concatMap (toListOf (conFields._2.typeVars)) cons varSet = Set.fromList $ map (view name) tyArgs - -- if not (cfg^.partialLenses) && not (cfg^.BuildTraversals) bodies <- for lensFields $ \(lensName, fields) -> do let fieldTypes = map (view _3) fields -- All of the polymorphic variables not involved in these fields @@ -549,12 +538,11 @@ -- | Gets @[(lens name, (constructor name, field name, type))]@ from a record constructor getLensFields :: (String -> Maybe String) -> Con -> Q [(Name, (Name, Name, Type))] -getLensFields nameFunc (RecC cn fs) +getLensFields f (RecC cn fs) = return . catMaybes - $ map (\(fn,_,t) -> (\ln -> (mkName ln, (cn,fn,t))) <$> nameFunc (nameBase fn)) fs + $ map (\(fn,_,t) -> (\ln -> (mkName ln, (cn,fn,t))) <$> f (nameBase fn)) fs getLensFields _ _ - = warn "makeLensesWith: encountered a non-record constructor, for which no lenses will be generated." - >> return [] + = return [] -- TODO: properly fill this out -- @@ -563,21 +551,6 @@ -- (This leaves us open to inscrutable compile errors in the generated code) unifyTypes :: [TyVarBndr] -> [Type] -> Q ([TyVarBndr], Type) unifyTypes tvs tys = return (tvs, head tys) - -{- -fieldDescs :: Set Name -> [(Name,Strict,Type)] -> [FieldDesc] -fieldDescs acc ((nm,_,ty):rest) = - FieldDesc nm ty (acc `Set.union` setOf typeVars (map thd rest)) : - fieldDescs (acc `Set.union` setOf typeVars ty) rest -fieldDescs _ [] = [] --} - -warn :: String -> Q () -#if MIN_VERSION_template_haskell(2,8,0) -warn = reportWarning -#else -warn = report False -#endif #if !(MIN_VERSION_template_haskell(2,7,0)) -- | The orphan instance for old versions is bad, but programing without 'Applicative' is worse. diff --git a/src/Control/Lens/Traversal.hs b/src/Control/Lens/Traversal.hs --- a/src/Control/Lens/Traversal.hs +++ b/src/Control/Lens/Traversal.hs @@ -86,8 +86,8 @@ -- The laws for a Traversal @t@ follow from the laws for Traversable as stated in \"The Essence of the Iterator Pattern\". -- -- @ --- t 'pure' = 'pure' --- 'fmap' (t f) . t g = 'Data.Functor.Compose.getCompose' . t ('Data.Functor.Compose.Compose' . 'fmap' f . g) +-- t 'pure' ≡ 'pure' +-- 'fmap' (t f) '.' t g ≡ 'Data.Functor.Compose.getCompose' '.' t ('Data.Functor.Compose.Compose' '.' 'fmap' f '.' g) -- @ -- -- One consequence of this requirement is that a 'Traversal' needs to leave the same number of elements as a @@ -108,9 +108,9 @@ -- Map each element of a structure targeted by a Lens or Traversal, -- evaluate these actions from left to right, and collect the results. -- --- @'traverseOf' = 'id'@ +-- @'traverseOf' ≡ 'id'@ -- --- @'traverse' = 'traverseOf' 'traverse'@ +-- @'traverse' ≡ 'traverseOf' 'traverse'@ -- -- @ -- 'traverseOf' :: 'Control.Lens.Iso.Iso' a b c d -> (c -> f d) -> a -> f b @@ -123,11 +123,11 @@ -- | -- --- @'forOf' l = 'flip' ('traverseOf' l)@ +-- @'forOf' l ≡ 'flip' ('traverseOf' l)@ -- -- @ --- 'for' = 'forOf' 'traverse' --- 'forOf' = 'flip' +-- 'for' ≡ 'forOf' 'traverse' +-- 'forOf' ≡ 'flip' -- @ -- -- @ @@ -144,9 +144,9 @@ -- the results. -- -- @ --- 'sequenceA' = 'sequenceAOf' 'traverse' = 'traverse' 'id' --- 'sequenceAOf' l = 'traverseOf' l id --- 'sequenceAOf' l = l id +-- 'sequenceA' ≡ 'sequenceAOf' 'traverse' = 'traverse' 'id' +-- 'sequenceAOf' l ≡ 'traverseOf' l id +-- 'sequenceAOf' l ≡ l id -- @ -- -- @ @@ -161,7 +161,7 @@ -- | Map each element of a structure targeted by a lens to a monadic action, -- evaluate these actions from left to right, and collect the results. -- --- @'mapM' = 'mapMOf' 'traverse'@ +-- @'mapM' ≡ 'mapMOf' 'traverse'@ -- -- @ -- 'mapMOf' :: 'Control.Lens.Iso.Iso' a b c d -> (c -> m d) -> a -> m b @@ -174,8 +174,8 @@ -- | -- @ --- 'forM' = 'forMOf' 'traverse' --- 'forMOf' l = 'flip' ('mapMOf' l) +-- 'forM' ≡ 'forMOf' 'traverse' +-- 'forMOf' l ≡ 'flip' ('mapMOf' l) -- @ -- -- @ @@ -189,9 +189,9 @@ -- | -- @ --- 'sequence' = 'sequenceOf' 'traverse' --- 'sequenceOf' l = 'mapMOf' l id --- 'sequenceOf' l = 'unwrapMonad' . l 'WrapMonad' +-- 'sequence' ≡ 'sequenceOf' 'traverse' +-- 'sequenceOf' l ≡ 'mapMOf' l id +-- 'sequenceOf' l ≡ 'unwrapMonad' . l 'WrapMonad' -- @ -- -- @ @@ -207,7 +207,7 @@ -- -- Note: 'Data.List.transpose' handles ragged inputs more intelligently, but for non-ragged inputs: -- --- @'Data.List.transpose' = 'transposeOf' 'traverse'@ +-- @'Data.List.transpose' ≡ 'transposeOf' 'traverse'@ -- -- >>> transposeOf traverse [[1,2,3],[4,5,6]] -- [[1,4],[2,5],[3,6]] @@ -222,7 +222,7 @@ -- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'Traversal'. -- --- @'mapAccumR' = 'mapAccumROf' 'traverse'@ +-- @'mapAccumR' ≡ 'mapAccumROf' 'traverse'@ -- -- 'mapAccumROf' accumulates state from right to left. -- @@ -237,7 +237,7 @@ -- | Generalized 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'. -- --- @'mapAccumL' = 'mapAccumLOf' 'traverse'@ +-- @'mapAccumL' ≡ 'mapAccumLOf' 'traverse'@ -- -- 'mapAccumLOf' accumulates state from left to right. -- @@ -256,7 +256,7 @@ -- | Permit the use of 'scanr1' over an arbitrary 'Traversal' or 'Lens'. -- --- @'scanr1' = 'scanr1Of' 'traverse'@ +-- @'scanr1' ≡ 'scanr1Of' 'traverse'@ -- -- @ -- 'scanr1Of' :: 'Control.Lens.Iso.Iso' a b c c -> (c -> c -> c) -> a -> b @@ -271,7 +271,7 @@ -- | Permit the use of 'scanl1' over an arbitrary 'Traversal' or 'Lens'. -- --- @'scanl1' = 'scanl1Of' 'traverse'@ +-- @'scanl1' ≡ 'scanl1Of' 'traverse'@ -- -- @ -- 'scanr1Of' :: Iso a b c c -> (c -> c -> c) -> a -> b @@ -307,7 +307,7 @@ -- -- Attempts to access beyond the range of the 'Traversal' will cause an error. -- --- @'element' = 'elementOf' 'traverse'@ +-- @'element' ≡ 'elementOf' 'traverse'@ element :: Traversable t => Int -> Simple Lens (t a) a element = elementOf traverse @@ -319,7 +319,7 @@ -- -- @'ignored' :: 'Applicative' f => (c -> f d) -> a -> f a@ -- --- @'ignored' = 'const' 'pure'@ +-- @'ignored' ≡ 'const' 'pure'@ ignored :: Traversal a a c d ignored _ = pure {-# INLINE ignored #-} @@ -339,7 +339,7 @@ -- | traverse the right-hand value of an 'Either': -- --- @'traverseRight' = 'Data.Traversable.traverse'@ +-- @'traverseRight' ≡ 'Data.Traversable.traverse'@ -- -- Unfortunately the instance for -- @'Data.Traversable.Traversable' ('Either' c)@ is still missing from base, @@ -371,10 +371,6 @@ cloneTraversal :: Applicative f => ((c -> Bazaar c d d) -> a -> Bazaar c d b) -> (c -> f d) -> a -> f b cloneTraversal l f = bazaar f . l sell {-# INLINE cloneTraversal #-} - --- cloneTraversal' :: Applicative f => ((c -> Bazaar c d d) -> a -> Bazaar c d b) -> (c -> f d) -> a -> f b --- cloneTraversal' l f a = runBazaar (l (\c -> Bazaar (\k -> k c)) a) f --- {-# INLINE cloneTraversal' #-} -- | A form of 'Traversal' that can be stored monomorphically in a container. data ReifiedTraversal a b c d = ReifyTraversal { reflectTraversal :: Traversal a b c d } diff --git a/src/Control/Lens/Type.hs b/src/Control/Lens/Type.hs --- a/src/Control/Lens/Type.hs +++ b/src/Control/Lens/Type.hs @@ -111,15 +111,15 @@ -- -- 1) You get back what you put in: -- --- @'Control.Lens.Getter.view' l ('Control.Lens.Setter.set' l b a) = b@ +-- @'Control.Lens.Getter.view' l ('Control.Lens.Setter.set' l b a) ≡ b@ -- -- 2) Putting back what you got doesn't change anything: -- --- @'Control.Lens.Setter.set' l ('Control.Lens.Getter.view' l a) a = a@ +-- @'Control.Lens.Setter.set' l ('Control.Lens.Getter.view' l a) a ≡ a@ -- -- 3) Setting twice is the same as setting once: -- --- @'Control.Lens.Setter.set' l c ('Control.Lens.Setter.set' l b a) = 'Control.Lens.Setter.set' l c a@ +-- @'Control.Lens.Setter.set' l c ('Control.Lens.Setter.set' l b a) ≡ 'Control.Lens.Setter.set' l c a@ -- -- 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 @@ -133,11 +133,11 @@ -- 'Control.Lens.Fold.Fold' or 'Control.Lens.Getter.Getter'. -- -- Since every lens is a valid 'Control.Lens.Traversal.Traversal', the --- traversal laws should also apply to any lenses you create. +-- traversal laws are required of any lenses you create: -- -- @ --- l 'pure' = 'pure' --- 'fmap' (l f) . l g = 'Data.Functor.Compose.getCompose' . l ('Data.Functor.Compose.Compose' . 'fmap' f . g) +-- l 'pure' ≡ 'pure' +-- 'fmap' (l f) '.' l g ≡ 'Data.Functor.Compose.getCompose' '.' l ('Data.Functor.Compose.Compose' '.' 'fmap' f '.' g) -- @ -- -- @type 'Lens' a b c d = forall f. 'Functor' f => 'LensLike' f a b c d@ @@ -168,7 +168,7 @@ -- | Build a 'Lens' from a getter and a setter. -- --- > lens :: Functor f => (a -> c) -> (a -> d -> b) -> (c -> f d) -> a -> f b +-- @'lens' :: 'Functor' f => (a -> c) -> (a -> d -> b) -> (c -> f d) -> a -> f b@ lens :: (a -> c) -> (a -> d -> b) -> Lens a b c d lens ac adb cfd a = adb a <$> cfd (ac a) {-# INLINE lens #-} @@ -202,7 +202,7 @@ -- -- For all that the definition of this combinator is just: -- --- @('%%~') = 'id'@ +-- @('%%~') ≡ 'id'@ -- -- @ -- ('%%~') :: 'Functor' f => 'Control.Lens.Iso.Iso' a b c d -> (c -> f d) -> a -> f b @@ -231,7 +231,7 @@ -- 'Control.Lens.Traversal.Traversal' in the current state, extracting extra -- information of type @c@ and return a monoidal summary of the changes. -- --- @('%%=') = ('state' '.')@ +-- @('%%=') ≡ ('state' '.')@ -- -- It may be useful to think of ('%%='), instead, as having either of the -- following more restricted type signatures: @@ -294,8 +294,7 @@ -- -- Note: This only accepts a proper 'Lens'. -- --- \"Costate Comonad Coalgebra is equivalent of Java's member variable --- update technology for Haskell\" -- \@PLT_Borat on Twitter +-- /\"Costate Comonad Coalgebra is equivalent of Java's member variable update technology for Haskell\"/ -- \@PLT_Borat on Twitter cloneLens :: Functor f => LensLike (Context c d) a b c d -> (c -> f d) -> a -> f b @@ -320,6 +319,12 @@ -- | Modify the target of a 'Lens' and return the result -- -- When you do not need the result of the addition, ('Control.Lens.Setter.%~') is more flexible. +-- +-- @ +-- ('<%~') :: 'Lens' a b c d -> (c -> d) -> a -> (d, b) +-- ('<%~') :: 'Control.Lens.Iso.Iso' a b c d -> (c -> d) -> a -> (d, b) +-- ('<%~') :: 'Monoid' d => 'Control.Lens.Traversal.Traversal' a b c d -> (c -> d) -> a -> (d, b) +-- @ (<%~) :: LensLike ((,)d) a b c d -> (c -> d) -> a -> (d, b) l <%~ f = l $ \c -> let d = f c in (d, d) {-# INLINE (<%~) #-} @@ -327,6 +332,11 @@ -- | Increment the target of a numerically valued 'Lens' and return the result -- -- When you do not need the result of the addition, ('Control.Lens.Setter.+~') is more flexible. +-- +-- @ +-- ('<+~') :: 'Num' b => 'Simple' 'Lens' a b -> b -> a -> (b, a) +-- ('<+~') :: 'Num' b => 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> (b, a) +-- @ (<+~) :: Num c => LensLike ((,)c) a b c c -> c -> a -> (c, b) l <+~ c = l <%~ (+ c) {-# INLINE (<+~) #-} @@ -334,6 +344,11 @@ -- | Decrement the target of a numerically valued 'Lens' and return the result -- -- When you do not need the result of the subtraction, ('Control.Lens.Setter.-~') is more flexible. +-- +-- @ +-- ('<-~') :: 'Num' b => 'Simple' 'Lens' a b -> b -> a -> (b, a) +-- ('<-~') :: 'Num' b => 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> (b, a) +-- @ (<-~) :: Num c => LensLike ((,)c) a b c c -> c -> a -> (c, b) l <-~ c = l <%~ subtract c {-# INLINE (<-~) #-} @@ -342,6 +357,11 @@ -- -- When you do not need the result of the multiplication, ('Control.Lens.Setter.*~') is more -- flexible. +-- +-- @ +-- ('<*~') :: 'Num' b => 'Simple' 'Lens' a b -> b -> a -> (b, a) +-- ('<*~') :: 'Num' b => 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> (b, a) +-- @ (<*~) :: Num c => LensLike ((,)c) a b c c -> c -> a -> (c, b) l <*~ c = l <%~ (* c) {-# INLINE (<*~) #-} @@ -349,6 +369,11 @@ -- | Divide the target of a fractionally valued 'Lens' and return the result. -- -- When you do not need the result of the division, ('Control.Lens.Setter.//~') is more flexible. +-- +-- @ +-- (' 'Simple' 'Lens' a b -> b -> a -> (b, a) +-- (' 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> (b, a) +-- @ ( LensLike ((,)c) a b c c -> c -> a -> (c, b) l 'Simple' 'Lens' a b -> c -> a -> (b, a) +-- ('<^~') :: ('Num' b, 'Integral' c) => 'Simple' 'Control.Lens.Iso.Iso' a b -> c -> a -> (b, a) +-- @ (<^~) :: (Num c, Integral d) => LensLike ((,)c) a b c c -> d -> a -> (c, b) l <^~ d = l <%~ (^ d) {-# INLINE (<^~) #-} @@ -365,6 +395,11 @@ -- and return the result. -- -- When you do not need the result of the division, ('Control.Lens.Setter.^^~') is more flexible. +-- +-- @ +-- ('<^^~') :: ('Fractional' b, 'Integral' c) => 'Simple' 'Lens' a b -> c -> a -> (b, a) +-- ('<^^~') :: ('Fractional' b, 'Integral' c) => 'Simple' 'Control.Lens.Iso.Iso' a b -> c -> a -> (b, a) +-- @ (<^^~) :: (Fractional c, Integral d) => LensLike ((,)c) a b c c -> d -> a -> (c, b) l <^^~ d = l <%~ (^^ d) {-# INLINE (<^^~) #-} @@ -373,6 +408,11 @@ -- and return the result. -- -- When you do not need the result of the division, ('Control.Lens.Setter.**~') is more flexible. +-- +-- @ +-- ('<**~') :: 'Floating' b => 'Simple' 'Lens' a b -> b -> a -> (b, a) +-- ('<**~') :: 'Floating' b => 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> a -> (b, a) +-- @ (<**~) :: Floating c => LensLike ((,)c) a b c c -> c -> a -> (c, b) l <**~ c = l <%~ (** c) {-# INLINE (<**~) #-} @@ -380,6 +420,11 @@ -- | Logically '||' a Boolean valued 'Lens' and return the result -- -- When you do not need the result of the operation, ('Control.Lens.Setter.||~') is more flexible. +-- +-- @ +-- ('<||~') :: 'Simple' 'Lens' a 'Bool' -> 'Bool' -> a -> ('Bool', a) +-- ('<||~') :: 'Simple' 'Control.Lens.Iso.Iso' a 'Bool' -> 'Bool' -> a -> ('Bool', a) +-- @ (<||~) :: LensLike ((,)Bool) a b Bool Bool -> Bool -> a -> (Bool, b) l <||~ c = l <%~ (|| c) {-# INLINE (<||~) #-} @@ -387,6 +432,11 @@ -- | Logically '&&' a Boolean valued 'Lens' and return the result -- -- When you do not need the result of the operation, ('Control.Lens.Setter.&&~') is more flexible. +-- +-- @ +-- ('<&&~') :: 'Simple' 'Lens' a 'Bool' -> 'Bool' -> a -> ('Bool', a) +-- ('<&&~') :: 'Simple' 'Control.Lens.Iso.Iso' a 'Bool' -> 'Bool' -> a -> ('Bool', a) +-- @ (<&&~) :: LensLike ((,)Bool) a b Bool Bool -> Bool -> a -> (Bool, b) l <&&~ c = l <%~ (&& c) {-# INLINE (<&&~) #-} @@ -398,7 +448,16 @@ -- | Modify the target of a 'Lens' into your monad's state by a user supplied -- function and return the result. -- +-- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the intermediate +-- results. +-- -- When you do not need the result of the operation, ('Control.Lens.Setter.%=') is more flexible. +-- +-- @ +-- ('<%=') :: 'MonadState' a m => 'Simple' 'Lens' a b -> (b -> b) -> m b +-- ('<%=') :: 'MonadState' a m => 'Simple' 'Control.Lens.Iso.Iso' a b -> (b -> b) -> m b +-- ('<%=') :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Traveral' a b -> (b -> b) -> m b +-- @ (<%=) :: MonadState a m => LensLike ((,)d) a a c d -> (c -> d) -> m d l <%= f = l %%= (\c -> let d = f c in (d,d)) {-# INLINE (<%=) #-} @@ -408,6 +467,11 @@ -- -- When you do not need the result of the multiplication, ('Control.Lens.Setter.+=') is more -- flexible. +-- +-- @ +-- ('<+=') :: ('MonadState' a m, 'Num' b) => 'Simple' 'Lens' a b -> b -> m b +-- ('<+=') :: ('MonadState' a m, 'Num' b) => 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> m b +-- @ (<+=) :: (MonadState a m, Num b) => SimpleLensLike ((,)b) a b -> b -> m b l <+= b = l <%= (+ b) {-# INLINE (<+=) #-} @@ -417,6 +481,11 @@ -- -- When you do not need the result of the multiplication, ('Control.Lens.Setter.-=') is more -- flexible. +-- +-- @ +-- ('<-=') :: ('MonadState' a m, 'Num' b) => 'Simple' 'Lens' a b -> b -> m b +-- ('<-=') :: ('MonadState' a m, 'Num' b) => 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> m b +-- @ (<-=) :: (MonadState a m, Num b) => SimpleLensLike ((,)b) a b -> b -> m b l <-= b = l <%= subtract b {-# INLINE (<-=) #-} @@ -426,6 +495,11 @@ -- -- When you do not need the result of the multiplication, ('Control.Lens.Setter.*=') is more -- flexible. +-- +-- @ +-- ('<*=') :: ('MonadState' a m, 'Num' b) => 'Simple' 'Lens' a b -> b -> m b +-- ('<*=') :: ('MonadState' a m, 'Num' b) => 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> m b +-- @ (<*=) :: (MonadState a m, Num b) => SimpleLensLike ((,)b) a b -> b -> m b l <*= b = l <%= (* b) {-# INLINE (<*=) #-} @@ -434,6 +508,11 @@ -- and return the result. -- -- When you do not need the result of the division, ('Control.Lens.Setter.//=') is more flexible. +-- +-- @ +-- (' 'Simple' 'Lens' a b -> b -> m b +-- (' 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> m b +-- @ ( SimpleLensLike ((,)b) a b -> b -> m b l 'Simple' 'Lens' a b -> c -> m b +-- ('<^=') :: ('MonadState' a m, 'Num' b, 'Integral' c) => 'Simple' 'Control.Lens.Iso.Iso' a b -> c -> m b +-- @ (<^=) :: (MonadState a m, Num b, Integral c) => SimpleLensLike ((,)b) a b -> c -> m b l <^= c = l <%= (^ c) {-# INLINE (<^=) #-} @@ -450,6 +534,11 @@ -- to an 'Integral' power and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.^^=') is more flexible. +-- +-- @ +-- ('<^^=') :: ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Simple' 'Lens' a b -> c -> m b +-- ('<^^=') :: ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Simple' 'Control.Lens.Iso.Iso' a b -> c -> m b +-- @ (<^^=) :: (MonadState a m, Fractional b, Integral c) => SimpleLensLike ((,)b) a b -> c -> m b l <^^= c = l <%= (^^ c) {-# INLINE (<^^=) #-} @@ -458,6 +547,11 @@ -- state to an arbitrary power and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.**=') is more flexible. +-- +-- @ +-- ('<**=') :: ('MonadState' a m, 'Floating' b) => 'Simple' 'Lens' a b -> b -> m b +-- ('<**=') :: ('MonadState' a m, 'Floating' b) => 'Simple' 'Control.Lens.Iso.Iso' a b -> b -> m b +-- @ (<**=) :: (MonadState a m, Floating b) => SimpleLensLike ((,)b) a b -> b -> m b l <**= b = l <%= (** b) {-# INLINE (<**=) #-} @@ -466,6 +560,11 @@ -- the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.||=') is more flexible. +-- +-- @ +-- ('<||=') :: 'MonadState' a m => 'Simple' 'Lens' a 'Bool' -> 'Bool' -> m 'Bool' +-- ('<||=') :: 'MonadState' a m => 'Simple' 'Control.Lens.Iso.Iso' a 'Bool' -> 'Bool' -> m 'Bool' +-- @ (<||=) :: MonadState a m => SimpleLensLike ((,)Bool) a Bool -> Bool -> m Bool l <||= b = l <%= (|| b) {-# INLINE (<||=) #-} @@ -474,6 +573,11 @@ -- the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.&&=') is more flexible. +-- +-- @ +-- ('<&&=') :: 'MonadState' a m => 'Simple' 'Lens' a 'Bool' -> 'Bool' -> m 'Bool' +-- ('<&&=') :: 'MonadState' a m => 'Simple' 'Control.Lens.Iso.Iso' a 'Bool' -> 'Bool' -> m 'Bool' +-- @ (<&&=) :: MonadState a m => SimpleLensLike ((,)Bool) a Bool -> Bool -> m Bool l <&&= b = l <%= (&& b) {-# INLINE (<&&=) #-} diff --git a/src/Control/Lens/WithIndex.hs b/src/Control/Lens/WithIndex.hs --- a/src/Control/Lens/WithIndex.hs +++ b/src/Control/Lens/WithIndex.hs @@ -78,8 +78,8 @@ -- Instances must satisfy a modified form of the 'Functor' laws: -- -- @ --- 'imap' f . 'imap' g = 'imap' (\i -> f i . g i) --- 'imap' (\_ a -> a) = 'id' +-- 'imap' f '.' 'imap' g ≡ 'imap' (\i -> f i . g i) +-- 'imap' (\_ a -> a) ≡ 'id' -- @ class Functor f => FunctorWithIndex i f | f -> i where -- | Map with access to the index. @@ -106,7 +106,7 @@ -- -- When you don't need access to the index then 'foldMap' is more flexible in what it accepts. -- - -- @'foldMap' = 'ifoldMap' . 'const'@ + -- @'foldMap' ≡ 'ifoldMap' '.' 'const'@ ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m default ifoldMap :: (TraversableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m ifoldMap = ifoldMapOf itraversed @@ -115,7 +115,7 @@ -- -- When you don't need access to the index then 'Data.Foldable.foldr' is more flexible in what it accepts. -- - -- @'Data.Foldable.foldr' = 'ifoldr' . 'const'@ + -- @'Data.Foldable.foldr' ≡ 'ifoldr' '.' 'const'@ ifoldr :: (i -> a -> b -> b) -> b -> f a -> b ifoldr f z t = appEndo (ifoldMap (\i -> Endo . f i) t) z @@ -124,7 +124,7 @@ -- -- When you don't need access to the index then 'foldl' is more flexible in what it accepts. -- - -- @'foldl' = 'ifoldl' . 'const'@ + -- @'foldl' ≡ 'ifoldl' '.' 'const'@ ifoldl :: (i -> b -> a -> b) -> b -> f a -> b ifoldl f z t = appEndo (getDual (ifoldMap (\i -> Dual . Endo . flip (f i)) t)) z @@ -132,7 +132,7 @@ -- -- When you don't need access to the index then 'foldr'' is more flexible in what it accepts. -- - -- @'foldr'' = 'ifoldr'' . 'const'@ + -- @'foldr'' ≡ 'ifoldr'' '.' 'const'@ ifoldr' :: (i -> a -> b -> b) -> b -> f a -> b ifoldr' f z0 xs = ifoldl f' id xs z0 where f' i k x z = k $! f i x z @@ -141,7 +141,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.foldlOf'' is more flexible in what it accepts. -- - -- @'Control.Lens.Fold.foldlOf'' l = 'ifoldlOf'' l . 'const'@ + -- @'Control.Lens.Fold.foldlOf'' l ≡ 'ifoldlOf'' l '.' 'const'@ -- -- @ -- 'ifoldlOf'' :: 'Control.Lens.IndexedGetter.IndexedGetter' i a c -> (i -> e -> c -> e) -> e -> a -> e @@ -170,8 +170,7 @@ -- -- When you don't need access to the index then 'any' is more flexible in what it accepts. -- --- @'any' = 'iany' . 'const'@ --- +-- @'any' = 'iany' '.' 'const'@ iany :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool iany f = getAny . ifoldMap (\i -> Any . f i) {-# INLINE iany #-} @@ -181,7 +180,7 @@ -- -- When you don't need access to the index then 'all' is more flexible in what it accepts. -- --- @'all' = 'iall' . 'const'@ +-- @'all' ≡ 'iall' '.' 'const'@ iall :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool iall f = getAll . ifoldMap (\i -> All . f i) {-# INLINE iall #-} @@ -191,7 +190,7 @@ -- -- When you don't need access to the index then 'traverse_' is more flexible in what it accepts. -- --- @'traverse_' l = 'itraverse' . 'const'@ +-- @'traverse_' l = 'itraverse' '.' 'const'@ itraverse_ :: (FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f () itraverse_ f = getTraversed . ifoldMap (\i -> Traversed . void . f i) {-# INLINE itraverse_ #-} @@ -199,11 +198,11 @@ -- | -- Traverse elements with access to the index @i@, discarding the results (with the arguments flipped). -- --- @'ifor_' = 'flip' 'itraverse_'@ +-- @'ifor_' ≡ 'flip' 'itraverse_'@ -- -- When you don't need access to the index then 'for_' is more flexible in what it accepts. -- --- @'for_' a = 'ifor_' a . 'const'@ +-- @'for_' a ≡ 'ifor_' a '.' 'const'@ ifor_ :: (FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f () ifor_ = flip itraverse_ {-# INLINE ifor_ #-} @@ -214,7 +213,7 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.mapMOf_' is more flexible in what it accepts. -- --- @'mapM_' = 'imapM' . 'const'@ +-- @'mapM_' ≡ 'imapM' '.' 'const'@ imapM_ :: (FoldableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m () imapM_ f = getSequenced . ifoldMap (\i -> Sequenced . liftM skip . f i) {-# INLINE imapM_ #-} @@ -223,11 +222,11 @@ -- Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index, -- discarding the results (with the arguments flipped). -- --- @'iforM_' = 'flip' 'imapM_'@ +-- @'iforM_' ≡ 'flip' 'imapM_'@ -- -- When you don't need access to the index then 'Control.Lens.Fold.forMOf_' is more flexible in what it accepts. -- --- @'Control.Lens.Fold.forMOf_' l a = 'iforMOf' l a . 'const'@ +-- @'Control.Lens.Fold.forMOf_' l a ≡ 'iforMOf' l a '.' 'const'@ iforM_ :: (FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m () iforM_ = flip imapM_ {-# INLINE iforM_ #-} @@ -238,8 +237,8 @@ -- When you don't need access to the index then 'concatMap' is more flexible in what it accepts. -- -- @ --- 'concatMap' = 'iconcatMap' . 'const' --- 'iconcatMap' = 'ifoldMap' +-- 'concatMap' ≡ 'iconcatMap' . 'const' +-- 'iconcatMap' ≡ 'ifoldMap' -- @ iconcatMap :: FoldableWithIndex i f => (i -> a -> [b]) -> f a -> [b] iconcatMap = ifoldMap @@ -250,7 +249,7 @@ -- -- When you don't need access to the index then 'find' is more flexible in what it accepts. -- --- @'find' = 'ifind' . 'const'@ +-- @'find' ≡ 'ifind' '.' 'const'@ ifind :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Maybe (i, a) ifind p = getFirst . ifoldMap step where step i c @@ -262,7 +261,7 @@ -- -- When you don't need access to the index then 'foldrM' is more flexible in what it accepts. -- --- @'foldrM' = 'ifoldrM' . 'const'@ +-- @'foldrM' ≡ 'ifoldrM' '.' 'const'@ ifoldrM :: (FoldableWithIndex i f, Monad m) => (i -> a -> b -> m b) -> b -> f a -> m b ifoldrM f z0 xs = ifoldl f' return xs z0 where f' i k x z = f i x z >>= k @@ -272,7 +271,7 @@ -- -- When you don't need access to the index then 'foldlM' is more flexible in what it accepts. -- --- @'foldlM' = 'ifoldlM' . 'const'@ +-- @'foldlM' ≡ 'ifoldlM' '.' 'const'@ ifoldlM :: (FoldableWithIndex i f, Monad m) => (i -> b -> a -> m b) -> b -> f a -> m b ifoldlM f z0 xs = ifoldr f' return xs z0 where f' i x k z = f i z x >>= k @@ -282,7 +281,7 @@ -- -- When you don't need access to the indices in the result, then 'toList' is more flexible in what it accepts. -- --- @'toList' = 'map' 'fst' . 'itoList'@ +-- @'toList' ≡ 'map' 'fst' '.' 'itoList'@ itoList :: FoldableWithIndex i f => f a -> [(i,a)] itoList = ifoldr (\i c -> ((i,c):)) [] {-# INLINE itoList #-} @@ -310,8 +309,8 @@ -- An instance must satisfy a (modified) form of the 'Traversable' laws: -- -- @ --- 'itraverse' ('const' 'Data.Functor.Identity.Identity') = 'Data.Functor.Identity.Identity' --- 'fmap' ('itraverse' f) '.' 'itraverse' g = 'getCompose' '.' 'itraverse' (\i -> 'Compose' '.' 'fmap' (f i) '.' g i) +-- 'itraverse' ('const' 'Data.Functor.Identity.Identity') ≡ 'Data.Functor.Identity.Identity' +-- 'fmap' ('itraverse' f) '.' 'itraverse' g ≡ 'getCompose' '.' 'itraverse' (\i -> 'Compose' '.' 'fmap' (f i) '.' g i) -- @ class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | t -> i where -- | Traverse an indexed container. @@ -329,8 +328,8 @@ -- Traverse with an index (and the arguments flipped) -- -- @ --- 'for' a = 'ifor' a . 'const' --- 'ifor' = 'flip' 'itraverse' +-- 'for' a ≡ 'ifor' a '.' 'const' +-- 'ifor' ≡ 'flip' 'itraverse' -- @ ifor :: (TraversableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f (t b) ifor = flip itraverse @@ -342,7 +341,7 @@ -- -- When you don't need access to the index 'mapM' is more liberal in what it can accept. -- --- @'mapM' = 'imapM' . 'const'@ +-- @'mapM' ≡ 'imapM' '.' 'const'@ imapM :: (TraversableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m (t b) imapM f = unwrapMonad . itraverse (\i -> WrapMonad . f i) {-# INLINE imapM #-} @@ -352,8 +351,8 @@ -- its position (and the arguments flipped). -- -- @ --- 'forM' a = 'iforM' a . 'const' --- 'iforM' = 'flip' 'imapM' +-- 'forM' a ≡ 'iforM' a '.' 'const' +-- 'iforM' ≡ 'flip' 'imapM' -- @ iforM :: (TraversableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m (t b) iforM = flip imapM @@ -363,7 +362,7 @@ -- -- 'imapAccumROf' accumulates state from right to left. -- --- @'Control.Lens.Traversal.mapAccumR' = 'imapAccumR' . 'const'@ +-- @'Control.Lens.Traversal.mapAccumR' ≡ 'imapAccumR' '.' 'const'@ imapAccumR :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b) imapAccumR f s0 a = swap (Lazy.runState (itraverse (\i c -> Lazy.state (\s -> swap (f i s c))) a) s0) {-# INLINE imapAccumR #-} @@ -372,14 +371,14 @@ -- -- 'imapAccumLOf' accumulates state from left to right. -- --- @'Control.Lens.Traversal.mapAccumLOf' = 'imapAccumL' . 'const'@ +-- @'Control.Lens.Traversal.mapAccumLOf' ≡ 'imapAccumL' '.' 'const'@ imapAccumL :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b) imapAccumL f s0 a = swap (Lazy.runState (forwards (itraverse (\i c -> Backwards (Lazy.state (\s -> swap (f i s c)))) a)) s0) {-# INLINE imapAccumL #-} -- | Access the element of an indexed container where the index matches a predicate. -- --- >>> :m + Control.Lens +-- >>> import Control.Lens -- >>> over (iwhere (>0)) Prelude.reverse $ ["He","was","stressed","o_O"] -- ["He","saw","desserts","O_o"] iwhere :: (TraversableWithIndex i t) => (i -> Bool) -> SimpleIndexedTraversal i (t a) a 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 @@ -22,7 +22,7 @@ import Control.Parallel.Strategies -- | Evaluate the targets of a 'Lens' or 'Traversal' into a data structure --- according to the given strategy. +-- according to the given 'Strategy'. -- -- @ -- 'evalTraversable' = 'evalOf' 'traverse' = 'traverse' @@ -30,9 +30,9 @@ -- @ -- -- @ --- evalOf :: 'Simple' 'Lens' a b -> 'Strategy' b -> 'Strategy' a --- evalOf :: 'Simple' 'Traversal' a b -> 'Strategy' b -> 'Strategy' a --- evalOf :: (b -> 'Eval' b) -> a -> 'Eval' a) -> 'Strategy' b -> 'Strategy' a +-- 'evalOf' :: 'Simple' 'Lens' a b -> 'Strategy' b -> 'Strategy' a +-- 'evalOf' :: 'Simple' 'Traversal' a b -> 'Strategy' b -> 'Strategy' a +-- 'evalOf' :: (b -> 'Eval' b) -> a -> 'Eval' a) -> 'Strategy' b -> 'Strategy' a -- @ evalOf :: SimpleLensLike Eval a b -> Strategy b -> Strategy a evalOf l = l @@ -44,16 +44,16 @@ -- @'parTraversable' = 'parOf' 'traverse'@ -- -- @ --- parOf :: 'Simple' 'Lens' a b -> 'Strategy' b -> 'Strategy' a --- parOf :: 'Simple' 'Traversal' a b -> 'Strategy' b -> 'Strategy' a --- parOf :: ((b -> 'Eval' b) -> a -> 'Eval' a) -> 'Strategy' b -> 'Strategy' a +-- 'parOf' :: 'Simple' 'Lens' a b -> 'Strategy' b -> 'Strategy' a +-- 'parOf' :: 'Simple' 'Traversal' a b -> 'Strategy' b -> 'Strategy' a +-- 'parOf' :: ((b -> 'Eval' b) -> a -> 'Eval' a) -> 'Strategy' b -> 'Strategy' a -- @ parOf :: SimpleLensLike Eval a b -> Strategy b -> Strategy a parOf l s = l (rparWith s) {-# INLINE parOf #-} -- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to --- first evaluates its argument according to a given strategy /before/ proceeding. +-- first evaluates its argument according to a given 'Strategy' /before/ proceeding. -- -- @ -- 'after' 'rdeepseq' 'traverse' :: 'Traversable' t => 'Strategy' a -> 'Strategy' [a] @@ -63,7 +63,7 @@ {-# INLINE after #-} -- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to --- evaluate its argument according to a given strategy /in parallel with/ evaluating. +-- evaluate its argument according to a given 'Strategy' /in parallel with/ evaluating. -- -- @ -- 'throughout' 'rdeepseq' 'traverse' :: 'Traversable' t => 'Strategy' a -> 'Strategy' [a] diff --git a/src/Control/Seq/Lens.hs b/src/Control/Seq/Lens.hs --- a/src/Control/Seq/Lens.hs +++ b/src/Control/Seq/Lens.hs @@ -20,6 +20,6 @@ -- 'Getter' or 'Fold' according to the given strategy. -- -- @'seqFoldable' = 'seqOf' 'folded'@ -seqOf :: Getting [c] a c -> Strategy c -> Strategy a +seqOf :: Getting [c] a b c d -> Strategy c -> Strategy a seqOf l s = seqList s . toListOf l {-# INLINE seqOf #-} diff --git a/src/Data/Array/Lens.hs b/src/Data/Array/Lens.hs --- a/src/Data/Array/Lens.hs +++ b/src/Data/Array/Lens.hs @@ -29,9 +29,10 @@ -- -- Note: The indexed element is assumed to exist in the target 'IArray'. -- --- @arr '!' i = arr '^.' 'ix' i@ --- --- @arr '//' [(i,e)] = 'ix' i '.~' e '$' arr@ +-- @ +-- arr '!' i ≡ arr '^.' 'ix' i +-- arr '//' [(i,e)] ≡ 'ix' i '.~' e '$' arr +-- @ -- -- >>> ix 2 .~ 9 $ (listArray (1,5) [4,5,6,7,8] :: Array Int Int) -- array (1,5) [(1,4),(2,9),(3,6),(4,7),(5,8)] @@ -44,21 +45,20 @@ -- -- This is a /contravariant/ 'Setter'. -- --- @'ixmap' = 'over' . 'ixmapped'@ --- --- @'ixmapped' = 'sets' . 'ixmap'@ --- --- @'over' ('ixmapped' b) f arr '!' i = arr '!' f i@ --- --- @'bounds' ('over' ('ixmapped' b) f arr) = b@ +-- @ +-- 'ixmap' ≡ 'over' . 'ixmapped' +-- 'ixmapped' ≡ 'sets' . 'ixmap' +-- 'over' ('ixmapped' b) f arr '!' i ≡ arr '!' f i +-- 'bounds' ('over' ('ixmapped' b) f arr) ≡ b +-- @ ixmapped :: (IArray a e, Ix i, Ix j) => (i,i) -> Setter (a j e) (a i e) i j ixmapped = sets . ixmap {-# INLINE ixmapped #-} --- | An 'IndexedTraversal' of the elements of an 'IArray', using the +-- | An 'IndexedTraversal' of the elements of an 'IArray', using the -- index into the array as the index of the traversal. -- --- @'amap' = 'over' 'traverseArray'@ +-- @'amap' ≡ 'over' 'traverseArray'@ traverseArray :: (IArray a c, IArray a d, Ix i) => IndexedTraversal i (a i c) (a i d) c d traverseArray = index $ \f arr -> array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f i a) (assocs arr) {-# INLINE traverseArray #-} diff --git a/src/Data/Bits/Lens.hs b/src/Data/Bits/Lens.hs --- a/src/Data/Bits/Lens.hs +++ b/src/Data/Bits/Lens.hs @@ -32,10 +32,10 @@ -- ("hello",7) -- -- @ --- (|~) :: 'Bits' c => 'Setter' a b c c -> c -> a -> b --- (|~) :: 'Bits' c => 'Iso' a b c c -> c -> a -> b --- (|~) :: 'Bits' c => 'Lens' a b c c -> c -> a -> b --- (|~) :: ('Monoid c', 'Bits' c) => 'Traversal' a b c c -> c -> a -> b +-- ('|~') :: 'Bits' c => 'Setter' a b c c -> c -> a -> b +-- ('|~') :: 'Bits' c => 'Iso' a b c c -> c -> a -> b +-- ('|~') :: 'Bits' c => 'Lens' a b c c -> c -> a -> b +-- ('|~') :: ('Monoid c', 'Bits' c) => 'Traversal' a b c c -> c -> a -> b -- @ (|~):: Bits c => Setting a b c c -> c -> a -> b l |~ n = over l (.|. n) @@ -47,10 +47,10 @@ -- ("hello",6) -- -- @ --- (&~) :: 'Bits' c => 'Setter' a b c c -> c -> a -> b --- (&~) :: 'Bits' c => 'Iso' a b c c -> c -> a -> b --- (&~) :: 'Bits' c => 'Lens' a b c c -> c -> a -> b --- (&~) :: ('Monoid c', 'Bits' c) => 'Traversal' a b c c -> c -> a -> b +-- ('&~') :: 'Bits' c => 'Setter' a b c c -> c -> a -> b +-- ('&~') :: 'Bits' c => 'Iso' a b c c -> c -> a -> b +-- ('&~') :: 'Bits' c => 'Lens' a b c c -> c -> a -> b +-- ('&~') :: ('Monoid c', 'Bits' c) => 'Traversal' a b c c -> c -> a -> b -- @ (&~) :: Bits c => Setting a b c c -> c -> a -> b l &~ n = over l (.&. n) @@ -59,10 +59,10 @@ -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.&.' with another value. -- -- @ --- (&=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Setter' a b -> b -> m () --- (&=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Iso' a b -> b -> m () --- (&=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m () --- (&=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Traversal' a b -> b -> m () +-- ('&=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Setter' a b -> b -> m () +-- ('&=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Iso' a b -> b -> m () +-- ('&=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m () +-- ('&=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Traversal' a b -> b -> m () -- @ (&=):: (MonadState a m, Bits b) => Simple Setting a b -> b -> m () l &= b = modify (l &~ b) @@ -71,10 +71,10 @@ -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.|.' with another value. -- -- @ --- (|=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Setter' a b -> b -> m () --- (|=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Iso' a b -> b -> m () --- (|=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m () --- (|=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Traversal' a b -> b -> m () +-- ('|=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Setter' a b -> b -> m () +-- ('|=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Iso' a b -> b -> m () +-- ('|=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m () +-- ('|=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Traversal' a b -> b -> m () -- @ (|=) :: (MonadState a m, Bits b) => Simple Setting a b -> b -> m () l |= b = modify (l |~ b) @@ -87,9 +87,9 @@ -- (7,("hello",7)) -- -- @ --- (\<|~) :: 'Bits' c => 'Iso' a b c c -> c -> a -> (c, b) --- (\<|~) :: 'Bits' c => 'Lens' a b c c -> c -> a -> (c, b) --- (\<|~) :: ('Bits' c, 'Monoid c) => 'Traversal' a b c c -> c -> a -> (c, b) +-- ('<|~') :: 'Bits' c => 'Iso' a b c c -> c -> a -> (c, b) +-- ('<|~') :: 'Bits' c => 'Lens' a b c c -> c -> a -> (c, b) +-- ('<|~') :: ('Bits' c, 'Monoid c) => 'Traversal' a b c c -> c -> a -> (c, b) -- @ (<|~):: Bits c => LensLike ((,) c) a b c c -> c -> a -> (c, b) l <|~ n = l <%~ (.|. n) @@ -102,9 +102,9 @@ -- (6,("hello",6)) -- -- @ --- (\<&~) :: 'Bits' c => 'Iso' a b c c -> c -> a -> (c, b) --- (\<&~) :: 'Bits' c => 'Lens' a b c c -> c -> a -> (c, b) --- (\<&~) :: ('Bits' c, 'Monoid c) => 'Traversal' a b c c -> c -> a -> (c, b) +-- ('<&~') :: 'Bits' c => 'Iso' a b c c -> c -> a -> (c, b) +-- ('<&~') :: 'Bits' c => 'Lens' a b c c -> c -> a -> (c, b) +-- ('<&~') :: ('Bits' c, 'Monoid c) => 'Traversal' a b c c -> c -> a -> (c, b) -- @ (<&~) :: Bits c => LensLike ((,) c) a b c c -> c -> a -> (c, b) l <&~ n = l <%~ (.&. n) @@ -114,8 +114,8 @@ -- returning the result (or a monoidal summary of all of the results traversed) -- -- @ --- (\<&=) :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m b --- (\<&=) :: ('MonadState' a m, 'Bits' b, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m b +-- ('<&=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m b +-- ('<&=') :: ('MonadState' a m, 'Bits' b, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m b -- @ (<&=):: (MonadState a m, Bits b) => SimpleLensLike ((,)b) a b -> b -> m b l <&= b = l <%= (.&. b) @@ -125,8 +125,8 @@ -- returning the result (or a monoidal summary of all of the results traversed) -- -- @ --- (\<|=) :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m b --- (\<|=) :: ('MonadState' a m, 'Bits' b, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m b +-- ('<|=') :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m b +-- ('<|=') :: ('MonadState' a m, 'Bits' b, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m b -- @ (<|=) :: (MonadState a m, Bits b) => SimpleLensLike ((,)b) a b -> b -> m b l <|= b = l <%= (.|. b) diff --git a/src/Data/HashSet/Lens.hs b/src/Data/HashSet/Lens.hs --- a/src/Data/HashSet/Lens.hs +++ b/src/Data/HashSet/Lens.hs @@ -46,6 +46,6 @@ -- setOf :: 'Hashable' c => 'Simple' 'Lens' a c -> a -> 'HashSet' c -- setOf :: ('Eq' c, 'Hashable' c) => 'Simple' 'Traversal' a c -> a -> 'HashSet' c -- @ -setOf :: Hashable c => Getting (HashSet c) a c -> a -> HashSet c +setOf :: Hashable c => Getting (HashSet c) a b c d -> a -> HashSet c setOf l = runAccessor . l (Accessor . HashSet.singleton) {-# INLINE setOf #-} diff --git a/src/Data/IntMap/Lens.hs b/src/Data/IntMap/Lens.hs deleted file mode 100644 --- a/src/Data/IntMap/Lens.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LiberalTypeSynonyms #-} ------------------------------------------------------------------------------ --- | --- Module : Data.IntMap.Lens --- Copyright : (C) 2012 Edward Kmett --- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : Rank2Types --- ----------------------------------------------------------------------------- -module Data.IntMap.Lens - ( traverseAtMin - , traverseAtMax - ) where - -import Control.Applicative as Applicative -import Control.Lens -import Data.IntMap as IntMap - --- | Traverse the value at the minimum key in a Map --- --- The key of the minimum element is available as the index. -traverseAtMin :: SimpleIndexedTraversal Int (IntMap v) v -traverseAtMin = index $ \f m -> case IntMap.minViewWithKey m of -#if MIN_VERSION_containers(0,5,0) - Just ((k,a), _) -> (\v -> IntMap.updateMin (const (Just v)) m) <$> f k a -#else - Just ((k,a), _) -> (\v -> IntMap.updateMin (const v) m) <$> f k a -#endif - Nothing -> pure m -{-# INLINE traverseAtMin #-} - --- | Traverse the value at the maximum key in a Map -traverseAtMax :: SimpleIndexedTraversal Int (IntMap v) v -traverseAtMax = index $ \f m -> case IntMap.maxViewWithKey m of -#if MIN_VERSION_containers(0,5,0) - Just ((k,a), _) -> (\v -> IntMap.updateMax (const (Just v)) m) <$> f k a -#else - Just ((k,a), _) -> (\v -> IntMap.updateMax (const v) m) <$> f k a -#endif - Nothing -> pure m -{-# INLINE traverseAtMax #-} diff --git a/src/Data/IntSet/Lens.hs b/src/Data/IntSet/Lens.hs --- a/src/Data/IntSet/Lens.hs +++ b/src/Data/IntSet/Lens.hs @@ -53,6 +53,6 @@ -- setOf :: 'Simple' 'Lens' a 'Int' -> a -> 'IntSet' -- setOf :: 'Simple' 'Traversal' a 'Int' -> a -> 'IntSet' -- @ -setOf :: Getting IntSet a Int -> a -> IntSet +setOf :: Getting IntSet a b Int d -> a -> IntSet setOf l = runAccessor . l (Accessor . IntSet.singleton) {-# INLINE setOf #-} diff --git a/src/Data/List/Lens.hs b/src/Data/List/Lens.hs --- a/src/Data/List/Lens.hs +++ b/src/Data/List/Lens.hs @@ -29,18 +29,23 @@ , traverseLast , (~:), (=:) , (<~:), (<=:) + , (++~), (<++~) + , (++=), (<++=) ) where import Control.Applicative import Control.Lens -import Control.Monad.State (MonadState, modify) +import Control.Monad.State as State (MonadState, modify) import Data.List -infixr 4 ~:, <~: -infix 4 =:, <=: +infixr 4 ++~, <++~ +infixl 4 ~:, <~: +infix 4 =:, <=:, ++=, <++= --- | A lens reading and writing to the head of a /non-empty/ list +-- | A lens reading and writing to the head of a /non-empty/ list. -- +-- Attempting to read or write to the head of an /empty/ list will result in an 'error'. +-- -- >>> [1,2,3]^._head -- 1 _head :: Simple Lens [a] a @@ -50,6 +55,8 @@ -- | A lens reading and writing to the tail of a /non-empty/ list -- +-- Attempting to read or write to the tail of an /empty/ list will result in an 'error'. +-- -- >>> _tail .~ [3,4,5] $ [1,2] -- [1,3,4,5] _tail :: Simple Lens [a] [a] @@ -59,6 +66,8 @@ -- | A lens reading and writing to the last element of a /non-empty/ list -- +-- Attempting to read or write to the last element of an /empty/ list will result in an 'error'. +-- -- >>> [1,2]^._last -- 2 _last :: Simple Lens [a] a @@ -69,6 +78,8 @@ -- | A lens reading and replacing all but the a last element of a /non-empty/ list -- +-- Attempting to read or write to all but the last element of an /empty/ list will result in an 'error'. +-- -- >>> [1,2,3,4]^._init -- [1,2,3] _init :: Simple Lens [a] [a] @@ -86,7 +97,7 @@ interspersed = to . intersperse {-# INLINE interspersed #-} --- | Obtain a version of the list with the supplied value intercalated +-- | Obtain a version of the list with the supplied value intercalated. intercalated :: [a] -> Getter [[a]] [a] intercalated = to . intercalate {-# INLINE intercalated #-} @@ -98,42 +109,42 @@ go _ _ [] = pure [] {-# INLINE traverseList #-} --- | The traversal for reading and writing to the head of a list +-- | A traversal for reading and writing to the head of a list -- -- The position of the head in the original list (0) is available as the index. -- -- >>> traverseHead +~ 1 $ [1,2,3] -- [2,2,3] -- --- > traverseHead :: Applicative f => (a -> f a) -> [a] -> f [a] +-- @'traverseHead' :: 'Applicative' f => (a -> f a) -> [a] -> f [a]@ traverseHead :: SimpleIndexedTraversal Int [a] a traverseHead = index $ \f aas -> case aas of [] -> pure [] (a:as) -> (:as) <$> f (0::Int) a {-# INLINE traverseHead #-} --- | Traversal for editing the tail of a list. +-- | A traversal for editing the tail of a list -- -- The position of each element /in the original list/ is available as the index. -- -- >>> traverseTail +~ 1 $ [1,2,3] -- [1,3,4] -- --- > traverseTail :: Applicative f => (a -> f a) -> [a] -> f [a] +-- @'traverseTail' :: 'Applicative' f => (a -> f a) -> [a] -> f [a]@ traverseTail :: SimpleIndexedTraversal Int [a] a traverseTail = index $ \f aas -> case aas of [] -> pure [] (a:as) -> (a:) <$> withIndex traverseList (f . (+1)) as {-# INLINE traverseTail #-} --- | Traverse the last element in a list. +-- | A traversal the last element in a list -- -- The position of the last element in the original list is available as the index. -- -- >>> traverseLast +~ 1 $ [1,2,3] -- [1,2,4] -- --- > traverseLast :: Applicative f => (a -> f a) -> [a] -> f [a] +-- @'traverseLast' :: 'Applicative' f => (a -> f a) -> [a] -> f [a]@ traverseLast :: SimpleIndexedTraversal Int [a] a traverseLast = index $ \f xs0 -> let go [a] n = return <$> f n a @@ -142,14 +153,14 @@ in go xs0 (0::Int) where {-# INLINE traverseLast #-} --- | Traverse all but the last element of a list +-- | A traversal of all but the last element of a list -- -- The position of each element is available as the index. -- -- >>> traverseInit +~ 1 $ [1,2,3] -- [2,3,3] -- --- > traverseInit :: Applicative f => (a -> f a) -> [a] -> f [a] +-- @'traverseInit' :: 'Applicative' f => (a -> f a) -> [a] -> f [a]@ traverseInit :: SimpleIndexedTraversal Int [a] a traverseInit = index $ \f aas -> case aas of [] -> pure [] @@ -183,25 +194,89 @@ n =: l = modify (n ~: l) {-# INLINE (=:) #-} --- | Cons onto the list(s) referenced by a 'Lens', returning the result. +-- | Cons onto the list(s) referenced by a 'Lens' (or 'Traversal'), returning the result. -- +-- If you use this with a 'Traversal' you will receive back the concatenation of all of +-- the resulting lists instead of an individual result. +-- -- >>> 'h' <~: _1 $ ("ello","world") -- ("hello",("hello","world")) -- -- @ --- ('\<~:') :: b -> 'Simple' 'Lens' a [b] -> a -> (b, a) --- ('\<~:') :: b -> 'Simple' 'Iso' a [b] -> a -> (b, a) +-- ('<~:') :: b -> 'Simple' 'Lens' a [b] -> a -> ([b], a) +-- ('<~:') :: b -> 'Simple' 'Iso' a [b] -> a -> ([b], a) +-- ('<~:') :: b -> 'Simple' 'Traversal' a [b] -> a -> ([b], a) -- @ (<~:) :: c -> LensLike ((,)[c]) a b [c] [c] -> a -> ([c], b) n <~: l = l <%~ (n :) {-# INLINE (<~:) #-} --- | Cons onto the list(s) referenced by a 'Lens' into your monad state, returning the result. +-- | Cons onto the list(s) referenced by a 'Lens' (or 'Traversal') into your monad state, +-- returning the result. -- +-- If you use this with a 'Traversal', you will receive back the concatenation of all +-- of the resulting lists instead of an individual result. +-- -- @ --- ('\<=:') :: 'MonadState' a m => 'Simple' 'Lens' a [c] -> c -> m () --- ('\<=:') :: 'MonadState' a m => 'Simple' 'Iso' a [c] -> c -> m () +-- ('<=:') :: 'MonadState' a m => 'Simple' 'Lens' a [c] -> c -> m [c] +-- ('<=:') :: 'MonadState' a m => 'Simple' 'Iso' a [c] -> c -> m [c] +-- ('<=:') :: 'MonadState' a m => 'Simple' 'Traversal' a [c] -> c -> m [c] -- @ (<=:) :: MonadState a m => c -> SimpleLensLike ((,)[c]) a [c] -> m [c] n <=: l = l <%= (n :) {-# INLINE (<=:) #-} + + +-- | Append to the target of a list-valued setter by appending to it with ('++'). +-- +-- ('Data.Monoid.<>~') generalizes this operation to an arbitrary 'Monoid'. +-- +-- >>> :m + Control.Lens +-- >>> both ++~ "!!!" $ ("hello","world") +-- ("hello!!!","world!!!") +-- +-- @ +-- ('++~') :: 'Simple' 'Setter' a [b] -> [b] -> a -> a +-- ('++~') :: 'Simple' 'Iso' a [b] -> [b] -> a -> a +-- ('++~') :: 'Simple' 'Lens' a [b] -> [b] -> a -> a +-- ('++~') :: 'Simple' 'Traversal' a [b] -> [b] -> a -> a +-- @ +(++~) :: Setting a b [c] [c] -> [c] -> a -> b +l ++~ n = over l (++ n) +{-# INLINE (++~) #-} + +-- | Append to the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' with ('++') in the current state. +-- +-- ('Data.Monoid.<>=') generalizes this operation to an arbitrary 'Monoid'. +-- +-- @ +-- ('++=') :: 'MonadState' a m => 'Simple' 'Setter' a [b] -> [b] -> m () +-- ('++=') :: 'MonadState' a m => 'Simple' 'Iso' a [b] -> [b] -> m () +-- ('++=') :: 'MonadState' a m => 'Simple' 'Lens' a [b] -> [b] -> m () +-- ('++=') :: 'MonadState' a m => 'Simple' 'Traversal' a [b] -> [b] -> m () +-- @ +(++=) :: MonadState a m => SimpleSetting a [b] -> [b] -> m () +l ++= b = State.modify (l ++~ b) +{-# INLINE (++=) #-} + +-- | Append onto the end of the list targeted by a 'Lens' and return the result. +-- +-- ('Data.Monoid.<<>~') generalizes this operation to an arbitrary 'Monoid'. +-- +-- When using a 'Traversal', the result returned is actually the concatenation of all of the results. +-- +-- When you do not need the result of the operation, ('++~') is more flexible. +(<++~) :: LensLike ((,)[c]) a b [c] [c] -> [c] -> a -> ([c], b) +l <++~ m = l <%~ (++ m) +{-# INLINE (<++~) #-} + +-- | Append onto the end of the list targeted by a 'Lens' into the current monadic state, and return the result. +-- +-- ('Data.Monoid.<<>=') generalizes this operation to an arbitrary 'Monoid'. +-- +-- When using a 'Traversal', the result returned is actually the concatenation of all of the results. +-- +-- When you do not need the result of the operation, ('++=') is more flexible. +(<++=) :: MonadState a m => SimpleLensLike ((,)[b]) a [b] -> [b] -> m [b] +l <++= m = l <%= (++ m) +{-# INLINE (<++=) #-} diff --git a/src/Data/Map/Lens.hs b/src/Data/Map/Lens.hs deleted file mode 100644 --- a/src/Data/Map/Lens.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LiberalTypeSynonyms #-} ------------------------------------------------------------------------------ --- | --- Module : Data.Map.Lens --- Copyright : (C) 2012 Edward Kmett --- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : Rank2Types --- ----------------------------------------------------------------------------- -module Data.Map.Lens - ( traverseAtMin - , traverseAtMax - ) where - -import Control.Applicative as Applicative -import Control.Lens.Indexed -import Control.Lens.IndexedTraversal -import Data.Map as Map - --- | Traverse the value at the minimum key in a Map. --- --- The key of the minimum element is available as the index of the traversal. -traverseAtMin :: SimpleIndexedTraversal k (Map k v) v -traverseAtMin = index $ \f m -> case Map.minViewWithKey m of - Just ((k, a), _) -> (\v -> Map.updateMin (const (Just v)) m) <$> f k a - Nothing -> pure m -{-# INLINE traverseAtMin #-} - --- | Traverse the value at the maximum key in a Map. --- --- The key of the maximum element is available as the index of the traversal. -traverseAtMax :: SimpleIndexedTraversal k (Map k v) v -traverseAtMax = index $ \f m -> case Map.maxViewWithKey m of - Just ((k, a), _) -> (\v -> Map.updateMax (const (Just v)) m) <$> f k a - Nothing -> pure m -{-# INLINE traverseAtMax #-} diff --git a/src/Data/Monoid/Lens.hs b/src/Data/Monoid/Lens.hs --- a/src/Data/Monoid/Lens.hs +++ b/src/Data/Monoid/Lens.hs @@ -79,11 +79,11 @@ -- | Isomorphism for 'All' -- -- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable --- >>> au _all foldMap [True,True] +-- >>> ala _all foldMap [True,True] -- True -- -- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable --- >>> au _all foldMap [True,False] +-- >>> ala _all foldMap [True,False] -- False _all :: Simple Iso Bool All _all = iso All getAll @@ -92,11 +92,11 @@ -- | Isomorphism for 'Any' -- -- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable --- >>> au _any foldMap [False,False] +-- >>> ala _any foldMap [False,False] -- False -- -- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable --- >>> au _any foldMap [True,False] +-- >>> ala _any foldMap [True,False] -- True _any :: Simple Iso Bool Any _any = iso Any getAny @@ -105,7 +105,7 @@ -- | Isomorphism for 'Sum' -- -- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable --- >>> au _sum foldMap [1,2,3,4] +-- >>> ala _sum foldMap [1,2,3,4] -- 10 _sum :: Iso a b (Sum a) (Sum b) _sum = isos Sum getSum Sum getSum @@ -114,7 +114,7 @@ -- | Isomorphism for 'Product' -- -- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable --- >>> au _product foldMap [1,2,3,4] +-- >>> ala _product foldMap [1,2,3,4] -- 24 _product :: Iso a b (Product a) (Product b) _product = isos Product getProduct Product getProduct 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 @@ -19,7 +19,7 @@ ) where import Control.Applicative -import Control.Lens as Lens +import Control.Lens as Lens hiding ((|>)) import Data.Monoid import Data.Sequence as Seq diff --git a/src/Data/Set/Lens.hs b/src/Data/Set/Lens.hs --- a/src/Data/Set/Lens.hs +++ b/src/Data/Set/Lens.hs @@ -45,6 +45,6 @@ -- setOf :: 'Simple' 'Lens' a c -> a -> 'Set' c -- setOf :: 'Ord' c => 'Simple' 'Traversal' a c -> a -> 'Set' c -- @ -setOf :: Getting (Set c) a c -> a -> Set c +setOf :: Getting (Set c) a b c d -> a -> Set c setOf l = runAccessor . l (Accessor . Set.singleton) {-# INLINE setOf #-} diff --git a/tests/doctests.hs b/tests/doctests.hs new file mode 100644 --- /dev/null +++ b/tests/doctests.hs @@ -0,0 +1,28 @@ +module Main where + +import Test.DocTest +import System.Directory +import System.FilePath +import Control.Applicative +import Control.Monad +import Data.List + +main :: IO () +main = getSources >>= \sources -> doctest $ + "-isrc" + : "-idist/build/autogen" + : "-optP-include" + : "-optPdist/build/autogen/cabal_macros.h" + : sources + +getSources :: IO [FilePath] +getSources = filter (isSuffixOf ".hs") <$> go "src" + where + go dir = do + (dirs, files) <- getFilesAndDirectories dir + (files ++) . concat <$> mapM go dirs + +getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) +getFilesAndDirectories dir = do + c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir + (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c diff --git a/tests/hunit.hs b/tests/hunit.hs new file mode 100644 --- /dev/null +++ b/tests/hunit.hs @@ -0,0 +1,274 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Control.Lens +import Control.Monad.State +import Data.Char +import Data.List as List +import Data.List.Lens +import Data.Map as Map +import Test.Framework.Providers.HUnit +import Test.Framework.TH +import Test.Framework +import Test.HUnit + +-- The code attempts to enumerate common use cases rather than give an example +-- of each available lens function. The tests here merely scratch the surface +-- of what is possible using the lens package; there are a great many use cases +-- (and lens functions) that aren't covered. +-- +-- Here are some use cases that are not covered: +-- * In the state monad, access some field(s), apply monadic function(s) and +-- access the result. +-- * In the state monad, modify some field(s) by applying a monadic rather than +-- a pure function to them. + +data Point = + Point + { _x :: Int -- ^ X coordinate + , _y :: Int -- ^ Y coordinate + } deriving (Show, Eq, Ord) + +makeLenses ''Point + +data Box = + Box + { _low :: Point -- ^ The lowest used coordinates. + , _high :: Point -- ^ The highest used coordinates. + } deriving (Show, Eq) + +makeLenses ''Box + +data Polygon = + Polygon + { _points :: [ Point ] + , _labels :: Map Point String + , _box :: Box + } deriving (Show, Eq) + +makeLenses ''Polygon + +origin = + Point { _x = 0, _y = 0 } + +vectorFrom fromPoint toPoint = + Point + { _x = toPoint^.x - fromPoint^.x + , _y = toPoint^.y - fromPoint^.y + } + +trig = + Polygon + { _points = [ Point { _x = 0, _y = 0 } + , Point { _x = 4, _y = 7 } + , Point { _x = 8, _y = 0 } ] + , _labels = fromList [ (Point { _x = 0, _y = 0 }, "Origin") + , (Point { _x = 4, _y = 7 }, "Peak") ] + , _box = Box { _low = Point { _x = 0, _y = 0 } + , _high = Point { _x = 8, _y = 7 } } + } + +case_read_record_field = + (trig^.box.high.y) + @?= 7 + +case_read_state_record_field = + runState test trig @?= (7, trig) + where + test = use $ box.high.y + +-- TODO: Having to write @. to@ all the time isn't nice. In an ideal world, +-- we'd be able to avoid the @to@. If at all possible, this would require heavy +-- type wizardry, as the default behavior of @f . g@ is already defined to work +-- in the other way than we need. + +case_read_record_field_and_apply_function = + (trig^.points.to last.to (vectorFrom origin).x) + @?= 8 + +case_read_state_record_field_and_apply_function = + runState test trig @?= (8, trig) + where test = use $ points.to last.to (vectorFrom origin).x + +case_write_record_field = + (trig |> box.high.y .~ 6) + @?= trig { _box = (trig |> _box) + { _high = (trig |> _box |> _high) + { _y = 6 } } } + +case_write_state_record_field = do + let trig' = trig { _box = (trig |> _box) + { _high = (trig |> _box |> _high) + { _y = 6 } } } + runState test trig @?= ((), trig') + where + test = box.high.y .= 6 + +case_write_record_field_and_access_new_value = + (trig |> box.high.y <.~ 6) + @?= (6, trig { _box = (trig |> _box) + { _high = (trig |> _box |> _high) + { _y = 6 } } }) + +case_write_state_record_field_and_access_new_value = do + let trig' = trig { _box = (trig |> _box) + { _high = (trig |> _box |> _high) + { _y = 6 } } } + runState test trig @?= (6, trig') + where + test = box.high.y <.= 6 + +-- case_write_record_field_and_access_old_value = +-- (trig |> box.high.y <<.~ 6) +-- @?= (7, trig { _box = (trig |> _box) +-- { _high = (trig |> _box |> _high) +-- { _y = 6 } } }) +-- +-- case_write_state_record_field_and_access_old_value = do +-- let trig' = trig { _box = (trig |> _box) +-- { _high = (trig |> _box |> _high) +-- { _y = 6 } } } +-- runState test trig @?= (7, trig') +-- where +-- test = box.high.y <<.= 6 + +case_modify_record_field = + (trig |> box.low.y %~ (+ 2)) + @?= trig { _box = (trig |> _box) + { _low = (trig |> _box |> _low) + { _y = ((trig |> _box |> _low |> _y) + 2) } } } + +case_modify_state_record_field = do + let trig' = trig { _box = (trig |> _box) + { _low = (trig |> _box |> _low) + { _y = ((trig |> _box |> _low |> _y) + 2) } } } + runState test trig @?= ((), trig') + where + test = box.low.y %= (+ 2) + +case_modify_record_field_and_access_new_value = + (trig |> box.low.y <%~ (+ 2)) + @?= (2, trig { _box = (trig |> _box) + { _low = (trig |> _box |> _low) + { _y = ((trig |> _box |> _low |> _y) + 2) } } }) + +case_modify_state_record_field_and_access_new_value = do + let trig' = trig { _box = (trig |> _box) + { _low = (trig |> _box |> _low) + { _y = ((trig |> _box |> _low |> _y) + 2) } } } + runState test trig @?= (2, trig') + where + test = box.low.y <%= (+ 2) + +-- case_modify_record_field_and_access_old_value = +-- (trig |> box.low.y <<%~ (+ 2)) +-- @?= (0, trig { _box = (trig |> _box) +-- { _low = (trig |> _box |> _low) +-- { _y = ((trig |> _box |> _low |> _y) + 2) } } }) +-- +-- case_modify_state_record_field_and_access_old_value = do +-- let trig' = trig { _box = (trig |> _box) +-- { _low = (trig |> _box |> _low) +-- { _y = ((trig |> _box |> _low |> _y) + 2) } } } +-- runState test trig @?= (0, trig') +-- where +-- test = box.low.y <<%= (+ 2) + +case_modify_record_field_and_access_side_result = do + runState test trig @?= (8, trig') + where + test = box.high %%= modifyAndCompute + modifyAndCompute point = + (point ^. x, point |> y +~ 2) + trig' = trig { _box = (trig |> _box) + { _high = (trig |> _box |> _high) + { _y = ((trig |> _box |> _high |> _y) + 2) } } } + +case_increment_record_field = + (trig |> box.low.y +~ 1) -- And similarly for -~ *~ //~ ^~ ^^~ **~ ||~ &&~ + @?= trig { _box = (trig |> _box) + { _low = (trig |> _box |> _low) + { _y = ((trig |> _box |> _low |> _y) + 1) } } } + +case_increment_state_record_field = + runState test trig @?= ((), trig') + where + test = box.low.y += 1 + trig' = trig { _box = (trig |> _box) + { _low = (trig |> _box |> _low) + { _y = ((trig |> _box |> _low |> _y) + 1) } } } + +case_append_to_record_field = + (trig |> points ++~ [ origin ]) + @?= trig { _points = (trig |> _points) ++ [ origin ] } + +case_append_to_state_record_field = do + runState test trig @?= ((), trig') + where + test = points ++= [ origin ] + trig' = trig { _points = (trig |> _points) ++ [ origin ] } + +case_append_to_record_field_and_access_new_value = + (trig |> points <++~ [ origin ]) + @?= (_points trig ++ [ origin ], trig { _points = (trig |> _points) ++ [ origin ] }) + +case_append_to_state_record_field_and_access_new_value = do + runState test trig @?= (_points trig ++ [ origin ], trig') + where + test = points <++= [ origin ] + trig' = trig { _points = (trig |> _points) ++ [ origin ] } + +-- case_append_to_record_field_and_access_old_value = +-- (trig |> points <<++~ [ origin ]) +-- @?= (_points trig, trig { _points = (trig |> _points) ++ [ origin ] }) +-- +-- case_append_to_state_record_field_and_access_old_value = do +-- runState test trig @?= (_points trig, trig') +-- where +-- test = points <<++= [ origin ] +-- trig' = trig { _points = (trig |> _points) ++ [ origin ] } + +case_read_maybe_map_entry = trig^.labels.at origin @?= Just "Origin" + +case_read_maybe_state_map_entry = + runState test trig @?= (Just "Origin", trig) + where test = use $ labels.at origin + +case_read_map_entry = trig^.labels.traverseAt origin @?= "Origin" + +case_read_state_map_entry = runState test trig @?= ("Origin", trig) + where test = use $ labels.traverseAt origin + +case_modify_map_entry = + (trig |> labels.traverseAt origin %~ List.map toUpper) + @?= trig { _labels = fromList [ (Point { _x = 0, _y = 0 }, "ORIGIN") + , (Point { _x = 4, _y = 7 }, "Peak") ] } + +case_insert_maybe_map_entry = + (trig |> labels.at (Point { _x = 8, _y = 0 }) .~ Just "Right") + @?= trig { _labels = fromList [ (Point { _x = 0, _y = 0 }, "Origin") + , (Point { _x = 4, _y = 7 }, "Peak") + , (Point { _x = 8, _y = 0 }, "Right") ] } + +case_delete_maybe_map_entry = + (trig |> labels.at origin .~ Nothing) + @?= trig { _labels = fromList [ (Point { _x = 4, _y = 7 }, "Peak") ] } + +case_read_list_entry = + (trig^.points.element 0) + @?= origin + +case_write_list_entry = + (trig |> points.element 0 .~ Point { _x = 2, _y = 0 }) + @?= trig { _points = [ Point { _x = 2, _y = 0 } + , Point { _x = 4, _y = 7 } + , Point { _x = 8, _y = 0 } ] } + +case_write_through_list_entry = + (trig |> points.element 0 . x .~ 2) + @?= trig { _points = [ Point { _x = 2, _y = 0 } + , Point { _x = 4, _y = 7 } + , Point { _x = 8, _y = 0 } ] } + +main :: IO () +main = defaultMain [$testGroupGenerator] diff --git a/tests/properties.hs b/tests/properties.hs new file mode 100644 --- /dev/null +++ b/tests/properties.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Main where + +import Control.Applicative +import Control.Monad +import Control.Lens +import Data.Functor.Identity +import System.Exit +import Test.QuickCheck +import Test.QuickCheck.All +import Test.QuickCheck.Function +import Data.Text.Strict.Lens + +setter_id :: Eq a => Simple Setter a b -> a -> Bool +setter_id l a = runIdentity (l Identity a) == a + +setter_composition :: Eq a => Simple Setter a b -> a -> Fun b b -> Fun b b -> Bool +setter_composition l a (Fun _ f) (Fun _ g) = mapOf l f (mapOf l g a) == mapOf l (f . g) a + +lens_set_view :: Eq a => Simple Lens a b -> a -> Bool +lens_set_view l a = set l (view l a) a == a + +lens_view_set :: Eq b => Simple Lens a b -> a -> b -> Bool +lens_view_set l a b = view l (set l b a) == b + +setter_set_set :: Eq a => Simple Setter a b -> a -> b -> b -> Bool +setter_set_set l a b c = set l c (set l b a) == set l c a + +iso_hither :: Eq a => Simple Iso a b -> a -> Bool +iso_hither l a = a ^.l.from l == a + +iso_yon :: Eq b => Simple Iso a b -> b -> Bool +iso_yon l b = b^.from l.l == b + +isSetter :: (Arbitrary a, Arbitrary b, CoArbitrary b, Show a, Show b, Eq a, Function b) + => Simple Setter a b -> Property +isSetter l = setter_id l .&. setter_composition l .&. setter_set_set l + +isTraversal :: (Arbitrary a, Arbitrary b, CoArbitrary b, Show a, Show b, Eq a, Function b) + => Simple Traversal a b -> Property +isTraversal l = isSetter l + +isLens :: (Arbitrary a, Arbitrary b, CoArbitrary b, Show a, Show b, Eq a, Eq b, Function b) + => Simple Lens a b -> Property +isLens l = lens_set_view l .&. lens_view_set l .&. isTraversal l + +isIso :: (Arbitrary a, Arbitrary b, CoArbitrary a, CoArbitrary b, Show a, Show b, Eq a, Eq b, Function a, Function b) + => Simple Iso a b -> Property +isIso l = iso_hither l .&. iso_yon l .&. isLens l .&. isLens (from l) + +-- an illegal lens +bad :: Simple Lens (Int,Int) Int +bad f (a,b) = (,) b <$> f a + +badIso :: Simple Iso Int Bool +badIso = iso even fromEnum + +-- Control.Lens.Type +prop_1 = isLens (_1 :: Simple Lens (Int,Double,()) Int) +prop_2 = isLens (_2 :: Simple Lens (Int,Bool) Bool) +prop_3 = isLens (_3 :: Simple Lens (Int,Bool,()) ()) +prop_4 = isLens (_4 :: Simple Lens (Int,Bool,(),Maybe Int) (Maybe Int)) +prop_5 = isLens (_5 :: Simple Lens ((),(),(),(),Int) Int) + +prop_2_2 = isLens (_2._2 :: Simple Lens (Int,(Int,Bool),Double) Bool) + +prop_illegal_lens = expectFailure $ isLens bad +prop_illegal_traversal = expectFailure $ isTraversal bad +prop_illegal_setter = expectFailure $ isSetter bad +prop_illegal_iso = expectFailure $ isIso badIso + +-- Control.Lens.Setter +prop_mapped = isSetter (mapped :: Simple Setter [Int] Int) +prop_mapped_mapped = isSetter (mapped.mapped :: Simple Setter [Maybe Int] Int) + +prop_both = isTraversal (both :: Simple Traversal (Int,Int) Int) +prop_value (Fun _ k :: Fun Int Bool) = isTraversal (value k :: Simple Traversal (Int,Int) Int) +prop_traverseLeft = isTraversal (traverseLeft :: Simple Traversal (Either Int Bool) Int) +prop_traverseRight = isTraversal (traverseRight:: Simple Traversal (Either Int Bool) Bool) + +-- Data.Text.Lens +prop_text s = s^.packed.from packed == s + +main :: IO () +main = do + b <- $quickCheckAll + unless b $ exitWith (ExitFailure 1) diff --git a/tests/templates.hs b/tests/templates.hs new file mode 100644 --- /dev/null +++ b/tests/templates.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE TemplateHaskell #-} +-- | The commented code summarizes what will be auto-generated below +module Main where + +import Control.Lens +-- import Test.QuickCheck (quickCheck) + +-- newtype Foo a = Foo a +-- makeIso ''Foo +-- foo :: Iso a b (Foo a) (Foo b) + +data Bar a b c = Bar { _baz :: (a, b) } +makeLenses ''Bar +-- baz :: Lens (Bar a b c) (Bar a' b' c) (a,b) (a',b') + +data Quux a b = Quux { _quaffle :: Int, _quartz :: Double } +makeLenses ''Quux +-- quaffle :: Lens (Quux a b) (Quux a' b') Int Int +-- quartz :: Lens (Quux a b) (Quux a' b') Double Double + +data Quark a = Qualified { _gaffer :: a } + | Unqualified { _gaffer :: a, _tape :: a } +makeLenses ''Quark +-- gaffer :: Simple Lens (Quark a) a +-- tape :: Simple Traversal (Quark a) a + +data Hadron a b = Science { _a1 :: a, _a2 :: a, _b :: b } +makeLenses ''Hadron +-- a1 :: Simple Lens (Hadron a b) a +-- a2 :: Simple Lens (Hadron a b) a +-- b :: Lens (Hadron a b) (Hadron a b') b b' + +data Perambulation a b + = Mountains { _terrain :: a, _altitude :: b } + | Beaches { _terrain :: a, _dunes :: a } +makeLenses ''Perambulation +-- terrain :: Simple Lens (Perambulation a b) a +-- altitude :: Traversal (Perambulation a b) (Parambulation a b') b b' +-- dunes :: Simple Traversal (Perambulation a b) a +makeLensesFor [("_terrain", "allTerrain"), ("_dunes", "allTerrain")] ''Perambulation +-- allTerrain :: Traversal (Perambulation a b) (Perambulation a' b) a a' + +data LensCrafted a = Still { _still :: a } + | Works { _still :: a } +makeLenses ''LensCrafted +-- still :: Lens (LensCrafted a) (LensCrafted b) a b + +data Danger a = Zone { _highway :: a } + | Twilight +makeLensesWith (partialLenses .~ True $ buildTraversals .~ False $ lensRules) ''Danger +-- highway :: Lens (Danger a) (Danger a') a a' + +data Task a = Task + { taskOutput :: a -> IO () + , taskState :: a + , taskStop :: IO () + } + +makeLensesFor [("taskOutput", "outputLens"), ("taskState", "stateLens"), ("taskStop", "stopLens")] ''Task + +data Mono = Mono { _monoFoo :: Int, _monoBar :: Int } +makeClassy ''Mono +-- class HasMono t where +-- mono :: Simple Lens t Mono +-- instance HasMono Mono where +-- mono = id +-- monoFoo :: HasMono t => Simple Lens t Int +-- monoBar :: HasMono t => Simple Lens t Int + +data Nucleosis = Nucleosis { _nuclear :: Mono } +makeClassy ''Nucleosis +-- class HasNucleosis t where +-- nucleosis :: Simple Lens t Nucleosis +-- instance HasNucleosis Nucleosis +-- nuclear :: HasNucleosis t => Simple Lens t Mono + +instance HasMono Nucleosis where + mono = nuclear + +main :: IO () +main = putStrLn "test/templates.hs: ok"