lens-4.14/0000755000000000000000000000000012710476104010573 5ustar0000000000000000lens-4.14/.gitignore0000644000000000000000000000021212710476104012556 0ustar0000000000000000dist/ .hsenv/ docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# .cabal-sandbox/ cabal.sandbox.config .stack-work/ codex.tags lens-4.14/.travis.yml0000644000000000000000000001042512710476104012706 0ustar0000000000000000# This file has been generated -- see https://github.com/hvr/multi-ghc-travis language: c sudo: false cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar matrix: include: - env: CABALVER=1.18 GHCVER=7.4.2 compiler: ": #GHC 7.4.2" addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.18 GHCVER=7.6.3 compiler: ": #GHC 7.6.3" addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.18 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.22 GHCVER=7.10.3 compiler: ": #GHC 7.10.3" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=8.0.1 compiler: ": #GHC 8.0.1" addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=head compiler: ": #GHC head" addons: {apt: {packages: [cabal-install-1.24,ghc-head,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} allow_failures: - env: CABALVER=1.24 GHCVER=head before_install: - unset CC - export HAPPYVER=1.19.5 - export ALEXVER=3.1.7 - export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH install: # build reflection HEAD until reflection 2.1 is on hackage - git clone https://github.com/ekmett/reflection.git - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; fi - travis_retry cabal update - "sed -i 's/^jobs:.*$/jobs: 2/' $HOME/.cabal/config" - cabal install --only-dependencies --enable-tests --dry -v lens.cabal reflection/ > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then echo "cabal build-cache HIT"; rm -rfv .ghc; cp -a $HOME/.cabsnap/ghc $HOME/.ghc; cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; else echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; cabal install --only-dependencies --enable-tests lens.cabal reflection/; if [ "$GHCVER" = "7.10.3" ]; then cabal install Cabal-1.22.4.0; fi; fi # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then echo "snapshotting package-db to build-cache"; mkdir $HOME/.cabsnap; cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi # NB: we don't want reflection/ to be included in the cache - cabal install reflection/ # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - cabal configure --enable-tests -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests) - cabal test - cabal sdist # tests that a source-distribution can be generated # Check that the resulting source distribution can be built & installed. # If there are no other `.tar.gz` files in `dist`, this can be even simpler: # `cabal install --force-reinstalls dist/*-*.tar.gz` - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ") notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313lens\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f" # EOF lens-4.14/.vim.custom0000644000000000000000000000141412710476104012700 0ustar0000000000000000" Add the following to your .vimrc to automatically load this on startup " if filereadable(".vim.custom") " so .vim.custom " endif function StripTrailingWhitespace() let myline=line(".") let mycolumn = col(".") silent %s/ *$// call cursor(myline, mycolumn) endfunction " enable syntax highlighting syntax on " search for the tags file anywhere between here and / set tags=TAGS;/,codex.tags;/ " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗ set list " f2 runs hasktags map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving " au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" lens-4.14/AUTHORS.markdown0000644000000000000000000000612612710476104013471 0ustar0000000000000000Lens started as a one man project by * [Edward Kmett](mailto:ekmett@gmail.com) [@ekmett](https://github.com/ekmett) But it has been greatly enriched by opening it up to community development. Many people have contributed patches, documentation, wiki pages, bug reports, test cases and massive quantities of code to `lens` including (among others): * [Shachaf Ben-Kiki](mailto:shachaf@gmail.com) [@shachaf](https://github.com/shachaf) * Elliott Hird [@ehird](https://github.com/ehird) * [Johan Kiviniemi](mailto:lens@johan.kiviniemi.name) [@ion1](https://github.com/ion1) * [Bas Dirks](mailto:ik@basdirks.eu) [@basdirks](https://github.com/basdirks) * [Eric Mertens](mailto:emertens@gmail.com) [@glguy](https://github.com/glguy) * [Michael Sloan](mailto:mgsloan@gmail.com) [@mgsloan](https://github.com/mgsloan) * [Alexander Altman](mailto:alexanderaltman@me.com) [@phtariensflame](https://github.com/phtariensflame) * [Austin Seipp](mailto:mad.one@gmail.com) [@thoughtpolice](https://github.com/thoughtpolice) * [Dag Odenhall](mailto:dag.odenhall@gmail.com) [@dag](https://github.com/dag) * [Aristid Breitkreuz](mailto:aristidb+lens@gmail.com) [@aristidb](https://github.com/aristidb) * [Simon Hengel](mailto:sol@typeful.net) [@sol](https://github.com/sol) * [@startling](https://github.com/startling) * [Mike Ledger](mailto:eleventynine@gmail.com) [@mikeplus64](https://github.com/mikeplus64) * [Niklas Haas](mailto:niklas.haas@uni-ulm.de) [@nandykins](https://github.com/nandykins) * [Adrian Keet](mailto:arkeet@gmail.com) [@arkeet](https://github.com/arkeet) * [Matvey B. Aksenov](mailto:matvey.aksenov@gmail.com) [@supki](https://github.com/supki) * [Eyal Lotem](mailto:eyal.lotem+github@gmail.com) [@Peaker](https://github.com/Peaker) * [Oliver Charles](mailto:ollie@ocharles.org.uk) [@ocharles](https://github.com/ocharles) * Liyang HU [@liyang](https://github.com/liyang) * [Carter Schonwald](mailto:carter.schonwald@gmail.com) [@cartazio](https://github.com/cartazio) * [Mark Wright](mailto:gienah@gentoo.org) [@markwright](https://github.com/markwright) * [Nathan van Doorn](mailto:nvd1234@gmail.com) [@Taneb](https://github.com/Taneb) * Ville Tirronen [@aleator](https://github.com/aleator) * [Mikhail Vorozhtsov](mailto:mikhail.vorozhtsov@gmail.com) [@mvv](https://github.com/mvv) * [Brent Yorgey](mailto:byorgey@gmail.com) [@byorgey](https://github.com/byorgey) * [Dan Rosén](mailto:danr@chalmers.se) [@danr](https://github.com/danr) * Yair Chuchem [@yairchu](https://github.com/yairchu) * [Michael Thompson](mailto:what_is_it_to_do_anything@yahoo.com) [@michaelt](https://github.com/michaelt) * [John Wiegley](mailto:johnw@newartisans.com) [@jwiegley](https://github.com/jwiegley) * [Jonathan Fischoff](mailto:jfischoff@yahoo.com) [@jfischoff](https://github.com/jfischoff) * [Bradford Larsen](mailto:brad.larsen@gmail.com) [@bradlarsen](https://github.com/bradlarsen) You can watch them carry on the quest for bragging rights in the [contributors graph](https://github.com/ekmett/lens/graphs/contributors). Omission from this list is by no means an attempt to discount your contributions! Thank you for all of your help! -Edward Kmett lens-4.14/cabal.project0000644000000000000000000000001412710476104013220 0ustar0000000000000000packages: . lens-4.14/CHANGELOG.markdown0000644000000000000000000012536712710476104013644 0ustar00000000000000004.14 ---- * Remove `Cons` and `Snoc` instances for `NonEmpty`. 4.13.2.1 ------ * Fixed `itraverse_` and `imapM_` returning bottom 4.13.2 ------ * Restore default signature for `Control.Lens.At.at` * Improve operations for `Data.Sequence.Seq` * Fix `declarePrisms` behavior on GHC 8 using GADT record syntax 4.13.1 ------ * Modified to enable the `doctests` to build with `stack`. * Removed `.ghci`. * Added `lookupOf` * Support GHC 8 * Support `transformers` 0.5 * Support `kan-extensions` 5 * Support `comonad` 5 * Better support for `Closed` from `profunctors`. 4.13 ---- * Pattern synonyms * Moved `foldMapBy` and `foldBy` into `reflection` 2.1 * Added `traverseByOf`, `sequenceByOf`. * Reexported `traverseBy` and `sequenceBy` from `reflection` 2.1. * Modified the signatures of `alaf` and `auf` to work with a `Functor` rather than a `Profunctor` and rather drastically generalized them. * Removed `Control.Lens.Internal.Getter.coerce` in favor of the upstream `phantom` combinator in `contravariant` 1.3+ * Renamed `coerced` to `phantasm` to get it out of the way. * Added `Wrapped` instance for `Down` 4.12.3 ------ * Move `Review` and `AReview` to `Control.Lens.Type` fixing a bug in `makePrisms` * Expose `HasTypes` class in `Language.Haskell.TH.Lens` * Make types of `foldByOf` and `foldMapByOf` more specific to hide implementation details * Add Prisms to `Language.Haskell.TH` for new constructors in `template-haskell-2.10` * Generalize type of `_FunDep` to an `Iso` 4.12.2 ------ * Incorporated a bug fix for `foldByOf` and `foldMapByOf` to actually let them work on folds. * Added a `Plated` instance for `CofreeT` 4.12.1 ------ * The `Simple` type alias is now poly-kinded. This lets you use `Simple Field1 s a` and the like in constraints. * Added `HasTypes` to `Language.Haskell.TH.Lens`. * Support for `vector-0.11.0` which changes `Stream` to `Bundle` 4.12 ---- * `reflection 2` support. 4.11.2 ------ * Give `cosmosOn` a more general type. 4.11.1 ------ * Added `cosmos`, `cosmosOf`, `cosmosOn`, `cosmosOnOf` to `Control.Lens.Plated`. * Added `icontains`, `iat`, `iix`. * Made various documentation improvements. * Added a `test-templates` flag. 4.11 ---- * Proper `profunctors` 5.1 support. This extended the superclass constraints for `Conjoined`, so it resulted in a major version bump. 4.10 ---- * Added `elemIndexOf`, `elemIndicesOf`, `findIndexOf`, and `findIndicesOf`. * Fixed `Ixed` instance for `Tree`. It no longer drops nodes prior to the traversed node. * `bifunctors` 5, `profunctors` 5 and `semigroupoids` 5 support. 4.9.1 ----- * Added `_Wrapped` support for `NonEmpty`. * Added `_Wrapped` support for `Alt`. * Fixed `Rewrapped` instance for `Last`. 4.9 ------- * `filepath` 1.4 support * Removed `Control.Monad.Primitive.Lens` and shed the `primitive` dependency. * Add missing `_WithIndex` instances from `keys` package * Much more code is inferred `Safe` rather than `Trustworthy`. * Documented the difference between `unsafeSingular` and `singular`. * `folding` now produces an actual `Fold`. * Cleaned up builds for GHC 7.10 to get rid of redundant import warnings. 4.8 --- * When built with `profunctors` 4.4 on GHC 7.8+ we no longer need to use `unsafeCoerce` at all! This drastically reduces the level of trust involved in the way we have optimized `lens`. * Added `fusing`. This optimizes long `Lens` chains, by enfocing a form of `fmap` fusion based on the Yoneda lemma. This is particularly effective at making faster lenses the definition is recursive or complex enough that it cannot be inlined. * Added `confusing`. This optimizes long `Traversal` chains. As with `fusing` it is best used when the definition for the `Traversal` chain in question is recursive or complex enough that it cannot be inlined, but the implementation is much more confusing. * Remove deprecated stuff: `Control.Lens.Loupe`, `headOf`, `makeFieldsWith`, `strippingPrefix`, `strippingSuffix` * Added `Cons` and `Snoc` instances for `NonEmpty` * Removed `Data.List.Split.Lens` module * Reimplemented `bytestring` traversals to avoid internal modules * Added `gplate`, an implementation of `plate` for any type implementing `Generic` * Strictness revisited * Add `generateLazyPatterns` configuration flag to `makeLenses` rules. * Make the default `makeLenses` behavior to generate STRICT optics * Add strict variants of `_1` .. `_9` named `_1'` .. `_9'` * Generalized some combinators in `Data.Vector.Generic.Lens` and added `converted` 4.7 --- * Migrated `Control.Lens.Action` to `lens-action`. * Added `Data.Vector.Generic.Lens.vectorIx` function for indexing vectors with only `Vector` constraint. * Added `Field1` and `Field2` instances for `Data.Functor.Product.Product`. * Removed the "typeclass synonym" `Gettable`. * Added new flag to `makeLenses`, `generateUpdateableOptics`, which allows the generation of only `Getter`s and `Fold`s. This feature is intended to be used when the constructors are hidden behind validating, "smart" constructors. * Fixed Template Haskell name generation when using GHC 7.10 * Fixed Template Haskell generation of classes methods where field types used existential quantification 4.6.0.1 [maintenance release] ------- * Compatibility with `base` 4.8 [Edit: this turned out to not work for the final release of GHC 7.10] 4.6 --- * Reduced `Review` to two arguments, like `Getter`. * Added `abbreviatedFields` to permit `makeFieldsWith` to be invoked with an argument that lets it act like it did pre-4.5 and accept arbitrary common prefixes. 4.5 --- * Provide access to the typename in `lensRules` naming function. * `makeFields` camelcasing rules now properly support types with camelcasing. `MyType` with field `myTypeFieldA` generates `fieldA` now. Previously the prefix ignore capitalization and the field would need to be named `mytypeFieldA`. * `makeClassy` works on types even when none of the fields would generate optics. * Added `Monad`, `MonadReader`, `MonadPlus` and `Bind` instances for `ReifiedMonadicFold` * Added missing fixity declarations on many operators. * Migrated `Codec.Compression.Zlib.Lens` to `zlib-lens` package. 4.4.0.2 --- * `text` 1.2.0.0 support * Remove the use of the TemplateHaskell extension from the library to enable lens to be used on stage1 cross-compilers 4.4.0.1 ---- * Restore previous default of `makeFields` using the camel case field namer. 4.4 ---- * Internals of Template Haskell code generation rewritten. makeLenses, makeClassy, and makeFields have been unified into the same generator. * TH generated single constructor Lens use irrefutable pattern matching to enable construction starting with undefined. * TH generated traverals unify their field arguments (type synonyms not currently expanded) enabling exotic traversals to be generated. * Added instances for `Text` to `Data.Aeson.Lens` * Reimplemented `makePrisms`, adding support for `makeClassyPrisms`, infix constructrs generate periods (.) prefixed prisms. * Added `Choice` to `Review` so that `Prism` is a proper subtype of `Review` * Migrated `Data.Aeson.Lens` to `lens-aeson` package. * Fixed `GHC.Generics.Lens.tinplate` behavior on single-field data types and empty data types. 4.3.3 ----- * `semigroupoids` 4.2 support 4.3.2 ----- * `contravariant` 1.0 support 4.3.1 ----- * Added `bytewise` to `Data.Bits` 4.3 --- * Switched the "direction" of the `Iso` argument to `au` to match the order generated by `makePrisms` and `makeLenses`. * Removed `makeIsos` in favor of `makePrisms` and `makeLenses`. Each of these functions will construct `Iso`s when appropriate. * Removed `declareIsos` in favor of `declarePrisms` and `declareLenses`. Each of these functions will construct `Iso`s when appropriate. * Added `matching` for type-changing matches with `Prism`s. * Added `withPrism` for recovering the functions passed to `prism`. * Added `negated`, the isomorphism for the `negate` function. 4.2 --- * Added `_Text` isomorphisms to make the proper use with `(#)` more obvious and fit newer convention. * Added `Wrapped` instances for `Vector` types * Resolved issue #439. The various `Prism`s for string-like types in `Data.Aeson.Lens` are now law-abiding `Prism`s "up to quotient." * Added `selfIndex`. * Support `attoparsec` 0.12. 4.1.2 ----- * When used with `exceptions` 0.4, `throwingM` will permit use with a mere `MonadThrow`. 4.1.1 ---- * Generalized the types of `mapping`, `bimapping`, `contramapping`, `dimapping`, `lmapping`, `rmapping` to support changing the `Functor`, `Bifunctor`, `Contravariant`, and `Profunctor` respectively. * Compatibility with `free` 4.6 4.1 --- * Added `Plated` instances for various free monad variants. * Compatibility with GHC HEAD (7.9+) 4.0.7 ----- * Removed dependency on `constraints`. It was used in a pre-release version of 4.0 but never made it into 4.0, but the dependency had remained around complicating builds for GHC 7.4. 4.0.6 ----- * `makeLenses` attempt to make the accessors it can under existential quantification. * Added `(&~)`. * _Experimental_ support for parallel builds on GHC 7.8 with `cabal install lens -fj`. Due to at last one known issue with GHC, it isn't recommended to use this option when rebuilding lens, as a race condition on at least one platform has been seen in the wild. * Added `RoleAnnotations` for GHC 7.8.1. These rule out a few user-accessible bottoms that could be caused by creative abuse of the new `Coercible` machinery. However, there was no `unsafeCoerce` exposed. * Removed some impossible cases that required unwritable instances from the example doctypes. 4.0.5 ----- * Added `bimapping` to `Control.Lens.Iso` * Restored correct behavior of `makePrism` on types with a single constructor. * `makeLenses` now generates `Getter`s and `Fold`s on universally quantified fields. 4.0.4 ----- * Made `declareFields` work again. 4.0.3 ----- * Fixed random segfaulting when using `foldMapBy`. 4.0.2 ----- * Properly bundled the modules needed for the properties test suite into the tarball for hackage. 4.0.1 ----- * Typo fixes * Exporting `Rewrapping` from `Control.Lens.Wrapped`. * Removed the dependency on `cpphs`. 4.0 ---- * Added `nearly` to `Control.Lens.Prism`. * Added `Control.Lens.Empty`, exporting `_Empty`. * We now require `DefaultSignatures`. * Added `failing` and `ifailing` to `Control.Lens.Traversal`. * Changed the signature of `Data.List.Split.Lens.condensing` due to the addition of `DropBlankFields` to `Data.List.Split.CondensePolicy` in `split`. * Simplified `Each`, `Ixed`, and `Contains`. They are no longer indexed. The previous design was actively getting in the way of user-defined instances. * Replaced more of our home-grown types with standard ones. They had previously been defined to help make more intelligible error messages, but when we switched to using `(Contravariant f, Functor f)` instead of `(Gettable f)`, these ceased to really help. Now you can define even more `lens`-compatible types (e.g. `Getter` and `Fold`) without depending on `lens`. * Replaced the use of `Accessor` with `Const`. * Replaced the use of `Mutator` with `Identity`. * Replaced the use of `Reviewed` with `Tagged`. * Removed the deprecated `Control.Lens.Simple` module. * Repurposed `Control.Lens.Combinators` to re-export `Control.Lens` sans any operators; previous residents rehomed to `Control.Lens.Lens`. * Added `Control.Lens.Operators` to export just the operators. Varying your import styles between these supports many qualified usage scenarios. * Simplified `Cons` and `Snoc`. Now they must be a `Prism`. * Simplified `Contains`. This necessitated losing many instancs of `Contains`, but makes it much easier and more consistent to use and instantiate. * Simplified the various `AsFoo` types in `Control.Exception.Lens` * Simplified the types in `System.IO.Error.Lens`. * Merged `lens-aeson` into `lens`. * We're exiling `Control.Lens.Zipper` to a separate package. This will let the design for it iterate faster and let us explore the trade-offs between the 3.8 style and the 3.9 style of zippers. * Generalized `alongside`, `inside`, `both`. * Switched to a new `Typeable` version of `reflection` for the harder combinators in `Control.Exception.Lens`. This enables us to comply with GHC 7.7's ban on hand-written `Typeable` instances. * Added a `_Show` `Prism`. * Added `Control.Lens.Extras` for the combinator names we don't have the gall to claim outright, but which are consistent with the rest. * Renamed the constructors for `ReifiedLens`, etc. to just be the name of their base type. * Added many many missing instances for `ReifiedFold` and `ReifiedGetter`. This permits things like `runFold ((,) <$> Fold (traverse._1) <*> Fold (traverse._2))` to be a `Fold` and `ReifiedFold` can be used as a `Monad`, `Profunctor`, etc. * Many performance optimizations. * Switched to `exceptions` from `MonadCatchIO-transformers` * Added types for working with `RelevantFold` and `RelevantTraversal`. These are a `Fold` or `Traversal` that always has at least one target. Since `Apply` isn't a superclass of `Applicative`, you occasionally need to convert between them, but it lets you more readily work with less unsafety. * Changed `unwrapping` and `wrapping` to have the same constructor-oriented order as a `Prism` and renamed them t `_Wrapping` and `_Unwrapping` respectively. * Drastically changed the way `_Wrapping` and `_Unwrapping` are built to get much better inference. * There are about 15,000 lines of patches over the last year, so I'm sure we missed a few big changes. 3.10.1 [maintenance release] ------ * Compatibility with `base` 4.7 3.10.0.1 [maintenance release] -------- * Compatibility with `text` 1.0 3.10 ---- * Switched to `bifunctors`, `comonad`, `profunctors`, and `semigroupoids` 4.0. 3.9.2 ----- * Generalized signatures for `throwing` and `throwingM`. 3.9.1 ----- * 'condensingPolicy' was updated to work with 'split' 0.2.2 3.9.0.3 ------- * Bumped dependency on `generic-deriving` again. 3.9.0.2 ------- * Bumped dependency on `generic-deriving` to enable building on GHC HEAD. 3.9.0.1 ------- * Updated the field guide image to link to imgur. Sadly the overview haddock and the haddocks are not generated in the same directory, so the haddock hook for copying the image only works locally. 3.9 ----- * Changed `Getting` to take 3 arguments instead of 5. If you need the old behavior for portability you can use `Overloaded (Accessor r) s t a b` instead of `Getting r s t a b` and it'll work consistently back through the last few releases. * Added `involuted` to `Control.Lens.Iso`. * Factored out a common `reversed` definition from all the various forms of it around the library and placed it in `Control.Lens.Iso`. * Added `binary`, `octal`, `decimal` and `hex` to `Numeric.Lens`. * Added `sans` to `Control.Lens.At`. * Improved interoperability: * Reimplemented `Gettable` as an alias for `Contravariant` and `Functor` together to derive `Getter` and `Fold`. This means you can now implement a `Getter` or `Fold` with only a Haskell 98 dependency (`contravariant`). * Removed `Reviewable`. We now use `Bifunctor` and `Profunctor` together to derive `Review`. This means you can now implement a `Review` with Haskell 98 dependencies (`profunctors` and `bifunctors`). * These changes enables more types to be defined without incurring a dependency on the `lens` package. 3.8.7.0-3.8.7.3 [maintenance releases] ----- * Fixes to dependencies and pragmas. 3.8.6 [maintenance release] ----- * Fixed an issue with `DefaultSignatures` being used outside of the appropriate `#ifdef` that caused compilation issues on GHC 7.0.2. * Generalized the signature of `prism'` * Added `\_Void` and `only` to `Control.Lens.Prism` and `devoid` to `Control.Lens.Lens`. * Added `\_Nothing` to `Control.Lens.Prism`. * Added `devoid` and `united` to `Control.Lens.Lens`. 3.8.5 ----- * Fixed more sporadic issues in doctests, caused by carrying flags from `$setup` between modules. 3.8.4 ----- * Renamed `strippingPrefix` to `prefixed`, `strippingSuffix` to `suffixed`. Left the old names as deprecated aliases. * Fixed issues with the test suite caused by `doctests` carrying flags from the `$setup` block between modules. * Benchmarks now use `generic-deriving` rather than `ghc-prim` directly, like the rest of the package. * Added `Generics.Deriving.Lens`, which is now simply re-exported from `GHC.Generics.Lens`. 3.8.3 ----- * Added `strippingSuffix` and `stripSuffix` to `Data.Data.Lens` * Added `unpackedBytes` and `unpackedChars` to `Data.ByteString.*.Lens` * Added `unpacked` to `Data.Text.*.Lens` * Added `(#)` as an infix form of `review` to ease using a `Prism` like a smart constructor in `Control.Lens.Review`. 3.8.2 ----- * Added a notion of `Handleable(handler, handler_)` to `Control.Exception.Lens` to facilitate constructing a `Handler` from an arbitrary `Fold` or `Prism`. * Added a notion of `Handler` and `catches` to and `Control.Monad.Error.Lens` to mirror the `Control.Exception` and `Control.Monad.CatchIO` constructions. * Added additional doctests and documentation. * Improved error messages and support for types with arguments in `makeFields`. 3.8.1 ----- * Fixed a bug in `makeFields` in hierarchical modules. 3.8.0.2 ------- * Fixed an issue with running the `doctests` test suite when an older version of `semigroups` is installed. 3.8 --- * Overall: * Replaced each of the different `SimpleFoo` type aliases with `Foo'` throughout. The various `Simple` aliases can still be found in `Control.Lens.Simple` but are now deprecated. * Made sweeping changes to `Iso` and `Prism` and `Indexed` lenses internally. They are now based on `profunctors`. This affects how you use `indexed` in the resulting code and dramatically changed the meaning of `Overloaded`. * Generalized combinators to pass through indices unmodified wherever possible and added indexed variants to existing combinators. There are hundreds of these changes and they would swamp this list. * `Control.Exception.Lens` * This module was created to add combinators and prisms that make it possible to work with GHC's extensible exceptions and monad transformer stacks more easily. There are knock-on changes in `Data.Dynamic.Lens`, `System.Exit.Lens`, and `System.IO.Error.Lens`. * `Control.Lens.At` * Moved `At(at)` and `Contains(contains)` and factored out `Ixed(ix)`. * Deprecated `_at` and `resultAt`. * Removed various `ordinal` and `ix` combinators, which are subsumed by `Ixed(ix)`. * `Control.Lens.Cons` * Consoldiated the various `_head`, `_tail`, `_init` and `_last` traversals that were scattered around the place into a pair of `Cons` and `Snoc` classes that provide `_Cons` and `_Snoc` prisms respectively, and combinators that build on top. * `Control.Lens.Each` * Generalized the signature of `Each` to permit it to provide an `IndexedSetter` for `((->) e)`. * `Each` now uses an `Index` type family that is shared with `At`, `Ixed` and `Contains` to indicate these operations are related. * `Control.Lens.Equality` * Added as a stronger form of `Iso` that can be used to safely cast. * Added the adverb `simply`, which can be used to simplify the types of most combinators in the library so they only take a simple lens, simple traversal, etc as their first argument instead. e.g. `simply view` forces `a ~ b`, `s ~ t` in the argument to `view`. * `Control.Lens.Fold` * Added `foldr1Of'` and `foldl1Of'`. * Added `has` and `hasn't`. * `Control.Lens.Indexed` * The various indexed combinators for each type were distributed to their respective modules. This module grew to encompass the remaining index-specifics. * Added `index` and `indices`, and removed `iwhere` and `iwhereOf`. Use `itraversed.indices even` and `bar.indices (>3)` instead. * `Control.Lens.Internal` * This module was exploded into more manageable component modules. * `Control.Lens.Iso` * `Strict(strict)` is now a `Simple Iso`. * Added `magma` and `imagma` which can be used to provide a 'debugging view' of a `Traversal`. * `Control.Lens.Lens` * Restructuring split this module out from `Control.Lens.Type` and merged the contents `Control.Lens.IndexedLens`. * `Control.Lens.Level` * This module was created to provide the breadth-first-search Traversals `levels` and `ilevels` which can be used to do (optionally depth-limited) breadth-first searches through arbitrary traversals reaching all leaves at finite depth in finite time. To use these in full accordance with the laws you should restrict yourself to commutative operations and finite containers, but they are useful even in the absence of these properties. * `Control.Lens.Loupe` * In the interest of consistency, the `Loupe` alias has been deprecated in favor of `ALens`. * `Loupe` (and `ALens`) are now defined in terms of `Pretext` rather than `Context`. This permits them to be cloned at a reduced cost reducing the call for `ReifiedLens`. * `Control.Lens.Operators` * Added this module for users who insist on qualified use, but want access to the operators. They can `import qualified Control.Lens as Lens` and `import Control.Lens.Operators` unqualified. * `Control.Lens.Prism` * Added `prism'` to construct `SimplePrism`s. * `Control.Lens.Reified` * Consolidated the various `ReifiedFoo` definitions into one module. * `Control.Lens.Representable` * This module was removed. Its functionality may be split out into a separate package, but currently the `linear` package exports is own `Linear.Core` module to provide this functionality. It was taking lots of useful names for little functionality and didn't feel like the rest of the API. * `Control.Lens.Review` * This module now factors the `review` functionality out of `Prism` and exposes `unto`, which is to `review` what `to` is to `view`. * `Control.Lens.Setter` * Added `contramapped` and `argument` for mapping over inputs. * `Control.Lens.Simple` * Removed the infix lens aliases and repurposed the module to house the now deprecated `SimpleFoo` type aliases, which were replaced universally with `Foo'`. * `Control.Lens.TH` * `makeLenses` now generates `Lens'` and `Traversal'` where appropriate * Added `makePrisms` as a generalized `makeIso` that automatically generates a `Prism` for each constructor. `makePrisms` generates names with an `_Foo` convention. This was consolidated upon throughout the library to reduce namespace conflicts between prisms and lenses. * Added `makeFields`, which generates classes for each individual field in a data type. * Added `makeWrapped`, which automatically generates a `Wrapped` instance for a newtype. * `Control.Lens.Type` * This module was repurposed to provide a single home for all the standard lens-like type aliases used when producing lenses. You still need to go to their respective modules to find the types for consuming lens-likes if you want to generate your own lens combinators * `Control.Lens.Wrapped` * Added `wrapped'` and `unwrapped'` for scenarios where you need the help with type inference. * `Control.Lens.Zipper` * Converted `Zipper` to walk a magma based on the original structure and to use indices from indexed traversals when restoring from tape. This also means that when zipping around within a balanced structure with ascending keys `moveTo` can operate in logarithmic time, but required changing the `Zipper` type to add the index type. * `Data.Bits.Lens` * Added `byteAt`. * `Data.ByteString.Lens` * `Data.ByteString.Lazy.Lens` now uses `Int64`-based indexing. * The `Traversal` for strict `ByteStrings` now construct a balanced tree up to a given grain size. This permits zipper based seeking to operate in logarithmic time and speeds up many traversals. * `Numeric.Lens` * Created. `base` shows and reads integers at base-2 through base-36. `integral` can be used as a safe `fromInteger`/`toInteger`. 3.7.6 [maintenance release] ----- * Fixed an issue with the `Complex` `Each` instance. 3.7.5 [maintenance release] ----- * Fixed an errant `LANGUAGE` pragma 3.7.4 [maintenance release] ----- * Backported the API for `ALens` and `ALens'` to support `snap` builds on old platforms. 3.7.3 [maintenance release] ----- * Removed my intra-package dependency upper bounds for my own packages. In particular this enables us to work with `semigroups` 0.9. * Switched to `transformers-compat` to avoid having unbuilding modules at the top of the documentation, and to ease 3rd party compatibility. * Updated `Setup.lhs` to be compatible with Cabal 1.17 3.7.2 [maintenance release] ----- * Bug fix for `Magnify`. It was missing functional dependencies to determine its `k` parameter from `m` or `n`. 3.7.1.2 [maintenance release] ------- * Made the doctest test suite hide all but the exact versions of packages used to build this package to avoid problems with complicated user environments. * Removed doctests based on `:t` as they are fragile and break across GHC versions. * Fixed GHC 7.0.4 compatibility by guarding `DefaultSignatures` in `Control.Lens.Each`. 3.7.1.1 [maintenance release] ------- * Removed tests that will (likely) fail in the presence of `hashable` 1.2 3.7.1 ----- * Added `preuse`, `preuses` to `Control.Lens.Fold` * Added `Each(each)` to `Control.Lens.Each` for indexed traversal of potentially monomorphic containers. * Added `indexing64` and `traversed64` for help with large containers. * Generalized the type signature of `choosing`. * Exported `unwrapped` from `Control.Lens.Wrapped`. * Support for `hashable` 1.2 * Added `(??)` to `Control.Lens.Combinators`. 3.7.0.2 ------- * Fixed flagging for Safe Haskell. * Fixed examples. * Cleaned up the statement of the Prism laws. 3.7.0.1 ------- * Corrected bounds for hashable. * Fixed compatibility with Haskell Platform 2011.4.0.0 -- you may have to install with --constraint="transformers = 0.2.2.0" to avoid getting new mtl and transformer versions installed. [3.7](https://github.com/ekmett/lens/issues?milestone=11&page=1&state=closed) ----- * Renamed `Projection` to `Prism`. * Implemented a complete redesign of the way `Iso` and `Prism` are handled internally. Any `Iso` can now be used as a `Prism`. * The `isos` combinator is no longer required. `iso` can now be used to construct an `Iso`. * Changes to the signature of `from` and `under` were necessitated by the new design. * Added `Control.Lens.Wrapped` providing a canonical isomorphism for newtypes. * Repurposed `ala` to be closer to the original design in `newtype`, but added `au` and `alaf`. * Added `_magnitude`, `_phase` and `_conjugate` to `Data.Complex.Lens`. Renamed other lenses for consistency: `_realPart`, `_imagPart`, `_polar`. * Promoted `_left` and `_right` to prisms and moved them to `Control.Lens.Prism`. * Generalized `view` and `views` to subsume the old functionality of `peruse` and `peruses`. * Generalized `review` and `reviews` to both return a `MonadReader` and to work on a `Projection`. * Added `view'`/`views'` and `use'`/`uses'` for `Simple` access to the environment/state. * Added `set'`, a `Simple` version of `set`. * Added `reuse` : `use` :: `review` : `view` and `reuses` : `uses` :: `reviews` : `views` for working a `Projection` from the current `MonadState`. * Removed many isomorphisms for various newtypes. `_const`, `identity`, `_sum`, etc. Use `wrapping Const`, `wrapping Identity`, etc. * Removed `Data.Monoid.Lens` now that its newtypes are instances of `Wrapped`, exporting the (`<>=`)-variants from `Control.Lens.*`. * Renamed `via` to `cloneIso` for consistency. * Moved `Indexed(..)` to `Control.Lens.Classes`. * Renamed `index` to `indexed` to reduce conflicts with third-party libraries. * Added `curried` and `uncurried` to `Control.Lens.Iso`. * Added `Strict(strict)` for ad hoc overloading of conversions between strict and lazy variants of `ByteString` and `Text`. * Bug fixes for `tugTo` and `jerkTo`. * These no longer traverse in the wrong direction: `scanl1Of`, `scanr1Of`, `mapAccumLOf`, and `mapAccumROf`. * Added `anon` to `Control.Lens.Iso`. * Generalized the types of the `Control.Lens.Zipper` combinators to work with other MonadPlus instances. * Added `withins` to `Control.Lens.Zipper` now that they can work better with []. * Added `singular` and `unsafeSingular` to `Control.Lens.Traversal` to assert a `Traversal` is a `Lens`, a `Fold` is a `Getter` or a `MonadicFold` is an `Action`. * Generalized `sequenceAOf_`'s type to match `sequenceA_`. * Renamed `up`/`down`/`left`/`right` to `upward`/`downward`/`leftward`/`rightward` to reduce conflicts -- in particular with `Control.Arrow`. * Readded `leftmost` and `rightmost` due to the verbosity of `farthest leftward`/`farthest rightward`. * Added `preview`/`previews`/`firstOf` and deprecated `headOf`. * Added `iview`/`iviews`/`iuse`/`iuses` to `Control.Lens.IndexedGetter`. * We've generalized the type of Bazaar and provided generalized variants of `partsOf`, etc. that used it. 3.6.0.4 [maintenance release] ------- * Added support for `test-framework` 0.8 3.6.0.3 [maintenance release] ------- * Added support for `test-framework` 0.7 3.6.0.2 [maintenance release] ------- * Added more explicit dependencies to the doctest suite. * Disabled the 'expected failure' quickcheck tests that occasionally would fail with internal QuickCheck errors. 3.6.0.1 [maintenance release] ------- * Added explicit dependency on containers and unordered-containers to the doctest suite [3.6](https://github.com/ekmett/lens/issues?milestone=9&state=closed) --- * Added `upon` (along with variants of it) to `Data.Data.Lens`, which can be used to generate a `Traversal` from a field accessor or any function that returns, unmodified, a single field that would be visited by `template`. * Added some missing `examples/` files to the distribution. * Renamed `Data.Bits.Lens.traverseBits` to `bits`. * Removed `(^!?)`, which was an alias for `(^?!)`. * Removed the need for `Trustworthy` by changing the implementation of `coerce` for `BazaarT`. * Moved BazaarT to `Control.Lens.Internal`. * Added `(<&>)` to `Control.Lens.Combinators`. * `element` and `elementOf` are now indexed traversals rather than lenses and have moved to `Control.Lens.IndexedTraversal`. This both fixes their former partiality and lets you use chain indexed combinators with them. * Added `elements` and `elementsOf` as indexed traversals for ordinal indexing into regular traversals that generalize `element` and `elementOf`. * Renamed `Data.Complex.Lens.traverseComplex` to `complex`. * Changed `Data.Complex.Lens.polarize` to a `Simple Iso`, due to the `RealFloat` constraint causing inference problems. * Renamed `traverseLeft` and `traverseRight` to `_left` and `_right` respectively. * Renamed `traverseSlice`, `traverseFrom`, and `traverseTo` in `Data.Sequence.Lens` to `sliced`, `slicedFrom`, and `slicedTo` respectively. * Renamed `traverseAt` to `_at` in `Control.Lens.IndexedTraversal`. * Renamed `traverseArray` to `_array` in `Data.Array.Lens`. * Renamed and made the combinators in `Control.Lens.Zipper` more compositional to reduce third-party naming conflicts down to just `left` and `right`. * Renamed `&=` and `|=` to `.&.=` and `.|.=` for consistency, mutatis mutandis their related operations. * Added a `Plated` instances for `Language.Haskell.TH` types. * Renamed `atIndex` and `atIndices` in `Data.Vector.Lens` and `Data.Vector.Generic.Lens` to `ordinal` and `ordinals` to match `Data.Sequence.Lens` 3.5.1 ----- * Improved SafeHaskell inference. [3.5](https://github.com/ekmett/lens/issues?milestone=8&state=closed) --- * Fixed a potential SafeHaskell issue where a user could use `undefined` to derive `unsafeCoerce`. You now have to import an explicitly Unsafe module and create an instance of `Trustworthy` for your type to cause this behavior, so if you do, it's on your head, not mine. :) * Renamed `EvilBazaar` to `BazaarT`. * Moved a lot of internals around. Most notably, `Gettable`, `Settable` and `Effective` have moved to `Control.Lens.Classes`. * Exposed `partsOf'` and `unsafePartsOf'` in `Control.Lens.Traversal` to reduce reliance on `BazaarT` in `Control.Lens.Zipper` [3.4](https://github.com/ekmett/lens/issues?milestone=7&state=closed) --- * Renamed `(%)` to `(&)` and `(^%)` to `(^&)`. This avoids the conflict with `Data.Ratio`, which was our highest priority conflict with a third party library. * Switched to a more liberal type for `ignored` * Removed some "`isplitting`" bad combinators from `Control.Lens.IndexedFold`. * Made `indexed`, `taking`, and `dropping` and `elementOf` lazier and capable of dealing with infinite traversals and infinite folds. * Improved `Indexing` to support infinite traversals and folds. * Removed some of the more redundant combinators from `Control.Lens.Plated`, which already had existing aliases in the rest of the traversal API. * Moved `partsOf`, `holesOf`, and `elementOf` into `Control.Lens.Traversal`. * Renamed `query` to `peruse` and `queries` to `peruses`. These are much less contentious names, both contain `use` in their name for analogy to `use` and `uses` and the word is about reading. * Simpler `simple`. * Added `enum` and `non` to `Control.Lens.Iso`. * Added `(^?!)` to `Control.Lens.Fold` for unsafe access to the head of a `Fold`. * Changed `_head`, `_tail`, `_init` and `_last` to traversals in `Data.List.Lens` and `Data.Sequence.Lens`. * Eliminated `traverseHead`, `traverseTail`, `traverseInit` and `traverseLast`. * `partsOf` and `unsafePartsOf` can now also be applied to a `Fold` yielding a `Getter` or to a `MonadicFold` yielding an `Action`. 3.3 --- * Redefined `simple` and moved it to `Control.Lens.Iso`. Instead of using `simple l` you can now compose `l.simple` or `simple.l` providing more nuanced control and a more compositional API. * Moved the various `foo#` combinators used to emit cleaner core into an unexported module, `Control.Lens.Unsafe`. This removes `MagicHash` from the public API. * Removed the `bazaar#` and `runBazaar#` coercions that caused issues on GHC HEAD. * Changed the default definition of `plate` to `uniplate` from `ignored`. * Added `Data.Vector.Lens` and instances for `Data.Vector`. * Added support for the `split` package, which is now part of the Haskell platform. * Removed redundant `Data.List.traverseList`. Use `itraversed` or `traverse` instead. * Moved `(:<->)` to `Control.Lens.Simple`. * Fixed a bug in `Control.Lens.TH` that was causing `makeIso` not to work. * Added `lifted` to `Control.Lens.Setter` for mapping over monads. * Added `beside` to `Control.Lens.Traversal`. * Removed the operators from `Data.List.Lens`, they broke the overall pattern of the rest of the API, and were terrible clutter. * Fixed a bug that caused `resultAt` to give wrong answers most of the time. * Changed `resultAt` to an `IndexedLens` and moved it to `Control.Lens.IndexedLens` * Changed `ignored` to an `IndexedTraversal` and moved it to `Control.Lens.IndexedTraversal` * We've relinquished the name `value`. 3.2 --- * Made `elementOf` lazier and moved it from `Control.Lens.Traversal` to `Control.Lens.Plated`. * Made `holesOf` and `partsOf` lazier to deal with infinite structures. * Resolved issue #75. We now generate nicer core for most `Setter` and `Fold` operations, and some others. * Made lenses for field access like `_1`, `_2`, etc. lazier. * Added `Control.Lens.Loupe`, which provides a limited form of `Lens` that can be read from and written to and which can compose with other lenses, but can also be returned in a list or as a monadic result, but cannot be used directly for most combinators without cloning it first. It is easier to compose than a `ReifiedLens`, but slightly slower. * Moved (`:=>`) and (`:->`) into `Control.Lens.Simple`, which is not exported by `Control.Lens` by default to reduce name conflicts with third party libraries. 3.1 --- * Simplified the type of `filtered`, so that it can be composed with other folds rather than be parameterized on one. Included the caveat that the new `filtered` is still not a legal `Traversal`, despite seeming to compose like one. * Renamed `ifiltered` to `ifiltering`, and while it still must take an indexed lens-like as an argument, I included a similar caveat about the result not being a legal `IndexedLens` when given an `IndexedLens`. The function was renamed because its signature no longer lined up with the new `filtered` and the gerundive '-ing' suffix has come to indicate an operator that transformers another lens/traversal/etc. into a new one. * Added `taking` and `dropping` to `Control.Lens.Traversal`. 3.0.6 ----- * Alpha-renamed all combinators to a new scheme. Instead of `Foo a b c d`, they now follow `Foo s t a b`. This means that you don't need to alpha rename everything in your head to work through the examples, simplifies exposition, and uses s and t for common state monad parameters. Thanks go to Shachaf Ben-Kiki for the grunt work of slogging through hundreds of definitions by hand and with regular expressions! * Restored lenses to `Trustworthy` status so they can be used with Safe Haskell once more. 3.0.5 ----- * Fixed a bug in `rights1` and `lefts1` in `Control.Lens.Zipper` which would cause them to loop forever when given a 0 offset. 3.0.4 ----- * Added `?~`, ``, `:=>`, and `:<->` as type operator aliases for `Simple Lens`, `Simple Traversal`, and `Simple Iso` respectively. [2.9](https://github.com/ekmett/lens/issues?milestone=5&state=closed) --- * Added `<<%~`, `<<.~`, `<<%=` and `<<.=` for accessing the old values targeted by a `Lens` (or a summary of those targeted by a `Traversal`) * Renamed `|>` to `%`, as `%~` is the lensed version of `%`, and moved it to `Control.Lens.Getter` along with a version `^%` with tighter precedence that can be interleaved with `^.` * Upgraded to `doctest` 0.9, which lets us factor out common `$setup` for our doctests * Renamed `merged` to `choosing`. Added a simpler `chosen` operation to mirror `both`. * Added `Control.Lens.Projection` * Renamed `traverseException` to `exception` and `traverseDynamic` to `dynamic`, upgrading them to use `Projection`. * `makeClassy` now places each generated `Lens` or `Traversal` inside the class it constructs when possible. This makes it possible for users to just export `HasFoo(..)`, rather than have to enumerate each lens in the export list. It can only do that if it creates the class. If the `createClass` flag is disabled, then it will default to the old behavior. * Added `performs` to `Control.Lens.Action` to mirror `views` in `Control.Lens.Getter`. [2.8](https://github.com/ekmett/lens/issues?milestone=4&state=closed) --- * Restored compatibility with GHC 7.2. This required a major version bump due to making some MPTC-based default signatures conditional. 2.7.0.1 ------- * Added the missing `Control.Lens.Combinators` to exported-modules! Its absence was causing it not to be included on hackage. [2.7](https://github.com/ekmett/lens/issues?milestone=3&state=closed) --- * 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](https://github.com/ekmett/lens/issues?milestone=2&state=closed) --- * Added build option `-f-inlining` to facilitate building with the various TH 2.8 versions used by GHC 7.6 and HEAD. * Added build option `-f-template-haskell` for testing without template haskell. (Users should be able to assume TH is enabled; use this only for testing!) * Added support for generating a `Traversal` rather than a `Lens` when multiple fields map to the same name or some constructors are missing a field. * Removed `_` from the lens names in `System.FilePath.Lens`. * Added `iwhere`, `withIndices`, `withIndicesOf`, `indices` and `indicesOf` to ease work with indexed traversals * Added `assign` as an alias for `(.=)` in `Control.Lens.Setter`. * Added `~:`, `=:`, `<~:` and `<=:` to `Data.List.Lens` [2.5](https://github.com/ekmett/lens/issues?milestone=1&state=closed) --- * Added `Control.Lens.Plated`, a port of Neil Mitchell's `uniplate` that can be used on any `Traversal`. * Added `Data.Data.Lens` with smart traversals that know how to avoid traversing parts of a structure that can't contain a given type. * Added `Data.Typeable.Lens` with `_cast` and `_gcast` like `traverseData` * Renamed `IndexedStore` to `Context` now that it is used in user-visible locations, and since I also use it as `uniplate`'s notion of a context. * Renamed `Kleene` to `Bazaar` -- "a bazaar contains a bunch of stores." * Added `Comonad` instances for `Context` and `Bazaar`, so we can use stores directly as the notion of an editable context in uniplate * Compatibility with both sets of template haskell quirks for GHC 7.6.1-rc1 and the GHC 7.6.1 development head. * Renamed `children` to `branches` in `Data.Tree.Lens`. * Added `At` and `Contains` to `Control.Lens.IndexedLens`. * Added `FunctorWithIndex`, `FoldableWithIndex`, and `TraversableWithIndex` under `Control.Lens.WithIndex` * Added support for `unordered-containers`. 2.4.0.2 ------- * GHC 7.6.1 development HEAD compatibility (but broke 7.6.1-rc1) 2.4.0.1 ------- * Haddock cleanup 2.4 ----- * Added the indexed `Kleene` store to `Control.Lens.Internal` * Moved `Gettable`, `Accessor`, `Settable` and `Mutator` to `Control.Lens.Internal` * Added `cloneTraversal` to `Control.Lens.Traversal` * Renamed `clone` to `cloneLens` in `Control.Lens.Type` * Generalized the type of `zoom` to subsume `focus`. * Removed `Focus(..)` from `Control.Lens.Type`. * Factored out `Control.Lens.Isomorphic`. * Moved many private types to `Control.Lens.Internal` * Added `conFields` to `Language.Haskell.TH.Lens`. * Added `System.FilePath.Lens`. 2.3 --- * Added missing `{-# INLINE #-}` pragmas * Renamed `meanwhile` to `throughout` in `Control.Parallel.Strategies.Lens` * Added `Magnify` to `Control.Lens.Getter`. * Added `Zoom` to `Control.Lens.Type`. 2.2 --- * Added `<&=`, `<&~`, `<|=`, and `<|~` * Moved `<>~`, `<<>~`, `<>=`, and `<<>=` to `Data.Monoid.Lens` * Template Haskell now uses eager binding to avoid adding dependencies. 2.1 --- * Renamed `adjust` to `over` * Added `au`, `auf` and `under` * Added `Data.Monoid.Lens` * Increased lower dependency bound on `mtl` for cleaner installation. lens-4.14/HLint.hs0000644000000000000000000000154412710476104012151 0ustar0000000000000000import "hint" HLint.HLint ignore "Reduce duplication" ignore "Redundant lambda" ignore "Use >=>" ignore "Use const" -- Used hlint --find src/ in the lens repo to generate this: infixl 9 :> infixr 9 <.>, <., .>, ... infixr 9 #. infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?! infixl 8 ^., ^@. infixl 8 ^# infixl 8 .# infixr 8 ^!, ^@! infixr 4 ~, <~, <.>~, <<.>~ infixr 4 <#~, #~, #%~, <#%~, #%%~ infixr 4 .|.~, .&.~, <.|.~, <.&.~ infixr 4 %@~, .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, <>~, ||~, %~ infixr 4 %%@~, <%@~, %%~, <+~, <*~, <-~, =, <=, <.>=, <<.>= infix 4 <#=, #=, #%=, <#%=, #%%= infix 4 .|.=, .&.=, <.|.=, <.&.= infix 4 %@=, .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, <>=, ||=, %= infix 4 %%@=, <%@=, %%=, <+=, <*=, <-=, , ?? lens-4.14/lens.cabal0000644000000000000000000003424712710476104012532 0ustar0000000000000000name: lens category: Data, Lenses, Generics version: 4.14 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/lens/ bug-reports: http://github.com/ekmett/lens/issues copyright: Copyright (C) 2012-2016 Edward A. Kmett build-type: Custom -- build-tools: cpphs tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2, GHC == 8.0.1 synopsis: Lenses, Folds and Traversals description: This package comes \"Batteries Included\" with many useful lenses for the types commonly used from the Haskell Platform, and with tools for automatically generating lenses and isomorphisms for user-supplied data types. . The combinators in @Control.Lens@ provide a highly generic toolbox for composing families of getters, folds, isomorphisms, traversals, setters and lenses and their indexed variants. . An overview, with a large number of examples can be found in the . . An introductory video on the style of code used in this library by Simon Peyton Jones is available from . . A video on how to use lenses and how they are constructed is available on . . Slides for that second talk can be obtained from . . More information on the care and feeding of lenses, including a brief tutorial and motivation for their types can be found on the . . A small game of @pong@ and other more complex examples that manage their state using lenses can be found in the . . /Lenses, Folds and Traversals/ . With some signatures simplified, the core of the hierarchy of lens-like constructions 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 linked to above it. . The result is their lowest upper bound in the hierarchy (or an error if that bound doesn't exist). . For instance: . * You can use any 'Traversal' as a 'Fold' or as a 'Setter'. . * The composition of a 'Traversal' and a 'Getter' yields a 'Fold'. . /Minimizing Dependencies/ . If you want to provide lenses and traversals for your own types in your own libraries, then you can do so without incurring a dependency on this (or any other) lens package at all. . /e.g./ for a data type: . > data Foo a = Foo Int Int a . You can define lenses such as . > -- bar :: Lens' (Foo a) Int > bar :: Functor f => (Int -> f Int) -> Foo a -> f (Foo a) > bar f (Foo a b c) = fmap (\a' -> Foo a' b c) (f a) . > -- quux :: Lens (Foo a) (Foo b) a b > quux :: Functor f => (a -> f b) -> Foo a -> f (Foo b) > quux f (Foo a b c) = fmap (Foo a b) (f c) . without the need to use any type that isn't already defined in the @Prelude@. . And you can define a traversal of multiple fields with 'Control.Applicative.Applicative': . > -- traverseBarAndBaz :: Traversal' (Foo a) Int > traverseBarAndBaz :: Applicative f => (Int -> f Int) -> Foo a -> f (Foo a) > traverseBarAndBaz f (Foo a b c) = Foo <$> f a <*> f b <*> pure c . What is provided in this library is a number of stock lenses and traversals for common haskell types, a wide array of combinators for working them, and more exotic functionality, (/e.g./ getters, setters, indexed folds, isomorphisms). extra-source-files: .travis.yml .gitignore .vim.custom cabal.project examples/LICENSE examples/lens-examples.cabal examples/*.hs examples/*.lhs images/*.png lens-properties/CHANGELOG.markdown lens-properties/LICENSE lens-properties/Setup.hs travis/cabal-apt-install travis/config HLint.hs AUTHORS.markdown CHANGELOG.markdown README.markdown SUPPORT.markdown source-repository head type: git location: https://github.com/ekmett/lens.git -- Enable benchmarking against Neil Mitchell's uniplate library for comparative performance analysis. Defaults to being turned off to avoid -- the extra dependency. -- -- > cabal configure --enable-benchmarks -fbenchmark-uniplate && cabal build && cabal bench flag benchmark-uniplate default: False manual: True -- Generate inline pragmas when using template-haskell. This defaults to enabled, but you can -- -- > 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. flag inlining manual: True default: True -- Some 7.6.1-rc1 users report their TH still uses old style inline pragmas. This lets them turn on inlining. flag old-inline-pragmas default: False manual: True -- Make the test suites dump their template-haskell splices. flag dump-splices default: False manual: True -- You can disable the hlint test suite with -f-test-hlint flag test-hlint default: True manual: True -- You can disable the doctests test suite with -f-test-doctests flag test-doctests default: True manual: True -- You can disable the hunit test suite with -f-test-hunit flag test-hunit default: True manual: True -- Build the properties test if we're building tests flag test-properties default: True manual: True flag test-templates default: True manual: True -- Disallow unsafeCoerce flag safe default: False manual: True -- Assert that we are trustworthy when we can flag trustworthy default: True manual: True -- Attempt a parallel build with GHC 7.8 flag j default: False manual: True library build-depends: array >= 0.3.0.2 && < 0.6, base >= 4.5 && < 5, base-orphans >= 0.3 && < 1, bifunctors >= 5 && < 6, bytestring >= 0.9.1.10 && < 0.11, comonad >= 4 && < 6, contravariant >= 1.3 && < 2, containers >= 0.4.0 && < 0.6, distributive >= 0.3 && < 1, filepath >= 1.2.0.0 && < 1.5, free >= 4 && < 5, ghc-prim, hashable >= 1.1.2.3 && < 1.3, kan-extensions >= 5 && < 6, exceptions >= 0.1.1 && < 1, mtl >= 2.0.1 && < 2.3, parallel >= 3.1.0.1 && < 3.3, profunctors >= 5 && < 6, reflection >= 2.1 && < 3, semigroupoids >= 5 && < 6, semigroups >= 0.8.4 && < 1, tagged >= 0.4.4 && < 1, template-haskell >= 2.4 && < 2.12, text >= 0.11 && < 1.3, transformers >= 0.2 && < 0.6, transformers-compat >= 0.4 && < 1, unordered-containers >= 0.2.4 && < 0.3, vector >= 0.9 && < 0.12, void >= 0.5 && < 1 exposed-modules: Control.Exception.Lens Control.Lens Control.Lens.At Control.Lens.Combinators Control.Lens.Cons Control.Lens.Each Control.Lens.Empty Control.Lens.Equality Control.Lens.Extras Control.Lens.Fold Control.Lens.Getter Control.Lens.Indexed Control.Lens.Internal Control.Lens.Internal.Bazaar Control.Lens.Internal.ByteString Control.Lens.Internal.Coerce Control.Lens.Internal.Context Control.Lens.Internal.Deque Control.Lens.Internal.Exception Control.Lens.Internal.FieldTH Control.Lens.Internal.PrismTH Control.Lens.Internal.Fold Control.Lens.Internal.Getter Control.Lens.Internal.Indexed Control.Lens.Internal.Instances Control.Lens.Internal.Iso Control.Lens.Internal.Level Control.Lens.Internal.List Control.Lens.Internal.Magma Control.Lens.Internal.Prism Control.Lens.Internal.Review Control.Lens.Internal.Setter Control.Lens.Internal.TH Control.Lens.Internal.Zoom Control.Lens.Iso Control.Lens.Lens Control.Lens.Level Control.Lens.Operators Control.Lens.Plated Control.Lens.Prism Control.Lens.Reified Control.Lens.Review Control.Lens.Setter Control.Lens.TH Control.Lens.Traversal Control.Lens.Tuple Control.Lens.Type Control.Lens.Wrapped Control.Lens.Zoom Control.Monad.Error.Lens Control.Parallel.Strategies.Lens Control.Seq.Lens Data.Array.Lens Data.Bits.Lens Data.ByteString.Lens Data.ByteString.Strict.Lens Data.ByteString.Lazy.Lens Data.Complex.Lens Data.Data.Lens Data.Dynamic.Lens Data.HashSet.Lens Data.IntSet.Lens Data.List.Lens Data.Map.Lens Data.Sequence.Lens Data.Set.Lens Data.Text.Lens Data.Text.Strict.Lens Data.Text.Lazy.Lens Data.Tree.Lens Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens Generics.Deriving.Lens GHC.Generics.Lens System.Exit.Lens System.FilePath.Lens System.IO.Error.Lens Language.Haskell.TH.Lens Numeric.Lens other-modules: Paths_lens cpp-options: -traditional if flag(safe) cpp-options: -DSAFE=1 if flag(trustworthy) && impl(ghc>=7.2) other-extensions: Trustworthy cpp-options: -DTRUSTWORTHY=1 if flag(old-inline-pragmas) && impl(ghc>=7.6.0.20120810) cpp-options: -DOLD_INLINE_PRAGMAS=1 if flag(inlining) cpp-options: -DINLINING if impl(ghc<7.4) ghc-options: -fno-spec-constr-count -- hack around the buggy unused matches check for class associated types in ghc 8 rc1 if impl(ghc >= 8) ghc-options: -Wno-missing-pattern-synonym-signatures -Wno-unused-matches if flag(j) && impl(ghc>=7.8) ghc-options: -j4 ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10 hs-source-dirs: src -- Verify that Template Haskell expansion works test-suite templates type: exitcode-stdio-1.0 main-is: templates.hs ghc-options: -Wall -threaded hs-source-dirs: tests if flag(dump-splices) ghc-options: -ddump-splices if !flag(test-templates) buildable: False else build-depends: base, lens -- Verify the properties of lenses with QuickCheck test-suite properties type: exitcode-stdio-1.0 main-is: properties.hs other-modules: Control.Lens.Properties ghc-options: -w -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: tests lens-properties/src if !flag(test-properties) buildable: False else build-depends: base, lens, QuickCheck >= 2.4, test-framework >= 0.6, test-framework-quickcheck2 >= 0.2, test-framework-th >= 0.2, transformers test-suite hunit type: exitcode-stdio-1.0 main-is: hunit.hs ghc-options: -w -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: tests if !flag(test-hunit) buildable: False else build-depends: base, containers, HUnit >= 1.2, lens, mtl, test-framework >= 0.6, test-framework-hunit >= 0.2, test-framework-th >= 0.2 -- Verify the results of the examples test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests if flag(trustworthy) && impl(ghc>=7.2) other-extensions: Trustworthy cpp-options: -DTRUSTWORTHY=1 if !flag(test-doctests) || impl(ghc>=8) buildable: False else build-depends: base, bytestring, containers, directory >= 1.0, deepseq, doctest >= 0.9.1, filepath, generic-deriving, mtl, nats, parallel, semigroups >= 0.9, simple-reflect >= 0.3.1, text, unordered-containers, vector test-suite hlint type: exitcode-stdio-1.0 main-is: hlint.hs ghc-options: -w -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: tests if !flag(test-hlint) buildable: False else build-depends: base, hlint >= 1.9.27 -- Basic benchmarks for the uniplate-style combinators benchmark plated type: exitcode-stdio-1.0 main-is: plated.hs ghc-options: -Wall -O2 -threaded -fdicts-cheap -funbox-strict-fields hs-source-dirs: benchmarks build-depends: base, comonad, criterion, deepseq, generic-deriving, lens, transformers if flag(benchmark-uniplate) build-depends: uniplate >= 1.6.7 && < 1.7 cpp-options: -DBENCHMARK_UNIPLATE -- Benchmarking alongside variants benchmark alongside type: exitcode-stdio-1.0 main-is: alongside.hs ghc-options: -w -O2 -threaded -fdicts-cheap -funbox-strict-fields hs-source-dirs: benchmarks build-depends: base, comonad >= 4, criterion, deepseq, lens, transformers -- Benchmarking folds benchmark folds type: exitcode-stdio-1.0 main-is: folds.hs ghc-options: -w -O2 -threaded -fdicts-cheap -funbox-strict-fields hs-source-dirs: benchmarks build-depends: base, criterion, containers, bytestring, unordered-containers, vector, lens -- Benchmarking traversals benchmark traversals type: exitcode-stdio-1.0 main-is: traversals.hs ghc-options: -w -O2 -threaded -fdicts-cheap -funbox-strict-fields hs-source-dirs: benchmarks build-depends: base, criterion, containers, bytestring, unordered-containers, vector, lens -- Benchmarking unsafe implementation strategies benchmark unsafe type: exitcode-stdio-1.0 main-is: unsafe.hs ghc-options: -w -O2 -threaded -fdicts-cheap -funbox-strict-fields hs-source-dirs: benchmarks build-depends: base, comonad >= 4, criterion >= 1, deepseq, generic-deriving, lens, transformers lens-4.14/LICENSE0000644000000000000000000000266012710476104011604 0ustar0000000000000000Copyright 2012-2016 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. lens-4.14/README.markdown0000644000000000000000000001622412710476104013301 0ustar0000000000000000Lens: Lenses, Folds, and Traversals ================================== [![Hackage](https://img.shields.io/hackage/v/lens.svg)](https://hackage.haskell.org/package/lens) [![Build Status](https://secure.travis-ci.org/ekmett/lens.svg)](http://travis-ci.org/ekmett/lens) This package provides families of [lenses](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Type.hs), [isomorphisms](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Iso.hs), [folds](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Fold.hs), [traversals](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Traversal.hs), [getters](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Getter.hs) and [setters](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Setter.hs). If you are looking for where to get started, [a crash course video](http://youtu.be/cefnmjtAolY?hd=1) on how `lens` was constructed and how to use the basics is available on youtube. It is best watched in high definition to see the slides, but the [slides](http://comonad.com/haskell/Lenses-Folds-and-Traversals-NYC.pdf) are also available if you want to use them to follow along. The [FAQ](https://github.com/ekmett/lens/wiki/FAQ), which provides links to a large number of different resources for learning about lenses and an overview of the [derivation](https://github.com/ekmett/lens/wiki/Derivation) of these types can be found on the [Lens Wiki](https://github.com/ekmett/lens/wiki) along with a brief [overview](https://github.com/ekmett/lens/wiki/Overview) and some [examples](https://github.com/ekmett/lens/wiki/Examples). Documentation is available through [github](http://ekmett.github.com/lens/frames.html) (for HEAD) or [hackage](http://hackage.haskell.org/package/lens) for the current and preceding releases. Field Guide ----------- [![Lens Hierarchy](https://raw.githubusercontent.com/wiki/ekmett/lens/images/Hierarchy.png)](https://creately.com/diagram/h5nyo9ne1/QZ9UBOtw4AJWtmAKYK3wT8Mm1HM%3D) Examples -------- (See [`wiki/Examples`](https://github.com/ekmett/lens/wiki/Examples)) First, import `Control.Lens`. ```haskell ghci> import Control.Lens ``` Now, you can read from lenses ```haskell ghci> ("hello","world")^._2 "world" ``` and you can write to lenses. ```haskell ghci> set _2 42 ("hello","world") ("hello",42) ``` Composing lenses for reading (or writing) goes in the order an imperative programmer would expect, and just uses `(.)` from the `Prelude`. ```haskell ghci> ("hello",("world","!!!"))^._2._1 "world" ``` ```haskell ghci> set (_2._1) 42 ("hello",("world","!!!")) ("hello",(42,"!!!")) ``` You can make a `Getter` out of a pure function with `to`. ```haskell ghci> "hello"^.to length 5 ``` You can easily compose a `Getter` with a `Lens` just using `(.)`. No explicit coercion is necessary. ```haskell ghci> ("hello",("world","!!!"))^._2._2.to length 3 ``` As we saw above, you can write to lenses and these writes can change the type of the container. `(.~)` is an infix alias for `set`. ```haskell ghci> _1 .~ "hello" $ ((),"world") ("hello","world") ``` Conversely `view`, can be used as a prefix alias for `(^.)`. ```haskell ghci> view _2 (10,20) 20 ``` There are a large number of other lens variants provided by the library, in particular a `Traversal` generalizes `traverse` from `Data.Traversable`. We'll come back to those later, but continuing with just lenses: You can let the library automatically derive lenses for fields of your data type ```haskell data Foo a = Foo { _bar :: Int, _baz :: Int, _quux :: a } makeLenses ''Foo ``` This will automatically generate the following lenses: ```haskell bar, baz :: Lens' (Foo a) Int quux :: Lens (Foo a) (Foo b) a b ``` A `Lens` takes 4 parameters because it can change the types of the whole when you change the type of the part. Often you won't need this flexibility, a `Lens'` takes 2 parameters, and can be used directly as a `Lens`. You can also write to setters that target multiple parts of a structure, or their composition with other lenses or setters. The canonical example of a setter is 'mapped': ```haskell mapped :: Functor f => Setter (f a) (f b) a b ``` `over` is then analogous to `fmap`, but parameterized on the Setter. ```haskell ghci> fmap succ [1,2,3] [2,3,4] ghci> over mapped succ [1,2,3] [2,3,4] ``` The benefit is that you can use any `Lens` as a `Setter`, and the composition of setters with other setters or lenses using `(.)` yields a `Setter`. ```haskell ghci> over (mapped._2) succ [(1,2),(3,4)] [(1,3),(3,5)] ``` `(%~)` is an infix alias for 'over', and the precedence lets you avoid swimming in parentheses: ```haskell ghci> _1.mapped._2.mapped %~ succ $ ([(42, "hello")],"world") ([(42, "ifmmp")],"world") ``` There are a number of combinators that resemble the `+=`, `*=`, etc. operators from C/C++ for working with the monad transformers. There are `+~`, `*~`, etc. analogues to those combinators that work functionally, returning the modified version of the structure. ```haskell ghci> both *~ 2 $ (1,2) (2,4) ``` There are combinators for manipulating the current state in a state monad as well ```haskell fresh :: MonadState Int m => m Int fresh = id <+= 1 ``` Anything you know how to do with a `Foldable` container, you can do with a `Fold` ```haskell ghci> :m + Data.Char Data.Text.Lens ghci> allOf (folded.text) isLower ["hello"^.packed, "goodbye"^.packed] True ``` You can also use this for generic programming. Combinators are included that are based on Neil Mitchell's `uniplate`, but which have been generalized to work on or as lenses, folds, and traversals. ```haskell ghci> :m + Data.Data.Lens ghci> anyOf biplate (=="world") ("hello",(),[(2::Int,"world")]) True ``` As alluded to above, anything you know how to do with a `Traversable` you can do with a `Traversal`. ```haskell ghci> mapMOf (traverse._2) (\xs -> length xs <$ putStrLn xs) [(42,"hello"),(56,"world")] "hello" "world" [(42,5),(56,5)] ``` Moreover, many of the lenses supplied are actually isomorphisms, that means you can use them directly as a lens or getter: ```haskell ghci> let hello = "hello"^.packed "hello" ghci> :t hello hello :: Text ``` but you can also flip them around and use them as a lens the other way with `from`! ```haskell ghci> hello^.from packed.to length 5 ``` You can automatically derive isomorphisms for your own newtypes with `makePrisms`. e.g. ```haskell newtype Neither a b = Neither { _nor :: Either a b } deriving (Show) makePrisms ''Neither ``` will automatically derive ```haskell neither :: Iso (Neither a b) (Neither c d) (Either a b) (Either c d) nor :: Iso (Either a b) (Either c d) (Neither a b) (Neither c d) ``` such that ```haskell from neither = nor from nor = neither neither.nor = id nor.neither = id ``` There is also a fully operational, but simple game of [Pong](https://github.com/ekmett/lens/blob/master/examples/Pong.hs) in the [examples/](https://github.com/ekmett/lens/blob/master/examples/) folder. There are also a couple of hundred examples distributed throughout the haddock documentation. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett lens-4.14/Setup.lhs0000644000000000000000000000504112710476104012403 0ustar0000000000000000#!/usr/bin/runhaskell \begin{code} {-# OPTIONS_GHC -Wall #-} module Main (main) where import Data.List ( nub ) import Data.Version ( showVersion ) import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName ) import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles ) import Distribution.Simple.BuildPaths ( autogenModulesDir ) import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref)) import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) import Distribution.Text ( display ) import Distribution.Verbosity ( Verbosity, normal ) import System.FilePath ( () ) main :: IO () main = defaultMainWithHooks simpleUserHooks { buildHook = \pkg lbi hooks flags -> do generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi buildHook simpleUserHooks pkg lbi hooks flags , postHaddock = \args flags pkg lbi -> do copyFiles normal (haddockOutputDir flags pkg) [("images","Hierarchy.png")] postHaddock simpleUserHooks args flags pkg lbi } haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath haddockOutputDir flags pkg = destDir where baseDir = case haddockDistPref flags of NoFlag -> "." Flag x -> x destDir = baseDir "doc" "html" display (packageName pkg) generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () generateBuildModule verbosity pkg lbi = do let dir = autogenModulesDir lbi createDirectoryIfMissingVerbose verbosity True dir withLibLBI pkg lbi $ \_ libcfg -> do withTestLBI pkg lbi $ \suite suitecfg -> do rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines [ "module Build_" ++ testName suite ++ " where" , "" , "autogen_dir :: String" , "autogen_dir = " ++ show dir , "" , "deps :: [String]" , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) ] where formatdeps = map (formatone . snd) formatone p = case packageName p of PackageName n -> n ++ "-" ++ showVersion (packageVersion p) testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys \end{code} lens-4.14/SUPPORT.markdown0000644000000000000000000000131012710476104013506 0ustar0000000000000000We currently maintain 2 versions of lens: We have committed to supporting the 3.7.x branch until GHC 7.8 is released. This version is at 3.7.6 as of the time of this writing. After GHC 7.8 is released we'll continue to support a version with GHC 7.4 support until the next major GHC release occurs. Practically this means that there should always be some version of lens in a supported configuration across the last 3 major GHC releases at all times -- counting GHC 7.2 as a technology preview rather than a major release. We also have committed to keeping the current version of lens up to date and building as part of [stackage](http://github.com/fpco/stackage). --Edward Kmett Fri Mar 29 16:11:41 EDT 2013 lens-4.14/benchmarks/0000755000000000000000000000000012710476104012710 5ustar0000000000000000lens-4.14/benchmarks/alongside.hs0000644000000000000000000001013112710476104015205 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} import Control.Applicative import Control.Comonad import Control.Comonad.Store.Class import Control.Lens.Internal import Control.Lens import Criterion.Main import Data.Functor.Compose import Data.Functor.Identity -- | A finally encoded Store newtype Experiment a b s = Experiment { runExperiment :: forall f. Functor f => (a -> f b) -> f s } instance Functor (Experiment a b) where fmap f (Experiment k) = Experiment (fmap f . k) {-# INLINE fmap #-} instance (a ~ b) => Comonad (Experiment a b) where extract (Experiment m) = runIdentity (m Identity) {-# INLINE extract #-} duplicate = duplicateExperiment {-# INLINE duplicate #-} -- | 'Experiment' is an indexed 'Comonad'. duplicateExperiment :: Experiment a c s -> Experiment a b (Experiment b c s) duplicateExperiment (Experiment m) = getCompose (m (Compose . fmap placebo . placebo)) {-# INLINE duplicateExperiment #-} -- | A trivial 'Experiment'. placebo :: a -> Experiment a b b placebo i = Experiment (\k -> k i) {-# INLINE placebo #-} instance (a ~ b) => ComonadStore a (Experiment a b) where pos m = posExperiment m peek d m = peekExperiment d m peeks f m = runIdentity $ runExperiment m (\c -> Identity (f c)) experiment f m = runExperiment m f posExperiment :: Experiment a b s -> a posExperiment m = getConst (runExperiment m Const) {-# INLINE posExperiment #-} peekExperiment :: b -> Experiment a b s -> s peekExperiment b m = runIdentity $ runExperiment m (\_ -> Identity b) {-# INLINE peekExperiment #-} trial :: Lens s t a b -> Lens s' t' a' b' -> Lens (s,s') (t,t') (a,a') (b,b') trial l r pfq (s,s') = fmap (\(b,t') -> (peekExperiment b x,t')) (getCompose (r (\a' -> Compose $ pfq (posExperiment x, a')) s')) where x = l placebo s {-# INLINE trial #-} posContext :: Context a b s -> a posContext (Context _ a) = a {-# INLINE posContext #-} peekContext :: b -> Context a b s -> s peekContext b (Context f _) = f b {-# INLINE peekContext #-} -- a version of alongside built with Context and product half :: LensLike (Context a b) s t a b -> Lens s' t' a' b' -> Lens (s,s') (t,t') (a,a') (b,b') half l r pfq (s,s') = fmap (\(b,t') -> (peekContext b x,t')) (getCompose (r (\a' -> Compose $ pfq (posContext x, a')) s')) where x = l (Context id) s {-# INLINE half #-} -- alongside' :: Lens s t a b -> Lens s' t' a' b' -> Lens (s,s') (t,t') (a,a') (b,b') -- {-# INLINE alongside'#-} compound :: Lens' s a -> Lens' s' a' -> Lens' (s,s') (a,a') compound l r = lens (\(s, s') -> (view l s, view r s')) (\(s, s') (t, t') -> (set l t s, set r t' s')) {-# INLINE compound #-} compound5 :: Lens' s a -> Lens' s' a' -> Lens' s'' a'' -> Lens' s''' a''' -> Lens' s'''' a'''' -> Lens' (s, (s', (s'', (s''', s'''')))) (a, (a', (a'', (a''', a'''')))) compound5 l l' l'' l''' l'''' = lens (\(s, (s', (s'', (s''', s'''')))) -> (view l s, (view l' s', (view l'' s'', (view l''' s''', view l'''' s'''')))) ) (\(s, (s', (s'', (s''', s'''')))) (t, (t', (t'', (t''', t'''')))) -> (set l t s, (set l' t' s', (set l'' t'' s'', (set l''' t''' s''', set l'''' t'''' s'''')))) ) main = defaultMain [ bench "alongside1" $ nf (view $ alongside _1 _2) (("hi", 1), (2, "there!")) , bench "trial1" $ nf (view $ trial _1 _2) (("hi", 1), (2, "there!")) , bench "half1" $ nf (view $ half _1 _2) (("hi", 1), (2, "there!")) , bench "compound1" $ nf (view $ compound _1 _2) (("hi", 1), (2, "there!")) , bench "alongside5" $ nf (view $ (alongside _1 (alongside _1 (alongside _1 (alongside _1 _1))))) ((v,v),((v,v),((v,v),((v,v),(v,v))))) , bench "trial5" $ nf (view $ (trial _1 (trial _1 (trial _1 (trial _1 _1))))) ((v,v),((v,v),((v,v),((v,v),(v,v))))) , bench "half5" $ nf (view $ (half _1 (half _1 (half _1 (half _1 _1))))) ((v,v),((v,v),((v,v),((v,v),(v,v))))) , bench "compound5" $ nf (view $ compound5 _1 _1 _1 _1 _1) ((v,v),((v,v),((v,v),((v,v),(v,v))))) ] where v = 1 :: Int lens-4.14/benchmarks/folds.hs0000644000000000000000000000565612710476104014367 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE BangPatterns #-} import qualified Data.ByteString as BS import qualified Data.HashMap.Lazy as HM import qualified Data.Map as M import qualified Data.Sequence as S import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Data.Vector.Generic.Lens import Data.ByteString.Lens import Control.Lens import Criterion.Main import Criterion.Types import Data.Foldable main :: IO () main = defaultMainWith config [ bgroup "vector" [ bgroup "toList" [ bench "native" $ nf V.toList v , bench "each" $ nf (toListOf each) v ] , bgroup "itoList" [ bench "native" $ nf (V.toList . V.indexed) v , bench "itraversed" $ nf (itoListOf itraversed) v ] ] , bgroup "unboxed-vector" [ bgroup "toList" [ bench "native" $ nf U.toList u , bench "each" $ nf (toListOf each) u ] , bgroup "itoList" [ bench "native" $ nf (U.toList . U.indexed) u , bench "vTraverse" $ nf (itoListOf vectorTraverse) u ] ] , bgroup "sequence" [ bgroup "toList" [ bench "native" $ nf toList s , bench "each" $ nf (toListOf each) s ] , bgroup "itoList" [ bench "native" $ nf (toList . S.mapWithIndex (,)) s , bench "itraversed" $ nf (itoListOf itraversed) s ] ] , bgroup "bytestring" [ bgroup "toList" [ bench "native" $ nf BS.unpack b , bench "bytes" $ nf (toListOf bytes) b , bench "each" $ nf (toListOf each) b ] , bgroup "itoList" [ bench "native" $ nf (zip [(0::Int)..] . BS.unpack) b , bench "bytes" $ nf (itoListOf bytes) b ] ] , bgroup "list" [ bgroup "toList" [ bench "native" $ nf toList l , bench "each" $ nf (toListOf each) l ] , bgroup "itoList" [ bench "native" $ nf (zip [(0::Int)..]) l , bench "itraversed" $ nf (itoListOf itraversed) l ] ] , bgroup "map" [ bgroup "toList" [ bench "native" $ nf toList m , bench "each" $ nf itoList m ] , bgroup "itoList" [ bench "native" $ nf (zip [(0::Int)..] . toList) m , bench "itraversed" $ nf (itoListOf itraversed) m ] ] , bgroup "hash map" [ bgroup "toList" [ bench "native" $ nf HM.keys h , bench "each" $ nf (toListOf each) h ] , bgroup "itoList" [ bench "native" $ nf HM.toList h , bench "itoList" $ nf itoList h , bench "itraversed" $ nf (itoListOf itraversed) h ] , bgroup "sum" [ bench "native" $ nf (sum . id . toList) h , bench "each" $ nf (sumOf each) h ] ] ] where config = defaultConfig { timeLimit = 1 } l = [0..10000] :: [Int] b = BS.pack $ map fromIntegral l h = HM.fromList $ zip l l m = M.fromList $ zip l l s = S.fromList l u = U.fromList l v = V.fromList l lens-4.14/benchmarks/plated.hs0000644000000000000000000001622312710476104014521 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} {-# OPTIONS_GHC -funbox-strict-fields #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative #endif 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 Generics.Deriving hiding (universe) 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 ""] lens-4.14/benchmarks/traversals.hs0000644000000000000000000000605712710476104015442 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE BangPatterns #-} import qualified Data.ByteString as BS import qualified Data.HashMap.Strict as HM import qualified Data.Map as M import qualified Data.Sequence as S import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Data.Vector.Generic.Lens import Data.ByteString.Lens import Control.Lens import Criterion.Main import Criterion.Types main :: IO () main = defaultMainWith config [ bgroup "vector" [ bgroup "map" [ bench "native" $ nf (V.map (+100)) v , bench "itraversed" $ nf (over itraversed (+100)) v ] , bgroup "imap" [ bench "native" $ nf (V.imap (\i x -> x + i +100)) v , bench "imap" $ nf (imap (\i x -> x + i +100)) v , bench "itraversed" $ nf (iover itraversed (\i x -> x + i +100)) v ] ] , bgroup "unboxed-vector" [ bgroup "map" [ bench "native" $ nf (U.map (+100)) u , bench "itraversed" $ nf (over each (+100)) u ] , bgroup "imap" [ bench "native" $ nf (U.imap (\i x -> x + i +100)) u , bench "itraversed" $ nf (iover vectorTraverse (\i x -> x + i) :: U.Vector Int -> U.Vector Int) u ] ] , bgroup "sequence" [ bgroup "map" [ bench "native" $ nf (fmap (+100)) s , bench "each" $ nf (over each (+100)) s ] , bgroup "imap" [ bench "native" $ nf (S.mapWithIndex (\i x -> x + i +100)) s , bench "imap" $ nf (imap (\i x -> x + i +100)) s ] ] , bgroup "bytestring" [ bgroup "map" [ bench "native" $ nf (BS.map (+100)) b , bench "each" $ nf (over each (+100)) b ] , bgroup "imap" [ bench "bytes" $ nf (iover bytes (\i x -> x + fromIntegral i +100)) b ] ] , bgroup "list" [ bgroup "map" [ bench "native" $ nf (map (+100)) l , bench "each" $ nf (over each (+100)) l ] , bgroup "imap" [ bench "imap" $ nf (imap (\i x -> x + i +100)) l ] ] , bgroup "map" [ bgroup "map" [ bench "native" $ nf (fmap (+100)) m , bench "each" $ nf (over each (+100)) m , bench "itraversed" $ nf (over itraversed (+100)) m ] , bgroup "imap" [ bench "native" $ nf (M.mapWithKey (\i x -> x + i +100)) m , bench "each" $ nf (imap (\i x -> x + i +100)) m ] ] , bgroup "hash map" [ bgroup "map" [ bench "native" $ nf (HM.map (+100)) h , bench "each" $ nf (over each (+100)) h ] , bgroup "imap" [ bench "native" $ nf (HM.mapWithKey (\i x -> x + i +100)) h , bench "imap" $ nf (imap (\i x -> x + i +100)) h ] ] ] where config = defaultConfig { timeLimit = 1 } l = [0..10000] :: [Int] xl = [0..100000] :: [Int] b = BS.pack $ map fromIntegral xl h = HM.fromList $ zip l l m = M.fromList $ zip l l s = S.fromList l u = U.fromList xl v = V.fromList l lens-4.14/benchmarks/unsafe.hs0000644000000000000000000000312112710476104014522 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} module Main where import Control.Lens import Control.Lens.Internal import Control.Exception import Criterion.Main import Criterion.Types (Config(..)) import Data.Functor.Identity (Identity(..)) import GHC.Exts overS :: ASetter s t a b -> (a -> b) -> s -> t overS l f = runIdentity . l (Identity . f) {-# INLINE overS #-} mappedS :: ASetter [a] [b] a b mappedS f = Identity . map (runIdentity . f) {-# INLINE mappedS #-} overU :: ASetter s t a b -> (a -> b) -> s -> t overU = over {-# INLINE overU #-} mappedU :: ASetter [a] [b] a b mappedU = mapped {-# INLINE mappedU #-} -- Need to eta-expand for full inlining in the NOINLINE cases? -- Doesn't seem to make a difference, though. mapSN :: (a -> b) -> [a] -> [b] mapSN f l = overS mappedS f l {-# NOINLINE mapSN #-} mapSI :: (a -> b) -> [a] -> [b] mapSI f = overS mappedS f {-# INLINE mapSI #-} mapUN :: (a -> b) -> [a] -> [b] mapUN f l = overU mappedU f l {-# NOINLINE mapUN #-} mapUI :: (a -> b) -> [a] -> [b] mapUI f = overU mappedU f {-# INLINE mapUI #-} main :: IO () main = do let n = 1000 l = replicate n "hi"; f = length --l = replicate n (); f = (\ _ -> ()) --l = replicate n (); f = (\ !_ -> ()) -- strange results --l = replicate n (); f = lazy (\_ -> ()) defaultMainWith config [ bench "map safe noinline" $ nf (mapSN f) l , bench "map safe inline" $ nf (mapSI f) l , bench "map unsafe noinline" $ nf (mapUN f) l , bench "map unsafe inline" $ nf (mapUI f) l ] where config = defaultConfig { resamples = 1000 } lens-4.14/examples/0000755000000000000000000000000012710476104012411 5ustar0000000000000000lens-4.14/examples/Aeson.hs0000644000000000000000000000104612710476104014013 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Rank2Types #-} -- | -- This is a small example of how to construct a projection for a third-party library like -- @aeson@. -- -- To test this: -- -- > doctest Aeson.hs module Aeson where import Control.Lens import Data.Aeson import Data.ByteString.Lazy -- | -- >>> review aeson 5 -- "5" -- >>> [1,2,3]^.re aeson -- "[1,2,3]" -- >>> aeson.both +~ 2 $ (2,3)^.re aeson -- "[4,5]" aeson, aeson' :: (FromJSON a, ToJSON a) => Prism' ByteString a aeson = prism' encode decode aeson' = prism' encode decode' lens-4.14/examples/lens-examples.cabal0000644000000000000000000000153012710476104016151 0ustar0000000000000000name: lens-examples category: Data, Lenses version: 0.1 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Niklas Haas maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/lens/ bug-reports: http://github.com/ekmett/lens/issues copyright: Copyright (C) 2012 Edward A. Kmett synopsis: Lenses, Folds and Traversals description: Pong Example build-type: Simple tested-with: GHC == 7.4.1 source-repository head type: git location: git://github.com/ekmett/lens.git flag pong default: True executable lens-pong if !flag(pong) buildable: False build-depends: base, containers >= 0.4 && < 0.6, gloss == 1.7.*, lens, mtl >= 2.0.1 && < 2.2, random == 1.0.* main-is: Pong.hs lens-4.14/examples/LICENSE0000644000000000000000000000265312710476104013424 0ustar0000000000000000Copyright 2012 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. lens-4.14/examples/Plates.hs0000644000000000000000000000156412710476104014203 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, DeriveGeneric, DeriveDataTypeable #-} import Control.Applicative import Control.Lens import GHC.Generics import Data.Data import Data.Data.Lens data Expr = Var Int | Pos Expr String | Neg Expr | Add Expr Expr deriving (Eq,Ord,Show,Read,Generic,Data,Typeable) data Stmt = Seq [Stmt] | Sel [Expr] | Let String Expr deriving (Eq,Ord,Show,Read,Generic,Data,Typeable) instance Plated Expr where plate f (Var x ) = pure (Var x) plate f (Pos x y) = Pos <$> f x <*> pure y plate f (Neg x ) = Neg <$> f x plate f (Add x y) = Add <$> f x <*> f y instance Plated Stmt where plate f (Seq xs) = Seq <$> traverse f xs plate f (Sel xs) = pure (Sel xs) plate f (Let x y) = pure (Let x y) exprs :: Traversal' Stmt Expr exprs f (Seq xs) = Seq <$> traverse (exprs f) xs exprs f (Sel xs) = Sel <$> traverse f xs exprs f (Let x y) = Let x <$> f y lens-4.14/examples/Pong.hs0000644000000000000000000001406612710476104013657 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, Rank2Types, NoMonomorphismRestriction #-} ----------------------------------------------------------------------------- -- | -- Module : Main -- Copyright : (C) 2012 Edward Kmett, Niklas Haas -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : TH, Rank2, NoMonomorphismRestriction -- -- A simple game of pong using gloss. ----------------------------------------------------------------------------- module Main where import Control.Applicative ((<$>), (<*>)) import Control.Lens import Control.Monad.State (State, execState, get) import Control.Monad (when) import Data.Set (Set, member, empty, insert, delete) import Graphics.Gloss import Graphics.Gloss.Interface.Pure.Game import System.Random (randomRs, newStdGen) -- Some global constants gameSize = 300 windowWidth = 800 windowHeight = 600 ballRadius = 0.02 speedIncrease = 1.2 losingAccuracy = 0.9 winningAccuracy = 0.1 initialSpeed = 0.6 paddleWidth = 0.02 paddleHeight = 0.3 paddleSpeed = 1 textSize = 0.001 -- Pure data type for representing the game state data Pong = Pong { _ballPos :: Point , _ballSpeed :: Vector , _paddle1 :: Float , _paddle2 :: Float , _score :: (Int, Int) , _vectors :: [Vector] -- Since gloss doesn't cover this, we store the set of pressed keys , _keys :: Set Key } -- Some nice lenses to go with it makeLenses ''Pong -- Renamed tuple lenses for enhanced clarity with points/vectors _x = _1 _y = _2 initial :: Pong initial = Pong (0, 0) (0, 0) 0 0 (0, 0) [] empty -- Calculate the y position at which the ball will next hit (on player2's side) hitPos :: Point -> Vector -> Float hitPos (x,y) (u,v) = ypos where xdist = if u >= 0 then 1 - x else 3 + x time = xdist / abs u ydist = v * time ypos = bounce (y + ydist) o = 1 - ballRadius -- Calculate bounces iteratively bounce n | n > o = bounce ( 2 *o - n) | n < -o = bounce ((-2)*o - n) | otherwise = n -- Difficulty function accuracy :: Pong -> Float accuracy p = g . f . fromIntegral $ p^.score._1 - p^.score._2 where -- Scaling function f x = 0.04 * x + 0.5 -- Clamping function g = min losingAccuracy . max winningAccuracy -- Game update logic update :: Float -> Pong -> Pong update time = execState $ do updatePaddles time updateBall time checkBounds -- Move the ball by adding its current speed updateBall :: Float -> State Pong () updateBall time = do (u, v) <- use ballSpeed ballPos += (time * u, time * v) -- Make sure it doesn't leave the playing area ballPos.both %= clamp ballRadius -- Update the paddles updatePaddles :: Float -> State Pong () updatePaddles time = do p <- get let paddleMovement = time * paddleSpeed keyPressed key = p^.keys.contains (SpecialKey key) -- Update the player's paddle based on keys when (keyPressed KeyUp) $ paddle1 += paddleMovement when (keyPressed KeyDown) $ paddle1 -= paddleMovement -- Calculate the optimal position let optimal = hitPos (p^.ballPos) (p^.ballSpeed) acc = accuracy p target = optimal * acc + (p^.ballPos._y) * (1 - acc) dist = target - p^.paddle2 -- Move the CPU's paddle towards this optimal position as needed when (abs dist > paddleHeight/3) $ case compare dist 0 of GT -> paddle2 += paddleMovement LT -> paddle2 -= paddleMovement _ -> return () -- Make sure both paddles don't leave the playing area paddle1 %= clamp (paddleHeight/2) paddle2 %= clamp (paddleHeight/2) -- Clamp to the region (-1, 1) but with padding clamp :: Float -> Float -> Float clamp pad = max (pad - 1) . min (1 - pad) -- Check for collisions and/or scores checkBounds :: State Pong () checkBounds = do p <- get let (x,y) = p^.ballPos -- Check for collisions with the top or bottom when (abs y >= edge) $ ballSpeed._y %= negate -- Check for collisions with paddles let check paddle other | y >= p^.paddle - paddleHeight/2 && y <= p^.paddle + paddleHeight/2 = do ballSpeed._x %= negate ballSpeed._y += 3*(y - p^.paddle) -- add english ballSpeed.both *= speedIncrease | otherwise = do score.other += 1 reset when (x >= edge) $ check paddle2 _1 when (x <= -edge) $ check paddle1 _2 where edge = 1 - ballRadius -- Reset the game reset :: State Pong () reset = do ballPos .= (0, 0) ballSpeed <~ nextSpeed -- Retrieve a speed from the list, dropping it in the process nextSpeed :: State Pong Vector nextSpeed = do v:vs <- use vectors vectors .= vs return v -- Drawing a pong state to the screen draw :: Pong -> Picture draw p = scale gameSize gameSize $ Pictures [ drawBall `at` p^.ballPos , drawPaddle `at` (-paddleX, p^.paddle1) , drawPaddle `at` ( paddleX, p^.paddle2) -- Score and playing field , drawScore (p^.score) `at` (-0.1, 0.85) , rectangleWire 2 2 ] where paddleX = 1 + paddleWidth/2 p `at` (x,y) = translate x y p; infixr 1 `at` drawPaddle :: Picture drawPaddle = rectangleSolid paddleWidth paddleHeight drawBall :: Picture drawBall = circleSolid ballRadius drawScore :: (Int, Int) -> Picture drawScore (x, y) = scale textSize textSize . text $ show x ++ " " ++ show y -- Handle input by simply updating the keys set handle :: Event -> Pong -> Pong handle (EventKey k s _ _) = keys.contains k .~ (s == Down) handle _ = id -- The main program action main = do v:vs <- startingSpeeds let world = ballSpeed .~ v $ vectors .~ vs $ initial play display backColor fps world draw handle update where display = InWindow "Pong!" (windowWidth, windowHeight) (200, 200) backColor = white fps = 120 -- Generate the random list of starting speeds startingSpeeds :: IO [Vector] startingSpeeds = do rs <- randomRs (-initialSpeed, initialSpeed) <$> newStdGen return . interleave $ filter ((> 0.2) . abs) rs where interleave :: [a] -> [(a,a)] interleave (x:y:xs) = (x,y) : interleave xs interleave _ = [] lens-4.14/examples/Setup.lhs0000644000000000000000000000016512710476104014223 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain lens-4.14/examples/Turtle.hs0000644000000000000000000000243712710476104014232 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} -- | A simple Turtle-graphics demonstration for modeling the location of a turtle. -- -- This is based on the code presented by Seth Tisue at the Boston Area Scala -- Enthusiasts meeting during his lens talk. -- -- Usage: -- -- > def & forward 10 & down & color .~ red % turn (pi/2) & forward 5 module Turtle where import Control.Lens import Data.Default data Point = Point { __x, __y :: Double } deriving (Eq,Show) makeClassy ''Point instance Default Point where def = Point def def data Color = Color { __r, __g, __b :: Int } deriving (Eq,Show) makeClassy ''Color red :: Color red = Color 255 0 0 instance Default Color where def = Color def def def data Turtle = Turtle { _tPoint :: Point , _tColor :: Color , _heading :: Double , _penDown :: Bool } deriving (Eq,Show) makeClassy ''Turtle instance Default Turtle where def = Turtle def def def False instance HasPoint Turtle where point = tPoint instance HasColor Turtle where color = tColor forward :: Double -> Turtle -> Turtle forward d t = t & _y +~ d * cos (t^.heading) & _x +~ d * sin (t^.heading) turn :: Double -> Turtle -> Turtle turn d = heading +~ d up, down :: Turtle -> Turtle up = penDown .~ False down = penDown .~ True lens-4.14/images/0000755000000000000000000000000012710476104012040 5ustar0000000000000000lens-4.14/images/Hierarchy.png0000644000000000000000000320710512710476104014474 0ustar0000000000000000PNG  IHDRf\  IDATxmookfDH{_O5  z?LX@ P  ǘ L5 D-0(=4txJg =@0@ 00@A>"k(V{x(@- <44-'.Y8nxwhh"Y(ȕ@C>~%mh?|1F fϘ ?y-#j`w-r}`@Xh{ҿdH?~xu`f. ]&_8@xDA@ț=MK"޾hm!k <~F V/BAð> ={cM!7 P,G[R1G>~1|֐+Gț=Mp` )WATI.+F`'. <^ܘ>sC!KCo{L>~)L Cqy *xh{^h"-WpɦのW| ⟢ ,%\ BNǣo=v%gNX1`0hÞS7ܼL4IU2q!2[ՈX1᳷\/%R@@ fn!޾j<i'Ф/ҧL(r0n\$dT?à ƽgmA9Cgl ` A3o[G--kW ڮr8L^;dҢ]3%\p;} AH8q[t`ӡςͪ 9ۏjrXHa*\Xg!s-xw>z-xw?ZvCdLHʤCgl ysD? Et;'fTQD ҨФ c߲BBt}F/9"G}YK0 `! ̝1,QuC/ۼ|]gJ }ĵ jS1r\je*6  ݸ,^W4_`\HK3fH8x-ǝx/;FTk7k>}5!l1Co`h*5+FԐ+<~5ZodseM,7KįF-^?<7){ 1K/UykԬP "4$ zHNo%v( ;qbFӽqlL.=a׹-Y?<44T%wS3Jyi`N_`x*>Xl@fCO_(7c Ux% $~hnu044ϟ9xIqcG @ ϟ#:uސZ:o^yg̭!'. D}//$O׭jx䯾;C=ǯCCC@04`ӗ !u`Fڝ'Cz] ,+kE ;w+@U ӗ9qVD $Lzu3N,߈0 6S @ `0o dHHdq-|,%rXHD0h዁l&I+ 7{ Bڱ@@Am'~usZW M '/m?x1鋷ҧA@ AS7|_Q,X$.ۏ`ѐȑ»ZG;fKxZBᩓ]G iw GVl=6E`+C$oFO8tZ.fOTO\ G t"ScF x/<}V @^C-|#!1u B8|jfڟ[_6w͡('cph*_BCCD*$ j])Х=Ʈ -'cѳK0׿UKC!iz7- ^/(4}DT:{^ U&Kˁ:!]`0Or]F =xZXhh ݫ}I `8]~?p@oFď݅Wo?Q2ͻO-I6wa! FpL >skhJ?Fʚ*@@<"vbۉֵJnjO(*Y\g yQQ QTֆ~(Y @iR$puSA@,˛AA(_~,V(BB7C:}~" -ۏG$ۢ|xǺC_3@ ФZш:U F|YHaE 5kވhQ@|gs# *3/9#CRbD 0@bD F C=2(ˆ+*QDbD bD bD D %RQDF0Q! @@@ @0( @ sQ|%-YgM"@؁pYo!% p7!6 aa  {W_*,@xx>%@ +G_}櫰PGѢF EE{Q@0Q# <<§/F G%\_xАPQ" Gb_X¸1;g{ҍG&EY?0wO_Z,ҍG&EY??~Rְ @d '5{.xh{^ sW{UU͒.xh{^ sW{UU͒~ɘ?}1o?L  6jE$i}k~1gu*?}۴pƣ@󢬟}hhZ X9WTH3W K7FpvCCC 9Rу *?[h_~ fE5_!!kv ]W3 yU͒ ""z#nWci"  j5`Q\RW/xeU*O^~7ݟĊ5WI4ϖm:W_BCC3BF7FMzϋ~R! K7 س|ߥ  _޽D૰@Fe>ȑ>Kx|x  /_@@D0("N\ M NpE 2wG#Zds} %K7?| Wa!޽N]ؕAm+%MG&1wiCCC@*πhe$$ū: [yCB/wi#BCC_ uΌw~w_SĎ-*Y wC:mGỴ!w|Ut/6Q)" h]Sık4pʺHZW>~q썐K^uH{1{Ư_~h3hQ]EY< &Rz}U@0gšH ˗@ @ PȨo}Ԩל0n`Q+"9v%4IX3kʈ @04fU A >}2by]G.&I+8k3& {Ά82#}x?~VCL#OZ)Y85//͔"" wt"ҞcWB$ᯏ9 Acmj̜m_K0T_鋷z]yÞ3w_:+),,4@"^?,c$U"I |nĬ-_MYVXзa^D#WDᏏ X"޾ka!%r0dѢD*yLi;cHP⏟[[sB=gC ^~̑>;n>[q)>OZ)Y85/g*G8ջkU4oa_͛9њV/9y8J%rghMKUO$24fՋ}^D蹫Bm?5>t4oώ&݆=gCn<77y5r$4z4` ( j.#G$ bcl)# ,,4@"^?,c$U"I @ ЯU5;L:K |l\YӄoݪmêeV \pؤEѿև7>i{n@ KxZQ3IqJw (gy@#mUc#t%IAҧL"%WaaA H_Wm?[_9BãFʟ-G͕5M)ޭv(9N}Ojn͑+5uoA`Vn=Պ1?|:P(1EP(OpMʯC^BCBA/.x'/>}$CgzWFn?xi>7q@PG! hQ"Ỵ6=~mqݫ}H7fAQ޽Ar7м}[U!egGI(vAx̒*+53×wEڨQ#bWSj#G S(skSO8|1tƲ=_'Bjw%wT_R$(mjן}0i}[MvRwMkºȭj|vbw yFR}m`䰰 @@ "B DDq*M_>!zǩ6wfRw|o% d?NtQ#eǬN\2zζHfoZ(w5ʒ.Y|wjhz}jU]gF7am X2%돆/!!e },|O)RTCCCx[BrfICg,ډ=|*vQrgK%߷i#FʎYmߝp;dmFP-k%](ҴFO'ܪfO!!`옑Ζ*b!;fdqbHrDھ;qv9"5j[,)Kd'[/RhR8o/K޴ZOЅvD׽ڇtKxN4^Z|K޴FO'ܪfOg Qӯ?g2`u^zgבKu(9a_}qbe{Z;ٻO^<#Jl6m@ӇH/XlR& 8N}Ț!y;"u4߅w>y:}sJME=[025\ߤ Y˷ZV=ZdMUN1k8Akv?>>]84>~rN~3Zb\g.ՁB_ "*%$$`D??t2 @_УV5K| a֊}_Z+C뽏)˷ZV=ZdMUN1k8Akv?>>]84>#:S#Ƌ)RD"ٴ8ۢ|ٛOu:CRS&2Y @XQdI4!$Ig ,4D 9ww:N:o9 鋦}Eȓ=Mxl×o=֬zO~zz)Q[,!dHQX/!!#:눕Q<~"j@wRDĈYo҄lj]ߧ}5}>(S/*$A?5KﳦO%%W_?}tߧ >bm:#ZdUhXi~o<&{5rX0S. tߧ >b hU'I O>y=Z 'BG:!ÃA͒<#EY #Kʈ}0eɞL)Ua%`P ^sHH.h}NM} .eˆE| GA9RBŎE?}_6mԍ*9~<~"jk>]m%#G,ȑ%e>~dWCm*y}:"j`4I#Ȗ1y/B Ȗ1y/B <<_@@Ph9SjȴR%9]O/v4f}h:- c>(Ul_~.]x0Hz>*r?%I;"{Ưcnj"{#F fJ4b#a1EVx/_V/c޼4QShhxuKDеOB.|̶ƋDc$=bDqcGNr99tF(DgĊo':GpƏ+1E A3&H7V/B"}MGČ,'ӗ3w>f >߷i#!IFѢ $+!a!GtLg/ i#HCċ=x ˈ呻X O4AAApÐrFG5xU`_M\Hn^cliTIOn.44@0 Fr|" J@DDɓKHHĉݻ5r0V( <"GH/Vw дzOqbGFb _yKMPd// mg^MʈAm|޼觿D'/Ĉ%s~9}nh>@oRF j[C$qH4~:i Ďū#:@HaBB`_6=(¬u:5?}Yb( /J9$$bF|鳗ߋ'GUG ]µ!oj㞳a9hRاxP1FƊT,wCr~2bP*R$W}'!vi6J0kw=~MOhVا?J Nqt_'i]sF%RN&O_4^|xU $4DJ?[/^}0kޯM}5RpÞ3a )p o}o_DȒ>ixHH@Œ9|7iyQ 7)#!EA#&\Ph3|!Y$;3z$)rx 7O !yM|@Havn6V(BBN\'fcWC ~>DA@@%<ӗo#D O @A囏C~6>~O<#j>{qbFO)Q|Jx8o Č%$DDx_>o4p7 "H?f. J$A!$A~!! " '!yM"#gnF_D_ýy1qcE@0e>~ l]D3ۏ',  2|yw?h.Y~GAٛ@? }ԠSo ʂJ?vD k'6{8y-4]DO -*GO_QSe>x;Q?UZ|%%taH!K"TÏ2_"Er|Γ=MxHhH0 R0Ϻ7.t_G >|U }-JAQ"}eƒA bE,Xw8蕑KˊMgN$ /޼xyM>ujP㩋CZXeC_'Er|Γ=MxHhH0 R0Ϻ7.t_G -* !Ѣ~%8AH_ ldO )LE},](" VFN}رW3WӗoԴz`гv/4z( ,,L=ZT?:yډN^ M"QĥCN7(dH >U|I ~Xѣ̕>` q[PX>9z)1(9>cSy2| ;w{)"\I,A +j=Mnی_NJ- "GN_I2qx|Waa )~!eĊO_ |%-4`ͻf>OZ#RP DNS]ӣ .2to\c#.^=J"SK75,:@H1ҧFhW$hR观3tWcӣ|>YKsEΒ.iD>Y1gp$WaBC@уzWh& =}DT.͇!%j 9Rh0Z[OMzύ gI^,7_N]-}P!6FU꽋U"`DǪ:#sg oO@ i8 #E S{_~3":dL$bJ߇B@":+VQI,BB5J0Voɛ9\D+Q9Q9UT%u;NUCL?"J!jWSs[sH_Kv@KЂFLiD(qceQ 44ĸn'3(HȑUMf|] -Xm`tȔ6ID?~ "4ou9Ӈ?y:0|Ʀ~%FHAu}~6mxe:|˾sa?|6$#rLwo}=ZdPRy>U*gU>-*|XG-2ك{P|U~9<"Bh@H:-qm .ZH.~by7_#D@@F>§&.iTjCCh'x%z9,AY% T-sy?yI@PhD*TFe?YcP@hԩje~9r@~.W*t|E@r?|39#-2S9rPCy棨QP)M ?#@@XX1-2 ĎD ,,DQDDĎ@hD@(aJˀk#p;$7)# J0qٰDcuD z J0Q"H_-2H4^tg?>H/XP3Wb v( UX$37EnTر?f2`'/M-2U:އ)\ #\}XX-"Q@BD&J0ѣE5J Ď@Q@UX{e E*8O!AAA. ~vBXxx0ХA_ CB˗~h,_A૰P3y@0(6ϑ%ex0Wo>G ai'H}hUGtA[V5K~{^N]Oپ|ISv/N?G~e?Jeh?Ŏ{"pҝ_çOn<Ry?Z\5g4`(V NY_:}SU#|x1'6#ܵ{uu_>B0ThUcoӆçsǬ6Ɗ`0~Y|ߦ m#bDJ7I*, L[m¸1A| 7v }gzmן}uYȕۏB7Mi:QXA5}X1sWt2ꤞ5eϔgI4ҍ!Wn? 4Db݇OHaa%lO'o2u>| D a? y1 <8ti i/x$Rli.Q]oChhUO|u䊨>$Av˕5U=g:՛] P,nMʾfGϜ6i"E*̘.9w/p­ƽD{]\mU}81`И#-r #ƒA ~g?ZaJ7Q",htAm>spH_ə%Uxa!Cfl2Sw!~2dƆ(;U{~ջg*'㗁+3zçONeڃ"}o 3J>p('f~pz]j^S%?D*Ԁ룼|.Se?\8J 1>}F)1i&r A ! |/v`r>v"Rӿ*_,:~.UEH_M/1E'fU-|,җ/BBVm;UaKB? }lVǫ > DUpÑxhcVywƽD{]\mU}81 [Hg/^}X9ɛ#WDҨ̇pGM̍6gPgNKqG`Gdȝ-Mv%;;FT(qQ^yo-QVm!UZL5:L|L7#E\WM̉@ڿ~]O!!?jZ؇ɋׁ>FٸWg:-!r0-JjgNg/ZC ?~ B^\y˗p. M4^Ē43'&FئG-_2ק?YuxǿeK,|;Xu݄o^~شWs22=z߉tۇ+z/toڰלhz U[Oު/~)GvJYWS<_o} 437Z @DB.eBÂ˷*Q`0Hsf/ w,Z8R%?ԪƽD`&8xʦ(pX< i;hq󷼟zlo9U kZ]¸1 {Ύ'ޣ![kSNj FtiX)hQ7!> ޽*oXȇiD.hT)FQCY ~ H/8X7"sʨѢ|e֯!A  R&QOCCC4Z'B}\x1]~m3}`0QR% $rHq"m9Uj>˟3hO>}_?W9JR|),m_BBՊ~{4)OY?izcVD-CW!nG#-Xs0Ҋǿu{_9Y?}`P:*Zj?dH0!_'/Q#3IhÑHѣEVXOaa!W/b11o}"ekBBNjH0vͻOBR$GO_ @ ɾ$#W!0[~0^ <~6<|   B {!"  |/#G BDD_dH( f}G۲WMd዆7xāLX'! ?~  [u+w+E2mc_9ZM{~i @D0  ޾`˷/_dI$<$$ 44DhqbD BxD8%@"Xm+a'v`_Bsg ρ| ~ܘk~^}hh_'}i5rb11|B9}ď3`( ~BCAD0XXkD^0,钆_ E૯r`0(%WFxM ~Axc Y>}*ypK> /_"AqbF Á҈f.)mʄ),4pK!!@ℱ" |QEoiяVB1qXA`0ѢF*8sw7V`E>Z?gC|hTȇ =y&pX1!RXh z@ ӧOR%OvBA~ _'GxSśwc.#F{s`˴֯%loo?<{xs "ȥChh>~px4)pQ#OvFçxi7% A8Q O*RX(/_"D*RX(>*RHa޾,Z0@|EP!!}|Waaiz>mʨO_ 8qvؑBӧLch?H9jP N[;Jƿ;pjѳ7C{5-~ׅlw?|yN^uǬv HyĬ-Q %<@D8%]c>ѳ7Co4?v` k6ͫ?FW@  .꜕#'=}va!.^Ҭϼk'5:ѓ! .TxiZ뗉 9r9n1fuoӄ|Š_w 2?تfQ" MZuĉ>˰fɯZQ"S@xD_-&Č߄iKwGeHe@0T۬*1wR{h'/ ek'5.^Ҭϼk'5:ѓ!jݧ!knѣ~6hhk&45J0H Q G#gm|P/|`0;f`c|E4Iû7] G+ 6epݼVFV{8A:p֣_HA鋷37GP,ǐGɜ>۴_'@ D*, I Z>61+:O(  @pD2#F?łFU|>s/~EllMڼyHz#bBTI§&$$@ @0Z( A@ pތď|ڸcWG;w[H0VAu_GUj|o}Rؘ=j ^3MuQ+7sF"G*G1wjwZ_ BCCZM" 1G Ɗ9x"2 @@?~hw^kFU%r~\t/H!*Y(Â8A<|ZDѢF   nb5Ă~t>]z?G zԯf}E2/Cϧ/ KO H1" =Ea>GXXy_BCUXA?>}a e ` G"|lE\6$ boҬ߼;]j带囎E7O%,4w0w,!rPpΓ3W~>Y8ʓ󻏟p'4V̨4G:7(.t_AXh@hHUXAp/Cϒ"<`0E6zԯ@0հǎ5Ee2r]g*Sp/Cϒ"<8yNhQiǏȔ&qƩ-_T/'@ `Π:o/՛Q##Ҡ{}bR\(OG}$""ȓ=Mս^Uh};%\PL?}93F`hHT/'ȑBWݘۢ̓u(X%Ǘx%} 7y(#:&4$R'QǬVn;_?fJ8bԖ]? -G.~ ^7铅@ b-Fv޾L0(zH 2 GzcI1f :QF- cE i\R!`9ۢ=J """JƒA`%~9,4ӗ{_ `D ӗ(ͻOCBCCtlP_~~IHgI4|c2J>_o~ b3_={&df/G ĉ-|ƯoXu{|5~֨o 437Ƭu^&e8OCn9!)-_EUFb l]moR7g. ͙5U8l}:@kF3nM4[,>BP3cΓF*LFeU%'8pjX ?.s {4.iX+>y6-CzZm޳_+AG}]`_).˽ '8th |_?|4}ѿ˜"ɞKhH@>˞)F.Xw(rhhM~WdOaA"<4vζ(o&ER|>~h\*Wa}XWGƊ揷w?n3)fhR]=Wșw=)CA<}6{h -J9 @Vn?.3"+!UذW7ېWoVmk2Y_F m&ŌUMʾ+ӷG |7ݠEo}>U!z1uiHV9Exϓ=Аt$z"Ւэ^O( 3j%wADI7_#Ď"G9rXh" Eر!D =Z$@h@B#9,A@}8i]o̚*"GgJ vķSjPXSуѢ~&ڈ @h@Ѣ~Ӽ:O9S7ƎX9IeVo;vSb,Xw(%L[͛wΏtiTݰi=}68~W~> xLY|4i}_ dKH/b/Z1waS_seM}W|_1w& " Hu@O8<,,@03k/Y3|nH9zSGҸYE囎E?q]Q~0~F=gxcS~zJXq!jwſ%˟sqUl4:y^>x*W`Pˢy"df6:i_GC?UZO,^DhHo?=J([se|lӑH;N0M{o?HBq2ҋWo?.O_Ɖ8xIǯ-C \=jHt),Xw(%L[͛wΏ5geٯZ_}w/Ǎ8qNh!K۬OZ#JˣUXht)F\9vUN×GTޏ?n 9zR*"_1bĈ\3ū{63/}t_BZWzWf-bI ?1@^N?ď#9W2M[BM.eˆ{ؾW=ǮihqbǍj=`A%r}X2AEqJ̝s: Pw r٦#jw#WaV/ߊ?~ KW&N+IďӻѢ~eΐcDHa! +SzR'1{7/^ċ=6U̚* ˜Kr᳐Wo?&ZHSWVo;U `pݎS9z OeL8~$ y4~/c>Ǎ-"qEL]93|y9:rf`?~%<D%~`̟jusC\AG ˓= 6u~y>UqbEuҸA'Ѣ~%H<~x+SOuUъ͋@X@0L??%އ(Ä>~Kx +a!JS "}ꫯBŊ5XJSFcb 1s~7z 0=?n $IB&ҦH6E b?~ ȟ3g QDcFG $AȑČ5 dK, Aܘ *,,Wf,`̟~+k/S @Q_#.@BX#cDQ#UA@1KxxUHIãFsЭ.|oşLj5 Fȑ%ȑ@0O}$^GDCB $$ zHA  H,~BH7f9>epXpWFH_:x/\:a(]毿4xq#:L? F(AdK, Aܘ @ {rvzɱrP̻ȑ$M;bѺCw Kd 2-汳 AmڿxM`ުQ&/%Waz4mli@oR|1EVj2&W@|7cLOa}'~ӐrET|a!/| 8~t[a NY_<}&0oՁ(0=6o_ j jǛg\H~Wtޏ@ُU +C',e޳F{/N Wa" GxM <a={2yK;{+E@XX qQ`dW?|Wo=}/!,4 JHAAWn> 9#{<$v$2o@ FG5fe?fdTWY' 9\ %<ޣ!cE 囏B} |^=A_%ы,|,u,UtI/]f lS!Q\0b'1w%$4a?v?T=Ǹk SKF5zUXXӗρ4-37V)r?|H?V"}8nD KO_@ 0M~#G sЊMJ V5^>×/_"D9xpQ珟YDGlǍ(,e0˗@ℱ#;טKӒQ^eI, ~BC~}7@%JPJTBI)U=IIU"Q%UUJJUR0۶8 ֪NV5>2c&?^uPaPЩu*@:$3D0- ,seѥSqO\4k{4a(zx_<|X4 B<ʛtp]7KiztBc&\xWuyN_ڗ`Qи~aN͂N͂tYZ{ؘ33KU~=UNVѮD<%  ah*ԫ]=ujuj4龛/*Z>fOF~N:LЩu*@(x0 b1Ȏ|#thZw..2XFnZ7yMG!_R\2R$Hd#ڹS;W"]u 1;W aѤceA^NVD;;tgV2cQ(xk8M}0\0 \ h֧o9 кie7(qhɭמS9L@v3zw\{׌8$/7;+z+uZJ())߹2oeKڹ"]mޞu͋ ~(?/;ѥK8GY2r炗s}C!!u%Fݣ,@J0$Чk߲~U^nvlӼ^U9 JA vo]`[9o|}:WF*tjݨ*; ?'ݸ^aɔ;3 2ο%e{V?}GkUMzϾ=Vf^zܾiU,E^v[vRthPߎIfʯ_;?ofO5[snwVt/5OYU*mւs׫qқ^L3ɂp$lʩ_ u}ww(2r7-p~^vжEfj0O]\v^ϲ),x3o<ѹEeit:٭K׽ ._:J(i?_߃h4k.nAqc?XpiaN)]3? NJJ'lyiÐxͶeˆ7MEOG/cUXҵcd$cρ^ȭ]3?WdG7w>JE /65gˬCJ"ťK 'sO}ed(/OWL[ZyyX^9v4!v#piK :nX5ʁ%];6OF"t:٭K׽ ._:J(xm7kg>'گE)x3׿e֡c%u ? }[;RT>eWKX3(jޤv ~" ꢾe~/J'^14Y6a֪S&kpbӡ{%k)edjhTFRɔCG<Ϊ pt?P^4Mx֍_)~݂ԕ)EAIYEpJfZsCG/A~^vϻ3&y6HQiwO~<'+3pתCG#t^T*mUxɛW|܏ޕYf^3Fuhݰ=3x!v_iޤv `e|䥼d^*|aqDPV^i])\?keWEQ?':} y{0Frŗݭ< _]ƹGY2fX߲H$m&~̧=ChZ;NJJ'lyiÐxͶeˆ7MEOG/cUXҵcd$E#>ɦ6}hٸNjkXF:w\Iw??OC iK 2cQ3?+]D!F[4zKZ6^>miA &]9kH$ap}T*mU䅙2Lz;V%MUdUJhT;բi+o~j6Vjs/- nwv1O|y&U:sͯS3?g?g>ˏOjgi_QXP-ȊǼ;[sxn[v[UN5m)2ⱰA݂4zW>~GsViMc9Ow /e5όEM9deh@U2ͨ]3r%k1o?x|֜'ۖVG ,iۢ~ E>zWa}KkVgƴnZ7U^ ~}0ںy@FR_zm9wܙ{%!&\vziaA4GYҤAT$8N97̺ #ڻ,xﳟ3Q'9p(r+O4ٽs$@ix/}/aAf kn3zw ѢG_3o)5ȟt%zjox;U#7ob@iYyU|=ơE3v^}䶑E Ht~*ޗofL;]zUGJ?9=}$,f?ˏO,_ܻS *DW0 ծĶs0ZLiݼnuӺdyZHdeeuuj'>e*wnxRwӖL̒:T_蛗#F/ypٖj *L[?1>wʰ̌ jZ7qɔ|S[|dOQf~儑JjMhduy g]yQ3?ܻ7_= +3adm6i%H@IIypK_v^gw/ӟ2Zz3(,@"+3/;a3UO ӱ 4K>ްzR7\~z;TA?Ȋu Ұꕏ+_0͊gYfçY7T ?)'TYܾ"?35a䀒C{EQPV >Y#[V%7.[22nZ7U^ ~}0ںy@FR_zm9wܙ{%!&\vziaA Momg\>t),{U-/x釢(sX*_zˬkn_0r@衽ˢ(gu+s ;  r2S5MshxqYOd]Oٕon_a*oF(ѹeޯxx%E=Ojc(cJ@" baWE"!8RҨn!B۟pת|,i޸V٫[i=Uc3/?6G/"i^TD"( Մx$J?Ė-˧UZZ@*ЌK"tjݸ HR˓D Ld'iRtΘc_ 7s+L_~s_z^t"Gɞ'8ҮeԱ*2c@Yitbec-ԧcŰ7s.8‚j!XԬ?^XP-!%%@vv< mT-3>H,x͜F Sm/h\053J(HdڅyE%@EERUU*hF4̊dDX6޶`=T>$ʊC^5_(+233X,C^pоetvc]fg\^XP-x$J?Ė-˧UZZ03{w76ޣݡh4 +LMR! ~i^j찾eH`zżov쎍ޯ^̻vĩ;vQLڡYrپ-+t:i{Xm̰>Kz* B`ch$ȌBj槟{hэ۾?}Gwڰ,ۜȔQJԩ:omޑ%3?J,k1aT"+.K-*2cκQges۸?IY!پb/9xxcG(hvj٨*++nZ/JENi4G{>8jp]Wo$׿ڶ_u JkρhuR?ee4 *M˹+`KC~[2W߫櫇}_tڭ9[?غaKN caN"&?7)OTX<{4wnʭLgu/#  J'4S BjC\QOcPX~{--yS/yyǻvhVI@* Z6UE@iyRUL+UzCJv/x֜wl0yJje  xrُɘzyйM伩Ë֭i׿Ly:٣vee4 *M˹+`KC~[2W߫櫇}_tڭ9[?غaKN eӄbaϿDOBjC\QOcPX~{--yS/yyǻvhVI sԋkUKo~FL#t+"(-Ow*)pJozHEݚ&t@I4!d: 0T*8t8JEE@YEU]޹y*U@4(NCN"3,IzĜIК>I-,HTK h͓ O3tXDɪ.\s%?7?ԱJ~c_-ӥe2Dϫ8ʻvn^ A@<3=fye2q9ש";'@:>jWf*- ˹eeSի^>r0 PyuoϚ=V[p6 c֭Z PNS#?5`5+k9~NN9tРNT T> wEťAȊ} :|k楟}ў'LF N4@"3G;TS#/Ysؘ;gۊu ?ܦY8\SKno~;v=物cдnպtZzn_QOW:ek N H෿eP @e2rY:?֜tpXid܈Jn|@i.* ~ߌD UTPRVCc_ʼ曆.yIמs VAαu:)mUunӨ Rily#OY3bQxuXqWx8lXƵ)d' D#eAf, #;jX4<Ԧqշ9}ѥkܽpCOL:͈D};r\rO  _>fwX2hڰv*'4[nA*ָ^aW|ӟ<{YyiH_LUE";}92زlz+8^R@"3G;TS#/Ysؘ;gۊu ?ܦYcőt:EN%eAnnVUE tqQqiy$boFy'f_y-h*-;+3x.luփ7ݡ 'Df\w8 C0TF^z۳>1w@϶\M)F" *H%5>M\vvϲ%MjP1@ztnY٭9vk],Yne,H!Ţv1>Y=+ٷs^U9͈-N2yXi[_f]rVx! ѹeUoUybdA^vzM[7NVڶljۿ=֮eGVSF^`;_e| o<ԹMd^DPJhDfRX*ED /%RUM^*Ъi*@YEeЪqݪz;]Һ" E"MjMUxI4@IyymMTTT7mxQߓOfD$SiGFPN~|?yqG:iTD-N@6.PiWY+_({un(W-ddDiV7CW [ڹd~n"-$?ڇ_٥c/NmQ xrӖTo\0նy УMłgު6W&ujg<.o{cta`rӽL@Z)ӡ^mƵgȈHddUP^ RP"+3HҎ+e LYiV6mXwt.-ЧKʹOl nLsY?cӮTrs>!>G5xh^qT*8pXd_{ jWOҡ3֩Md,##\7\vz?控 ̼XZS%ϡ7/xBjW T*8pXd_{MEJh4Mzxf,|pje`HA^"5lڱy"XH4ѦY@]5oi6#Z5[%( Z5[Uv~z_ }ZSZWSH4A$вIi^j5_()VQ{-}XFFئi*HҎ+e~4,tnӨ **eӖTإ}UA$вIi^j5_0R?߫m%@=ȵ3WT7m9U/+ݵ{_YOtj0٫K# }g\_Dϛвq%w>oR5mkxMzUӣoveuM8iݪQC@FNl$yGj~ rҿ/u:)xDP H$6ڳ_?|ȌE-{̑ܜ6WհnzfdD(ɋj@N"yhhs>OthU?٫K$&anNV۝cukS /d|cw;.;D۳;V3O)KdfsρdUUPf~%kiۢ~U5Rm<ѩud.-PN~z}W5OzDN^U0 y m#ծxțxso~D{+UAD< ;кYݪM˦ܞe7|5oIAnvH`W(W?HqIyrBܞe A$p9=.8 >Z{ xHo !dffvY~'STD"W+?e2Bԧ}EVSU& k zljQCf '+ӧfXuGNi4a@D< A]=dF"S3?TVdfD=>ʣU23/ʣU шZNVY!T 23defrB FY<5/ܭF~Ne2BcurB̐@0TTRSK>*\z;ui4 TO`ںrc!dfDdef@D!+3#̈ 'C,Qg~A͋w+cⱌ 7;?Y[WN?(23@ f^qHkP~nv ݣ B2#{`#C4W^0#GFJʂ\w(?7; I?t,zPV^k_|‚j!Ț`}~f,ͧo_=/'(-)@{:ܵS$W$gw/F# Y2k=>#m[6}EΟZo>}y9!E[S=1{?vi'@^{۬~][W%/3 ۵jPazoum]M%$z2޻œFazoum] T%f=r3 H&SvmSQZ @/}-oUg I&S^Y\wntߚ~k&DظĂ;8ҽsh$B'f>RFn*DUUUPNaHdD@~;#?76iP3PQg8Ee4 /'+|I eBןz`-KkiB@'_x%g(m[4kWOdnʽwE[-S=/G_9 ׬:}$@U2mc/o[9c_Zԫ*UɴYmB LF3sa5SJ!?{(zb |I)Jzm+g`ւS!kYyi rR5rRAYw?2R0/5曆ұY2?'VI!!@:Zj_|\;kGV͈f_~XI-+Nv,;O0療CGK"^YWfD`ڭ/<:B>kis7S= C-۔[vAjԅ}Js0z͋kn\z*G#gPVNujCG*U?tZV~|w>]NTv KcｇWbA&'^>x+#@4 *[Zu?i٨vnH)(+O=}YX;zF9~[\WCժoڈխ^qˋNhx:6DCJ Z?>խOʺaG#A$ŵNlݤE7x흯co[^!`cGw4r/ݑuJBdcaff, !4nP*pYK/=oݖ~RY-+.w)T&uia&u,{wGݺe_tVw>)mݬ~rOR^ҢIm߹傇g\z^ZY*&p=2volE׫ 7sK*7e[ukai \tVw>)I+̫U[yCVv'7\ ̜2zp+8gUyK65ihuډ}[_$sEXԵ~|}JQ!*ǣ/=69[Wݺ/Ьq/ߵwۧ;,٘W"Rzݥ ҩV?oɥCv){p\Qc[G3:>]Z{/޹Ff,KN?>>%ь( \tVw>) [6H2o^#K#s =pş}[|öogn_ρU=XX-֮ЪA27;+|҂Z=Vg\VX=7 оed,#KTTHNa~*+3fg!8iݪ[ǝs쾥?bK^f,걙W֩ye(*He:_~/CA$e$SiP dƢ6?9ma4;5DD4dDukTeeBʊYunwα-yf^y-*va^z֣/ͮ85#N+JW2۫d5g2>Nw>ݑᄆ ~F~4 إ]n:tnݨr/LߌnZTYW>m}+)׎@؞}]hݼ~RӮb7_[:nT9wc@iYepƨkj!aQ@ϓ[UD3ݡ|̰%̘?~oX8W kW{8 UU)9ީeeϓZUR~ߌw?[cO/82l5}34JUCiUtpg?em,XTYyy2ԭY"_p9+k Rze3$SiP @¼G_]qkFV LV{w(D+㥑i(-yu*)pJ]s/cT{YNhpkWK)OU ! sٟQNA%;fߙPX~[:ZY'OAX;vJޛ.>:U5^yh4>6bH JW2۫d5g2>Nw>ݑᄆ ~F~4$SiP @0aF4# cő0FEB  !" PxINmU~~㿌'E濼h~Ȍ fjU-{{E/L;A0AB C30A  AB08\-OVɈ0HV $ 69O>^^3Y_VQl~Ü⒊0H3~P*RfA?K[1m˟߄mׯ pUZ).CA?!$SUa4 3i @(JԩYzo?G7@бHJFa:(--f C";#K"AȊ1yQZ<뤖H$SiD,;;p(;$~ڕVD<ꇮ; )ujļOѶM8жy*B0aF4#M@@RlߪA*<Ӝ,w9AEJ̚sd 4kX3?2Fݲvj0٬Q_؛ gjRj`ϼQE+n^?/{bS]]xr&OlQY -Ĉf2>ߣmy5SBhӬ^'__thV Pܗu өt:xqKQK FBnYZsq;nl֨v/( Z6lPz?xbּ>'.OCH Ъi*hӼ^7oR0~jG?1e綍+riX4mU)4HSZWdD#U)XFتY]ZpXq"Ydc!lUU[Ĕ6I >y(:g6~Ȋ7Xq˾T:tpQ?hѨv՚>ߣmy5SвI*a:ZYWgw+v٧CN{wiUyhId_%FݭZ"4[=ՠN)j=|MԪݙ|=:ָna*##>ծ|3s̕>pʪT*?2ҪVMT޳]cϼz϶MfYgv)=CJȎg'oV1uޚϺP.*!W\зx55^|c{Nf,'tZf$ Dh4ƹV&SZ51cAm%-ZwAV"ffDhڰf wi]>xU* b%#UEN;;hgUXF!2ܶB U}]|̽NhV곗f!@ٵ*UdeAqy=K!DMr%A~n< n;u<^ r2 {Y%RANVf;;Bf+w"D< k>\{AV"ffDna! @nnVqJ*IC1SbYYYU[-F# s۞*%ۭuY*-4W#uZ6e:KЬ^>%^Xj۲A2 W'4W+w!vjgPyeJU*ȌeQsO_߱A<+#LdfxˏWdeFҪryJⱈ ~E7=xjxޚAի{0Bcw^~2%+3*=V|ҬU '+3 םW!9lSʒdP-!Ь^aB}ZA};WZZd%bafFT"HyeJAd3ddD%Bx2Bxx2Bx2BȈ*OY dόgB  2νy0//@iYE0e5w7VL!AdgόgBȌeJthըI-++]|Â:Çt+),d2e~題h@FA(O9Y!'Bxg3c!2b!@FFT^^"ȊgB@ӱu ZNVH 333qGStмq*@ #a~%ML+ȱ)>C$d]]_  #qrI! zԪ@tJ!B!rY!0H&EXFTҒDf a*OVId@U*-JId@yeJ* a >yfiYex,|vܲ*F߼/]~ASǜUalȌEmZ6PZ^{Cu jVK?˘6oM+OLٗʪ~cw:خE${$-ծ0 ]7CoXFj+M@<`[_Wyl~őHVo8GU篩qbf۫<z꾾 sV׀op$vy:/4=T6'`Δ=2m$NڦqЫ}Y6m&{+j=8}ڗ`Ɵ_|:)8v,rZe7\vfQ*UTdUddDVTD28eEF4VӥuY ;VH7_3UH4bѬQjTK'R猹uiW/3# +"РNԵ 8ϛ:a蓯whը2/7pH6AFprɕ-N=1uk92HT|ϛzadU_eDf @:5R^2؃O?o#7>.1_2J?G*tn(0 :Ma¼k7_7;;+їd|kҾY%@2v—k᭏L<|<2orHZrwV/;&ML?G*tn(ow+Mԯd*/xgm@lu_QLUwŇOؼr_'ȻH<{^t/wfO]z8#Q\V\tÂ:O=C+6L죗ݳ`}Riw=JFj'T&S}Y/+3;0 ݿzu F߷FyqWߴznvжEkWaMܿlS8g1lyY ^(Z׬HC~+˃k.>h%gD#_n{h];FLꬣգ$9\k.>hn%k`ڭ?:i/$RXVފ>ȅ6wŇ*Hf[5xřǺvlQ #ԶIe"3.;w|St$Rz^oweGJ#=NlY~ W 7}sM0S : Vrs_uk`Ӷokeͳu.3-ԩe׿deƢLР*sڙ?\VAvw0c-/hߪA+<ֵcH$}WjT&SjrS:6`̭KjgƢf?>s!m25o%OhZ vw0c-/hߪA+<ֵcH$aїSig]3Gkg !!?Μk;COhTmyw=JWqoIIE_LyƱ+/s{W|vөtk;x,RNg/) PxhInmBB8{۲ek$RӮ>Ri#$2! DV<ΌPըAHc_jմn2]LAƵ-ԩz/xjs/=XF^{UZ^:@3Z[xun٤n{U00 Ym8?x,:qΪZ'oZVťU3qv#Qg?eo悁:VMdelY>ovyֽV7\9X o{2tիBZA>b޵Y乫jQ:sINiSs߹Vf,c.[Fɔ7}..<{yu=^X=/\Qг]'^>ƅu [~N`yyViyE0{# L0ZVعm)kޒ 5zAOǐ׮JSϾەu0 ?߷C?Ba"Kh\79l=ە}#n\Xg[C!!@Hp$?b'mZVTT ٟq$7']f^*L[d2qb~ږ'owٷkjYa綍+۾#>%!tf4 l\FU$ DYEepԋ|ܻ\}Q B ,H2 eI?O&axxId?%&|zMLW<;8ɗd=u*Ί;s^qԋ?Qk+_yƽh@U: ۽/#?/' p$RLjߪQrsl䧬yK6Ը뱗#CR<3 22FOn*xO;KqN+.?w1K7l~ۜgnEћ=[Zvgu+O9jۢa-*өtg;{ƃ/=Xn w=]*vس=p$7\1hUA$Cg/+xjo}}viխxg?%Lv(/' jVoڊyge箪fGncjVoڊyge箪fGncpi';MolZh8ӏoq4O3gNPU>v[]R'nF4o\;9{}Sּ%jˑN)pEstq.%ٵe\;syh4 N*wJ؞32cp%uah4 gu+O9 2WI-yŁ]ZWUOlQO֩Q5vxhvl-ԩjPzՇ_uѐn%/lژ}Rť YDLM*ⱰsH G.h\0̃~y60aǚ7}m_:n;=niE_Wf*/ص4 ;C.Ph*2zԲⵥ]t:4o%zwiU4T*"@YaNj׬r.EoT]G`_bЭS[oߪQv!hh Ԩ^őHĉmTں牭*ڵhXng*xPzNj+Һ"~b+и^aj=WȈF ӱ_׶^}/EӺ-sJ ;6-'_iϼYى&-No)ciZiUqrk[ʾwŇ3ba-*ĵl\'Ѱ~꩹^޿{۲'HC7r%jLt@QyEUpy~Z1ah#E%呿8.vk[^ZڷjXtlQujQѽs[5J;^ޮ433tԢ{۷jVVMTZ0(+آTTTIF#0#5O~]{KkNֶ)m***+dGǏFnpʪ  322UKZ|fNeO^Pw3o?Kia4@V +3ba-* ~ Zm8YJHRNд"tFo~3gϾݕ5cGss V`cwԢȚW[yhxۄwܢR)9ѣsˊ^'HR~Wzn&\vFQ$gѫ5Y*6 *@ ;+nlGψ9 2cѰ2L-MA`xʚWdmzf⛯>h<*@UUU,Hk|,G~ N͂ԝ{gz"8{W&S\zN7_sXw?9ѾU 8VZO&L-ի0 ַ;vǡFAN{hIdƏ|僼X4myunQx8wEnLWZ$1mGFݽ$PV^~+.=9f,YVhߪAKQP- UU7yϫ==-%w_Ha!Bߣ]7U_v[ U֯S=W?̝=i0 y5SyGK""@B@OlU!  Do~O TV%`ߡѫ.>fǟ񙏬+\j7]u1_؛q—k;uġާP^9~!=.UdPXxWV\}ΑN\BHa׻UԱH$X2ذdTO|j%xfC ӡ0-K=Ӝn~Z6e>r'B!Qª9CGJ0 ~@, 2Y'D"x, pBg~_F TФ^a5/펿W^طh乽k!TOwT7|Ӻ/}J NpqiE + w>q鍏խUztzܺ" @"m7H렼*HR?d&A$ ෿a(!*U @*UNJ"#Ѩ(a,JVx,̌gjWA j7Y~XV<!B\tVW~35X"Y PUB0W %aB!B9/y׶E?!j֨KF#T:Ԥ~͸*M=:Nn] e\4iAݗMiH4 W_tڱ5J+Hk3GHaXFpQidSn̢0 >Z?D:]+/"xkWUO5~#/ֽ}YSZWhFF Cw啕%S_zjW+.)Н{FyeeaשZՊK#!𙇮CUa:[z~ӧ9/Xmʞ}}mOx/r^~jOmzɝu!B 0wŇK+YXkKo|nԣ38HBTRYρCǣm:O^pFesg͹uoS#kۼ~ @fd!20HVUɈe-Iw/\_hEe0000YZk/nڬCE4൷?Y'H_uiE)`[F0LC(-NҪђ+o}3ղ!!@H@ЭSǟ}Iʫe/X}FrR 6-T)W<{t]ˆ:,ٷ Ԫz^vzҍ۷jT_-;% Aaڵ{l`!@F4mzauaߢ"ZV0t [6S9{'iRhHԯSP8]~5Nlۤ!سp_ΨJ=UֹeYTݚի}'wa<}lFq+>9~JO^0jۢA/ $ C!a]6h<K]j_JMd{wiUqhI䕷qvj0AHF"̚xSJCaV<#}4۵nTyC/֬W%A!!a(0 C@!@JF,#lѤN<{ꇏG+*d'"!@> ,}'mR @a vف ~^}سTˉ[5S6s2eP2TU*2vmSۖ.ZVJׯYu}[0AH@xx]a&u*gOv6M*2c0# CT:J_~[f߮mc( T^Qh\~7乭Nn]NH$+*V֯SPƖ<5ɭt h٤vZ7WSm\0 YU%#hR'YT\ܽp}NJU~*wb&+[׹myZҶEJ!aA@&кyWo) t(U {/!=OlUxւ#j vg<|<!e.?⽻.oZp?[BEwbۦBd!aZ܎V>UŁCEm-SJ%!ȊeB~jD/y:Ew  M+o=u pBzB\zn}k7M$/q!M֮ܺq{w,s6%2woWB^͂w(ZNA{hج1eëZ߾#ы_=hިNr]G"A!y!GvkSBSeuz]4+?K)UW UfAJ9o}}~Kn#hF'lnC8.#QnSydƢc쯖!BTJWJە2F׫@iiee4z!aZ܎V>UŁCEm-SJ%!A!кYu|`X4B!Ds ?tmhVFS5Ծi?Wk>Uקzs3c'lTUZ$)ys^~X4tSOi[>bgVaAnmISкy/ Oͻf?UO=~S:t r!zAyNd>{?׮z{Tx,ŢnQڅU_^R ⱌ0(,I?ĽťAx`+RQ9ˈ8zղ!SкyksxyEegBH4`+RQpzdUU 0 ޫ};YU$2 ̼#׮z{Tx,ŢnQ8ICv.-) XED3Y!f" өѧ|̓7dʃ7UȃьxjY!dţղ!dţQdC QόgFCxfT<3A ZVьjY!@V< 2 jYᴫ>ܨn'4hTW?V\Tϯ9/:xR@@,a=Wۻh #Gs&_tM+2 CN=B@[U@] UVA*hְvUB@Zڵ R!2xiYANv"eA"3JWTى0PLddD@IiY 32+R2cH,gfQɔh@UXD$0 W$DVfeA"+3(HɌED"()- ";2!@6n*o6eswS]]2D<>8}OlUeK̑>vӘ$\4qAuW=zǕQaa֊W{,'NgU7hF?DSO,}r;p4c{eSO&Sw`ݦO_;F} f}оǺتv_lkjD32Yܫ7|Qڶh0 ݿtc7W#?'y=ь(띉GWncfD@_?˫ڼ|hF@eʹWo蝣=p,ѕ[Q04}6SGT]_"+F"Oޙxt/=6hFW\PkF~z9/l4/W9O-- -$2x.9H4b֯rvmSV=?' eonvY=G32x.9hF@@*e5Xqe]}Ρ{/M۾ι~uzu(?={iMԮ~7sb{;C׮4Wޛ.F}}hqtȩ'ڶ"|KN/';?Xܶqe DvVf䞫F NiX *+#E0׿fk٠ /' zui]ڶE$;I7mX U)o:[/Ėь(Ӻ-[[>.'D,vn۸2+3?7'ݴa*HVol[G3Һm6'~>Iݎ3?=SG|/=lc!_6*N޶l귪oT '7vԲiÚUJee椛6Yť9O׽zD#O=$J/l4K=s=/=dUEkֿv{(cK_zNO5]y9iv_9 kVa蓯jײAeA^Nv{(cK_zN0gKt>k-̯waj' 5w(D4CխE8C!X _|{+˞̩=[XQi{ewM`-}q/GssJbpT osԄ+.s< CtjӸީ#;^yl5 7n\fБh"+zߚ=r0]7c/v+z G"wNz'~5`ԸKHUJG٭8# miX,Nw}:$!@z5mOA0kT{pBE7r$3[6/Մ[MӡE ઋN;:nǢQpȼ'^-|ol8.owxfx}9欬3oN+jٴN+,[NsLUUy`C6:`Z){ጫf,վe.xkH+_Z^2K^߉Tly[vxIȊ*U#N?WXZ}]>HN-+"%v*jKge9o~+s}9VTީE]S.: ']Y]#Z*N;_|ӞjUoxݿ-ԭaߙw{;kڰfީ8Y$@iyE0y:D'^Q{G39īmߑ -;{Ȇrqgf׷}3i:v*=촢M$ YUe VA>tjӸީ#֭UθjZ[6GvjYТo?{pE7cь(x}9欬3oN+jٴN"t辧jU)?kY Щﶧ>򦊽6?_f%?ɺ[HؚMT[ɂȸ{Vާ/7e[q0lQv\;[~؋?:_\zi>G꽋VWnۢޟ4wr{䱼\<qYSgEzvlvW_\IVjJJz+οk8@UJ#0HIJ8Sp>72҃)kzgebI^5|ݒA _3- c{n}GnȞ}SKBO |祐^Gy,+#->a֋3ˋJJïoؚ #sWU}} ?w"}{:?S)T&vta%vhՠǣ?o/']_[=kkU*%[7(g%Gc}G2ScgGJKB,fC{?ϔK͙캜+gr+;p<C!tjݰ~L[bSGy,'BV-*. ;m)?ޟ85g2DZUj*2>fm,Lr )غa @n iIqБ\n-ulݰ  ;uq/_w<]V^N->ݻKP(=rXWoؚ #sWU}} w^? \ޫnm_ǴMH]|f̠h$'%& 91 ?V;R9- ۮkv˯KNL ׯ^Z\ZڵhBzyejU)fC{?ϔK͙캜+gr+=Y^ui^Xs?ziH4^mwkh?M|`enBB$?3cu/D# 9)!5iȉIȝ?my=rtރ'4SARSaԕ sg#Ϝ? 8It _gL~ cL[z-_:.g`;_eak'NJw]U[+y3Pp88@iI<js[Fm1m+s"a3{A$P3bB-| o 3fPH4JYqkOvɂ9/WY⎭B!s?9n%}1⎧)ާ{wi^ @JRb0~ŧZҤ1}O@M(F#G#Oykg χkı.mAE@8թ'WlxD~8+#-͇U}:FaF]r;{dPWR٤Cn{`EsGNGݾg3bkE.8שM"A1O-\RBRbbPe1lR8))!޲qH$ R{ N|?Ғ5r+7^m#HH&9oҐ̫(FJe^=:횣\;m8p VM1C.:sIc$%$ AV 7Yz:|gǦ AJrb~ͪGNGkTT )K{.\o-럯i?YZNYˮ [~JޮIQ8ٙu9m\z)ԮStMGQ}<߭'Zn.\M@(B3YeZ/7^%]Z'f^wd/VKO qlk_b:Wn6 {c P) 8v0\sxsFEL_R!屸;?Yfղb)U ! Sr}ݵ|9wwszul/ c iP@HV :jPԼQ=;6=Mp|q 11$D2cc,ӭչ?kݾ0';=PH j$/lZ8;35&]t4)IIA ÄP<pXJrbӵnm/?aupQ纷mR P\Z**) >v:ZXx><} rh4sC !;gAn΍^ۜ}e9qBZ_P8-%1~aٙqc iP@$%+@(8r fM|"';=ťc' :Y+FP(yÚ%II FuBa屸;?Yfղb)U dUr*V$&ƫW*PRp8NeMrwn{Kձپh4 }EZ5(jިfK&8w8 QY鱱Cz۟{Wn_8v0\sxsFEL_R!p|q %91Ԩ\vߤ!'{wm~_]ݜ^F  iްfIRRBQꥄDcqDV* ‚ !UΌl\M^5<5%)hP+]p-8_֩RaL|9+rob5ػ]/?.`@BB$HJL "Pp&\$';=%%e!A [7Ý_~ѷ{󐞚P8$5%)8rL<ԣ}H$%%ťeE!z5tnӸϏyfmwJ^!{=;rO9~ﳟ+L񲓡PH8 ,Y`MjpxP¨;< ;jPrTXˬHp+OthѠ@@^Je{h@<'f @RRBҶH$ *fmwϝy*мa ;^zN9@B4"-59>yP8H3Oscmۙ>з{˳F@8D ڜ~ەpսNP1jB0.]~zC K8w5mWrӈާ+f< A,+/5S4ȩQx/Vɐ۴| #7~Sa/"<ѡEbHMN r;筪ᓟ+aSpre 08_\=f^X_%ڸO}(ag} Jnt8b!!:nPFBT(h$$)q9SoT' ~{\;rY6 !"bF9@QIyulY'Tsse1*ee'%D;r2? P9;#6癵9+{X  eWJ}(ag} Jnt8+<]OsWi,7~*mY(p' YRX,xP(Xd}΂%sZ6U" -%1HMN r;筪ᓟ+aSpre 0 @B4"-59>yP8hDZjr|] ·¡p=8fs5H ۶3+8|2og=?9Ϭ])7\4/. 3VYY,/?mw>͏~GZy%7}bfjmwϝy*мa ;^zN9$\u'g9ұuL~lJL۽kuϏF#   H߻%<;9XvBK<\+ Æ_޵UR1|U$D#JC5U*[wv&ׯ[#իV,à\Q7wOܳC EyfuN@bn W2COqo5JŬ ) "<sgf9R%'< i ^# a!%%X<T;xtϝp8<%'&ēGN%|8ֿ0u*ٱW"$  ԫV,yS"Z6(⁒гpc%kٳ%p8*Ẅ=|׈cP8Pj9>0y9+Ğo.G"a0;йub_/9 c!8v0r^3& <뎽=p 8_\ܫ/T0ꊮYq34[tբáXZN@Zjr< %̽NZ7sI.W^}YQWt-H$QjM<qW*0kYo;%_7w.̭<64UɎE%aHNLV-t(Ń3c6}wszthrnբ/WNFn+Ƅ~ݱ7'VWYwV+]hp(,]RYr۱/ san@Zjr< (@b؝Ԯub@y, Ú+MLL_bqIY3x ϟ/ 8s8ikA5K\~[Osol:W>q 5תZWhӴvqBB$&T.ծVߨsѤ^oΔanoyĄhpОA oK;F@Yy}qQ֨RRSS5.>9a-GPZNy9e WPx$Uүc>˄5Hi=ܺJZ+JMJcB!wj~n[/\ޮ|UE%zV KVoҦX,v{ 3HF]sE3O Rxº0&'}Kw)()--~c<@QIi^jժdp’[it>D׮VVv2hRzgqcЉSѿ;PJX,wh\Ԡv%oή_+XIIIY˪_ҹ!};/.@iiY/T1a}۟mҠz) w8qjeH4WbVz/O&tlՠ Ij|-'8|2c% ш qoݴα q(*) ի]ZNXzKv6bqHa T-&u}ur`㖟_{=7@&J++FߺicYRPN*ᄦ %9)huA _k@H [JiƵNZT.lvfjl MU/LO]ڭOGU*.q˕g-ZS5w_s$rVy($@ ;eر,uuKoѠ]EH=檋N#@=:\p7UгM!p8lk:jtlm;B!իfW]A 7uSѫ'=Y֨RDPH}ŷ{_hTZP(w)S߰ԯUA= HMI ]97\ Jm|na=;6=*g>~:詂p^ب+O_Fu} \ԦoH Z5U $@($@`Ͼ ePrիfW]>#!! M'@J jvsla>XFJ`-WhM}͑Y塐 ))!>vyݽ/|ꓳ^8ڣ~Z[58uN:v* i=Sk,X>frd'%%N{>o{+eWCjJR03Ye75mWҵms=8 5%)vY ߬2sᛚ6+ڶLO<@86nQuGg$$D)? VMk˻|)oXP תZzݠga=;6=9II Ӟ{p3=_\JMNzwi 591X>#gχAjrbPȬIN ڟ-** gTH!0j`Bh\zo{&|81)&'& :yO@2ks%!i4Wl@ZrRśiIgv8;g}(jNVS=WάB<F=s\q(=-9xi͇/_}bڸ+NBzZrtmqMRP(IOBJ="aP'/uJ⫟s%!iحF\ޥp]  !NLIHOK^Zpa1/*z@x,.=-)Gn9|\qӒP(du;G>%_ԡٍ>aDK8u{CiA(rߤ'ҒO_/ح_g8.<ׯG=gҒ  _ԡٍ>aD|xc~"n;7?ɾCӢp8_g8%'_9{/K n> iIݿ%sH~gϕAB$ и^K:0j`Bk_o<B!M|}%[^!iA(0oWj$Q!%@՜ؖWf+$D"=PjrBs%!i4N^~].u~=Z9{8ODTɊmye־XLB$  tݥgiB!=!=-9k_o<B!M| +#5[=WdŶ2k_Y, %9!q@HKK wDTHOdƧ2d4PṢp̌8siiAHKK @bbDbb$A% %9!@z]T;V̬OLHL`ρ-@$ ruN_sS5X_X//K{:+I6[{n --)@ZZr#SHKK @$HD@ZZr 11"11@HKK D#]!6fH3HBD!ujT)[4sH8oV犊Kurqݑ3EኙEN<S،뎜), -,p8@B$99v& PXX~yăYq(tlݨ@ZjRZ%U.6*-.UsFE WjYZU@ j@(@IiY(991ǔBɉb G_ţv/8v 2tҢZ^bfzxVG_{, {&\w^bfz̏L_j?= 0G/u9 ޣ}Yi~ߝ4kXx`'?h|VfZx`'?h|VfZؗSk1V5;v㰋O=lcyw8W_z,=mդvI(zE{0k7Bj KÙRcsJfuV`ޣѧW_{FFv?+=v#[egcw~h -)- O}lG^X_<\Bmײ^1][μp]vK8Z[%8ZopފqX }\u_dCƵL~ZNf b1/qW} -.3uj91wdt%y4+yԥ';_O~JUc+?0yv-M,KFo%][KKI `?{܃GN&)7u䑆ur`3] QТ~q8AxੵU(), ;t"u (OKJB[?߽}ť_ޗԽ]㢌 jkZ) !!!P8fJ!E%~wȞZ!-)2sƯν@br4jon*sU|zYKt 19L{xU77|9N=ۜѶw>KF]|rHMNH5K$ߩf}H@Uʾ~kήO=m᲍='\T8@<7r/նK>Jg/{E#alsG& ?"/! nvуzG#a 1LQ8|T4))Iq(..q~댵|U9B6˙B!ԯQ|(B!?PZz  ﶡǮHO#QHD"Wb5WvϏCZ4]Խ]s4*~͒m.4dgw6**** ulo;ԪV|>Zޮ_Z}?f\ơ4WXǕRJrRoߗ_p>rx~¼#dgů}[n?).js6m[/ΨϩUެA iIm>G vQIxlن7}<4.o3 pةsECGOEn_أC3дA͒h4mQ8!Z4(زfjwhv61thѠc5Y_PޡhBp|I(I !Q!%>fE<7j359g`v}녍JC[58ێ})X<ѐĄ  ӭչ횝cfMuk۸,T\Z>r"?z(;/hPx>'+f^%lo3{:@ڹ%!^?S ;35ދ9y0Ư3_{ H0m5_D(HMN }ؑ^U}'?eale] B8W\;v^ݲX |z+Nu(5W4^<~x3cCPV^PQϞWL?tǰgϗBR5ԩYN*ew$1%%!a=ZrR4X<.<T. B o}g-{x J}$q֢7TQ>gh$(/T\CZ\rv}KEp'tOݱN*eHXƵK ԷZTRJFwMߓC_RFzj  h EFqjuNAȎ=32b@ʙPx$ b_Nr{uj~kEH$ <[UJJC{vyWYֹs%aCOU4g[|۟e;WԤ`‰b V,_֌Ǘoҽ}+zyg}ֲ'o0Gg-zB!1%aνGGߵV ;`6X,.59)w8Uyﳟ+,~ʽ8S1#IIʅA(UY潭/X{&gW>6qJ QŽ_p^*e|KZx׶N9~g/뜟@9Y @J kѤK( |KZx׶N9~g/뜟B{'96ŵb@,%&&#_#i%=ZŬJCh4_Zi~aqx޳oW=.RTVJ$ٙ>[<¼N @yʪU,;yN*77U<h4xϳoS;yʜLuJNfy,=7>?+~juhzvszui~V\]uޣI- ~jun%OzU: Hlj?'{&"Q4TVnI܊9|':it.!4TVnI܊9|':it.! Rvn4WgW'r9P4 ׭V_XUO矋"@Jp n:%Η߳洛ܷCay% ԯ[ U/y)ɫ\ ' ;7?QЊ>ԨnҺyn.Y]6.:~ |-LOMӒ؛ܳcJBM< Me5kTkEODޒ3𒶅1 Ī?z5 VZy9a! йMWZԇA}۟sX񓅑r^Ry*"QKG^vC+F]˻G"aO7mxs0zE'{ozZ6Ut׫?~699gJ“F;Ʉ=W R/>rh$B(B~Yj9>\~q-@jrRвI{^{ڶqB! ~W6|GXP5gh$߳M'Q!ĄEN tn՟VxaPg8tda$-/zJիT*HOMf6gp0m•Gs*fuJ 59)h٤V= _(ғ^ `4W䛵s@R4l^\bJVެaBo>Ф^o  Y>uzսN̘0Ԥ`gBo>lYu.~} ©iIHԌ TQIBx\bR$HDNܙ_PNJNRPqqY(99!ֶkv&))Ba:NHKM Ͽ@zK>{}3I AJRb <}B \ҹxpg,Ba:%wbq) A(vףּ4UUPXNMK'DfLtնօSӒ (H8?T\\ @oVgʶ?Knۼ^1@iY̓+߫2o5Ԥ  H@rrB ee 99!HNN 55)̴8@rrBI $'% ef H$''QHԳؙ(?=i@_jYUTZ)HD .x<@qqy(1!#!X,D f,|Z ye'=V.- p #'#oKLI]xϣoY.aܯS~5yԩyxeVέ]vݠg<0n ZOזg#ѰS"?' >U޾'-'Bw ?ta{Kxt麪yokŚ*7iMjf>0oӷp"xZ7] >y\ؼ޹eKx5r3}gʅWj^|pX()) l\[,Y{tatN c~ʙ1((8~7=! fM[--S]~wgRF׭Y ּ5W};m̀~kgW .l^\NŌ2x,Uzm`NT$PTRy9e-s-_ٻm!'jMMω-#!Kx5r3}g g#HjݴyB;&9~&G dЊCt>S!=5Rc(?F~@xBB4N( 5r+>v%or2lJطIiӴx"/*1~ 5YSSvonj_SvlsojjrRGn76eΊAxmc_t-Z_r4[Swٛ\ٻmANvF `Gs3bH$HIIWHK^!@(ج @UJ; F_̛ؽCӳHyݢWRH$TQII  x<:E 1)1ex@ φ"!23bEťD 5%)ܲ~AaQF=y\qXUcуzzY3Bf:ȝsW֘8{Ym⶧p䔄 0e5{ 3]6c~cW`ʍWiۼAQE%Q8Ix<:E 1)1ex@ φ"!23bEť׮C?:.W4akU\GYY9sEaĄ`# cz^Nv\S#   Iئy"PAH 75'BX9BS1C{櫎䇞\fqBH$deƄRLCUs2׼5ɗ6VڶqGosAPdg'$DB T*Fo!:=&]ܩymP!=%ֵ]'OC՗u>S!-9P^ dZ]P܇_nz@9Yye_|=}So3Bv-{q'U:]\vfz76nWQ!5и^^ɳ|ݶR6U˛T̮PEťaFzunvCnr{ EaA6YE]5>tA5TO i @b$=7= @:KZ3geg7mPXen4S5sv8{/ݳĹ煅`ټ8+;WNMK'D"iTz 4StswG7(&|߿ uW]t]ϔCR4StswqQ[^3Eh8!!zA뮺)*&LO/{}ϗ 551qR^_Qkk7&&[^en4S5sv8Q piVϽAmInۼ~@iY+}hh$h4"33-$''@Vfj 5-)HNN%HMK @(@QO?x#pLAICm^ PV@U+g@PZjrp|q(-59 R()co׸vPc{ \?ٺII }V3 '\uA^5':ixz齪*Oy 8W\vc O@*٥sg4;vJk~ΝHc c xky-9?ΧƷɨ[Jo/;#%~d~t_6 )qo~;W?});0صXuw>ՠi/<|p }潭9o=w׿ccס{g2_n@fuΝ:@vFJ|iYhݦo]t4p,nӷY.z: Rr0$'&ğypܞf kҲкMf p8d㖟3whz6;#%cס{gwD ߰޿RX֬GO'qez齪*Oy -a?{U*UL/0QrJ<|8 -Y ⡲X? M!ă?dD#P\R~{r+8{(w5}hh$ !14 >ҍzLJ߁;N_;oz|qICpu]uzͯYRo;KΨS I;b!&Dp8 +.. @4!A Ԧ kgUH;'}OܻFܱP}fΟS第o]ڭUo}3Dz*gg_|cs/e\(++;8t*N28W\ڰNJx< Ѡ4 ?7-ڽ-*>]p.k&?bNܳoYyN_[eWt; ێ3*@]^=zE_6?V oooiuKgطxk뿬v-f?f.X.F\-=ĊUdԙ¢ةOp.U?_|csgA<,\jn1zf>_o;wfg`Ư*vlݠfJeKC }_n S"?; L;ն'='Bۯ>жy]%>t]F795r+̚4`&ub1K^~U5u;^%|ǮCIQS5.()- B@$-v_}?1suy0oh$'?ԚJ &h؀g¡>Vao׀6Ɬ] A`?f.X.F\;<ݪg"w]q#p), ^F敖:@ `cs^WfnG_ݬQs{%V߽hU}ڟsܕG0#ٗ|aE_3 Vo:W6U.pKH-{jƏx\NyGo7W,(,mV̉CUUs"-,>SX~ٷm;B@<<ݪg"w]q##v|+Ͻs!S )Iqᗜ{dYj4WkߪH8JckկY|iY߭+awpvȏA?y/ȭTŝ8SX荼~U!! uȁ=Z|rM^NvUGnUvn)~ɺᗳ.̘!hP;>|[O#\qd۟{үdM g=F7\~ppk\]?vU͇X/BJRb<4~%'*ħtᙏ^oV eko} ;E [%l̠>n{5.:{0thB4|˿Vao׀6Ɬ] 9iVBZJ<;#-`6Up8|Wj.8j=qǗWV dW(oM߽Z ExZOޗ2s᫵ "m;{VN@,x+aD4-{ ɷd=W4h r+͝:b&u_Mǿ*$%JC_rbᓉg-Ѹ^F^z}#SgEJJ6J 10Px|$;#%˟\j¢Hf)Rt,^ FkoF3/oor\u^m v?kr+Ǯ /=rsK~gOqĚsJcā¢Eo HpϭCѪ-?f<ݼX('B}hߢnDaNF.]?TSrUR'޿nB49C)HKI?K9z2? 鳑G^x?Ȁz]x&%F/Yw=r%]Z3 j@86{yNK3Lr851!H%ol<`ᓉg-Ѹ^F^z}#]%yzM^}KvF6G[}WiqWF?K9z2? !;#%>nǗ;G(PFk>ڧ[p8d_W̭Z|qYmT8w,Y7ΑU.6xAjůEkqj׾#IN$|i-.UfTX< $%qV, qO9aTߣqI~͏?UZ9_NkݴX< nwIݦ k)Y=RמoiYy{RSb/>r뮥Te ^ztUoQyv΄I`UU#zcKuzvj~fhQ.]_ ⡟ؓSBy<ѓWnvagCϾ۞`ɺ9wWjvٴy/.CF>1eu?*n{%9r_e\<~eǎ?/dHP8$xMUΗ>{^S(--pJK_w{{ͳ՛~ˠpg߮qyg+6;ߨ~^ч_ٺYݢҲXh+ve־5';~Vs}9˧?jIC=~&aGWs}X'޾iaV؝Vֹ~%G/Լ%T{37c' O'ĂT?rL'2~ھ;=@?/dHP8MήREeSSs#HJKM\֫mAvMw軬;筬c:zNE"a#<]p.R^ ڵlpbVZloM}ɄϬ[j)X7Y7|]{Wx(kj!qslr,+<w@iiyh)9FyrNfy 0㯯4[ݵea(|ʼiT##vr#jOv﷿]zх) @iiyh)9Fy,8N;r2MzɮP~_(|I;ɨ Ⱦ'Rbq4WRRZ#IMUrI$ $%q@Ą/9jUF ~* y ut*u(y+\?쒣wj^wWɾ~G= _ڻ_e|ѩI/{Uߎ'QUTK#O'<[5ʃ kU-ȫ+W, paM.L׶ ۷jxQ}OA`ս=nޗwjwM*^擜/}ucϿA{3щ/{K^ڽUS7V꾹ΝpgVZǎ'ܽ`UVMئyGI2}=&={՛6; _ne?}Cϝ;x")-5)PZZ pY5ݱNB4u/:V,kդ PfԴCFn88z::euvK*xjƪ7B7sս=nhIIYxO;28@Zzrl sl=kق[v;pcJOKݛ[)|)9FyrNfyf?F]xK;y Y^gË<ʦ*K{~?lƒOyaWN׾ϿSۆoڨV5,xyo>sH$ @qiY+߶UV7zWw4PV󓭿Wxbꏼ>ﲋ/Z͛g-7AϾ]4WWEG"q@ ]3:q@ܼW?vةhvfz_x~ބ]Px<w]6ئxtmO/ߘw8UP4Rw׉?qAB!8PzNPT\>y0!-%1@Yi,԰n}㎴:YW9㯹$$ؽXőo`Zjrk]i}S%]Z$D#[ɮ0ѻ殨-kתjkRsDBQQixu&Lf7/l HNg>jmا[w |ݵmmM=y#v;Ҧɹ: 瞔zs^L$2[>/o]v׶M;it6C7]7XIYyhN^$A gE=O3:\PX1+ H0+dWϿߞymq^ χH$ݵUy/׹+ kְFѫ%x<|]tW慰nђҼ0kߙZvn!ND"! nSJB/}}c4]n~{&PRV:W: [9,RS}*ӭU@fؘ!=O*̝O7|qǹnw&'B @$ o?Txw''UEӢqk>v5[Z֪ %))V);,|@JbBL; cFg_ZI=%T./<|w?R ~}gjڹEc:,w̾+nxϿN U.3׉h4캫z=ztB,1l_6Mhָy?ԫ[4g"ٷؒyA ^voӷ6_铭eQ5Y7W|Ʉ3k&۵{,JN+d$%Ưtb$ظ5سXB:OGcxh㉝4<ٻ\B9@IYyhNǻwlzVʔqWA 8oԊǃ ӭUAn 2+ yOVc|ያ?νw39bp9k?ғ7Vmϻ{ԁ~+=%)1~e#`M'4kP(9)oT7<Eϕ|㟙7_p9ͩM5ꋏ'D#dW@qii,|sot, :~:٢Wi[ +f@Vfj׵msJZ?iA !AB43q̌}솹;Q^5R䟏6nPBPkT.h$xiSk6nႳLjۼQ" ';,)11 $%&3+T,?.: 92J㐚OJLC{aUsʿugsVԭZ94-59?ȼ3 (,,\2jvSh$F"!+.) CJRbvd^z݃ HPt4\RRW3  qCS筬36HrR4h$&ԯ~> Yk''E=wVҿˉ8@B-/} ))! NIIyYEP8YHá %%1p(DAUJ!bFr())׫[YbI qK ! ´+fUP5WU?*ebAz|=[7<KBH8UJ)@ZjR\\iE3ʎ<PȌ[:oe,{95uUGD# -5)ǿo|}3FשMsoS+6T;|t%][yeh׮Z@B4Q )1!H$HKM@B$$3b-*nѤȫ5w>)uMwIw{Gg=҆<HF0Yb02 T,кa޸ Fr!꜍DB ))qǵh4 A<)¢%f7HFpغaa$Yi⒒0=q&Du{/( Jڥ[Az7}[qƂWԫ[AAQIixMԙ(v8c\] ԯ~;U- JJjD"jNf9'`f=҆<HF0Yb:|UwFz_?JY1(<[>~0zeWi_\R*_`ujܷԊ =tIG^d4ee塞G"!P!-%^RZ>Sp.]!Q!%oxIYy,u:q+P5WU?*eHhRP($dUH+h٤yʨKJLD@@HN +#-?V|~M4+{סZSS䔤XHHIIiZ7s/ի["}Ӡÿ_gV|ocA,T5'L hӴDBAZrJ|͆O^.m֝M/ܜ{JF%'F)XsOjUKxΝBVfn3䔤XHHG KËCaޣg"PHVFZyB8X\jRbuԙ~\j;,ȩX!PXXyaͻb~'mso׼cnxgmsnդA^߻%?Ԛ8Sp.hDpFzrLvQf>5?<ua V/NNN-Z!,|hzyEϿa~'YZEϽjvVFY( ]ԩYAj9Ц쌴7Tk\/|VFzP(!BA+z}ßiZ68[A5{$ Rb5r_Z]K  A@Pp(DsK-F׮^ @  59)VRfKkTw8͹7\}P$@(ڶhXOvд V Ut@zzM:5?iMOFh$ KJ& p͕ݏnVwof8@ P(BP (.) #@PrV)Axro`bB8/-+bx(5%1SByڹ%eeP~AQ4Bj9QGfjV)_2*ƺk|(-+Fv;ҶIa,VBAzyEϿa/3]^zӜ \РFѿ{$ P ֭^[lCnqiYjOj{uS쬌P(\ޫ^S>*ЫXyyhU @Zu?-:B    @kԯ[U/z;]rtmפ߫>eZBZJ|Wflw_ڤ__ZW7~YqWsvN>cU+bЏLº*ukWWZ\4`ߎKJK÷ܷ7^y`Hgԫ^P(@Ax55ԬZ|[7s>! P,Fu-?d]3碥eeѤ (*) 7D#qݼbիf]pjݴn!->WZZB!h\zQŬ |KƟ;?z2@4֤~^1@ͬH$|ӎ̭?}5[z &Ǡ\Q8)I1 4[U/z;]r%%a  B BᐖMj+-- !(8WF"@KӇNZ%,@$]'&|$%Ɵ村pXK3R˻mR ҮEsMЦi o] Үc +~{EI?v{F6HNywJmިVQB ;+=1{7>\vyZ>B!/vbo~ӟ*%D#AO}̔#3sKq5HF  <8eľqӟm]'&|$%Ɵժd5mPuw>ztlv&;#|ρI.jSp5}+u- 0슮>4a %)17D rv\@ͩ- IIB !PZVzyM׭YAJRR<@zՋ+e x$ 䤤x]| |Ԯ^xw~Ҙy:'==%BP8F?i  @B OJVbIRrBZ5S @BB4D <>kye7m .jsje]Ow$)9))a߳H55HHB}_VȂ~9նEs 9)) ,@q䤤x %59Rzvj~׿+2_w=r]ۣ >p<< UR,@iYywڤ^^qKJ4;ߥ]sF|apffZ4q\آIc@B4<2s̞x@ԬRҴAsT#ѱٙ=&MM=tïW+(%Z?wٗ{mURVzٓ۝TJ/OLLrf]+.fp%OwxʱJY剉 []/LqWxm c* ؕ>G@UD@GHNJ)P=b٢no?㹆Mej80wZs=pU*gHLLro={_:;7k/>zϼin\ؼ^-;z䤤x~x׫^[qÓ 8BZry#Ajrb qjhΧcP8̸uIc P!-94WWg_PNHɉ@zKϙ81F2+ 99!H@4HOK@fFJ %9! !8dfcq8ߩUsiq䄀 3#%|-3;+eEHOK@fFJoK_گraEPRf9@^n2=%~ݟY,@JrB@B)q䄀BZr !PHf8@B4 99!HNNӒiq 99!h@JrBҒhXf8@fFJB )q )qHNG_vh w% iqmYe-.HNG_vh w22Z6]P  6C}B<p$F"xHKJ=}{"@@(mc T(QRETTTH%(UR"Q聊P%m۶m@b4j=~\B  '7?γ#v \U\Z8M@< OJ,5 H(.e/, '%͚th$1H-sY pեr2fg(yH%Y W]*"AdU@QqiF„h@aqiPZZKIG@n~a$\ra$(FR% KҠ\JR<r # X KH4ŃX4F1,7/]cSgq@&XPuy]YCwz;&_\K޷aw\s 7FII SF|LVC\w䙬؄?kruW\\x&u +oѤn!,YKk-9SGq(b28rLS68X^z6ӏ:=ם]$= gF@qIYo _xNe%`UOfF@ D,[_}ۦY4[udX\u2)1O&=x\fPƢx 0z+|S7J}~kVOӮef[*=[,XqKųsctk_Po7U<ઓI;|2q2e"..((@HQqiB! {ŵ/9WFRBuxAضYNYYXQתY9ѩ.7j {qh,`-Ϟύ]ӭm֡#?r}ƭ}.;#@IiIFC!ʗ5SJqA@ B8pLv A>YJM.hZy:, UvY!H|5_ׁh,b߁o~:WPy6o[1! @neЊ~O{iuqgXwTo5dɉFlChӢA?xɺN!B /(mv-3N7l꡻;=6~5bp]ws|iUݒҲJZjɓ#0`u_PvFxWtjy4ttVb-H/k:{4صhһ 'uKS|*?e@us'x0;;?okAe_ujw4zKOh,s "O{+&ĢalwD3kPFw?UE㺹#uwz\rj}}EcB /(mv-3N7l꡻; _~wYr)e[{9=۟u Ǣ_UY͏a;TZZǓf.lZ0; ܛi󎴶6ٽh.ݕuaN3U)~~sW~^1%))P\R?ઓI|᭹fʻ`Z7ɋDBJJJ#6Y78x5Wj$x>n㹄H4!aYh΂~C a\ѩ9!Sy6o[1! @neC'^Kܺ;ύըA"g?F;:{WjYYg7mKˏ 7[d?ʧ JJ"M;}N$N{mq*+uo5 n/ x˺#p,!8xoѷ#A@Qqiвi]/nմ~AZ%bϮeO%VOfّkk&>t6-/ny0]|e+~+ =۟zDžFOyaMlMX4y׵o,_{k~U,Z.(3?,X]}W?ԨQ0Z++ 8حc2Ke).. ڔq?liݼA;tOТqce H7F=}ߞ-~Y_ww>E@vNAWۼuońX4?=] H|fz (ǿh\7w]Wu>rCKNh, Sb!iʕӫs5޹;oTEpعĤx SSSR˞wǁe^RRD \i/#}bI.$'⫿5|{ou0ɗ4͏aćo=TroY7WɏF?zeΔe9 Vg| oy2m&OԬR8emd,Ҹw>Y2E㺹  ]Ja4 njH4رHrbb,^VbxТq& kiZf[{}7`UɣZB4,(*$/roL׿vt|ag_ބh٤~x/.W\w/NAbxkoUlVMr︩(,, zuk{|N^n_+!c>nhU~͉^ڞ9[6m/M5p͌ǧYVsfFAaq]ߕAV۪VPPZ\x+͞6lS/o8r& `$ZRڟqB0-kҰV?֮ef~QQi𿵿WyއX|zS[ VՙF+m8q*+q_*ukW)D5yEGʗKD9T\b,_ե}KXy%Ģ᠛86+NGcϴ9yҒ4hתq^Բ).}ߘ#&>Sf,ʟkon~QtE 0U5 #ڟ4 ڶVr2`TuǍ]gTTD <|N~l}{Yʅx[gOmOr[ϣ^ėg\ggcߦvW`u*_.)PZ\=x\qsyC'N'mGM "ҠaEk7Wّh ]Ja4 njH4xТq& kiZf[{}7`UɣZB4,(*$/roL׿vt|ag_ބh٤~x/.W\w/NAbxkoUlVMr︩8q*(cن{v8ݸAKUb/_2dwbb, -뻜XN7nPpݦm^eɣ^3`}}V((,|6{ܿkҴ77h*s[J˂=/Wzӆz GNa7A[K_wUs4Sgrc'ΜO PPPcU'?Y꽏ެvF{oq孳H]FypgZvl洿IANVxi&fFz?,+ aw\sWg\\J%o/;9v[k}'nGwɏm~^zrԒĄ`*,]K^ _yх :m/ M~tm{憫;h'"/YWT}ʐ݉p 7\Ǫ8[vpm=c(sezY]ڷغMQB,cnt4E%sscη17.mX@f?ڟT:3.vv+SYUw7>\YEyoL{`s/?9H4cX^*3kFb h ha:vLR^^aȉ37pkٕ+/r/U/m|ǶM󄡡w>2u~~j^W& w,bjR!A$q?l49p4)Af,] ycc/kݱ m[_РYf/VmITl;]vqHMr:X> CO8֩]<رЉ tK`)I_}dGji T/\r2@x 4Sxƒv*ks5:/mo4ҊnH$ТqΗ4ԮY^:_}k|$|j eOKF"aRr,>7~A_zm!kW+~2iA$q?l49p4)Af,] ycc/kݱ m[_РYf/VmITl;]vqHMr:X> CO8֩]<رЉ tK`)I_}dGFJU*_ب^~%oxM? '&իT,VF+Kk~cۦy;zCoDJJbaѰN“gԪR_P??)1oY?WNIJH4oU'>VN&AjiE}<SgxI5۫WTE%AQQI99džx4"Mr۷i¦ ϟϋ^vbq05ٷH4=9cAòh4 /0"*VH}K=/k5xfVU\ bp𛏤/{~o2“jH/(,, D#aJrbFzQv-|̕ڥC+_ %%[zw>ٵC܂V/Y_{?ҢI‘w]wt̅ 0D`ǒ++Z PH ||͇N9j{WGwєؑi hWP$'AxIFh$܄u c=%e[ś{w>Y>% 0 A BHJHCX&,.)ԩQH(a*EKWm< eaѼI|*WPrLvBiY<ɤmvn,,݇R&8?sW?Vy>BPXJo,+ַq0N("LIJ*iyEAJrb >/sԔCnmOƣI FarIeBaHϕ_u]HE-RjG}m?v5ͬ7WIK-'ܳS&yPPXDAXf"ʕK* Ð0aq4oR7_(ʕ*: Aa7;}^)5^ڞsGb!@FʄBضP s<ؠ/niYs乤+;:;OEP@iiz5 " x,nPP# h4/T&PDÔ䤲JK@AaqK-scp[.LJԯY8 @x|nB:Iͽ;,RaqeyB!$%$!,FԨR$qVF6UL20 hޤnP+U(9u&;,wdR6Ms;k[ZC)^<4vQSk ==&'B0$% !a:yA*U(_J aG 64 #w شyWW9v\ҕ[x姢H(ĩ 1_Su?u>+?W뫾Z=.\JRRH}4X4+( BP@< ‚H/3Y92jD"A(n̎GS4ˬ7[֭U %91ЭM|F7U% Ѐk/=jU*Lcq?_඾] PRZ[ E"A(BȹH ePPXp KJN'G{&یJkY+o-WZ* ^855THRRBYrH^ azxF;)iʕ.ymgf離}sFB,>tuڷj+@QQiаN" Y-X(L-\!A^ҺQv4 @P%bP1PQ\Z@i~cg,ߥYbr|^'0t|ntǞ)!퟽KGcш! Ѱkg?XƎ=Ϟ>lWaaQBǓ;iq@ DAB,Ykv5oR`)f-<ܱM<(.- B8t*q7QԩVFj^]PX,7-(..5K>Zj^~a4DX,8x}:3s;NIM-[=m؞x/%vhuYqU,Wq".@! Ѱkg?XƎ=Ϟ>lWaaQBǓ;iq@ Ń ʕ OPBFBQeeapلJʕ((,BqzfŊK#!Bm@)E_TWs<7|Q\RPeeapلJʕAA 'wl$K˂! +0:{ڰ=_Y9Kw2sHX$!if9 DҲ~E>N{tjiQ-H@"@i˕b0( EsR  `, zJ%!`Sɉe!BM];<5v9\~a "<ܱM<h  ¤xbɪ^{7>y;N6kQmAqiYSI{ޠNh4Ur׿vW, 04u fvF咏_ X4 q.;/6.LJu" CgFw9Z. +0:{ڰ=_Y9Kw2sHX$!"D\<@.;vg %9!.'i}ϡ~]zb^-Ba蹷MNJ?PR{^}o~~Lv¹>׉0 9ݱpJjjxX,#9%L(*) jTO/Z0si5 w8\Zz N>pW+N>6#ms/jŪMqx\Lr\Vl.X]K[gUMPa[;rGKU/NEťH$&&D5}0+ǃUJ}S7?_횞4S 0FxPPXP!,x '0Oěͪ<؝{;_<7 @qz!4 oXR?F@I<[D @Nna4ɉ!4jPQEдa_Aj)Ij+ٚ'F?|lvO}O+F"QD".n8ֺ98|Ww< azf֢ V/x.j /! c 8 Ha趾]N*+(@F(-\/nXz[Y 2AΜύ~_w除'_ڵ T/0 ~ijiE5$H-glmNU(W6냯j7ͬW)|@IiYE kfGge e▍?lm/iɗjxuǓuT+ʨZxM}}jU)޶Pʜ Hܺ'Qцu2 jgT.ٱH_|_M!s& j^~IyխYjU+:'aY7[ੇEX4%DC(@@nd Wb2 \wg {_yxOF j]~IyխYjU+:'}Gʝ˜;s g~ҕ^xņ*.go> 1~˕K.(,,NӇ9tKNg5]цu2 jgT.ٱH_|_Mh$Eß7Hg.hTtl$+|J M( | jW+(,*|t]oFæ@%29q&ansa|h\f0%AVNA ֫^اŧ&I&ԩYPHO>rL~Ճn WwmsVr۵j{4IJDB8u6+kk꒳H'6hYaEPjZ3YI'NΨ\$%!lYrZjt:FH$&''!<lj%3fPV' !aaP6r>Mi }_|ѓ)'OgqbɃFv@bb4Ok⌏>1@k/=޿姡iÚ,X]g纃ϼYuTMEë\tM*0lڰf; V2f𱳉'iɉe+Ax[{dMtkkj 0LNN,CAH!0 JJJ}e*hXz$&)Ied.Zr5NƢ0ɉeqsyԫUIF#A0C ø[6qgCO$bwZ," E#A8}sXrrrbzDQ]##mr[]ۜU\arrbB txa6D!!0C0@ɉe/\V>%S*4tC& j4S0o+i!:苵\uH$ej4ˬUаN"HLS6ɬ]P9-k:E#a$ S3WZ˓D00asf9}}^>/>uɔb8A^ 11OFק5q MAخ_.'4s?&ĢU].:æmCŽ횟pyEw_w𱳉'iɉe+Ax[{dMtkkj 0LNN,CAH!0 @u0u鬜Co}e?Ԁi%>}Ԕ}:|l sArrbgE"aӆ5 Yΐo6{kI |>|oϽEB$4jJ"B]vz=B_z7u= \rco亮6xu{^ ^ԙf\GՄX4Eشr< è@DH$0i'%eA  BhӢ~>VJEÙSؙ@*ŵ3@ 0aBA&''!UӊOJ:q|vFwdRYYYbAxlGu1H-hYpGOo9MJNKJ ?x󑑃=ꏞjW-Ԯٹ}9}'oxbp;OlhYpћmȀCc=7i @&mj+pҖh)e шdž|qD#a jwpwAQIPVV$%%[7[p_b..,(o9[7[p_b|dkAj84Ϭ]ʋ&%'%%3k.zr sajߦҲƫ; M 6晵 vI 84fH#Z.90g=A3}7t9s5ΖSAv9PjeMz.+/R@IY?xzm@pTZt;Ol;MJNKJ yfEo>qD#ag.\[eEC晵 vv99Ӈ(oޤ-3k.zɉpȝkv2\rbcg:XѷhYO `GOoxƫ;X41\g.\c&=2И!}@j8MP.91߼I[Z劥>%+'?Z|JYB4a7xnܠ"HX.)1ȨZ]PTIIh.ca.ߥeeAx~_S]trb, o>2r \rg.\[eEC晵 vv99Ӈ>3H-HF##_{ R%ڷnfᴿ"ߟ,.!qKgsőʕE#o3i˗͙>bOn~aR%ϕյ_ySW]*K]ZVOIAm|4WXXI-晵 /~/8T\Y 0g=͛yfEo>^ŝ5;7$|j7_{q@j8@zeZ.9Avgcu-;\) R% i˗K$%$F$'%$F@j8W*_P5kT;S9)I ! !@zezii[_ +/H-JrZf@_Ys ]W*_Z.9AHX \r %)!$! 9)!$!R% R2rqrqE# !&'%KĢi˗@rRBHBHDj8U,_aw>vYһ菿mǷתZq|@i<ԽsW^: ~޾|N~4' ;*/@H5ρ tU n̺5 C@,ѣKS9 B C%AJRbeeʂ "˧ / FÔ JX,Dee #IX@Yi¢HbRb_f0*,*VLM)}ym[fnͨZ8zGcQHzkj=]OuF_>/9٥}g~Y\\}>n,~K%eA D0|ת=/o}>:s cg^?;X9Bu}N$ޗu4t2*~ˁ4/)-35S QIWz]$OzӆOMܮٹH, OϋG^(zJ0kAVn^><…VZVβ:ܙtm{j7y~ug\p֣R˧j}/H`7Kly07>kp5*>=M,oYiݦyvWOKNvi"陟fDρzu:D shҫ4٥Xg>r}r 7\L, GMyYB,=.kU\R9M.D?9OK寝%'/,>ÑhSf.ֽbpܰ& `w`yҲrzwE$2jʻbp=qYplVwtkSc= T~ŏ\ѩA7^qQÚE?+۴5=70ώ*~.[d==Cw9pSNgSKZ7>_fNgn|`z#]J @ !S. 3aaaIpĢHRbBCV+Q54#'+V(_ +.)Rro4䤄Ą8BA$Q0!BxYh/[*E&uߧ_<޽ $‚` B((*v?Z <[y8Կ'1 T7 W׹ks%޶slĈ[]Ф^;K/h,~GΙU+nkGa(؃Oiּqy/4Q[KJKmyB䤲݅k޲>ЎKU_zcIHLNO|ƋWT=}&]ڷ8{ӣ}en*E-9mZdf]/j3kB߫;qCn|{r{mOM8c~+/m}՝Nmcg!7W\r+,-Uf?3l3 _q=:] / M՗;}|yϼd"D޼#=sfozզ=zMu\rID8tAڅ%q9\BR으XqIMdkVݯ\ӵoXK;f5)oώ۶l۹mh," C[vzq& h|ר^ԡ'I'm6vȍh9K^ף;r\E_j?4f_}oBP+,-Uf?3l3 _q=:] =.4Ii}{v<޶emeGcazeuߴgm?y&;a4.՝Nmcg!7׬Q9yyVw5Э{k֬ZsS{wWjQ$s毮QPPYOڳo|UX ^e'Fܲ&?lMYZGEc3 |2폵?Sy+W ]}Z劥azt˕K({磊?q6qMNmѷ8pԱe72*Ց_џ7Ho@C\~Giޱ{_+pu=W\R ^Z˖Cn0BT\iFr7ov9 pԹh$SO}6g޹1u 4iX;9PvϏ PPX9P.91H$|bdFzTjY FBQ5D4ө]N6Ϭ[bͯEiiJ{.i_umV(.- 5YYFކtKNg>[S}]}dʍay@w:綽/mu>! vj+>p5Gn^hߺINhٴ^y횝OLHwTRAaQtĠk/6}Gк,"Sسӗ9:mvߢq݂X,k87z5խQXJIU+Au bHخex+?kU+_zQۜZns[dA Kȉs PqYYEԨVt NE ԮIVvsg-X׌¢HrIxzZjqVv^ ׮Zԡ{ш]duiᖇ&t?upj+%5{Ň}˾TH${vo(bp}Vbik/;үsaK΋W,_r0-|لg/:pD@AaI+?kU+_zQۜZns[dAC۾\KenʍA$x~=;[6+?kU+_zQۜZnsɣn/Z6έP>9lXF3kר\2/uj\vso}]oNJKʂt|pN@:_;|t =ڟҡEV Vw9E[7޶`’,  %'hD.mpCnzßպt|s;9ܨnjU*OJWZ #%Ń PN ?Խss_V޹?XjTM+n"tj$S3XkF~aQ|8@AaQlVnB8@4wDF#aJrRYre!.ȬS'_k=+W,MH;I6av ߽cۦPV£'$РnFaPիT,zg3Yn"D!JK˂u3h D,h֨n~xbbBB̨\tƪOΘAB@B,^߳sFf>q:ͅy Zh4VNX|JJi\HLLWZ"@i%ϽYW ``߮GHX%RQrRb9c~uCШ4ٱh*U(WŜ'>[j_X3}݁KZ7 FKI.{`›d ]RF>5g޹cf9Y{Թn/<3oXDҲa݌ * 5"!)!"( PV£'$B(-EieXDJ,aXVZ”UT2ad PժV8Drrnn7>kҲx,eAF a\Ko>!;7ki3e@IY!;7ki3e@|y $''w8;Mv=Tޝڧ˩U+@<, 2A C `իVwxJrrBb2BXݷt?P*<@;|2NERvy rN͉}ݦ*^w٩)q䤲SK"@0 <6O|²xYINJ(- -fiRK"! @0 AH"()) bhqf9Kg WmruJ-xeeW(i܅aFմȢ?Tx}S?⎽* 0 âB00ڠNZ5*{$j_Ҳ+˂~rk.>|mFY,D"K/n5}Fu$|JڟN۱Paw>)غ|VriZyRKW#mޣGNNiݼx菭{_Z3GL}e8†yEm>W3M!@ B0!Hvnabr*<„W{ \JbxEǖg^yx^ҺqgQFur%'0 âBDB@0 ð87Tg}&2feo*K*kPjϾY?coQaqdw]vIm.lP.%1c3ex< /i8f~ڨy:U+4]`gʬ82f. j)غ|-pGʝ<}>vY }wuu|ZU\S>!B7>kXN'Eb0X48v~Vv^tƜrcAXrvpلW{  / iZyRKW#mޣGNNiF4oT Cor VT  D $ $''UZ!a'StY1R\* 1!vcS_ȉr-> aZλ9f,]WϤO66!4o\p-W^ZH4̬QtmKNL~&Pf@4ضiK}ݓ/9qpݩSgcőKվG3SCv/ hU+W(}{v>¼f,^SEs89))1IIHwmϼT"U9oVNTس7њEB]rK1m#&" ;}5/ h\75:]7x7~Ś4&v>Rƞϴh\75蝻sg>hr/6ff H-;}3^ƼCjJJ*--Ԫ^ P+rI%0zHAx/3ڴh5鑁@rRR@RRb  bHd5_U?N{bb, A6νcɭ_\5GF{8e&@ &=2p,1m{>A[x03k]KNh\75x箦.\]o/Ƕ9v:'紀IJ7F  F7z{{ \z^TVscۦ/wOnvuRN͎/\ P+rI%%oij/n5iX3EM}^A[   M]mB~~a#'ʵh0$&oGݭCH4;*U(_raмq5  wؐ_o9kVTv{kcCo:<^G|8m7v=P\r|O Ш~͛Wvv~4\R<1!>6P\\TJ-W P\r|%~9pIFy?GN^A4\R<1!Bu ?})ǶUκ%ǃ -֍,9+ V\Y.i(o{OW Q\r<^~޽%AJrBإcnvʗOOݻ$HINa+D/_rwvs ) [Ӈ(_.9⃧bouٱJʗ@bB,7Ccx((”է雏mƮ a`ǞU+-xm̶hŊʂ @ʕJ2j{n^A$@)qHL|hEXT\t+D/x{) !Y0ms< x|-F}SoM y:+?|sYyxJrBШ~͛Wvv~4\R<1!>6A>ױnvʗOvcSAxk]%W|AUdžk/_>TT ٜ[{Z9"J*@RbR@$^B@)I!@)I!/"*UPЉ糟"Rc8@iYTT |8DbX |8$'XD˗@z eTT ʗ/_z[dx9Sܶ7 @ 1!xj'$ʉvv@DrӡuUEkT)]Yi#T) A݌DA1vMmV٬ظaoתq@ կQԨ~"j%K|r뺷?pQhP|u۟Z5@ 04HIN 8HIN  XFa\aQi@n^~$)ɉ!Gʗ/ |8G%8XF0n7lټAndELFnOINGlQ񝅫,xmX@M|-7۳;~7_yߵX*˿{/<={xflިVFE^U?V v9<?9vk$dOU^`E-fMuJe6VSX@Aaq媍UT$o|i%8_/ G!)1!>wlV`)_ҷ'E@ƍ^7t=ޱm\_5-,,BRbB|Ɠh٬^_Xu@O~|y +G}wGEbQ_cտTy ?浧noռ~jGu۟_c4aI&9 dCiYDJJJرh2fA^~adU/ #u灔7?ѷn}Aüsygf}pԹM{LZbCw9LZbCw9:⹋ujU+*U,WڠNF1Gxa^v=zuKU?V= ~5O9`o @aQar#O0}%ge`ɪg?wz2O&-^뻜*).T\i:pęg.~~D'_vq&[4WpA:|]H{sxYs6>ڃ ]|Cͳs^x 63߷WJNJDX{_q.m'&BG_3Nj|IŽ^'޻gaii%>k-Hr뺷?gX԰jz?I5Uu灔g__yԹ:5+\r ^e!?Jn~a;zLNJ*Oz䶽hr }_AȽxO_׽9٬ؑ۴a-^vK[i0.+'/vة2ҲYEѽ%_иnԩQ '&$fƎ8ܦEf.L]?~E+~vۍNعYysY x<8rt'ʽ?ߏ'qt'WڀO7xmb/}x HJL}U?]7^q2 |תwxőz<v9ٟ5zhpիU0叛TNP Z5΅Nkۭcӝ.nᢦ9]{, ѹ ;k`WY~{/hR/Ͼ9% ;nvto#GOK= |᫺=uzjNnEWRGn;u|“37mӢanǶr_ޕ>y=حh@ݚU/lZ/IsZiuY εo,? GI= |᫺=uzjNg>HQqI鯝irIW~Ygݦ-U|f'Og%Ly&wgTM/xoHji%i>ivس5[Ŀ#(O7xmb/}x {s_|__~KkE;^y<EmWY~{/hR/Ͼ9% ?9vk$Ш~o?yfڟN{_{wYk;yU\NJ]G߾ѓs>_j6e-kjΘxH4`׾#)IejU-h֨vAQqq OOD)ɉq(_\Nͽ.;WwmwKNWNK-ɏ@JrbS9pH$(Ԭ\<O}ma.Zd%%A[^Ԣa~Rbޝ~kKpUOOuK.jer5?metm'תQx杕_rZغB:D${mܶXSOgVT F>uVy3|Sf禍/Q58DԮZ4oT/Ś_3 "PZz}<FLz䶽_4/0OoXv}ώgbh8FLbM2kDO{U^7?_Ԧٹi핒ˮL, ؈[wDrbu JA,k84PZUծ^6V]\y,|jJPPT).*8}>177/:fMKGbQpq&9\d{f eF;k~.1!! abB,T)~=Nu_ۧGU+W*HZ:m읻.䂜%g`⠬4h4$'h]۝ҡe#4]ꗷoqʕr4r5w*;/0ej=4Mtgg}HT(R (Z X4KN*KK-W~_7X,.zsߕ**WT FrIei$rE_zOv,@ P\ZԨ^ br qHXի<(U+\Ҫ߶47?V*ujU+*)03; (TeeAf#(RԲXAO"a$ EGPBҢ8u.!Ľβw;1!$'^ys䪕+B5ADbp#0."JAbbB<)%)P\\Q-pkn/wThTF!ZG}[gٻO Sk܊~9ttr(TZz_6Ш^gsbIe@4 q%矸gg6raI TJ-Weeʥ$W|Ng%o~U>_rRø\ܠ0cԮY/V/@i# QUӊ[]cۦf?; -/WReպgMY:I~f֧ "|}9H$߱߼rZicui r",ȨV x<P-{*KGbQPRfe%FF j5jP4-UP KJUұUVf݌U7$]Q-2V*~^AaQQk~-^~$ٚr,¢h:5k׬RcKsI&eqgZjJr.⒲ͅ هwޒif W۰i[KZ7a< .hR7R,D"A$vArrRw)*.?u>if W.l oIZ hw7?k4g.>[ZVZa< (ɤsY;N).) bhqZ9ї^ +7?VP\)-rw;Ңqݼ W'_i;_hj/o^[7֘򘭭/hW.% ' IqhԠVQYZ>lO{°=\Z`׾#6o[Q~ 2R67wo~+{狲X_Eqe\_lHj䲵?c xhWZe-Z)-rw;R;JQY<eOZd7]`ojg֫82f;/zv:UTT¢O}{wsge¢h:5k׬RcKsI&eqhADڅЬa^Ab(-- bhqZ9ї^ +7?VP\)jרR'$۴h,0 ;0RSK޾[gC'JKK#@IIij5oT7ajEVo޼q;\S˕$}+;|f/T.- ҋ}e$ɉeIIq@ "]3/jjX$6~%e՛7mX;@BB,(_.9犊J+U(-(*\ܪQް;{'M =~ΊQ27pyg*+9pDr+.>kNx Tχ]ڜ?w`_P9B'ߑZ.9^rҤXIs.x;ڻnvuRN͊U\4)1hҜ ? ?oE"AdTK/]~ϭ+ |~jx !$%%غBiE]0jרR{wL񈉳[@$c޼ w9@ʥ>¼f~jr0pQ ?oE"AdTK/54f.l^[?03k]9zlbRRbR˗zo/|cފ>U\ "]3/jjX$6~ʥx]0:mk_{8TʩY咋jeT)QȨV|lVjרRL*-- 11{C}v-#/VP^T) ʗKp_oM c:kjw2|"шYST)l+cGĄX⃧h޸No>.ouy%ǃ O}<@5]q|`Nг󙲲Ҡ|xDm7v;gG:MNJ$'pMWJ0.\tn^~$@K7 1!oegGS%bcCo9 I ^{őJ"JRޚμ/_.oM |y:V(.) >[Cͧmo$nIGB/h޸No>n) xk]%W|PZZԈ=)_\#v3uo68R)\Y$nIGB/{]vG*+D# Zzɲ&]\R$&—oAaq¼Wlˏ(_\*6.W雏o{sۜWM)OLW]&-()) ʗKA4_+;;?R.9 za xk]%W|)Ƿԯ]cfV~{o8|7@ gdUݿW]yЉ糟zvi{OV}۵jZ\ )11LJL  r w8@JrbHbRRCC  R2ĄX&%&/_.l3-RjI /_.%A^AAʗ/0)1 ʗ/HJL  1!$'Z\ T) ä "*UJ- zǵG7؏[O HL3399F[Rj$&O yDw9 q)I W& E\AaIשV΄gݵ/' w eyFravn^nɨ^*6buGhGg^pmW9 \_٬(@qIi/Z:-:1躣X@ƭʗw0+Rjّg|nø/~ܰe:<ϣZ+U(r1wkT)gG\VnlKF寝gZ+.>%%eeAii-<5zYxP9BwI&yPPX= bH86S%٬o/_;mOrVo>nڭcwxʼn& `?%=7??euoͳ\Ԩ$]eg ^ܥ `bB,t:s=|:@ fƎ8ܦEf.ƃOTP ;'/V\R@Zre+vcS'&$!Q+#0ŭeK^s0:a䀽~7xy}{"@AaqdGwz_]qԽR%Ǜ5]PT\{XƃOTP ;'/V\R̬]'l^io~k.kxMv'x+U_tgo~]Oۣ-\ڮyN$qvf h5Κ2ɯ.hiZ.ywN/:س7殧xۖr.m<' øW~Ygݦ-U|f'Og%Ly&wS!7oYmNez^ܺ_V|/>Ѐ=jT)&0x돜:߻CukU-D#,XU8Y?iQVZR){坥&?컚3^cFbQ(g67?\Qw5[XʕJ0n/PތQ[;vs6c8.[o\Xz»_ug6  +'?P뺞xMVo\}w~Mݫ]|.\rlVnȉmZdU,WּQ~m7v;18~|B$HINCAaqPVV@4 שVƴ Qy'ϞO 9T+~wFf&+Th$ |nR bHh$iEwp hިnNvMwn"yz+QXXI-HZ:m읻.䂜%g`ҲqZ +ܫWXc|jc5dRnAaɇo|raz=W~ʕ["cn>Xr!:4[7ɹ&[6_p.+7ک]s O'EGhSsm:hS^o9n:ivnڸAZ4[EZ5΍`{.yNTVբzͩUҵAEőȉssctp$Q58DԮZ4oT/Ś_3 "咓RsPN7 F]ݵ.Zf=2yN~ ?0 !$IPH I 0סtGSE?REMW4z'$4DO˕|ɂOdݸ}/_FFn}($"<#;@Xh !2"q| AG{"Y۞>xf!q۝)[<3ȑ%݋Gȑ9+OץM+fwƗ >.>$g CBC!cBxӧ|v˟iOX GtаF黫7bݾdg+~ޝB S$$q @T$ɓEK͸i+ssb4\ $I*IAHLOƆ{4Q*!;AH{&,̻! ZE BBCrf<$4?&k,' KH UtkEtjZ!q۝)[<߳w&ZqO5e $t<xv,S۩鵾^vn~;gm‚QId~ >>$O3)~<<%@XX ŋWrf $$oWc>ZKIkI"2Of?8/@,b !!YyO_R$|f>|h=ilޗ1,,K BCEEEwrJ'^=_O(0OCM[K[wFT)[* Y3< ć "#ǧH9{q0ľ|Ylh}g/B#ƒ"#vo~!4HCeL [ !._8}ڔo׫poӌ*&qx C !q! dHuHH@BBWͻ<|1Y^x=b1Rxާ9kK0*Ix0/!ņ Ƈ$/_ FFć$@0!i+s|2tѤ3gLzbc_C>~M iXhyVe' KHPnv"Jy _4w]/5PT'!!uS,$$@hhho;SxgpʭϞ /2IyCܽ8ѯal+}&Ut@ҥxo!?H&/ `H^>-W JȾmξ]@hؗQ+~Y2}ݹM=D'K !/C Mq!S%] !囸Δ-\r+g/BCBC<}>hz5RZ釐%SםԽs/^^ L+?{"4BCC% £a-Tz7?|vµ$ɓF>mًЩûy 3&)W҅U,S)-޼P;ً#FM^!!>k}@oFtjZT)ٷٷKx x20p ݲQ;)}5-@ܙ_Ldh -SWޫSfO $H!]!! A }*ѳT)\|+2""Q 2M2gHoV咏._jB6>"ie =I؆mnQݤQA$TɓBw~rׯƇ$'^9x2ybGOY+Et7qqq!aa92x46t⬟r<~'E wFELJN,PެOw;fL!!m7qqq?I۲a{ɺw ^z^Ȓ16sԯO_dڝYJ(miѠEkvƇ <僺דFE{4 Wui[ZBBP|0rSE B"""qp볼z&pDY3z >~>i2Ȝ[3ʖ«G_T xUೡ hr:˕9͛'^%OR$U#H4ihS Ȉ`ղE;gm`BRE(V(g,@TdDj"6g0!Ayݼu?|bdy&Ut\i^_5sl.z:{J|-G`V*[ t=νlj*.p߲V)WQLi^~i+FQSWʞ%m޿R,aaD ...$,,4;GOƆNSb^~ dΐ ܸ}?ѤN/3 oLR$߼Pn$~^b= U w A-UU@ I2M !!;I+ 'O$"KQ/ 6eۑֻ A.+)ރ'aKܨFIBl_S-sgy{ծyO@ +[W=l<%c!B eKh>ZU+u]w}87%kwfnTQ(,!!wBr<B Mqc;3p|Vn ]ԻR,E$NĉÃU5jʊܛwJH^?L2:*~vg1+e@dΐ7_?=e}5 ! };7X,`|PY"Z˗+˳O~W*.x?E7Wݎȗ3˂>5eE}ڜٷ텾iu\1(^(.m]Q^0\So~rTq"pqqqLiSȔ>LS;6·(^0!=[] 8" q @@h@XX fxs@¤!N%!!#w<-+ zܥmwl|-$ogP`Czjd߶EqŠx\w=2""X0w֧=2<ټ2Y%[S ,"Q""㧎z*,4 G·CSC͊.-ɢ;3hhIWvMr㰨Ȉҧ~)}7QF5=eESVȓ3><}Z:T)W &$O4IDS)_ ƾ \~;`z <<,C:WޞJOS$zS(wX 1Yܾlaոq[׹4~Ƙngڷy}u~Z6uo@TTdU*wBBfv *2"qУ13u< M OЯ{븐褑qQ? >PZ~0cLyeOM Osgy|ڀrBW,S7q!Q\RE<߾dԡ_HPh9yl QL‹CD'TPB#D'.x:$IDxgc! @j֭\/BDF%j\.@HH1DEF7z`ͦ=֩p3::i<' Kߵվ\}*$"<`ЎO/@U,>-"MWKsɓGƇ@UI7ާ= **2wmvo&Wc_ %$OH*:nO={ATTd`^|$"</u(BXhݚ]Q H1Yܴ`?? HL=ë_ɓ$Da :w $$nmZ6DEEZ5r $$`Ƙng"# = Сu Wo\L'Ѐ?N"YԛBԬTK7gŨEr?x:.d_ B ,@i_W,]ڶM @HH@ttx}ܢ4 *::i<$OHP)DEED'N$"<FEa\z;N^=}Q@XaA/ ::i<@Ҩ B% $ @@X"2:i<DG' @J%tsN^*/GEdܳՅ@X(0Da w >95χBBC' K0[w?|4.,9@L bgxӦ|>m7_Cbs$+3 &{W13iSxJWtǹyIDW,SO6l;u& WoK)o,9}~bBO=xd̍j4J "# `Ƙngr1ޏYS]|/.r p~\Ț:2@`/RC $R@` $O_&ۑaI࿻u&2< u0ww7>_D^ľ&n|>˖֙ $ݍ$4Ed< w7>_D^ľ&n| )"Ql0u&2< u0w Mbݍϗ-3apHPPuGw &RDT-vxQl0 u0w MPPuG˖֙  8@B)"KbB$ "2ja!jN(6( a'y !U E U EuGw &0xB~VL\.!!)RDT-!<,@xX":ң B,(KHHU E jN(6HB£-&= ?BH@ Ed@BBZ(®/= AB  ]!!!)RDT-!<,@xX":ң`]~Ve٤G]!!!)RDT-!<,@xX":ң`]~Ve٤G IK,Y1q HPPa!Kb$$]Ϟ=A˖-}wҧO8`Ν"##|R.]$M@hh=z]sʜ93ߍ?ݽ{W*UJҥŋxΞ=+y^| $$ĵkܹsŋ}7Uĉܹsׯ]|YٲeݸqCڴi@DD-ZTҤI͛-[֮](PǏ5nXDD5jQH.QFI`ş4iرcjԨ7onҤI2g ˗z-'OӦMӭ[7H.L6 ի5oKӧL@BB|I4)W`A/_1cFg [VH1O煄v.wܹA9v:X|>} 3c C UTBBB<{eʔ=}[oeǎ puxݓu%Bx~" #{"YY@٢9f=0kV$ܾy[BWo=Фz]'/_nqAeL׻I| )M*⵻67IW ‹Wo|2hQh֌) !/iωv^P T'>o --[4Gk~юCZǥ2 )7ދ++4tqXJ7P gƄ[4^QXؗ5lz؝ϼWdB~63l>qā;yH\vMY rA)]=}cC>v1EvVo=G5>h߁`B{W T.7!S\;0g  `|бWCv?)%q­[1k533P HH "JTJBJ*J@ YܗKWKܼ};C/E$P;_zWxNFs(U4+w#|8@p:j(] l;.' x4ִAP K8ѫEl}^OxL_}>/۰; ;9# W ?s9`dg?c/Z MW?Pb~@b+W(uGp =p&@!@($ɑrLqv rH "ѐ >y>q;؀זELi3(~_K 5mP9w’ U)@{'Ⱦw'Q~CԪ_l|vƍL ߸mg.)7 p\KIjUׯ^6D &j{jŠd׬Z2 +ΑD!;=:||j` jDLvy3aχCC{ pwb\z <ѬF[?ʑ,ɺŸ) f ngeYق !?qiΜ}WPshtsW}W_x4ֹu8\Izg HM* ! };?~' [|35ٺ-{#{9@3ndOdOaU)@HXjJshtsW}W_x4TmޘU"0P(乎~{4:wṫë/<ܺ^xc`kHJ CB!IQ8vb~ ?ѼVR"vq$73$έƇ=]j8¡ȸ=GMY9P(  t6;ęˡ7>]j8¡A X&b;B\Kom`(59AV}NH/_]}w}j˗;%xuM!)1jp6%'E-{wVNZݛS.wsx{:=}gW;~'c_x4{k?=Df9E"aFD"!s&/%oBZ<&hv4ti]/ƒ^_-_dτծ/7$%Fտ\ág/T)[4\u+ᎂ-{wVNZݛS.8t$&D@$2g_(c f+yGPrw?Ӂpoض/p@$2g_(c fGaP@@>z6t4]!^ oSIJO`C'^ϓ#ܪN5?E߸Ng(@8ҹux2߸E@jjp(]=_LqKRbuξqKbbĄ:g_ϸ%11ABBD7y;3S)"hpxkf+yGyޠ7nԔ$P@׾˖35@2EÛ^)v- %۵|TfrL@$fF,:w|1.3-I R@2EÛ^r%6u-$ Oz:[2\;e]q $ B OGg^qKjJ(߮2ӯߔ+gp(*)Z&7nɛ;@@@Δd  ˗+@LM %)*%) @Δd 91(BL|R)LI gJ29S ɓ3FJ% D  @ hDP`8 3iyBA.\"hZ%|`_Ai SQ(@Qȸq[$7ogKJCnť$ Bb[$ BnefCpF䤨h$ ̎IIJ73&'Bb[$ BnΖ@ @~GڕNl/9ˤ^$!ϵߣBypjRoWF;>Prvn@7r\q@oD"a7<` ވD`ɚ.] p&SBmmk=nW| CgLOO>5Ùd͏s|8vVLoΞV❇|^Oޟ5gLsC-zu|S3C uQ/] ajff9u_1$o=F$~(/zF$7<` ވD 3+n;_2: ^e;'mh`F8 `ߧyr[)ܾ/+/\<?Dz2÷6 ~DS"PY ڌuI#zęK˾Mغn ̊ΪKyF4 }*2Us^~@ޜA4 BPYXP |hZN|5#t IU(_+7pjF(2RA,o/.ti٧ch4 :gN] G"ack}c:YP5V53_>) o oplɂo~|p$6ַ|vք%տLe/?Z-1]n;t:S.__Bl'nʗ3rM$\J~3[2^`M֟DV̎1eE2yQ怮M208~RA3S;8#)1Ѿxk7W. XpbpXbyr'#/YJy'yrfV"sSwY|Zmr|ۍr% 0gŎAe)+ϓ2tm3nqJBy[›C;J293+[̞8ݭ\9;t:<ϒD5*.7KRzh{r0R`ܬVXܾ/:qƺ$oxK9%9S7n7FNg&&DM| Α %)jqXHl/"eGa}ѕ~It5#~fh2ڙ8cٖDsW[;ʸy[|A)I b@<۱Qf%c/ޜ8gH$!o~#/YJy'~MDХIf2Ѱ53̬lE  x][.ڜf#'/: 9_|8 #%) CgMj(tjY7kd7UӫI6 +/9_ܶ/:qƺ$oxKDCa/^ >k}kv%T,]$˝o(? ׿ͭ~|Ҭى ?c~HoֺT_>5*.7KDcY_ܗ7ᐎgֺt/f.f~5ŌRE $&$2% CB ۶':gpЋ'zEǻ :c὚g@ξV뫾%y) QvfEa}*<ϒ]f-ۚ8U)g ̈F*I߼:||J8@k&\n_I1eeSfqf|9loվL wg|ߑSV$OfZ<Bʔ( "def<.\0O5}Rzh۟%;㭻*Z5qR|!p [& 8ƭLVnO|om} 2bʊcL+'=fAJ,ׯC-oȓ#xf삔YtYhxSg,ݒدCNX̧Zn?ڐԬalq+˅f/H ̬>JT6-3hR?,㎂n߼vۙg;<d;Λ75rF(3;[҅k&\n_I1eeSfqf|9Ń@f|960w`fy*ɕ IѠRg_35Iۦ5#e>c/TZ`fFapҵpv,pp峿]04`\bqS_t=cAUJ-OFZw%D`n[|j-S_t=cAUJԯI^ʓ+GGƶFs&i۴Fvb$<z0J+ _p$ˋR^:uPۦ5W);_`wgvecA^n~LMNP*-lʳ7fz ^y 3͆5n԰FǢP3>eul83+;TZؠIRwgvecA^nOܛ SG?uޚc UʤWM}FJJbM}wW)Ą ?~+OdUӫ9/8zBB/Wf5~3?G6 'w*e]THJ&@B4̾v/KY&dWB Jif4eoUX[Ą9S=ڸz~NwwW&WBvΜIEGnyTRiulQ'Ix3^y m؝ ;y1ܠFo (/WpМo6Y>vf5v= ˛#!%9JIJ%p@,ѫ% &$KC!wV,?wjA'"u.ݰ;؅)U#B(\0o\ A??ys[~'~LĄ/YcO&&&DM|[*bArEbp( i?<ߵ kZ+9._n_ p1S?O3s* 9RA@f53s:¤PJL+' .LZh @P(xVH$ B!HXԤ/LK|5# @;qR8ԨR";' By9R !1,ѓCiC(\0o\ @Z<v'0jqABy9R !1,Aٱ tpv,. CPqKBrǮgrO咱?ML?p\x-I>X~H$ z_F<q oܝ0~ﭚˤ`׿&,]+wfT*[$~ؿo,OȎ{JB7uy=V($$%%!8||mi9̙Fcp@RB; ZUK݌DW/C' /X#.]׹]gA롿 ʑ@b4 GΔ  T_?q$RD? (? \/=lny }cY l~c#H:{kU"H |Sع)+RtZazH(B!6̜"ğv4v;+[맿~H\.Q$< BK응Hd4_5~Хqf._ȹpț3U_tQlc<r$jYSoNIOg7B:7=K \z=s9H8˝[\2纉 \%i)+RtZazH( tp,Dǹ~v(wl Q[ ;GjH\@9_zf$ J-عpr);3x@"PH^*C-7X۠bI[/w=\ZXVfvhgnԭV&GN]_ϸ-@ޜH\/=lny }cY _~WgͨTHÃX񀭿kq; y;S1 rm{^V\9n##)) ׿NFY!pp,Dǹ~v(wcq^X KJݾwW*+Wp#Br%@2Eb_^2-YѠ|Bk7Cc~|pfvVIvp\qE +Sͨ^d ᐷv9(ePfJ v?ꔴyP(hڰJ;7%7mP%TZ)+R>|6eш +U8; ;Vh3Ҹ^v%NhcӃ $@ܑAT.;Wj $@A$VLZ,)15wc[Y^ʝ+% dEjW+ x ł  X&- ޚ1ƭ,g/^ ΕwO٬S.<2 wW,;~b4W%{]?ژu  A`۟T*]$o֨T"HL&D d3SrUJ"g#[LKW>{S-d&&D}V.S` ƭʖK]˸;W3HǛ8xVE +MB!MVzg dJ>eE߇F6y1b @pH!r,'JcJu\8HX2ih܍7ne9{j(\qۢ'tk0s-I K׉xἱO߹=?u7/@ _Aw Ny6z1 BpffRXBy~o椇VΊǃ !ѣ}'![ɉA*){wGwy;NmYZ̸q+V[ܕ;6|4(ŲsJ YѠ|Bk7Cc~|pfvV!PX @rǾGN[L[ۆoIJH@Du~~'s^1ﵞO4?7&ø޼|8A?&UR<bzoǚܓ#%)bLwwݕǞiNCfĄo<=K峧.ޜ\ w=!`*YS}q+Gd&'%ȹeѰW=~חB$6.7ȟ;B{篇 *)XL(S@VRG}7'jtwV9#/+)Du~~'_)Q ^j#ϾZ5;`ÕʑC52O{9\`T"oTD¦sP@(7:#u3kY:Vj؉ӗ|r&G#apnJ~=Y%%W-W4L 峧.ޜ\ w=!wW*{; LFR⵪=9U 9}1\x8,]cҔ_%'&D-zbBD8s3{Frl[vڕ¡ByBycB!=w.Y+11!õ27nݓDžVΚц6gB(N7zY.ojWح3範SS.hoJeĻ=03=Vh5hE.\C!V(ot-T&ɉ?v~ +5_%{ӑ'ʺy+_GDFjqlWKfp(1iMs=1!ʊ)Z(OQ>{5hE.\LK 1iMsx7nΖ|ZR%D#Bo<Pt5B!=Э6}5k[s:7IMN -Q(13nIINݧ-ūO۹sKƾ5LX 1!*!ۯ!= #% @'_P%ӳcO4պ=Y2JM@63rL3nܼ RS$'&Z8oJJHNLx7nΖkKɉN~&#@(2_[O4պ=Y2JM@63b"?{#Ac5g[r$p ^% b5XH/^([P|cgܒ(!1O[ шMs\h~o V)Iv-)  :7IMN d\~SRbDrb"krH @63W.q׮eܒ 7xYХMLhRJIMN @__ *.jrL3nܼ RS@ݟqKJrh>oA63D| fGB'eV,]$B!4L{oCjJˡhUʦnxWmH{TFՒ.mg@E\~SBūO۹s% w:Zz-)ɉPt__׮ߔ+GP(ΙJzZւ/Ozkې$ B9S;})~ބRS@RR$D#RSə )) OIQIQ'g HMIPH)RS@RRT(<9S@)  ɓ3$%F%ȑRSB!sB^}dZYr 5% @fV̫3֤RH@bBĘ5uU/\DrLN_ ߶7a#@(;g 9S@@H Է͍o+!A8W߰~sBE/[w-#4yؓ7jY2fr33;șV/=w9Ry,r5e.;(\0w6B!6pO1D|wswG_E ןVZlۙޜ1u<o$%FA`GS?Y+@ G6oRܞPrÞ^p8W?'ulYv8?S)+o C\VY]Կ R C k#:J }-̵C Q__|9礎-ݎDn3o[+ ff (GFz>q!= 0W'/O`kKr9J$Odys._$X(/KD w\=f)s//Ƚe"03範8p"wg_=+ϵppffe5ǵ{k8qR9,Q|Cz6 A;naO= <^GN] 0-ofVYz\fl$U@[Ҵ׫^.+ X,!FA< efeyܝ AXd̬MIJ V|jႹ] z\vHB!_l-i]U/det>;#Kyj||l?J)3"oIԪ츱SWs*'gJPh8NGvv(!=_KT. 5ٸ^dD<|7o$ɽ̟+>/rpBႹo ^RّH8  'ߦ\]jb n‚x<nܝ޻nG"a]C A`3o鋑H$l䳭wjY3'/U|Z_\T;/=uLтM;%^r=er$|r?{Gzo} 3nΑqvhkKr-j*%~j?z~utkwU,;rbxԛ溣`_&~6ߕr%?x&2Os?}1Rd[#:W,U813|:ӭ)PYomHq8~Rx۟庻RݛeԹlv8ƽyϵE̬l 掿9czJeXu܉ Q/?znHI7lLz5#'|c>ѫ7-ޜKoJųvoQ箲p@<oRf-ߒ j|OoF"aߓzYCo?K/M|/ɗ}6UzGjߞ0}mzf=ҨZ&xtg[S5}?&~k7B, ܶ7Ϳ$_z#q#`W^'11!ӛWffv̌%ߦtk Լt֛C_ϝ;5Bqė[+3+[{̜0RS3(ץ+>۵H$ `3o鋑H$l䳭wjYv(@ 컔y+$&DS]) lOIIJʟ'gc C詋^'3+[Qsrx>:yy[|+^P&~Wo3nvtk Լt֛C_/\0O< "p  xeܼڒ\ 'ZJl ,|G]ܸ|5#t/=&>yy*Ӳ? ykemo;&]q; 6~{^ONH Wݰ~˞:w Y}#3+[еXٟnMwzshW3nޞe*͕/Y4ҕhkKrߕDxϸ{?ЍUJdvD"aDz/M4k}91+ᅟHɕHq+ܾE[ Hu܉ Q/?znHI?=sJQʙpksn~"txέ϶HJHk=I>TY1.zqf̬l=FɽW@JRba˞A-ߵA=g<[p]eț+ݏ%<|]ߓzYCo?K7B#^s/$&&D>}z_ߋj|Cڷ |moYskGFz4/u^(@WOv̼<|Zc[Jo~K6bvu@7Nr{GvIKsB!`sm\Q wS6+;o oGympczW[s6lvo̬GFo;俩 7v<3w -vjJy5:xlӟ3/;#VXX BeKɎFAx%=\9s"5N:<5jߚ1Ga|>+}j|9sسEYov8 ѠӀU*۲.f4o嬬gw̓ٷsBs@<ƒ܏7}kzkό#/G#a>y;S>~դhŹ?^+yH7ՃdWϿ5$&D$ފFv#tԅHwVzkwV,={SW\=sh$ t_WOݮ?_pM1~C:wnr@ޜ@3v_z4(U,<iXBVS^)GJ"Vޓy_ ?פgFϓկK{+ ӁEwp󗮅{yaJeջ\6PkC_n,|Gc[xkrY;3C+ovz(goСe[_?qҋ }ֺg/]Q쎼fܸʗ'G:]+?=0g(nn4fom<_x%!̊C~$D (o nvlYJ|kΆYDش%ߤ6H8u?$+/~ҵpaحٍT9 狙\~3C =`Y˷f }pOƲ\ߒ~3\MJ_Yuvn|8}Jx[sM{J+9rNK }j|9s <# o oGympczW[s6lvoys`I=L$^x|q\9%,@ƍP,@;Giu}/s=S=?nn4ixW>\݀iyx+ovz(go̓3 ?ߙ[}&%G,]Ƀ{42}cygSJ+ p%fhӎ}Iwk_Fӣߥɍ۰;q*ժ3B=3vGX,n HI 2nB$F#J zV|y[Uǚָ] okX,=u!ҠF/ P\q7nr$PH/o;3 ٸ~HL+{nT)_,;!QRٹsŋ}-j^aWJ'3**+_gJC x\ేk݊um|À?u1R12S5+d]Mz{dk k \2 U3ߘ!ǹWys[~;w\? 9Ru+׵>{L+{nD!}-̝~fW"6q3Կ\V{]Bؕk7BMTLJH2n #Uʥe^+))  VxvrrBPtX(Ž=㵆5gwW.3u̓U˧Ū+[//  ߵMT.]D?$W)W4 Cިy< % ^_Hg" rg+n6B!T.#%1yg켹S9bwgefKNLC ;=zܩf429K(U`m;g,=w h4 ɺ]v|FUW{\KNL A{]Bؕk7BMTLJHT(uGūA359h=?Krݻ^jޤg̑|s_g(Y$dZkZͯԩ @ܩAEbg/^ W,]$%Nz@B${|Nό ׫y_YA:dAv<0K+?W<5!A"ypƭ@  )U@m3{gc~59ׯz9 T.]Dv87o+eA+ʖ([ pƭ@  )U@m3{gc~59ׯz9 r$DmRu+gϓ#Xܭۙ! 9RB!իhbks?ۖ2uש%WyM@ܩAEbg/^ W,]$ bl(@@@v<D#Hr|来3ܞΕ~3TW $&DB@ ȕ393GR<@8r$/] /yGg B7ne bXx@c'1HDbOOIJ ^&,dܼzpjz(_q xJ~A;=0ot  )U@v@p.\N\;;Sb  fnzi^W3k҈g[]BA8^EW}ƝbxDA tZz٬~?9iӸnw3 @(d0O-jѻKJ~kΆm^8RjbB~IgϕnthUf@xBA@ .+- (@V,ҕX,.!CԻ\Ί Խ\wVF_uFu*NINs1ֈY!+ v}@8nebH$2b /[ج[r{"ᐬXLbόnέݺ`8Pؿnܺ*]P, c.Fr$'PLg?_$)U@Xѹu[woJv,oGOYi;o7U! o׽lV$"DrbBиnefFis̓wJIM P`xVvvhS:s'X°gZdB! ϜVΌ-ےц7CjW+_gMqqD*-={cB^ȸy;jO<\OBcJUhv~p|ˤe?x:«uWzfef\_;{+1)|.U@]6U2{(~׽l֕k7KJ wW* ߟؤ^̥v%=˜ ;jѳc%TR2+! ڑҿKMxv̂<jBynP!36õoWP,n U,vG?G|Ԯ|;! +}G *-nK@y-!QtC~ҕ̬H@;+o?{% #V(! RP(\;bPlu_\2@~k҂U;S|4=KdΑD#Aܨ>sv\@<bKxnBr]6s])jDȊILr[mӿpoH?7CoMU\aWs̹y  +U.[4;)9!x{7oex-'wj~YCw&ֈNpwoMU\aWs̹yoB=^jĄH4PRiiwsȇo@ʷ=u9a3.~+wW.]D؁Fbq/_ 8z6RLZ,X\$Vlsܼpܩ1HLx{zN >PZl*f9{CP2Ys?ݖ⪖+#pvfb;9oÏ7xvxNG}"ɖo!k-rٴ:dE"P"-LBw'?ٲέC6unt[*-^0_'}"ǣK(P(Yê?-vI|}7o U,vG?G|Ԯ|;/^ @B4cxkƜ[׿(oRˎ.|-vVLjy[{|yr qAx^rlBY:+3+cT.W$;_$牄.]@4Ql@ic:gΕȝ#9S6Їorp.Y@, F"*-3Q}LܹR |JΞ8UKe%&DDa'wj'wj ,uv_ YH{$FR @ys&y2z*>x\$GrR y>RĄE_|2i |(3) y3zn+BݸVHN !GOYVqڦȓ3!!wח^ǔĄǚֺ=ɱpB=gȕʙsdQYVߨ+Voy>RLX)A:HyT2{܀47D"a|ya7vm켵۽Rh^Vde拯/ɽ|) 5um{cqRfĄy G('G6/~@ޜ-^(VJ6}-v@'G*)3F=9 bRE IUKez@bBĬ =LM !!wח^ǔĄǚֺ=ɱ8ȑ @{N|kjuo E[kΈ#@8n>k]GUS&\31!bћyr73+b"/zHaa9{mT/6 oU(Y$Kr/cJbBcMkr۞XvLioސ3>7@t@Jr^jU*O_pPjrbAB>t"tCh$HNnшK@j=?}ʵ䤄 9) F[oΑ! %5ј~m{ٱX(1!$$D;t@2 ?|:"HHxM2>Pƭ̬P( 5GR@kj`[7nerH‘wɨYY1 ْ`q^JNJB>t~[WCɉABBhҰW &'pȘ~mĈ!O丿fʔ,.^˸JMN "F=:X3Wdelk;:_ rJ ʍ!H͑h@piwlIIQ>r6RZSbqS_z5!!$F"׾n Α#! %9wF\`Dz.䤨?}ʵ䤄 9) @(KZ_ O<\Vߺq++;Grh@*)çc.^v3$'EAUnr܅X(591Cksv,{"wiRP8Q0wl'.fe$$D䤨?}ʵ䤄 9) @JrW HI "T(S8{G.tj]j̎BɉA(B nhҰW &'pȘ~m7A@Jr^:sc:7$'nшK@kZcMk近"V8Cs$p,5ys޸q;#)X3W}42D"2O?rRs$Фa?w!+;JMN B1\wW.FÀ(/g @ 7nB9 mp@wݚ2wcNEjT-|O?~ H͑ e ghe  N fP<J͑S.w;'PL>sʵ䤄 9) @GϴF6 n(@$'WJ#)SPaȓ+%HJJ "ѰѤ 11*11@BB@RR@(7wJɕ@bbTbb4h~]ݘ'5CJ ܱ/P+H͑$%E]v3Զ{v#ɔ>!kBx\ޔ o 11*11@)@bbTbb4$ !!N N DĨhJ~# yrw=VRs$9Ĩhh@Ԥ#F>&}spH4,5GR9R nFysys] C !!bޤ^W]⁜IG{^DLF>*xZXųREo/wjrߑ[B[533++VfV(G4)Ȏŵ[U)T" ʖ(]D!pHUoPpHFCjT)3%=Jd@; yq[ Q{mQB9Hq+$Dnge Bˊť$FD@q+ˣ}-xjFxGC..;烉}_YwkW2Y{ф&|7$%SvRrYp33[!38v.ڽ}Cz<݂Wf4bႹ;>yu.7ney1b| }yA?ܡ A h@F{e̶˟R:3 @ߗ̊i[?JrŲ y{ =ū}+i ffU_ұUH@ X,ˎ̊c} ⫟A@iao,;OkMT Gc{gT+MV}kgxpbXvLfV̯x_ @(ڭ̬ۡ^sVZ*P\n !Z7 Yh4 oP,+O`;S]vrŲOFJ J+pvV(! (Z8_칧5{}ICAÉwV('WJpsEW) ?}!:糭9:np#@:մBy,3"MTu+3+Y[*%؞#1!b?)FRo?'l} )91!`Ɖs/ [Jų^_:f!AVfLjjrt;be L.׵-?HnѨ~O5>iƺڟ O}cDoސe3[{̥HJ2c7oez.]0qݮD"a\ڟ O}cdV鉉 591a/$No!ߒ[Ճ|FJnf.&gY13|sgr@2_jZq8qRa+Ux k^Z٬p8ȩ1Sd5Rj=[<>ժލa[G"a߰__Ռn?7|kwz"ߒ[Ճ|FJ7C|g/$%&D6+wmy;+c c=zYjSS \ӯ ZJRBQ w|ȧrl2=|d_wƄW@@Vf,E>~fxuP0/"cMkݼ3y*eY5?ϳzWfgG>Z4smQ϶#mumM.^N.'T+—\?Xmи^۳~+WjJ|XV[U7=y%GrR $& f#mumM.^N.'T+͛7lVKg>~K~zԜkf  {41GJR~}9k3^2ˋVL]s))1b[:>Z{筩:xu @@>u! s;nAߛĞ_$&un&\K>rB4gJRp;3;$uYMS3?bBshwߍH$ ;ΎΞI/REY?gΤ/9w%[Vwd75v8l {jLjtmw~{\=GŌ\ۡȟ'geqvhӼaϤao,[Αה_̱>#qkH}G @@<沼6qfn=\"0HNLߞez8" sL 1sW"^Ynջ\`?7A .W*-ٽw 4õ>XŎv/XX6޴᝷C&'&ŋ Xjg/vXFKI^8ҵ?uhݨkVjgϟ\&=w# ʌ_twmzi;oB!,:C & {ciZw<_ ol;b|>v̵_y-׹ysΞIGO>s]UJf}s^6 ?}۶mm۪TJET!I@HAHֶmyyفH$Yq\<Ѓ/!Bb!PyEQ_uYgؽ& yOs 5,L=~ee:.{Tۺ! CUӒeg_yx5ӗODpx&Nm%aCyCz<˜.|!u  @"ٱ{ǖY{h FrUK^ D>ަISf/~ؐqސ5ϯ2zy7a?EUFtܜp¥+eS[ur#j3Qwz(?}݈!X}ۣ]'Vve|(7'+|O3q* ss UdJNvF]&ҢtNFfET2o[kA~vwf=?}!#7;#H#ڷHdeŽ5KA Jq)Z6Is22-Bk낫.x脣;U <2;*kܬ0Z7/M9Q{՝\v>DcQ+,MaBhWwDɃ5]jxkxLp'Tr| p |TMiQ~@(̈G<Ңs\ͺ3O^<꧹TW]4 Gw.x6d wdmkVsB r2 hݼ4ys*NwDUw>W4.-LQZ̈!w﯈6{·@FկeS)زskFӯ* ۳C]$aIAy7獙.:2@um/q}"Fu\MN?禝E~7볎a~^ks2t*thH2u@9H0 55uu;OݸYso|s6LUDkAn,B"HDIa~.mr@NVFk[vA};׾<}5K@(qi4TֻvsqlՈs* GߺH3U=̻J ң_E'A%_/eSFR67oR ",}d*́}Ծ׹5uu;OݸYso|s6Ldg?yڮ}啑?)gm0.u%EiJATֻvsqlՈs* Gߺ7LA@6/Ͻv_4Ln^w3?/cy+/9FiT2u(k jwqO"Pem3>4~o:LtZ R6o7Էss׹]$@ItF4B!@ bu ws3бMsD$S)&LOu^K @(qi4S!fg bL9X׶EU~F꼜.H$A<վM䡪h`e.5?o$97۽}]VVM۫~b2Ad2rm%g^?/1V@um]5uuAVMܼ3ॏ Xۨ Je|=>,,/Nh$d* h׺Q]F)tX &mݢ4NԾY 7|_~^5cۮ1%hW_Y]2:grzxăߋ}Y'=vor>~ܼtWؾM;xTX4.hߪIYwqAk4OMytһLUDܼ#fH4t:N% r?%[3*ӭ] rӳZnmk/}\0횡"@,չ]$@:y[% CкI2 .hߪIYwqAkөP$ hߦQ :4I{[(MTOlpt5>.vh L6mZŢ:kӡQP9sDA~vC?m'x:ψGŢQЬqa4="KG HC{*nҾy @%|߱maK6Ȏ-P`􉥫ܳ:/'3 aP$P0az^`c/~L-{*"PfDJ6MӮ;瀀xFuR6l8czA" ^]/1rmBÒ{F?KzB0 @H C6Ȏ-P`􉥫ܳ:/'3AVf{ ! €cBФQ䎽*f ӗӿ/ໜxY'߳a*нsz 0 @H(a(D B0C@ QR:m샍`}NؽPu]]׿;㓯80" 8: Du壧>]pɽ{umSGi 0$ Ca B s20(-Kef˦U9aF<&# !dg)s~S/.F#B@AAV!ⱨ1A!zBDDЪYIi#%;3jR2H LOegTUA ֥$ ;#QUUAfF<ţꂜ0H%Siٙ1JէҲ3c>)b( 77+Pa2giq.Ս8븪D2hrJn7>`׾?Sv4Oay`ʢD dģ}ľc:0ꟳݩA~voddggGo  C?N?!nYTg]PU8G+oTT~c+':`VFT_~W\;cں`ȨMk+;kM--YݱhѾyڼ3v}KKV<1yw,ߎ}ы'=oݙahʜ=V70t%%Ok߁yi);Kw;=o#M]j{K &<8+33| 6Hm۹?vJ=6iw$۫}h_F@vfFD7l߽`Ecw\ DD#HAu]]0NT:"H{ʢ{WFwjaLx~YnVfa3в ?;_/NnVmoݜyߍjj"X@ũtmpߍ7o\jI|xQ9a=kޞ]Կ鏾^ #=ЄNHRO_RڴA5̘xAك8TL}ڐ{Oߵ?eDJÒԬzwm[`'eģnzhِ㏬ o{;"шƜ~3M[xdYQVocnέ&>omwWV4h[ʾ%Yڶ5e}/9Uu~'ݫopnyvFϬm՟{r慎[x5hso}? KSMt[&۹?z7̆%^]Fѷ,jp昽E9aum]0E @eGo8'?ܺnZFцw/:oMc8h4lߦQ2/;+ܻj>ˇ5@UߙBQ~N9ꇛ/O>iӣs;E/ћ oؕ/H㙓/*ѹU Z7I".[7a=iQIAꛟ^l%Yu<1M|V1 |kO}F{ RHiIԻk~ə1x,b׋)v>o{;"шƜ~`}bHt>fg0n؉W?P,lwW;i{{qX={_Q\HiX5yXYm *kתq.ߪiI jkO6ʈGzв!Yoع<6OZW^[׮φs3dqC欅on} vQΘt^yW?nȜĎ=+oXwV3~sнzo8 dK?*xGunVִaau#:4ݵ]}$HC3(2X{_Q\HiX5yXYm0oryDʨ?4~)H>{QhS*b}%*#/;P?嘪Gl6!-?嘪Gl6!-?猟\'t}C[7N@"ҏ }|ѹuݬ5mXOx ^xԴ 疝uQ55 =|6ܲN<u#:4ݵ]}$HCQ3>+qNrIbxg9g/#5m¹egxTMM}COleģM80 ͘zQ:v9Mz]% #_KwE +"ܦ.$ϭ;8sM L N;2?7;{Vu}>Uʌ30$aH!!zGkմ$y崧='SƝq@y㰲+/tk/~~J^:~GA6!# ;ִ>$nH&Ɇ[7IX0yo5uQӏ\v]ןSf:SVvhݴ~}[.׬IqjŒ% k/\y_Ș8kZ5uܲ/˞+%l(? ˺-w=x֍?O`ƣ+V<1iW4жUķ޶uY=VGG;w5()OTVcn]3=t}>].g+~Ʊ!!@2oܞѢqQ}JGݼьDw]V2tHdp#ˊgx#oY+ f$eݖYV< qx_Y]0E++ kG5F#h۪Qwo[|xƣ#һW7dwdU, a;f_|Үʢ|!YݬQQrJdQ3KzǝQ>~s\2㎨tw=zcwf8ʋ|~Ś ߸u䵗90ߑAx^z뫼gjOfV,8ҥo}wØ3'U}BN5?6;mWtp+({=; Y%GϺG޲WVxtEъ'&us^Y-+l{Ӎ7H<[.W 7=5,n Dvf<\yztJp}/jRr|{Vu}>Ue;ݯ @y㰲+/tk/~~J^:~GA7>{魯=YpKe+N?%_{ֽ;.+n۲|ޚ_s[}ƻ;m8ģOݩf^} 3<e4z*ڳ`oxmP ̼qXٕ:5^?qf%k/r`p#k nӶ̌t&EϿyKo}}W̊g>_/&_q~5.ݛ9wYqۖvvo޺7~e[5ݩm pT^._ qQkLÐ2νHfgCa?W?`ff̑Lݭ]Ŏ=LMK =2 cތX4|ŏ>AY 73 6\y'ݹ t7d9km:mVkAsfTVٙaZ5+MMށuג=VcF֮Ov{2qPM0OꌌxXSS^[V[& +#^[V[&A~vk4 +#b1yT||a7y셏 ԫ(? "JuoQV.ig@eumAUԴ8_ךw-ixߓo:ˎh4 `9pLvu}sDj}TgdÚ5>8}:Jt2Y5>8}:Jt2 GthQ^]b1Ьqa2N@< s3Â4\qHihӢQr}1ЦqqgyꝢGWLl_jjAjVHp|ũ1smݹ?vU#WF@ɺ&4ȏx,eYe-PeM$nZ=M&S$a(H%Ɋ׮>dģauM]PH psʯұ=;W唱ǧhְA~w=/48Z[2073(;PYWyϭ # ocPM[dģ!bQ99!APQ4k wɻ~XzH$;D"kAuM}gSig]PSx4_~(333œxٙEgڼuO,33#Ɏ^tFߪںbv @A^ L[v4,)H?WM[ܨIâTNNV[5Ilgg< CATd2@XTNNf6Ho煆ִֶ.J}g 8*;;3Ɋ׮>dģauM]PHCɛǝQ>wY^aF<>2}}{t8T{h?wպ3nyRڱe.,k٤$P" 5l߻] ?i=4*n!#QX޼uOYa7eL(.M-;TEUs+>/ȈGۮ9GVuFd'?@Eu  ޼>VMKR,}.7D"UӒT%5ݴ1w\Q1smݹ?vU#WF@ԝ,+^, :5ug5OMw{|#:4zI EṴ̈ /; 6Ho煆ִmF c{t m(pluA- sӯ6;JGQmZ4Jn۹/ЦE䶝bݴ1w\Q1smݹ?vU#WF@ԝ,+^, :DдaQ 0tHں6,JBU 5ug5OMw{|#:4zI p)mܞqB׎-fpaY&%)?}j_s~hqNh4 "A{Th4 |dY_6fh  CzUдaQ 0tHjH&S$!6Igff1d* VDwƳ2aڠk߿1s۟w:ւ?1iW4 C04.O}q_y+.9ʆ%iŅixry\U45k_EtD.ygA^v:y!*#/P1Დ+0Tv2~x~~N: r!*gf_'L_ws爚~;?.oɜwwn4x$DfNVVY]ʎ]<& KSlq=;E"a،ǖϺz^\~_!Bh"A!B}[2ݝ5Myg^+ uH $ +#}Mqgѡ.JI$Suӗ4\m'DP ɤzo5uuAum"(ȋdO[x+ST"Dd"Q\ǢaT!BB ѻkW]>ɷunYߣsZ6L>lu-;lլ4ݱ_os! D!B@₼T< C?.oɜwwn4x$DnNVxrUQ'kW QVQ} \sh4lPQQUtغ7fnsWWZV웇Y7^_kkDa`C1NzyJ^{盼Ɯq dcaxs]ޒ9Wܮi;=ZI!**0A2 r!@9yXYeu] +;nܲ7vG4,Oͻ㲽X @?ߒٯwں`Œ^tzCWYXs뢆 `H=eV|ר(~㎌tH$`瞲 +Ȼ~2cM/;DD:nZw↿/sW\rq K  Cw>>xw6k\znʪȞӡd^}]tbN5/sf d* VD_|dջ;kkmV"Ķ=e}o,Ķ=ec_쒳U@VDC@um]кyÄ "ge;Y0m$^;~w,t*hݴ$9 Y_*!@|dYqm}}֓7lָ(5yUT:j^V|״Q$?x(ڪyi ^XEa-KT C04))H7/z>j^;~w!v?3ĊW-yw}wɻao$cA$LSA%q/n2/?%gWٰ ! ?mNR#;YV\[_;5.J=|M^eUm$_5m j^V|wX;@baسP>1II@H܋[ah=!QMk~Iա@UdG^tFʼ`=+.j+wwԲoޕ! }F 0 <Q.+ &>E+w==^U"5W?ip'lѴ8F-Yy޵9o3kIodoÒd* ~mS; C9}t^G'ۥUZo,aC!aak%[7>Zeģa, CD2)Z7NTT)';ԫjE[4.Nvj۬>اs>*<.խ&o xc ;  [į3ݭSZ4JyWF2F޶Y}fF<%{ʣAB۫~y/ /[Vu٩ B03ڷnZ$Ix,l׺q67VFr#!@U/~ٻ[G`x4 A,ѹmz0 <Q.+ ں]&&gGɗW58gǚt:F"ڷnm֯xbVJR@4la"v'**k{{`e>rұ].]U8_= V1N:K¥ ZgO>Pف`G^tFʼPQAnꁧWݣmmuu]˫zвHDi9j0 C9j ܶi=@Fۿie@Pm]]ЮUf #˫׳cMVF<ݡu2]&e{d{O;vw֍_x˼vc_%>=kn%cۦ+UW_,_8yGNsSA!@,ѹmz0 <Q.+ thӤ>LBBuuAVM5.Lώ/jp\ώ5Yt֍_x˼vc_%>uZ7/ڵjRߎ}GWq{klrtU$HCd*MTG b(bBry9Y1OZ+ _^UxUyٙauu}7:\@^{Z١n—W3wU^vfЭcKWqE!# g̞h4BT B.:OUnfF8穕/eD7>Vfģkk|ыo|Qc.pp@εpmjrwӯw/~TXYYpqM '+#|wł"/?w]0tp]pl *ьpڴuOƾCVJRMK SMK SBMF[]0~nSүkUqܔ!Br23C!B!B"ۣC¥ _4\x16mݓPMQ}"o8q۵C[fGTfBس_l޶']#\s3Bx6m ]#\s3Bx6)iaiwd˫ [6)I!9!!BB! xKnx[{T=1cއWx6vzC]~h4B= D_]s,~5oۼ4 h4!B@HNff(Dȱ=:.\E3Zsh=EZ5+Iun׼YEg=F~Ʊ[v쏍&>ջbAҭcKWqE!# g̞v'wlUwMaHU rSn;EdNff(Dgwh/g:оuĈsO8$ ׻S͂?*LⴃPphz̡M[d+;iլ$ ^_0# wX)!m&\nфN9?[xѡE]kذ=횳&bC{]m[6Jve}!de=ph4BT Bg_1e ]~F<>U_JEQ;!J}ۣC¥ _4\x16mݓPdi}+wW4*3w/HS8[ڋ:r—W3wU^vf DHIa~̱6a9tƀB냿7̸aiB냿7̸aiBt!2?.?# OxTժICLڻi4ҙ-`̅Ժ#]{3^:p[ ީU=:_:u͡}ƉpH@ 0N &w;۽"ڬqajWLr~}6M|ʝ 񨜬xжU䚗v.Όxԫ>5vCA<cۦ7a'%gW g`wl;TUdgx}6M̭9מS>eYT2Ȍx< ';#۷@ǶM߽~V_sm(flm&|m[5JymxGMxۋn x=0iԩCdxv piT2 O Ɋ7( }՞rs2CsCǔh۪Qrwl;TUdgx)! rsBm͘x?|fh, kOܰqia 7dM\wuLuP][1fN=6i{NvFxU5/;X=yvoi=MOQo~-ftSPS[,ۼ{(x{ՏTS 7 aʢw>1E7m+,MeOkSSjjË)Zw޷O=0tAnŷlƢkSGnY][h\|Iۣ(^|h, _LѾygg6zIۣ(]vc_r CYZڽsK>@&lOukE sԔmŅ]+Ll+.O@}"qsZ̻s'0sݩAng/*-K]u1hѴ89a{"0JTfvbjE!%"OϺrgiI~*NUuO]rۃ4|1(x<Vao^_XD2iO6ٺs|}Wlլ$YU[,|K&>E7m+,Mlٱ?k\|fCdo~ԭ/A~nM$ɏյgkgһ LYffFh\ ugY9K}Æ]# wWKѾ6̌pvF#𷿶dělwiQA*h$iյuaO}Z@2&A$v)W޹U} CSѝן77;30 }Y]7/,M/hnӢ4 O7^>4o\7lЁ[to޸(5nؠ-~/ao^_X_ ?7ݦEi C_wV r/Eq:Vwn<do~ԭp!N{3lѸ81G_/9{NQ )4|e~kn#F"\Cݏh C]^Q㒂T8T1fx]Zak¥>2=XisziT}_l -_p㶢i  ^!wŢVG,0$?98?5s=۴ew'*ԮYҷlЪYibuֹu}"pDž-_S:{6*Lώ-htO h$ЦI}nNVpI+,[S t:rw?!\6| }֌is_kmx$1y/:H$5xtYC8kT(U?p_vH$UTTE?!wsʢ8p:2WKx<N½V Ma֍Yc~Nj'm'mOnZ\ynUAaA^2n&+#}19pFE RtЫje?Ao sy{Գjݱ;_Æh׺i [3}ᶝmZ&=kD2iҏ [ujU{ 6mT;bcn]԰Ku׌R~Lhc.kضuwV߭SI#O+ҍʸ>7=,}啑XQٷsa7_yvYfF Ma֍Yc~Nj'q]es5lۺq;֩UZfve\pjƞY!|oe,%7;3~W?/Z9/7Zt=:w4[mYi~ܺ 40 Nm[5Iæcw> Rk;-|4H{&sDï|n׺iah*V!W4ˆ?0$6n\ 9hx7L$R}:Wus7l͘6vG"G3E"aPH,?+1,wѠX]?ḏ;{ٶZC} (M$RAiq~ݵ]"p_YElo-ۂZ6{Z5+M@Mm5ǣ-Woݫs3C2w==Oj+#=o+ň~+k7Kw9ۣC+-K_YYcρXOp_iQ^ C)k|Jnx} H$.k [V0|oF)غ,6E o^w͈!tm_FRi3XQr3cZC} (M$RAiq~ݵ]]:ʯ~q" .?kG|  /_H'Ţ Cs󜥍VTGQPF{rCCFluCʛ7)I{rCCFluCʛ7)Ia?^sO߭ro8d¥>|M!tԪmڨ0US[<;Eo|]A< o}gYUS[<;Eo|]A< o}gY[wܺa1kT*mҏ {Bsq :Ea?^sO߭ro8#OIs'n'ɤK?.|nB֩U7 ۴Qa>xwx<~͹Գ>xwx<~͹Գ _/Mӆ^P7޸0/u9'x⅏ i>@ۖ|yUѐVG"WYdm]"Տ`g߭Ͼ rfMX$N4_lMg_}ݻo/X, 32x@˦% ǜ?,W~(ڤaauatZ:Lյu[6ֱUncqe߰-L?9;7;3|۟x|xaKYWȊg>_\5N㎬|h%{[V R'aIdbs[rL5HgOdwEg,iL/>5c+.:؊Ͼ#g9[ծi֫кI^hҨ }>W4%5-J^?cId:L}Z=Ͽ3KO.kݬ$F<‡յuOݼ~ϹW:Ң4@2 =Yijs1efw^wH>Yá'>ԹmW677n/XS0|Ҽ歚&dp㎬D"UD4o(N@FK 9kË-3ɦ{lq[~uN+Kk[{uL߿hek~{w=2yY mޑٰz셃%R|{:=kZgnE⋂o`wddE3o/ nr8sPϪT]7}Ix<vRŢT͚%s͎)_l|ŭO6F=m'k|I~NfMڶ}Wyl >c{^ Lll֤(kvLb+n}ٝם7_pɽצ}ҾEV7?>iC55{委|O*~Sg}Z8wDO(]nO$IVM=vöoQp흋-[IVM=vöoQp흋[w;KCҡd"g{f&Eg\c_q 0}CO}("[2Z@QAv[Vݙ9m{'L}Snݬ4 @˦% 6-Gd*0LH&R_wd6,.{=*#w?zÙ7 ӥ}ůn07J=6q{iQ~5Nں`_NϾ[}+?͚%I2tflؼ+ce&|ɃݲYIiO7]Dž^25c+.:؊Ͼ#g9[g߭~uW ^~{WD'\G;uxmFNSf˺-w?zÙ7 ӥ}ůn07J_|X, jCW]?*9eAmK<ЮUw7ܿҙ𜓏!JO:x,&NΧdؤmw&|㏬nڰ8y5jI僎;^l<}Jo{Fw?':Ȫ{y+=HD"8|߸bMIjV像;:xaKYWȊg>_pp栞Uݩͻn&x47_E8To8~Y%G_o8a{oQ f>FOھ?rz杒\ANiO7mX\*.O=;%OdwQӞnڰ udee^;MRM'߭A~V[ǖ]s5Jwزs.z!H$7|V)>i^VJW_2|qGVG"/`_6X<Yp盼˂IN+w>\k3]m{/kضu|_n>Yvmwn<p栞Uݩͻn&x47_E|WW~G۾gEt=5qDc{^ D{}>Š5'kުYiK>H$22a&EIxaKYWȊg>_LuZCϼ[_n>Yö/}Ww۞kӸs H$ӏw]w4wTǚo-.>c~dɻ%䦿gzGD0o ӹo#O+{`%̹jǞD-٣.8߮˽}y{ 8$pNHԧthӤÚ}_rto~`e'ؼuo6r d/r_6fǼ!ǣWZ? 3mGwoW{Lv;ӣ}dhZ1E41g%'X+*۹@tۮxmk2qG^[_tվ we-?} '>mF7P&+j< SƝ]VZ|h|G CYi၊hqA^ *Z50232[fg{vi[W ' $pNwx46}Eyͽ]:>ӣ}dAN8x^uޖO9[ڛ{рc:W١V~ie,zd}S׫c_Öc6;rs҉T:u=ձ&#;ػP4Nۼmoأy)[QIA y- rB(l{uxmMm}ЧGox<N9黮`ߐ3[(ڼqQ 6)DdgeXw߻֫-jƇ ӹNt󈶵J&:]ƉTvFFجQaK/8`,5oڨ6m7.IăXԼiv۴56#6KwL8lp#\U:["ޮvyxՑtʈC ##c19QX1'oܻ(/ koy, x rs|Wh_-Yaz F?IG+ ^hx2jk#c.X>.50_!UG"ڷ۵` "N[0PU]dgeHD;&W6x*-GwoW{Lv;:zV+P0?' aJRiDE 䛥|[Vt(!@NVfx p H$b_tFCH@â=.+]l+.XյuJ$R\tq=vqoҾyݕ7Iģ07;#ҡE]$Nⱨܜ7=`Eu DBx4fg]:D"‚4k o'|mC" N8Su4>I}[n:6Zp_yeYVf<ss2Ґ?M[vDz2anNF2gWY][@< s3B.ZE"tZaAN "-t:-Tt@< s3BhָArO&4cMBnu9^fee?v}gѰ>Hԧ4iXm$nsS2Jh>ᵇ*# N]n|١Eݓmլ4 P2 5n\7y @6MQqa2?73 ѰAANz=捋RNƿ5 [.\ퟹ]7r9iE#aNvfXf$M{oСMz-{Tt: ڶhTpQkjn[槖mA2En0}8@ wo9eA3GէGڵ?ozpʒm;O߭rĹbQа uϣJ) 4--NB$qkhZZH$!GW@um]0x佭Ty)c,E|\?so^w rp)+mܖyۃ4#;{򰽭&{[) <2m>=׮ycփWl۹?~Jn#0H@kb(hXTekݔ pŅ˃H'!8{Uյu4--NB$q JJ楲2!@ !@$1~.yaq~sc!!*:'\v0 ۴- 7u*ZNIYye>GT/Yy oܧ{y)TZkт?,<9Yt:&i+0 '@",IA$Pxo.iKE%?+$ijb0D" aB<M#<[)SovܺGuUQX>Დa@edݦmp~:QNyoH 0 $)O,p0Tv2nӶ̂T5lDp&xz;R鴯ڐ=}޲FQu|Xa! a( DD\|x!LG"A8EMsKֈ\|ֱK Sкyqb7lѥu]IanA=+0['0-QZ4-I,{lڷj\P47'+DDt* cGۣC-lڲ+~. An*ԧ/Mw_۫ț{'ߵ(? aKj7޴YԒTUEdgf?0~{P++{镥'өꅇ&lܮY5M4BAP@.~ƒ&N{U䥯iBE rSx, 0a0y+>\[쫷wмM;2nF "ẍ30 Leei)quxM2 TpK^GvkAuM},ӣ}Mm}"2t"࢕r̡T*C!dCE rSx, 0a0"H @Yiі4o]_ښuŅCB!B@0DX^-xv;uh^צ?j#AdC??,1zgayEUt'Oa*;PYi[fT4(jBXQYֱuw+?;OhowŻ~|E{ohw^j(u$ \5t/yW-{m WQx!+>\[쫷wмM;2nF +P5uAA~v !D"8|OeeM$̊]zc-$NlWj"@u[2TSU[\?cIa=x* WL]4 C0~ӎLv)bMF% 7$aǞ +4n9Yo۬&lD:nVjSM~sKֈ\|ֱK SaKj7޴YԒTUEdgf?0~{P++{镥'өꅇ&lܮYɴꚺ:(n~oW|Woԡy_vdЫBض{ !|_YnmߎK>A@سP!T5D"!Ό4B99imVCE@" Z7+M\5&%k.>؊ƥ)0 %5u oҬqQj "TBC6-JCxng%H!<%\ٙC0Ը4?ʯ|ze tz :k=e/8-W ˟f9F_wg޶Y M t*hݬ4qմ疬Cc+ ycv2ݏ^RSW-,.N!<iӢ4VмQQiQs?+h۪Q5bH'8Gڪnd7$H`1qcTnZWmܲ;gorѝouQgOۥk O:Ȫ ;?Py/:> Gui]g?ϿcN4iTL+(+|.?dM}~@M]]]&gg|+;aUҡeW,YYT:D Oswjp#5z8s—?.xlMK=J[vg<|"6̊=.w ڱ]GWOgyxϽWܰA2ӹjT][D0z\=tSٹmzk٤Yԟ/zeUqG^N"AC& Զy'omӼa6a ضY}q{k~YvTFTvm$*Df>ah]"o3;jGwo[ii'*l8{PC ^d7nGcٹwyo}}p0Me8'#/8`<#.`mgxRPkk#JYZNҠmVuObxX?ޞ1tܦQj`}Udf`@.m[4J@umm LX,lצIPMd%A,=CWܺyʼn[A`1qcTnZWmܲ;cBݶ7>'==;;EHRA$qxfYW%]Dx{yKp㓶uԺ.?7' ڷiZ_$ 4IT||yUѺD"E3C;ӯ*GcayFE){ʣOͺrQ]@zv9> L6/n~o95k]>佒Ͽ[}t>~ŧ^u_gݽ}Ͻ_}x4G#:k 8УK‚4EڵlR߬qQvNCH СMtjۼ~㓷i0 M& LX,lצIPMd֧GT-z哢!wN߻`EsN]1U^hݪs.X{W?Py/: rS-^Yzt5uE*z9{#@ٶ;cq]+! Cl۝1Ftn,pGu9ik٤Yԟ/zeUqG^kݨ7?opX{Jgvտ kxߖb>AɢvAC& Զy'omӼa^}7*\m;Iģ5Kasѥu]aANڷi\C5uuv-7k\E*>ë2vտ kxߖb>AɓѮua-۲s_?(Y4s܎7lXi{DaT*Nۥ:ģ  '߭rXTh,deC\<;#oZr2̹z{,ѺUDQTއW Gwk[_6ua! C{G޲_{*Of!23aA̓zZqG[Յ@¼;y4}JgڱU_deC \z>r7> 8'_W '=+v^sS{ǣaF"Y7 =Zy=b뎲ț43s޴QQkV5NN:ʢ98ģݽ)@6MB\<;#oZr2̹z{,!@a{fquR^]׆"B@  ۹B 0{|aqArKwӽ}m^s;~^D̾]J S}o?u;偗?2m9SG3MO}_kӽ}N)߱,rs3û&^gƼe_fCz{!@N}o|]A< OpԡO=/EtҺB@tA"DBq[|KuzucÎOQ !BdeC ! o5^9_ g&m]sξY2.Ug :7>/ܼmoƼ;GMXq1̾]9r׵w-nҏa͗jڰ(5ig_W>)nѴ$!BdeC ! "HӦY6rgk1f#Ͼ[):a6p)}{WD4otxf N{0q+(iAsL?3X[Vu۞lx4\x4Itت s[IYY 'm[5Jpyccom[5q Czw^GŕuWQзgE|RtmSgw 쯈i0 ]K?.ǣS^# дQQiT-&~ze鄑d8_֥}~:VaGz{o&~f۵jz{o&~fۣш  ۹B}+ǣ:׿%ô(]ZANd^%s`#jPON> JlagW2Mx%ڶ撳Wdf¿ە1l#-w׶5տb'_^U|އrs3C!Rg_@+>OtTU`㿻3&:.Deu]F^@зs .=SxWGu蓯K ͙:bi:a'w?ⰺ9SG3M_>5n]ԅޥuwhsNs+h۪qsO8@зs ;0ڬQQҳ?8wx4<}Q>М#v뙦/F_pby#3uw=t3[ N,֥M++O9@ +;#޹u-i#wݱv7)N@HmWpxf+i+xBxz;  pe'<WXYLb1!wiSūwo>XYLb1!Գr*T5OxW@AWY@ܬ qYŠh@pKw !Y>O__m[5lpxf+i+h۪Iw{:bnf~F-bѨ&o'z! 0ye\zry*@nNVS:c`C55u9 q)}1Ht AV}~tT!GW>):.m[5_VVGr2ӱX- p 4}5½7;kdpXF9)0$PUSC9Y!?sR7 :o^ZѝI&SANVFDO8o^?qہUxBIQ~8XʌYY!hPZ|5;k !jZ8No!ʋԯkGw'L9Ya >}PRzemVE2aVVF%EWOv`U$+3feep\N.H!"FMYY0Lzag|ɮb9Y!DcQï̈E6MdP 7 rsB(lƢrc 3#&3#X, ++@nNfE 3#&3#dA$PXOCU5 H 7 Dǐ̌XYY  r9Y!deC(l !@aAn 7 x+wc+-{th,*7'+̈̈23b23bï̈V5ɻ?9mH 7 @nNVEq4@nvfDgVw%D"i3+K]XdfdfBi(l  iy}+33b23b!@a46M}bzٮh, !Ң[N=GeMM}N߽> jAn,b1O=vǮbдqQƽ*@UtvCiHݾ֝erk U^m7 ?7 e۾+>-~fTh7??!6& HBѸѝ!>6|í233%Ҥaar}X6iخ]զӡ/~Pka'rh4f2fUGڮnX\+b<3:=u[λ6~K3*f mݾ76f-߬xxs[5]GunS& ܶE]a4lں;>7,*H~反2`//* -[KԙVW{[ըY:~۵J;>s6]ins*=-V֘ckTesK3²3u8))!xd5?\sqw^}׽c}=iJF;ouzD6#u3{9rg.ծeL?4{M|ɏ{nVJ%wtmC8@(]yGI 9/ @"0 ?y&1/0rkvʽsV}[unרPs^Z[)ԭYxu>䍛לڳXb<( nZhɪxņmw*vl̔ŵGtxћm^y:˿53^ef~7-,(,ul׸]SAܺWzs3E%%aغa/$D"[7;|2H:J ]E)-U(_.ukV.}1G^|qHFT^vة'o;ڭ}‚Pv u8% 6ҳ3欪>>gs4)+ ulӠpsKkNKHFPZrr $>w!ҼAH ~M)P 4["8X,UrI4AjJ?rS3߭Ш^P kr'NI]bQ<6ꚜ#'D_Y歮rθ@"^Blk+m{_9ۇ<" HNJ(i:- ! JBiqB&|rwj?yQmػùTrrB"FAZAyZP(e+  n3e4hTzђ? m/奷T=zL[2ҳH8z/|wf<*cr<%1)xa'ՊKbp(|>>w!Y\A<(+- AYY$ V{aZ5Sǃh4K. @Zrr0?{>_5#{ΫNtUP( z 鯭}nt8 be!᪋>9v;6 w]sLM/D¡R%piTJI $!үKТQio:¢3" 9prS3߭Ш^"sFees6O+{MKN''%}n%Xaj!W}U%! f?1hvM ss =o ! ‘pq5*m)/g:AF (+- AYYAXPZ(++ \/ /yxmRe[-|1ï<qEw4)|2HH/nxźJ>`ߡĮ@8 "hW?])s3jָV}Ǔ&Cى]5)Ҳ|tnս:AK 'd!!!AVT+,W}xjJ|c0@BB4/;=fg ټȿ&/W‹fs4uۮ鯯ѳK@fFh$8@(v!RSXX݇RnMV9 ֪;zL?$k^Rս:A5?%PKV> oKiUHjJrY(DqBNH׶ a ‘HXfFh$(-+S.9){O|s|Yŭ+WL/ ڊjűUB钏WP?XxWRFMij=:6{g7UQ,!  PPT7ZCw9{5ULOfmh$@$R!\w,y? {tj Ι #B =-,$B~Qx{nە:U5zvi;qPXiY )1!MgGJKh$@aqiSѻufksy yk׌2JkUXq~_Jj%s K>򁣧Nׯ]5{vNO@fFh$ڜMPƵw;45\jRЧ[|SR_r8[>c_y&N͋hRFreU( 6jƞ'ڌ7{fO?tZsfÈSѻufksy yk׌#>  84nƻrk9q_[Q8^5U(] ˂ V(]/-^SGfy̾`J Tn{8ڜ?wH+5cO4mP eԪɅ}(ց4۹j3Hh{ ˖ݩ͛*2cA<0ԭZ<5_ un`ٺʽ/nWfؤWWɤ/ߚN Wu; > viߠvAm/zrA*ƪW(ݳX"!4_]7)^l5U7]^>5+- EѠQ%ϼXYYSF }WKKwVP]Ϧ&'}ΝxpSN>Қ.,]I>y*7RX 7SV ;O\]5+$gsU}q5&O&}}A7ԭZ<5_h@aQQKۆEq Lu2KF:4ͻo:}͉Nm;Y >"ҺIVKLMއk0o|}egsv;XFXYY`?Sztn߰NԠN%ť{'-̺k ]|aQQKC#x#99ι.XAjŵU(ݹxUڮq^Y<.P(Q1hڠf_j ( Ah^Vq?lKg#O'h۸ SV@PAiY kڰvqRR4xqEťGC(,* WToPjnn׼~QB4D!#)[ޟܨn\SjV}K-{}(es~k6V\1g쁶A&YE/2۟6yق*5? zO ?ڤA$=4[F%syO>n"\.-Ԯ¢0@4FFk^( ?jgGJbh$ C'ԩYbyšPe-Xr[խY56;x2EGO%uޜyϡͲ֮Vߡx kڰvqRR4xqEťGCo-ᚍW{mEi)e;|HeākWHövN9rt  cuתVt㉋WkyeH8 BFi^{~1XXqŜ6[RD4oP n|ٙveq[ٟrifAPV};}t{N@(:MZT粛À;вaE->~:GՅ=x>}>hU^17%R5ժR HFkW,_zU]τ@($&ǃz9}&_jU-~mʈ#P(@'A@'&_Sྜྷ?yȝ7:ɤGX !!AdC`WتAqCBIE/̩;ᮁ'&gTHF~;KA5^_e~y=|tΫ )IE{0 L{&-sSauhٰ A$&ǃ Pă x A,Ay[-p]Yo~RrfghV BGF]sb+kL}up8l愛V^ă 11!>7뮞6<Қ~Go=oxs S;uhJbr< $Or|ƜU5^XY5xd5'*f/ <⇵>[BB4m/_ZB6A<@<xÁp xAP !}k>҇5UxEMvw4)ă HJL4SċKk?(8A<zYUJZ6*gזS:P?jIJbr< @<8`7iQn.pCˆHOK);ڱҲPjG9Y!=5Sw7ySƎpe:EY+lsO#g5YՊot*u͉1Օᰙn>ZRz)̙|Wдwj\wecn*qx}|dѲ cnJ YC& jիUHB ă HILqA<&_Sྜྷ?yHZUb.Q%#vÕ]τ nxt^]HIN/zރp8 @u=OYGjXzI&YC|2BzjپC'gU-IILqA<KmsO#g5YՊotxФA͢ח|Y_vĽhă P HNJ/}Xɗ>Ԭa‹/j㿣I  ă <⇵>[BB4m/_ZB6A<MW]rnӟ{ 9ϪV|Kƃ GfA\iV֜#nP @BG3fU \bдA͒?܂pbRB@G~9Ar)4mP䗕w|`r])R`͢4mPd !)x򑑃!\b&'߾;i/T,_{WNIM'D#wPn=^_r" IIJ{m#JCpHJRBбUO hXN-RP8eCV ~^>}7DaG~9Ar)4mP&w> $%M,Y5~v; ,|#ｹXi('\b]%.ʗK#!PJF<7VZ&!ʤ;,}%Pr4mPd j_v )Ih嗴_=eԤ ybuM,Y5~v; ,|#pï<}u@j‘W&q4 .z/@JRB`#s ‰I AJRBOдA͒U'쇦 j|b~=۟3%r@0uO~AQ8%5);\_ruWvɽg %RH@jeqMNY ɉN M,e0?U5i{i%OP?j&w!0OF}7DaPH(r+Oy]3Z.1H(嗴_=eԤ ybuEw $B‘W&q4 JbqQH-d \bCSH4\41H4 9)DaZ.18@$V.$'Eh hRH4,==5IR% 2SXIi 0 H4,==5HNI 99!qr$'GHOK "0Ҳx(VZg9cVMS%3筮[+83 R%+- ;q&q/1S`#W, pm/^%o<=PPv!v:ҋr+W,_65] Q.59PRF? @(BԨV)P.%)hߪA!@&uVPZJRre]/jRX4^JNJGQEĤhFD@XON9}ΫOl{oJJrbEb(*^~{m5m|e3 TrJB >33˕~h@~aQ蚑jV,Yh}|Z_?ޔxYk߱'_D#o6զ̷`$pvLwEycᤑϫ7]}, Μ>xէ {tn_!=5+q"lƒw^} BABA +o:掫N AI,q/5HJL/~~U3cJ|jڛN{ÑpՏe<ȭo\IR3>mu8֜İC2K#p@YLaQI8 ;:)P/#" Nf>m۬^Q(%2% $ |Μ׳8vl4hfBu/zɉ _iۮ~8VVL/W&PJfI]Z  G"P@AVHV &x̴28yBdk+klgoZ3Hu:0ՏjϪZVh4`ٳ|Z}Ƀ|fȁh؟;'?>냬 Mw*ieG?O͏uWmMӱ nO{dioם3mgΝ/}{ܾԔ*)z{7Ro~+흕U-,*?Ys8ЮE"GN%8ފ7&MJJn}hBkD¡Y:ESɄ_YQrfzl{?{$5beʙK'?tMj {OpzJ+#nyfͺ_]vj~bee~+zغΘxuǢ ๹׌wjןHOKo}8i++j;q&1s{7 \4,0+/put4[:u.TF @aQIxS%D#۽݅Ԕ 99hT֩ZϪV?]ȏF~}Pi?WM X~AI߯OIJ=8!e9|YeV &|t/;t2WVԪ޴ݷJ_O.9h4ﶦ5beʙK'?tюm-Oziy-/-! s+.m3^_Q#r Vb2Xi7?O -fLwӱU3K  ٱPߪi>Ę!'R>Ԣzw'o^}M_w8XWAjE2n6zz}XYhc)5e|ZP;sVպOieZTd«o^.{}qٷq?`o3b^L:KgFϋ[&%TL/WֲIVǒcg]7WZ8!!W, PVH$ee ^VJce=N$WL>WNso8ڢQwV܏k|ڸ}2Ǿa[z:NV|K|lo;=7uYbKJ{]qќN&s'+V({%uyd:*<0yq݅KUuKӣZX~]p%gm{ڼ6q~ش_Vqɋc΍>̻uڵ_ص]K.jRPrF+iTz8{07>9hT蝕+=7^/ PT >}{*#WؓhUwVcּOj^}ywTe\G.ϾuPӏ?Ax׍}N_իy+/m+@ìj%?.s}R;澧d/xā "[ٛv՗V2W~kGHJ=^~ɼkhgG`r6 NsrOݟyUnfݷ?;'7ʥY5#ʙۇsD_Vqɋc΍>̻uڵ_kN~-.zgJƲq7JaQqƿӦE-禍Y BBٟY+_.LVXqV;}ԁhسe-̱#h4rz_w^IpBBϛ-os hp}rF>:# @;x2ĩ &r83\};[oswJ`]WR1ln~{w8YjCs=os hp}rF>:# @%w\t4qrN>R9#VbzEڅRE֩Q$ x\bRb]z)eZ7ʯ*L0A  HFG>^bFcfMv{š`j( nS֨[pr,uj0jw,ky wX!=Oq7ֱYG k))Ix<0uMkZ-) B!N^ԤࣹR)T(JX kO- i&;ԽCPv u0P@O Ix;g49Yb)@aQ,TZVH$&'hDm/t"o7~kf./T"@ ԨYrNG ,x*'O'ժ^)EPiYi"pD}{нSѓ߬=4Pc|P5f?v4񿝇\8Us&$&˗K)sIskmܶqw־U7oO=߉5׭Yϋ~~KƝ_~*! =xe+R,?&}xOJDz%̚8P C5kT@ >_9|t>BB!--&Dm'Dtl(syd-w<7!1!. jVX2΄#!td KB B!Ek~ >w! F5q^8zlbhP.59ЬaP(D8Q> B \8}B,Զyh4 BPHE8P( KJ+ V DѠ\jrjV* =~u@鱴Ԥ8$$)ee'֬V }$2˕~=Fݘl/`ȁ:j\eeG AٱH*d+t{N͍._1s_*'D#ulոJB T+D Z،VϾ4/ˁ;7fßPH$^\i~ZexFA8 ܿ%O}eE4oX`긛լZ!Ux4[  8fS)Uڟ0ړ) @4Xi,PJFlk+kng_JKC<@ZԲX X,TZŒe+lcOj:Պ;p< ch$x#{2ʗ+D¶mߗQ\YiiYBzjib4@ X,Ybɲ6'Aj8T>- 1!@J[cՃGOe׫]%{߱y9P!=41 `W*Yo޸VѮ}Ǔ6/uqoM?=XIws[]s~ plnd羣ieH(Zyw4W =OjMy#tl#mDӹ;uQNїV7b`@bB4Xզ km8=7Uk)// r ǃPaaI|8@(2mУ #B 5%1{DҝѠrfجuy~8ie hPȴC^+Ԕ`Iw>Fʙc&;H@jT, B 0㵕5 KJ+LSz%W/(CF5ʥ$-Z]s4.JJ/O`vM `yEp(Bzjib4@:A'wʌV_+ԪZ1fgܳyZEOp>0{JKCmS7VեUnN  A`k+kW̙VKV_PBI"pVM׉~嗴lO]R,}c{nK0cIݙrfҢ0@u xuUK^XS}GϾuk²?>ᵆ=>P󆵋:nV7E cmɸ᪋%'%?NJumu~1(** JKCфHШ~ "}\\nA8 E``{jAU3KZ4] "wuzumyn*%S_^^k+ޘANo҂ߦyݢ=t2,Ú4UiњjE% ad,_k__u ˕K.}(N/ Q/Df܂hq,F#_=ϼJh4hְvԬVT5DzDN]zEkє9gժdԬVT5DzDN]zEPXRnXFQKw4vnB,~%uAWt>S.5)@:U._WAGc,׳K|$ -Z׶yr VZ&DFP5r űX 0ՕשZ4i 5WhA,mKKF֮QTzMz{5/ #!H$y[wmѸv o~RM/DA h۬nQGp8lU\! d~ⶃcUoڍaK/"oIɉq@H(  P 6[8a5GQi}$>C*W P DpEM/,^]Wg>它y 3tEc*; ű!@p[+vMN>J תRh4A@5{k}n}\۷GrsN_kѸva*%Cr:9rT5 G!@)O7iA}HFקߨ~▍k:FpYז3˕?|2Aj%ɉq=iFj  B/Z^~Qx܈^,fpmNI9}!RVR ٷ+.Z]h$;}Ծh8jVɌլq@ BBA4iP>ѹ?]h$ jVɌլq@ @H( nǩI/}Xg+&D#=eAY".ﲋ ~i^{sMCy2艳 ɉq=iFj t[+WsھN?sB$$@S} ߳N IefOziY?ؽc|{҇u|bB4\yi۳~ۑQ @(aN,T?j#D\=;BiH8nYZ+\PNJ 4kXx܇g¡s`]_ݳCnAQ,Ck{[q.?}뵗ILbG^{2VZJNJ'D"%'߼;i4kXw|аNՒM5Yj4S'+ KM'D"gIH"O݉*;@87Nquarbr)Ip(ޜyhP|J|s!-59wp[LbB$u|䝹yErHc : Ьa.ӒP ྜྷ-8 \,@ \>}p ྜྷ-8 /i׽ʥ$á'F9PfƏfʙieо ERЬaJP|J|s!-59U2ʾ}ܼpxB${zzf kgs I 51!C^tᢒPrb4ޗKJKCRPxJqE%qq$$FhqPHFzJh HL@bb4HLOCqAbb482S@jjrHLOCS@8q@Bb4HH@8q@($|JHOC h ʥ&(@Q(PT\*-+ %%F (pbb4((, $%p@~AQ\jr?U>Ј'6oojjJReEPX ֚꟯Z >O) A^XY5~ZwFašAw?׼$ PJfFv;4iҺK_; )Ik}ǒ&^ZwkwGa$|Ɵ,|u?כ*-uh4 3 :ﲋr ϼW?lwCzCO}:7NU+VH+u9^\w`GwVL+CO/{뵗rQ|Ч_oʼa@3h@zzq[T@ @  s}]uJJCǿ89!1{WPzI/_w_{җОP8dOV>5ΏF %91xcH8ؾ`ʋd=+#  Ҳx8 A5e cg'OKh׼^a(AxruwrAI4TX\X3g.(erMNu͉h4lێ)Onn^A/Lzh*iekߚ}.F6+}>tӑ~'SvW۰n/{'D#]wK K\jbzy7?oK KS^^V)#^Ԣ~!c9 LNJJ6OE-B!(CAu 3S鯭Ȫ\!=<7zώڱҲP i'pƵ oj@K୕W{Z~7}߰~% ߮WRF='$DΊuhv1-gi-:~lR8vGoph$@Y<0.[SU6貓w'' +;|2呙o7xuȽ[/ϾےʢjJB*Ş|Ý4,h$=0Oj~K5=ujT@aQI)&D#Cw]}%r˥&}٧'^vq kߚ}.F6+}>tӑ磋>\W*O-ާ JNY0! #}.i[.51QBI:Jişۜg^}km/o=tG_\(ir^[We OU*@FzJg/XMէ'|88f†M,5ɎmG!ukVAQIi(%9~j T+  "n۝VgGxEK ?;39K?ѡuü~] 7O~w{^XZ77 zQ&=4H̴3[2_(Fxzg}\OFˍY\Z4z*gpזg?y6vJES|išǞ]RlnAtܴu_zjh4 ټk ߫#9@RbBUҺy;o}!NE!#'N'<8eQ;xmϿ5r~_[ o6_Z{/ˏfs,Vjρ5f̛qϞfPo̔ wp8乹׹OeNY/?޷Gy.,(}-yⅥ}s!y%rQEszQQIxG׿ӧNV w`]ZKKI L/WڢqVI3ϼpC7WJq(PPZfq8B:5%D"P X)( JJ=x"rfzA8}a'`FYo WZݕ2ǾêgV}kGF]sI{aYOzFfS,t-W @@ oozݧNF^vwI>%]x%rQE@׿R^:?زQV+յ>|mh$ AQI,|\^=ozFk?#!(Ze^Z[kf]իQC8Y9|lcWe][MDAaAqxǐ'nG/,쳟+wNڟ>!?zEvBQV ˦~/7?ͺWӣ^qrf2 )1!>X,Hʟk ?+?o={88sGuSSԮZ3Ky{]*7?uï5^@H8&&|AAAr)^w>u:jug*o<} I ޭ|/㪓P (a~^tھϾ㧽UF %)1>7}^y"S/TK:vLޫ߻k]/j&%ſJ3ߺ?=uW*۽m.D`]i)Ikv>khQm`vǓNO|3˕]ӧ_ZmҚ5UXe7 Wp>xsG`JJRb&D"'{s?5dq}h$lNf:PRzi  kOM>_9rt]ک̌re " T+x%%&m+LIN,زaA2SrYcԝ ! &wʙ;cwk,8ܩMv* |Mκ;;;m־5͋Шaڷ_+{ӁK:4ߵh<ԬA͢EIMIM~ou:F9I]/j;UɌ@J饕*Z4]Q.9i>6l Ý4gסrG9Z!=lҘ^=rf9gjW(*) JKC ۽mn-/4ԣsă߻k׼~@*w\;' 6٧'$'Fue:Pzb!DAjbb 6GFOTѹEn  kǁ򇏞J3бӉ˕}_s_&uZ7StoޝN7S/? L?ٛ PJf,˥$@rRbJg_AP93$\r$&Fi$ծ^) ԅwwdO-]`⿧^.J+>jB4<4bέ@u 4nV'? x 򩥫L RiTMFF 8ҹu|-\zr+!^XisVYH(Sr @ZjJpHоe pD %9 *d%&FPPT8Ҳ K΄לعh[+]M(qc+@qIi~* &G<:qn^A 5UhT;jTˌ$'5W蟝S Kƒyɽ)C T- C¡|g{ ϋNO9xJ3欬m$@jrbM|_R8rGo3P@RS#87  Xu+/-qq@%pK_[mu9p< J Hr#f+WePFzXB$CGA @I4\jfW~۶;A{OIO+WMq\/ ϛq޲x?w͚qKʭWZO~XNbZUKv?# @ #\,! 2?~k7_Ƶ w=+(yq˳o.v(?{ҝ{KO7 9wߑr)p$gq>0ܪi݂{cE՚:n~v,/׌|EHD8s6/~}9+|զ9$@&F8~ޘv.ܽHӯ rJA(¢HqPȤo<_P IINwx6T!-c_rQp8Pj rq@#@4  B!)ɉO&*ŞylK.j@ @ Ҵ~u?U$/ BGOMHOO-BBL. PHX4 ٧EKJJ․͙ŕAZ7fڗozFiޠV@ @@ZB,¢#ϼ+ ie=9A_rj{_ԬY>v5ݳᰒXiF⥯-mwZ:Ջ8Rjb8.͸woYY<럻fNN-sW~KXYb?T/(qRR_3y{Ι/6lkJ$$ PXTzw\{Ev;Y>'7@%%Z5*Q! Z5?k~˟齺]ϕ~m͕s!@vH$x+s'ؗ6|zkUXRTTA !AHЪi|]_LյMokABA MmXFV֩[j17i׼~~B4D"xnm.i2a֯Y})/}Xe\( yyUIJJʗvn[?j  B GBh8hTza?}>7?$V*% 16^BqF C{{w5/|ݚUJaC9)Ι/BGO߽MujU-{drYi\8ҤAIJ}V$>s6 @ TXoU{u6-KM. Fj%bX( W/̽P~~''JDBAaqI+:˿D&j jըTNIxkQB6b!!@A AkߑԓGU(UR ;y&ᵧӮEBGNJܾPRii $f#><ʮg6] Vw\^}G5]@<A5 +f/?2vwܑ;k Br7VǶ KK>;@4W8vՇ3sV CZP(˧g=q j8qY;p<)99  i^p숫?3gUgL7t*PB! ti+_PЍqS3eԺQ~8}fICkvʹNDab>]5t6z gU-h4@rrb@.,Yƕßn W_c)'OOWJIu U(|ESH #$&콻0hӬnu.~`Ɛ/O_Ջ7wWA-V(ZzHvRìjEɉeC^zꏿ[@U ot)Cov/(<4]7dՆW5\}ySe<}>^*%;=}h5UլV1ukW)cnD$B  hҨvԺ9MV/# *jV]wd\~q3cG <͞t{3ZA.:}O!>h HwMKKB!{jT,NIJ@ q@jJR|Е]޴WkҠf~vM{4g˗K͙9gW6qg欪̜UᐩV%4 C&=t,lwLwE;i_XX=eذrB4o, rwY>[k`숫WX *g&%&G?f=retei.74߹];MY bCǼ1;\zu74iXxGv4[w's!(Fo1h4lGw@4=pGP\r%!cĽ^y,C`{;IJN$'b#˧?;zo~~QʕK7\~=N'%FhPZWNB~Q85%)=zcM,qAprP8tk_{ }^ܵWt:74<[7,X !S=2#ժd^8s#I k.gB)IP8ntiҸek~6u‘HII >{ }p}ev]SP\rB| Ы¢pzԲp$ntihҰfOܹHRrB<%91˻ЭCKB)IP8dCg.pߥ/8FU(];JK0P8o)(W.9ps P\rII ARRB@(R!\) ))! 9)!P!\)HNJH  IOK)R@$'%$2ʕre 9)! 2Iۮ:2kY:~g4Q@rRB@*df/iӬ^re ))!HJJQ$%%IDR@@4&\jr(T PaqI8-59AHIN2iH$,D  ػ9B.u.@ (@ @@Q Q(@Q,OҭcuʧuymtUNKD4k6_~VOJFuj~ԙ ޝΤKDԔ%S̽6U݇3DQ(@eqEť RP@~~A8559 K˕K@~~A\8˕KĄh%%P(,1!@~~A8!11HL_.W.5yx4'~f򮿪۩^xvg֭U)vgf:|4w_iep2l¨_oWҋgp4˿:p$ eq ߥ]<'N'1ïmCzg$O}FK_}>Y_5Gr ֮\{{i\1 nOjjʧVhAic_@4>|UQ q-n4KOti@aQI蓯~|s ?mq\zEMJJJCCGj=h\ nOjjʧVhXsgq19KY!-6~' JBxف٩z8zt߻wYsߎy }[w4y]:c3ntow~okt22akf-O>-9/x q[fiiy{yڕֽS TX_ ";o)/870ڮEOPPTyy]\]gpȨ!Xih/k|Ьaօn_rF ]SfɵkT,-4U_P~wP0aF/>9p4ԙ\]?we^=AGHNJ.?+>FyC.?rǐ'Ñ0mx&uiuA=O6nPΞϋ|o>v(.G_lf]<5dȉSIcy5ʣ4 G$tDŽ[Da'ݽ]!!;LFؗqi疧ƃ)ɉAfFZW8ïk>=a8rTا?n޸~nh6‘0xYjk.;zM}O*>{M.ԭzlܠVރ'2Eii<4~¦pGJrbH+eػ= Q8s>/zv-A'r&W?[[7oky32NE~0sSS潿q#aeeV}s]k$+Kڞ(W*\ѭݹp4orܰrn΅#a!a5eW)oԢXi[^5.iB8vBAtӶݙ#ns=[M^\qָ=q*eo>7fKꇍޭWo9pĒXig5WzchOUV%/O{ܴrbHn9?OE˾ӻ[s]۶]{ԔνGPjK>۝ EB>rcU*?u.a ב=.:;kk?0i~_{h$8&OqoZU9))Iee!py;4os4F:ruXii,++ @Ω;!׮Qo7)Px?8\~I۳.ZWtow. ˍUWPrԹqO/h>^Gzשּׂ_(c_~X!=GW/,*,a ZnsO+G zF+X;xYז6۽}g7+Ԕ/;oʣH@čIԄųsI/KڞrQ<HNLU&?tAӯ,m\z+.m  :փ9kI|ԃCAvMs{ncCiqw:۽C??J?Nh4zm#]+;2>o>7f{Ωs O~I\4  :փnPRf[8|Uqy_7|*O]ѭ9UVn*% {pF ˍU{um}:1!ti,e:Xv^%k{e#ayir𫎖f><|O׫Qw[mgzuB!`cg%33#uAcn.hV7Eh4oߺQ^B$ಮ-:Dz$V(W3_{oFrrb]NG#HnܠVBaZ4OIN*kߪQ^fFZ\qisW\@FFZ#{Ue]ݧә3JJbAWv=qǍ}Kʤ$'ԩYTRz,%11^rz1\ֵ~]X J7owkO/[HNN,طh$yc㣟bPr1 EBO[((zā};ѹJK;i|cjZH&&$ K%ťᓧ%G=pIH8 hT7?9!o֠va(Ps땇ԩYTRz,%11^rz17_sٱ˺΅].;ӯ9/KMBajW+x{^kƒu\\( ރSʗK) @6/tlVM=ھĄ8@~~A8$&& ##d~ّrɪﲮL k ?%9}Fyie UY4lPp$FeeU+epZjr ? ĄhVv}t^kdwYWtrŌR eЁ'vhJR0@x(Vvxŭ=1&o,Y[%mυ@JrbЪIh]H@JrbP?zasQFAjrRY2nV<1kI1_}7W9{>qc'oj G#zwowwveFyYOK݇/.?lΣV%3vLn;ҋ ×vis>:5N͋n۱/$冭Ua[{ow4Ե}sH$%&KJb¢p$eU+\1S-HIN'%&KICJrbp=NvG   p8,$!Ԭkְfo*_JfIjrRY5 >ZTTܼ(JKCPVV苟+zoa]moy9g/M\F@HH֍·Prso}7]sQ/( 5]ii<zb#K>m3ׯwuU,_ JKKCvnu& ie%%s+fff/MJL,Q3ەCpM'};oknڶ;qy]X0ʮw;+B5xp5P>a]moy9g/M\F @J⡂ȹH `Iv˘:L|w <ԮyU_ZLn^rŌR5oؠnzg>t՗9{~ >pGHT^zm߮gNNJJeG:ܘ퐔_̏ư=h{ JĄxRrR,v=G+-ᬕeVp#._(|zSNmqȉ@REBPx?xk6l--׾ "+މ7[/VG]?Ǡfg~>w&lR5$ҋ HػST([*9cԀGO֩Vv(DG"YQJH-Q$ѳXA" 33+8_~Ӊ\Z!5rk7c;ZRwQAA %3 '[G%p9U @\ /ӠN[wdXӝOBQQW*}  {s u?˖DYQJH-Q$ѳXAya *WHS34pOR)QȖ *p֪w׭|@\ln߉ B|a@ rLZ>5I+ mVd?ϙ4xooEE^H$.ԭ^hbbB9~6 :p<&o2&xX ԥ]^0*N{).L`MjT.{B锬H$5t3. @ "?H[`T\z3`έËd3*N8~|۪ikPPj]^j^-?w{seS3v* .]ӳo׃:XxH ;ïUm`ԀG]\F {5q%@\3c/YR[LY\iԀǎ@qy6ʅH.uj߫Ӊ/e@dԀGMI.ujņ;ntqܔŕMYr Tvșx])X0.Fw]pZɅrN{u:eߛL0)Ʌr_~l3FhVݵ+ȼΔŕX(jZm DEC_zlYSth\H.\ 7_L(gOh\ wn)+X%֩r3ڻT >ǀcˆ;lp )Iٗވ9ztj"9whv)+e{P(iմ 1Q@3A`03yApljrƠ纜(^4)+._L,vLc^Pʦ&g<н jńJԌ_/P'ڟw׺ )8p_Lt(m[Կ^jݙY9 eeAm׻\@.A#^~^J(W"PWb>QpǏTT*;*-q78 WmJnݬp`||\ngd7::EbCVTiPF͛Qb1ѡLk7ңbńD`䏍jZg@ 4ŇOtmJǖ f&&bk|c@|\lxѻ t~=;!>>. @> е}+[6q'; jq U*;HViuo]㟜@|\l8itcˆo^wņcCB9gٕE~=;!>>. @л#9@$,>>. eSխzmƿ>. P@Lt(2q.w% '7]ZS:iVڝ̜ @|\lx &@Ro qPyHX|<8!XxVŲųbC_(R$*& jZս!D2rcc"~;#nņ pn;YY0ܾ 0degPNfv  Aog +;;D"W~ۮÅʦ&gL~B y/=M+11!.^)5n m^/t; Eټm_i_}WfC jxU ;;7؋5nG;qƊ vjvoyaϽ6Z^8 EW|v>w_Uv6~\a㾬}Ͽ j%\bbB_J{vbqcsÑp׿ͫ[m;فً֕ "@VVNfҷ6je3r7;mę1/~fȤ#^zX3ڍ71a>{D\*݆7,Hؒ5lбUËt6f[*7[W. #pM?U/V  '#Ԯ|; 1]k~+YXp$yZWsrÁ܊i~wŋ@ǖ ]qTNn^`[ 8_kT4Ze\IJ(*5foܸ咟JCb/& |6\o+/vg֮ (W*%sqʥdV,[< "(uVFG]ʳۜh2[v*mo`Lt*l߻/\K:7&ͫ|3Nn 7^DrnoGgdfFM+w4) F^Xgf.\[bjK3ŋ&=t2)+\t-TwFxX pFz؏۱hR(ڧ۱-_ }@#^zXڕo@(*v#=f+JݴXw߲%NfNpϫBsҹR%lJ>J9w\_`^j]н+WH˖=32B{*رeËMVNj+fg_zɮ7GO^7nE ޱߤ Wo^[FtH.\0¥k3+O[h/XWLj/[ t2ozh0*^/ /S4wiE[7{=T2PfPx`0pbbʔ,@%+K杅Uvvvn`ݦ}ɕ(+YˌE '挙4rffvps9wr]>:\ߗI^++ +jO%&XQ~C.]G~/1~x÷3,#1ѡHV ueWV^nX]/]MY[_r%3ܔ-?@LPd*-b}\nIwmӖ'^U~TG-YHT G{?x>[ESw/XN =y>DB * y} &XQcWW*} Vdzrڼp* wOv8ra?|p}QhĜ1Uԥ7by[ʨޝbk^OL}mœ=wE'}>/]}ڍH$le/^oƄyW%7buZ.]hV0*qݪ7ODzF橄0[C_ʟ?6_@nn^:lx-wqK&̩ #=S]/ 1:\nN*Q$q_VΛ=qs/nj4J{\+W:W~NmVz *`?ON>zW3ջ6mΚRGVm'C޸ڹXbMN*3wنw2M{ﻓޝb*ZӶ«~R1} EF}0Ғo-6g ' +I6/OMWͮr]P+y'3;ja7;K+ֿ⮢sv;++ +jO%&XQ~CCQ +;'xzzp}K#W_1ѡ@Ųų~\ J՚Z]]=XE '$5q5&:D5J|\t;9fUZSZzU78y_%ψ5K+#ζiVz pbbʔ,7nev?إ} ?c^yH-\x_O*WbڟC-.%˫VdoO|78y_%ψ5K+#ζiVz pVF~֧W^bo q䯝G \C-w-!.6 8~B|BxYKף1aHI.ؾđq˞"s& ;yKWǼгٲ%m\f8/|l _LoRS$}m—)牶q([X_?0'/?7 iZkϩ2Cg?DԬR՛Hď*xZսo ydY՞y9xs֩Q>zwV%%r 6OG"6H;Ӥ~[pS糲m.Vo(5o1y_LxĜ‰5*]@\jWՠNsFzTծDGDʗ.~翫cRKɞ4sUu^kT-ޏ?=m?||\l" 廝:{Jm^ivwE W|h܇ozm ujZ$•2oʈ"mֻs ЙF"5h`8o<޹ŹViuo[Cz:nV~=; >ԮViuoD"a+m%?{-PTgn}1ۥϸ;݇N|DUʧfV*S[ ;'7P?Œry̬`B\lm6 11![:޵R?Ժբssrk|˓?6&\L̔"sĄ--u}˜jLRb|݇ }2>@FWBQQ^[qO^IY/x.0ٕngd^@W]FBrWu*Uk7ңׯv-&:: p'+;xzLzw9w&]t- WbhJk(R@.$%&=MTlpW*P02ŇOJL#'WҕErdfr䏍m^zkxϪbi k\O+x  wLBnA^8NW(S23H11bE f@ @|\l8*W*%{KOۤߛWeWkʶ@'/?7 hR=; @fvN-εh|M8tٿv.ضy@Prz=Rowz @ @|\l8*W*%{KOۤߛWeWkʶ@H)գU,}q*כԯqZ2k~+%33+P(ַ멢s `$.6_^RB\]޹Z3{_N'nVҵ1˗8j?{}w0UZyqwerڗ>0{%{';!xs}{eJԿҍ`( *މ?}Ior!..6 @^jD!s)!'77P"P$8 @R2W.P$)1翫cr?y!Qj4q+gϿ|0o-6g PhR΄iK,-BD@lLtxC5@( ņ!BדMwfW7CgD  Tz; +X >HV9Nlt(|߶Kz} qqawU+/&: Ἴ@fVNzҷ֬p3@P\l<HE $`Bdf˗*~ %E}]9^U8@ށ~ǒ[w.T|:WP\ /U}}JwBL)Sb-;(\(;.6_^%;|2.33;{ uP^n^|Q@|m3m^￁:ShR΄iK,-ņ_{QVi`0wjz9@ h ]O6Cޙ] 6(R(g?GO_\bP$`vb|<E &=~Blj"9 ~kFG%@R埽ҵK|ݟ%B`䥧;hXr:Ul:}}JwBCi v6OU8zBFCvnNNψ5gOB锬`(Jj2{ŹvNˋPT$ 0mĮ̬yI-Q${ 22Ca~+#ԽSszv8]v+tfc yo<ְͩ@FBy/VZ;ǽ?*ʔ,*.Э}tjv)%PDDpnޙ`(JDDbIف@Q H))GO\=q!.66: *ޙ>Q`$7//PdѬgT9xtn훜SK)Ʌr "x@ ( HLxrRD"aӾZS_|rrYYp8?6_vFf? ! D2\._(5}.]]2|f蛟ޱ饘׫7%7kt׍ Sbw"H@$MZ~^=hRVjr` ^7,Paj oT.^0! 777 E++y歌I3V ֫YƼR6q#//Xo%;nttɢŊzio|2e9p<וxSQQcфegffeF+U"#DG柿rc*_g|#i׾Zck]/[h[/,̥埏;uI3F xdjnBHtt( |zSrFwݨP:% D"ڤջ:pS&e&>xl~լ|c ֫vPOLrTH͘2nWA_-ې G+8z|~.]ȝTbtGOh‰ DBpll0T,W2bYP|jƗ)W*%  *JfN*IK8{r>7[/VG]?Ǡfg~>w&lR5$ҋ HػST([*9cԀGO֩Vv(DG"YQJH-Q$ѳXA" 33+8_~Ӊ\Z!5  {w eK%g:PrssPTRwnʈ4cE;9PT23PC-rOCPzRw xx%z}ԭQ> B$U*(T o/ۓ=p|TMEE^H$.ԭ^hbbBT,[N$ \z3O[tRB|\ ~2 TuNVpʍ?D0*( ;q6y"goW zw":7Pz yLKԾ {ɸGO0c@Pv{mœ:1a6Q S"w׼ҵϸ0G D~ n7QApЂS;J  /*ΨP:% R/]sErń±PBIo|! #ń/^|-_Ղ%|0@@zn[1oԇ-\1ySw  z=Zo6iu/5R:@|1a *99+7VtF)Y/&*RN*ݥ} P` ɗ/& to}kz.|QGE"*doN^XB`*`TCz;bjNϾ]ŋ&e ԩY> 6: *ܺqSW7eK7S#gw`{ukJ$ʁ:5g{ӗU|o2` 2j$ ^AoϬ־EMZKw׮~;#;SWZbP0ҪiK/ H }뱉3VT:gM9߫Ӊs_~l3FhVRû*@zn[1oԇ-\~ZR?=_ eSխzmƿ.644] 2ŇOt$DžZRkڍ|11jJe.6|/}:5]ZNnn>ضU,jJe.6|/'.6\(gѻH D"@Ч_< 9k~+1Ǐb+g @Ч_< S]qai^زՌ;Ą`Tf?@ ņ|.jJe.6|/4w}uw?_J!hb.@j"9PTJ6@ X}꣝+УT\*T %&&DžD@ؘ@HCQ @Ą<pjԫv >>. ?6&BLPbB뎤Ą 䋉䋉B ybb"bb" EILL(@PbbB@bbBĄ"}{v<|4d_0%>>. УT\*T .]ս͙sblweF`(JvvnyߕG(!Pd]J @Nn8pou[IbCnD"aE?`( m^zvnn #++ -֠GN*ŋ/rݸַwU n x*T,[(a,z@^`1IqA֌ [3֦}gE[oyQ!YzFتm $Er}@^`!p=#lն @$79  \̴rJ>`0ȑ#zmӦM —@ |B=?#= 8s &x@^^(@ /  4c `P wQ~}Z'{n=3g  77ӽ+GIII۶mqFqqq233WBB(q=zvڙ={T!_{_.]ҤI 4аaCp1QQQܹr 66kW_5l0`y7ݻٳ2dqÇ+X L@3g;>вeK @?N8QFΝ;'99@ڵ%$$R hԨM6^7nx衇hݺ֭[bŊyw,XЄ $&&t%J,#=]t{n[<ɓ'KMMiӦy@$HD PX1Ç_6me˖yG@be˖DU%K:|Ç{GE"@@/_@ p1sSO%$$R GI?#= G~@ @$XB۰aE_^)RD5lСC >ܚ5k-[@ зo_-[4fŊK/Y`*R"73ܘ"/>"ҵ[D"3eu/ێW(yohJe#}S0!.2~C9'/\ 0z~L#r7o+|"NRKM?`˺yuIY>!4?Bya k ;KN"NlWoVrj`|~5beEʔ(hOMWo]ۍjuN;['fF߶_\8#3ï|ҵt]Z=Q ,߆/g+Z0|?Q#ܟȹsKnյiz##\8L]!zDTKn~WT8eCjޠrxѤȒuۢ>[kW@@Dde4aI4j -; D/dzJ$E;% ~8N䂑+-sݰ+*_LH5r߼H٫.]Kxs@NFբ:ϝǃm]_Q{ >|6/_8s ֩Z:\HpD:w%7oehըznUmRB8xԩ^:rbgWo@Dʔ(dY}߰jNB\>+ de|ɯѧ_  <"g۞\G˕`˝xw\q'w<HȟR&FO fv}śBwU-ײq勇w=jɇ}3 'D?,?ivW{E1eu 5u? jTB^-Y4Dzbc#<5cыz}ܨ D"ޟ.fϑsjɃH$"IafÎPe+'=Ytp5scTLLHjrU.`b"K@8YO?kVe-" |#CWoV"`LtiS/wփ쇿>6vFv`?xтo=y'tm?FꚖ/D# J)Z02sw}}NOʾn<_ry11!u+Qy_.=s9 >N ъ|Phț/uΊ _z*I.Q8r(@$"P.59rw"ox("Yʹ'"\jrC$BY6&=N|1!EHɉݫLa܃߿K%Gx;=# D"}wWݹܼB$DD B"OX @(EBQ@@(   3 D@@) ]P DAp)  B~O f5.3 O=gP@(j X},.!DWbB!P Pˑ #3qfw-=}=? je*y҄ANSVQ9_<FY.uK,  LJյee je*eޛ? @'  Ϥ_q<^+Qwߊɛ+_  kɓF2ׯ 49}n {}Ӡ٩s;2"=}-"y [4q ~TI 𩫓{iCZ?B!x9Cʸxx:ހKov<@n.鄾xvYNG8~)aLXh_mg.fkwY_/\'z%hUITT$rnxNjj; "z&GGEe{ `s?&t+ LȑW: z1S D7E8y<_wi^{s   qixڎNzZ;dM"Iܶ=T*] ޼ѯd~ݥy':,,@@xXHlc'JԩToO" r8a Kgu>ܼ+w[?&t0A@3SiP߇%P i:u%R<|,"cwWZc)& n؟pׁs Fj(,,a 7xEϘ?:x6ATd!>\& @4Y\\jmG]=ǝ_Ǚ`s鋷'"uGӦ0!GN_0`VCT/WŀNu'L "@@<&s7" i^nCK9gD)}ʸJ<˕-$5}m}>}:EC|A]>BALibCBAL >I"/n8]da!˿l^.Ot3SEEq'y :E@ȿ1muRsDŽB`S OX|lOdL2Ӡ٩b}çw< ;rjDB^_~'|Q4csܸ0ԪTV|RlK7m\;q\nl8쥛O< ms"Wm=&ِІnouL >;]+EEE]U{{#ƒ.EuoUq敞t<'_V%ԥcWvf> 1m:ia`Ɇ1ba!Y2k]p{z㰴ƧK,^'M0XPtF>P* LAo֪ʓY37{? h]/"Eq!@ 5cJ? ٫C߱㈈pϞ AdddIVu>\]&qƤ+}:ex3W,W gִ7HPHDFFH4:hUʥ ebnLZbS&AsS@%un^)z_JDܯn=| X@r=ڰxsŤM$`ǁ3 EG+{thOONs%~o{Wܸ}?gaY2K:i<@qA/®z^RK{*yxȟ;Ȉp|JS1Ї%~ Ț1ulZA!S R1D$z ]~߻&5JŃP@(! qqB@@(^ @" aˆxGBAc#cT*SEX@$/_=z<:exxUҿz,g۪ON_1u֤[JX OW>$Uq^ŅBAl\,gJ˘Pg/_>l>,qiO{śSnMeϩd~ ORHG ^[?׭;v1}3M8Q D' 6=ps "ýx]سHsGJujBaP‚/^*>~Vd?ݘHl1gə5G/Dݺ8nwG FNv4;u>RC*>ծQ^ŅBAl\,ҦI)>|!@>!ulJe  H$:!" <,$Q(G"|3se4g|93zC[ [p'BP0K͸$XDhW/o n])BA`ׇ_92u %~ЖCa33|O'2&9f;,6.^9=eɐL_+ט%KPP/ BA\H$:>P 2""> /NPB@\}|  ߎB^~-<,,BFviS'_f_Wd y;o @XxD| p   c;ގ񁴩/Z/zϫR|X2ߋ㿼7WX ,LB{rP)+Sʗ5|Y_4MO:$< ;ufdҤ%M8QےçaBW,S.vs|\YҾ ݼ1d-Sf;B= ظ߇%?vIK{yb @XxD| A8~I/_S^3g/ÂP(P(tvD kaaA "WvqS* hn#:e+G\ 9s-~\A)z$NLaUJ&7{37?7|묯b ;}iֽNuWH 6>Żv~(>wMcG HpYܙ^*H(:@HHlb O7^/VLi@:pRr󾌈 wĆ@HHlb O7^/VLi@AAԯR8o}X2I6$/fHog/qV""4Y鸙k7^iD  `,L_| ?*U?w'7s]3zxۦd>*,<,d[ƫ@ƴ)bo}݇aҧ#6dnWΖuk> ɗ ER8EߌٺdsńBwe}@  ^n?_`5J=&'DQQnGʕb̵ɫs@@„ Cf{Z= 3&ҥNU|qҧM0a1mJ{ ң}+Y`"]g# qA|=T?hyL<1ҬV'_-GEBvH t27ͫqrg5  ?s_+Cyse wtPHXXf' ůr47GưZƦKT(jѰG@fk.URbC IÏ?oqżzJ0UQܼ~ĥÿn| Qx+GC+ױnU} IteLwhŐPȔA_O>,P ڕ}^һOq cw-'/BQ "Haa!? hy8 Ggw7^ƅ'LB!vş7qb^ %N@_ @tHФ{=TCse ^ŁWqy[:NŢqZ;koI*i*NT,ɋЬe:{tCAPA`-Uڎ@/^ Ul 9 AT8B:a ~\iI!"+ /EkCli@dɘ*vlw?yJ8nH 92 ίЩIvƾ.:ABNM*Ķ_6eLp @-kkTݸ@ :A yN..6.N Wh\JE(:!P$O DEE$"E$D@ދq UbO   9#. DA|1!a!FWFe{y8/]N*YB>c锞SHAs$ydǚ=I}?kA`}I:ظDF4YH?7LA'Oփcg$Zgٓ#>x:lݾ z"6O1y(P <)O 3mUoG/LnL0PC^{. PxXx@(#.'H,q\Lic1eS׵ zZP~cϯ~+[ П/^M%IDղEļ~  p9˶j\#B < \v+rӧM,vg/z '+ nM,Ǽ 52.n+7[ȩ+dLu:@2J(aPBsmO >OҡS5ؼ'=yz¾ B?|2kKM^(_ DO]Nk7?y^\tmpًЗ{Ixq~.?w :U/_OvG|yB>UI:tʲдfW2jڪ4O< yl <ӡ 9~ZN؅DJ|ܧS;D^ 2w4"* {N'@8g/L6e//.>fi裻UʽdܯrDx80d͜>&",< DQQ "C&$..pĥiS&ܸu/r¬i+Yx`NY~WM}#cݿ96.PBOgͪM}2">TQo?MW17>Ϙ6a+n'ŋ :6v{?ӷ½ס߿ߪއ >ȐU< GGuܭ0@H7H=SL| q /^Ƅl;<8 6.ފ{]H6yܾ#磻%}% @t¨NZ٠WV-` ՛wT()Ba1a5=/[<_lJN/ <{1]}Qd> C[=qYGE~պ֝ #ظ K"Z-wullBOC I11 ?}FdIiS& Wߎ"W‚BAD B@yĉx2VTTxo?AxU(G /3O %mw|EtOG{3Sgxݷ$N0.@\993mb 3y N4C*&\Ώ"j|TqXX(ذHKmZ݄sfMrڢirdpU̫fdGsT B;Aɷ  &}Q}ʽI^ 0ㅫ9!A@ N|ofy9b ֓ĉ@l|D|=ܙc @KuaA_>n;"gExX}Bk90綣'r^_XD볈0pёz#GN_]GD cĢ2ܬ+n=Qݷb'KU~0*^~'i?ӥI cBsnOVL13}do=7Z}=)ʍ7Y&6Kaǥ_mW42"Buop÷f[0sH0A|Y0-~ i\cfs?)##ƒ*ymωdApB!|3b~ױqYҽ}[x'0q„gΰ]i ,,̗-נz釡݌, {-i&J `ެ]yTW3iκ }=)_> RDxP0ߌul\(Gt/n_V(,ҤL "h/9v.4D@l|g/_x&\;8zzXdA7R?{;GT/_(nyuI[B!K}-Mvjga!pɢlo 6>^(<B杇[ 9>,~τ}?{;GT/_(nyuI[B!YL^gܒ} :6VDD8<92,zUJ=ܻb^%K"%Hl? H Aa΀ OL1 =зcV|&Pl'>%Hl3,WÏ˽(Pa!vjW*y3? %L?Pt@G =yXӱq$ƇB!};4 >~al\/_%MBO*蓊>zeE'B6E]zEXX($N0k/^E' `O oǺum %M0mh+ ?lcx*,ixRxnVcc B  aaU[D8>oXUfżӮD;jQ~YeJE_~mKԔ[@f|ްܫ0A>mm7ҧoYWjw<}?at/* ?.O֣lidIױq,ؚ`mQnqz!uB+Ns*ε^& #脑$N0@ #脑H( :ad #"4qt<@D H8:F qpIGDFD럳,modHYb}Øno}lס &LaLv$Ϫw_ϳdLk)mMгmArE|xとV}f$еG1-k~aF=O|#%7aY?w}歜oĽypvXrfNl'[ $ԤFW?-*u@||mG"J {a?jM0*x"F.ih)StW51WiR$ DEFԥI VyFCݹR11b@xxH¨(a*zݪĿ7Ò^)4 MA)y2&M ҧI bbbǁQQ"Tz?Usoԇ%.S$i<s%PRWQA$W !FĄ1{y*xU杇'O^'/b^dž \^أCo= ȫr:U$F\dDDP`בD\o?zB_GEE >lķ~LXXȄMwXYݲ1T9s鿰 &ذD;yujVeIȐ6yh? LqS mL|ĕpH"qmN'= _7j%0K0 GfbФçIaJ"&FO%{:|VlL6Ub\/l 6:N,qU|:y CI0' .ݸFq6g&>pJ8I86{5DEFܥgxqqB!ҧN@+&E`ۜO=zjoJap/˟=  y<MG$bcB A$0wIQaɋFU} @(]Z/>nv&=&Fէ/$ ^Ɔ@Io/q\M?x:6qقB i!@= ؤBLb pK’&"‚ "ܹ$yb^3{XhѺQ_n K*Yܓg/~+K?|_nK0k~4<< $tBǧqѕKNOK7\ [92ğ|+Ebݺ0Pȯ<e( N\v;֗?%ɐ&Y0V/+.,, .ݸ.U'^*V~[a,ܖ`+ixxHe鄎OS' O++zO͑!çaqpyU(y҄@(2ϟ> BDOI2ILճ ֽ!BF~/CPHtµa)I4ɂi?z~\qaa!u([4'wy+K O4:8:Ao}$raX*olI'^lu\\"z#_.+ 2"" |;~iBf|t)YwE=y \v' 8! %[Sߺ(xVT&y&0?ߐviTɓ&?l &8{ &@͊ha`n{ٵu[gkR냻%y_Ąuփ#hOu#}AhՏ7_by@Vm>\O'WNyփݏ}f_?XP%;;y3%K(u;G$M.+ޣeG~{G'0A p_xϟz+s\άO^PHl o $kTzrgKًP ˣ=|*bb<,yD.E杇i일Y a(S'፿%1?+V渜Yşx3B\@I֌gcY;E_doK yc?{'o8Rxl%N(6.GÒ'MRnyhɛ5ܸva/b^ :AdP(O Ɉ %.X'jԵ @̫tu^ԫTuܙ sʞ!u^ɛ56*2BDxWg{#][agoJaaa!#*_ ZQ_@(O^|Ul\NꍻQ9{_ĄVoٟ:.>> DD/cb@D x>pݨAfK&V>Ax W"##SH퍴 ˘ذ^H2Yl>{>aƪ.v""PHVofɐUx:.4zڊ,2 G)R$FqdQ"f嚍H ysdkQt Vz'oEsy,4~*~8Q F2n}*Dᜱfm]lL~I Qh4<",@"_O)a:Ab\/ֽ_~?8&dL"Ș.E<@(BoeݸTD9c ۺ^٘_"#ixDXex5fQ~2KdL"  )W"3'|eU^^~?8&dL"Ș.E<J$~CQ: k~w0gR' @HHa!A%N ٫^#H²hkiR&BFlYϩIߩ]$4ޫw d :a x}Ybc! N~{"#ԩ\պEAT(PHxx/XysdyBP xVԠ gI*/$:sϞDŽ[OGɟɀ.%Nyjvlo?GO# ŭ{"~̇N\J:Ehz%ߛ_=)w65n/Njg&4 BdIޕٳ~tWߩBy5mEƌRjQ=Ac$93'^~yDdDx@Cg񏬏>(?Ǔ~_ֿ!M?H~ĥď<}Lbr=حTɒ?{5᠉gyAͫhB!N6Y᝷sG7[nxX@| A|ڶD_D|ټQi+N^)7 slN%N  v>}ֽNʓ#+^77e|4Qx?Ŏt! >j ݱY[߲\ .>_7]D|1mׇO];쏟>(?Ǔ]]{Ex5Tɒ-^'gհ>#emI|f9pBȈV)[1@|582I=NN4u\_Oϝ7<ܽ iR@( Nwf;tR % oT>VvjaLmGG BHjIP(/Ӽf` /2EDB!ÿbW^@*ﾮ;^|J$: 5K5K|-D pysgqG?%LDGE ]/_J>z?_=8:R(ݗ5_4F}eL$Ѕ%J*٣f : 5wnV*[ę3v\'v;:yvK+_|Z_y>x_reϜŜlw"i^ק2Ox7tvSWfE[(k݋4ܭWYlGg_r\l\|쥛 --tvg/:x:yVߌy2yxrS[>V@ΓS&UKuL^M8q\<,ݚfɺ4As/\+uϪ虫I~Z/V99F{TX+6K9##ƒfuעwz:wf R=?Ef^rfz %sWUɳx@@DQ'Hq,եEHA H(t^ؚE5cF|5g.-*@¨I "u,y@¨ ""i eD@¨0*( "tkѯ_dž|'*t忨[wE}׭I~ѻ;W.΃)s׾ʷ9N3sw?*vΧBQ]P d3^r;*STv?|[a_̚ErͶC:v>Q !m?invix"o= v,! 8rRYӿ]o42vڊ/b^}/o@\a/LpΣ5"iO>zu{lB?ګ>}"&݂;s%q]GR4Sfɢy© oļymS?oZF7d͔.[t+2"<ݡ411ajYD'д9|6IxuXjn-ɻ/r=d[.kx,/; AT*[Q$O(Ew+.賯'5-?X~TI ATD|r@͊Ь-M~ѼKTigy*}X՛*Λ6<9M5 $utQ5* *,Ȑ6EL)_ A|QϞ ~^'lJ$V| ,2", yR7ϓÇKaddx@t)cnXx/;z~a={ AT|DDŵWn҅}ķf%'O*i 2"<ަ45^'W `ޒm=~&$H "ȑ9D @(<ߺTd\|/,q  Oow*2.>B?}aĎS$M@$N N BWa?6{$BںxJ0*> "<<~oߋ[{<:uzw&ܪ-̐&eL7ҼH>>.Mh߱s<9CꗙH:..@(y;㰰P ,,,>:a@(SlOA$qO<AxX(Bx7)&}Ux@$K(v}NL]1S cBADxx߾UBMw伜9Aofy.@I_߹8AX32~ƟYΝi\| qqWaf&@I^OabbbC92{!@Xx(Ș6+ IqcT?Z"#ƒSzHɞ9O|ޣ޽P(u}=tVn熪Ѷ D 6>> m䯇{C'/%Vx\Bc_ {YXIWm:K.p}l<9xYK"I <<~QЛļ eH2f&ə-ˈp7o=H8n,k}p+{/~˰/GO_O9KyexwWaaaaATdx$ x&LJ2Iz]&^T<L\_Gd^GDD @x!""ƒ˗@<ٞM>]G/YwuLu޻eԷ2M/O x#]WsmKUBo]rfKbYCjRL:udn}ག q/ߖ̜պ퇒'+^ާ u?{U㫷,֓ '/_ySI+7 ۹> y+g Fōu1^wADo:}=$.fS͘2EW@(ҽmM?u5_xDxe~iassףׯcCaA_<~q5<,@ !A@ re2W / O7^di_@[ԽkN;tY2{8͙>(aLi_  kwxDX޿5m5*w;It  ^<ٞM>]G/YwuLuW / C~=k,^Z|ٟFF@\||(.>pD82< Wrd0T+IwÈV +wͻ 2", jzfP@GUQ D AdI^yL~QX~@A@"H *Np A]Ɨ39 R6̝kMбy!a¨?|q&<,,PxGl\; B=ڦƕa?-1Btkt!m䯡x#qcG'O:yLɢo= |ۥ.JRAy`'$f֧',CTeB|\r@ȈBBww?*.>> aa!Gul\([t/zu]((?3! A  Sې9 r^Xa \v'`O,>x::EQ|iXxQ/CW >lA񾝰4}z:SS$Kd͔:^ \q7|mџ(<&&<92\8Iu*qwx*,YDqa! 2:AT YwW/}7.668qt<@^.$]ڕK0wGO'H *YǬ9%Jun g/E 6Uc~E$NIsdzpRϓ BB}2<{&8qt< 29 *X=sQ'G '<  :ATz怣 OL/-rwn8qt<loymѐC $d@@ʥ\/^ K$Q\XxUZ?mW@@^=G$N1~veP =.^ñcCƇBp{?~^\\/_%N OL/Ny4U. 29z g_]Z|", \q/q)VQtȠVljG~i|Y"#˟=6Apƽ?z@ذpVn:wܒЮ/;7`ߌYJ:m+K^BQAO^z#FFEFuU %W(Uq%E%bǎi4rԕϿO>|w]j=K =|!b3 WbC>ŕ/ ۵EAXpTqKCܼ⋰SF'K0}ބw> 5˞B~9/ E×M+Qa_#rgM7OsgOkg$]a=x~DwލӾ Q[$}VEe_ H$PXHc a@H"yX " "@(,$Eı$N8qt$N  q8QAxH㠹I3M#ma]/DL1Ws{=ܸDTa l/aꔉBW/rQþ,iY;̥6QW} Z4*2B=oUtLxDغtdqKO7ҥb줱qjS[89&O݇.HRDODŽ.rJG}־g-NX@ԩX,^wcFN]7&k7#@lZňkumUEXx@4i`n V-[Uwr@tt$i@'q/K-ceAI{pNX¹b7aTIx^ū[?~<{+,,,B96aoe#V@l\g*rgI:e :**>s /^ ulRyby^C&ϙJ" *2_?H2Iw?0AqOū}7배HO"q0AqOyLyLl[cV.s܍C$wfu3H ҈ tnn$՟5V<& !a%RO)<~BǼ Λ% uKggϞ I(a<q"B ,, B Y>AY#$NB@+APH@( PHɳh(..oFo*S <<,@$}UhdJ"~ֲ] >{B0.]^ CAT@^O1 Ip;?L^oZ L(@= }睚}"= oD$ xɒ$GA|PHpPPS"z=颵|Y%Nݹ4ϭ6qǤN$@$qt|( y+YR/,2EDA^Ӓ#@> C_#KXϞ k}lOEiSعDc3=gv"M䱇O^JgĬc$xͧy/xnڟLR&O3ͭ:/^3W-W!D,t?~/&**2K}4b X2߫s6&_e͐*?x3bΕ)vĴ5Y O13%N*Y<@GЭwe@|\|(..p2󼎊ūPb3K?ݔz 6:|2iy %J0\Yʚ.zjH+S$ bA̩*j?zWY3=g.ތ<}U[%dgS=(/sl@L̫PSR|שzUżX ܾ(ʞ!.,,C7WƸ:tjK ':qB9_?*MvBC'.&ZCx7O <}<ψYy{?>.>tδ}$N?~Ɗe?_LJXLGeȈK'K=sW/_džTIbًg:h? lXD8|٪LӼx:>4~Ɗe? (yD3wNyȪ= pᓰnL\bPxlM/wo0 <"$qA<}R72)$N,axDP@؞m=kdr0@PXX  IӒ3(5ԯˢsN (V0.C'22| B!}udKV"/o?u|pa0Ku<3}Ӿ3P(_XA\\.C')Z>nIɗޠˤ8:A`|aBaaABaaAKu\ԇG<3ĵSEĉÿn$IεJ$:eQwb^SH@AZ>tAR(VK{u܍UލiR%дf'&\_!?-ʑ&eWNO/Op7?}9rTcWoٟރǑ-}tVoٟރǑ-}t{ݶ)L[366>TH}:7,q[wE {'/&O"7P0oFO]9C䯚뷢:9_O>>4eY>*Pv68k||jeT>$qt9XaOPУ]K+ aqwN5ho?}Ѽ^}t+,< @3myf;OM]M 2~+rJՀ^(vЙ$9.^~ݤf9\2OK/"y;磾^~eXANDI▮ەzɆ|R(<99(sh=z>hN\Hl_brEA?-tUpJ4дf\fwFț+˓?1mrܕ$M}/^N&6hi7sd|ڦQziXx WK0l9eN|ˮ#ifծuy7n'^[=Ժ g) tkSD 2kDGb|?߃f ,.7gsZoϪ<P  )_ƅ'NY#>of=z< Ad0A$ i@11%H){ҁw_ %J Bwԯ{'P =sp/k>*O 8q`ֈ PȬm1 :Q>._8J1ϞDŽȈ md_:6VdD e[9D'J Pؾ>/^ D @x:6tӤLIr7yTȃIܹyMG"}t;KmԼMy,}ڔ :*">*2*B¼>0ͪ^,woލ?f^ ~Pw:vu.%N ~ܴ噷=zN޾(rL(r% >QvL;烀A{3s1?(}ٔuor꿷 Զq<5G=n-=J~5{ܺ?˨)V j9m`3&dK6myƑPd؟J,\9W/@tLTsuhtKM/~8fV-.8osТAu(gҡP0ҹu /-8yrB\YweT00Z4ql ȕҸN&B3eȚ1!~dF@b@ll4PTPBT C|,D C|,(3GC!!>@|P0^vrdKL[_9b[6y3֡N)w앸@E7c/hڨdM?uJb?ɬZ5ussxڷÙp.9|" P(ԫݹz3JJޯ^ ?}ATjenDGO_ջsßԋoo-Y-Y+B*o^SJ| EU, ***ҳs KΝ=sjpS\Bp%vz& ˑR(Fu\_qwgj$?N K֪xz⎽37yxlӴ֕gkU0)K7{[sJzԻk#_\$`ex]KٳfJB  eΔ f @bPT?N ə5yW wTPg.gxx{ʗ*#w=y1EoE>|P(Y0}Y2Ƨ:)cRK~;+!&NpPj8=+*)A c|\z(@81z")Q?Mp ggQib3UvgKh_Lt(!.&Ҽ_nUP!DEEE&%YeÚW;{-kbBz'HXrjZpWլR<{%GQ *rG' 9<p8=v %džW?(\jSF>\DGUJ=J3g(RlNs?)r$vѓ2dΘ9SBz|\l {Qtʥi<9&CʓrN?,+ҩ3 ϕ=x57=iܷխQN'@$6z")Q?Mp ggQ.]x FEbbbS>}8p8;G +ԟVY)#{.[#ČiDDPt @$))K~8}5[fiT ~ߔ Ο|y))/\~5#N*?gW8 ,ِgfw?1?Γ6ʒ1C\z'߿q^hٺwhQzƄ0@jzz {LiKazH@YR҂ o٩׷8z<@rJrTyɋ,PzwrfON,Y5G^?s`0RzٻSZQx?ܺ/ѓ3zH$,=>p"cՊ@beɔjӮ,GO^xʍ% &ÁNdd{Ex4s 988Ԯ^VE Ks(Tr,PWZ F//x|)Ph(R cvMd<&/WծQEk >[r|E^w EEi+?_]yW3Dž#0 ?>ouܚ{4xouOzo+`SJJʙ-sj(Ĥ/'"Q+\ gоV.Sa(DG"ÁNd[½P 9%9HIf| sl(PB;`T@T(*ٶ<|LBI_~[')>. ,?J͟4c|E ~ 8HK : 7%@çʦ ~, 8~jTڮnR:SzYoD )9U/Y"pըK\:3~M )C{=KB }þغ5J?Β9C#;QtkQ?)Ț4ܓQ H8P7fb1a&3c,*>f"` 2osfMmt;뵁_UtTpR&仲 #>|hlG ~ߗYj{^|K>YD"aKWL7@0&VMzgLYT|̔E@dhߎ'r̚ x ͞1..+[JߎE tzf]gu\Q +Qg4&x'߇@ }W>ĪMrBHUlip &*E@d؄%s&z@T._4 66& DETI.XrG_<[##.ф_3On ݧɑ5c8!-5sB$Clt:  55=ѡ(p厸x[2%GFN] f<@0†M\yo.@O|L'> T[rSS q@ zl݇dOW*p=| !>.A0*hG|8!.&Rf/w0O>J~_8aR00@ 4jȫARr0 KHAS?} !>.ʔ(<}}eJHް`.۟#Șr>ް`.@ h'5}E=&fOFnRV&n̝8@Wxbcb"~Q@4Sn'NMM $Dž h߼LKO̘2% $ϟ< mMq^s?D"@0`[m,' _9yԷ3#"!/ވl;F\H>_g5w-DGZ㸘8}FVPqTw}a@D"Ȫb?jQ"ԬR"%g@0`[m,' _9yԷ3#"!w'_]cc|6[! >aϽ>>ȖxnesT-W$uw` w\Lf&n{2En{/CLdGc3DRzvz˷]b6~Pb`0@$ H$bq}$3t÷6~ =}EL qEp`Vvo 4w]Nѩ~R(*w!4xܢsnD+3m{*; )9UOfgyaYGr'pgSg^Xhߴ{>?6:@ 1ё;wAv$DDbcb cB|2DAY3CQ3@lLL$6&&Pb" a q1Șqa0@lLL$6&&&fLؘHlLLBQQ2&ć @ A~_l`0 @0)\ G -+-D85;3Ξ @'J=~(%Σoq4棯dA;r'{%-=ݹB.Hv{% I{9YdxEGAz8_W-[85 `u>z\;j_ϑ5S:#fg|Lm{<}z(!c\ %%-AzSj?Q5^:#kLt7_juBQA@Gc>zI t/wbYY#w7}pڝA;遁c'>dG)9K:魛n9|V֪֪\< =1U{Զ~X?fs y}*SW<"H$ЙY3&F~+wxV&u+&ת\< q_Շ>`MTHD@8s<{%;_D"(7{qnLD0j2FGV8zTT0H$`?*\rat3wk_>"{ )/Mꏂ/ueDp;r?|] " Wo?xpvuj}Lr,+?5:EG"ԨT"J%R*ʟvޣ@ZeCHD"eOM`0`lN֏ h\Br: Ln/MjZBr'zڌ==K@DDD" Vaɵ*NAVRR@ |qHR"pĻݛ/V(WZlbcrgMG$B G)T35J@Nlu.k=,# @{QH@9  snF}ގ:qZ ..:RD@ ݇kwexb#smWlJ9@GaPfٔIsfjTlJ|Ӈ]k޹")/mdLRS*Sl"snF}ގ:qZ ..:RD@ "-J,Q4wڧ}ޭZ(P0"@8=HG_K7: 3Du#** D""D"HN-zm1 % Nڦg,MYn,dϚ)=6.&yз8Z!.6;z^P@35&8~1m"D"gɘ9SZ?[Q!Y1PX޴]K>mPX޴~|J˛! CN#.fd͜!1CxHE$EbCE 1s@\lD@(%c(*HDdΔ! q@H uQPtP0*! * B!  DD DዩO@ -=e2>SLr9Vmޛ!S|pSDP"" Դ&*'pi ؑB^:cU`?*KldȝH(PS͌ @$!.&e ?q <,-1dwY"iyPS͌B"TdW>lAei@ KzĄbBx(ٝpHZdT3>DD"@ 0E6,Yꕏ +gdwY"iyPS͌BH ?kyc{QQApԥ&ҦF+&tV53\ G)6/Ț) N]^81P@q6Jv')%8:̸BE2hS޸=[F̝80swf+Wsf˜N5sB8.6:ׂ@@Դ"@tt(Df,ڜE25bfǁݞ@jZO,ɱzii"I̔.R GDsnf)Oxq0  -[ w~7 ,4_> kױ [չ[l0g˛M%gމ E8sFyOyb\lLc߯}ҿ* ?T-W4%C\t\c㾌+K F-[+Kr@6uեU<PbGٳeJG"u,CVuV.[1 G~wBQ{=!::*27>S) _a{+۴eHMK3uYf-ޒJݎ7̒3дnC!.&/vG3ņRR=;6{ʭkCYD]߮QDJ0HIJu>$tmS[] F}1¿7ӭעֽݚ]8MYջFwBQ1C%Dž7ȑ/^/U4O*@RrJgrߺ03r}3kQ(7n4Gu'F[1!!&&jӾ9{I74ݭݳXA T;S7@^@ r o?JNI &BQ@0P쩁@)qT0RSKLȝ#1=n2&96s$çދɚYo.ccNXsțo(;u9seϜ8--p`rjZ !,Iɏ+taݶ~ ϑ5SպiǑ}_)c0?/ߖ{^?-Ӏn@tT(Й_nzWɬc[uDnoDDŽ|Iu(u;'::*ңC;{/*6s$çދɚY=wʵ;_vދ‘!cd٤-qWo_~^TOgVHr*%S|'iR?YBQ ClLG2[4 D"cL _&xPfnRÚUJ@\\Ld] yj8=8znBy6]D"3@W ~wu֕ 99Y͚5mܸQ֬Yt|:S[XA:>1!@ z|>EL͙3sڈ匎 F"GDwg,VRD"~[c[vu#bJM>˳=|o9͙3g_/y&!C\KWo?L^r;M=YaČ+Y %T+_<9:KYaDs~<{y85Rw>]1)TPrz$p COU-h鷃ʞ)ǏRRݿܳʹ4QP P`JlltT| >wxܩ9eJΗ+KZ"HDrkk{׮jg* =z饗\p@rrhӤIO-G|\l Y2eDGGE7|pֽ(G}G [IAhӤIO-G|\l Y2eAiwߧ31кQ{_oy;C\0p@ά?(?OfRS 0**2e'?N ܽ(#k0?8e9 ::*bٲd =u)lq4\)otjt;[b| ..&iǑg_8 ::*q@RS5  *,;ʗ# >.6;>`O;S0N7;u? D" :%!>.yw%`Q@Seɔx̸͎ Hɓ`ʔ)zڵk~G3gp=:t߻UڹsYXbݻv5j6mjժ+WeΜ{tA%@(w0`\rYxڵk C5|JgNHJN{^}ޝ6ݺ6o]O{X8oy՘SHt)_#?{OV(U(Y+̚9M {q>ۯSu~ȩKr xPT ˅9W-WQttT$ DgjK@@R@y˝-.X骥H$ F#9m{eK{6 }\pPhNj&sHiHzz$ЩY2SàX>Yyys~8~^ƬaȹD "Y΄n˲hr Jɔ!"))iܫM|PxDHK qnKe @8(S4_J,WnWnjV. d͜>?W\Qң g}6[\vǏ9sF͚5]tIΜ9B!g=BYںu~ZRRuڲe@ (` 99ܹs)SFҥO9"o޼l{@psF=Wn5ܸu/y복iT~ lZx J(P0Z׹wҭWNq_ EQh/7'3*7Z760﹚w6tjw(jX^% >CLrɃW.ש^:..:1!6Yq訠@Ƅ@Ƅ@(*(K0@tTȘe˖/رCŊȑd͚UFÇٵku?eʔSO=?~,>>^ݿߠA\xQJJ 2Ț5F8#G4qD ;v,DBۡ` **(D"_|џ)Gӭ[7QF4h`۶mf̘Zjz)Pvmiii2d>37ov  Pș3g$$$]B@jV) 3g`3fo7|#66֝;w޽@"ECqqqݻ'>>^(iB!.5-=R1@0 =-]jZz ..&cc"`ä@B|\R  $'bC`T׳gO3g9sf!H88t|;#g!gBQA8\EOt&{a8zrcγp;BQAtΌwz_EūCmVC8zrcγp;BQAH/~]8_}6 Sӵzct/r\oO(do^8?~x:!CL=N ,Y#SOݻzn -32LJN,ǏNǕsd͘Ƌt]ˡ\*Wc8zrcγp;BQAu fʱpbs С@9>JT0 &:t3gDE85-8Hu~TU@zz:` ._uP2SHz9K$>Ur <llbs@YӺwhpl@kH{cڧՄ 1D"_% dΔ! g/܈dcN?}/i;4r|65H$1sjBD"/CS2gӥ*Ҽ~dOtKSUK=,WcG&fNH/?G,k#k6Kh^Cܺ0jӾ5*r{pè-d?jL ᕛ$8OjZze Zt(*몿+)^yog~OT(#K洀@$aFN]:sOfޟZhєwDG^;T-[$"Dk7E}/=p2>gLizr2SN=e9Kϛ2eQV.[$_.Ƚc߉PT䣷_iZC#Y6gW_wNnGE;u)fʜ9 s,[3.͝ș5SԨX<BQQ|,okvd)R qC^*7G$=J pzPTdP֩ c@#gb' 9eN}î{pè-d?jL C]h‚܌.?OxtѼ݇}D"4rйU[}6 }wʖȗ&7TQ0GL:OmPݎ j{M,&7 ͞;znSY/}[`0>m<_lܓg5S+/Ի]pTɁ#g}7)3~=ۥv״b^lr@i੸7?Uii*߷e >x=6+_:B% I4o[A҅}n+ysdIO޹u[ٻ/^;w\g9>G D,_3ȩKrCVunVTTr3(["_r|RG`@(**rИem͎,E |Y. t@kulxkov~eFF7ש0HoN:g3LJ+*hӎ [׽ > CQ!H.ϱg}ڍ{c˔ҳOK>kޚ欝p|ѱu*= f/ޜe۲~;ёA#g盿,t{&x<)m׼ |N+_|,Wz$?RF5x$B]sR[ qqBr _ v"0 Nsv9!u'-,/]<Jt(*mȖ9.Mo鑰KWoOWxΧ~yOW<KJ.@)?ꭻ"GeZȣ6s([/7^(oԂr\F٤@ ARr !Cl$(?gڇ}^ tV/銧TѓUJ/_;w߽ŵ~\kOrF"c?zbBtRȚ9c ń{$cΟdEE%=&ťBQxmBpPSbc# fkϰ @ˆO}V7#=yK&, JON+Hȗ;KU'9;?@yR gĴL3!:6*9S|7ɞH[#w 51>?8}oMlѡ[^^x2@0(9%EQi$EEAX$Epe?[aWb0ul@ (FEE"qq1-ب'CQGI qq099ՑRO~7uٶ{4c_f]'9y)v؄y\#xPiP8_ WoF@rEDc[BBረ8|BL+kU)es]r3IJ^lSNTTD"@|9S/\ ydwKsnin = # 1ߛR`\U䣿~u&u*{M;QQA'GO%NBYdJ.5k\ ;v6N$ A "rèmVצ"D9u161SBZH @JJPTd3fG>)!=--=9c|zP @=== }aT׶|k[H)!-HH$ʞpL_W2Ip@rJz.Ԫ\gpzBsйe[[־;Gb:@$7 s=JI :eZ9˃`ܸy' ٱD|zzz$*pèmVצ"D9u161SBZEH  ˕=1m홾ay<9ٲ?wFÑH(@8ѣ`bƸpDY!HK8}Ft-Ȟ*)R@']2EL2{Nd(_@ʤYȞ5sj e|7]O{P8_ԏZ٫+r nymݎ̝׾_YYaRny{Lr=Bً7e}&=t:g3 ~屢reK{#OXX\)ߵ*e&G"PLo˶pR3N!؉ qWo܍ʝ#1 5-- "%}|~rKr߾0qjZ G)lڵm/X- EJ+sgKKn}|rE1;q2D**S\҉Wb2ą2ą>yÕC|Oܩ^#:5}'Z>-;KgK8keWN,!B(TRI/SGMj9}ZwCE JXvgwEE\L(rfK˗3[ B kȼC̖ˤw z_w׿>K'"@!6/\ty~,7 zY3;{+D_~7?w[־sWߛZ2ņ\(E*e Щww;1Šh)]kAA>Y6 DY2Ąm߾w*>.6|] '&A/=__oٺYCQUaQ̐?Oq1rgϒvΖbw_{S C{ PLݙ9CQoG:"7" DJ͛wOCVu@XtjUDп{^jr3= `N@XDnw#a b"0wk^iq=$!CL"dѼ)[8shըƽVjl2m< FG2FGdѼ)N{4E,7iE9w؉1ё Ȕ9>}^>@|BL"J E@¹< f G׳5(Y4o_G{2fa NW> kZnzOKIyȔ! ԪN܁oZI P(/:}îL=:52wk^iq=$!CL" SzOz8 1شHB, ieJHFܟ8ke}V-_49[Li?G0 192Դtѡ(7˘5KBZ"Q*'Zk߱UMΖ-S_=@ L|BL"~6TpX|lt$ fk6e|K@$,PT/s 2VT(ʐm{H 1Eluqw/))cp ߒoE"@ .. Eb"$f$f'DBAdȜ9> qH\l(Q̙`@.MotM=ԝ, aO@|BL}5ܟ|bT( &:~6eq_s&* b"85|KBA1A=),3Q H E`}rd˜Ztd@0w7{NĄ0'D2g 77l?Ο#u.nOʒ;wG {/ ФN)ɩiPLΝQߥ&4SA@rjZ !H8">.& "!N\9ʙ% Vȕ3KZY  hը=<]SJ'T,S8@rrj  DBHzO@rrj  DBGP$D$<d$=L'E 995 "P{EB:p2CpSf.ڐڍ;j{ >JE:GQrCn{zK Fcb5?8 bJLc.|8vn ED"bNBr>ӵMxݛ_ʕ(_Z3{ք7^lr k~r=^zGbO߉ E{O*ׂ9DŜyRw2g io51c"U ͙K:6,^;8xsǾɊE#}`HŒ#p̕@^c,M@$pW?W_D>YAr@$D"Y3E˱#'?k ?ѿ`T "pW?W_D =N0@0tv;e$"IIDD"0MjV-\D\z;tP2Exk_UE'ϓ- `oլZA3;}[  {r% &'f@ZL.-2hP>g:/ DCn U.S$9 76Q%[4xn<)[ͪ%+Y yϡq@$K̜^@Tȗ'k+_>}e ԴtJ|&TzzӾn?GQ{Ih[u,q yj;(t|tVL|9R>yRE>;g-ڐsG_.ȷsѡȇoJQ`EEhyq*3DG"qӗ )jۮ<]ob:7]w;];g-ڐs](0aثB $;rvFu*}m%~ 7]Yz(jO ʐs 4yP1~ۯ[+ѡ(l]75-=#ka:\^#x8{ECQ=Z^n\ H8b=HڶxOت΍isNνGY69)?a?udƆ+d+7]2=z&kT*p菿Z?G̩;}NkVNW?+իsdK"h+77:Wu(\<WK0㴰iP4OV*ާej¹":55 b#:*[,oOɞ\3DfwTTTPU҇<5c|G)|a ټ:7Hؼz:@$1Ψo]v;PH7֩V" ?F9z.q˭NZPT8~R̀OgzCkj{0+~wn߾ny}~蹺Uɑںi[% y=a '.F ɖ x}S~ZͮMGOwn])~S@)=:6ިv@IQofK̘*/%%%5x̕زܹ0U}$#gFO^oX],W@_6d=eq E/ݰ`?,;foo/63kt^mLwltP~8ٓ^8zB\llt`l„BQG&]\4rv~=]ݯSHBѡ+/ԿrgoR#kW^=WiKH/s@DDҵ;KWzǃ=1!89sz`!xRȥwl{*a ۏ'3ԺAsX~~ѝ{9u90MOcӁ^tm{N.'nƩ0y_r~PzzAGܺ\y/ÿY'GH]wQ bP@"dXW(&nS  D|¹30W?RD"@ @$ ̑=[r <ʔ1Ck._aJ7C7~Ț)M Qrj -=-QQH|\l$Ҹnuj{{طsWֺ5YCHy_nt&@ޜpa@||L13Ƨ#U(YQ\L(\h@0?|>4xw?UxP(@$"ot}Z(ҳg͔zà@ pƝ`  "YdL3˹:O}(%D;@@ZzZH(q(o 箬ukz8-OޡM9SG0ɳc2gOGD ȗ;㮭 d@ C\0-0)9D$&&B[Tu/Xe'̖߻J;!@ B"so:. >.sTL~AjV.1[rjZ? Dܺ,;=---)S|zyW " qanwfz{Eyj}մ@B "tF6yȩKq#ZXϟ4❎ ͑ i@\YR;Qs /;rd˜1>6 HLO/w4D"xz/C iKB ~ߖu[sD"^oyzIS{.7*-0H$d ZqO`0+.wjQN [Zɤv?ay/]Ӱv;/s+ir'GEdϚ) !CL81SB:˕%uʿ 5@¹ xY3'-7o -}[o xJ&$?N /;fɜ\A(Rk ))wD̖%wY:5-=պ9GkGN^q[w\xGѵY3BHB|\ ՛D"DERQQٳeԯQ&-kbkNՒiQQHTTPD4U.7<y(hۨZmRD S0""QQA itQA"@m m[Fi5 qzZaֲbbB@"Hrd 萬 o?s~߶m6IET"E"UDJQ*UTE%J* ٶmql޾/3 "PQ+c%)*~-яyp{{w9(@e2c(HFPQQի]PE_g7kT BǶMJf jvez"g?x㖊<8p4n(G.}`K 9gީ?䍾>DxUyX]0۶_SZ-NJñՒ!?ݐ[Y,L$g?x㖊<8pm!"XQI\q람klV#J#cA*`#@Ok7VV& 8HŢhݼ^K޼)B2կQ~Ӥٍo{ծ_ !ukGQ2tб@e29mV1x\,zm&Ə<|ŧU j?+'iX  !V̜yo'Ӊ͋_~{yJiעAX7UF՗7_ؔռaf]IZeSobW6BQ]3"JE~} {z TbCF3^gʵgvb%Ʋ:pBɤ7>.튚5UߪTJ8LBA(--!Ae2 v&jM]4.NKC< !DA@!@*BDbA`񗫫o>;f}vMs3B!Rlj٨ni*Y)D"Z4[zXI;|xR" !%e`g֗xhݬ~@ZjW{(1s'kR !;Hmedf$ Ϝye+yډE |!! %э^l:憾pf J  B- !@HRv&jM]4.NKC< BjW_k7ܮI HQc%D<3B- !@d*|횔@T(!=VK!;3+)мQ!'⩕?/lۢ~٣>ۭS룹ٙI!-),xz&kT@Biiy A M; 3zwmT@ XqiJ"BDBo|`ɪzխ]efF""Ţ()BA Y"M%eQH b@2\=vv=WzRƕHHH bT$=Q+N/׉!ce>rM_7ij3@!E9} @:Ф䶡!-s*9Y3x~Ob2S":96/kƧb-S4}Զp~Sv>ym{2F^n{2ޗƲ:8M;G\gmx߳bsж5*"_VfKԯY ڵ_ңs)x,&33=E)y˔9M{_5-딃Ol^i۞ bpE=^! k^}Y":96/kG_w^n>;_Eg_5-\rΩܗDN-[][_NKؔPV~eZW-[_/1q}}Ͼ+Aj̫E@,dg&oC35x﬑:+ I/$Qv~QWeʜu'6/z+ʯ(?1^̌D:+ I/$Qv~edzF"b^o$Ģk{b[ML& *JNV*7;3-YP_~쫦K928ȩ_^z+ l̮W,3#NG Iԯ_b1}qEe2jڰV]/"бmR6mݓu  xy9)HHO(99|>o]ZW%;cAQ$)BE )Yg,ʄ:5i\\B.*۲'q(S[U>sWi ;Y7ŷ:UN }:WOEe:oJC)"W^%}r2RQIjFm**.ef8Hgt3!"ޘђXFf"dxICBMKVuǎŪULEQR.G.hqiET573ER썩^|pVH2gMRhռ^;ߵRhռ^;ߵZ5W썩-ed&BVzZ<)"/>8r+>{m@*Y߼xqi r3S\;.9`FZ<дQOYw4Jyi!Ъy>79VH ;]r\vn#t"") !H^paNG~EeT"4W{G,ghռ^ٲ7;|$YiRE^|pVH*Io~mw")4W{G,gY3'[LJRxIC%+UR)ÍC35{}QFʗ>eѢXNvz*{䥅(#B PLzokNs(Ia;>d/Ն<t;|'S)%+{6@ u9yym[6(MY>@&uR||1̓+/9c3& *).)WY.-tЧsJ7&@Rx% ;3MEU -Pt\vfhX |c|QR9(I`/.SJH d'L@fz"@^լ$1yU W5+ LOH*YIjU TȍCL}*ȫYItŚU*:n\ E)6晖t9TW% x{ӿYw^ܞ̚Y5o'i\ .oޠvD"gt;q*kWϫ@ $  ղC 8V@H  Rl]'*@Y?^LO1Ǐ22SD ?^HO%1RAiyE YRZVHE@iiEx" =[F` |K^m$6m-L>~f_yUPRZ}ُW\@<R6t{8G7Nb¬w;꺋@HwLt%-[97̝1!<1ú}f^gO;())屶'Nͼ7x"< ǁx"B*xb·u?buͼ*ٕϞw<!L|FZ5:~եش0}+*уcԶE]xɛo<?o?11KWVmE}a_5 $< ǁx"$B*Ss>hԣs?C*D[vxoksD*؟cfO!PRV# x U߮>}UwJˢX<B qy;tj}"A"-XB`ˎo~m}{(LEK][}6Ex,6gUlRf9ekS{\5`gၴ}ulפ8"oVϯR>[gd&C*RIHpFG_zsYϾ;?ֱ](gsV&k@{n[B؟Gз@HCϽ v:{onʽذ1O~tҰzaFuJfZ"qks'4=ZT8]ӣb{!XĜVx難F;Yד[}%k.~y]%SV%+KN}s&1_=+*ixKUrS%G^mvXqs>>͉x n˺ٷ{(#8W\p(@Vzzr7O{ͦGkh@KVV߽Hzz"dW-z"ikaƭgLFbcݙ?vEʼn5=:~;*lo>[KDqqiGo_7W^]mhۢa;Vf~@,()+=MiYylo6{jOjߴ2vB.f[^ԾiqϿW^UN>9-+^.(sm6- !Xxe կLF.㓯s&G'kztvԭUPيߪ}EʼnīOޱ.+3=G׌Ѧ<67=5'oZ j?]5+==P^]ř;v̸}K[6w|sww>x,L-C/ܑ_{zFɨz^nۮҹCb(+ixڋ٣ܬg+~6/ྻoEq=>z|s͆uk>8͍,.>כsG1eQ2-_{3{t<?ݖu߳o7޳PFK1pK`O}qfx'8E 9g6lͯS9<ȫ+N9}nn @uyco췥vͼ^aû.Xf}NqiYz^dnVңr>fן;~vnb7D,@|*OQ7ի_>W[$+SF >o=2\\̽#iU{w=om`Z/=z?I'krɭvL{x{MA1|iᗵGw@fFZܯ >]XKcwR˾o矶:٭ÑU+ 33#7՘6!L} #pxCiQ())[!}ysYIؼcwcs>hpZ8wNJJbj VVOg?zz ed&>2K~!Bp˶{ՖnrS5K =-9LF͎ȯRuܛYZ^e&nk䬇nZ7euziq/ڬ?k0eMr*GO۪z={kÖ]c|5{յÑ|ϵp?~{s~t+^JEzzZ 2]#/:W[NM,E8zx|YIʈXNwnse >JD< ׮!zKc9Yx M9?h<7k٠䕷ج̝$1.r}k{g^s>lԧ)nšU+Y;(+/ ߻0(ءEiYo|VƉ/p?1+)/mز+m.r}k{g^s>lԧ)nšU+` s.99Lc.<ӡ`٪"-/kH^H{uye]O8iap^g/XZv!@WE8^\dgRVF(-#-$p ͎WU#_r].^}{IKĕWVFee-)[/5~*d{&bp86h٤N@6ҪH>odz|p 7wl۸uCd2ƾGcKZvvzh׼^[P|-i]z_S/^oߗ@'?y=£Y p<:{õz~n ξ.ʼnx @S_-Ϣ@RL&x,r~?ߛE4UPZ]3թQVZZ|#'#)̌˻yix(:^/ԩQT }gÎ})jVQWlmTf9@Jo_76HKwEB@ jNرyCuHKC< TϫRW?׬Lv$1B0Wm}4mXGo/!EprbdԬax,jU<ۍ~{sURL&#T C7t=uHOOV@Jܦmڙ !(NnX<X,23PY5]ERL&#w>W4DG%m[ԯ-D<( miժd4ʔi}mwGXxt젃7WߓHlKV%;դA$Z9;<@iYϿovJx<(dgW/ZTS۔E)£s>6( xQ 9W}GB^]ۖ|*g;b{ԶQEE-&|N'4-LFKʢpEc< Q`]Qʾݎ(PRZ%E x<wiw4֗6]\NAYye2Jr+JJJ⵪畗Guj1DWiZ @8|(qeߞogOGnڙUJve<IOO ?z{kڜw,tU. pXq}&Ǘuonڙ;_yjG xfD@DʬD!M;3a㉷^{6bxOD!w$P\RWFI$  zrr3RX"B2lٱ/3BWVF )k CϽݨ<3cWb{_,*) D!B((  RQ%1AU*B@D@B]V{3:آ(3+2dHٲc_f*E(!Rj*(E!B!M~F̌W0Ou=YO J*+SJJGcrCOR#׵iQߍ;B L5pK81i[wg|ۂ*=xi=G !B @D8|8Q q!LF%e*U3+"r4AE&xI̴ƭ3FmA~S#L&egeU.yy&>YKK 68[5W̌0IDTF^W0Ou=YO J! "dfeVFB` ]ЦY-ytiϿ=/~>txxiAg-*):lT3=nAyEҙڕLᴴp봗wlӰ7!̷?Y{R双tVAlٹ?>Y5?503#= uFF8xrphI_V{ Hz[7^-'2ѡ>6vv~V o;yy,Hg~7vGT2*]Q_ȁg1!0}yZ\FyU-թ{mؼ7ߖ=i7My܇G~saژ_?Y'm\ȸAkTI8y?ِYz:xbF;5 &W]ƓmѸv%|Ii5>4|)TG_W$լ^%+zbHdȋyhA;IWƮ7fzZě.9tvJsr2@iiYaJ>#3^Z"xb'U;zN;xM0eU潻 ё,ں{|S7o\rfԶq; ۲;m]£D |iϼ[P^tfv%SowjnV(..nZnjsS9O{|'X<.<|]( ߳|hAű[{bH*Q2Ɯ]_c&G?Ys;odK<")= >m_6̽{dmE%9 f.[&ws3C@ JE1z~ʊ5YֽSïU]O8ܰn~oߦ/#PQbHK23SOQXiyUsRUɩ ;wlQT\Rhyۇ]5@M%s,mOT9E/e Q JoޕRׯ]RfAſvf_~-*S@@@@e߶/~ HW%E+thոUٲcovł@iYyL@@b"=Nmwh_;d&|F괿":|,M;3[6W2g҆OSOlQ;_mѠd]Y -kިnjR'FոAr5A@2J$bE:ǎ~Eʼndz *P{SovM@@VfCzQJh#{&>VSoX 9bK5_\U-C>i޴uv{ܛRK5}czƗ+Էq(4[PBhҠfEZ<ݴ3-##=UNA@<?9c԰>GnzۦZYV^'ީM{V4iq#ude=DߵhgMUs(S쳺PE.urڔluMS^7rYG^ֳ(8t(y羴6.Ws~½oNhR֥cr?[gU9o/=h+aOWLu򒧴kZgރGCv/_;oٸNņ-{.g<8[K~̾qЙǮ?Fu*~κvœξkwEEҺMjUZ9|GjרZ)䖥kU^~~-ש5lO{u-W*ӟ}?F&1m+/++mؾ7ަiJjU辝+YO{fQ~:8c5DPY$ɔC|}駶)caC?˺mȹGj׬Z+*+|jsƛ} 8Wkt:IY^՜vׯ]P9yͮy"ަiJxIC7S1饚/.*L#yy6ܣX4a✚W^ؕw9O2IڕȯH sΓO`hXJ Y-Mg\ǩm?Vk`^wGuE[5]h/jb)_VJH! ?Vs7\yq};vȸBffzn7cC+n~4_Kz4.ܮĤ'fADɳھ5?jTfkiذ;n=;;W%b󎽙[/ȫ[1'Nޝ@fFz NWmoD<<ڵWHKN&ФA͊ (..RDH$T ~Lg/vY_%{X"T =p4Ll޾/eKfߵV*d2"3(rre_o;+<Ʋj Um^0')uvMի&kTKТAYnNf*R rR?X<73}cm񝅇=@^՜%gw:smCFa-_%Pzd͂jZ4(Le'QvVf*Ejȫh?**qYFn8|x<#3- E?t /. )99Y)hլ~™w pE.>deebx'k*+*T`MμoS~pa.~ +3=|4w/]:5GUsQ,pjVt̻8&v 99Y)J}4wIi+8p]&++TK>~y0by;^{ghƵ>}yGٙɴD#/ /9c?jV =bw?YYV5' pA·yoEťdZ" E^xPF^Gs'QQrC@,'I-)b1-Ԯ{qW>KO& ߱Mʨnd@@*Dܽp"bQܢ$ (>}qdʣGc󫤠,:s+ cw ȿ$f/\VUڷ_>rYGrS**+@kT,:s+ cw ȿ$f/\VUڷ_>rYGrSD׆[X:nXvߘ֩xcɏ3}xgsH ~6뉗>/HFï8v9y9@@@@@'+d2{%x\yOzf۴/(֬|soo~MVMQP-!7N[s?2 /'ټq>[jzZ5Cep0 ЮyrQ Zn2 Eڕwcs>ΟʧyiԤ!Բ  R"qUrc%OkQ,PZ^uhݰ< rR-]8 ̌p;j$D(@*+Iyr2RJdfiqW- ';# dHO i EUͩJ@Z" 3#-H<7>oM٧th~>R2{E/8cqNvF!JHE! B!!!HRZNVR(RZV!=->yi쮪9YX+/RJ.JԯY -)!EH"O-_wn8ֶy݊ms3RD "-ԩVM/9zW5* Rh3zmI"Xz+X,(hRZ5[h]רիUQX/ٯ]EϏybFeUrRA@U ժ/(-Ko}=;)cu JEixLF-D!?7f4oTZ$ jW`CsR@ @@!,ꗜ?ڢGii0{xE!B4*tq#O]a A33B!@PQlւ//>SQym+k\fZ5*w;ؽH~d@,3**QF( 6. 'kR27k>=:,z٧vl^Ţбm2ܬdԚu{wmWrŅݎvCVi.rG ##.J (GS{!( ;)~eGˢի&C@SUsRL禩s`e5v{ڶd=iٙ!@޹M /?Z\NjU/{ !M/x$BJ*̴EKb9ٙ(?^LEQ URRVJ%?^J@XffF*XNVF*"Pt$JcR)e(+3-*SJbٙ(ԮW޳v+.U 1|qcw^wᛯ:H2(ߘuxN8խi}[Y8u4_W6?^[Έg®EW\ص2" Er;Ҋ(+3-lu ?[2i ;췾;mK=|ťdghݬn<[\yW]XfF"DQkѕv-5.{>ZH YZ7[w^ǦDfjUxsʶ#NJc9D„/9G+瑼9)ȼGDQd# 337&o{FF~/޹`=DQd# (rus$SI9Y!"k%| YG:r<2DQ䉉W%edgHMOhӸ N?כ^>qOM_~d#G=~Ϗ_[ZN J1~fE%sO?y︑1+W]e櫟4z;#JCh?Ԫ`݆7B{t}}wϿoHOкa @IiEtlٹ7u]ߝU|cO,;L-9}80۰#sSoX1[vMq}qVD7O|͖{/=Q !cm1t9U8m؝Ouxk渵yI[d8qfTtߝWmA/~.vG$(TT&;^W57 Y(rxnjr /7iD"deT* p~$OirB2  "rY(W57 eė? ۉ@NvVLHr9Yo}ݖ ߦnQeقcc=N:;_ֽwUV% ي{\{=ukWcv9Pf~@yEekpub(~ <ƭ{2zF-+ԫUP:7wl״ȑO/l_X{DMqaH%SfYw> ï_k7?k^z3so5JBtu{@@NvFжQ9@NJ! ;ЬQfjW@!pHQbg̓5+U+;x{kYk8w{jIhTV#Ͽo4+7(V1-KKcot=6(̾nޠ^:e M9Y)عPFǚ6Uޝ5ڔ;-hE7;2|y;۵lT!<5_o{#iX27;s}jNVfn7?7c>r?^Iiy|sczthFAJ?Ye?y[ڷpڤ_ouRE]Nn]иAsz9=N>kڜm[6*~/>⢦ X"+bm|E==-7Sl|ڼ.i<w){ox*_֣siBʘs[d%>~ǟvO<.'.icoݲp=bs*(fY;y(z G>ܷ5+6de 3=-_kN5hC;cAu{)f'4WOWt(fژ[(+j\z Jpszt8bfYw=;O|mj)[_nmW4҇M;㔽7 r;׫Yޫ GSԦٚ;;Z*k,V%r/7U=lU޸0s5nٴn~1ՏA^st7Uي_j 4nP|÷ 6?i :}XD<vk/?0]{NoӮ̃g=8jۮxGㆵKjȯ(V]Fǫf&}uV;끗 ]0+6v?1L'jr<3-:mx @Vfzxh5(Z?}/E7եZ6%no\FYqҾϾw'p(V9|P~U*{8^\ع@zsN=TϯR MKі텙];9w^zJLM){pzz5 Zn}w]_m:whqUD"|j o';p$QN ( Oǝ{){#j_k8Վ;rOl$Smo֨^iU+SjT-1T4iP|-WljK}ZQL'jr<3-:mx W]|Ʈ3v8 n:cOkzM{p:@@Nvf*b4]>+v቏o5%>(gߡť{==H*PRZ%㉐sO?ppdԴY>_k;ܣ1j=x8MЮEÒD":C"H@" ٙɼ$@6K:i&>j[h_.wHz˦u2{&Kĝ#g8H2>n=7W[=w[w枅ύv&瘟%eӻx$Fj 7{jw4de2:u㣱Dde2ӓ9Y)LW^s)$d2ɨC&Ei)TT^Ԫ^BNjKcWhE% 3v8ϞNjc57>m\Y^|~w( Ͻs,iЦyc!ɪUr"wuZy6p'KwdeKzM;Nshմ^nn\f9ԭ_ל4U WJBzZ"TܼͪmOf:+ 1_ln\ȫ]ެ;t4%|&p5n9c"Цq$q99'>hQI@ﶬۦ;k6~e]}hϾCgt9a7!(-+whӤ ZngWJU&qM*ٹ@&ﶬۦ;k6~e]}hϾCgt9a7F:y-n8q;22fmܕ yU+ޛ5}ۚ}CD"n-vlYPQYA2Volii^H@e2 $`=ڴуlۆvRۦ:%jTXfoRv3}:r罳[6D< 5 V^rN׃vHObPLE"d2*YIXYyy4,fA+,D<lپ'ɭ B< r* ##-u nN%SԮ_~4v͏X^^i[?C99)E@H)=KܻUVVsvoomѤ^[y彯zrcUs*yF-/T*@"׻ۉG<{cMgh,p5oʁX< 7_䕷o֨ƲؘttWVVHnָAI_c&XHKK:<16=XygNCikWTVVFD<բINJOɑDIyE,'O@iiy53uDm%PN T*<Ԯi1DQ̉m+A)ЪY₼*Vnܝ{gк kۢa @)/礶M7Vȫ]4ܱű/op5ocBHٲcoV@"׶ER^sImnV-7 BCϽݬqœnrk6M'PN T*<Ԯi1@)T* g8tnXUH@dnVf6vQޚU0lS\v^׽~5}Y)7>V6kX,@n|c@)?OIc`7_^w bצyf k@Z<5Uv =%4[P@$9٩ ^j{ۯܐW%yImEK7 pמ2k аn͒&]_<HO@VfzģHnD"|v5t]myMw7;r v}0=##=XxF7M!S9=NwjEp=joy#4_K{jVxΛ7qsmߛ5X"׿gv.}$r3>ZA" OMOzz"@+ծ^,}a'n條9ٙRoxٷlZԎ[#G(挮ddT 3O-4egavV(9kQ3+6oN>CVsz-^jWH33SZ4y{HLEu8ti{I++ⲲXn";pȱo>CǏFH$@AiYyJK*D#!eQVfF(-!$y:e)HOKsO?0DQL߳wv5+@|tu>nْH@HT_5rʨ+vVLk٠ Kˣ7> X,ƫ-tICxo{Ɲh܉`oضIȀo~)nH̝">lUvxӶ=]`sc6%1 )`oضIȀo~)nH̝">lUvxӶ=]`sc6%1{(mu^MD iWG4XܘMD @BH)-2/dg(Xvvf*bRI%ee?^Nű@IiyJVFٙ(RJ*PT\JOEQ @Iiyx Gi(/JJc D2k{S;6/qMnz~2ĤkVϯRR߲;˩wcРN򩣮łٚ_ssʨ2ĤkVϯRR@2ׯU^LFSG]#[75ǡQ$&ھhΛ_5t f2*-=1隭TL&kW&QWba=鯿M+/q"E!Q< BwEs߬ɽwcPQ"ĂHrϣЦIt?MW/qOM_~d#G=zOX[Zn J1vGJ~q#o%VW?nw@*2ťco꿹I>ju/.jvE=w8d m9}DIw?oޝ p~.r?DKV({0.B=ozB&EW]r>ز0 3ۿĵٙ)XaG洧h%_Ug ޘq_D܏:1οb8(^R?!7-o|yw<5UEEޒs;m&=aYyEl}wó>w %+*QضIIvfFزc_b鷿Wm߲aQ6qy{9x%55Tw6) !X> W^YW&og߳;4덥5he hߪaw֭_ ! ?.oւTT&}>_{c ۳㱴D@*<VN'4pط?:r9{sG7_ w/wk9dGw8]BDbG_\ZNV"ANvFWENjK~JVe{~V+HIiYlǮsy+.q߳_ ߮;YԿo̠mjW+S)#:w֝{37lޝ5bй{Z5W*07~C)===<+G_w^X*ϾI ږ_-'yԗȯZq=jV"a˞rr3R/:^\U2.}̀{7]}^aEJJb;vH_ywy}gFov߹}cmW;^m\J ;oUʳ4_<Dj?[sF :wMWWx5~l6`7,fmg_}cm˯uKMkWZ5_ZVV۰eOz-՟|۷jT_xxzv̆D< "vб'n0s絮|ӥMJ<1&7 `[zZ"@vVfe"װnҲGVV'Jfe2+S!}_U33'kvR^|o-^Z儃hcăT <#ǷUT&*زso_iĤםЦI}B M=h#/ECV%r؀ /[]B>v<]D9RM~kc^" w3N9 xhM7Uwkki؍WcK4޲sogZ8Kvq!HOKKAEeE,jNK{ &>6]N?^-/(z.N,1/|ᙧڸuOS/ߨez|cz Jt9RM~kc^" w3N9 dʬ7>փs%f=[;٠nAۯԪYR(,|_4oxlA̯H[sG;Ś7U;劭YvٟqǽڶlZ+y-bT297iS3>lZY Oe'<%nH­n9Is3Ss:ޫۉGBHyb +N/$pHQ5_j5[侱C64WSfg'Oix*y*ڷlX[%+@fzZxrnv^H - X+hڰVi(--o鷫F~俛ve$Skߡƒ9p=Suk{x<Ҿe::V4oXҟ/-RNcQHR g}\ڷltc B K23Mnغ;#ws]5$VKVˮ|x[wjs,Eۚ B !0wV|;/)$'kV5 Vw(7>?y[ֲ^qjrШ~GyǎUJFF_1{eD@yyyiZ%ǜ}~Kt8ԫ_4S$TJԦyMb嚂S:8^^^}ϵn}x^yI]FA)OoYZZ}å;vzSGzU_xƽxxO~ٸ/ضeW/.j|kwu7}EDS~FKY=Oꉭ>(w(͏.mѤ^̘2Do/ֈuN=^8ɇϪOۮPNҲ2;d'zz%ύ~{wҡ****[wԭ_̽7=7ZqcF\)EqQ :@ Ki{NEJK+b1L3xpEk_VA5yNϓGQ @)O׫>޻Hڽ3\_F~_m|~͘A㹏Ϭ7>WRZ_߿)QP`ŏVhُu^|ֿ?6[ԮiQ[)=9=N{w?0/޳6X5?XcSFu%; -=mUï:o=ًN}6Sv~>WZ'0;78x(pIڿ6g?9fn|cۖ_}狺邧3h޸Nٲwkf>lza๻kTZ%B)Ii?k{z5bءEi/=r۟/.-C.ٸ^^]O8J6yתU_fI*ٕ~Ye#:wwnNvl k~ZB,<1Qt?G_iuo_ױT}uV;끗 ]0펫6tl״m%,v*VwuXqqisGo[TaMv`݆mpmV/V՜W Njժkx*N'<ֹcNhݸБxSJOKKee =x8~OQדZrJcBlڒ;';3!w(xqib}9@;R=J%@" xGj}Ϸʿ·B]zXq(!& jOpx#[|uIOx8JP\R nxj5_'_{w" wo[j9[Bgߡť{==H*Ѵd*m^ٵS?}5WXyYep1/^^K@[ܱ?'n\rHQ)mR)QW_{o,3>Ee2-8~8!=-UM^s{q=lx٧QP`ϾiX$+3=yr+wn{4ֹC @IiyLVF'BVfzH==w‘Qf|ůzpjBH'mr 2vy] D,rn߈NwH~ٙNJ㐝*-?z8%Q2YA<Y!;S GFMqj= إusFG-z]{ɶv-<<ԮWv wX$"wg]W5';G~{sV*9H!R‰mWȫSHKc/o_6NPZN2Beό^W}]x@@lݹ7KzH?|4 *,~xqZn2 3+#)9YI":v_iGfNNf*j̫ m׾(XHKYx =ߜ;f\uIσɔA_?ߍڴW]g( =HXL, Hc!;3#ЦqI6wG^mz5mIoٴnSfyoczt'IU&Ǎ?j˳z}kYp$W^|*+++#EimZ/LKۼ+U]ڧ۞ɨC&Ei)TT^.(n?_oФAb-TϫVd{2X펥*ذ={c|{7nNQ2Vgdߛ\y;!2R?7$PRZLA5kys/ݑ Hr?E1b)UT2W|hҠVGn'/|F{< D@,s,i+KiXAFzzj$Ģ]#mw? {{YwӎfZ5W4׫Y&=Z/VEaUo(Vgdߛ\y;*++wX<f'㇏%jTťKGn" \sS;,mUĚ6SWJBzZ"TܼͪmOf:+ժD1 U+RLպr!Jv{&Ѵw|[~H-\Ԏ-J*bM)bNrJ@25mXxDAA8|xڿ7gA<d*j\VY"/ZQƫ~f^r( >Er2Sɔ7>kwYZ~[*Y@$BPYY) @B(--E(LRgnؤa)]M%!Db! BBH !DA[#! B$Jܐ]3JeyE2W'"Y$IqGF$ eD)ǩmu{uiwQf`Yo=w: ! @YYEiڥj۴+w߉-!cD_#Y;|E .:(ђDժ9Q+B?7d̫RY^ɫHV& DdeҡCEimܑBiiY,"D(QJqj#/e^]mTfo6ؼmoևs# Qx_UiQ?VGr3Q"3+.sVGd%{qQ| BeE2:z$QjNe(Mk;V{>z~'QPBHyxMJJG_{ZqHdۮ}Q<i)w@2j+{/q[znۢa T&SQqiYpQq J׿zޑnޠM;3fasI_XQI<dd۲;{f/ȫR~]Ww)m1ۚǀdTf^9)*NTBN!,^jN**S#G**S#G b&~զcE%X,ơپ J}w]i=ɨvͼrHRAZyQ HF;9@Z"z皍wNO.鹧gWD(t9^Qqyl(/xEV4nXVUoۢAi9!R !BFfz2DB*F<Oed'ba+6eN˳}8@-6ؓ("!B"!s39Y5lc!"#=&.'LOH((Zqҋ-0lCFfz2DB*FDj=}0}Y-!+#=C7"!}{¦/zZ"7O !EŒcn 796S1aŒd2W,s39Y5lc!"#=&.'LOH((Zqҋ-0lCFfz2DB*FDj=}0}Y-!+#=C7Kă( HHB,כVT&& jy%ģ=o^1tӭc&^s*&lQQLFjb@N:^} pYoٵ7k#& j( {ixxf S3BH7 `[ZZ,dfd$+*QqYY,JEY)ťyo-mԴ E<ᴦOKģѴz"'{xn6 .6 %%5gtn+U8RRSJ)\`'.YHen3ÂQAQȟε㟃˗)6 )U8ʕ,<˾JɟH@(N*Q{Q_~s;C҃ 0@ӑpʍ,ㇽvzŒU-_^Zzz`3qOoc7QA5w٦|/mzu BPB"!==#p~J({LHOܽʞ-> ȝtWnd?C+L3k\lN%<^]:q.ۘA=NA힬{13 _]%_2*?5 kTҍx"H$lǮC9W*y7o ]p'+*_hrS &: ?̕#[Zu/CQ`$&&: =:=q[1Ue(Z0?zhT GߝtsV݇ՀVMk]9ZܵwB=:=q+q=W ::*%0!_,:w A={ɦ":jxy7 nݕ/ Fկ~seÁ '0]7M0.\G*BlltO< ~w?|nrCկծt &&: DE j\] SRҢ<@(fO{{#~,1ՠzRwxՅnFD &&:  ~w?|nrCկծt{K|1ՠx]6Y\jU%KOɕulo&ݺ+_(4_o;Q@0( "C-/7ݞAPRdȞ5>3k\lN%<^G)wͅ[uVZ5ukqn %Ǧʟ;PPHޔI{{ Q"?V5v囵dsP(?Cѡ:w5&###X(o48ujLFFFPޜiP(BsQD""}>Tք qB(*@ 11!"bbD 2 7zs}T\ʥ"c3! :&K$Z_K&p hY[xSq5+J D̈́Hc3# >>6"k>sD""ٲeB$@qPgf-XqwQAP i_=%5qR{SRӃK 葛ysfˀ@ h[ulYZlL8{F@") {սބPTdO*ہ!w:sX5} UӇyr%f1lݻQq,w80j`S$ F"qy3saJZ 33#ܩm_ Eu*NO$dž ZU<8wĮpPT:{{ dM@")֝Q1@") sIzxyݛ4{`Ƹ~?HI) |R哊2s[wGDb#Y3'} $$ć੦olTc׽cYBf iP@B|l89تL)) aEzviqn⍅ש|tkf snrT\|l8:K(@ܞ:omѽO%Ԩ`Ҩ^GnwZ|R G;wGe,e{-_JL̚ K~ٞ}f@ 4iT UӇP>Hʂoܶ5DDcW΂{IzNhS-ɄU@< NE)U8")\Fs&fHH@ 5 !!> !:qHLtt(A$$ć gbL aY3PĬ@(*Jք04osdB*IĬѡݞ:?UPvvOw; EHL̚ ']m܋kP9q!vظy~@T( @ 1ߏz`f$sŌT\һ{ϞȖ@ZzZ0*"3W}[@)͕3{\bҒ9jZ6ɟ;m۝N"=O=t*qxNgR3v;+g  #33Pp; D=s5fm;np==3D"u+ݝpCdsjZ6:8 3)͕3{(V8_jfzF`۝NΞp嶂Z7"g@@иnnoVMkp@  @$dKO//WZ0*ʓZt{&3XWjJ<^_LT8ѵ] {{/ FN_%h_;v~AcfרRÔ@* zjJ$1eYyӺoz"p *+]49gbB&-U{s;}1ę#'T2Oli8c;nsU}5%=p"G(Zk\CTZW.瓯NKKSgڷw™~X^nd #ii@T0V,D߾'g"t^r#~,j'߾ 73WZrdM'U,Dug?./ ZԻԫ[X&_ԭӯgSO7} XLrJjTZjF0Kt(c9{|6M.±ÂE׸歬aw.\[b X܉32xw?HڽXس/kr닾ڥŅRRҢ.^^g/T`wKJ;d~xQ&# K._;uJK8Wtd~ݶ;k9fcӞk:Nŏ^OT(S,yO ~%}`(JEE8s%BRч7 ]r=z "(*b߹ge!>.&zU{g_h}K E]|3滑^U[w>%?Br 3LF8x/\~'ޡٹmwsss&f?ys%=צuR҃n2[NFg Eʕ.05--ę+>qSث e%iC/伯 E (5-=x,S?y L!þz=T7:BR{Z׿}ҿ۱FN- #@l/ulv%ҹ"[\s%&U,SAlrHo"@`V&?H{W #h6OČB8qڭ) oD?ݼu*ɝ3[ϓ#6Mʗ.znըx|bɫ6?%%55>6 p,`@\lt&^Sʗ.zU*&%._ã.o?'Wb+?y*$W+_n=Z=W:8UŻ2|vkWHuTËTv;%: 9f|^ףkUU%gƆsȚv^r\v;K0ɳ{n;`If ˗*詋` ɕO^|{ ɩWz[(O$-};kU7ld=:=q"驆5~F v4&Kt  Fx&gbAo={k#_q'T@pYKY3>}*KNN ֪tѳ  Fx&gbAo={k#gX2`y\XRQAp*J  &:K 3#3PjPS.'d23HI~nc9gdYD@ ʵYBP8!>.^o1cy_G}̌@ɢ@E!:K(  Fcc2sd G<=9fHdfϖ Ç,?KsBÔ`ZFf@iŊMW=s/]G!_) PHd@\i`$>6&3GLpS>ܓ31k&D@\lLfl >|sϑO4<'@(<|LIM,R!@"ySըxrȞ YBY2N[@@\iL_CSD|;GĄLd``( m];ptFO/p‽,@ByR{<{$edٲe@ d EE *TPAĬ5>#&{aoI s$\aJ#" ˑE"a$Fݾ+GLؘL "ܾԺ7ݸu/tl Q`$gbB+7c~@vy5e̽vˮ|~\";b‚;w22ÁԨrȖ )Yc3C@QQCZ7fV"8=kB&ys\r3෿d;{zlg_;CH H$-{B&g7܉Xk7aʕ. #&,( w'2‘@4H$,9%5 @PW۝تS+ثSjTNuVoڕBRa$A8@$ {D֤RgHK_%oG)U4ڭrdlP= 22G"FO\TxyL%BH,ț# 3y>Դ @$ ԯ]ſm\~g__u*ޚts ʖ9%Z6y %%-jM^h BpREBzzFPlI% ={/9.q~raZz0!6{mӫn( !0ϓ֋O=mE P>Hv9ye@jwJfϚ Ԯ^%zg.g^|%M]| ?hP=0@(*tO(ߢ۰мAk$?yrȞ5>3k\lN%<^] 0 SWVLLtʖ :¨/dtjKchREΜɛB(O{_UKyMë#^pj@r-;شSddd ͙ٳgfЩU YB&tjފC\2bCC'W5ţ11a,QQN\pz[Mљ?yP(*@ǧ\?yr+}UV,y6 MZH(PN,7g6 `ͦ]f-\$ F}@'IYmwnªͿM<||y#w67q` ҹmkЩuZ7/wj~sWccBH 2sIz(T$eO*ہ|R_fsؘp\lt:m| 4QEzviqn⍅ש|7!>6tꐽہ!ޜ_ZzF :K('Iu{uIXѡhR)֖)n'sD2"[ufB _MFdK ȑ#>IXѡP@JHq;9#ٲM4 _MFdK ȑ#>IXѡP@JHq;9#ٲM4!Xj2"[@AM*ŊDT@ȖoYXj2"[@AM*ŊDT@ȖoYWrjR)Vt( :ФR-RNdD,~WrjR)Vt( :ФR-RNdD,~@@FdY ÖL@ G$Wx@FdY ÖL@ G$Wx ؃Dn@ `J@  !q?=5c?GDzB!@ B D"3%X@@ % Kz@$ !g+ @ B!@$9H4r~oz X@$|l/@ =2@@  !@@8r5xq`'Yb#UGN]" #!8y.3#D@ 2a"!D"v 0uQg.Td<#p-M]Á}F̧Up}_N_x@TTPf#C|*3[B,) 1?n2oU+D,[_|"a2XqOpsM hXx`'á \v[Ώ*7we~1}}T!6蟑#{L ݸ@*%"93raTôN-jE[^W03r@LH$Ɲr㮇Dv8eQ&zY 3ja_ ed E8z/ˏK~ DGyB@$ @ r9Gz*J"bsZaOd5 _qO_d~ᶨk 8}fK֬npeu@|lz?YzF"Px^dOD~}2p{)<9D"thHx{2',9x%-?ҦiM{o~27K =#=#T.S(ysfU)Pwʓ3o<0}B?Gǟˆ>m2~4 p8`bCȗ;@ 6&$w8/\@ "HIRvO<}a`=G"{Ӝx#P O6ٳŊdἑovΈ͒~`kp]N-k"P(Jbjb/83S"RE~rrG" "W?]DZf-3@,Q)F_um[w ޸@֏ff EE23#,g/ |^G* #@Ff zEԛenR5  "p^e:F$~#%:~~Z4A  4]6f_ն,rT, >ޟ2~(xc̷< QQS?BXy}ڧMF(sgΑKq29|={cTLtHj#w"p@Ą@j;~rUJD(W@i6|F)iQͤˆON FJ0o#ȓ3 N">.+˟ ݻPq(W@i06'ȑ=@ %"abcA$ $"bc J/ B!"B"z0P01k#Q!'*`áp<B!D !*%2322d)iYBQAr!|YL HMԬ?|=BBa|^ū gxY{# {iD_Qٳhcx% =|>=.RPD@^nZISSe " ?o6UƒRTJ*I E HJU$ J c۶8@@7CW\FF?X巃 elT-7-)$BֽEVRb?s)i)>fbBDNx}F;KLnH\5MndzeI[~;I0]fFr #3Wצ$GcTMMN>8~Yҿ.|Ѭ[ B_{:IߥyT7>\tPͲ۵SpZ׮gt9P=n>PV϶ s!H mm&[xVvǹogw%`w7f)ûd.'xy~, )_H,$n/[,%'`ne~;F^~wQ ,\ OPUȨOW%ˤޝӷc鷲u0# ;>rw5[@ --Qjetnso@rbMsOoJxƄUңyV %c׿gR lHܐ[eY/ 5ox<@wUJ_~W|!#^< r"0B~u?~@Dq'ߕ]T͍ <@wUJ_~W|!#^< r"08sj$M[Fc^2u~]~i)wU+nƫ7WmyЌu3_YdW[4nKu{}FE^e6@Rb]elmҫ= HӀ)os~&A,vG]2bAQ/hT- pAkS範k^7{*ȗ|aO|Mwge̔z*7@0udL8SbAkS範k^7{*̟@Ffh,BGZ4۸^ܞoJ^fTmtQh4f2u{4Yt¡jJ]ܘ\HMIԩR&6cLYueKګdpABn+}9q:eyk~>m#a7oe @B|8Ғl0ejm|:aw5[@JH$ZhB|Ppl;A, pV@$I/-I϶ sZ6ۦǩf}Xڹ ?}1\|؊n%''N_ _O JԔD4޺HܪM4?}1\|؊n%''TT,)1T.W"D1q_ۣA@*2C;7;~(,݇Z4 P(^#tY thU?g2 v2A HhT¡Pp]rXFsS: ,:3G2# "ep`闯ޞ0}閄_z<^A@& @pGb}ZgMһMLlt[ԬXy\$G VJ @yb< p#=3p7sߏ 4Us {jV@8-}(+..FzfhoD4niӠQB j~339y>XOR|j C\x˓'J0:M  ''SFh\(,&)1!hm\ZFV}d>ҤfNJrlOCYqqaGOɍą$&$I V|f,1 K?ꓕI-V꓾7,_"qKԔX, bJ |#~'+Z4'}oYD fZwX O[9q+}ƥhL\\ddBH֝eV}oNʤ5^yP(\x˓'J0:M Ba]PX " A/K\xtOdԩ\:Hչ=w]1@ikjY:/Oj .]K}ao|V#-ၻ-_p ([4 0eɕy:K qpd"p5n־L TD41!Lۤ[9^ʛ =ܸzi%GrwUʍ ; gd#*F~2}UsRP(bQ|躙(S`X 7 ߸Uʍ9 BP T,S4 w/]7eJ @詋.͚oV,S,sᢅb9QnȽ?:DZ?詋qLO]A5+XX  {.T\X8hŅU*_" &|mҭg/^ MK@|SI_܍Їs6$xŅ$P4hFO;^rѺUFϜj‡yrb3+|xZ9Ӆ?$UXfR@"cPɢiЌ<O?|wvjPHDQ Z6 #MjΟ=}1\|XFfCw@"cPɢP($..QRsrU._<ƋfB!PQHNLPF~o/H9+D7n;_pԺt 9!@ʷE}BB|ļq,Z0o0띞7yq3M˨~{Ԭ|[٧0`z*$G͸0(T 5HJڽ25湃nΟ@҅bwU-}Iy&5s O \x pXA6e?@@rcf\6 q@ƼDZeBJr"TxU\6:.^ hѠj7վIvrc; ~-=CbBI k$%$v.RD tAUs{|M?T/Crr1Y9R@82uD[YY#NھXdo$'&i{ߩiVn,*%)A(wU+73$'%BlտSӬXTJRP(h/ ɍHJH0go^Kϐ')!B!2HINȗ'$'P(-2QZ)7O$ȗ'@vNԘ?z󭸸0P(-2QZ)7OHr"Ĉ L}RNf˓ #EŅ͓ 11"Q@|$˓ %)@@HPd`ʨ7T _\zoP[u(]`0eTכWnd*/OyqfU" Tb hXb.@B$NFr 7oeO@w?[<S   6niJRc/um AX&+ϛ5%JgZfl- ߄o[b.A׈=ju_Y9\+#wgG 91_};aȮԮ 73CƇ+R^0@vNn(.OMKʗ*p+3+p?$w|l@G{fFVߘyfqcK[qOOݬWlJݶhXyWr#'/}eE~W]|桌џLٸݗ5蹇3"qa gkKDc/;:-mWțڍ S~y0>!>bnl\='ٞ0fXzHLk72B',OqqٲqX)hL]7ٹQSlJdKU\,Q8op8׉IiסMkgحxpܥזֺt3רݲ?~/SsrlX-W̓WB#>*u۞bE]E.]zU)o3~~֐HL!%)1Xc$\v+Zϖ=lNǽ>~iӗ·-}pkԜ< 97uo@Ƽo|6iX2% /3q{(m_nrk>{7$t}}fښ^͍ϩ% F|K,Hڴ ,ͪRD ⃄BrC!0yƤY ?_8Cmצ|FE yknY1/?q &٘t33+ü6gcT}BRB~~ֆ_Hړ&0﫭_%i/HL 5/U[w9XYMS J,@KGz5Gw,3s9*v=#jA@12 ź=032qho/3cA$pV'>>N޴Ǔ3[4xO~źǚ*T 5 BB[!K.Ԥ qofy6ضpM{wm >eE $%n+Q &p+3[NM3ׯ};7iסUΕ:[Vv4*..P(r#,_"7D hLsJH\Xb i)A >$5+ B Vt4#/^1uHL @(2[GeЌzYC^xVbb@4EdžO2݇tnzqp\KKed冮*@Ff- ?0ٸiK6'τZwޖۧSSJG1SWmJB|Ĵȟ7%(^8_,1! -%9D"ayR'}[!P(VVVNҹ Ŗ͍ٞ݊ArROq伴ev&Ņ ȭܝ A@$.$_ޔr1јHddB(?Ob1odMxFN4u?C&,Omzol8rB=+@( \79=<}ղջ# A>[YYg VX$޸ 9vB@Vvv( #ZrrsCŊ-Y#a'+SװZ\r{(P;K+9-I>^:~PKWChL\$ 2sBPddx9i]/cețt{}FBa.\ +]4 Ƥ$%ۗy•U&LmJˆճ H %5)B"AL Ă r ɍ5ӣe`? |ᛁ 1BA 1A@Oֽ=՛w'vluOfjr @V*W,ެsgٜH$.Y|o۳%N_\9RSbA V*W,ެsgٜph 7ر߸Wʉā VVV莲%rK蹸nHiRrv47LغpKD䛔VJNJ@HEpgk?{jbXSBL˻ըT*mE9)V8_4'7ZNޗ΃72o1@4*JHK}㾄?{9\F (75δ)k )= dfڴ?~weUX2X1@n4.\p %(?5_>;oi}=aAXZwiX Wo?>剦uRHNJ  yoPnfvT"{~fsV.̹+q_0?QX1=!P{ڥw4#oݶC3W/ ɉ(; Ҧqas! x㌗YdW7%Fc1pP($..[f\xtHַBY(@RbԨT*ڣmN僄9㞻V`Z=0|v?.fKE %)^d4Yﭚ?jQ@i=A~G .}ȄeyF}u*z p<ëre@Jb߼uW^r;JIJ#qrogvSB㞻 uG_92@(2iXtG/~ꍌPbb$HNqx7z&&'G/~ꍌPbb$HN|:KzVvĄhv_+F]ΉƤ$ BFis ?\?+7+59$2ϴߥYFn4&%)^(ݱ|PJRB ,'g@jrB& 73s &nTrzFV(%)!(Z(oaWrr" ..,_ Zr Zr  H\X$9$&D$ ..,_ 59@jR<|yH@D deJJq+KrJ"_|µ A3bN޻kWd 8sjMI{>y]݂WoZ_hTP< {EyWN{J\\qV-ӹML_|Z`jWǦZ=?An]bD쌬lPH;K㟄O4C8x*f:48t\$> ʔ,ǹH|2% }:}Auj͛V nZ'd1H|2% 23sBOѻuz;8|:K.x|ySk'ݼxw%]v3~+3xR+sV2cٖS\θAnOK57ߝ.X-9!>Τa5W9ة q/Mbܯ7NLa-U(vWo+V4kĜ|ׯ=y qF`Oޘ'%Ѽ)s)%..WxY oLZU1HX`ʂ)-ݜ;yOoHyvp.?_m/u5*!@O ,3*.z뷗+ߦ.丸}xweB!p=~b\E^prŢpƭА8zFճVmڝ8i9QE 獍]ڴ;q'+Ӳs7K`|;Kl`‰⎞Utے_"_NѶSc˾-i?̟JBb$7z^%E>r&~w?ҘLRNN4Hpyߧv0\zrfFV(+'P"Ѹp8ARbB PhnNnn+ Du<~do:o}G"eK~f@pLrg;npC{26WMkѰZfNN4Hpyߧv0\vVhm>7EwN}c>[g͖ߓLsqߞ/ojrPؠK؍;?z^bE[v0o/+>w^#[\=*Ģ}Y̶-gL|mg<9/Eܚ3tfp(#>+=wI Q*cg#X .R8j}UVmړܪIͬc.չlġWk72BpA۳o8#=~#`dқtt̥8(SpkḐC:^5|vWH_>^XXm[zî:UYD Džko* ¥h,:vRܽ+|7s" 3'WFfvzNɍErUJ;J^j~oլĄHpw 9Ԫpr^5jVbB$_êkX5 _ZrУm kd=>cfʟp5..KX,tԥ{kWnKE ܼHIJBᐲ% ņkޢqߜ̔ysŸp5+S•jwʽz=#ުY xἱh,&nf KKzmѢa'\9yyBSɕ:{zF^srٹ_IWkT-Fr^R[4 ̜\١o :='7 bS]:}jfugv)ȗ:un[b?Oȗ:un[b?O@^*ܥq;9ߕ}XeR"J-Fc*U(@Byc#&Hۺp qr G;~R\JsRbi) 5918zsJ+X "uC )!>P8 eф3]kդVf\$V2>[ٺPBԤhἱܨ율 _ZrpFFޓoH@ZjR,-%1P8&'/^gάp\$%9[YYp8deOVԩZ.'h\RV8. M <28t:~{A;Kۊ${o`}ߚ;?ߝ -76b򊴭{'E 卍"m /v|&ow$* 7mԍJQ,7%H\\MM ݕǡ[jY:g쀧V` 3N-0mTwתGlMډ3}vf'ފ@Byc#&Hۺp P oj,)!>[9:pvNt}A=|-ޘq_5*ߖӷc)Iz߷_丸ϷѺi̸pHyR${o`}ߚ;?ߝ @(275'3 @3^Uzbb@bKH=jn~;+(^8_lɽGpg E E+W(3f7yT,@;}&mpV`n8 0/ne儾R ľXsrpH(.] ̗+DzFVd|QYh!!!9Q ƜBPILBBAHmr9 B!(@ nr|.O\8d.WCBm% 榦&_瓍nGₜܘpH|)ѐPpع7?\w 5wGv\8.x˻EB̬P4율Rc"?JBhTRB|YcrO 9pоN9p2VVN],U@?'  ˴[Y9ogvT/V~+3 je?*B$Ɩ-imz_%\Zd.FnfdT0_jps훤ѻ=N`IHʗY2H8.ȍʖ,_sgl|ӣe+7~v++'.*V ŊoeCB\r#AH(xK& ȍEC .Y[;Ӿ*YK&\B\  7)ɉKpzxImZ:wdEc MɅ ȉƤ$'ƶ.~¥՛&ikP-pƭL=9 l{8a5jVzwd~Wo'/wV(ϱ !!+ߕ >xJsldeBB@8胵3N[6Gn.+^@(rB-U@cg#.ؐYX >!Ysmnlw,~_'Gznn͌Зv$?6,6m}Uo/; C,ٹQWnM~;+V$OӒF([ܴ<ɱ[2U(杖|u*e@,h(..rI kdd|-͌Зv$?6dd <_tџJv"w+ɂ y*x5++'cjX=eYg~GQ*w)7=IWj˗jW-759u0]e*KPsK+ȧ 65rV,Cne*-[X_F>]!]b@8p{b@ %sWM{RRPp(aOUMMªV( gl|rp++'TlR :v6 i煮BHB!-*J殚ʥ G2CL+8cןjY/JR(?:}o7>f鑸0̬P ZˬRT.@,J,'>>@Nnn(>rsogF}uK9Q0P|$H 뼗 Y!W. <|̵'*^0  @(oK-9!>cfiRN, Μw_1E`dǮW(]4zع8VnM;}MZB|㞿' */xD׫Gvo 3NŧI |ds*ZTտԼHJvsǥI4_9kզ=ɷ+ PLUda!xqBScGN^T,]$7!>μ[SN_g/ 7-%ks*-;CᰉC;^}qM+ ܞݯ[yS<| YDnO?ro/'610T*[, oȓ;ݵa,7ӕyadǮ*O4 /85I9p D㛯 ~KNX~ڟIUJBȓ&}"{d?Ƚ>جPl.7@(ݕ!PH'|~[rB|ǚXXLB8o$.Q0fҹ$%F$hwmte^E jA 6nhۢ^FG'%)xw@k>Xo+]/T -B!ccڎ* m[˨[|NޑM~rTQ=<ߥkqJWOlrBGu*.7c}:7Oӹy:Ԧ-M㮝ˑFC)ɉA(fǮgdfFCJ|$N|B\ (^$)/_Lʛ')BtjO<i_ <ٳP 9)֥e Tڱ @rRy$%Dܕk3B )1cg#ŋ~=鷲By$PHܨǛստn޺JIM @iO_y+3 HIM @'j[ќPjJR _ZJ0g o AJjRje>ԸFfPJrBW%kǗ#ɍRP(;]M㮝ˑFC)ɉA(fǮCڳߘߙ/-%3˷nf %5)*Y;_Nn4B!o}:dF}tI6z<@̇LJIN#q-7/\JLI <@̇LJIN#q@s.~Pbb$HJ*.˒7_O $'8C_l}T(]4%oJIN#qF$$KH  Ƣ$sff%}ê~=TxO;I|cMrrb As[aHIM 5%)8Ԥ ..,_Zr x lT#sߦD|jes %5)HH|"EkY:%/or/-9ȗ79P($_Zr KK" %)1s$B"яr% Ph_~a hݨPhTT(U$]C!33rB >.w|8೷z^ P(NrԼt }Լt J-p[ B5 ܨPb|$@ 4w?Ox6O55yۑУm]a^Rno4r6[S.\~C_ߕhԅGOE}Y9V|##܊7zvWrٹF 8{jKjU. S{I}.(?ząHs &'%:祫oLeڰ;Nٯlq}9v6#\둸0 ٚ%vg.u8鯞/2B˩PH.@Fv>gj\rGsϛgHW۶+ةq.ot ;vblϤ Hf{Yٹ7zڶ]7O.UPZtkԫQ.Μy$oelYV|$.1xF8z3Sԥ{kޞU|p8n2^pkqX4y?T˸~cn/[,gՆ)u~gcϱZ]?yR YxΪ{R*./+Y8*  ;7}K^n{je@ $~##4e')!>ۯ?_J [\ꭳ?l;oO>TfM [%:n^f{jW̎ąA`ρ]1+>8t:brW]P3 WB7'./ B9v6gz9Ӻ kqoI/x=w̓t+g|4w}ZFFVx?OXR^rmq0ϿNH΂Y١^z@vNNhcɉ{_tw7^_!Ax/ I}=^B-UϼVl@w]q"N^(]`Ǔߌą=.^ 11H3G.'2c3lνz##@(-n@% F<4"a.׸LNK,X-5 J/Ԧ͸pH*eS9ZgY%k~s+3;ϗxdK ޞ}+3;tO۳y<1@% F?{ F3]%a3 }ݎ;rVLy5S~5?剋 ttKwW/ $# DL~ZK6^.7%gx'ϛ f]ԥͬІ_H~홇)Y(Zd{뛍_)+  pKS]k臭/_Jl=)?Uɂot ԣyS @B|7>vp<~]3rN!jwIJ*/+rbמ}Z2s H%%$ P(j}\1|-=Ƃ:eF"qĂB   RSB!P(vm١p8ySbB\v#<}{6PvvntB 77 @  B!BA, (_,;.. Ί%BABBXbbB  %]o-PBP(Zx7Rg9-!>ΰ>m֯Y!K(=u1dC^|ڐv帱V{VLyH$.HMM Be M! IMI C!)ɉ.^ ABPȘOWJɎp@pfǮ5гCf'ZԻ9G bjU)% 11!hP( @ i)QBBPB#qc^!@(!ٹ% ~5݇+){IBh4"BrsrCR(_hB$!XB@ pB B¢1b!dFC@H4J+ ‚ BFw|osPR9;Ƅ!pwb1J=x\˟-R(-шnU)+ڔC{u2TBї{EnffB M!$ B@ʍB .12rB~=+fÑ#73Cp!!7ҳC_{Bn4ڶP -B73bOʓ4W9ҕvouʹԤ@@RRb ;'ț'9Vx( HD\~+Q*(R0oT  @ G;ʗ̹v##\^pMyK( X@  AH  ! KlO^FwUμxFh ykVfZJR 91>pw*U(3s̳ B"9[ݓ; AErP(B@P8BA W̩ 7mndIh'pFlrb J.-Q@T,po3xr8 c!)@@( @  B_sqΟ/P(BP0aHKG)ܢ{wd@ qw^kw)ݬWB]gp%mA2rq1 "qqRc)phbb|eԢ>tp1ȓtx-*(};3t-Z}unefRp8:np:npu2Z4~:'7ʓʗtn&@({/\Bx˗ݵPa]. < ͳC{R!59)ܺMP(^ͳyш373C A|$^mG {͵ןZfvv(...HN0l[7  | ౳bn I BܺMƖ}|zFf(_[-\D/Gv## ~_x&'PLGBb|6?K~ـh|q6'7*>  7yq:&'x$K 59)B% ˓FC7nf!oZr'9)ȗ@jrR8@ (_H·otĠer pVf(INJ C'_=Y6>( H߄o)r+#;ɉg<rHJ-znMzڷg8|:~qZzFxӶ)/hys7^yg~7]/l}(ihy[3[rW^>(:U_U3]{vb}:5ޟs[+g#ap濫qoL\Vx.J,ϋN[1oͯ= Ḑo?w SݚwUၻ7Ÿp8P V`n֍n!,ʷ}Gf򥲗|kZFf6si|#z F.֯kA΃I)I AKycL)qŸB͌8s1rgs.591vȍ[ѯk;j~][\FcpAʙ5* A@(|rEsMI,?W D<Ѳ?J"P۲ h1ȉFC+ TP*;@|B\Ȏ憚}P8$@bB|B!2C|6x==bod.]Okn]26nݗ2r¿9T`ZDCbT( >!.HJLdGsCMV( 1!> A[١zw\WQ\%r>g) |)bE$'yRk3Q >>.tikopHt=^ᓖ^״VԹ *V 7 @|\$8ptBBXLR|$HNssB/姯 JXh|)[Wp7OF"qzvd?s1R`Z (U@n(Hp B!Hdn+^0O_=9Ttw՘|c,/\ ٹ8xLOW~絧/4wGf\(eBqVFV襷fkȽ;np@rχ.#ȍA8VB줄):Z@(@,@ % O~eoʾO&:{)<}7~83JC2Ų=+q)IB oXgɉ*)F/B!'-+2|2pظ+? 9Ьe TX2\¹˾ݞVr鬆*e@bF?{nvymJIFԅd%)1P ͓b99P2ŲP(VC{?vqeEOZ&7bGcPJm^{vLb>o.uas^YL6THn;Kg>oR)hޠ͂RGO_bĠ UTVuЩ'[} f⹛2C@i8 4 z)I Pw׵ŵ2C)I x7}[Y|i)p8 %)1q@6}[ɉA(+zйMPȬz`I nz׍~][\y+3`I'[}޼Η CR ;0VWtߵh,*591B^ Y?/yƭpjJb,>|\NJBuߵm_Ԕ"Ԕ ''͌0 5%9Ąx QHMI ''͌0 5%9Ąx QHNJ .?o(@|y@e73C-׼,V %@ 77*+;'a73BɉA8JNJ0͍ɍJNܨPrRB[ԔsG"PBB| %'%p3#+aQY9䤄  %qqas21sb؉H\A`e VBbAXqwjU2K9q.ˀOKDClz3`Yv{޹= ꍻSׯ?_J ޚv+ϴ73BPW>o;2"]^xD TNN46W9|=Kb .}|w_qW"]|Z*''gի AXqwjU2KMm… ;'+V4SK>_B6 #W|=Kb .}|w_qW"]|Z*''gի }b_NyT$. '飹Zɫ"qaۊ}!pFFٷK+ĢySb~EIE ˝3ϙ9%" B ;;7t++; ~EP$DB޼ɱrdeECA4vA:'%1XpRтrLs&551Phs^y暂p .(6S$+N*Z0_ }Τ&rrcޞU￨rumyƖi]饊| VU۲=埾vh|Q(U@vM?sMwtAcyR{'-/w΄>gRScP(\VBbkؓV2/woui촯>_Ssms/GVmܕ޴DCE (ݏ|yn XrkK[Qx拏 _{f\q3vyq{w?IݽXq?w=.ȗ'v!;uRSs7rgŒ9A7ɗ۽my@ %*)S/^ףmݩ܈kG*ްn[S/ xыO>tO:lOҸ_9sjwғ>mX,M ɤ`Wnؙ7{ڶ;󑑓-\0-}Sew?2鋵O,3|ɉ1Y'WF\$a ^ k̓@pپPJ||\0-y+W6V^{#oN\RdC)qη- ±XL^J5rQ/0wŏe2 pDQB'1oh\}^JIJo ]^zw5Ȍ dIK:{)m}JJM ;aBۖwB!x-@jI_- oe^|>Dc?gŖS^yc-cJx-@jI_- oe^|>@xyX,M ɂb] /΀[6X0SO1xjh%Lw:9)>xFxԯ _Ц]_K qڶ)ۧs+?M S&}0闅{ /_7}U+[ úWd\_lsjZ&DܨI,Y@άqO CzߓB[kӬލYtvGϗl?/,Փ׮ ߩ86EWԫͥOO8tlIO4q 5u[Ym7v}CK]_rkO5wԬU9aps=kuߵ HLcA8J,-  9)>u?)ʗ͍ ͹|+Wn/_I ʕWAp^= ?p_73/= ]jz_[ޛ_|G_y]+[gx'II}GS>ԩG~XrRbBI,\r\Hu{F\lp(ܘ#%ϗzf\VnJgo]2~ƪ"|uWڋ_)T0-! toedV||}oL\\n=m۶d"RPU**R Q*"U*JIQEHU(lo/[VU>?(79gJųnպGQ睻RŬ7\qݐ9~ 2CtE_̞})ɱpUp 8bp͆iؐ>o|>Pߣpug:ito~:񝼤hxύݎq]h, < yêW_;7W2qvޒcwM߼*۞>=p,󫥥$e!n6=F Z/VKJ#wz"aay_̙;m b&ku޹E_\!+yZ?!k.:+/ۅMĢթ]}AB NCo8VcgN]LQь`IIaD0Ϋ7&PFzjy!gef$'<|ǒ?5'-\в~qj[n6=F Z/VKJ#wz"a KNpsxWk~#;cuk!!{{T1+q5N~^Z C^}iHsEgKݸ; f^ۮr* <=ߡ&w/+-7իSo~^צ)*璂h,.>q}GJJJ#c_w4%9_}:A$]W]Raϼ0[ B!xv[4SҴ~͒yW塟7few zioޓҴA풤X,ls޹ťe붧Ϙxj6oTf[V7LJ=pJhxnCGOխQkTXԥvMv?3oҾً*6)0 ?t,LaQtck.mMf'/+鼳Lx;<^1;3a"б3EѽŮ7=[1'3*I6[@oQy k,(tIarRRy_{qA$xf-G?~^<^~4(<[hTH٧k<jtY (.+ K#>];ڣxPR~_=}Ļ7oTyڥ86s޲un^EAoOjfCNvFK=kTF=~*Z{$cE1zWJYD.>tT Dh{R[7;r3 ϭ^zX5YZ%IXscȫ/OJ`*dHMM oR8%%h|nI$(O$| >ܤh8^GڷhPGȃO77kBmNA&)I CA$yɷ?fMݽͩQ>P^Pr'_o붥eeGDHKF*UJ;/++ফ/<9ޞ7nݟ][g={}{+ݸ@UX߶)a"DDHIIC*fg٢H*q XR4*ί{6-%9 ]";z͖6M}d KH„ aCHP׬R _}ܾWv<5rD aCXmTtld᷿VN!@Ba" aꇿ*سcAIqyV a0La DHآI~ы.S۵WһK+{49&?mOԮ٪-˙@#G lqq$ #@B0L!feԼOݻe0PHyyN>jJ&>)NEXR,Ѷy]VV T,nԫU^&B W[Zć>9IhEa" q?mOCI(HsJ}_򬏖Wتaay<F"X42WTJYNmIOIN@:Ja~3SrD! aqq=c_އj IMJNT5oY΄9rT4"H&B)*)+ DBB0L!,̹_ʝSV 0aڶPr΄0VMa" !!Ca&q?mOCIѨ"h,LIIN0W"JH"HPIqB4<787+|OgioGc 0m a)*)+ DBB0L!$-.ۮ䬏ˍEca0*)-NED@ =55 .lݰy]rĺpO{8ȱSQ^>l;5AJ #'D]3ẵm~ 9=55 ̧>\2vD"+g C[v5/lۨ؛-tmv2ғCz\x^Ⴏ~ɾyD"i) f kgޫi)ޛh|NѸ>̛_p{ƾZ;& -ꎧ:*yUr 9)B Lvͪ Wmϫ[s9y@~/Mk$a7ج]nPzuk[h|NѸ>̛/lۨ pkN{üϿ=;) թe*"D"W/֮V2kAZ4S !#=9`COqo, c>\RV wg쫵.cЫ[ۂx Nef/2+Ǣ 7t׵[2zx6֮Vr5] 4غ`ʃw^q Nef/2+Ǣ iIa{üiܾ¶g[jjRBȫ?pdҡr㐞HOK ^/| iRfy9]TTlu0;8PvղiWzcшHϾ#UJE779) v9AиnO_ ޝ 3|Μd$bј1= ?_U:W/<[dPX\' Kɱ0uk|ڨ]pKpKkKoYiLKI<[̌A7q%|}m.[zw.k.mwK۝uk0' #)IaZJr0HO q%?}|ɂHJjRD"'u,HMM [?m-^^.#-% #C?^TyyBQIi@zjJv+/jy٢HFzJ"jdAa$%5)LKI-OW+yuoݹ*dϞ2do2SClLYެ~bpY疧_~kە漺ŷ\H w(.. RSxyX񩑷D"!SrEr]zq%6j@;od⏍s2˛կ]L.~UyRڜWޝ q%~V(8]+t @2eda3őxyy]R|Ǿ)nNӺ :6?Y!@jJR&H@Fzj9 ԤRSB@4@4$"S.`]hdPOO@4vWOڂwE’fVΩo$ ح^窎3S#o9F$"S.`]h@vVFv9 Y_ .rxR&߻'Bfy ^vsڱ^~AA&%A]Ԣ,-) 2SC8qttо[W8\vQҲxp4LO 01}hDsjTO{Fs3'NN`.jQXZΖ!3g#o?w YQR Ъ%^rAAսZ9j"@mA[tlݨj򪕳 =ТI~ @ 8{$HOO Ξ- SBxyxy@qqY 0L(.i)!aBqikJٙ \ԮIaQIibIѰ8%ɂȔ>KwF#' #S^G/ DAZjJfoztڛ_T.z̫>v㞔?oxja=)ߞԨĒaQqq^|~bm][-lR8"0a_sn~=$z̫>v㞔?oxj>;t ֲI HR,@&kkZ5K+d$MϾw+f^ݵ~{Sn>KE-lR8"0a_[Ӛ6Y]!#MڽHGZByj˦E#@" Ci#IZ483~ Μ)WU^{h,bǞI/U޾Ud.^G3gE;t;Ok+'yr+ a"(*) n}hZo<Тqg-RjnY뺜D0Laǿ3~ӼxyХmӏ=PVFjb㱧__vdT͊Ov[ ;lpFܲDU[68SZnY" ߼'?x<9x+xeǂ HD"A8k޲RR,No_Mu^Pp]OteGkV(zO=q:v V.0W?XZ,^һ!^~,=1S߯٣bQ3.6쮫E#0OxՅՆuh$&+f>'yr+ a"ݙ:f5O.=na7UN`އL}fNEجIh8r@σ=:<@=?kQw߼;bvfu]NИI(DyWVvՇhC3YW/si@Qqͪ#<أs3i!@ 59)ǿ>ASȝ_r" aOS έV a"4o/ٯ~jYؠN^ɨ)sjU]ԬZFCHMIN$'BwDlK jd›T͎‚FjE:ܸ^R Mi"8q0єM-L|q~{lP'dԔ9V.wDιG._V?jS^?jS^w~r3ʇLx*{_XШ^͒ȶ]׫Y pTat)-[7I>ؠN^ɨ)sjU]pne?{r_|~զy^mNwʹYa"EU]OSuةJO+rAA$sc"Q/ΫTzMݏt *yW#nڟH5Uӯe|MƌU*էh,ܱ￭{SbHh$U* h,bdרRlh+Fc|Sl}('F۟[!N}/W%٢hh* Lv^_T -%)>CEؽHr5JޝδpǞɅgK"`zFr8ˎ϶pˏGOe%',8zL,#-9e`wlfk%)h֠VIz5K\gmRjV"uk8v2 ea jznsg_Vֲ?J6u L,Ys۵]uB{RBHKN +fO>GOƢ HKN'cHf%'`;W/GSh`Ұ?+ܘuYSh8_w=j=G[4-9)?ylAyH -%)".ř5+oZ_,3K&g:mrNJeի斞y␖V͌<}6 E#AݶSgʂ-oO:@qq<(  $Xĥ8sQfMYetiLM@Qqi.>ڥ}p]fKƥ8E@zJRDujV){t wl~zwk??j:6? L,Ys۵]uB{RBHKN +fO>GOƢ HKNvϯ^|m"a7EAyH -%)".ř5+oZ_,3K&g:mr, YCnp~ujUuu'\GE "¢ =%) ":5=:;6?=|򻵟EnF 7] [4/DиnN&@ "a5"ԩYNeOHשZ O_jq$X{?|<)+3-ѡeH42ϖGa~^鰻:4Ubp{s+dW͎B̴(pnͪ [j)T8}8$Ţa,  [Z)@KmڝֽSBSZރG+s^yoiUD">W+dΗ_|:thհ T1 iiɉĢ0--9вaa$ gK#A K"L NE&T1 D聉jmز7 r*/5n۱\3+%Ţmޠ L$xT]F´DVFZjT-t٣y@&BLUkÖiS!|qێ8媜_\)) G}mEE%T*sCXlز7ernVq\تH4)KfgέUlk226> sϑfyoZ8VՒmTVuщܰiww\yRSSJqԔRnf ^^D" ,IKIN0ťeCGN2ӓK?.VB<))>|۾_ޒa޴{0}wr*'r*ްK&X@.i[ W2RS^_׫{PZ NG+d%z8TjޒjlJ?9/Jܬ8;q:wT7]{K].pOMg etqBfZjV^|ﮖM-(-2PrNJ  W+-8]}O:+)+ cfqxjbZFf/X^e=Fh,IZ%aE[6ߗ]!#K7;ւU.鬌ĔŃ i ^9'(y%Vٔ~^s_~oiJYq*`&߻es -=%[JɬRN}%%e 3tS-DcQM*Pk.:޲I  Rz\piA4m\x^L}6$fMZUˮS?Ԩ\"#a0CD! !^cw?4:-^U nˑ7=C#S^ʼn@ B% WTnXfqK?zun.lרH 597=U 0$ŢKUr ݹ{wyoƒw]uysC!Pz5~zCfVϊԫy2۷:J6uC%VȈo{(VJ,Ұ~UˢA$pGԨTvIf-\Q;8 9DB.h,THK@iYKoYQb!s49v \֥W,;.-N:giLm}޹Ő SB8z 6W*HM)v9 ً`ǞI?ސͱ[.-N:giLm}޹A$]!=@zFr;MaEouiq9Kogj-X*@VFj,᥷~{cHxݡ[YE#1;o3h$I;Hpcܰus%8u0:{;3$Ef$@*ۜN*ΞrpTatwdg'$HDx]Lԩ)LOH=>$9¢AS|0mU*f{RF=No>9¢AS|0mU*fg_*=X@iY>M#nڠv lڶ/֚7cĶX, ^z{IJ3]v Joj}wK`+r;{G:|ï-_Vb(0 ^矽.'04v{5okMxӞH$!Ec"0 LQqY0+ot!Xqgj ^ A( ?|"vhAR&u"Avk>ʋ[ΫT+ot!bD!۸3BVfy~eءI-)u+~iI7TXﬞ][X5wfLy^ahS׬ߙ1y-{!' A CpIN*KWճkSءI-)|凯L+/n]P;R ؾUM*_cnZV0X,C0|凯L+/n]P;R۸3BVfy~ePZV|9Oeǃk>ʋ[ΫT1ضpsܸ;ĢvN~yΗ՞wǞ%+T{3gT]z'in]%=¼ݑY97l[˯^2hΘtϮ ťq;c=F'M_rnVٟe=1ݳ/Z97۲&k/۞_#{Մ{v:2Gbш<k?tƇV<pTQOn"~}wp+$sUkUTà[N$Ȟg5枝 őX4"BZ_G*Gܼv8cj5[~nעh$gK˂V423c=;Z5/׫7>7H(.) 6o?gJ"K~\{Wnn˱qϽ·~ν_ß]ZՊN?W[_𱂤cI塲xuׁʹYewpᬬU*K&9 ~uC7>~kT-ԻuD0GM~+kNSg~HINN@jVX rvskU+;}\iou C$J]*fq%ʷ:V97.9, S#Q-lS։'{6;[OLy@rrRX)7 PzŒ %UϖE6zUdMzi~6mZW:vWFlڶ75%9)QF2x|Kמ=999\q=@mN]ԶϾ5gS'Ţ7t=tE#,r{/ {_W0պ_Ȧh@sV5m5}=>>G*f$Y_T[j}ݾsϑg^VsokRfI֍ ¢iI!m{SSjT,_3U^x􎝧 ϯD9uQۦ?לOw_|<wD ν.ũW{yX$9UKWeɚ6Ͼy͞Z#s3.hը.NFHaݚ%%e;4WĩR[7{N*>x,uӺgaS}4kxNW'55Ҳȱc0t+}]uW~#Q ,))-ly0I%ΩZb.[Oִ_xk~YCg}Qm٪9Ow=GRyZϩI%[7>3ɷ d%MMINJԪQ 6mۛUbꗜy_£w<]X8}~  S#Q-lS։'{[Ee2ҒB^]ۜmӍ}kΈOE;nz/>F@jR,3#z7vתR [7>3ɷb D""H$B@^;v=FÇ$m~ ؉3Io>;t{Nл>N  !bp7YiX4w *foڶ?a%VԦ Z5*L|5thz42G2SGߺ ! yHvJe޿ظ@ʱg|v iw_}(A!!B$Ţo8P)7|Ӷ)Ih8T,ߴm $'K~ةMSjT˃A/?⛋ktTQQidH+d&&uoS&BK:6;sIfgvJe޿CH>s(+ܾ陜%+Ň^xxvmֹpŜrde! =v-hְvSENmJJNJ$g#! 5%)FUJK~%{tnq/sw{hWP)7 DR, iqϻ'7>tTF8@qi<Dc0-9)D".Em7,^W훝ܶq!@aQId٪r&ey5SBVFyU+W'HZZR9]SÐ0OqCCjx6nw4-ԔD,U!+-q ѹũ;FTyUգ]Ar/3-%9'ch8_#ƼZoT/(.xb@a<8q!9990 A;h4Bʞqo#8[\FezڴmU] 8{׍=WɈ@X9BYfzJ9$'Gʷ9\Zna 3ݺ/r+Sy_8˕Ubp==k^!@ PJv IxJrR" ۝_t4 0M*Br+:v" !⒠O7*pЦmSf?7UhTٻnqbNF4r4'NGթB03߭!Bz|q<Ū\Y%) s_ @" !]&"E#aZZrBfzbH٥,%wԭS( VέPRɑD{'ר[T.B03߭!Bz|q<Ū\Y%) s_  Ud! @K۝Ί$'%Ba NG ۝_t4 0M*Br+:v" !&sce'VHEóE%Azjr"';+!B8[\FezڴmU] 8{׍=WɈ@<q!';+@1(+Oa@"L2SΖEJJ"ťAJrZX߬/_we BF<) r*dē䩳[rxm бgMMNJ O8TZbliY,R\Z$euWv8^^ /r*dē BF<) N:.v0 ;y&q䤤ĉ3Ie K!/N)exϼi.4;;vNe D~_53OFOFqqI7ת^O~TXTp֔![0H U+UrUKoY6N쐭,8y0Va"EE A8ߞӅE@ 5-)m{~~̲)coٱUh4&N:*xϩRҹmc'NEKJ"0nkf<`ۮlpJ"i))C&aVܗƅmz![׫Y%j%8bXfKF:K 0qx= @jZRb)YKWu:?T.O$TH/ܶQѓ#ƫ;LOMר\FO%k.>?7t; .5k{yΒjD⒒!BKJ"B".jUڡ٩s*MG9n)O$O{UN !~ wӉD}G΍Ww< L${[69@"ʃSEr!+g!+g!e J NESҲȢoȹ'F~c[쏖UEask)++ NŲ3˅Ԩ'7pO ޲ɹEBSR֮R?W[+o߮_uK߳]3EX4$ԯW,!"~b @MߞZvMN'z YiwRɋ595{wջvhvꜼeQ{-zBN)Ƣ0=%%!u@:5?6lsZU@ 3EX4 @HNՒ^}@JA !0DFzjܾcoם=Yu8]ժdr>'W˫[a!ajJJ"$ $Bh$ o؞GZ}HKINU*U?;#|sɃX4 0׿VlRNm9ztWգ݉t!@Fzjܾcoם=Yu8]ժdr>'W˫[a!ajJJ"$ $Bh$ o؞GZ}HKINU*U?;#|sɃX4 ߭{SǪ_yOGxy^=ڝH@rr,H8 0^ρ+.nuy [WIԩQajUsJ+H>xdfe7??*%Ţ<rDТYY!!,J/3-99PjnYe!@$÷s{r.oz-=ZŒ䔤DjUsJ+H>xdfewȎ=SoypZCH"$BhޤNѰN~ړ_X$1qMV) PjnYe! C}ϑxyyPjҐ #=<3=|]t8LFzZyfzJڍR/pޙ Z7:WIMWvGw;ZS;/ޫG!!,J/3-99}ϑxyyPjҐzܲUsBHੇo5^}&p5]ܳ!g[z^%)Iժ:V|X˪U)=t ѓ+uc#;Li "p]i-ZQK/8qcN8|CZJrⵧoF#a?ٖWbIrJR"@fg!!! CBmy* <<ڃC_q23R8[l GӒI(խMQխQ2QխQ2Qw\u(DVFj~ ϖD*d& }D߫/<(qޓڟ'Q%߼"I0=59ЍG }23RpN^ [7,XßnhNO_ئ 3=%qC?Шn< NE*d& s3ߛւSEhBYGVT8]Hɫ\vaK~3{͗ME=33"HpyW_ܦ4df&˟+쬴&^qW}3ɱpWx{.jLs~ބO)%'bQ ƃ2hTFO Z"2SAXϕ^pvVZrnf{Zp( SC(hъ߲+ 9y.lݰ`fңU.uÂ%?=K&Ţϙ}h$LOM:ntVTX!xHM}hEՉo =-%\>Z@fFj Yi Ԥ0URX,"BZ Yi Ԥ0URX,"BZ BZ23R_uΑ/6ʎ'*fg&B쬴dWHKgT(;q" w|Wvhԋv ԪVVBO ْV.a(#% HFB!u*>5F*UȌɫTԨv:T!3Сe3  2R_pώh$C)/MgGR4 @$ti [7,֮VZvR֭]Z4/6? pa놅pa놅 /l~"AOb @ ӂ18]f׎1b! @gJ"ɉ HFjr"PTR$'h$plq$3=51 J=bvf9nkFzZjy`}0^_,k{ǾYg$v=|W:k̴sc̹_Ţ \U)oWbf~}'iW]ZJawuW(/ A':v2esA0;zе2Raz=]i) X߮:txީw/59Wwks:tɤM=0 ^)IE92,ECtyW]DJe]i9YujU)':v2esAymΉgbWtiU e4:ebnVClӢ~Ws7\rc$#k!FlHMIN1|ZGqg˦,>yp5]sSCXԯm|:SkS~w^Պe(\e=78E|ͯw=46aV{X{KS/*f>:6-@,'NIzj|UϩQh÷m?FR(*. M0) ]=:,HOIe>^|q'Cn[wl~20sa~Y<غщG;+3-{I~687pMoעH4_,=_)sJgg gֻKI(` b;գs˂˽W5>zuH$0jе;$XÚܱSޫICJ B&YwͿ;*\ܡٱٓdg^>i-`#>Z4<wOxzZ5=#Ubv˂ag7LEzW- 2SK}kw5{zX,w4mP윏U{u>xqĿ'NƎ ' c Ą5U,!"P!?Zm֔!9~:h_3eN;n +xjx&zt]R, _W_͚2#O^M /h %]p^B37>;M9;e՞{ca^o4 ,rSq#6l֣bQuϩVlk'{;ϙ/nud͗R1;lpQ&'QBVTvMN$E<4Տ}bĭ[kU*ě W]dM}oL ) op4ߝ/Y!hڠ9/ |uk#vHm\V1@s,Ěɞs([pT̎ VW|;xDLK傦޵z/7Qb]}ѩEA Ēvgs{zžSޭzl{N?; Kf$N*2AR,z_wh, `I&޹ɗ^\sc3~҈(T+Y65W=L{sQ:2KV8FՒ.juԙ3IBb<֭49}8oڝ@ԩYt֔6]?H${thܗFR)l+[;nv8 <7|5go٠SID"عHJ֍N}i*Jx eM:[!3-9ٙɣnکMg#mίzYcaONvF#}?r Fe%eAy<@$ Rh4ҋZ\ԾT]ӂ*OM3ozivgp( Nm\F)oLKKIESI H-N&|R1;<֭49}8oڝ(-((@qIYPEô0o~o45U.j״Jťex{kU*]J8?*]Ԯ (,,&HNﳷ['<;wӭc(0 UZk/>?xӎ +//FU)M$HFzJ(HEeW(Gztnqg4y5xqW!55gǓ~= Z;7,(ĢaZJrF]zQ˂7[?7|*kZPbiԔn*Ň@ jT-]ʏ=A}skW; k/pl}O.4[̣Co h٬H4h4LKM.6nۗ B5<:]Ԩ\ F҅K8vP)'4+#RR2wJQbIm_&d}N_KVUOE칫]gys ys A~!]ok%ŢQnU3Eť9,^5^ph7mݗ^%yw@ qQ-t_*?έ],@P)BIm_&d}N_KVUOE칫]g"Au^z:M:H$D#Qaǿ`۶vl/mzyW>zI|E((-]7= ++49^p&VbvZt xݞۑ1.\K@@(%¯?4<{&8.Aa(_MYS!c޼LaQTHKMNlu0e#6U:ym[.lt$BH4DPZV"a5 N>:'ϜŃԔV|Uƃ,ucϋc'D}kWu:vn^As@!,&hxn>jۼw/& IsΆ?*~o[Z"@k,LMFbHXn͢gϿ3gce =(..~Un#W=%(Pz2?t:'ϜŃXrXZN)eWȈQb:4m€-{ @ZzJ"f墷|[:շßxQMܳ! h\f1@n}ѡMgggCƢ/k6kjooDFzJ"¢h4K$B PܼhW שUBy ߬;[ }S}W{+ Pz2?tԩYk/> Ahߪ9/ulq{ЪX;&9#G$թU:kbp7&BQbYjN*ůz,QV|uw\E^'l X$|ѻ7EbвٹgCƧ_c 9VTV{H^2QbYj GM~={>jV`W \ܡ)H$0㉠N*EvodUS= 7=лz|O>'"oZrvjTXVZ2hX7?6ԫSw&}hZzJ"9)|w73E09)@z5}8O%>7ԫS ൧TXX/:GAFzj"מSaaQ22pWnpjJ,zu΄O:MKOI$'уШ^͢='F+TH/\ک7?ֺwn^N-O׵#uzk[_^2SAWzWLԩѴDrR,==st ;;#Pbw73Ei {G^}xyBqqI$3#-PZ>^n!Wt~uZHK@,oVYֲɹ)IaJrR9@$1K˓xp$KK\֥x<8[RɌ%O7;;0߄#A@zuhZ,;,KHKMJJK HNPRZADrR,D\In0å>>rC$;Jzux.;xv=2񊼛z]t<$%4sݖ [7>E*mopis`g?Tis~MSK:|TR&uAԬ^k}q'm'a?7f5mprX ZJ ^ K.<\ܫ;K:|TR&uAa„??kwd&KIhaύYMs6;;.𼂷|WsɊr?t,SI-9aύYMs6;;v=2񊼛z]t=wl ** R(mmB#ǟo.ȕ#[ʸլZ&ởyޝ݄~3oyql^ʖ36&Wf7S/zҸUP,qMŦ&l}0m(Dv=&:[-\WSeϕ#[=YLsنii:O;nhc3oZ^QS~͗ ;}1j'_~^d0׽];`_ B̷vq*>\־-k3=[yW3{VnUxaaC9>g8Iɩ, 3Bgw_#sBFOٷ,϶sciE._upؾpVm\(SP2dff?s}dS ԺA ogΆ eJk+‚G^)4^+r>\UE'G2S#YT! fy݅f>sރ&u>,?;9J?O 򋝚slڕoFw>ZS9B`:kٸ@ 赗]->q?"< ΢ P0sȋ.4_~ HIM [];#>w馵l{8Y+6]vMn)Y( !19e?J 5uI' ?% zl2E}c 7Xc$= !taBxo?t*gѨN%ʈ+Ϝ#S@S>+dhum˗*dcw5zx KrNJ=? ==rKVP`DgDGEdxV(ҷ{+ɋ*k^z6o,5ۊ6_~\i{8OL.hc ƥDEFd[0,kSzJ2E̹+QY""ҋΜ%""h<Бbk]ZSDd*闿r]؜śKj\Z^˓+6 33KD/=k#&e٦ݫD٣˗*/th| z{d.߸z|}Z`\}:7Ңa@DzdSv`)g,-ʳW馵5x‘M?=vrP0dzO]Pxw?>|̡^h*lXшPfRx-B"Iêsm)6g׸jMN6YnDx(333CdDxƎ}&¿3gUs?n٨}@ =.^|{iys%JA Vn+7}]FRVT))ag/^PH@bj~+e[YD5nڭ) .]|I 9%YⓒCo r!&&:c@7]s0tN '->dTtt*.(_pR ?,(#%& ~rINڱpܩsW K @LtdF Tr'*狵?[aW~3bkQb҂ًעD3ȗ'! @zzZBQ0-ո۠V r>HԿGK%LΗ;{jTDDF<AJy~@|Bb &:2#*^8_ʸ].5[+]XzB@ffovNrj(HfW^h}i-ZLtd@BBb0ʌ͚77xޫc>l"4u7O4o zbجwرߴ<ʟ;5:22#W)%@RrJ ==-aąȈPXjo^{{A{mPbdff8~r֪?HNI оu<_ș-ո AȌ@ x|)wԤng(;wٖbUߺ%!19tv-jir̖ёrdMy(1 Si eFEFd´lT~U~ ns(oZ7 1)%^Ry-qom}(wڕA AȌ@ x|)wԤng(;wٖbU@P"CKNȗ3u_&,@y @zzFʕ*O_UL<T)_, qrXrfM۶ϼiCaN_`ʨgԹQKN AZzF  d)Y()22KƇ7~~~xج ˜SG8l^. B"II)7t:׸VP(U@RfffTI(?w*R޸~'W,lɂrdK߶`SgfrvgffpfT:@(,LE233tkz %fMתxoٺ4S~yOhUoE__@P\B_?$'SB % 'AjjZa|r({t(?w*R޸~'W,@PrdN5~8]i! St$ 7^BY233LtmbbB`fxx(RSCٳE@S pƝ';YbD(^(Oҵ; ,ɋׯYnJ%Baa*.[׫W(q666k:g=8urT2EBPWlUmI5mӚ7}+f2zN`0@X&|`REK{yy˗.D2jb϶s}E  f~SrMq3bE`@϶/U+K|e'/P0s @\liY"BC'.1GMR'+Y8s*CZz '@0ȼy~g^ܹE=Ȉ̧V}rܺ N#n/?wj@@|S ˝ Ѿy>ORDZ;ILL^r#bٶ j\CLWݎ'CaaZO._p(pbL8f`)P0_Ԃr@qW|_tpg GfWֺLӚw j\C@ h.FL|^rCoժR:_%---X0.g ̗;`ܩ@ДѽώL3AJ% ATyqee @btґâ#3"Ct`#O'$#""2#Ctb#3.{wȌ'ʳWhs5==-Aͪe/|QBRXTtdFDx( ʳWhs5==-˙yĿRRLȈy >,2KDFTdD&DGfl\<({bRjW/wo_}bRjW/wo_}:4 ZMn@LLt|TbR+.3KC1Pt]_M?ćeߺ/ofMhWm+rUJ'L9OL23Dg@҅.{ȽaY"2"#2oݗcbc'Dg@L+%5-!@ (66k:@֘ $"  5 *2"LP&͚36k:A{9;w+Wl{9;w+Wl11))i++:Cabb3bcK7 ""Bz=߬3x0FGf@جpҍ,?y"y1@q)GPҋK5+>|q9SLjK$ATX"B8%%E2SYC $$&YeÏ fU;˹@RrJ`Ӷt}`( @ff־OHII t4ʴ1})Q$mL[PTE^9g`( dff9yIn]DxBofYeoH~  VLج6{jM:ȵ[ڮ-̰lM͚MU~?ںPΧֺWo yax  H~  VLجgbKƾt6 s,Wl)ؗn{(=JH ~L'*?nrfM?w*uֽ:O8%%, f‘'P%B\ش{ض`>5DLtd$%^~qVXE 珋MձMض`?P2--#Pw |1{Lt嫷"[ߧ˞+G;{jmx %2u(wDg$$&ߜGᣦ.)/ 8vbԴO*yֽ`0ٯ{e|7oMnytc٦bW ΢ :>uY'] c%8\rȞ%" K 3!*"W 9]Gtpǣ|Vnɪ Љ ʗ/U$~Ƕ:kΗpוz{D {@ /\qm=RtnvE 3DeH/Z0`@_l"} 7޼'_qV*7WrͮhX~ `嶂I)ak>}O1}ץjT)W\iJJzv $*闿r]؜śKj\Z^˓+6 "#3v;79ΟqF5AoqVoޓ߸O+̛+OfWZ4~?XqwܦϙdDP[V^޼@(, `&˓K7 ֮՛wG|;KbA=\Θ<άȈv-j eԥAoΫxHȗ'! Ȉ'z`K) .]|I 9%%D2ʗ,eo'?Ƞbb )7ڸNp\+9e >!1//e.ԭ|e.Ryj!^-&*-I TtPF OH DGfA K7˥&u+?sEٹ˶k^@pֽ, ɡ+DkQNU|;g4ȕ#kGaHOO @XX(3*2"3e^PvCyԪxAG|}㫍Ty5Ǒ3[6q1ё@PR rI\Qv-Ś׫v?ɪeլVdrŒ=S @zZzrb0)‚yr>ʒ%"#2DDC0(399%PzZzD (W`򀞭/.r[%k SG>-&-w)QYdDEʕ*,2KDFTdD&vl]Zllt{'&bb3YԴ@LtdF K!͚Y""2DD@TdD&PجQDdD2 gltёʫcTئޭ\9CDx( glt8wF<{ݼq@ ,Y""2 Pp\=(1+GtGMt"66k:n͊U,!@ B!@ B!@ B!@ pJ̼@&LBg+k~&-s@ ̼ 4V;_5W;3rde^{|nX{|5i@AM*EǓOȑ{M`դe9rD5)"M*E}<Čiߤ[_MZ@ #GtPJ"B&">~bF̴k~oҭvֿ k~&-sw ȑ#:IHP@JvOv?1#GfZ57V;_!5W;ԤRP@D(IH'#3-st/Hr L@ Gf9x B#(@}@zٞ~τ B k~yE x5> 33~ ӵn;!/@ !3mU2Ӄ!@&@dL2B!@&@2L]hpX=U) U9E\1M? y}hWSWD:`U2kwJM*KG*/sٻ/BA!Ȕ ‚z?[7=SLibEgfdȔqj@ 33Brd_1#{֨䔴NdLV d4|AIk@&dʔI 3S @VM#/FX~@gj9y)\';4ڻ_ɑ5sʰgRҼWyrd͜2ٴԴtZoaijU)r e&&KIK7НI[}{jQ:}9ڻk‡|*S'3R_'l{CSԮZ"cvie4݇ ?pą߇J@\Woֳ]`0O|sΆкž_)=/w, ,< o<8MgyM*_l% *+3##S$333#_. ͑Ifu?֨fyrdg¯&2Afv\0>4p^{.7GC_TƆܸT`~?dOͪ.7s;BG0@4p^I&x( #? ~xػ5S.PSr`:3v??|>1 Ǚ @)O4*oiiiؼ, DEdf"3 D6OUP$l npg32dB Ƽ:ua/w֯kso>rghjW+'Š̓YHLܸ0&ʕȟ. , yu}^X?_Fi Ȓ%C?('QBr`?.^(/g&@& G([?8*KWZ (_@'CLYBR33ґYH\12efDL2e{-!t @,DL̄2!95- άZp{{n݋׷KPX0S>}]=?\wGtH S2 aO/@XX0 P\YCPXD& 3S&@f&-&23< dfw'*ͼ|adddfgdgffDzFf ̌o/g\hDg"#S&d"3Sff)33L$3Sf |i?o,aaAMW>-3S&d e. ~Lj {Vsdf)N{=8mTNghڂ"2efff=fq@$$>ֳ}KÄ6e(1eW{"DȞ5*?W_l%t\0w$(H  3#Pff!ݟJmrY"BQXF|92rP. S׭%<35-= @fF&XLC?S~|G@ .]WYʕ̟ï'bF2C;-3!G4Y6}ρ3a2e7^mx;+#g-Ѽnd"3dR86z,e)+٫̈Ld"3KDX&2#Dd֨X,N}hhHRʚYJτ=۬zjXX0`K-yﳵ?[/<,,hsFg@d5*Ka:E׮Z2}ϟy:ui~>:ϕ`2AOIuaNGDx$d@2Pp\橭S2ѱU6Me 4^tFfL4S!DgO.~d iiFG+Hxi6{" Ӊݓ ĕg.^FD4|Lz&3ǏS2EGN잜XxDH0,(%ܲ/'' !QY"[5.db2!) *"RRRɔ !Cd"@LTņ_g.ޚz=['5_2@&1QYLFE@lH dfrV߄٣233e4]>5wb3kT, BaA(Z0wfтBL@d!O3@("Y{!RX, Vq l[U)߾o<)s_L]0e=u#_ OAe3sP  GtO5C/ە(^0 x'aY1x?h^M&.u=Q ɿ lWux1 ((8pІ=f8pZ~أy7#xs"EGboI}j|sPA c 쇸߂@ʤ񾅄7-,$ !QfHuÑfuz/ԢXɒ =, ç} sݐn#ҡ«i|xw^cVX=3@ ;ῇ)OΏ;^طU F>x~8A#go98na0gsW2gH"ӼϼX ܦ? \H8G ߺv-ji9LZO2o`eΐ#Dyy=M@pu"o[]sb 6ze@69QBo˒3)ݧO_ @Dq95^ LA- M~%]/X|3ux7 +Z=_>|;K' /,@ Li| '{ƔEH?ַ}Ǯ/_4GSp9ܿ1mo| *;АЀVڡV!!9ܿ1mo| *;АЀVڡV֢k  iĉ-7@qbF 2Óp!@ , _~J5#Jo c|_H䦽H*= |-((\Py/r,r>xZN }ċ=1~ł/_7ӧpA%RӗA~+Z@8z^kW,.[_y3} $Q">}@  ʒ*_@ #p~H,>`oaa }+ls6xS_ziȒ؁ AAAAB…̕ӐcLZ3JT&I@@b|%hOď}}Q޽D AA[#߿G #@ e1>~nj'I>k("ࠠOႃ!$/i?-z> xW% zzۉH>4$`́(s"qO^ aBB}&}D̛̝ۢA.l>$t~-Ѿ А@~)1~ ao߿;39~/v԰S~^H^-J .X|%(uD_Ǐ͇!o{t "?yC4I&f\?})B /A%8~o> 8{߳-, \ppikҧI51S! (8.8\ JaAAz vQH#wAo_M]+O|I$7 8㗠Էγ%rqHF%Rİ6u1rYI vDK(7ko\DPXw<}]PpPP (9bİ_3vc{x{t[fKIPp_w-|(CP[.@PPp 8\4)~WAAAT/߻v^H[(E  ((8.X~|] vj+A;&.Ek&} 1C?~ .)|(K}_ҥHw2:+:ReFY0wL~5R@Q[w"E  sÒ!E`\?}.bpq棐lR#wa-Cz{PAAA7) Ph|{_E1¿exhY_}1B ((H&^0*Bќ~˗"@!%RD1޽[@PBCAAAGycP&#z!xΰFOD !44ႅF" 4\HP,/| ѢF W|˔6B H0w)Z GB@ C7’@p$1^@ ~)B WpB@@ a!|H $$xSP!#۶l4e lZ :bQmFY˦5~ f$^(#7;Ѧo=h*&\H8>} Zp @ ,y )*W4ӧ/Au;LJ|ΣK}պn 2uMLj# ;@^}OfN081~!\%d͜oaoAqbF  spX H >+> ܼ,tݱ*:p޳+vǪX<@X@ pa@ pH&=Z0yYO/vX18svѣ|O$7 ;OEܱ\ܸ$SݧgNcE&;"-U% v'x}բ?y([nD.7y14$S$_ҍ [݇C0zHa@$[^߾,NIMh{;VaS$_ҍ [݇C٫gXBqIY RQ@b['dNc߶';77:-C>0;5=#Q¸IKy+wÏ1ľ pG-MxI~߶)~KP|!\>3^aH`_ 4qU=G/FnWH#m}*Z!~!\*>] ~hN?])|qIhN{PSnĈ!W>ji&OKM+y"o)?OS?ϙ9 נG&sp M[^)>|ݤb['dNc߶';@KDL/ש2d~]еiGA]ğ9|5߸ z*0cڤ/ĕks{^ڴzmxڲ$'ӳY٧"Dv\O_{+ￇ}עądz[GW}ǭ Ra&%A!Bض(($kZŞ%n6F;A ,, ToFL[iI6r3\`6_tWl9eIBCy2_  "4-e?o[A!(0wŞ9"x}1Z9@@hH@z>;%.`]_^y.Q_uq?ot?|=K/ߍ@$_׮V}g'i[Ç-^w Dȓ-GO_|9iϣDؾʣ=,(AA*H8C݃1|ub@!<|UȇV/G..e/qbF>rƺ7= M -Dս>|Gބy1c~-(8\@Pi}!\ ]$_ Yid ċ{ŋ5Kp˙,[SW#ç ("$O[צeʓ]뾳 6~}ٛ7o?wlӯ߿ BBD%V?^wڌK6yᶸ% g7v (/R~)|دR~-JX~N1gfL×W3А@!D @HHH j߃H&ࠠ@@Q|"$A̯+6ޮ$iR$D wgO6\pP"E|.Gg/ކ'ƷBÂ!BHX Ax]=j˝Ǐ^ /No#!BBA@@¸1$ѳ7,[y@ ǎ-GT )? $?| @ԈZVxn$web+&((@A ,ra5ڍMpAAA |%?81}[H߿? z?| R^_|4,bp!aa@o>7Q"|-(@X   _~됏)8oAa|{X@ L ,8o^/Ʒ8~osVpaa@@X@ ,@H .Ոi?ssr .-Loo­y"-ӻ} "E. |%u9IZ_ƈ9~IIa@X !((pa@>|Cxa1E34۷AaI]JߟW,Ux1CX @ @ L ,80"FeNk_ ~fo_LƊ"jz; LXXqc~[@3%={34S$_ @ ,a@ ,% >~l|6g՞ BO_} K"ї7o?8ae—o߇[\z?҉"IIȔ}";n_~%BX ,^/fZjoa!{NE)bX?}x]ێFoWQ"@_1|h߃F_BBBY{X@Hpp rao~ sKō+|%8uǏ//w} =,ŋ7n܏S$se×o߂MO>}Ԡm|TH7?N } zM#*pA ҧJ)f(azHG-Q6$s? x{vJ>  \HR' _Y'=z0[P.WQ"9:' iS&R&hLɓ ~N?ַ7x{YҾ (@P r H@PP @P@Ay~Mnq UJOc=}&@ =JL?$ܩiGA‡M9>@ ?.563=AhH@A@ `13M1o|<}Ɏx%:Ja!|yIӬ!MoRn>ӓM]= !Rxqȼ Y⸟ T.y XXАp"~}йa@@Hpa#F@ѿV䫧t7V f{u(B)B[[x5 ]Ɗ Ŏ5|а]&'_=õۈEIXI>ǷދXH3ʷ2M2zQo$ @#@("5+߸則O[5(0n )>@ @P (8Hw5ۏ (RWNP 1U/& T/+@P67o?G!,$$DFޣU<SP(Cx?gLi^W>}$ M S4 *}K]ҥ9cO; Th2<շ AA:4*iB(f~#OW}%rİ ]yS4 lb/Nfu7!!!8sV|NH,}%r@81oڷo߄i\e (Q"dHOAD1Y6Mm|Y.)8Ja!!!H"q By3ߑ+߾ 9bXPP.M< D_`A@@`QB#޾@@ \h(o ~}H H@P QF1RH@s­MI1|h]~#(,F߁p5B%BpbĈ)$@ w_|%X (">w[1D& R{+F(@ب?#Z@$ '[B…-S#Z w>G.  :GĊ꩝ ӗ M}}nnΒ%Bai_y0[[?uǶ6o՞؏ ذgoF14,c>ѳ7#E1_t6B%5c]b~9͐p-{HVTgQD k?pvuӺ\{ЪbV7ːp-{HVTgM?~rҭH-@5,h˞ӱz;ׯi  úԸ'vo0{wɓF>}~Ϟϟ3$jZ0@k5QaF@@P  yU/S| _~W WWu+~{X@Hpp0@~ٲ❠O_'^>~.,l&oC @Ti9<_{X|H7f-ّ A_<CweLaIN]5N̨_{p7[nyإ?HֽbgL}jE &񍻏#3dzVuK>FpS1|@ͻOE4iEa<S+ ӗmFެ_ҧ8tʚ EZ@?O>r6>}ФIO|o㞓1^zRa1^zR]I>~!88XܯX!a p_zawDlf!j>}ZUǤ`?}ڼV'aamhPT*4$$Gb޸$b3SYzL)?b懯߾ʼnkf9 {]ɫq,N> TvDqǏ_*4$\U'˛( ,(~/% _dK1O/-j{=jlH8S;!!ny~ܜ ty' `-2MwJwčMPP MOȐ:f'CHӒŏkڔ?V7K8wnq7$׷͐` @o}*Fa ~!NjYppx]!V&R (Gm|!bhҍ,ؒbDN&ڽZUiHH0C2GH˝"\(R>LCύMJ!MsFa牘-H5ot_}zaD bпѵC%osjJ  2x⊤2y_l?3F߿~Q"E+[݋wdc$w:Q؟ d}  1BhXha@ႃk#j_~("-ۋE;ni K1uOͻOI(A~!WBo>{]țs=+o/>mM @ }Uh'K?s<ϐOI~X~L{XU{7QA;j34ś̒!Ň\෬%K?sZ=I+X0͕`ޅʤ4!].2Y/;=kh#gK2t~忟č; t3'=4'%?BhXAsR,\7N>xscD!Ar<kD+ 4xNBe~$KKxCeyC碭|(!ͮ>}&9)dH!ׯ?@)?D={4Ç ޭ*ʓލp[5rİ&Պ<>qZ O,'Аp6uJ<+%=s|d{0oo^8^ڐ2M@o\9UU W9d!|`dڷZ, A`ܬ I Cڤ ̅S%K^ 2}C&!@  Ѣ|4]%@P@ .йI1G޽y{W!?$ӗoA_} p!B/oII6<'_oeKp^ WE\=ʷoE޵4?ܟO;0Aa &@Ӽ˙9͵L?&͇py!4|Aa2I!bR&7ffOr֓IXúּspș-T/'/G_| hZT}+ڷ#|O/@T~|u |ᾇݾ$|_Ӿ[4ͥb} ww[pBH@XѿD> J $\@(~JÇ abD {uӺ^=wȚ1pA zԈ?}}Z7녘#S Gӧ (881E{czf  @߃ kTCCC.ݸЩ+QdUht//^%IhQnDq@߃%u٦q: U n_F‡ 5[F!ahkj EX"[9/߆,^?Β㇆ S^i|-?y]1O_$-7qb|7n'ߌPT@@ѿ1۽G˚)pA i}kp3ڷ;=~H`,rau:K݇@ ,,J{{Y~J}&K+@ aE-,H0޼@ ߂ Ĉkh ¾$ &,H @@X@ 8=@QPpaa   aA@ phGAA @ >}$~ tASW'֬ܭӿ 7 cP 8 @  $1Re|9gxߋҭyaAxҾa.܌<`7ݲο $7~84!mҏo܋{aA^y{>5ҷ GJw޽$Ran? _tqbF:Cy.8\@@@X_Ɗ[ @ /| ė[_m{1qX_/   )wAAAJľ?p3j?s> @ A^ ϟ'IPP ,KPsRwK};zNL @   gCkIp3qK/t(v:>@0^߾Zahݍڤ?ӧ/ { ąČװ D c~%clIŨY30mᶄcE [w͟3ӛIٴD#}=GwaA'.܈'fo߾$J/S`K.F͚!i %+W1B}c7OO_=q}=(88HT?|1|ik}5Wႂ']&EOѣF +Z0]'%rdH`ݎ#o8V~ɐC8w=J?E1 oA!!)}zC!W%}C藯߂"_jϦ/?$\@I>@ℱ /B5K<+w"~- $48dJwkV7#_v?J0"E݇.FǤ^#ϯWl9f?!|X @d >OûmF2fn{> ?G{AA@@@PP ?t{w?t0~rf|>|HX T(ٱףk4$$!ʥ? Og-ݞ- ׯ?|W"{g g{zHI$`qf-ۙ(4$\`LW‡ H?Dc vĕN\!K'v8߭EmHo~R$ٞv %(Χ@PP(]ↆ {\-,, (.1baƌ5Bа&&tbsqcEw,Ϗ=ix bĈRDO2 R;ד>3zˏ/^)RJq҂-Iw)χ {vh rO@ R z0YȞ9Ms{~c(Q"}  ~J/T/3 4zzsPH2 ѣ[1|`ܞg& ht "E X=9(S$ f{LK@葿#D.~|>\a#/B?]ГJ%=>$o~?f~@葿M!jaP|'J{1|HR%OiӜg^.JHCk߰}R'{ISp1E|<`Έ_y.F2h߰Ջ=#ʓul?{PH‚tnL/Bx1aBp(4$\p ((ȠNoFq-F4/{J!bDm&W} Q#G pbF"E ϟD?#@Q@jwܩ 5c7?L F)BhČ;@Q@Q^ #@B.鋷#9%]a~&@HF!D1 ܯ]?$_׃,?%Bez HFen'k ܺ^[9~N.F(BbDQ>Ĉѣ|T|N"s*Y uӥxW|uۏ={7bFߏsĂ F= mM?BpH0;{C8~W!|-(\pa@ 0~@ D^/ 1E#>WK@hQa@ZI _5}usd8ׯ߃FM_N#_~ .\p1G_\[{| 3D>sV^+BAN{  zmI69xl/<~_ҧT-BA-/܌#zo)~B`aL){CׯףF8wC:վۏ"L!j_;Q[ԅ1S #E شxSW-,(?ܼNǼuINfޭȑ"~-״) 761݈ĊGb:oaAcFҹiN Љ1rMAUZ <}+FO;gDs1bD1|~?@o^~E)N3$$8оA 3`daa*-e?1}[-p :+L/W;Q[ԅ1S #E {^Dh{Z)[?}.@0çLѸz;C¾>ueՋ >=̤-]71T*Y~=  |4uD6H?NG7ŋ0-MbX۝3wp/_ ?lʤw4Q};Tt6}b'OS߳L4}GGcbD`xJ8G# f=[>+U4C'/nWͨQ"ۏ",Z;AȝկRqI/_O#|5w7?7y$MNHbJ3CCR'˗po?>Mҏ߾ݾ8RhQy>oAR%uA;9~䣦NY@'*0nᏜfw&98\Yҽ8@w>݉9b@B9^-U[4hV@WOC[;čK xMA>;Oonw&^n~B%SR< [J{\?=G)' lv1RߣE;F/&{=Zk+R@21]OũoN.^ׯeʠwwC'HkTw<d9{x5߃/_@QmWJ~)8{4o.\ CCB…e͜]hQʗڭGo#?$+@ ӗr%<_ Ċ 2I1$$\Xiޅ @ӾKڋ%p2|hh@Xb}V'ukQzϑ |NHp޿>>4$#F5}Y㘌oO9^čBD> =}$Raa߃n}1wL81{\6uDg]I 88(x|3obt?|.\? $.,k4‡0G.Hw?v(!@߶ծ:4)w;V;7-LY>$a#F 37o??2o!;Wrfzݲפ7>^;[[p"ժc~=ӧQ#G xCp>|@А@Q,?ec2^=x7voШ̝c|(U$7E8~ij1ew]ZT ߾} ʟ3Ӌp Z?.^U+z{ҼMɧ/ڜ,$$8Я]+9}ÂbFu.gC@ d);ѣ|{Ux-哺  0bFɋW QX_Wn>y?!߾߃߳hsbg/^|0A ]2; m?}Ҫn{"|-?n̯/IqK۷93 E/^~7voçR g-,JQݿx^˶&>|J)Q8}p#|5w 1Q#REr?|^㗦S&~ץE1bɃ1eO?} :tR{F̒!۸c|qc~4~ISnX}[|=s 7~Jx;K7&KSlĉK(CА@ݼ(bq;F/݋ظ:׺+Kw ]no& 4YV_Ҿkp~X1}>wxSp|%u_v/e[>y%Vڔ(SAXѾE;<}:F5(sśQ_jզ EX  A{C1}=,ç^.vhߟ>RLG{(/IjӁx-w $\8?L "E 㷟 @ f%)>}n6g$e?|… ` KdH!A a>|.Z(뷰_7M_,Qϗ݋ظcFҷ]+y.=(A_!| #зɅ%˒uN>y_|9 $#joB^;۳>\S~8+7L8kxs?O>r!Rao} {B ?&T1cD B ~JÈi̒goC[~TΐC$>ݼ( ףI~!ԅQ ,[PI>˙ܕ;˕5,^;qтٟ<{&dͶq*4|w˗+TI|xCȩ 7@X $$$۷|̗3+w&ɗ+kXfw?!6[O&ݐ{o߂BB…I㛷 "wB>~ @aaA'^/W7CCehҼ }.>$I˥#[Ҿ &8\0p!N^}؅g?MaĴUsfI2ZaAAҦJ ҥLaVgS $+$+q4S)wS?$$Q/ߏ4ogJ*{ Ftn2E< =,,kQ&|hH>}n*dm CBBҧ#|-ͻO!ѣEcFw Ȟ .fɐ}1\HHHXĈMKΦ!ϟ@a|EH8z'JƊX{\~H#@p@ppPi} J$އJߍ=U)!$$80kK!!rd;~xSHٞ%\~ԹJ%?qQFeg/ބ_3I?s> [voR'*i>} ׶uuROoynQ Jasgڕ$aXrӛ+w&)VgV(V(;FzuH #D#F ː&~c>93-;I6@AA ((Xfn;{Ɓ~4G4 rĈa$}o4}Ç^=gƷ\|]fCBfy‚‡  z۷I}h]ݠ`KƔ zߣFśQ7ѣF5Ro/ތo?X']Q_ yx*+Ql}<~HHpp,O[XXЙK.]'Q{#F ː&~c>93ذx9w٣Cp߾} N/ |M W \Ĺkƍ9raKƔ"D7=bpѢ^wCb=fD<v;Q_c;#_~C0D9 }òTD9 \ߟ+o߿sp(Z~ê<[PÂA =\BAAv.xtuݒ"Eb8=S>m_8ٽOOi~sЭE;떼)bİĹyDpׯ߂F;ff<͇p"G h߰=HC#{ֿ0{?} 1|>}1b?gH~Jç{z]‡E>.%(R({׿poAQ"G \ߟݧOFÇU)zwβI &|@*EY=IĈ/!DN|-(JaAAprg5 6{?} 1|~Jçׯ߅=`7_hއ1bDl&WoAKMԽeOi~h|s9J8oes%=p#VY޾^t>WЧ"Ga0@@( Ja!‰%r@D>QDo߇|- Ja/_D>!|@PP1~H¾4xvĪSϻQ"G X1~1|">|B…5J0+߯-ؔԅQfN|`SSnDɚ9{%r@‡<}*OWCH FgلΧ93f_Oݽ[p/ ?m=z?mۧD6ϞW{5>4$0{ˏ<CCú׿t&mr!F )Bh؈v~ٖ睠hqqd,5A}sϓlsaJ9!Cx_5[~N5H"O+Č2ѧOWNRtNOH 1~ >ۣ]!b04GBB͇&_p1H w^uk b{wd^Gݻ'o'=dpp/>Iu t%̢ݫwFu;>@fP)PJ(@EQBTB !@ 03c۶{םEJ=.tUòdg ܍:gk69G_:Ⱥ^*y~]l(ȝA١EO.cjz䘘}E  @ĭeU; )s:T.]dtC=n $_* ņܲH1ikMnVHu/yn|О:M/R3UNUHxkm9JJfق1 XT)72҉o]h3fC/u#"BҥK6@ ''~v<[NJe)z;KN"@"|(<㼭YY99Y`xfXxx@vVV8g@ffFTX0,3;';", ݻw @޽+dggΞ=; wRRR,X P'11q$$$ԁ=dWnm^zvLAgvWRX)xr#{Z}|/#`m>[xE k'N5Y}M2cB\NW[|z֚QO~\y׊WbF>}/7&.ǯ/;oݍW!nzP@N̰*:gkEnA\:jߣoWmnlurr2\{g~otY~}WHt [ʌ}=Lx@| ˄wN33cEE`y ^PBDDDфI{  =A:f{;O ɟ'd"1S2^qzRE%޸VtD05otıw2eD?'Ofwu:t]dD0T`QRk޺}ެז΋Ӷ4 e/_TTы5.|v7|v Y93GGι GW{]^7"",xu"#2nkx;-р];vTfY`0"#5WTKonCY)Miy U`@xxDZDd{Ό Hdgs#`vNNVDDd{9` df܏3ó 33#*fDDE2!';;%̉L̈` @ ';';`vXxxVffFy-Q411qO^FDDMLL uOUHNN>qqqO,X 5''gEJJJR^BXXX,̜9@޽+@vvv*̞=; P'''gaXXXP(T{wS >>>6..Brr B|||l\\\̤ٳg'fݻdggݻwS[4;;;5""hbbHLL)*j2bzvo^nvZBH( DqnF{i 4|GEt;aKMI?+멍zE9TPO>x44S)Re{-E~;9gG)w3ʽhgOJ]×SG ٨LQˇ5/Y&̜j Wޯ̌ 633eneS_нOߺ ^$' Ǯ*z]̌wGF}7#XLKsxDDdj( K[(o\9;gev)rh( BvvVܻ{HtL99w$u;++3&3<~Llk͛~?-DDdZz|QQѷ""#R.vDTtʽ[BP} 6<<\(ݻB0Mqqq{=6%%%)_|3"""qBB¦ z& vƞ@ &, Fo B RFV(_SW-2 2Vmv@69~D 4Ȅ4 nU(6bذ|S9[X0Ox0sI!gom5y 2⢤FDs3Cg.G4 $ @ ^NyN !Ldf;_J){996Gegr*g@n?Ӂ#ߎSU/ظ ',X qqqO,X $''|*$''X`A*Ԃs_;%x/,~Zj\1`flIpzR%`07ܼT 22Ȩ԰{iw; ;++<++3&@S|j9y8A( ߻[(Oórrr`fLlk s; ϔ*E!&&&NJHH3fPg/X 5!!a۷-X 5!!a-@ ؔ8)!!zA 蕙9hI}ݻw`09 Bлw 3g<ЫW3cƌnЧOy:c@ 7oِ}Ν; [@AgNӧO,@ HJLL k`r(] }d@(DGpzjlNNb{. ! Arb"];toA.˖To?ZvZFDLd@V @ #,37)urI T7  ddsҒ-},I7}q}޽{W"_|Cz5(,,,6Ɗ| ݻ3gWqqqBظ P() P( aaaP99P(,3##o@NNVD0  e@N('⑑Qw '''<,<< L@ ~^ ,X `TfϞ@ Y)..nb\\h HIB!@BM3g<+L m70l$@ ٳ $  3;G0rB"J`sK] s|³Bti]%euWZFVޖ}EYa9P(` rEbw+kԬ`v Q<9""A 7łw>xs.Ⱥ[8}1#ʿ:B3fX'""h( fϘ1cE޽@/ ,HMHHX{A ,HMHHX `033##&"2׽̌`0  ˔)&6`|(LvLlq?:"2׽̘4 =nfɄ:{P{@ R_yaaaBM|"_|c! UBPR HJLLݻw Ph^3fp2!!NbbZ]}6ع酗-;ծ]t Js?CZFfX ׻q;-,?~Vv1'os^ n^lv7C@XF  եFFA%ZR@"Y*6^b9aR .#$HLL @$,X `;;So@lٙQ+:wJNvV[JCT[ ˉz'f@ r "*WjZwnߌ 9PNbb%.H  W[o]+MΎ K $$$" ++kRDDĐƈ<􊏏_`TX`Aj޽'MDj(J۷oO0999cgϞ0rrr>`pHBBB*bvѼ]L^;4Q]j7ˎG-}6n'rB!b\WSd\~ӨNuaڵoʬQH^O e@́>"ß dԝ?+2^VNH(  i;򝼒z̖U}?v-A0yعk-F3B98R5"*Tjnb3BI=} B@ P{P' %ngp7a"@AI3 ,t1> M!2"@YE5k& HLL܃A 11@bbb3f8 11qA0]xv ty3moeD\vKyYE/IUgمVRž9u#m[ڜҽÜڹ,>7:"yJdedWL. 5$h0w&&&6} aƌ+7ōNHHoBPhS\\ĄP̙3W@(71!!A(:1s \Mǯ.ݺֽ * "+*xYf-ƭϕ'"BLx0wrxjv~reWEy+饃a!6WؕȰEeSF}nrvNNEyx p?E;Ǫ WQ}̟??,gOrB;@8ӹWȹyz@`.]d@8@S3<pppSIENDB`lens-4.14/images/overview.png0000644000000000000000000115132112710476104014420 0ustar0000000000000000PNG  IHDR @Ίv@IDATxU8ߦ^IBIB(My(* Ol(C QA@@t[BI5$^7=ew&lww~v3g|Ͻ3swoNƒ @ @ @ @ @ @@hh̎ @ @ @ @ @ @dH @ @ @ @ @ @\@I#o`G @ @ @ @ @@=@ @ @ @ @ @hHy= @ @ @ @ @ @ @ @ @ @ @ @@#@ @ @ @ @ @ @x @ @ @ @ @ @Fv @ @ @ @ @ { @ @ @ @ @ 4{ @ @ @ @ @ @$ @ @ @ @ @ @F. 7#@ @ @ @ @ @@@ @ @bEC"@ @ @EYh^ @HC @ @T`M٦۳1 @ @L8J[ @bK @ @ @ @ @L$ &; @ @ @ @ @ @  ih- @ @ @ @ @ @@` @ @ @ @ @ @bK @ @ @ @ @L$ &; @ @ @ @ @ @  ih- @ @ @ @ @ @@` @ @ @ @ @ @bK @ @ @ @ @L$ &; @ @ @ @ @ @ hhV_ @ @ @_`ccެyVhѲEt-z @ @S@IlW{E @ @ @L`ȡH?GV-Al,~-^xXxi|씏Y)D"@ @ @q m,Is @ @!0>D P8sg΍wq[Yҿřh߱}|^{ݽqiU @#eC"@h.C @ @ @4m )**ɕ?1Ǻz_w~  @ @?ן- @ @ @ @ >_x=8x^W)&͛7cpl+[G_ߍr_nٲiū__y;v?x8~ @ @,` @ @ @ո'e+O Dn:N~_TRǮcȡѲu4lP;%7/8 gL\݋+n˖E @ @@  ?{[&@ @ @ @@ 1$˸JHX~G"s͉w^{'7laѵghݦus>S[bvF&nv}*[ @ @'Т6m @ @ @ P(iđڶo=s9kVOϘ4#vwuUTTT:+ʘ3cNXB @ @l{$  @ @ @ PpN4|sf͢[n9Zik6b+ƏD~bGGudC; /]qES @ @lK$R۶ @ @ @ P7nqOf͛Gp֔Yþ:C1m*k^y+~vEK_i&*3 @ @m+ln @ @ @ @.E(!i]yޕ~,x$Xqj>RIR\Ǟzlԑe#Tؘ  @zyC"@hEKRM{H @ @c}C"@hőF-i۾m3׭ZGQh߱}ټ4HkF֭ʖ{A P8#cd,yH @_EE{H @ @ @["ЬY~QQQ4CB*<c @ @@4( @ @ @ @ @ @6@ͨm @ @ @ @ @ P?HV  @ @ @ @ @ @L@6! @ @ @ @ @ @@ w[%@ @ @ @ @ @l3$یچ @ @ @ @ @ @# ~m @ @ @ @ @ l3j"@ @ @ @ @ @ԏqU @ @ @ @ @ @6@ͨm @ @ @ @ @ P?HV  @ @ @ @ @ @L@6! @ @ @ @ @ @@ w[%@ @ @ @ @ @l3$یچ @ @ @ @ @ @# ~m @ @ @ @ @ Zl- @ @ P0{Q\{<:<$ @4>ۧ3Ϗ }{=t8$~ꕫRȌI3yi~me:!#5&[~o]5 ͜-Kc_wW6{1uyƍ1몶U!  @@ )P  @ @ @@e7WN Ĥԫ3LؾGtޮsU*N"@ @MA(ZjkWLR9m6:8޿~ #)>nUKnio?BhVͳ|6l$ @BhVR' @ @ @1,QOvIrx2\H& @?>#vcw}1a6֜uM33v=mM?fOK/v @m% d[I @ @ @D`ᴅ72fJ\s5Gw+ͳ4Λ4/|lUVlj{D4"IJcWff~ @ @"ЦmͭwޤaGX-Y7s^lذl~J`\j߱}_Dn[~+>96({^fmuT\m @ԇ@بm @ @ @Yi/Nvӯc5xX:git%)߿w#-Z[}Kâ}Jx|{vF$yOwמ @4%;;&g~9hS'LƏ X{e^\2qwOY|evmMeTH')e#_9~_9ǝi̎yg'r6v @@ }jq jD @ @@c}C"@pVĊP/K-[Fm+HϒKkض#bD*yH @(t12Z?iKx7ލU%:FY @- i'@ @ Pocu,*yH'>@ r5ʧry=X KR x/<S^[ѪQS~52WN9~RuW;(IՇzm3U,i^+53Mջ@:_ fP P*@ @ @#P *RLu"U' !@%Y\Y\lVfq\fWpMB @@R0M" @ @ @ @ @ @# d* @ @ @ @ @ P0H )T @ @ @ @ @ ulW @ @ @ @ @ @ F@I4 @ @ @ @ @ @T @ @ @ @ @ @@ )P @ @ @ @ @ @@u\J @ @ @ @ @($*B @ @ @ @ @:-NJ%@ @ @@Xv}~tzuVt-2$um.ܱqdًWImSi3^5ĠG?zphhnIOE.:DCDb5y[xwcڽӢQcuN^c/Ot!d|_}މSֺ-Z>Wd P&♋+,.jVztȮzyB!`bkO_pp ѵP;6Uoy1:ih}]{`Kw_pl2a u}o۹mt)z m;F7Fr1}̈^CzŠ}e2fJ8vDlJu @`UXJ @ @@cXrmj_K#?>2wow&7]lPоk+?uw}1!uҩ랋}wѾ[cS]ϋ~c2RYu-~s;ccE= %>7w6P޹xbe. &^31 P)EUyS5ꌏᑸeY+9s113kvn c@o(_zlټelxWҏ^rn[":^lDvƆ@z_>fl=>..79 6Čq3K Qcɣb7>{$n'$&<2!?>,/XvQ|l+u6[O @u'`T @ @L uRH#}eA ~P\6ko_^ÏY\Q y4xL||bzmmzMuQQQ }@tN1q}>OKoqq3cOYP^\jm$2gœ?۾J"_ƺU m^ @@UF J< @ @xyFl,_2/\^a^M._cԅ5e,Of9sye{뱷_?WUL^k:A_:~mVPU/k M`%ǭuK+vꅫ7{wϿ*$x$7lFS[UMͭCTo-[8[ uM+;ĈFgީ-^%wѡ:[H:1׏'IONW %ǻ[GnK?e+7m:mz~I ];r_op: n_xL}~j|?_.]:~Zmvm{̇gƪ9Yfo['G}eŮ:1AF$I)jh߯}lX!ܣ1Ѫs-;,+>^խw%X+J$mι*ݹ[_Wy%6=wɦ85^xWsX0H\=Z~mv k`^:Sγdt̥= `ܧsclc\t9R)WtMSϷUmn˟\>͛4/bcv+[A;fS{kx4o<-<+dkʯ~uۺQ=>m^tvFzǛuOnکW4o<5 {-막OLVġ_=43)ߊ+kJ;8;l3wHL 5+֔xˋMf7nΫ)O:O;={Үf:^گx[w鼥?_{Y6{o{sދmZF_H>^)ޟ;m 1hAԕOŪVe#ss7>g2)@acųg[Kf-^C{e#,4 nI罞CzF ܼͥF=MYM睮fyu+`n=k+?sev}=*o;]7PuDڮ;oIw:c Sڤ}2ZFϒGmis?g9 PXF )P @ @ H`vi/N F_?vFIvq?Y ;ߘ݁y1óRH[f˶w (+Ћ$:5_q˷oGhxTL=99x7ee{G[dm@l~f߼9?GR֙?wSO$ U`Db ⎽O,ەn#J?Cg.Q'y n| ag~x'SfQ쳖:ԧSnꌜJ\]i$C~wlCUV.Y{Y$@#.>W[5ϮSPr>͹s>GY~"ՃHWru\yu߻5&<:!N[CU7r{:gœ윓V2SOvI̟ ^Czͪm[ڧ_sz?=NU_}/kZs?ί{ٺm'&]S,zWS_ Qy&f?t:'.:;~EV-2tį>~ѷ}eTw\{21SG> ]^sQncOurM#ݲ kӔOjNiTܹ2}HSpfTӱ/{|b)݀g/,lD4b=3K)36Ih )P#HтrFIפ4xwl/ @@ զ T @ @@^"uJw[7ǛyA|o <|1hAFYhEEV 7KLK}w?zn2{NJNK[:Ly~J)$o;WW~U4@Ch۫modzz6f=<+8cxZ/S=Rb//X6eYtڹlYZW3Rտ\M/ĺUN͹RY=wޞ;C<2hABr)uzܔ϶Z)P:ʥ:lh F&+}%t&Nu~_v]Ǎ:4ʔj;1Ϙ$kWfĔ1SҝOiYߔ}#.}gubJ+Y2dnڎ|s,|iĺ)k%d#8O#Qr+f nOlܞ}iԙ<;gaMܲk,w^6HFI+OOG566 RPB:ק) sK[m''&է^񝷫Zպq)vR[ΊB\{UOG vmw;T~u5@C!#=F͊1?=|\USiGUWU@Rc5|^k\.\۹o埯R&v֫Uf،m6vK3o*g=Gs'[ 6щf9Đ &cS'͡t1Y蟼l=Gu_.^웣ތ#9bs'+\1|\i^Uyy]Z3uN7FsҹKc<hγnͺx꧳N#i41S6bbZV/YA]u[iԑ4B ĜܦO;W@IDATÿ멳rKڎw5mgòNᩝ=>3iu# &/[gigC殅g.9=WHS CJkVd~?3ZoZ~QnTIseH2cgQ:"Wxs{>׿cv+|s˧WxE|q?ΌK% @@ TY+ @ @ Y`]/W؅=:HĬeũmm|Z*ã=ZvGV=yH#/u9!MA`锥1vM6q͎kT!*lڲlN;tPN?T{J5' yU6nnc+vB*omjVm_Scu.S]Mq~>3̛;c9ҌgTK.Y3o%w=1ϫשg{vHi4C)5no~1ڡ'_G#<]q'S{eHU.4Q1i1ɉȊi$;U--OA'8s`onU LzrR6Gws=Wvsݵ+[Uy590 Y4mQsu)v 򹎨76ǀ؟ơ_?4z` 6|%&@l-@  @ @_ ["I|6['2ٶS}x'bFǢ鋲aR= t&B[pQfZɯU_\@ y;ņ5*TÀyXl^֥w֭GgG{D>:Tfʒ﹪iO >μjA"w{T߬EXz}Y/jVUMN}vGOWȒηu 7wga|i˯:hծUC#Pa;=wY[Q\ T׿yGg#y7wߋqwx?^ @ ב @ @^M6vWQ!$@fS:|%3G\pqwgp Q4M~nrvWl~[sW--ܜ{mkt\Z`y~vsf3?֬X=_3oV˞St'Ӕjk甧|@ChձU_>SH($~ahhۢ®eb֊74{v떿W4np׮oiɼeͅ,LJ9y:k=nxˋqY7|8u7yKcߞň]5ұkɎ9urKi|zyI[y]@TfJV7?,Ň_]\kqftg;T HA)~:3ͯ<<'9]#/4HwNϥSĝ?3Rّ]3hzHʧt RޓSU_g!_Tsϵf:]r%ٝW/[+F#]'0ѼeH7*GWKkH'{Ф&E!{y5r)'?,`#9-{ޒ]:~K:̛4/|4(}="I ^ I{ظK#w}# g-wH˭bъ4qT~o~1`ߟzCț1_{ ?vx(%i^rC0H B-ZuDZs{>׿e|)_nH)?wݐ{cCyU  @h~^IA @ @$0Q\-uQ_fEğ/y|%'gR3(;53W?;C|}4kߎ:}sEQJ%z~sԓy2㣱jɪH }RI/uxW5J:[f0!]G_7:ڿk =dhN x#ƙ83o̢vNZo˯r6Ugdz,|yaLsjvư8蒃Y{W.z%tosFϋqp` jRǪݰnC6*#x$_Nک3]]}1wܸweͤ[5A{:vUϖk-{_mv#}>SE!W|>F?rjN ->[9/坏ܹk~>rZךiW~%xm %D^cT')?|ϿuWbɬ%ѶK۲enyxoܷƂ u~q_42EzN8t5:f,>o)ޱI{ 70mlg[),z)VP @$oѐZC]  @ @ @ @ @ @[A@V@U$ @ @ @ @ @ @Rk  @ @ @ @ @ @`+ $@ @ @ @ @ @Bj u!@ @ @ @ @ @l$[U @ @ @ @ @ @B@RH. @ @ @ @ @ @ d+* @ @ @ @ @ PHH 5ԅ @ @ @ @ @ lTE @ @ @ @ @ @ I@I! @ @ @ @ @ @H @ @ @ @ @ @@! (ʨ  @ @ I`f?ߙK,~ޛ^\2֭ZVlܸ1ZiYӦcԧSt9{>{ٹOݥot5 iWe]_nVWzXXXX9ge*{^xMlX!֯^VoѼMV[E>m]vѮO0CtٹKtݥk񱀚8N]sޜs&̉EE:az^|MvLm;(? $ QDTPY; b=ҫC@HH@H/7lfvwvwf23o?ߝyݼϼ? Dpx C#B꾰qHx/4PK*ڕ?eeٓs^(ﵧrOAley%Bi#~IrѸmcrJ1|55 <3#d cԅ1Z - wJ$@$@$@$@$@$@$@$@$`0eEe8 ُkNZńALzb84Q 'n H@`@DL-/X{?[_hT(lZՀVҍnm0"g.{֖%b nEΚc%!1!hЦDF!W"WEB!&{Y~Y$gm~:`$LDd$ Hȏwg~Pb?a9iY4- ^wDx08,UU},& 7cS;q,}j~-e(CѷrD蘐F@γgUk8ATA`p [%"Y6XB$">+#eڲ2 ;pq_@Pn̑>kmڏS/ ;.ڳU$ Y${ >` *,Bb6wقwIbuV[=x]YxP={G6;1aLL]FwA+ K.幒IbXm;LN~ yçqh!d@,)$,{gW I!N(Aޮum~ʏ$@$@$@"@ڐ h&.o6aػj/N#:!ttSh5dQ^#'m]=C2O~!i֬tĴYܴs_;^x*?]qtQERF 4^TﮔTWȘ(qnB;QMhвhة,@8v~V'2Na}amU_D}v,!B),b@?uoW\~I~Y1f! W5_!- F] A%UWʕE7FD\z7LQ7nZ__=?7s6K["y9Sf.$a ''k$@$@$@$@$@$@$@$@$FɍK^Y"'VUT]rjph]Cx (/oh=uCoOТ^,#\^޾ `+[=W@[IHPoBWr9؃_GY~\ߺ"y@;YkNRQc,zqv-ۅX+r+Keeru0!pmoreᓇ#Iqs 17eEeX=u5{7c^BL4䑓96-M:7G︾0Hze!.瘏P#Oh?Grf&Y@WYn1 +$@$@$@$@$@$@$@$@$EFd¼aӷ 'Q}s&(Y[d\wm\l^7i_![h?b{>'wĦ7re0UCe)[.Ƀ=*)|d;`ydgx3nAN~',{c OJ˨'G!E3ٸs [D_  `ɩc09X*4=~ziɲLo>,|~!ۆΗvؗ6ً뮟 EfI5nRySU|ڄD|xt;ZmiGмCH4^ Kj_u}/\h֭irl OfbPѯDŽ{ ~h#ȜL ?Z )‘FݺUI +^1vzSk'O\:7G9>Yµ0#OLjλ8ό)HHH P@VeHHHHHHHHH o+o?='?}HEw؍o=,'f`#L\~+7?UON.{phwK;Mfº_@mAaAG Aw6\Uʹney%Vs M~Uwk}䘣Q dnĴ[!l\tEшJ0*ZX !ɬ'ga݌ur[݂FiI8Z_O>?q|ii?Օگ.+n$VE@WY5׸1  H͢l /$Gb6y?!42D-̙3߇B66Hӭ_N7#>CG9xSe{bd"c?ſ{#82XϮ-$:-Cg EbDڦRJ &M0eEeڞJ~,Bѵעkh?]q̟W<[^\9[oAR$k_؁ckq_/Ix~}~3t'#~%FUrϥ=~LM$@$@B 蟖_v @rPeԵ-b)(/ݳ˷땿Q x|`׏0BfݚRE1Am8h?GtjjgcOO1ݐC, #gD;"02)^iԳG~ '  0& Hi֊HHHHHHHHLK@ r"W0yd$7~!""[{;;BL@pgb?_T}ZI|m[7,. mǷEEQ?EH,=3&W]0{QOM}uV,|~\Q'Ci@i^{Lrah2zvbJQb~}v-rEG{xoi?Y}(AU~m.߅гoIHH~~ٛ%        b&H4'Le:.bL>eb!0g>6yyHD6oOh?^ Ɗ[V/C{W'ux*bbcPYi^?*zORںm67m>=9Dn7E/#a4Z'C4A_?}~=퉰h9>l&#zs,342dD_OW|{.__ H}G$@$@$l1 x?1Azɭ/5/\`Bp))H횊rO!}T%zswL_WC$~Az~+n]wGcBz&`Q[Qi ӮX X*_k SoKv8(8tÉ,DBycVyK5㕡 i,X}]%/3bՕ5`: ]ix~WK[+}z AU,_ Hli<'  IiwHHHHHHHHtW@dʧķk+où}~(+>V-EʈYy-j^Oº蚣.+:W,zqn|z/QaѤcw{(-,UAsiMb&_{+O)qw{q\8]}Lmj3ڝα>i,YV҇HHH[( iC$@$@$@$@$@$@$@$@$/AADɆid'|ŪWADl}Aw BjT|lJi3Q\>GSؚ7ul; _lpm_>U;گ.BW7##0<6jk)c x$"|IHHHHHHHHt'ppAdKT-áE@`L_c~MAigeĘ_\8=͈H Uv=^Z+UkjMR/G/ŶGa@i3Qevb5AR7ǣOWuNJWxOevxv_]΅~XȈGکR$   HNϷuՎйp 3~9fk)c x@'2e$@$@$@$@$@$@$@$@$@$ - C[ؽbwϽku=ۀ8Fs&e޶_Ltn"f~@?u(8Pv7Eu]q̟  <3 J$h49W{63qH횊vI5c8vIEMk݅#ͺ63U8>q\~v_]j~5yh?Q5s\KHHHj"OPe$@$@$@$@$@$@$@$@$@ٛ1ɵݐv-&:%LW}n[foA끭uػjy~33R o/o>&F$E e ~',q2fg&6FPxWekSg]ڃ84nӸθZ#{_~H{0 "XU;گ.B~31)n'kV2 'P@ ̓HHHHHHHHH@w6B`p Zj[ށhկZo%{S_$4K-_giؔ몀š›;Ш~+  _}z YU 47w+o'RgU-ę3RD3W'g$9_{0#JvDL̲YfRg>K\~9:8[8'|[WhNL>F'u_ZT$@$@$@zDȍHHHHHHHHH#!I,Bt?<&\{޾0y2|] ~sQRy~EG$!'$&D :iB=Z'3O"!3BG I|~[HsLaFb3Ug7^3)/,GH1Y8f$LFʰ WUT!ky?M2d owZ5U+-ơy  G"jPׁ`VzT켒OYQ)O`1ޑ-}nڼ@D T>si?~מ)H@<(㎝KwD{!9Μ9=+U!Ft4Ul>{Ȑרr|r>7OgR7gvu_ZT$@$@$@zDȍHHHHHHHH & 4V-qDGu:(+,$G ۣ(@|Ķ̽ĶLsHeq%m}uh4h $8g)Kw xDl{iuCl, _- i ?)zgtl=+x2t-FXB&;5D.չBq`sFg 3+ uLJYLY潚{CR$(Zb &|x8tS7xxDu~zkUp?+NsʚՌFD35   gY0 ' B䠄uk'D*cD *[^uSʤBysS{npph S~*\rUu6wlOkm]oڕey@`^xcnhd(3IoYm߾ѩШc_^NZl׿~=:Щqd3g"ڏIxg_[$@$@$@ @'2O      рA;ݲEz%zlnXL{hh(Ab:V𰰰|X;JoXY[XcwE>HC ($ƶd*oL"&}qu/EK:{ČfT)\襮fi7 i={ӓs6ws,"i`?wţ~b1.owʫ ~/C%ޟ(-FGtFH$HnT6U\v,ځjZ/Br><g 'S%oDV[ #ێ8% Wfݚ_=V xOm{ Q E &_`X?O7 '瘙򙈿TFaΙìsdl   OSd/ xA%XRGųNo}lpOB!&pvWAK'QQQ2Oql[J#hK@7{1$ o0a2 'D|J7eZ ~9Ԯ(+,V.._%x0!~VnN#:|\DW }EPbGp6N;NJ9Oh,G)M uT;r 6DEavwAuҼRb:߭>%WIk6_W.7* חgqmإ^j/^z]K H~CF~zǧ;ѰeC|w%?0uX:\Yڳrlz'WPzeWqf]blN#;Rzs|6ceg"ڏ;GG_Z$@$@$@ @'2O     O(3nYYY\)^|k_/J \!,PXZe"uZ˷Mq|HH|Kb[+psM#ٰ(&Ny_p?kYO·rtEo,Ӗ.y>~ZK7wo.v.ى#;#42tꩫ+mAswii?8ixiδk&oo>ў3޿**ϋ>o^Q F!],6>^ʒJNÉm'pۃ eӖ{hWq=ӲUGL4 h1vM%ߡyP7DWࢻ.#_F=Wҵ/,8kWk[PLf}Ꮿh?+~]Fs-`l@`ٛ=WB>[VT&W o|d$ Lx:ïi##ZK\wщrף="Rp5."È֝i'iq|r'ڿ3uWsFN#YR$   HbGXtʊP_=,ĸ8y!N>/-ƔSY<|IZM;75=B&UU5Vg+oo6p|\,^xV{cV2 ' Xcy7     ob!jP9s[Vy4h!44T 'l]!dV(qj:U"xC7   ` *,Bb&&V=i$L}s6nsBB++*z r E=?w-:H|,GڏןkĝOUU^o~1le*;2NctZeWUTIŹRLt/v\1#-ȵ|Έ;els}_ 0F5j_( Wzx.5s͓2Fc2 '3ov qM|4!09~ $BʸQyY;Lgpk1ޡu˺-W7_Otگn[S ,Sv]g/Z--@'˧M|N$@$@$`L\ĘvaHHHH$PYY) k1=-~XD~Ƕᢞn֢!jmWMX#bcckpx\WTWt$@$@$@$P {^\=dC#jQPpL۠{+ثxrZj.W5q~FHc+p|☏ 53,إv(ډS[{+B$@$@$ x2    ?! BPD u^Ƕq셹*c;_J!ܨ(ǟF-lR׈    ]V ${;vKEau왜<}]Fw5Z~)~(k2Ht=vka)fAz<.E+a kppA{ջxlcԻS X:e)n6 kS2מF ,* w~w'~k D#V>a:N?K�ӥ 0ڝα>i,Yck%   HAe ď@JQRRR}]{JdaXtS*8wEBu A0p%Pչp\ GFxw̻h3:eaʰ)i 'YUj0ۙ88YQ G!y`ِZ¬B61d6^1/_/]X"b_Ek}Yb-1{S_#T:~1ί=}Xc´ "".cM.w,>%^S:3D|[v~5~5yl_5s[<#  orHHHH B2qU\!>=SUrpV .PvW [un/<<\λ.lNvM+L)#b\Њ m @R,$F9\/~mz\_UUXzRd.e.C +V⑀^1Iҡ#Nթ]7ȵ|X>n8ܿ~D%Dm^!6v[h?:YT#~o c"*|ϰuk]Hjx~I|r(t']b8ڜh}QyDSצ]W> '  0& Hi֊HH-…RXJ|a6]]"O}mPPPPCJx!k;c/gڦ+}p#    #b=&VWbSe΍4q0x{WhL^<Mb*[i?0W'Q@o)z]_UU1;;"ꅛ6^p\rD6q]<"i?* rUHp![/O 7u.~~#Œ|Mi?᳿|-߂H"A_W OJ5p@]a^Z_8zOxyྲj$n?/$OHH7 Hz  K@(Zȡ(:zhsfՍ`)B +:W"΅uuuF$@$@$@$@$P$t1٘|\tEXF|#;c^.y{G55DO\azMTٌNwuBW!8߰H?1 Zʎ 2O;%ǣUU-+o_pݔpVO7fO ;{cC qWw U@Ʀ |Q^R{f߃i^mW'/9]<1>a4fK*U@"WK$@$@$l= IPB|aoW"{a~sZicso{WHHHHHGEa7DRDŽz@kWC'Og\ehF_LQ ]uvZSzSus7꯫jCAdWCrJdBǻS=K^_0o Deo9\Km lڭ܊;LOWe;[Ç7|Y\Y G R@"g`8q |JLtd_3)uƭhѻErh9i?9JO "¬B)\;ӽ5[QRmlFTJƽ&ח*UΥ;mW `X<o޾QQ麹n(kdTW<[XB)hֽr- l7ݾ`;}[1!>{SO(7'# f$]@"WYu1%  Hɚl C2lw%ް/,,u0븵WVVI[:"22+ԮԹk.68q#     #D1Xz9d.y 4 *T7`gAg#q× $Yµ0#O UWg>>y“/$[DHH7 Hz *!P" !P⍺\4X*a[1[Y+a7$DI<^5 #      E@"_V\SbKQUUw ưÐ,y7YɩK_]|??!I*b "fgV[ _\.)ʩ()[8SunahTvM݅mnCQvMoO8ugV[ _OhڬἿZc&suJ/1k۲oK\5h;jG\ H< P@b:$@$Yb%8}c%PBԡ+Giiȕ9B6XB!F$@$@$@$@$@$9FV?ԯz~|GR. 3 ʉ$'v}F<8 iihwi? ,!Nl{msld3)h~eshp}Wec'{pۃg/w@ :חeGrݧ>7}a-TøRvZ^[~#0` _h?׿Nq/ zIOd@M}߸~JDZn:98~8:_YtؼWsLa*v.݉ ']-BtZ_o>?q|ݴvVbz|Bٳv?OȌQwyܭr}m?2G] H< iP@bS$@$P@IIhڅX)W:꼢fA6gR!Jm]!܈bf-MOq l I Q@PVU~Śkc&-SD-07׫:sK~1,G:}nꃨ({*++k$B!D\姄Tኼ #FX;/+ڈsBPlmFoD㢼"w__N>!kT&򛒞[ydd "ߙ3~m$ vwSU_GƜ ]}TVQFH`f?GxFVWc蚣]?EEa&h=HHjLqHQ0AOĦo69su.ãív,|/&/˾p|h?'z~eDF?C߲K1 \7]NQF5M:5A`"9!ܚY}CLR vW}^~~ڗXpן}nZ?$-fU;r&H) +ᇵޱD "NppݲI$@$@$@$@$@$@f%`F-S%ؔբcIA&&NJ_ Фc AJ 3Yy%&h.=EBZ&-@~c~ʷ%#=RtU_?H U[v W#T䖠`T׾jJo"q8b c7g"""XQUlUonFLT `9YY O>)"R񴸡Q"m,-}4i=% 1g˃_I^Je"ˇ B`˜->*?(E#&~brѝg9{rNTfуD%D!.% #K8#W#_rJL{<⧵5㓀i/=uv{ԓe)L.$zd^$@$@$`^l^۱$7#??_ =+UkHYY]&bҀj4hB+,+F~\DH zw'OWo+ y/`yi9k+wGspe3}ewlG۳r^ n65~;?Li$@$@$@F%@Q-zIwIXJE)㸸8U ]ATTG$@$@$@$@$@$@$@.ϲs= _lp{[xԈB7qΜ9ow+|cRO>78rcs|gQ&w#NJ $2+K(**!Ѳ DJJJVJ6CJѪUl㨸|k]$       ]/F$6“o~}WzH eB|?=#0g~ 7gXk00.+ykꙪo^&^&-ľ3*VHHhkP@b= OJDG2AُV[Q:ɱ_]]Bq#ͺ|g%N;fNL %| `$4KEX& %%?u<:/JBCp{ƨ7WЊФcWb'H:gw8rH*=܌O@#Viѧ+ ( (/B "DǏsA>7!iذ܅Di}qD"XByxxu6<&        zMӘ6~z\&,?<0,k6#a:%P_,& C\8b1!﬐/{2֞U&cxı]J$ͻo\\<|Icj6 !!ؿv?$H“#puTHum0sfv$@$@$@$@$`|FJJJp1V ?!uOKy -qcN  g›l]骪*Hvv6= !ޭĪ!"BBBqP{۶mXD"<&&F%K$@$@$@$@$@$@$@$@$`PbbwW<1g2 >t7X4"I 0!^,EEX2e 1QQze|HO)qK //|o~ .{+9Љ8O'y#X$Y7bn><ۺ y P@b^ۙ楥geeU+]""VQ[dd$VZB"…. #ˇq{X>um޲_YQy\'.Z>\| \-zuu W/- _4om%_%l?mކPP|- ˧u ŰIrjztꩫWŠN_5äE|o굿F\._دd!RH~5j#ֻ.Zw*Pf,.HHHH;6 )#GHq8?yduYRѤI{HNN>o*!x@$@$@$@$@$@$@$@~E aap3'oIϠ(-IIZG@[1ƜFXƸ??x{M݄!i>K~<,g<:ǝ7)2ob;05V!png 9'w#4]y^f>6W?W+t=)RP=/"=]د* mڠS6Ubꝝ숎.#-ˬ6LIHHH( 6qWVV&E!؅@$33SXRUU%[!M6EJJ j! 8WBB~sp$@$@$@$@$@$@$@$@$@:XR0Mq_3A Ѓy0m4\ݙ3gC;))"!)KelYXƾf_KDdȾ/d!I rνs_Ms|S=yߗ>ݻ'}4YD| h'6333JCիK?gcc##~[18(@ P(@ P@u,woƮzP~z[gm)Z Ée'~a{d0 x MY?VDm-K`Ģ061_̈ s涘+Ml1BWģ 5F埴2,Y$f %]a``u;ՈN )|2b>ĠLU+S(@ P(+ՈP|!&}bHTT49$_|CZ⹘ ">ȑC%q| P(@ P(@ P@bcc1mHb)8$cS^,3uVX;X|rNC (07V# jS +DvǦĄə ghh7WcRl:)^x9Mod̬7\!u߼#ȈHB0o=x6v6c-(@ P/ $ ?}q]ܹsG$>HfΜ燽= .,M_ ##w044Tӧ(@ P(@ PtA`\ˑ4.㱪*8pB۫)]|ӫN˪.0|Қ[(+J85 iQ 8=>-lb/3`UЊT#:cKsKONQc)Gꙫ@"y"Ub5 FYײj)@ P( N 9۷oqMܸqC|-1q$,,LDR`A(P\LR@L(@ P(@ PwNcxTC ?7\Z6 ߄%LsNXi+xu?2ʠr:_+ :# @ -&5d2Q0(`]VwjSk. 9%'(1}L U;1 XX[h=']OPBh46 ۄ"_|^F+Z(_X$yWO?@=gV.hTw(@ Pr i+WŇX]$::FFF "NNN(_<~7iH…'OY(@ P(@ P(@ 0F&FﭹA9Fڂ4P#q lބ?D%=e-0gdȌvd')]Wj6 r_oĽwĤ+;`)lݶ<::헱B ;; &f\%E]b] ) V 1d*}3I x0rF{@M K P(N Q ŹspŤˆ(bff1IXbpss>)RDZMXY14(@ P(@ P(@ _;cyȒ-dFix|17dΞ9qQ7W j?GІ+wqF _07j`̭Kq 1OS9a':,*7 ecTQ[inpK1D]w*S@-g6$ $\}DO}Aھk{t,rILk[qE d@'>q ǶÜ}sx39TrJD@.Ŧx5f7 jh6Q(Spziiså ZLGCPBq굫Zt!WO_!{N-syFrtȊć>mYq\Q>l ܑ@IDATʹB>}V P/N I|E._ÇKǏGHH4)DL)_<:t耲eˢH"|=O(@ P(@ P([;0~unQQX nź)^Ѭꔫh.GXL0M\yќOP rz%- wᄼ b0\d6AU]`0hG휶Yl$L݃C{bz΂~zzB^^r N 7ƈEpN wwpT8>(@ Pd!WH޿kbŊسggώ_֭CZ`ff&$(@ P(@ P(@ @WXKl:cۏa02ҫ!w߽}ePqg/e =o 5)V>[#`g eb0> t\o؅x-M駗+a/ &vGVˬJJPH : i\"frk\GI @Hp鄦]4evpGWGlip(逛8$|*s)Un+c <o?Ց2(@ PW^K.(Y$y9\p*EhZl4|g5[?7-f%fpaWQQ @΍PA#14tK &*/&%TU]jh Br:DT_i>oFg0fS3A }MQR#R(@ P@:7СC(Vzjoh^䦬Sld\b45\:q)"FJdӡ6xmp_kd}LH"W&vO~"B΅W令=^@ecknc;&(@ P#])DԱ|rt5¢EڈOS<Ń7 P(@ P(@Ȇl(F ;zFC)Qlvg{^¢!Cd)2Nhء~Chϟ<ǂ1 ~P{Ο[G>z哖ΰbYT(p-읾wvTHP’KKTn_ Nx)mU1T({OǸ*PtG>r#!%`CL|dH|eәHf̘wwwxzzbڵ<F4 (@ P(@ PtG@čx5 Cz-^޾ÔS￢dŒ XS<<l8zPg&"T@W,m,Ѧ_<)uX,GEZχ ^ ̂022& $ܴ#0q;@oz{?ۍx "Gt P@Hk:ѣѧOIi`? P(@ P(@ PP莣> hDGEτ>ɉ|[`(ZUv#QuVfC|2gbd4g NT ہ^,NJg0΀*]Ȃ##̔2ս, $6@"3{|qRc>(@ PЪ' 8Fܹs1h brp P(@ P(@ P?Wr|37_Bofs,~\8~}'{/ bZk!A`J)=W |Ws!N zHm;ZXR(@ Pt^@HċbՑiӦaڵΟ,H P(@ P(@ P@)郦OWRZ)i3T}=|\;7NEO6Ն@lL,f :ꠘK1m1,i&\;{ LC#1v%M橮!:)-B~5u>}**k(ݬ4קURkDFD$\ͫ7zHRN/x]⧺?id<B P(@% (rxS[n3gV^6m +(@ P(@ P(⢥OqXG.V[7w_9Ca``(}휵x|1zTF2Uŀ!hٳ%J8/C }h٢HYP@GC7`A?(@Y)VUNݓw5;G+PT^{&%mcgu8;.]tJF P(@ (1yK.Xl֭[f͚r(@ P(@ P(@yL*ehZa/6buܷo1|y U@L1gIN{HmW%?IFLx \꽫^ 3 8Tr\$EZk@!ZvF$mΟ[#q veYfu`+ P(@ 葀޹˥# 6ԣSR)@ P(@ P(@ _`˒- ¨3ON' $0s-էkf[(iX'4"pkX7gLV@\x|rt9lr68Q@6yoB u:\~Vw  ƛo UH`.!Ȗ3L37H 66b+("P(@ P@3DL޽;.]*M_n VC P(@ P(@ P@!C0lJTRx5L[Ž;0p@[H2#stU"?sJV,3Uj:V Jxp;~Maf+<~+~DF8]>ugVĘCw^ 6&ƪ haUW@оWr84b"sI*T\$;nEcUvI"cP(@ P@1Xb~7!(@ P(@ P/0uT;򅑱 b_XBI|wJFFQA2oyp,娂 i8L;UBz5=<ǣbN8n֜<س|zTǯqn$ &ܿyn En{N ќx#z$(@ Pz, $&L/,X-Zb(@ P(@ P)o> V:g*w%>;rJo8W@BByNKuTmXUͣ16fyϒ.?ܔ)~z\ VQf̚ºAPse/_ pD X[D7cT@ĠibkQRF y()eGWsrNhG P(.YnJL2df̘:Pv(@ POѸqnлȕ/ù3ߏ_"kؘX=tnIk(e}(@ POcL1hҵ jzP08.Yz҃_⎕;pe T~1?W\kYeq@p>F~G^/3 "}vļAqP@^1t\ M 5'Սd^EdD$^x $2:OGAf(]b*(@ [8 SEEp|qkWM5(ٮ@qFxxxzRC I P(N]B뒭1$ZUzx2w/{[oa/<}.| (@ P~ bPX絆~gn\_Vɐ!Ur"0c 4E~(w4JU* ۖ+0sLd4A]$3^={PD}[,;"S.l آ:",,- &pӌ;̫9JF:`d,{*'[PtY`벭Rk_I7iQzr٬Ç ]tȑ#ed(@ P! کR's)Yf(YȴԨc{8NeвgKb P(@ Z`9y&ƯS3SUg<{郦M6p*$N\woޡkc X7gڪl/V_or?dΒ @ 6ۈyõk { m[8D#&y [o"| UV(@ P@1Di]{V 0ut]"*ST;̋(mM v5jc̙(@ P x%& 62dn.nT[\\АP`wM|(@ P"pb , +(&,ٲۨnjΐx M\:"MUg<- ]3DmPx!-g" Vɝs~궩CwN8&~M`d»7O?0!6-ڤOeVN I3]:>66h1MIǶCB|*ׯF P no#EE I&xB'dJXXի'''B&F P(@ ,o_E'N00jwt >>>p4(^ ;i\vpߏV[Ε;8 r%j"~wQzԞS;Xn*;?z.݊e\YܸI (@ Pd" .`iU;5IVLCGջ1=h:2cT@̓SZ1FšN[EQyY5M{MVב|;{~#UXĶ1PvEvbo P&H~ʟ 7hիUXmGlB؃0qFchZCySp]dɞ\&G,~7s*߼~GtU8TR(WK'}t=G[4 2@?rh!VZ߼.)) P@{4lPڼy3LMMeŔ(@ P p%)MkcW}Th˞-([mbrʶÔ~SUX1u.>X:a&:*?Iz3oN?|r}bp|1|,["Kn\C P(@ ;#3aܡ2ʌZ 2"㻏GVQJxjpv܁~X #06cNJO>6EZ~ Тg 8pHk |7@vQA+=}_@@/n<} $T]ؘXj.(#Q(r1!?~C\l&飧8٬IKV,哗c\Y<"kt[6-#MqMaō;vNFƉ掜"Hq<{¯3p+anðvZ,!dV^ظ`# ^N;]bxR?JoFPP|)@ Pd" .f-o)J 2P6qZ=gvl'"6tge"o\w^i(c1鹽=\\]Pda1i߹#0qDl yҊ$ɍ؈(@ Pś(|yg- kcYf!m$9PsT M\@0n .zIw:twEݪP?=  1C? fP@|\<^-ʢPB*JsCZ;+1M,&|qu,1DsӾx"u8DPZ6 1yČK/8Qȹ;I77bb׮ɒ- Mtip*$M<+MdV+?޼ W\6wN}Zcߺ}vĉ]'8y;d1dXn֮]… +ɏR(@ L@PIJ!BPB/Wbci&i! 'L,,V~e)71AE5!~(@ Pжc1gb.'Ok;'f0u,-3T`۲mz*<=U!tRA3#!fjk\ú9gb"T` S4DOX'Z]<H{*$+ &zSঃp(<Rڏ(@ PЎ@cq#qsױ]B$VAGbjqكgn4[ik'>郦KG^>R>DL9r$f̘ի+ōyR(@ X@LۃK.ջWJM >JW)-}y\/508Da-=~)@ P( 7H˶W"k!9ąP.ljCZʂæF Mf ݚJ+a/_@\(h"t?R?@(2qsRJYMzR֓tQ@.{ߺXja&&xXe1s0 P@rYoڹv7G :*>$~OMcvKj͋7$Iq $/߆Un+ 9$?6ڈz}/3H ]+4+WСCxxxHQ(@ @YײRe'vHQbI]8~(Eǿ8[cq?(@ P+0hiKF~Kz㲿_л:wcF_X0zbcb}LNe zBMNS0BАYCoRO"֊WZ92ͻ7ǖ[ }r{⽍Аo7\In* i|2k(@ PX5c>#iU~8y/mAμ98%bG`dqh(N7vHCFw%|wMbqlww[~MhmׯѤI,YӧO(@ P߽~U+l[ 7fE qeREۗnK4Xqqqk&S(@ PHkph!]1٬#]Ε;Xc<@^B`՟#Y-D.ۊ3`ؼa_9cet9BWN(J> h\\{"{ X hԩ?Dcm B+߃ 2ib8}!O|OJDƮI7;b;kMZWbu\*(o#x1wmЧu^|4 "u|4ԩSm6۷s(@ P@_~#V]\~[/Qt GOѲgK 185 ff҄#66Gbw48s o/-],ݍW@8|tsfhqF<]Ftvv҅FOnK.aިyҸ[nE>|K%k(@ PoxB %ɻc|- fˑ!C-gS"p`y9K ڈ#c\et? r'L>g P H윸ׂy2yXZjveIs~R_3rHd4Ax6ğ> 9¨e ƹp6/,_1ut{vK揚>@v RW8r U o O8Ub2dF0xxHH|p(@ PÃ[ [C?n_-Keb? })qS<R(@4 mqnq&V<2U*r 4$-[݀v X٢X1n8V'?5<5nؘ߳Xqm嚦^3{7l 3 3& ~<,,5<3&>l;@~? vg;>8u|֜O(PӪtAaޭT!0w\=Ji*c( /N< * %>Q@QQEG!ZZftدӳNOClY8,nkddO_JCDϷ]#&1uD(DHѺukԮ]V5s(@ PP,b_^H.}dJ%<"b&Ń(@ PH >T2yt3WHa &-Ë;o {R>D}/Z<<J+ኻgrR.{웾#)gӻbFJ7rʙ'՟\8<\h\{O@p~N*طn7#*Ue0 PL3&753SiҪ%<"ڋ#b$];n/C}0dҥK&9(@ P(@ P(@Tܻq~=ж[T_9=TngE#`l»*-]ޝ9K ',9=_sPTdsU^߇ۂrIyP@{Eћ/)i)Z-jR=w N)[leܴ' ^}6j4; (g£& Rz!3R@O46DLYf4yJOY6(@ P(@ P(@y DW+/Nz;Yfn4#0d;KV3r ;*.B.\V`B ȕ?60Q@޿y{QoMe5jY^zĤƝcü MO(+ʒ8+aN'^ 3s3!aڽn[N PUx\9}[lEaճuVEm|\G#߻w{FQvm5(@ P(@ P(V1ѝGXqv5rZSe?zJxPA4Є#8 fc4108wF-482R5qtQ?8?e,?c?Q_MEOG3,CVuLz,-Hwbo_ q7 Z 5D (@ P@=,}/PP(JP $ ر#뫿Ҭ(@ P(@ PWk`ؼa-d+l^z؎#ێ`053Mo8׀X!hrɨբ*9& .ނ|o^Ix:bƝN*te(ži{PO dʖI?f+uUmX;]qt5W Qɽs /:9!uj\S(@ P@FFF|n1PBzW ޽z7rʁ2U)-B P(@EuIHH ///-[V L(@ P(@ P bhȕ/<=|w|Ȕ%zXo [%#08-tN+cn:xNEv 9( ;ilYv1! 9Yk囤2+<} $ ?~HԁVVf44ToȈM)@ P(|[9"̔(@ P(@ P L4w܁?d4JҺ~w܁g2gru}'#}nVgjb!6/ތ`8Ȣ@1ӷ/*Ԯm*L _zߣfM+Nͻ7GP`޽}ՙp<9,:ط/ݖj/Xhp+wQemm)@ P(HM YbvڅD8L(@ P(@ P |^/b}}/^`b҅v.]C)0 rR{4ihݧ5;M`٤exx!"Ԙd/]v{Ed͕U2A 4po8-_rZ(Gx3ݡo_.)NJd)ӣ(@ P<2$<< XRJYQ(@ P(@ Ps'`dhԩ굫Qx0jG:Pw1$m[?Q*b >-s\wݸcOUPL8,}:#!f8n?c쵊] Ɂa2XhZ ZԂX(@ P(zL >|o3b P(@ P(@ PP@ll,Z{!g8cؾb;l:F,b)7j"D)jFe/LI& $$$`lwG;vIH ;QYX;X[R_ͻ7ܑs:_ZXJŋVp,ڠbgӚSƆ(@ P';wgƄ -[ /)@ P(@ P(@ P@^L{LxΉ:sx9&=ZEC1 n]Vo/HsW^arh֭\gRgv8{{#s Z̆#j)Ke <^Cu]ϭFFӌؼxlrf"&M`/8DAi`h X)珟㗶Q(@ P_P;4hP|}(@ P(@ P(EX s1x`-f¡5%L;n}PZYM q) -V6hջJsetrʪ뗯vTUnL&bM=f)Ȗ@i{Xnx>>@z^y!VrɁa/IBo-'45؎.Eߑ+Wƍm)@ P(oM ?>>'Q(@ hDHDFFbرѣ˧A P(@ P(EHDC⃛ d@X$>DZdx vZw- ֥[1i$dΒYA3l<+v?̳'לe*0T菉2͐iQ@fiST+1l)+B TRX?w=*Ր_!~4TWᭇ:h/ ć>moF*70O|fdI|׎Q@$>"C@gğ8׬RT2dxWS(@ P(@[:TK@Iq⃛ < } G6uѸSc-% <MG!\9i?[@Uw\q֨7.d]ŸK Q~Tec~T5yddɖE>1 (H &*gDU06 :uIUB"V{9lr(&ou$5GVxB2뗯818e.z{vYV^0mvućϿ>}֮/-4""'OF~3gc P(@ P(@$ AY0M |kJZ;aXansj' Qx0 CWO`x/{NL2srcB)xq]g5e؊'{t1*j3s3lYE#[lx]Lz檔IѲEe!&c :O2T(V<5c?ϩ?Rv[+1{ T HfΜiIJe; P(@ P(@ PЌp%C&LhU pJ .FX% k}֥[X>i9zu^{a\/j"=X4&/~l#ʪ19~ d4(]dqF$$1 $_֯o5V{5XZR0vƨѴs(@ P(JtM Ĕ)SЫW/XZ <@IDATTڳ9(@ P(@ P(@ s|:C[=|6"!s"e߰_WȒ- {N'T\O2NciI M|}PA4XKYpشZ |o%P !!~69˯ 3dJ)c_[ݔta Pq1q82t#on V,괮 66gx3N II|2r LUO߾~1(@ P(}4M 9<=^yy(@ P(@ P^>} ިޤ:Zl9V&(iVI}&I&\"Uro:`58GsbO739 #cܡl@ή?7Oߠj)VP\}\:uIEjb9 \:6οv"}|P&f`6nixx!ŸDižض|2fcc P(@ $/ $k֬x]vGg P(@ P(@ PP?\J\}<}OX 2"|ӫʋiS .ĝw0zh) c5I}&!.6gaR)pd(EkMeO6jV߽UPaQ2e@v%i@2N ީشp괮L(@ P@~zѢEhܸ1gϞ|t(@ P(@ P@:>{{&E],7J%}'ᑸRs@I_kITDￎ[GnلfHc@p u* W>X>y9}t:-q,Y!]$v/?ZКkUcŌtC *2 #~.hիnUǸ;. JPA *(v-vnԘho;hbb {oر`T @A@3C|sgΜβwg9@ZɹBߝMV͆6JY%eh\9yEcډ QQcO~1֎{nۡFZˀ&mW\>qY:v{0X+Ʋ c>]W: H fƨQ\O:0}`}nQm kq&M j7نI@86SF8j*IrD`ɘ%ʓ+a?GUCWO㖎S  h΢f(RXCԙF/2Kt>a+`P9^& yn=g젹"#"1aycɜj7-3L k:L_ZMs_L .Qւ\Xw뇮?ŗ-M`mbvxvwx@$@D [HI޽Q`J$@$@$@$@$@$@$@$VZR;$"4j|Rzz([P%GzB.*hYn\+ݼPr*:Xk,VDߧ.#NcJZ;{O??xn/6q\f2)bh8 (sr#VoR|"(HjIۈEf G%ʳ pdDxTSk笅{:yh29"p&T`hdJ*Q ĺ(gq4FmU +L%-Ѥ혶sέ>IH@md9͛7q]^Zm$@$@$@$@$@$@$@$@EuSxģˏ`6';ᛇ'p?0+cURqqtФn컁A(QB #fNA4"KJK_xF%O DU+L;M:41>H;;O`X"nTWi^?[~݂kRʹ/f.hӫMzXcw hԦkKH@}#bcUGij: mŭK߰!H>}uXHa~l|aڸ]cOh|%/Li9>;qzi,[Rf4I`[dƉz%~0"ȋp|jC="gEaݒ.]svvhҾ ޽i7x\;TA㶍 @8"^EӴN4{Ӂ4LrWCJ' 'T";w54iR 䀀*vl[3e^rExBGO: "$3 &X;h-[ ]/7ŇpY!BD ԊSg;@8©DQci(m_]guEX`Ahg9t'(KxƤ>PfE|9KHҭB7<}T[OJgMjH j^ƒ {nRUK(p5ԄX$hסCe,&::he -]4:HC8/v1w\1/!WM}MyqsyhM5V8@`Ls@@D0|2f;F!B`vMC``hh5  E!MsA:E@ t ǶClLl΅YO#DT3UC]qvM:tXC:ziQ'GPNRE+[4U|t"+!2|{6A}Tcl"Z-';b>L]5]tA3arp Htuu1h ѝGk;k)S8?R? #wOff:B Uob}Hԍ@H|||p tU죾$@$@$@$@$@$@$@$@F@HowoҺ>/%ۆiZ{mG]־p~yYg'XVҪZd ٦A~k: (x/<YGr (6 "I!p , QFDK1N;iNUņF DCx¯?SþX}f<@FQ&1 *V.H :WApwR$*2Jͭz0:~#trF "~ N4!ݫwc0ztw^ޗ%"c Rr9z(FGbSF>D*\&)˥/a]OzK+KܼSs E- ̘ryx\h(^lY,)7dPE6&,$@yK4!&"&Á׍ e؎IH@ fEppppJs!        \%,8 ..8ڌj~w"F$hXEEyw7Ả>sTDED#{텮t "2(Oo$7"*^ن@N 侓Ѥ}0~n_?}*uYf02"3@vmX7uRf@@lr(MAK^Re11:p!ԍԎ<"2 ^;XtšOdْ߇!"kCYQ)2Td0.l,(S.eM!{N;݀ZK@q lP`XEM@@t= s +̥dtRP`k)+o`J)P PC [e-(yW9j7 gf֘rJ h7rfiht۳nɁH ;> =][.Hr8ľ $C ;V@ltcS- i ??<{,]Eo /wtgp&*,*ᑸzj"+׮M67uYv PYT Kk`"l&fOHH@U d@SN]vj"       q1qM혶A/9CfoV<_[Id웱O9aE,%-K''1 | ұKu Y>~a!aNC3k ^u-n_ǡ5gNZ1 m>kz% >7,ڀqukU"iB NSjF:TuJm $qqZat;톺- liɻy&nzuuZN = 1?gIaXZaNJA?iUkUDtdt"SgVago'LXI:,>D"/юϬLxLIW-P^Y,"^% KϑEG _K<'  +BCC@I%IHHHHHHH@s t/_&hakzAdi:ib۸ D\t^ejAϛ%:C,Q%,0L^ND +Wp?qe oBޠVZ(Y$\7x)ϟ|*SW}V8(ۏik[]ꇇcЙp΃;klmoC:Clf:5 VZm,#| Qz isHߤCr4kԼ.x 7[Aov.m˶J*ѨFv4.3b"$w qqq(~+ h$a{eKJrsLt$$0D:rlyqsfʝxtm;9_AAe}Dxr/e!b؄ߚ[vmu*c;r..M?o¬aЬc318YEQ/l ("YH%CSN %ܚsw轸7k20ER6<&P:3KFnܸ^^^={vFxx 'xU(ςqd[u=NvdM001@եg=w^9$IB!BrQADUR%ȬÅ*~2Uկ㛶ߠC=_:^ե~J"QG밮0zRL^XB=C(8H۷cVxbh & OB9eg*?pZK)!Bpn9FE;F@ICYEDߴd>3(KJ890m6Ųy^> /0rH>&#Y}0??5 4ޱvZܼpc벭cOafi&U_1D=kFQ@,C"ohp("#Qa5ߎ7odTR8.y%aU l xWZ*cX@$",Ңs x{2HLT fߪpn|wp*֬^_wͣ2 0Y/mƒq38IDD At2/g.k.Q͆5iwXy_ơC1uzjўj1MT$|KUxtZoشiS:-XM Ci9r"u4֢xK46=F,2c%-"[pt|Ric%lwD{Uϊn#~|(ZJ({ UǿU B$$_NJvp-Z OIHHHHHHHH@= HV ,<"u)GD <"dQMkUXsn GTsrEeHlH=_ȹwHascats,aDa$HF CT8;bK& 6ʋ, ݇w ۂA |YSP~ w)S2KcfQzbtus,ې O@XV<3{xHT@TrwwGXX7oQ3^#         P"8?1j(ToP])J K1qD,E` "5f{)QF?uVD1*7NߨԛT%K(ߴ<,l-T^W*H@+ x "j6K <AσPuwb8)ɺ׽rԟHHHHHrF C+WժU˙t"         _±#;}՗՗L|::wV_CT#[#f R gWNŒu3d1ͳP;,d~FJcQQ:l#s89]ZBDws!jSDf:i!TW52G. X\g'     ԁ^z(X0f9HHHHHHHHHHx-8@nDOv'K@Dǟw2,OX;5հOc7^hڡuvX'vl0/nukb01l)fP9q1qY=Ӎ @zи]cdzM4^dIRd۲.tttבEϾ,[ؘHHHHH drUԯϔHHHHHHHHHH sfsױ`1ɼ[hSoBa!62C:Z4J[x;f%)_ 5^M50$0ѺGkIH@%\räĄP,hݳ5.aYn @Fme#[g楛a[͖߷MHHHHH @""ݹskQ(HHHHHHHHHH Cb٫1fT[%ö9: 6`² P%MON_Y*& &~65ӿ s.h2 _h4:GR]Zs)KɉH>-wEXHN^l]A/p?v= @鉨(+a          H@_ 8^7kz # L<vDס]5:7X6it2V%9_cs%Vk7.(ѴHH@\zQKMҊ@6+?'A [ Jp= ҖjNlmۗo1>I Hׁ]0^jHHHHHHHHHH$&ø1IH3+^Ԣ(&FjU11:p**שje5e$gR koÈ#Pi- j jw }#}TZ@&Zuk%3iI=?$5ΏfLc|:Sj4HHHHT@$w܁ TI_B$@$@$@$@$@$@$@$@$@E`ul_ #pjq4&]+ݫw1|ێT}рY*Ts-/,~8M7nwWw괨!VT4@Г <\#ihѥ""⦑AWWW#mSQ{;mlєM2j,<$    <%'*Vp0         &Ǻ0 T6ն ;{;f_u?m؟º:@S&J*9{d{-yIq#:yWÉ}J:tws[2BwzԠ~ߺ}8a0`f j1ZmE.-qn9d H46e%ԩ3K3esŃ[t2!    Gt GHHHHHHHHH@; hJ䕓Z-N? cwu| 8}wq:O c|Df(a]"Rn?o`иAhڡ:LI@ < 4@m$ТK ?$gWnty4$7DS6-لrdB$@$@$@$@$S+W.U$@$@$@$@$@$@$@$@$@$NX*7'm 5HZp-s]B&R]gjصj\v`(b^DvY"p.Z/@,%h*("<?jW·sUA  h&mn00A司 X3gXVZCagoQF2IfG}杚g5䄀MO\<|%'هHHHHH@@+(U(          _6OGV%-!pEc~J*i՚c}ohe\ͱL{-yzM@ݖuX>y~y[AW7y`%M #pettuTO9jD$P@4nXnnfWo.21G+jd֔sH`â PwN (@$VVVJHHHHHHHHHH@ <}B=ѡmǡ5?GF5Pα#W/FjYZmǻw0m4i LsLA烘qJXP' =SBH@Ai~:ބQTistT43da&8'3). Dr' v_v     P>4HDKKKH$@$@$@$@$@$@$@$@$@$Ɲ{KcqZH@;M.XYgz[9ρ7l&h~zqmafi &i ^^X" q}L+h/&&ԊYk8 4iD:^9yEQbTD Q:u杘#fy'n߷}n A$@$@$@$@$@ Jp )Y$#.e$ $'?D?XT)LaPVE,??XT@IDX"<{ n7WŨI?6\B:+QW8/vQƮ<'v ZMkP9DtxY~U|rR d@\"w/o,21B^:yep*TV][հ>Λ7065qyK.۷hܾ: zݫw_!_eg)wӔgx&7u/C?>Z(ZД՚&7{jxּ))~s$VVV"}IHHHHHH w-r g~$"@(cm:]¢u+D `΅(W\AG ?SMeH |# L3 0`|Ӄ8#BlF\qbttt>\ %@& 8 WQ{fm?dVS/+2vVO)eQHÏ⑋Yl̈́e!Sh8jh5ؾ|;9nJ@S~@=+q}@5JH~9ho՜ٜkAʹBk>(^\\0-!" H":        P}"xt挘u֪5U7=1o< 7(WǢp8¸1&1YPb^Pج05=#m8Ptq $ ,x#GKg=:Q}</kN f (-̸!@dD$B&tdDv" @ hD@KXZZ7EjO$@$@$@$@$@$@$@$@$@L Mܰlgop"* ? yհGYc065Vd/~X]?qNk0;Y+A"E dPKYOn˺SW5pf `6w8pȠ/唀?ͩ#    i:$H         sGE 6zc[;L|:"#1w\rp59OiԭnS4Yf *6i`:ƏD60|puP:xQg "A@dHNWN^ "I!Sf~HoBO:6l^@tT46,ڀ#z¼y @nHs*44$A2IHHHHHHHHUp XeJjnq9qXvjgH`]Zvwoc!hݣu-X0$9y6 (jSG8޻k g "eT"k̢nt!S{ q5x`?     \"nSS\bIHHHHHHHHH@ xa褡hI36%z*OYk'@=13̀JS k>zo2lˋM@޼p w.Daª,# &e:N$l&MrՆ=o Q{"(@Td6źmX7XZY~,v&    P>tHLLL?% { &=F<'g">شd.[r[zo@y LsI,W!"24qDTSE4*$]_G6mpZuj6 'q.m(dRHm DeJZj!^elϵ'    U%塡N"        Pe3DDXܰ,2h>(1͙BM[X6iv5odQ{M ӮPļۣ<|OG/{ЮڊvJxr ŽCeTB*AE@d*_F80IƯSNCƍx5#ڹkip'*W*فHHHHH "66QQQt I $@$@$@$@$@$@$@$@$@$ %84VXeM!0w\<}l߬ 侓Q|# ضcp37DڕS7`Z|=ǣlxЙJ&ヒ-JPͤm$ jVK#H^x=[#9r|2ȣ     H$<uxᣉ#kO?mU[ %3ylH=7EREPb>G Lq0묮)d~zl1E2G]2amIIдCS6SO>#gD kV$SlLmMQ1$ 4ZuV^mf7qWLx2KT*"FY^#{&-*UI׿{.3`akgN guL3O$@$@$@$@$@$@ZF M45n٥&cפ]Vy^|e4bu \wq俘\ P}%?`^TYjXTd/7cX7NCj8/;5g 5T^2z /c& 5 &Ȉ_LBM$JAlp:yy%]vްfjob.<应A1\t*oslu@x!Rr,$ RT] wMT{Qud1/m騚Wq7=阓cx5`ݐu|0{dq1qvkq 2Uv;_{\ۍ jVKf1rG'"&luI R0-jܻv/w/USMcIy$)*֌Fp0q ٰ2u#cFm[/24>W}~zGՑa:NpptxrI˜cw &"Oo>=`5یa ~;(0G2i S-osy3qE@`r8۩l!I:Vg oK>4HHHHHHH 9KOȅ'LjM4Ư6y,PqpE F!S\`YH 7\#c#9Cث0yzKa @UжO[C=jQԢhåwYXJ8]l6$Z颸]qR:_j 5gBV1 m xh6Yb`ﴽ+CM 4 Tf@ѡJ8tF]x-@efM};V['_m:)|%[RN/n&(NHri4 h/Ewx B=9Y'=S eI'ÆH$ѡ|:lfsu%uVxNP.}j&q `,M@fvtܦw6F˵5l|蜧>Žq@K'H/@QkoȗDd]]3;4.:ɗ3DS"E-a5=7<Ѿ_<@c9%; MpN!¡@l @=vZ,BltlBY+GrR o{[v}OpJZ+S3ӤU*}LŽSZi]b Q̶4j] ~|}8| nqOjh͌O.쿖)_'Oɻ-G:0(!      Ȑ@v >_w}DDi;mwߕQ B>aR,‘H|c 󇈆֠_xQnR cExr ,ZBE; ʋV- rB^Mu<>A7PslM-h<9we_v֩"'7ύyB 6&?b%ay2&nݰd5;6A wSQvfN@8tE۱mӞ001He_4}r^/~ZFNWDب*KUhR7ѠoT"Q8k 6^B ߦ JU-m|,62 nqZ#F(`((~8IFmB z*3{ȹ*L '_ tn]τnVXfA)Z+{37qyxN_7Mi}I& rH'wC҃-`DzkC11 -tc(ǧ\R\s \t 4ڦM2ijPY2&*kPxaZյ| }74zK91OW\QN=fe祘c1Wej{ XA.)|B& \F$@$@$@$@$@$@$H_l^>W}T ]/x,"mr#`^.L2w|ۈ i SwFQ뢘Yc&5 طw OdCao即#k>t$d wIqye /ezQƶj!a*#g=GmEF]c!7xhQ8-M.Q0R?;"vDC ."" "=ww>DZt ⿐{!5Qoz=f~f^@G7.c؏ V^:x{&5/afi&捚GA>7ͨ=5 |9K6֩<F g<qELۊSNaפ]5qػ*,h |j@q,[հJdQU%ͧ"hza89b]pPY;h-[ ] />pFYb#s͑;:v71~7m)iͳp)+qv4m gI]ߺ>_:{޲NW+wyWfgvލ+'K'L85qY[H^UzᝇѺ#~OMZe쾳G~4w&:5+_JGnçmx{{&# ci iՋ5#QץCi%\d䚑r£p*jzNk>꣨}6Z]s;/<5w>f;N8-FƢFh(Qg}t'z&?w\a iL8"+kv?aacVEqnUo̅(iNDH5Еsd^F{S9(8vYEtܦKssh-yC?[`b1z]~UDmO[Yɬ$"/M;MEضc8rMƤM@Du [3Q=mL*] N~G֕eN@|@Xg 2G-|<|N:*'#u$p0n&"-&HQnb5s A PRB$J+||@?~lmCxQE+=`p B"k"2$m8?ɮтF0fz%Bl\=/y4k9YltqOc#s @mKR+2Yq:(f;xWT ,W=#Hv'P<@M>o=jˍb`yw$yZTz:ED8v(RMU6Yijm).C"_C>j^ƒ ]tQآ" ɱְC6Pj¡C?Ul^\'yz׽dwdSCΓ(l^NNy zUF-Ѿo{TU c~Ld)"Lűf츻{N\&át ŠqGwIyO.nNx( u暑.[sO-._!6sÅQ5ds|"B-x"L)ϪzNk>~@@xџbe/6}!V~X8-GQ#kPN+Y$*;T#ckQ/9<©%mnO׎&khhjᛇKG# yQeVhD̙)Dv1G gEmzMi^StttK<'        Rpv[ 8q¨c(:/;f-F;⃮&^B! "v>~qOD?2V Vv*+E)dUHtbӎ^oxfٺ5M7AFru Fo{EC7dJ@lTwAxe#7gJL5,~=|g7g*rlR^al(W&1Yt2$ tqv<$ ѯ"K/D1$} __ۘxJ:6$m 7BC ~:㱎ұ#EOQ^S'|)h<^蓃OK]EkCO"*Ԩoͼx 3.:J&G657ϚhۗoGhp(M9F%%udh#R[-,6",A..3ȀRמGZ$kؠeKG4ZE( @E{aYXO(iG=?SjcKskgo(C܏"CE A+gT_ 󿝯h"c_NgL@dsbLb#>;Ѽ﷉Rd@%Y; =YI'.c8-!uE+"xgI@ŽQuċw_Ǎ}7Ł<48A@|dIzݩ:iIEo; _@%I$@$@$@$@$@$@ZL@dV[{a2˛7oZ]Rbzz㩬*]}$֔mxt uQ{rmh5tRz+"ȉx!w$_)"a1QD% &|)3VŘ%.46ڐ>ߧ /S0jTʮU{n'XWxPJSt qg䕓Qetjxt {'V@ ֜ڑ}*jU +F[`*Ύ8+#oU{!W/oJ\ׄMv"K#uk)gyӱޮf^南i(洤#rAZV*'uI|ʕRy]BA֣:4y [S:_Ͼ %HSYz|T׶-h`>p31[, 7@!iޤ(b67xBMEǡj۪&ZI:f@!x@igqJYG*$%|$msn"ɒ55֔)[VC` )ۥ:}1R}iYTT7TXA$@$@$@$@$@$@$@jF@Dz2M,L司.'ŏܟ%k$&2F*^jbrA@nQDv}~y"yA00Kƒ"O4sgD80['7jCa͍K<4pj17i 2 n~vI8d - jmN|`%9;ĆoRL|*1PQƮ x=QKSJSKDV+[ۼt?x`e@UyS~ k|R-p}6Ĺfvl[lzܶaﴽ1jtP5刍سgˬ.] U2-)^K^^JR|_ S頪,Di!F.ĺPY="S%fÚeKo83u8@=QӺ(j {Kvc_C!MeEh@h/23;!fdd9fIHHHHHHH ? gmͤz1G6B1b84#6L-/R΋y3wq%|%pj) SSQqd ۘ($zOy5T}! g'N :+B(!ج .ȹ/=wMp%ѡތz04 y)苈K֤ TN`c}V%Qh{|cH<(Ax"EV$*F8.nJEUQZy'uUU+li#Œ; M[ E^zL29Xca9f1H"2U隥ҡ$\)DŤ ~L;(/ {W@MDأ-vXboF1j5XQ7aҋ 3H+wosoٙ7/SITV]E;[Iy:4s,glhM-&2àMaX'%ƥ"vd"oJ&yӎH{;"TaҲE 9>5Ȋ.i}/,̉'0d|j){_¾eF8Ia'D"@ D"@DK@D) )>d{'̻#_ me_.'xu8DXT@j6^SS_fQZb':!l5V%EareN,k[µ+_m7{%_v.RL]LQupU4'ofE%\AiU$@pz<>j(QBHMIńo&sϡs1M$1wχ'ږ4ʤLw.? Ru;+S@v'=%3S&z;6H B)>9:HKᗐ/6eF\mܧ۳}k{<Eᘤk4\r1IbN> yaW&0EދZ@_3#9+fvֱ#,Z"`K.7gop~yTh_H Ig>=R?dEWJ)5JH&($lB+-~ugR?yd>,*HB E$ļ[/"8,lc[W}0C2O|9;sZrV[*>"qv~kgkӲkIϚ3xRdͭ[o8kEBRϩףl11*9)6trszk9GWGs*SN-> x~6SB\?u:s?dvH7‚0ˡ+s݌um[-;sɽeuΟín9yCƙv8M7ɝ@v)?Vl؍0AVy-9;Ɔ؉Ž7Zz?̑Ew_ΣR-H9-2NT,$1Y}Qu&g_<[dC6sd۳x!?v>D?y DϾrcy~96mmFB_:BGO]t|%]'NC#Y8ƒ2s]:|ךWt͚5[.7 <d>n‡mD"@ D"B̗6ZM9ycyhdMHtlun+L*WBIm$Tm]mT;Jί;SkSbItp4Ll#4չ<:AWqKE*"2_ʪF›$&ї'?Mˡ6,psMDݍB܋8hjl㍏pCj;gh F\-soS~xuZi } }Zhd.]k2|IZ6Y_?'cxp_6BЅ`9Gmj|:@"P2 `<{kϬ+/ˠH*BI ^ús`Q6kuu%CՖ@`ڨE#L0~SKʆ4㙒d#٧|xGyq <8Gab^Q*zTDX`'׉ ttqk gT8}=IU[v7IkޭFo0k֬'hHH |}d.Դ"@ D"@ZH| mcWaj_.2~CCV5 I['z[ =dkZgWai*n~lǙ/uRbS 22%sP|=8d|)>egNvڎ2ee_ٺQk-׷KJͅ3B$p|%Є9!HJ6oÅ Z?ku9) Vf9;yOfT#DL@{:JbQEa07LW8sT9AY{Mj4QvQl%K@vt"0cO8>Hۄ r'`QfzDW`PtVAfX>+i/ZN}xw_E˵ջ7-0tP#Y|c'>mmmKJNjE否$ŹWc濚  X +O?N$M":[|h;mQ%>'_eDE:lQ4OM-Mhjf9J IIx ME6.&GG1ȊXPDR$X 3{l@,_̢D}V%lrFieFrGbN`,FƮ1)1"?q+R~E"հ'sRQuU.C[vMMM?-"@ D"@ D@G"l'{Ч0t taW=*WӲ+'܇車5Ӆm㬐*"ƹq5qrFUw_o<"R#߻zF.?@#"an-xbr FdYI'9~wrH\q ӘE7aK=w#=l9~Ȏ)}M3/<&9ŃB.-U_]lrZ_0Y_}eZ^T%J#/^bXj\5w+gg#(2iE)ƢW^YfŚȬ,*H9X۝EMd{ # ъ6a`Q}+߿Ww6? D"@ D"@&"K2" ,׽c|X1aF/M@r- \Eapi#D@Nu9}+}.AD3Hވˁ$6*񉰭@`ˆ%(gz_>9F_(={`/y U[V"_Dō`MiWJ"@ D"P E E"@ D"@ Dqx~9>f|E'bL h4 $ie92ED;5pzo|ZYHMIńo&s+ɲ|*K=.3b+dJ`犝ؿ~?"S^M"Pz?~DPXԲ@vQSWS8rOWF%`ΏWܲEA; A8 Xǿo](7 h<1psMښ(_<gw1O"@ D `ff7oޔlO D"@ D!``nVW$D@$R002,I ^hܶ1F/]( ,Ad&cSc%JBU@4uK[W"K^[z䂑hޥ%(@ĭnzc vHH.:쀌 hQ0~>-sIJ-mzX{ZéSN:"[6 mr.ӁkvW_Adh$: $lAE {Vj*-5&ID"Pr׶]ûr .84t usWڝk拆ZkqФD"@${+ ħD"@ D"@P8-m-*^`]? 鞖-]1-ZA FHm6t-S'IPǘc`fi{@[a,JOb&~K~7u@sDi$HE9DGq - i~m`6, M-Z_Ѧ_hepQWN@CD_,+X"s qtuT:|rE[C{z(LZ5+߫O8.Å9UHr B#iw"@ D@^ |nii(q /@T. D"@ D"@ ASؽj7U+j%$'`홵002PcUұKX1aF-:~&^EHrbW7"Ɉ{FJ*~x!ɉ/GKr1aWpsMEp'ȍwΈ,XPGOA`@ZZh[;V‘ ul.5.-a˩1 R]]4!^~UmУA  D"@N@ ^):F D"@ D"@P9=ǯ?#{M6*))yCX~t9ڕ4<As*:^}// X8?~'Xu| Txj:#d1(`?KSZvBVd#jE@\,HGD#eI#B=+E)jբ#E9S S^J\t JSL@XVhM @WZX M :P$Ոl"73jj%R7"@ Dȗ@$666Cbb|k҉ D"@ D"@ J&"PHkTإc, Ul-G1|vUDT D`lp㊩ʸt*N~s;rQtTN]' &<;ɚp+"@DE)jD-͊JBDMlgupmCr֓ xٿg˳"? V$MrσcȌ:S}/FsuD@:!s;s87qS]Bװ6TAy D"@BG \0Ir"@ D"@ D"@B`Ώs&/ܻVJ aaƸeдCSa GHD 5%^]x%Ф0 7Ѷe۰c2 7$Yf #;8" V 0qIÅC~.|}LxYY30ʺGdYz S'!?htU ^%p; ^VȒG?BHˀ{oB "@ D@$e=}t  D"@ D"@ %"k.ssw̅MʠL!p]7-z)I< ;o02svE䮓XcAm%~)ĞbI,pzY)kD@u MQu5 O"@ D@ k)  D"@ D"@ $/ǐYCޒVeK<1~x)rRR!غd+n9y;rBd9_?Bq}MɅD`ߺ}<31  _WH2,DGΰ@--4쿄M)q' XO垕SȪq@GȎv)L{s_44tx,sؿ#j(> *FwG {6"@ b&PXYY-K"@ D"@ D"P(hL>Ot4mPj ȶ#h_x"VNZыGibTd?6oѼKs]:#h" =t&$:P_e 鴁ƫX}Hs~.1DS?¥Kc#`8vVCYNUШE#H+\7߄x\0RBdD@eMgn F D;vαSFjs'Hy1 sN0cSjgN|2. +'@[;o䅒I vGFZW!=5k$fuHv"@ D(ԁ/_IH_ D"@ D"@ b&k?_5U!% atwGF5$AIFEmâJMDGB))xaZ++aNJ&4q1qHSK+]#H" %Y9%PrEph]&M`UJR@1L-Ladv;, QlY𷭭-+PLHEY D"@ DF %1y'!}ؐXy8~>-) I`tߺ06Y93ٚ9llPj9XXC[G._ "(1b>=B?f̥E-}. l `X0v4ysZFF% dsE؛0lz 'bΏs0p@|3J(ssZvh֯B`O_޿ål RN9M>=dž @N] 7UH$؀X}o?yywX'#5os{٭1b[ނayCü9\x"+& R=6VmCmXg%#`a' t94nX@)F__<}I')B%^ -݆ +'P@/T0IRRxo4>P0NAe ,{#2$#B"d$'%#%)Gׅا,m-aUΊS'TZ664> h.O.Gݣwǀ80NN@jb*fc9f80dLmMX0tm[>\ơ 08O H r $ÜEpuܸq7o˗/?---8::֨Y&ZhSSS0G4>لlgÇg \xϞ=i4̹~pwwGFeтY"@ D"@ jH={{-~MmMXULmLaԚ2'P[OOIOIy!C0O=D^Xٳ2*5ʍ+V +G崄4\J(IY=tLt`lʝA` 9"2UؔЫS6[-lg.f&<{'J*5Y;x.5o" *cXR$ҎA[GPs>]{Lx UTYsaǘ#ICI|l|ɽYeo=ݸ6j5VڕQ7[\R[hTq+xPD adiȃ$pƕottXߑg[*ObT2KXLLLsvSɓ'q >X1h (¢.Y0;* jC}v̚5;ԫWm۶ohkjO#D"@ D"@T@d<:ރ!{@XQE4U! E_-59aay/&nWp@PcM5wNiĿǫK=?gA$SL2YCUIQIy1_;F֨б;9²-Qrʲ-ÐCSvSI# n?>7,8H Ճg^}mX72Q*AX?s=vލã e$$#dxƊWF#)5JEdK C*ޜ~G_տxt _QYTQVw.(m< ;oLXTFv+} =?O*Z,#*l@dgJ*JD=yB֬:}/XmJڪcV$e:^…#{Η; 5=kbԁ\2b]Z&PbbC>yf?zgU&KVKM^G?',:H%Jh7(۪(SL{Ϯ=wqb ~;5rc:Ղ}-{ԧꅐkaLPvmo/, sرcwhӪU+i͛7G $**;0fJXݻwhXaJmD"@ D".2_c\|TtjFVf mx;0'׷_ {6DdSfT|IjǙ/Eoxl~ !`ʷ* *=OrL2^{w |WulW$嬑R>NDYj&t3_m~ãѻ^o>XrQZ{- )Uh=G+=BI ĮoZc0{'[vkYh::AH@Bd[`}0} +ٿe/¹ sb ]s]TYndS&iF+M {}u0m6lNU;zY|{JoY]aoЭj7?IVR9"%?:6iO>_.>i@$m?IGpm"y$[dŋ'&Y8ы|2"E:};]Y Q*yOV~*/-XU5>\u5cBLf ?vb<vL$_R#MIRe"I-;m"Hv ޽;>OMM޽{j*\v ʕC=гgO4lx")xܲgܹ<@J0l007?$i D D"@ D@\9@^{#y$:³'|&eM.M4n츁[݃w(WZk>ULQI$Cde\rJ\ 3))|köb&HQHS[l2B鎧o eAq5Iڿ%}z[~o?նtG.{ c:r_KYR:E;m8:UɿO׃i$ꅧO7JPH2Qϗe$(iI_E? ƶptQ_cyDGh().%xp_y<*IPq.anyOߟJߊß|\WmUUacZ6v;o 16G%i3 *77qBTd%_vi߲,ҁd„ 8w|}}S84fK.:t(4"DŒ 6`@1i$FKPt"@ D"@M@DIqI84έ:T41 媖<<JsGf#AGOIj?E= ~ ~|] ƨ9&sbRfd2ž`K[va`~ǣ"*: ;W_WBU䉛V"b"B"`]^+_+Q}}{`_/mnSzL1buS_=8`ҍ!T/U]Q(SUfE&yw(/Zjғ[_go:*/}$}f`Zm UլǶÑGW|TUK,, |k/0F- K8F)$(MI˥Q'iI_E<{G< l+آט^h߷IMIC"ݿvu?%E<'O*oEoſ>?XT@1-Fei)i{.~~9:s_y~ѓ~٥J~NHuaɈɟOvZ̝;)))>|8;88ZoÜH-[wqgiӦlYهH j$< D"@ DJ@Driih9%w14.T`QIή8 5>06A]аGC+Dã?mN*BSKxa3ZȥYp}Xe+yi0IhtsR&HKMØNcct(|IO$%&V?!U6^[DjD:PjǤnuHWL\5Q#~G'u|1(Oș4O6>/HONGͱ5㈾ Ⱦx <\p_=ʪ[dJ6/܌#gRpʠAQnEU\rAG2szU"5}<-4o&$, H2QϗKZVIO{| :<gǁ?RJ8u Ztk--:*p9\ 6E7l1KƠrua?ij~>#8qvh7w/ĂVG%ݸNY}_~%Hj%ieY7ZjXZZϫǎ"1baa!|eLMMI̙T믿bԨQeTi @"@ D"@| k(^06߄w# a2# iHrh!֘BS$E$ ~|@Ǹ6pNCw$8[\;|rM+JQH^B}ѺgkL[?M Wrl齧ыXnL*91aLKKW/ܻr;UZQTr }5tuS!bV_㫁_a)*%EH3) P"Qmx5-8bnNxfidޗK'mV:mOk9n_-׷XI)ۇW\9QN- 6u_cAIP<> s+sfAG@ Ҵ$}}8J`1|ptQ c$>`틀;5M֑a?ijKw-_w^9_JO|`>/tӑ)&} B՜GtttLPPƎ˝d<==rv% D"@ D@uUŎ?y AH3@=TyYL2iޜ̮5_PJIBHNt: ?^ 7 Tyakf.7Mh#" DI # ]'kLX9dt\,g҃KyDŊWGkgnpGڒx%gdz'\ޞ4;w 7V FިHכ]}6ґIބ5}6j56#,Ȟ5{oB?cpdv'QWt!<0{nՠp0 2-űS4k7~Ч~a9wPؐX[܊&`N4J805s~ǀ֟W^I~2e$RK:i/]ڵkʕ+`HvڅrIWS`ٸ}6w*iذ!L"BUHd"@ D"@PqXa>.l\mTR *`T;~ځ7"5)U%u-Ha8PbŠ\ mC킒[ 68y[Dg"xbz6!G2d0{,4g4!a)VXo!jz$y?<_vl"`+g?&[ؖ$ ĦD5k=殪U=+t킚cjOqY% HEHH0m> v ;^BE!2l]zz>BSJG{vҶw[4\T#]Tѧ^x.lإco(}oQ6>upW  [OF>7cnyǁ/]C]1LmLsn*z=~3a$ZZZTT9Ɋ+мys0;w]vb)%VΟ?/// 2 Brrr)KD"@ D"@dC ix,7paZo2+FH[W_%`tS,X_W6Uuah;ؚkǏ*<ܵrN:;¶_;`(2w,߁3c)h٭D& m6o4M5) WbL1hڡ)f=KgbIIeFqd˒B|D@BOcq B'_Ke"-@KW 4Dc+cQ'Ÿm^sopH|aay(|}tZijO{# oGG@wbf]1h YqۇnO$r P]Fe˖a˖-`$,,m@qYܾ}m۶E\\a!D"@ D"#e0/ocaVN=6m\luދ?0d݇]+3\w^-oA*{;ƏqvY 5Ǥ/ց ˫H<˗/G.]DŮZ*+oooL2ER D"@ D"@r:x+bbj< Ë/ϔ67ʷ*EWR f75k"ˢU'wIƦ*)\;} SzLW˜%cH _NcY0i"ՂfG~9.\Rr8%2% .rX.V{lkՁVSnd'S~J/ݑAZANw/E|lP80UX8b!5ggS£~ RSU]jn[Uk?Mmjm᯾!595Ya -}$044D@@@v~=eʔҥKE۷/k 6 III#D"@ D5#WUqjUZT!Y&z_xI!ۯx%K)k:KX .&U?W0: z IK=7d͸e$F鈀R @Ue|{1au~˳ɿOFdh$.ٚJSxJC=`hnXj~qz'}A ~/ց),zٳ֭Qnk֬Axx8,YRLJ:M D"@ Dtέ:Qmq⹿[7D PC8vruŝwE {d󎋉W/TkX #>L*DMpfjz])bHm,Z#Z]=]jb߹|;.\JD|90!͇VX#+9It>]$+G̦"? Ow+&OALSDͳ7ڠj t648iJ@qծ WBW Դe( S]T, +&@My%SZ S:bдA4bbU%3*O؏jvڒ),,~Z{ ٯxk~/ց%vuuܹs6m֟K@C oD rP"@ D"@ `_{M6Q*ۥ.|Ra@)uD)">:445YсeǏ{:RS`hkS4YpRlea-AKY]!GHHMfcv*gJrZ2~ܙQFX19 @Rc r(k8c展04GI@h>@7=WD*إ"yPT2#I[\S޿q'ިz tE7G/)IT{m\8|DS#k>#@zU.-GWG0`ɕVӔߎ|D P[rs}SJl>9`$7_zzWnnnxIΜ9///,4AG8߿_hfESB%p n?htaO*NG~=V ]N]D@F^|6JTb|ص0Dލd? 4I'}V{g{[Hg.{ lNl-³iq04έUk4> <>~qE&TqVgC;T-ùtJaj}}xc&'%hKğE y)=82e૯ʯϞ=P^w--B˼x"s3y _q9̙3gφ}N~E~ajՊ;GUS]D"@ D"&xqO=D|d|kî]cbq&6&`j;J>Rv+x&K[yh=Uto+ᚇx=L+ot69f d޴'z_ah󡰫hiu|46*? ,Z޿ vX*J'be/1YE{(J&d#ڌ@ Xzp)JV"D@jcY殲x|*IIydew.y9ל[%C'􅧾> -<Ŀk*o32mHO-2FB#{Hp#E7O M6yuշw^? }%7;jKGXo)\Dwx78lXD.m}ApTV邓3_z"0d|2~Qe˖2hܸ1ѫW/|wEFw`ai/^ZjI<ߺu 6mRyiϟJ*'D"@ D$p>ndC]cc_05LPfani sk&;'6Ȥ .*ZZxw᝘L-SY1tt݆viT ~Cm[: le=G yMf[VVS$s8Ζ !V{Wq.CyDq&" =veaZֵQ:X\s05/׬ޝF'e%$I/9Rpާ'pyѼ& @<"0m{EU򜣝 v Ƿ3aicYxB:CH7"2~+\H  XG.^qnR; 'S[BP 5&ڳh]#w=|T.]]ѽ"x!PR7W9eMׄl޽ dS__={6/9mٲ:::t۶mQlv h׮]a+8cׯ_+>"@ D"@ԇ@zj:A%J2Uڤ z*')EJ #5QQe υmYǒ;hj r>]-y~RgJ&#ChI94[]70vQdVc+hjk©Sɔ. r%ϬeplUutPnS~_U$ Z"2eʠlٲx$o ڱ yNNNrUTAjs}RǏ~z'i;`eڲz%)űD"@ D"|lrE?7 k"Ÿ"MP@Q,X 6<[;{⩧g;{zgWTt `Ba&%ٙ7ۄygYS'M,).0,%SҜwht6*n؀XR18 !!`>Vk@ n4%pU(h#JS4,%DEa:* `r4l#J҃<|2#ЦC[GEP$qvH8L/w諊r'wݼpVŭ``E%DGDkh֥%Q\Baۯ(j/hNZ5'%&ab1wrsr4-b|  k hi<+jo;@U.l\E̵h|;8 4Am !2 2wTDI/?1E!#$..D(XP tR@6n8QaBO:5k2 ڵk3ڵk~H0^^^T%rA1=‘#G`gg=z(̰#% 8G#p8G@$&:u cfѥ +ŧup}? Fͮy/~Zx P$oO;âK(a=Io<|ؽ|7:VM#jYs>F;Q3HDNھzX9q%9gv_E)(Bry(ʼ'#!Ck .3OG { C0u4m3oENHU;鿾 l7͹x"[hضrQ`/zOVԫ##EƣϩjMo} w} >6UÖ1#ʈNN"[lf:}OOWXxH8. z'c5GI;>4@txjSj;w~U"" (פ\"ڂCwB>CaUCᒅWu/wЩ^GHttwY/SK.رc3e< B^0|pVv͚5Ctƍ,رc^:F˗cŌ|/`޼yĴM RLZ9#p8G#p5Z:i>.RI#%)lCLh *"!Qb#bF,s]r|^s',Bl GttS6H^J:H&*WτCnyU-`V gt "NMO=>xGBxBZDjy %;Dex}5BkC EDm,CfyQI} 1V{fӻӓtH8<"f/+'9yD̊NQd;c?S#"W(_HgI4IM@Vh^D<xZZZ(_>g/VB P@ۣJ*8~8:ujz}uׯ˫T6n"TV TV'R IE8G#p8G `T$|ԇwe⊋01eE9C%d}043DMhQAQ轥7,^z!}^^}ɮwK/p4/3U@IDAT5I!]ͼ+;+xYokdxB%u 䉗"ׂgކFv+HZz)_' 7H||1̊!,8LHV&.&3ddEǪW5?fڦiРPO/ug>C߇/vrIPd:ȉCa@ةciUoVn$l1H.5 l :Rt vCjbod;UEI/x""66եy_EQĬYk.̞=Xlƍ<==1#޽CtJ]]ݯO F}&"9sFz*w +p8G#p8#n@ƹPFtO3$eY"z@PĚZiQ?/ >D=l@=Qm4sWaw*g4r0EHMAԋ(R^ 5>Zl7v0fu-k[BKOl&5ih`1+fy3u4{یe\Env? 6m[`\ӷL`ӟRx-4S S: T>AVHQ v63L9G4h@}+&[XNOG@51a ۵SP}AiEĤ LB<4{s"*4 Z[m`2{J#D<꭪'Sg/6mPٽ2|?.}T#XB y}5C#rD;@:%e1K<FF"92,CEtD4('HKq},?m_/ĄE3dn<ʢȴْ4v9OIʱ'F&):wD#uC7:tG'u;M04\ЂAA(ּ -';?٥r949sTO9CP_(!X;u-zenɧuBS/^|s2#r&F@g۞F y%,-0qD!0(k{Ol_9p_6}ڤZW Gʙ[ȫߪN8af V$aLM}U!W:W~6.˜[tGe]9s{| 'TII_-+Y8@lʧOf[Ǐ>L5 :::X~=͛C~?E.:tPɉ]bb":DD)S X_-ʕ+3L׮]1b,yy 4 ?#p8G#p8!PQY м~?V*04O=bVYQL~*'I)ihkoOU=z#FsF^P-ϴd^7ՙN6,YdwYm8a_^; MIyG4~ A /<"N[ZNEfr8N2j@FE$}J>Ƈħu"eU,N{ZbV;piFDMןlZP5&}WO_E\L\\2_P'w'h? H#Ɔ7+W7 >w.-հKnMbhik O^r*MCIomBZCCfr2 l9xߕSWHj9>Mbkjk~'d발J&><L :bԙQVwZN~3փ]5E7J'EB*/;HY 1H4hd_dIvP1 2EϞ='ڵ DVz5#=i^"km۶!22H޽{Ǣ9s7oƄ ЦM*U ɸ>:50`t] c1k, ;ĩG'wûHLH jxpy8G#p8G@\UGm% I7\~ ($%'&ڶk3clFQ{Z+o^^=Rl?<)B ^} s'sĦG'/W?̔'JuQ r@5K2cjArWq}@ 7#y9G{L'q"1m+X~r9i(Ύp9jCgg[yOxCLF%h#ħd GBRjb*m{#?#}|#vehc`e涂QdA?U5&}ҧwFUQĦH *pvh!/[ɧUndZFW+XnZ0 UȻz^G@iplЋ>кwk\:v !!uKs{ϡSi$&`j$V˔ F܋uE([,ttu*_[1tyzVVvFѺDk/QX꾔1vl<c懀)O|x]G#p8G# MSpa|Ns00&`JRM3#w7Z|k>9""b9ݷ8:(QȮb$ɴ;c]1is4 $iQ:?/Z- #MM Qo@=Y4W%:`NR.Rr=b͋ 5_p#K(+- trD]f+!4mG+y0Ѵ `f= =! .[D?F!7,8 ;G0ρU7`p xN.T[]9J[ HW_YX_PM>GڽA6lBr%TSP.wEiTr1ApCosI_ϙSRpe*N㍏#3wCqk-$E%]Aм[[W[6'96O6<G!s ިK$4i3kn3_P݀v* |E g v.hҡ|+Wh_̤.ФctM {Ȼ}~Ì̌w^PfP"(Y9/Ti^]\aY̒?fĒgeVHFuEFki{9=箳<==4k?t~eP;tzTf>!u3xi%e ~}56 W@.5`V ̂3x=#l{f- <sYyTq"W;0UwN! Y;OTQYʚs"\p[ETڀrJ 6 ǎNJ+"pL4 5BrЭ[7 4CJ\s"Y)R'NDJзo_lݺիWON"fmۖEذaoϞ=Q`A:t_9s&<=='3fɓ:]p!rq֦,(["!>"D|` ?գWΘt@1fikTƸ1 M#p8G#p@ Y+/ɨ7y痝g¹B.0Bg!,Lq=Y ]8.8ō+lq2G&a},dNۯl(Z(^Zj{Cy3MHG4WyZ&LoMB%}do}dxYy36EѦ01@JXgZY\:;*F̳.-l?,Y_iQdc/TՄhD #zlraWb*-zUr^2b֎Yl{WaTQ;#kw(^`XaŠ+`lcO~lo?媗C QЄGs̟9fͰuP /bœ &8D47b -cAp*TF zɟQ}}VryHg'w'FN:1`O?B (ѡ>'ҝw∊R.p QU'L̥8448;,V* |EX5y[F{iF k{kL8M {Ȼ}@S v6zOՓWmlK"l_nE'%ʗ`" C FJ+Ϭ8qXrv8Ttahd"7lcmdy'D Cm]m,u #zL$g"FT4j)Voğqxa$p:C)drn9Js꿹fXfĘDDD C4LmLaSɆ2(v[dGъEgkA-XKW {G02ǯ~AJٳɑ!\ ir^/$^C͚9 F5#rر4TIN"~DDtuuϕӧR @B$D %D2L&Y'y-*Q>Lb*! i~F" EN#p8G#p}G%k:!xaZTޚʒW(a#kJMIe(IK䙂aVY贸 o$sGy{Ib'66wFhq˭'O,,y5}NHF!LB^䙈rgt~F_֍Q`#yYJ^BR%T$[0r(k!{[oM-]kc9 0OCÛg%ǖ0z% 3` i.yŘcPT1,=9ooA@{/|,yɚn~W=DǝaXPR"(Fq cPDY{/#f"E@6*@"t~'n:3k?[ŔrO>M+uJg3{Vɽ/j47M+TFehK^J/gm"<B>@ͮN]aSN,<<% `gem#iii!<$9ϑ"3{E$"';Tpl#NٖgaZBqhF&(ZL':NGB(_F4,d&-]"@3 yqްaC1D1"/FFWHdd$ RʐwJbV"M)4Ivēw/ǏR¢ud"|xRXM(9G#p8@~B䖸{.6tـBS[3ϻ"aZ4EoIau\5Toɜ5 m _W TW9 7*.1#0ZT|$aOs~YK4&ou="=ٸf9w\W̋vظ#v?ǦC9d&C2mT]@b$/ÇѺuk\v 66'b9)) ;vdf.^mo3̕-,kjjҜBYd$僗P2UM!2F0F9ONq!chhr& G#p8G#P|`0ԚcnJD z9&4ύA0b&|xt@VŕFɋ'k_:+@OmP}u}|}K9ǣns6Z!2=#|< "pq3"w^mo O6Fpa\sVW$-o={{"!4;?reEK} PĶ(}-j6j<맯GH`VYC䇛ܽl7*ԬuT_$OX2U&?e| &~PFYwȫtҌ q`VE&|>ˍNPUe(X#rQD )\04iDZމo>4hЀ(Qhaо}{ܾ}ϟu5725v5I"Hd$H'AoүA~F|E:M#h G#p8G#_(Z(zo ]7@Tn+ߴ8V#afc6x8wBPq;[JmD+.j1>2,Qne?7X{T +vcᨅ,y#UK8.`<{`J)h޵9n7 FN5 &'똿>kq)dF~+&[1l0G:  @?\6tMuQszmi lhhc(kyZ/3b_f?KLHđۨn*7}Ƿ#j}Jl[ aeׁ*ypPs} >@S}qn TqcG i29sj_*;3R8xwָaRΥ{dP$7Y F轹2?bI/n([,(SB WWWԯ_OFŊ%mnjh;o!KYUShk#xtɟOʼnn?YP"cy:&:?*V@i39ULe0cM[sު../:6r(P <[ ø;X N(&II,>:-{p/:%;K *=LD'RL <1S G#p8G#>(nǗ_cSXlD,6tـW^bԲRvD{|8꭮~, gg ,I+W6 YpeU ZZ4f؃۫\goCUgaL15ߍW7x!Bfh|lmI`.3pHpk7_Fe d6׋__ F`B*S2$z@o?[gvj sKok q طj: H$y.5Ayw' £0hX[#zBbWW_}3OfC1qD_|}|z9^uvʍK? }f441p@o,mWwG~ޮ^kQТ F cKcd^$/^-AMMM၉'W^ ĢE`l,/'y}\l&MFaǎ07W}/1;c"$cWie$1Q1ԀIZ`&4‰4Oz-OL6 G#p8G# 8k;z1`XT{pocC HNHaWU\kdUD)nMڋjCK_W?6Ec${bۂms˟pHB~'T<)7w_BT]d._6g[O`ƩhӧM6x*#ySzLAş*by G@<_2"IOD # >馧xQ­H#h L˘~ue|绞GjB*\nb>eadosqR_ }:}'}Q96C\L dI׼\"llWՔ#D"Zs~ZLU;y(*)?n#̕ 1w.N]Yg'h4!No>椧N:c }Un=lijKH${ԣ~:BG_}meRlB<;"66#_C 1ZWX󇷼wbH$GS"y+y$NRS2Kl"j"=kQaQң&RBI&I6#p8G#_H(Ɇn nxTcW^J=ɩ81N92 ˠ0fP}裼$TKվW͢qlvU]+yV2użW?/yUQ}Zu(  l$/KKHJБ~H}[7/s^S #I]&XppȸɓHLĭ g7ikLVNw5Fbɹ|2~;T)]bQSb/%/)>$Ϸ?gđ0u4EeP206`,w;9&*$Pϸ3ι h1 mQDV} =]d~/%מ_%S>Q4eڣVZf H"ОKukTytoW";ګgGyTʨ m[Iڋǵm֛ۡfX&C*>fscTI臷0 >if:~E|;wϡ̟E>h;{so8UO+oñ<|@iTUПT"!7i٬2p$9y*U>ўaƍCٳgFӷ3qFԮ]݃#-526ZX[CHw¨DJ0H:!!̃4?)!)Sպl'L ї1) Ec#p8G#v( W'88 nN;s)aoyIg sɗ󞒝Jْ+? ~1\7)IIH?ܛs6h{-,L6s ?U` o@aPZ{O*5* @[goGJg_E VI,r'1ft]۱l2~_;uaK9Asg=F]P%D `Y;3hNpc uׁߞzk&uAaf~#չ'J?I.ׁ1ɖ[m]m6m9 6OqǬ^kpc ]kM¾=+Zsun 7NN\ѿ~g 8eUQbB"v.ىMs6MB Y w0cN쀭bAp63ў2!LNHDƌٽk+S$'W8^Ha``={H$ P x{{HW^Ev0eTVM ȿI",Zk֬5O^z}NƩ{k r$RBINi~ltliji$Siē'D:(C%OXԑq(kԜY ] VHR"lc5W_=zň@JIl}FˆTbȊk Ki=U8TpPLCV#@DdzݳwFV&o#YY7@Ů8z+F%Pw67*nucr(j (v-Py|em(G 4}wϿ^QVZP  IqL> 3%ya '(;gFwU1qDfQGB߇Cf"?ɢ?Y|寧ϟ|&'c.8˾GMPXoR+ p,H(l kI'?hUY^ If}e˖֭[֧瞞Xl=ݹsgt uԑ{y3ڵO>O?QFSN֖?s- 2?sMã#H%t"!H#H󉜒I"dG0!IvDP)P@T#p8G# DZ}xq+X=k+t. ŵBQ O3e]Jj ?Y 2 Ma"b<^~Kb͋ Zf6w(/l3:VFA;_.KRӘ} fl=[J"Cv,۬b)ƃ`WN].&4('Vo^N_:~ SzLa#19I!@~TJRsY왴*s0țo"Pr<񷌈U0cs=K+[u~z ϶>cO>g[PŢ.yC|:͋ l!ןlOP:"8q~rGh|еrW(W.C~{ #lMMZQ4[0p@ȇـ()唤=x^kS%h0 ¹#rl}Υ;:02F6 'ڲ4=w8<[pc{c'Y'< ?e'#LyF-rU^hYs|{mf׿mBv'pɪŢ?BoҲYsE !7㓵>>ǎ;#ف4HMXӤ$\zgΜӧY+++t=z@5L? L(G@4`ITNI&Y>eUSK3= Lh&H2QNG#p8@dg ʡܲ|ƮDFRUeTjU -֎2 ]^Q#r.dzx(t θ!@$Td-I [6?Chkv(s1?{NdOMLev?bc`QeAkwr ] ʯ{Ϲ lqKI"Ccf]{EJg,-{ĔSr @ 36`hӧ &m2~]Ĵ_h͘'G@yg= mGtSD)ٹ$t7 gH'ɟIŮ*ҊV=
ۼQ6hdYdfڗ70REtS(`'ğ{ahEh~|2vفyC,TѢGSlz,rZ9?zᰫf? fYoJX(%9\O!7i٬"Z SNEXXXqAFԸu444Pzu"}ԬYKf%007oddzvbbbX?3ڴiF)ŋ,E4H4&ϳO£4]6IH%pDOo8G#p8@FQ^˙ clCa(UJ) .o M Fyy%_zȀHY1__mW ?6ƖyBPb`;ؒ cbrKyTFaXֵeF1 x#>\|& 9b8P@uQ0/t 6%lJi+W02ǽ{@@PT)F(S lmmaii"EwX;Pccc~x{b,lGGGԪU kfz)Qұeta&ϥM fp8G#B 6'l!1BҒ6V051LLX -=-hh!%1dxiC;>D#m8><!dF^ HX]r89E+ۘbS( BG~DqM:f:0u̟ʙ1Oз҇tu54Ad]?6&")2 qq~'#Ҩ#.v(XL0 RI u\w~k;J@",X~@IDATn9{BoqῩ@\L&u[oahکiDx۹#!.gT[b.]NDEbrɸ{.&}Ts8y@V{&m:>m<ҜZjK7GJ<5G+L#_AJL 4t5\=tyA@2miΣH:;o\pڜ'Cm2G)E!s^ Ip5kbF^+-B6 f?eWѫGp,[lD,*\F(R":e'C ? ]_V} <$CEXl";~/ïE*QJV017aut@p(@bB"@$a CP ě'ok2ٔA底Q^8tU1Rg(BBRrj+xM6ɗ(|$Hڻ:}cbRĄ`q047392A,K[ڄق\м`h &HLQ}GTPBr`XeE*r5Xx J5(ŰSaɛ7o@$FZP!:T"S F2o/+!H Yæ {JɮnZ\㶆3 kR.br@,T4}OIG餏ь3]/Um!æ(nQ I,'Bɓ@2vX^\UMw @Vg}q*Zl)ɹFp,>kUxVq9f# + o?\uŎrs8#@?S\qwAR\@^ :irTfKۈ<X2ݣEHD$"8Q$:+w![ړCa[Uv79XEنF@Uî\('P~U$')SP"ۡl|}s,8GSBx$>64%Eb(Z(~j0A2Ņ/+>@d-k/͖A~:2Be’^1c$O"a_Ξ-U"'~мߙyBaPgiI4YO {q,,^;ktǗ!$9>Y￦&s}J6BQGXBQKQI Ppa#ȟ4.:ll@,%9O{%*\ˆ7CI!h&RIV4'z*9G#p8y9+TY%%RMiQq$5):lъBZIfhl+Z@u=GeGVP%E$E#=?˼J#|h=+!(k}c,YG\O 僗Xvrj5Z-FѭGf,IȖ[DXxed?X1a/ڎ.#`̢1 <bйZ*f SsSqvKPSh f[n?@[s'dɑ5a)&|L@J|ZEutΣm͢1^C[#k5\P?>j[Fj UPbE2ܕ7Ew/ r*wr߼iPA&މ'BP3lp&oyB `>'d>8(#$'%g OM~o_H^T>jArB---7(܆FRY]"|/EAѻ!sAlESy^x꭪COJ&i[y:WQy"{CHe]ʲ#k,9ځ院?ـLLXtϊ|.*Мy葡 {O>~\Y444ϟ~~= ҒY.SG# hci+B¢ %,I'"f̓|MhB)DzN@DB!B OG#p8UD@[W%o$G^&jߎ~(a}"yfqc, I/9#Bpws qơe*i N7O`FW7dv4T_Ek0$M26G꾒6M-D 1tP]'G@靧qj)y%-QO]Q VVPhJJ"(r5^Z a$PdX$M[czXbˋ!!g?e/(TP^46/œ;Of4@~CAJ"~]*k# | ێئcRK1H^-EOW}@*hLO"XRgb7 D?vO#ڶ0_jg*FEbq̆1k\#\Kb1I9W(1NQaak\[$|R Ikp8 @6ZeAS('pBOB$|_'&dꛖVz)DJ4ɎxBL~nd!?p8G#PC{ F.탶#i0n nLV#UZE|5S(*6Em׮֭yœxq~J+G3'⑞KJwSb_ih'/s$c+G44AUʊCp.WcB ́ ,@v*38El<i/s~լs3Lg* )LaV>ޚ#l3ܝu i&6aɫf}Ud6u¯*0o=BJU,%|T i2vRIII8z(VoZ 3^$ּ[s1 5Suб@DM+Ϯ=aI !7Bp9hkLh#E"hja1,2 G}1HXΛFy+!w G#L%$P= ,zI:DbHIēǷA%F2IjBNG<[dz{p8G@ۻ.,JZ`mXPk/:ꈏ2dl#OIIANϞ=|zN@h 0w\46MPUTO+&*SzLs0ewVq~MuVІڮAGh 'q"}LG!Brc ڋ#\j @/3΀:z:pi8NZZi&AoyTwg{7LǾ,Zw͏E}VJy&9%ǖ@WOWDI[0k, y2ݛ xh,fe'Aߐ{zW>޾}Ν; 0{l4lې!ES<  ww"ŭCb;Hpw(@ 7lBlsΜޙ;9*tBI1i$dL+v:C#jl^;Y ݬι;Pf9pNl7mՆz{a h42!jxs$ӧǜ9snٮB@#$JHՠM#> L|%ZhE'2޽}ocF&0! B@!`f@C}0d7׶G)bّPBz /z?еkW:tވ7neڠbbざZT:"u ϟ<,YV  D|4ChԽLyF.VBɽ)|(_BKkjQrTT좕"Ztnl&mշ!ms^SnKm~FP~9C5훷aT**}g(۾ƘnGJaD],{t(Aeq"Hsu.\ܹsȐ!uƍߤJ7sw)?zs`шݔGw .۾"ϐ<` b)AXa"dI:Eљ珯:kiY1K=ƒŰw1^!`<7a\Ub52k _k XN>.2p>_&YQ#?''c9kB@! $?M|3kĘcl~3䪑˚u@‚ ={HU5UecҤI`9rGm/P+7{cPoPZeMؽf74Yb8A0i9"RHG?&FeлNo~w?5sG%k߲_FeԳ0ڴlxхG(1@ g63xF58F ˶BV EEUBa ʯ!" 7te| qYV! N)`M>EO$Dg5s2O=ވ#IO"Go2!B@! Dt:n숥bF<2*(/Gq#Ȋ]vӧj׮ 34E*p=L1 9 4bHc5d39q3y?F0gzeD[Ŧ/ؼx3c᱅A~.5B@|0eϞn^gk Ý&lڻ)I>B՗/^]Uqk!j!\mЎCZ6\6Qãmmݻw806ylŽ;[TP˗/GŊ%췶mł1 04Gv"`Y~sMlNɜPH5+XxUp |&pB|"㉤O&B@!`lRor=B[nټfC^̇Np"4ܹիTR6lm>88zEkZG-1:oޛ{jol[ W}خI^+Uf_:5נN:Kgq4kgݦ!@mD#O?Efp%I4i"6bC pJ鄲k!89WStȟAʘc'A4h} E:ջ Nڳnzꅒ5JbмA)خYvBL9M 7,n>@|Ys~z](n6G'>"̸nh"t :ha޿}#Ĩ$L-Hr.e뇬ǺPd)9{ODbt^S%B7eCl`:88 UTv획!! KOՏxohXNTF pBN\RS^xoEQF9&5?ZXEB@! m(֮Xk]x4~\#⦌k5`Js/ݫwv+%qvv… ALZ>}9t"`!Q2+gW^xwM1.~P9svGܙ}/!O>՘cPJq/ Pmջ/[lh5$Ld-sm{ϱFDvʫ[:i)<yعr'lbڬzL 0uT̐ȻB۶e h4UF}IlSCK7<}rToSSd~x6/2uʄeKNON?~EgE&1 08haqR_f| ˕;rRXb-.YM> "B@(xb]RC/^poǣ΄:`v5K$DBϿ[.iB@v?~>ϟu!cƌ^ҵgr ƬHV&{%F8G?.r0F.B&L 1ݺB<#<{LE߹b'6yL9 @mPz Èxm#X"j yʻ*#zAIoߝ6tElµ4Lba=kodɤ%J srO_ګ7(6g2捚CۢkKӶE 7? l_[lUUv[2ocOF}?peT'Ds̕ W!}~}5&}o~qZgB1Dn_c]-kok{.0o_E/^H-]Oٯ#1Dm],>be9?g蟖HV^mB@`IC%.#-8N8SÅc)_ꨎQ 80ۉtX1%?2!BdFfjpX6Ppgg5D8$(M\{( +Wrh! >*TGjgѽZwDMtMMS/_GZpn^e^0{WNܺt+2k4$0f[nr &m5bhs'] rp`V. f;߆ WڷoNj {l Gu?VsᎩSUf> y64𱟠DN“?玜[ͫ7V-z4-:Q@2H]dB! 9\ i>DEu4vmh#3N3RJH"U0x̀p}xct^h=ҿ%woEZpu\6jLsз^_/ǬUf1*ưÔϽ?D3Lc\U@I=I#f p![s t6\?oI #GS<#ågd$p T$Yúpt{$k κ}k䨑1`"T34=|ߣ~PgVjZ ]v5j+T2ExdMGصjy"`ق??PLY{0m>Zj"ȟ?i"{ۯ۰Z$ˑ \8s⠯@  :ܣF<SOEbm]kw೟6^" bǎׯbB@!`8#F/ÈogO'&Dg3fGz,:Hw7_+KbteӕcQ9?HWտI+@x7y+3͚S‘,yH40D8$f՝,e█\b[q;m)}3]M{7zT5Ka߱e0 -#c Lm,2#'P3fo<0bČaM`ʔ)ڵ+/ "^<qm,h7DAQgY%K?`F#SL9K𭌙1PoX^eF)D30!TR $j+B@&K,Hm`hK &~b߈-t<ƿnLαAAjBQC%JƓѢ~ ! B 4reRQiQG!]taln.m86ТeƌA3{Jo*5 Fm9h&܆B ʩY0{ԁµr1,]U5t3oX>u[Kވ0G ! qc)SQC k?.;&o]CEPj}qx3Hvm\7d͗ VgƭTF-ʶ/sN\\r*{y&,@Nu؟$Vn?#k H"x8 W(,b%+Յ=-Z5k0`r~ ~-ymĖQ[ :$K6C(xDؼx3uoCsXq|8k,4FteUM ԩSK%YB@!lQFAd U JL;行Z[vtrTYNK'q2P&B@W2`߷n_4FƕB^YpZl=GXmɵsTF :lWfi~_~8To]ͱK=zbhˡ*H^7d/.9ѫVc|_ۻe<_PZ Ȕ~^x#k|>ʀ:tfm%-5߽.K{nTY]EK6=woޅk}WSFQ kJ/#E[="mk礞Eʗm3A 7H}q/BOzĞ{p3f-V:<% RYF:{A`0;wXbM@"[ncjx" n s >c0[čQ\0A6:yH!ضt yG:Cs!L2%BFYB@! Œ_vnS<6:qia? 2/HQ" Nf7$<8AB@! # iL5]EGdzcbHh}3\ Y+i[%]>{zl.GϷv=}kF(Nl%/خcj*TnVod4[[naXa8y GۡmQ2l:ǑطqziT'׌m@hצ#1 cΌ([, ;[l 6gafuF azJ 4& YC˼Xxl,#ۏD^=XTO\Dj1kk02 '{7۫)35Wh+XdGF%km_~AJ0gč+Y?_ֲw_C ![l輥3⤈czLB۷6ƐC/Q}5իW1}tj*exiH ܸxSeL-0BA_,ihB=3"UTW4 HRH{իW5꧷$! B@((y"UN|>|%|E{歿UGݟK'g' ! BW-c]7j\rnT8ZpZ6MM:Om$`:+~p6;+=KT`p };܆k3v@$n \9}EepZkf}!RV e1kr}yj$؆5 ˺HT:s߲_FN;7 ]t(V W(gCJ`XnRN69sHW)-#lgȹغt+&nhĘNcz`k% AS]b9>;v61{|X2a vk:M$K}T r֕[;O<=Hevd7o`͛'OD4i`n9e?-kQk)Tt(%ȩso`8iQRgNMw&#d10ad頀K.eZ! B P{_E&Z\&=3Wy?+#E?3|Jx#FB@! E Yd` =&+sROFLx1셳cΒ9p~ Hw p"~V^ >t2}˜p#@NGYwld͗5l =7"w3u'⟯xzѹtRdΓYL%m bY`_fʕ G=.˲]Y >8#4g|WtO9KόM .pkߏ! ~s:Nԭl`|}fۃ)خHmt[v)`(>:PlYf~0p΍;٥QnpC6j._] F7{+'sG e3EB'[Š!"}.ÇѢE udȑܹ ) u|zi%H=GI͓p(iϦɷHcvftF85Gڥ;yTe0p`r~J0یv+lC:ńGF&<_˜UcLREJ*Jm$޼N:)9Mݫu׏G4\lafm#awhDD.`>1<zm8rBR}drl6\?b s#=z~a(^8V^-YG¼B?gk6kZL1 yF G*eɗO,FL g|XۿQP ;uT)'+_@$Ń@b1B@! A&1HjP~>|_xP| RX߽}oN.NJLXKԸoCyѝL! 'PrQ,:HETl kv˔R% N8̹3wvL[i7sB&livю3`p#YPZp"D#QG)GkF:Xqc}bimd]Fh7 zad6!`- s2rxa0 UsfD ӯ?!W\=6)'{,LVO6L@Ph{=t fWz#G^յ㘕c`Y\M3eųq4ֹCsѢi7[™ >"¹#Eee-U"s?Þ5<<<УGuƍ!0##,ed;Al t K0cmho1X|R (ERBb <#3%f, NHV)5 H؞I֭[k#B@!Zf9n¸e|xė(D&v(Lk3zߪDOP%slg9GP&B@'0YBL9nC0xm€9|~6b$SO^xݫvWޡC ysʌ)BH _"@cḅW2&n(_3J_-鲧s5_pJ6tbo*VZK=z(K~#Btf:5yJAY:T st| 40/oٓgJg66v ?~w0p˱=Tfv?m45Ōޅb_x}Gv=Ǖslɐt~4D]cIW@.]panÇGرͷ]#QFQ:Rt2Uѝ/S,{[Wo)qPͶ5mv2H%K&Hx' ! BKeQY;(/ Nf;a6geJhGO6CDYLt/>)<.Rd\C&B@ je `@As` ,iE5?C1mX*–%[аkCkk{cH!W,oF?0cضl_z4j. ::w S]*DžB .+3 ЉFx(9FL.r˭r ť!ḭh"8m?<rdp#ݫuWI5 ĥlЖC̴C ka3:N;9Č]3?I|{a=a`ľx9$^[1(#IR%{V@\v Xx1/G"gΜF <@emoʗyݡ6;EK>Gx~zeyȒ7~"ߙl~-Ƭ h&xQ@"HlsV ! B 8pkPe'_?{0w5)'z) "B(N,RHU醪۸n\l 64i`I&B}>k.L:P ߲_}/&me ~Q0^fPD9(LCێGc\q`N:{ޮn?۹.Z h%Hc5#{'Nys˅:(8c'ɦMGN#ڍW@~ѴwSCC5@IDATe0P4h;|3=g*# Ou0]tH"䫦hjrCeN0]g #4 {6!yw3SC:x^u3 N[ FxHH̩M.1V&?:nnnH:5V\jժ&eHֵ[ふk9fpDPcs+uˆE ci,ה^޺]3cjӧOmbB@! `xf#< &Rxr{*rkUe7aVLD ObƊ)7XʄB@3U?GvCT!#i[ HsڥbVعr'Sz#O'4y|F+,|Oh% ("Y B@!YW^9n>-@ T4FyA[ѐ!gS H.fۚٮT#>y(F S`UjFC۩. n# ?My)掘E(y#D.&& @鳧ǴӐ&\L]9xƯґ*kTVs*=!<>}0|,tr W-ɯŒ07,TXWfiV^q]aﺽ>P@Zh돮U"k>L)[_ziW._nHb e)ޅ*'vsXoV2+1sL^Ec-q35OEd`sbӄ}i&#:?zgřg@ATDH%:TjRI :bĈJ-FGD'qFݾD˵[ђIK0oia$wxd]W}9vڍ be'5C[UQ#G=y[cܺqW2_h!z)~rsCR;b.O[O.FL4wn!‘o̒1c C R*s*"[naXboߎ1caÆhժe5ODӧ*xݺux"RHz~H=~m +`ђmv^o[ kתgVY dň%#Pz X_9V$JHm? ! B@! I/@YI5qQe4&Ã<-EkRxp>E'6YH! MY )?DmTքN;u4"QD`- u>JFڽϨBtf,fIڛCZ+ߏxFVq{yhپd0qe0F `ہmȝOsF[wbFűVo|qQy]O<s1yd<}6C^?A2I+7sqkopx`7Ȑ)Ȃ?Eِ#WĉG !.W`2q)fOB:%JP޺Z|``ρ?k> aZu׳i& ^ªmPp+`f6c8} #;Nlko sud FY%#)8tۇ{… =:J.ZjMςcׯqY?~Gq)0A̙UFf)\tH)Kۃ^~xR5ݷd6*U$ǿt? N; 䄪b[ TA!~{` |cȑm%K!p _ߏ! B@  &:x)B@RPnYCFas_H)%9ͺrU BۆZ+:'\#%hfBŊ1uT4tɓ'1|p,_3fĈ#PJpI687o`ٲe;v,;2e}]?% &L3~vн{w$H6aGٳgtr3q9\|^R6RB,Y5kVJGqTAZdL3ܚ5kj*u&K uEӦMiLŪxӧOWۑ#Gƴi?h3+QF_/^0K;s ,Y~o߾y؏gOOOQ}ʕ5eкukU=jԨ_(߇Sׯ_WXh &bF)B@|f1'NPG9 ޻R4>,ň9r@y~!t m֣G)RHoqO GG5Fx=^^^~"q(_z0& ɐ!7n^ΘmU" *NYB@! LESDJD  (z{1r'0jDL,3p.^AB@ '`B XZe5RfH6ǭuGq}Yo"m+h^9J.nClHmgF>}u ԩRB}eyf̙}E5$Zm7l茘HÿKSϞ=+WP5oooL2rر#(+lliHg+W(--tH6Jqe#! –۷k5^ݻw)STQW"EւCڵkJdO=#bO֭Y77n… u1yO@L#Fӆ `N<_5h͚5E^x#={sNAB$:CS_vmO1}tN~̪Ÿ4B-<4SJB@8FnI&hַMϖWRe ϕ'#}uZxpo$`궩H3E$_&Ȉ^۷ppqqep!#,X'OVN.|B6fb,m۶M9^Z 7o:Hfcuy /^'_`ի'YHO PsvN6t^ջwjmJWNBBZC)|صkr`**(\(b^m۶E-tˌ6mH" ڪUpƤ`Na,R,AAKʕ`>:\0KU%2K*DUYuZ0Bq? 3KN]_eʔIq9s+[&&g ̪7o*Gq't g x_C%C{֭[`Y)a_r,þP_Rd)IfxgzWSXŒL+XļJ8dF)=|Dq˗S6op#`5IjT3K" }@! B 灏&لz_%z2|2389;Y\ƅB 7/LWUX6&qeXaŌ4mÝp/);r.no{/_Dm};bŵN$w~7oJNAI1C"Q6lN:mƳؾ-b$=|xl:YijR/훎Zo>u1؇ϟ\ kÝwҁXuaFh(t5<}2Ne9mD)j‘]G0\Hj(4j(;V99uxA萴h"U`\x\n]:JPdpBD5BfQK˔ C%] T#.Dv8c訜j,(SѣGȖdM@;Qx,͛ w} $G ?Nj3s̎;C,*TU kr:Qw^U)ʠ;2e((NB>}O(l>>>꼕+W.?à]pAUޣ={V12c\Μ9 + !ZZ|p,<^n^ FxEv)B@| @H@@t 3fg27=80˒>p1>|y=~ӕӺ9NѣWkYI$Q|ΥkhªI0"iѐܫc^?) <)Xy$|{$>PS4g]Z(?~|?!eΜY]I!,_~X~55t$tZB@! †&?vbDg;W!bq3PP$VΗRA}b 0cDz)B*ʦeM:JG ^ЙNtX9#tȑ"SE`ǏWN}$(ѕZbŊ>bpхZdc>lK8]^\|/6?@89K,|qyp*霨iE^siEF-uR񚋑{%@ XpC-˗3f7'Z0!)"{5zy+$3-N@(䜠iH& Yh(, 1|D! B@M/יD JN,P?D.z"GQv Oc;˃ 2B L e ׯ^f暸{? EW9CcٹRgr(XJM*[, # "2#| %| Сm޽ذaʒM1Z*WWH#u:yzz`?l#J 5>m GԩSXf V^J}IP2e/kC8/P@4:f !|b6 .ʌ jtg͞=t`d 3Xyg@t̝;ghFh;vPB~)Pl(Y<)s\:Y $8&<&x2bJf̘QeBY]C),tb=8iF:B?YU3}#Ys}˱8::*1A;)!Ÿ#qX4R-!!둀KZ0<_pU9 ;0i"7=%E+,z}\_sZn_wҙ}9_Z48wkaX`C-, o+HL ǒQk,KQe^r XM@m6B<Ko" ! B@X$E&xчqD':}oq^BZn^ =&s' -Σ;#}Z}#h[mI&h;| Yaޭ{@`d֗[U٣/^Çf8p ҥKlÐ֭[qF5+U *$N2!l5ɏ6oެ#tS)FZ:W¾۵k:(btc:Q4l#FBȡ.|N Cr(MLB(23(0}u֪Zv>on,PEUr ̴' _jΝ;#GTG9&d$g%p:+V +VTb:sI t|`ǎؾ}rR}f)W|= [ دt>(w:'%:Euh`tх/a/r,+_G&C!`.L ̞`Y9_gC3+(r\t0#8NB )0 [ŬrӶ{1>Gm_[(FgYU;h[ɗi9}w-+ s36+E8,Z, :<.-z$Z$`9hpsOI:{k@!I Q"YAx~ȃ}ơ|٧Ms~L z @$rowȌx;]y}3` ]F6-΀4=^ZZ$3!}m1B^i5C]% .XM@Jpaɓ'Z [2$[(! B@!I|* %:ÉZx_xo}QEW\&Z|)αAC9[o侓JuѴWS%\3'>qD*Wo#t6(bu[Ds YTV{Ì30qD|۬Y3KEd[ ~!:[l*v2ePhGOOO޽[9F TҥK#w_)'@gCs9%KD P|y%,0~KlwީH:z"/KQ=N']. ru*j_! KPs2Keբoct&:S4!o?cjaRpAZ A!)D[t8m}C:ɉR$őJ}VNxЅ3Z$a鰯) HEZC:`R-Ӂ PZ$zZ_ظ=?/`M 帞g9GyӢ>]8!m2 {1!!r#&25}[(,4$lO3Xf8-~繂82pŒ 8VF)M@$z! B@ %8|AxFw':Q@'Zad{^~&/ÜsTij#j4s@ 붥g"m~ٵjzT:DrPN7Mz5A㞍yU{HO-`$"(Ab;3X@E@Q ГBz$~w|o}rno9ksZg~[mAg@7Ht?s‡?H'_=؍`bYf/`C*;b<#Z!aG}-$UDqƾ:#HP+[qgϞUzUk!1c Z ZjɠE/s9;}IQdQkC"p ."kEgK(Bg6" ȡWoRV{4bZ#*uI{BcMVLG&l{eD &X &Fj!xg/(s?2>DN A㙯yO]! a.cJ/|$wfI eiCltPs[)+ 'Orl)ku*8||YcYgl:]A! D|0VU=Y#k̀-/ui{gߑ4~4+P_6}2;(jMPZ냄"Pևe=0 Xż4yƩ7Xw]b<6R-1**;;5,Jt7N;. i /vGpGp ۷mo$۽DjkK;jQp"Qv7aW4>j.]~ˎ@"گ^~FaٹN}uG_ !jݹ0`ЀV wY#ؾ#S_ ?$/p-į^tE⏪5,"{+̞=;~-QGU"@>~@rCs}ň}zQle5Bsȟij$I\p)TDQ,*(y|]у#tŋ#I+Z7 c& &MQ>}_':~V D,sr|Hg>qveq@D_sAmNL>hHlO~Wה);"Xg1$<ʳw"c?v\1Hcmd\6KN΀9:ڨ:H  J`}w;yy3Q!bi͓/K]XV7ynoh郼Yʈpy|)?ۭ|l&g50 0&; [l^]nSD=t,j& x| ڱүpIC'tGpGp:qu šlg(4iBxe_ݷw$&N&E? ["w7TWZ*\ \}Kp ykJ~jeop;8]uѼEO8ov-{Qu-W>͏_Z&:߮o;<裁.pǏ3o+įG AZ?`!A x ?̝;7^ #iӜ8>TY! ѧ9v!Bx衇ƹwGǹǏ#1"P4RbZ":Iqx  H|ZɃ 8uae!5cD> o9–$Q/H?+F —sdyGy]g4=Fp~[Jb ƶ}Nii Y>r>@dF/G )گ&#ܗ4+Gq3(5RcJ$YEd]~赙$ TSkYD[X'4Fش|^#6`(_6/2o*]Nx֯_ئ|Duԇ<<'1N:N˔vƔ渵X(qaJY i}o A%N12GT@>я/9. wGpGp7w7)'< eú_P!~>(6I'S׿R/C#H⻗~7p嚿|ÍW} ~.uZ+caS 3?}ٰr- [6m-v`٫gէWݧwiCÈ1#ˆ#q#ä)'LuK]~Ïc[GM>c|lj_~Yg.Wfu >"ʑ#/iBCpG{a:fq8|x衇c=?,B#3?Dv!կ}ڕBa]dZ%B<,XʚVAވ^~w@ oI/>f+.6vE{H|y'Jpm܏/(YE>GS4+KwvgkK0M D!DURX6ʻw #Ric͖>Ʈ涵vWSOu3^KqUj3TfU<ӶCq]a7a.UrRDv6۴%Yo;m@M$p@x[.Ҷ?WD$SGpGpG`mݶSpRDLvBYbCeqf"!O uӷOpwG< wtg8'bO|}ر}G!q"i3o4oμ=3vK5aT>jx>zx6jX ٻgްK6W疇,u-Q sSWM':)x^֓>^xzь;zCO}/=W򕱯&Osm_.׼ChD<0 kLvgbM<_BH)E|(D|k!zp΋"[kyQz/ُ3&`!y@U?4/o@V)%#[k\k˦5QB#YD!y+3Z'P;Ri嗳i]V3r=zF0V>B JSc.-:yK-#HLָj[_yX뫎SY['oQ9.GKg{OhZ+LGQzzƘȻ,Sw~Վ@!PS [C׿zƀzs#8#8#!_W%d퍮O>aaIAh" Ptu~7ôç>w^on Q@>X?]|Ձ-lӆMagn+GN_zL{BM;,xbAxǢH;4:uQ߀~6 29399'v⛭z@;<O?(9]w.[I. FHC`GiӦ\h UC,AAϜ9s`Q_0aB8C{Q+Z3vAcZZqava AdE!Ukɻȯ"dW^et:"3/҈Sf j/{|%D5 "$P:<ɓ-E漐lWɓo-~^h^~!9瞔/C<)5~|3y8fdݴ0Ҵy MY~Q=ֱ}(!@&_e-1k)b "*ߖ5g˛+Ш/~n!Q|կ{u}t~m߶= A8C|O=O?1uY54DG'Mw1)#@h(6M2B)a*B+cR!1@"ҽH[ȚdI'nO3kG"}/R;}N=+y'yV؀k]IDpSS4;8/c 4b KxLk_ ̵xXk} B=wRfdҊҲBP[g,Ge״g$eNI$"<0OL9Hy6Y߶Jٌ0.%Hyi*-%6d SpJSZ'S#OZ{gSQ-W4]s)Ξ{ƞؼ4_udmdmY%c;];*]l= 53=/>x6'K'Znj2xgϋO+)r8#"[Wԙgr7VxWߗ#8#8#6BPHy+32^ɺօ_2- O(}zmy@M̻>n8D$w3輛7n7o$,yfI:cj8ݧ׼5QŠ+m?-zaÞ׽ugmrQ@hѢ,\ƍ x;»0u6^O *&"?,NXɓ'=)^ "BQ'x"ZQYʾ"x`Pڱ{bܹssG?~$C6cHcxd)}`STb"$4@ W!iRi~8HYGD\df^˲mD0@K-EzΨEjW˪U , <'DfY]%իW$:C- ?x%ͳ < `26 oAD@׵H,>r]#Q,~^Z-U{HJ܃|k/Ag1jLk(_鼵{6|jk|P"_OӶTV_5AkW94,~SXK~rk󩟊J]YG5R,lyyZ=RV ƣƩiZurVT:%`)j~˒/?iN4C}#8GtQ*NR>***_e5DqVeXu1]S厀# H%Kw-*?pIw߀#8#8# Fh$lژw@H;X(Qx2`dxt|q͋qD?;\+ˊH6!uCزiKx{O.tggA yGxo zjk(/h g}v8<sTFp$@B|A]"|HbZ zbD0B#~#G^NmiqOG;hҿjs9H6EXmȅDaV^Oټ# ڹMK"M3V=8@G=눈WHͲ=i&BHyfAк>[\=%RBYC}0xN2 Ad&ׄB[ 0$ѳZ!lMȵ^i)!L6[f}[suI:W{:G͝w4R]Ciy21Q2&EmJl罛v0a|-ٴU)1[sGB kϽV~5k W/ ^8FnAnAt<楙OjҪj{XE[*˸ml%kHh 3<w` E6 (p>z~w}y͛W `-[o;qʔ)1";vl}?{X$ss=n1?x„ awd Ad!ʗeBLHV^E~ŷT8 Eӎ@C«֔cR~K-pG H>񏇿a֬YuR\@I;opGpGp$7mlbw;~"6ΎCrVeU4uU_v˲T{Xk\*Reއx0gD7VݖXU|\K1,!3t:_!%i+Dz<8@CiZuFQJ[E»+֪:)GߊNHX~qyg<"vWaIf'r3q NVXrɖ*Cm`\MӶZ(Z@Q$Qy;c-qꐠEfWS: ,i4yHsa;(-)65?#XK*Ow^jC@[;vSmyu츶Cg:~IS֗_cSz?ul7'vcy.W;gxjY1J:8#8"PSɗ <+!~#8#8#׼M O6o={lv3)%<4lP񫊍D 8ieasYGhޢea5v~{ݻ~{^_8錓^wl_~{wɑp@x̙3;e-_< dء8wb:B@U`w(0aBĥ=!D9XX@$/~|4iRD"CmDYr%Vzא Aڃ%{ذaaԨQaܸq!+Er#y`=( 5Ɩ.!G д*6-;@JIA ȓP?Gxs"AcgH zUrMkD Ub%um| ˜ZƕҖ@Wܒqϫ[x*Uw*i:Vy&øQM$m49Gw;!V ac}$p f+ OdXvڰyNKُmٱYd_uJj+%w(k#~5Ѷq Mճ-O?c θMmZV.m|Yk}myxpCi)l~~FSiGpGT@=|k_ k#~#8#8#6Hˉ' OZ V`bw7?xvֲ}~d[xe}pG. 7lߺ[aګ4/\r%a>nZ1zD=ww}w 3gN$s1SN >38O>x?rک]EE&@~< !YxqݚHD>{GL81F"!&8Zt<}yjE!K \p>  $" XѻGགNٚ6OeyV 9Y,1,yVl<5X%k}ޙ#e0\"a媿\^m`= ~8c<#۹2dDž *إ"h."KPhdN(jF_B*eg%KF!CP2dH9D#+B’EQ78[\Jn* 9V$k|!׬YVXH X5@RohYD7u<8@#+?6Wβr5rkN%FR_i)$< C }B֊:hO=}{!}Ƹ v3 ❈ 9(qAcLq0{PG"Y 9hxGK#W-iC˪4]*-}&~*jlh]ƶ%j~9vt_08f\3Z;uJ|Ӻ!d~iM(emIH+z.U7|EH_t1c+ͣ Օy|淇Dq\LlO{*MAʚki1k c\/UG<#[~̟Ie?pGp:5\{Ϗ h7Ӷm9#8#8#ZM*lUs]I> Mv4Ax" e? ,sn>zxW:maUc {tWyUwʺօoW2t-z6mTVFe䮻 _#pر'pB;rCH"$vȂ{dT HC@BxlٲcS~1ccL%c?@k"M+/~Z4X # ,m:A,,пD;Xq Bd DYk*1 ⤎r{#ЀTYg*V岔Yt/H۴|Y:bw ,*CbYϵ+i.c/r >sοy:r`_$@,hG=$@!aСCx)N>kmߜr?zJk"i1Q!㒀%OVc4beX޹{UaW.+[ѮwVD6xhcK}$y4Vyeͳ~z>KQyjsQ)\)5Sh۩6OeRYSc=v祕_LֳunI絥<%A4wR~^kyOVs}GpGp H~3(*) LrvH˿υ+/^|ճԡr%SҠ+a)w7}kAaPf@կ~`srIQe1E3Le'Or֖q/S˺<ǦҐEnZ-療,gȺ+_8+kVA!!$DEDޯP¼%2.rYS>&|Dȧ]"XY klZ7n꫟y[=k\ɯZJ[[繭h4פ{xՇ:mߴ_.pMyyZ “!<5ORk˅yZi'[C^T㜱n{u)nZߦ#ɯ5f^<ոO-s\^r{cʕS"j"_cY'd۷]pW/ʽ_>a#s$1=ܢ`dΜ9)S`䨣vJm4|d C$yQZqxh@|WZ#|YX6%GȗU1C>d4yv>ib9b!DA 7䗲~Z2mI(tiE@%b@_B"!ȃ#Qtl "+ .gzyi;wJa1ye#kJgP.+Fʷ|aIB(,\,Y.s?!ٺG9uUO֖/u<:i۔7k9˕iWc8qyy*Ö+OtKUm^-MjӺk46PVZgK}ֵ<|E]<=8#8#8] H~_7MCE$]GpGpGpZHk_E'l"(_y[77tﾽÐCv9v6IE'1m T$] +{v/m){G6sZ&C[?.0󤙦][å4|C^}HWG~{obbanQ(.##Fj5!wh DowoN0ߕ k׮ EEd!ȑ#cd"i6!/cD" [_yl55D(/braݺuQDKT ,[?HBACwD9k=JLZb<ےr ]I/q)|4;"|+"0kJ)2sO^5irM{aZ에EOZAe]Ǧ>$D"")Z-W;<:@ ;_\)GƔi,eJcҶHSW:\:}W6۲ǘkWyuUqͫvzxΒUT>mMczuXE֐4esi^0>Qu-oؑqG7Ma\k_:Ma:m'3ۯ=,(tQ"R2 ,_Q0Da`̘1P3`n ,eD? H.S%%AƂD-VA_  KRӼ4mpO98߶ﭿ~]aÆ$8M}7]`Y0QRryx֖T8S9mA^&x ϳğС(/y> E̹/sX 8:FkNBķyZ\lԕGkVgVZ89m#LyXʧR_msn&e)%jje-yy7yWij<˳|oԱeJY+2*yDҲ|Y'KiC} |&X9nW򰩯Ԋ,M}Ҵot~k˕s*׽rՖ͓Z&Ri͑Q:JQk]/)WKm:cf/URe:zҊ:FuJYJS XʳV(ϒ|7Π|iZkVb#ԕPUyXΣ||{QwGpGpGpGp#PS #q#8#8#8#8@򅸛Ȏ _`GrDr!O>yv 7g^xߧW:rhx^$o8C֯};u5j8`hmVʚdu_6-_\TO#?ؼ<{LS$(ZWWBvdg*cێH]5Z!\Oj Ǔ޾-vcp:p^\in"kR:B_ o N_A`&}ŒfN=*\w?p_ #ƌ_WN~W* dHx97Nj?B?|vxb! z wm+m] $"؀t(|E}iyȪm(n; lWaI2ձ\(BGEүQX^/NkT'nA;E76jey/g;/drgUb11[q6c-7T9ƶQ3'e9kUVՠ7q÷n#Ǎ =󵱑|#^.e.gdՒU;.=zpX?f3;Nꦫn _WbS~Ϳ2G^:kK~}Lj/%\ū?]Z:fpK'<8#8#8#8#8#8#8-D$-wGpGp# !Bdj4Vy"H̐W! dm"GEDh~A@a^h8  ;V:@bX-K׵Gc I?I-Cbn݊n yeyY=7e~݊u1YnzPNԧ]lVcG~jPW(+fG 򣟍vʏ㌝=؍B'lr_={{ =zz =zfwf4udQ^}zPtV?gXqN"ս{&b0s7ح6fM~3,}iƱW?UG* kesB̳X?cYRWym4sqw2ΰ1mݲFoټ%+}yuh7oo oP(x8uGVP_`3L2){~]<5m^#d9uXlhY83. 7wƲZ穇 ܨYo=1kׇ\aXhyz$j5wi3GpGpGpGpGpGpGpZ ި#8#8#z,],rҹ!>!B%ݺ5#b̧LYE$gmsE<;R.SHPA>$b"#׳P" HPFgQWlLl|H"xvҐe-2EƖEY={FEk+\Wf(1E])+ןze٦ ¦yrŬ^6oK>iDDِ!קQDdѻo߷Oq% 1xẄ́V_q _' K|s|sYOZͱqesx|s-m͛i]!9odĹ͓Y8yiT_ul9S2dsol',/mW|vU;egcw^XFK[4Y;~C;0?>Oca 3~0|_>xK;`pgĸb"ʆu1_cpGpGpGpGpGpGpG!'~E#8#8mX)Yy"2/\Rcl: 0ԋl0 j:⋢ ;Ewm0 *Dr3m%~&ZcyAaEqL!]v9GᜍΛGNQ^AȁhC`ʊ׭o W n|+i`O>;  iHCi=h@ quH@IDAT Hˏocdϯ-̠v+?Zn.q{'_s!\.g5B;ڏNpLSyiw7W9#hes)" \ 3q~<|pǘbꪎD"<^|Űfbъ7e iĘ14;2,]4\?ŵex~q4U Hs!SO}+ op#7UoV;{t^+VtvG6Rɞ{-]WrGpGpGpGpGpGpG( HJB#8#8EHD,1JH-aƖcXF,qE3w@Qd#FMD H3 vs'(t(Ak#A2uόhm-m:-SY =ld΅~t,DpeK^!]vبaa>w`0 Ѡ84/0h9⺓-E[(cuϯk$؈kֻM &T"x4r;ٍdQD%։sm֎|[ۅ+[̛87';|a~ u4gP1Y(=tg(/ڬNli~E!H&a U֬Z>4,Y$ \f9ƦݼiNF<-Q\Q(F%9w 2vgdow`'#9# ZBV_'!ϊ<-nD6zuEs{ڏk- ֽhO"3»Y !D@ge#C>Z4袰FXu]E6ȗMf-u@R,b=,⏗_81ǀb>B c^#@ rY["6h2va̤17}Gk@K8|oN?8%mr,7]B2{x򁯄?/\ byaâx]ڶXnw.}3OcP {7?pz|7Aބ#8#8#8#8#8#8#8@ :$DGpG BČBAC(||}-p@JT͙@dKB:TDQ-1D# x&c (ȭVHD/݋,]$b}$m,D4qsIֆtq1Ἢʎ@'D3֮^ *ꅰzŠ+kWe@g֫404Wy ;oAZm!*AhB,$ވ­hv<|p\{l|,ZeTt|̅8g_ ʳiXc q6=Pg#lss >lV,|LJ{qac" w\κ~͟v̚3=qGX+>0}O:o9-asu}]8^;w+>}Ewn+7}p͗yRrq=3,yfIٟǿs c|lW|sߋkY GpGpGpGpGpGpGp:A`쫆K6a֬Ya̙a…a„ i[K"./pG3 F(h^3eHA]7 &GrraJvW3^v[di}پw]3 گ\y4/鋀#;Gh9!ZkXayܣ#۹:$PcڱmGU듽5!Eyf7|S^\emxE45w$vMgLq~BʋBD!C! AD !.xrAL0vA@$/t]"pmDaK/E9vdԮ*ø%~ZgrvQu}C05GpGpGpGpGpGpGpC~g~Ŏ#8@#AQ$iQQzXgFб4Ž҅:GulV2%+s}* J!DK93Dj%D1"v<^<)g#vD!Ghmڸ; ֵl<>kw]wu H} /ר"|7v!ldW!]C(U۲wF!m`аA"(!tj,[ "q>aҔIaҾ L"Ŋ+`QLekgK•]Į{W{^#CO? GpGpGpGpGpGpGpgeE;#8mHڅDg և k7 /nX@֮dHvˈfJE|1s}L-G p/~E1G,7i-}}#q`a*Of:(Xgװl{5' f!@i/vGB,bt)ѝco{ }X1zD>fx9fd2bH YY5Ƀ#P/cW<m )$<χ 0O+Y{Q/EN GvyHq<&{W(&c=hYG y?ݿ;{۽a#s;+}e8#N>"Lgby ~ջ.Z숷ׄH\͇6O8#8#8#8#8#8#8@D$SGp y#iCVdjdLQQ{@޲qKBYQ=z 0_HF;w]dR ?h[X3XsvY EHAi]#)'4Cה _ FY\T)BXmk)Dxv:jb\luxa Qֶᣇa&}!ŲL,2tqg?#|xxa Q"!+y\PdB(ɄPN[c^A,(v1o[ ߺ[aqљ4#8#8#8#8#8#8#8 tkqGrzH!"!JGQICN^ /׾X@TuefA~## < Y4~Eq$kbyydVB<#P .' ֯b~A4(-Ke˄eZ֢cF<ʊg˴UB8gM]xeX|bъ0ѮX"AB#Ǎmkķ<8< x~aʷ; 2 .ı{ SgLmGvt`ߟ?xE[%>vb}g>置BgfN ;ño>6R;]K;Jtu_zo?7O8C;= 9#8#8#8#8#8#8#T H*k9#8 Njk^v!yD֬^(p7o^c]U>ʅzFav"$EsАA"FGAZ.w^/sAujVTD#֬nݻEql b-bm4tP} BX{Z֚zZv YpYX~0j0Q$Bވ#bJ)FqEN9vaF1h+b. vlj;jEyfM<UY_!y⡝* X;þE#*gm|+3?;n#tǺ{ectL`S}jZ/Fglͮ9m1q.9}#_wd=ކ_#8#8#8#8#8#8#8@-#gVqYf3g  &TqWl, Š/tgcGGovD U|@& %$MvFe{kJ>DCCF5_$A$hM=! GS"Gb5Y$ N]% yiKbS僵d;֝$:Q#% e.邥aKcD0^0*!b%CBkY:V~ ցKVvYAPϸ;o3q; ˣN=*wqկ{u|"4&|/UIK%g^n.eaWW SypGpGpGpGpGpGpG?\@R}VW&HG u(@qȒ+/kDHFLdaUcгwЧo(܈cаAdcvh ((; ѺGY[C&"ZCR*$O5Ym(SΏ bnݺ5 E%, //4H P=ٱ{"#ǎ ݻwo[s;M"5,8dat&! C쌣XE,彥׀&A ͙W ygelpaE#Iû=']+3O^{kN#XZǿ|ᬋ`~3=|Go.y}, =8rȀ@$Ƃ?x|]gC=r#w3Fvټas蛽N=tj !ҟ1̾wv5 L?zzp --¬EŔWL _vq8Շto|q qI.~##8#8#8#8#8#8#pIe~G>ضu[~@&.}vi$F^:1 1[drH޽vɾNpH+ڐ*6!#D6b}rz#u`aW"q"v/" l>XxN Ew=vZK>iWDu/q7n \>0gz6<o;) 0~=itѣG=hxBd".އ% 'va Qg11 >P X;92~# qp6sZžSs.χ0~95[c-8#8#8#8#8#8#8#^uI'`.3=IB D\2~E5_۶l+-ɾݳWЧoe<>4 }];@8 9[dlt8@tjܽh(A ݌?{_)!Ȱb%[FkVKiKKߡ:^ԬQ 1ID$}^Mw~ͽ{rE U s&[bEPzETҽ5*9q>o[GχLj8zﵼz/d)S T!5#2q3/Hy4!# N:hЦ ݸ 0?77_VbaOiO@ U wC]3o-F.nPkM;5 յ$qe(@ P(@ P(@ P!}([` .@Rbd"<$8$|^+q+Rsw"%%Ep'dd)ˊ2ѭZA[&C5Kz;(@Jrwd쑇"o漖 쀑$͘tVDQ5H"\]Pܭz_*Km @'#D(Yt(ʵ*gyUKev[X! ǣF:,$^0m4"332U52H0r(UVM0g 6Άw+CG$Ȯ4m6~}!{턎ZvI, Wnܳ%haϪ+:RŞ>rǦp]o]-TU'z2THˉ'/vV]䞫ύ$f](@ P(@ P(@ P+z@Kr!ϚGTx  Mͤ;wȆG"(ZhNPH !U ^\||O@ƙqHoF X{=M[B\}Gih=J*]sD$ E.,±:|7Y #m9UDFQY]r(d9(T[oU#GQݯ:uTY d_\{Ů?vaHMNUA1-|Uf>TNWLO8*PSm{d5/H J)@ P(@ P(@ P(@ hE$Zad! 0aN $'%`Y]B"#ճHyNܝ Y[>(X]T*&AVQ +V{e6W~PHMI7idu~Y!5Fi^ވ`dem&ي\˸U嵌;(ZJ,ymgo!dl L+箨LFzr_y4cOLZC$P$=5$\W jrCUH>!ftlO7Ev T̲bc|roF^ot?H0n&/O›SD|L<SHJHRYh$,{,q/~;dHs(젂$3廕=WײIv6Y@iZHπmZW+uXa-;$z_(@ P(@ P(@ P%0βJs/_W #ԳL~݈鋍t$e/ySޖ\("!'(DxqH3&ɳC*p1I&"^2Q2uG952#;HP+a?_YYY*8䡓juUfZDQ𫁚 kg )[QLXWG R%s**$($'둇ԩ^UKȤnn'h2w^5..Z 5 ܀b񷋱n:sßCwsן~tU2I`]:sI=BTV6M⬾cU jQQSK݌1$y:ܙ(@ P(@ P(@ PQ 0ĨN4$s.ٓ j"p5\p.]ϲq&+Q H@B|bcjUD&j2ȳ' GG;6.ވ6qS|7(@ P(@ P(@ P(@ P@bLgm"3gJ!C eE I2q3U ^5V큶J7¯hRbi5Q&4Aj8PxX N$Z$Y232PUjWQcRn-s#fxXr~ɨܧ!)!Ieiܡ1OA.Ζž@FFv`سnFí^hخ!\]Lola$ӈ=lZIe|dj\[?}0 3Z%fcՌU(S &6 t#٧K }?{;7~;a!aYt(@ P(@ P(@ P(@ P@bLgm.Ve?u|$QQ V o_oȪ+~d)\%o]{PAMv(,r(8,\ Vؗ2&ɤ׬,,UWG۞mո8q#{n4"AriԾ|3F{U.g9I Șal[ q7Pݯ:ZvojLol"#e8"ckWvQv]20Hn(@ P(@ P(@ P(@ S3ͺ(@ ʹ21?$#d#+YU|Gꖉ߲B稌 7A`kˡ3Oܙ$I~qߺ>2\KȒW!]{NЁ {bbPvetmzAzs]w1܉S~W]tg~kNAn>c*xunwhIy:\ѓN^줲YqS7o| t[E)p7%I \ (@ P(@ P(@ P(@ h[-(@ JVY?%)EMmԾd5z-)|9v ywy<0o1UL?TѸCcHy#w|26,܀MK6!2,jVBcߎt/QdhLyf|4C 0^텢ŋi.O܌߿?}gϩLNJ/ɿL@śose1߮WJ%I~R (@ P(@ P(@ P(@ hS$dYZHC4?(-x;{Vv hW FMF]k' l×/~b扙P*& <0 cێa8llmиkcL\< ;7Db\8[$XoƙgZGPN6C&"p p,zGᢅl"'ͼ{.v.ۙ3>wGaQrպd1pSM[bꨩ}6FL5]}e{/YH末dՒZ)O_ lPLÍ(@ P(@ P(@ P[$}~MwшF懛e dfd8=0tˇvڰ/lދǽjŒ>3rxK6F P [ -% Km8*-`׫nQޝ8]?¡_!#-zØOƠzj"ox S Ǵ.u򻼩DJ익##=1jǧ2y?Awb807QLq\p'I&7Z~Rkٍ7ԽJkeE]i~Q(@ P(@ P(@ P 0|ϭIL&QZi~䙛 \=q%q'ꎚZ=&&B$dwffC/ I @Jb ؃-nAbL"k~} &+6]YYY8鴺n8Iwu)R,5n˧.cFذ"Fjֿ@rB2,==3 , k3_<&cχ/yu 2WUbK5$XiTfaK`Nm0*^0Mmc{)@ P(@ P(@ P(@ ]$y7dWYuXG W/WM6jȰ0L1>}(@HSw`딭HMJUR\mxzxal׃fǚy jt++O(`b8pmAs֞^){s}30N2~ww6VE\S핸r &prsBU5ߣ(@ P(@ P(@ P(@ T3| )`8.8S}a{e~j>&Ƅ৮?RJxiKZ]yֲ.{OH{"%!ƴCéiwש,8M_mBlx,,{ei,8I; -^n38'D{j@y>1n 7h$ żAkFY_nf%Z|;~܁{d 035v(@ P(@ P(@ PE$r& +jdIKBc¡ {G{$)>I)Y#VzgE0nuAUcbV~u+j܍f *k>݀x4 &vkEWS@WgwŌ^3T8J˽y{fY{!vlL:8r?Ukε1h (̣X<|1:뀆SĽNf(@ P(@ P(@ P(@ 0<ȕL=`q*<;O(QDNgn&`p,Y(`#qvY4on}%+4Bp-n]Ú_WYGaf*w(6C AuPLE h}woj?ђMªwV#U#5R@ _Zq;΁Az7$hϬ=*/6j-6fIM_mRٯzappr01~x8:鬶n o)@ P(@ P(@ P(@ P`IAx,(# +Gh¥d< m9 Pn&174zys/fQldE-l__%0j(t[!ܛ&,pC\&6]7/TF+k+xQ}F? ɚ6|XwOy^[=+F :mbh pzX8(@ P(@ P(@ P(@ P  ɯ@웻VSUް̜1M&7kVil (GcaɫK`[oxucNnr?uIeK{Ȼp誏jMɒ˳O9^#{TK](@ P(@ P(@ P(GP233%fCк 8u@1|pxx}Oҗfe)@ "-) ֍OwVN`X5~ /76ڝk]! FK_WW ;}D@ T#aaTu25;4F7aN9ڪ4nVfeeayHIH{TR=(@ P(@ P(@ P(@ <^$'F ."Ǿ9s%FM\<0z$BYyvᰅhзkJ XL~&x v922z=#l6(xyaB)X@Q ǖ[Tw&2xB.v^@PG~7K =5Ħ6!&,^h4pfvLہvEO{CևN`ç/rz79!^]ou" P(@ P(@ P(@ P@^@W1O3HIā{n*-`Ȃ!߻> ٙdCrJ:dh P C1,;c(_| # =[V 7.SxoRJҢʣ>{f" #q l6:MJfCo6cxMlq(0͆6CW[%U}zQ(@ P(@ P(@ P"hq_ @ر0i'M6A?ZL2&c:ۨPKmUߤS6zg?tP.^8sO8X% c1u )TY_@2P8^Yo w5#x )Qhgz0`%/=>Hܼ]5(@ P(@ P(@ P(@ Z$0/0&feŃQvh 'l$ֽfa'(@' %?,4|?XԻXR+-=PFޑ-."7FXTn^5sxLx Wmq=: 9G'q'ʀ"s84/ $pd8wﳾjՕ@fF&,8_la-@:#}Ư)[1p@u^r$C{$fTH\+Ά'(@ P(@ P(@ P(` 1SÆQ@713s8g|1vXTkSM7T_ow$\VK} ^U+Nϯ:jwY cN9Tts*{W둭P< jAX4ln$ ++ N\Ýw*ؤUwbZik1o<>HsFx6~MT%cQp-n]fC]T`5ydw[1tP4~1M(*kқ[߄K=Խv c)(@ P(@ P(@ P(@ 0DG,& na;.<{|%ھl'I- в+}Z)]wQC58s.WL2 X"|t#Hn4>}ڄuʢ$I*XvŇQȩPN/ɞsEs"g_LP :4W}LlNu : 7荣UƣG/y#y5Aɽ 0]QwGP(@ P(@ P(@ P(=b* B &XBeUOڰ!:cbk.Z^/ P k1o~}W,@u~d%aU9eGƫ 2ޫg٧t*$ ;`.|\\9c>S gUMUW1HT{^ƪwV!dWv 6 * ~^_D[8;囘io 4d aY/(@ P(@ P(@ P(@ V$~0!,$6BꑫGndYS!Μe*'@>NيDM1p@$fN]31ǠFruya y*KdsHv9h]͇6g$jW `*eR#ˎM+kx% `t&vRSLjR*f<7Ǡ9 qx+̄g)@ P(@ P(@ P(@ P?@D܁#FD@.1n8x6Nqq?w?Ї h)`2֭;~܁vGkS.#8,[B% *t% "Qv5;חbKp':MD(o!N| '&?KyX9o \~xQNYi(R m*Y(G40Ak0d4T*S{ꉫۭh7zO ۂg9,ŽO9&bhFqw?ڌjޓ^웻Oݳjv?ӱsN< T j bذNaH_vcam L7ZhU7/ ~ :;P767/\]B`[.\t[K(@ P(@ P(@ P(@ P$0@VV.?uÍ 7Ш#\=2d VwT웳Bvk+t#W`1jҥnjb.Y}f P4$]u7=5_\:| Fk?XoDZrvk'c4w:69>Y=gf䔕p3%p0,+zVO}Wr Y ,0 eY]~cO:[ӱ@jR*~~gq)a St\'+ƭ@{1tPH\\!ŸQ(@ P(@ P(@ PY$|v6 W^)[q! Pfidef!%!Z||d<-KdգL2h(: dw_jkȮ{)wR ~ZLnZAKJ6s' B l ]).lju'^[*>v{i~-7/{1'W$휏tsܿ=-qȲT P(@ P(@ P(@ Pжf,mza4iaaaNmb9Wqњ,O~:MKrJ R.]TvNj0IY Y0Dp P@!JU,KU7l?gkdQ(QL/%MĥKHπ :YgDU#CVsVea{~'~UѾ*`I:8i#^eRޮ1ׂ%;طER|= 4~Q T:zOm,MW;5?955?(@ P(@ P(@ P(@ P[l7/Ěw貣Ҳ &J*Yƿq:aaiOw,[@>|{dgb(Ye=c7 ~as{ ץV]?.;3?ȱXߑt;I}m= B3] עߴ~`?.yy~:7d (@ P(@ P(@ P(@ P.c?Cl [ .f P(@ P(@ P(@ P@‹F,"+ƭP+ 'ھ6vV*7fibհCXYY~VJ hW *$ SLA1zh8tn,,0l +^A> ̢_ )p'5dX}iflQK9To4v4z~JV*{{}_dAW>ktM:^Q(@ P(@ P(@ P`"F +67o FMWq''֥[#~DS#ߵNe]y 9RV= jS;OLv{ۨذjf50o;w_=l(@ P(@ P(@ P(@ <$eЧ@0bio{mE#' H̀w<)@CG#pU 2TvWMBjb* mo1('ƈ`%J7-ăqvYʯh2 ƈΦPȗͭqԺQrxlq;9 'PB0iIX`Xow0-zHLb3)@ P(@ P(@ P(@ P`  @@V1uVO\ZbU^9r%꟎fg"l$1fu+χ|eڔo>D羟n]t~3l|A hW@C&^ v@~( \m Xt*6̰[ TnV}0&,) 13R(@ P(@ P(@ P@H%L= Gcj%vEZO_5W|1f(?dia̖1li>]ޙ{FH 'W'+eq? P VVV-d#$% -DFZF g}t@F̱zSFzn]jzQ1ul{pVFS1t$Lx~<n_=3<}JSZOA-^5)`hԻ,e-/C__R8|.XzJU/e>SOV`7[0`Z @2xTߣzLX (@ P(@ P(@ P(@ hAV e P 1o69~ͨ6O؛E@&˄b*y9RKg}b͒kdV~ba6}#"c~H5A 9BrBJc1" [&oסri \ʻnj232(_<:`F=OW$FڼM5OZE2{Q-q P(@ P(@ P(@ PЃH*,Wkٟǣ_Ao^JurA,ЦdFfZ濊-:j{G7[vmecH%ƴC9"9$:117`.g&=:ښ@k,la;Xe H_zO_O)46JM+?(@ P(@ P(@ P(@ Hm&-2 ,PA#W G1b&cl;AEyl(@Zr BWZǧ=Pԭ(,T`7յ[V'7't|#ZhڍoPptvLVp5X4lK;]wYBY ܸx>ZtEe}ܠ,0))o;SdɊ $tV P(@ P(@ P(@ P`  @`㤍XZ}crat@"%D&s[GH++dedVZmoV*3"Yid"'|>2-\g2HА\W9)k]>Z ,kD=YsIfbp(ydPϚ:r;džng/o6bƪ ~0܎şgI ll^Ex5}:!|*սJg(@ P(@ P(@ P(@0D7,$cfQBnu-PA] 2=3~:n\&ƄǨIPr*RH{q2IWSMHH|"dn *n(]4J, nLۑq\ h&ngV8:9"r'%'DVV J7)Mw*R~y{j 2m/4אAhz~Sv"F+1 Q޳#YbT&XLr ׁeȘ"e9ڡdpKqL2jvdn㍮twke SzWoB&I2ݾ~& o2d{sPv\sF*2{|HIKJ PBz+Vzv.+l7 2, t_|ڃo.g=O|xC5QT$ n帕h=@^f?p>F2T3 \}EQ(@ P(@ P(@ PLE$rNIS;MU+mT`5ɄQl[Jb _Wդݬ,5_&h{T󀬆[]5Bvh2DPY]\2qn]|8V4+˄B~2 X#*6J+ y.RًCq;ⶪD&I[VCWZWͤi"߉oD co JQ)ӛOcr&K0QきU2 \V@&^8x_PT**9$ xH"M&-TJd "*P( ׫ H[o $d#IHJ½2 JD!<88iҭdS$&YIX$%;E/%\!I2Wq7Id6Mƀ[ 59!KF,Rt~3]+߳ 0Sc@ٞz̭pK_*7I I(@ P(@ P(@ P(@̙זwc ^~P+O802~$t喰%i&yg=q:,"%QF(UZ_&1+(C2sL<,S!.QTVU& nP%lݲ֦.YLM 3#S]+prIH0/Yz)&@$7$ی<4@\~<\9]>r{gņ7#?U~P[L !KT~6R׃fl0^ͼ.&;tҩ`"YL<>zbe|T<Žʑ+j8,ޫ$E]jjdf ` .@yȥ ݹ4Md!m `M )pe*cH^ر0Zt(' F$ѫzTlXѬ YN@f>?1i jvI wÿ?F;פ C1ǘ$x((@ P(@ P(@ P(@ L$g +K}{7^\m2>HnLH<I$PΧjvL`ލ}+T$xAoG&#K z:e+lmTBͧk~j%$y^6zh5 ƑCYf1oIpẄ́k#{~ʎr|q8OeM6Au :<,_.?N dw f*-({DodtmnHqzilaJ03j\(t' r FũA#M7UA#2sH%OO_L+r? ۾ۆ;wԸ%*,_U7 䒁D2de 웻X *`쎱(^;7HMJŒW7e'uԩM_mB -LGѨt-NJ(@ P(@ P(@ P(@ PLFARÇѤIS[Ųdi~ԙcd6SP³F5^=~AQGfpHc+K; 2yS5۬S[UY\&JyHfndtٍp T6n&Ep+8#ˎs_lq|zȵiD/9&K&:]먇_92Ny7VIM4QI &t;Ie c`%k*7 +0S7/TANi4$FI ~`eeB`J)9r/^2r />N;ϟa俙WaACy8jxԘpq*Doy#Wﳾ|J]v(@ P(@ P(@ P(`ug'M2~Qwp1ǘժƯO 9@&|'Y왹GwA^0h )OB˹U% <23+VΟvbkU6#Z@ lai[rB2vKej 4@nSZǍ 7w^u7Nڈ/@w;:?R>Cjb>tP<cFRqw՘ T3z̀ZG$<| ޒE2ƞqؠ"jj56v6y,2v~=$kΙmgT0׮黰p.z=~ڪ*M ';kQbL"m=EČ37|EHd7Gpo^faf<"]z^{U\(_<^Y |{Ɩ!dvDC> $8;YƏ?Ɓ %jv5tＯKFIw貣8 ~^ͼfT=[{3p{G5jk}6N2۾ۆ֣Z}ƒv\=qТ/1a1xf<"&Q³Y\x P(@ P(@ P(@ P0 f 1dr,h ;7=@cN]gu>ǧ>FZexwIk]EeNhЧmQVҗUe+G1ٽKPԲח><>?1 :aw 1u*4aK:Δ?2V왹Gr/׶ﳾ%]V_]+WcUUZG/cӗT6 2h5$D:?A,H@ޙ{&Pej7 &qt6Lv yvU2p8E4eBYT_N`۱b k `Q—BsMhp.[ $n(@ P(@ P(@ PLXx5aT6dNS10xHN[e7@M_mRyKV,WW&[Yi-_rdhRs^|k?\ xg&fn]Z; >=|ed.9u@o{鐦\|Q =Po.}WYgS1x`4Ԅd`4Rcdn8k [{?(|[G~* {o]4-Ss,ͬ_fiZ+Gj枠7(~]_9{\z}?7oE_^mz]4}zE#vr&%?>YLQb"f#wF^CXRFX #BS:O`,              0!ބ&Ij$o-4i.*;G;dʊ{B-ʌ7[$R]bkߺ~(ռ.`]z #MG6E~uafuwo=*]d!gG>> $Hh2 2iƣ돰b 4!| wl;=Cӓ{O`;E$@$@$@$@$@$@$@$@$@$@$@$@$@$`jޥ/#hGS*O:k S]GiSfu#m&MAHqB"w~RޟrMiG:yf;߿?wx$9P_ke_GVγ`c\]ńJ`lQGQ<4/A#3|W;=75e<տǚ1klL3\DiUrQ9:B/N|ymo뚝DHъ}W;x jJHF + 5"Jl1EOM_*ᦈ,ܽ{$8 X> H,4\߬G]Pn4MJPxRT/*pпnř2eJѵ DGEr=rh!lJ ݭYRFXb跶;*:reL; g;?[n7 B,>G9D$bj\5F阈DrNǰ=IaGqZ5ll ~o:G@K,E/tEH!u              07ۈ1^x|1~o;J6+ߵ{{l }\r W\jwՔ['oa* YC h8ɹTD¬. .:~lf w(C`d>s(O#TgQO^֛4{'{?0tD4]g7!&,L]uy,3,O<2eV9^D"i"е"./SO6uӄ'}٘fo;k SCsO/[<q d@vHHHHHHHHHHHHH28 H2`_% ݿ=ծx;NH Xiz1ص"vyLLT6xMCfF}q-z!I[ U*ѽ:&-:x`dʊ '#QAUX8zˍW8A1%uj^\ؓ" StT4~o;2ۡע^ChY\XHHHHHHHHHHHHHHH 0cG1~K|6X%,A@bnG7%bUjµ %6f:V@ձŐƍ]>|/j|ʼnMMp {UzT~'E<68qٸobчtTS&inZYV`$!ڐM-cM:}x4*}6fm?i:2@M(??S-&MGWGLЁDlY3 P@lL욱K%\9 4(RcFj#}62ѱSv3sPo`==.T *?n6鎯kDvL:NKvȞ/;c.$111Xk*><_購Nm:=D>9$0fI%}dydb(l fL2pb>;g 'ys:p4              #`cz!1"0<n`ejW-J>.6v6(ٴ$8:꤫^r;؏zu#V+eΚ%x=sz!Iү@E3~GG4o@MadXwTZY1 Ź^i;SLЩ+ƺǵ1,Hb)&٭g1p@ȗ['n!w6^2CoWɯڿ>6ۀ_[7dy獰"t)hZ~׏\WB)wOa*USpk[_B~zO@IDAT{CۥHߣu(~o;n>XaPovٰAL4J ᰆ(>cN|d4$@$@$@$@$@$@$@$@$@$@$@$@$@$@)'` 3I ^̎3vzإ"tI`h$郧(Tj6^,I['oEPRW5D=2[tREHP:sY灥"<ʼntX**4Xj^ 68TDgS!kJ0V#EbB 8!jQ NNX=b5(.\oZ?ݧD&oAJ 붵5>Kv֟gaOph!|U+\}WBؘXPld@Më1M "3uaUj@Wvcā^9wݗpqE|#HD:t;ͷm|}z=d񭅡cwHHHHHHHHHHHHHHL$&2 xJ&G/Ȏ,I@8ݝ(Р847*qAgK* ǬJURԴ)ɠ'7NbOYW;5]H2GU͇3ϤVp% W/U${8(_|JVR^` 5v m]@=K]3wG 0,"6FYP^QTQC A_kkW?`NF)e+@q1" nk˾y0 B9UCQg5<0{U Ćmm^YQ^YSllSJX%>g-Twr4J| _gp"NS:[f3pCI9{HHHHHHHHHHHHHHH -Fp2Ec~vNe^.B"K⣡$i- IҹCՖH׬.\sl 7~xɸܽpW-d96N܈R-JxX9lZW7)"W%$ >> ,BSsi--1hGm oTD+@Mm37|ZͶ#\H N$2e=9X]Sz>.cf|)# Mq]γȂ;%;9ۡ1:N3.GWG䭐W#"µ #sJS8 ki;HJ*(Ӧ b^@'c3cQz)Ia$IҮ$>iQN?8 |4$Fq^e\}Q%kqBá S9"7ޥ՜>Jb+NXݝclA#TO`rreH۶W1/4:ESkƣ6߶`ee_GߜF҈JVBf%! uAu4Ww^u^R1 59GČ5gJ3}sꎪ^`T[2/\\Dy1OTu{)W{񿏫,{uFWdϗ]>C吵|rumrmj^ :Ϸ/G"N+ZU"_3f baJLY"bhqwg!0t-~lg !%[!J\YHHHHHHHHHHHHHHH\ 2pkkkU˗/uY-"q~itZ9+3:RK&^z=I,ޯƒiA#kuXåH+%N ZQjv9aa{!_|񉪥[%ˊEJJڬй|%J*ޅ{J^?2^Z#4;\yQFdjCv\:DvqpLyfPukFp ]d|ooC7r˅\RtA:NrOAK8 à̓T½Tmc@9کDX""m[TygemsSk$kz|aWƜ?2L$""J4s2Dx@!Eo*řHJJAJ\+H|tǧwMD+"vx=*2h$ckg嬔\c{3CVej zoE_)IJ~zoG fVYJFuYe,u1p@6XXt~wgy7tސTx]eB9 ZH$@$@$@$@$@$@$@$@$@$@$@$@$@$@IH:s0sM\uo='1DGEc^y*)XwFjSvn2 tc[$h}Xb| ;. ;u\lbGKk.WtKmeGv[Iܦ\#l8ċF$ XçR솈˯#q% *d&m#%s@.qn% QBw+zeGjqAuna]|뇯VZڷLXv!왹L]g S~Q<gŊ+0xT7/_.œO<ϘG8t!LM5Ⱥ0Р 㛏E!B8[k;k%KĄ c-N{Z*뇮ִ;&7q_5kQ>X"ũF)3v+dR6ItsRǿpgE %*W vvw~ \?S8Wdɑ"KwI_8(Ǯ N(:%:_/oqg94rm먶QQk>|M⻬G3{Ƶ2Y2Sys"Zm.j|vTHÌcHHHHHHHHHHHHHH T@bmDK*'I\krʭ̻7>%ʵ+b)9=]()v 0",B=ES{mȗS[Iȿ"TZY8<}W)J 'TUWUqrG` B&D%O?QIINB; 7'\r͓̍6myޥqq$;g/V|o?:Yft1\KN5&~-#]j=AZ^ ;qpye|C%9mc.┤?ϣ <,eەEВ \w e)wgGڅWҟ]*f*ڌykdMZ}k5nt 0 uE_m8ɺy(4~ :ra!7=ѰFh=Ngܬγ b!ۆ@a ]rԒ9ab [dc!             0?4q Pd͚6mBÆ]]bi$p7qO/VmNCI g/|zAY2gZ5|yK3;ͧ1tPxk[i\{>$qZI׺E$Ct6օAaD?$dE7gENSIJ\7=7y LcVGqZ*%?—[0W\~S3:"lm4=>/ r^+8",8N9~OSMQuUm$Ofġlщ?2kM\!glu;X+bf _[`f1%_Kƭ$JNmE+4XHHHHHHHHHHHHHH̏NU;OBFlZ,ٳ騦*vkv4qjz wO}+$%qDWDZ񈼖 *ѸN%S*putCKHN<"sWqdIq!7;xDߚ~afǙJTK6Z)'>>z$_g}ϟ/0T諭ʁ'5ʹjXbϟ)8y-7̓yBěXHN, ]\}ɽKɤDŽJ3%tQ,9j뻩T/ZLRNZ=@]S5~nXqZE8$֎Yv?x$w嘘9$              Щxf$=CB穝a_s G@-n 7i:d 0E蹰'_#Gc~͟qsEAPw ꀬ^vN81{wq j=wobjq4~8&Vs)T<{ui;]#_)*WI][~8$fwϰJ{pY3_ ЩD..$,p^Daq%^[)! eĤ4#nlW" D6#V+QA}`mkmRRv;a+)"IӛOזTR&.n䫜C_Av7ײDohU7L+"Xe"Bn(7XB)٬$F ++`/GGEk< &M²˔kM攂+ʓO •:ꘌGLt ~4È-e L *" 3:^ӯ%wW}6!GN붔d&A$@$@$@$@$@$@$@$@$@$@$@$@$@P]WH 6M܄0t1"`eena|2i ~P?@ryj*T-gΦvY9|6s퓷cnTn;7@\Z7OM1TX@%йnw\o_?S[Lc~hl~RKA bcڪSuE-Wq/ODa{a*>`~x<0u;vN \H}\_9#/#_bB j'c +N("ع"]0180u>pŇȒ=K+@5~NFo[F=7 ^Yo$J$4Vb,$@$@$@$@$@$@$@$@$@$@$@$@$@$@G@[1Ӂ&E|qE\z}K n:cee z_cxYc.E/[J*X=b5~{7.7Fԛ2%IkQg5%\rr)!F{,ꉆ5Dw+"[f,ZMCVarxzrwؿm[>/F ?`z'۾FNo>!VB&Lkr'-3 @\qh6llB>-wpqë:8Sj~XU߯ tf3v5GFǵaL_޿xc1xD3;ĭmV7uO7=# /a Q-cmKԌv8m)y #6&9 |˙HHHHHHHHHHHHHHLH>Sݻ{F7uIH4|=x`76c~TV}6Dz{9kfbn þy}vP yFtTkI]ŹFFMrN/gaJz8z66(T7)MJg|3炱vZZqH.s]$6LB$H^z-jlٴXE \=p".\V#{g{UCQz䫜O9KsN웻O9kXLsD`q|LCwQS= ,&#paO&z qC}h.†͇@hp(f;^B)4"@TDifQO~th: $:JHHHHHHHHHHHHHH \@2qDL>W^538HDUZ;w/^/}^x$B%?K~sC!βkr S|T$?IY{p|qgGUQp}pg3s#@DR"xn"2yJ:J|b=N_Tиo>ln#$AՕs*6wU"g6Q ",gGqu 5jE\j}j K,F]wN߉=3ysTTMF6yEc(u+Dxt9<~ѱ Cûd8ro:3>A#@]TiularÛxcES:G1;H$@$@$@$@$@$@$@$@$@$@$@$@$@йdѣ""".ָ*F#GbL1(ݲ4L뢭GH$O; C1'> y?n֟>I0qJ e)3eʔd,M;*7,8 GkB6&}@@<}hDӒ-%;PFw(@*MEJ>v؍sys#~I"v$ܶs8,]]CFŐ`Δ y휇bJLq;˺)k8(9[ .9]^eo<}W*+@ÕSrW%N4" i-ҎU mPT6q[Z۶̖3~ziB!")ۮrI4I4BQ0TzrJR5dʊ[SqWq&^}3zJyj׍]6]gucsq迮 s> z=d3$? ^@{nԬYn݂ 2K$!\ *hܥqpa Ä Z$1I[&mQ# ?k:]nПpxa=wW l^EEE,uB5 {rI4tX*}'J -ppA웷]V;WZY G.ٹ_v7w>X|UQ~qIjW$ $ˮҮ];'*bk*хhR")բق~/{.8<]++0^Na[]f;_~pA_{\2%|}T"{DZo |OWv_p9)1NVeԺj~;΋H~$N0r5KQlLrR(g$-q8i5%8V<.[ Zd~.^%x3LkErqȐ{ @$QQQpppeЮ];2ΠR+I)/drmwqW$F{6h4M"uc)G qiyc6[/̖3jۧn#6:YrdQIDzybθa`Pv8f+$\%g*yT4 $jD㽡aم^F@\)@D#kܣ_F+1לp!7CjB2g͜nzNpqE%EǬJP]9T^D)+WT^BXplmT-aj>pgpq 2A ":9 "Iwv7@A;awp->y]Sqq'qζiOZ@#q zp:9塞|%WI#D"f1{䅊-[lsJ<#w6i3d!ȼ|][7 :'u|ck!pA:*7.Lj0,&ں~5DGF+[7G9lHޟ>7*nvوy݂G2jjXs,vqȠ-c,ڏQEi]WorQ@brC€HHHHHHHHHHHHHH@t@"z{{O>СCu0+4$Ujd/~NS;fkH?o^عbyIⰰzjܿx{WGmseHµ$^E%wAD%|rdIdެyBK$Bd4-<l,ET!rD,X$G$\Ӿf}ޔ.o/ɯ39pn9tQW}*r pyKIPն$w d${C Һ{Ddg{g2]FDN"y50/;_T%Λӈ/B'^] ҈4$_ B%q;ADG/ҟ[o)LO%ҐBD"bG#75!I ',Zx U<(nh>kDTW|UgpVSçj\W.r)Hֹ[mS(ְXCWaUBj+L/#_Bvk>>$_E!/#^R}{89$^qV";u`IzE("<2"̤"f"frK)o=V ڤŽ/dINNJ!sB >rp]A[k`mXd-Xs>\!ʾS7zĬ.0T9 H Փ Ћ?ɓ'k."C0@/:y ߔF咪@ HppAZ eۦ.X5|-?B I )n_'KD<{,^""%8kHg8)8oIqIT9^ZS6'd͝r" ؏=]=zD*%]%_E$a*![V2"qG7$ok@;4s-@9iFJ#h=<{ y\\s$V*.PV$("nP.nD ).&1oy_%j3Z1DY#+0))1f+jnd9f]Ь"<em0HDB" "*DFdCF!%'#iġB2,UDG}e c*q 1O!e^'9(f= MdMr5A湈RdRCVp *Σ@IDAT*aZD-Gq]B<~gMvj$K  B\(䨞kD)9:F+RxMjSO4XD F4h$GDD&JРH_E%"VLqM{y?f)F|!B5 $rrIj sL;NB3Nr#b'yO^`%wՎqBDHZ$X4")qݑ>(ወ^4qG)Tr9":2_D>2Rr/J>!^ >m=Y˴.$$⒵mj}6 @% FX|yC$bؐĖ`o;аϲ>@&B5 V:9cU%d"^d!              K!7ɽ{YZ +\ Eu ,$ 2:O |k_jns!gU/SI;?Z}kN67dgx)h$|&>e}йd蓅8!h 8<E!9 Tq!ܼT!w_ڴ8iF"9YHs|\V.,'q܈D!5ґR> L 8hMPn1{+N2Gy9Ex4ʭFk/\=:܈VW~4T9_w~ن Ϣ?>*w5B"}|1z*ݫXkv&e^h\D(BDŽGI}@>eɑ"Ǿ-KNjS J A2i z. ީ&"(\9 X HN2eR@EPB(Rih,$HWY ;^ SElt,ɊUCvގ)nYg1VzmGv왹G|]}9t k118 6߀;gPB>;ʾSV>qVn2$Ω;Jtuu}6=~bH9=vl^eG6lpvShd:@EeKȚC qM4J;ݧ']\JU ! ٝ 6TR$%"Ƒ"򰶵N7ˁ8ĽAưF\ }[б,͆ N e4쿢W^È8 wF呫h.pEK<W/!Cddw~s%us;&ʺ}dX$,%TSЬ2Ex")ǘ+] ֐{.*{^ͿhpɽdntmmmSaO[Mշ|@9%wm%znJH IRϔ)t u k!              ȤIz{nںr ˇݻwzi3{b)UǠ-P^4KH e${ T]w&Ib09uOVF%)V]<]wFV &D4!qW3T( yCMvaF N?%6u^+搤^xF!ErMՆz-'W$.C*Gٙ^vl';$B&Mmj+ ]Z-:t袊*Q{]7!^{'MHBɳ9~y8{>^9٩~fc͢o9h*M\(7釮O"R X$Y?NZCč@NRׯ*F{ƾ~x1 +n7vd6kk`_%Pz Ej{7I=.?;(-B\JT/FOK:1D[o{yzщ3+LgfsS{v:f|sTE%#zs<ԳV*A6,iŒ,Mh}=D)χ{7SW:wqW/P%B5J*ѡ!`X:mA{*"r~yEuvdrEд>4/¢1;!5Xw]_oĨ[`ZzC3PO Y6һ?C{Z}$F 3___x{{c׮]uaexdGU;D5~Iz&jRK%TfeO[AD%TzmV3kmg'H_gN>Kr7$yVVbMKu.mok&щZYE!j%W\o.╋VbTPCfd&0ml'=3IFm0JN7±m657WoŲ {߳;q]\ u{E.U<Xyz>FDT'GThQ!M{vZ$|hP%'3Pb ?%ф"JE zOm*^n%ܔr'+{\}y_5mFAכsygqY;w)'~W^˚ k랇^U~czm9-^zk?[yXŁRJzՑ q 䙀D%#" a!}WNb@:6~!!pc l{yjA+y_K!EK#USDU Gr.8ȿQVqJamyhIְuJͪBnEPpHAKkYL7vc>xDY3k>I>SOȲ#9m'Kd&5ybPZY|oZ|X%IY,| "h=5yY1ѭsu;w5M6wo FD"nEW;8J夈٢r҄$%9H7DEJ".#NV%:,Md""Jyފ#É4E5"wV׳F&w"oGݻHJbN}c8>7ϡF5e->L t~k{t~}On>w[&r['              S">eeeeJf,fH@fU-S !z- 0w~!HM¾ÉO/Nm G8!]rg?M''`ǫ;pi%ԛP5ޫA0c+ئZ:hk.ln3duqi5B 5{9<ɪ[F柺2hǪq Dnn7`kR&"?%‘āY/ov"8v78p"N ,p/jc KaTh^챙^qY8b!fnߺC_Lea6TxWViݼUE+vX9 @f=6k 8|0j׮m辱= "p ]q^+@ @(nELH Z_,o a%x5뺣q39tplqaq贱[>@J^:+u[~܂/} _z))w^w/N݄u_S2`ưX,@pdr*W|ukkk<{ űUjx+}-?vQĩ U CM0x`Z;z m Z`E<*E,$@$@$@$@$@$@$@$@$@$@$@$@$@$@$`IT@Rzu+V ֭Ē#EGdf]ju6i$847/:¥T<.4N e-(R:mgolh$E8ix@G H$`|l}^`0$zvCw( D !6ވu)QX@upDOY7o nζwPY'Nm<·Ep@\T\Gww'm5!wƢކ=-k$             02<XYY]vX~=Fm䮲ys%pmXxyrM@n ܿr[^؂;7 Qͪ4qwR$@r^T~2vO.פd?뀈 l;L/w`۔mx}mL!s8 u߽!? KcህF1zd,OS?!S"u' s%|ps#B:|uW1ZڔXW1 Ą`Ȋ!љ'fX{+?Z>Q&%$tdHHHHHHHHHHHHHH!iM$Gdd$\]] Hq$u{}ܡO%pqE%}wVt$&唤 9P}du)"4:aWEXzt66imyN-$ ٫đ 'W'tPn$3 &`(P'_OZښSg4rj|t^/Ć7 )>Iݛ^$ż c *^2u˘wCv_PgYI@DH#%9CWEgsUI9|xC%LJt`S}rIkJl n_#\ӍM@~nseq{*edHHHHHHHHHHHHHH)L?ګW/^qqq34ãcz8 09_`iptDϣ=)梈8eswE]Š+. +IY2x鷗0DݍB`sEdHdEbV,4P/#f6wo1xĄ}ۄn'O5m\0w\?xDKx[5 ooşCDrbn7F&~|K)]cx㡏7~k_S㪏:YG®)x E>{HHHHHHHHHHHHHHHL d=z୷† ХK3EŰ M`۔mFA 4۳II5d>@O 9'N"1q6kڬ:o =kI>~V#ZNp,h: >="&,V'3!@X8G%~5}֍BU}e&KJ,'Qw]*\]uAɚ%ۀp z~Vs,<3llmr^0)=PUeR}H,u/              " FFpB HĽOKŐL~bjY|[ 05RRRl2L5 0rHGrM|*6|Kxyb쑱1ҧ pU|ZSly;^"']h%?PB} qb1Ll<ޮ(1$3NG(>+?Y$\L~v7llL 2$Wg9t[ނ/;7yZ=~5h\<\M^mb`ݝڷPwL:Et|ȕWyamc~ug)@P ^:wOq $              0; ݻwǯYc-ۆobf=CNOx+Qm7V wsIsXl F9-Q3 wM8Xeuyn 5Ipzf*jDG`k (1`[8  _ìɲ2+oǎ?"!&o_L~tp ,##\YpuFa_VD7`xzϡ^ϯz<\4ӏ<_'W;ə <t딭3gUBC8 ́D:/#((v̐o~(VFϐ&Ph:rɶ%$³}ڴƒ:K+Hny*F\Prj`Y\щHMqH*k:C "_-2M>:K&_aJܙg.&{>0<#mz_;r \DE#`䭘Pkād족YdhHtIvmq =7 wlSOEca聩Tq|vaPq]:=$             0  HZj???L<0c+fGľ8jv3 W;u묏|tO`ږӿƊf+^=@E2=./6ZZXqθ8U$Xv5\JZM}X_}87Ə~Dw }_Z%pIbck_QX\9kZiڡ*:hq3ݹt)I)(Z9IHHHHHHHHHHHHHH  * ƛoٳg#"""'Ǥ?PN%TmV;{(I97^Ǎ7 .ฃ8߽A#뻮GDv WV^Qm/oÎ;Hho F̭ĩIU"qɞQ{pi%f]1$.,kڮm GbEhBTlQƾaʍDi \8T0sxҮ_vn?0x`88gG:nFĉaJ)ӻn(zJON`{'~"&05!Af0j(&i G_C1<Ɍ7$%$)S!'2Ӱ:{KU޲'i + @0D/C$3g۞v#r5mƋ#_4pćckV%8%t ~:U-VADRQza8K9#n[ssϡQmX5lRܿrk;Ŋ+pye|c'}rHSMwyˣ갪SSO-?kNNbbt"uZB7tcûd_G(gv=v3cΧvcOO`'+1gt or O3,ߚb1>$ Ϧ齧cV,`iT{SzI%p Q@"xa9Vǫh>y+&M@a7Nृjwrbn bp,hZ$             P*ɏ?$ n= Sph\9q ikj[Lp ZnF5Bs3vQ"hqw oXXcI%;.;5Q'BFFȮY_~-kDmʉ'{Uw5o2!q\Y~bFsj\hag qc#"/DƎp)钣xX?q=:} Ks^j~O|s΢_]V/ǝ[9k3YIɘ,옶D:l rC?.`ĆC_;JYSHll1DHb-qg:ۯ\g!=c7tzK(^n3F $E+5BlHHHHHHHHHHHHHH Co7n`ܹ%[1yqqX2 v&/=[GmW?WXۦފܫFeh ^²F`mo Ž87rؐXUOHuZtQ8z8I켭3MHM ?kQw^,H >"0!CamUp39>Y[5"`䖑awmý˾ 1-݄W漂>hq8\&k)]c?H @BL'~#*ʭ+7¨ ¯ǮCFQ#?lGKQGmVrL@H{<@$@$@$@$@$@$@$@$@$@$@$@$@$@$@B(eʔA駟"00666‹qs"6:=G-Zs `e)Jx%xҦσ%6;kF,vK\T~Gl@Y+; \sQw0p@p+DS:Og&߭O-;yb|"+9͍J TEt·xo*m^nN (Yѣq%̛7E#`& 2 d EBDM6U$g"g1p?M8lϲHYƯ8aH?c 1X}hCcL?.CJr]y#V.⑹oŮ:ڈͲh|"#x,GAgG 91?\/| uv0l0sVBX% qW Aȣ}KrR2;65ȘŸb~=\-`H: e(_~?~<򮇬 ;^Cz| pDаj܌/RpSɟNf4_"/E(by:4=HIgO49qqp[]!6OOSCz1G1 X Di&|fj\L58A7P{-S q@ԝ({wwR5JVG%r:_4B= qcNb(||B=nUxdjriOG{Ÿ2-gwG=0{m6H$@$@$@$@$@$@$@$@$@$@$@$@$@$@"`4tO>˗1m4C ESRJV FǐA 12QUV]bMeˈhDRD߈o/_$KDHD^ϳ>p.=WGO8.,D|HէhɮͤsR_{sMA|x:?~j% 1:n %64y' 1}|: uxlj F>usSMmz3|HRq|בOk_ ^25:ȏey">*z˫r;-['oń`emǢŐa;G; Y6囗Wb h;#.bĆ(SLk@`ߟH حԽӄb($@$@$@$@$@$@$@$@$@$@$@$@$@$@$_FbذaJHߞ6 q'mFt1a"8q:qdD1նʪ+m'*oTQ"%uꚫp,숎;`^U/5? 8A8RS#6=Ѓ(__#fp4UDXDX՞9G6y% IInQZmL7vmk?KQy2)))$bZJla ^2;DL " ދmGLx Fn_y*[ ·m-^ ekoAra`h+))/w#&:P kAۭP_\Ip/ f5àAgY*|ׯ븎ڿb1M\7oc|/QbN:o_?466S-_"+aeeYFҷ^0J~s &6@+=M7!xk0ﮄ?zo `ڿڿǕua/a_ s/0o̥zakGrq1mhht&*A>XۭfUOG,z3v.!&;MFPmG273& :gaFۻ.>9ृ)1tv8̤$S<,#^Fj͒ a]@"|7QbE 20f+&Aet{I C 9![Glf3_8Vĩ;zW@re0ᤆnm҄^惛L2ZU=Z|db3V G; @b|"tnb(V#`s$7l;qM`axa &!b̛>V;G; ]>ūǤVr&'YKG/yj+va.mg1HK,n~7B w.4P <5ƦM0 O4/+f@QNe @|D<ִ[++ÚJ%͊&t'Omy)[€ fV&^X!24, 2{u~,_~3;K k@Y/•W0bxW5m1Z~3wշ탏Bζ/`4e=;XHϲc0`Q;Ǭ Zr>_~?Cze̺/|pǃTt f?HHHHHHHHHHHHHH$`hذ!^{5h׮ 3$xlk^uC6˶L+Z$OD]]Qؿ Eg١,QW`h+hbN88 K8F~ˆ d8&9>zmKi4I}%!&GAϻbxQɆƟCW1p@8Oc*Da{'{庒>&>do^K @`[qy崖\SOMj{6>>,V QF)}T:̀ IB=RszUXsN`Z ृ!RnDQB8#_il.,NGG-|k|{]ze>bО{%mo4Pϵ:S!plP3MeP8n5\[[xzlp p+$t1c($@$@$@$@$@$@$@$@$@$@$@$@$@$@z#`2ĉzj ::ɊLڛ^p( =vWGDmO7%ZF@rJ@z@IDAT\JUB?X:Շ}j"o ~;lM1p+B~S(Iռ1TLl4o~EJ1䎓q3BgRb"bcQx!uXۘy^k. 7n۴[GOK?XJ?2`OոWhV!5Ps'K{"oEf蚣#m 3on3z~q`ɜS!' _7_6?l{'pRF6A Wb"[->rNm<_mmV[H i Ȼ䁅PyXJld,~N|Gk $IIw3!j얍^) FgݳTc,@+ z}ep1U]D;R<Z#6tĞriO4;5y~|Q 9&sϟx= [}o~W;½{^y 8 Z4/3L2iJ'm>-k,$@$@$@$@$@$@$@$@$@$@$@$@$@$@$`ILJ@"`۷o_FHH%f_%=B  ¥E$F'‚ X~ Ju(:>m?@V% 15I;V'CZEPqLw6^YqE%X=H~{gaI%9h'G÷0^$lu3}pK{2udHH'I# 6ZfVNڥ) 2KG>¥ۊ{ wX[MXe(ɕ[V1Vu>_;b90Zm:y :%'&?hItNo9nY+qAD$~t̶_YՓ_{q L3ggu?S<T RR52tx%B/*ge1`ր Ls+=sʁ+7!Hg\{o,zC9e8_NYU񬇯o!N$@$@$@$@$@$@$@$@$@$@$@$@$@$@fI l@#uo:Bay@`ҭʵyyP;46Cp}ucwuj&7ʐ*h5U^t>kߣ\_YD@LpL14$&Ρ;Ng.Tl>)NCAךڵM,Yg_#kϜ=*6#uv-L$_WBoD'x8uwڸˌlC^mB|DA`l(U囕7*|[ΣXu/grJ{h5`3mDz,Z?Y̟@HvNSjפvmFߍMVfz\rI O-5fYuMݿN_VHHHHHHHHHHHHHHl <]uqq sN?- Cظp#wh WC6˶ D`Ϩ=զՊ Bv`yz; lF6Lw+o '*jյW9ÁZ\Ȯ,_̰L慼 XVL1vUZJ}r$.ʣ~O#|hmE0BiOGspOqU^8c+7'9f.vF}Wg6yN;6:"tבSNaتaS?ZpvYĆ*tE>oiI\ASF& Fl)& 9 A\"nur$IϑQw 'QΙߛUsu(#               ="}Xϭ0Zk+Cd~Hţg;]0`h>njppvȔ{)wt_vݓ鸋$!&u_ˮ `Nݳv#%Zzz/3DbljRkg8 nߠdG! HNJVece^╃W2oĭAez=_s<.1}M{~\ԲpN}&*t(jeeR5Je[g/ez7 0Y02dz~ڵkffE`j&du)Qy{3u#hT.ѪDk;kTX)'$掛i"!-{[N#nt,Zqi* '7 "`@@mre,,XOAS7hz3Cdm(U:6?8>iMi僔ČUO ѐ  +VիW1`L,I %Em|4<;$ I{K;w1⇒JAqv<\u.p)!&ڑk%L*ZTe2-c32$ڞnco<#*/m*ch1^w~lbp.✡*w ۞䋸dvs%Vƺp~*$U $ /4p{]"P{h(ZXrCPTaΪq8@V =hvP8v jx+G@:w0nuMD5}1ӪIܬLRU%ThVe4$@$@$@$@$@$@$@$@$@$@$@$@$@$@$Gfr}UEa3fe=&piD܉@}7wfD]wI "yLlJ.6IJw. W?ǞxyGf (n&y>p x}{f-:ocV-Ȍ׫>YZYvnڼ֚^ΗXX%85z)\toRCc>pt蔔/NM{D%PBQPY_ Igdh\ΎC=3[=SJ=n$vGWG8E98]2-trʬ"R*~/\3)ev@J`coְ^B$@$@$@$@$@$@$@$@$@$@$@$@$@$@L q-0c |:u FȐG`ƽ(rw($p5:!h]#89Q-7TVk}-#LuCP% 1$F/7°PeEuxV3>*$옫"jXZ{l)^zjnYq~%KӌG!n$U;8;ߔ~}`4J,~7?c~Px!E@ơ%t% qZz&@mGŧ>E5=. ID(y4ݑeG "ExRh:)]2$ݐ]wG?_C?3][~U"cW[M г$@$@$@$@$@$@$@$@$@$@$@$@$@$ ؚS ׯcذa(^8ufNXn?k{䓈[Ğ/U6 G _\J Dp(޴c{}m50A눍 0Υ;(]clXYYZB΄`[{n//][ mעwIn^}޿`JA$I\f @UI֛K |#Lp>s\c LPM4$ߵ{F̵N<# X?qrۧnU71Jۚ>k%sAgGa-0o<\ 6.]m\Sd(IHHHHHHHHHHHHHrC$1c(I߾}j*n:7"c/2P:^Bڒ"HH;^D`jB|ҒC_9GRCQF1D݉Cx$&!%!jkǭT!C`[E[GWW]UU&V[``.ZI:Xbʽ,&mB4D+ͫƭR$z9/:,w{/I IHזrmߵIxږY{{MMn-D ] Efra $'%y\d\Xk㝜 _/ Gɚ%qb݉1NR @7~ȣDԆS"4MVTaT]us> qFRKH?yFօ:}~:llmL35]A.>"k{g{X[pQo3_(H,Hr?*sac!oǁ텸 ot;lX4&"F=bc{LkOViRڒqc!8 {&*sC/{Ms}-f!ȔcE;qQqE2q[wy'".jw/U=Ⱦ=h.IŚ PlDO_u!k2HܦzϽqܜP :G|3 x4; :&$"}#11%k, hD[brPv41j3 hkgogٵ+\|\pHLT:q@ʠ*prz|C8$Zҭ[ 7xzEl^ geφw;u®jnS<윶dZ[E@¥ H"$vA-%zgZ77yoY\:߾-ب"km ӞKZN4"I9-!CSןrt]D5):qܟsV @6|綟Sm>2Rk TP >}lyۻ.jt5@ۏUg$3-:<:U ĭd4)hLIIIݻ76oތ 6A-F#pq[ߌ%ӗw{۟h݇Ϯ#p ?s,O8<{{H7E8[ithCamfmq q=D8j3rg4"w$Qevo͍"IE Vwqbmo%e]QQ<:(\0윳Tb7q{muu#")vPзZأrѹ(G]DK\fd-׉\r kkY ):I OD|wW[Bu- /WeȴK.(RZEEa_Tp8`?- q m1|pl^nsߌ߂TB]g*bˊjǮ#|rݵD8C%UDk[fV˿VV^u ;$v%#$J,nI+Y$JV/J|LE+KqJ ')E"uxXHbZkuc.3t+m%6m&ow;8ֈx@>K2$n@ED+NyWFjگԿr6WYL$f뒴%QWD\]nimw]B;u"!$g͵H^4wK;∔ޝD,: .$ÉYuEw:tE .]RVaYT\=Jk>/쾀.ҾKr-gڿir}=P\BަuJmr/9qɵ#׍\DsMo"]GҖo_\879i/yf8_ kGbq)&Ӊ5F琦kw$1GGKK{KdHOWPrqqy3U{Љ7rZ|ZDD<(omˢmF"s>!Z;XgAaT`E?煸dTL JJ*uJ+~O 5c!             0?f+  ٳ'oߎ5kЉĄ NsW1}';\$x] ;d3-?ddH2 P|!sErA'ML"pQbZ\/4aE U xAf3IqIIK֖m;%LiŭPKZ5p(P@*#ݣڢzk@f͋dnD*h*קf% ñ~c1hܕLI? No>[Nk*[-%YDi O$Ww## n# I+KU2O_rR8{;F"i:Pִb$@$@$@$@$@$@$@$@$@$@$@$@$@$`f- Dӧr!YjZharl%[ @fxw=Ou3[D\n0wid;o*,1ģ%U܍hۜl i9t17bTߤŚj6)n9>++˸:bu" ފZwqG]K ."ԵeALD> >:x\# WGqrIߏGQYkZN%I)lwZ"-E2ej2)S?ty|q_s\%TK$ՊCd-3rg$`f\Drug1CEL&3_=|U%kHW9/xREUɺ={}^;-rD`#?Ir@o[}\OCoyvl1uKIIAeïdqr5D(OՆ8EQ<k۪?[5P܂NkN#j-.%&m2y0ߒYD"@WYd.KFszi%r_L2J-B q琡B#7$^9xE]'(\G@S6( l             0f/ IIIxrJ̟?]t1cz$6-nv{~?q'Dђ1W_UIIp)bS"p+k̒8v}%!,"/ڨ(|:p†dېH`u_R3i{?2].lg8\Y a_F@_i:O۳Z0x$vQX$ h+1,"UaN;e-I"mR#U.'2ka??O%#xJ**t2kO(Wq EN:'eKK^VÕsĩAD 3=srG犠;Js #^/] |Q6=Ltfˎ?=sbE(\kB2As΅:ߤ%DwjwpQ].AbEQ,رY_K41&E[,`(6PT Egꂔve;?s\,+hn1 hޭk$Y냫;>ȥD5}\py4=C=[=zوf00TfM븾xw!Q" c$Row";'s%voF~$, )(L 0&`L 0&`L 0&`L 0A\Huff&&L5k`ժU;vlrJYHDXu\= J[@ Eخ0^aM)q]0rP c󩱩?.6䰑 j޿:;JlqXe$g߷qc $%;8D mcפDYAυ+) VnX~aϘ`~VH;)& ¹@Axp=#=irI|↋afE!&8#֮Z.XP'H$DAL+pZ+VXefPmW R&eqwre H³9yGn(P5^nR39PYF3[rIdyɚCnJ(OÚBPRC#ƣ<Mq{E 574 :+5#-CI.m$>)xɐ&UG8]K /Ģ}\{Zn!&zuUTu.:ejЊѸ.m$Du&6&B ԰OChZqFOn<B9z# K+sL 0&`L 0&`L 0&`L 0(7)ٳgcܹ7of͚%=̟*& +=I'xqT6%vAiH-wK3/GCLV"0vyxOT=T(  cX|Л<7Hv_r) HaZ״OkѢރn]4~VZZJ{~G~0mޛ[&w&Xwc"(|?n ssTBiwzr8CE0b]QݚZP_ϭ:3π\99ncyzJp9YemKp)1V_!+H Cv±DZ#˗Q!Q=wNA|xHz/hV#?,׾[orX%BoO@oj|Wfzo/pyr9'Z} lK}QɤJ۠hI5 B$3bR_007@{ G> qm5$>K}S{uk2'+cvx[7@IIB5>ܡoUZ6=w|CHw^_ظب eЋ;s/ ~ AY Ǝ/v޽Ojnt+Ws${5uH0bt \0fe>5χA`hY@Z>ђ0,צ% >E\; H1&`L 0&`L 0&`L 0& [ u/00={ۇ󸫈1#62K]]Lɓ3Op+mg[4m kW 7#han };}}&$vP`sK.!xE0:-`P G݊Å/.ɩ'pnsꓟ$y2T&nǺj?䘲~z̮B!GiZ,l@|CO;a̕p`R^=z c툵ph}*%U{sr.$g_4,VeuYmtzJpr:a84sMc:3L 0&`L 0&`L 0&`L 0 )kbĉpwwǶm`mm-=ş & +Pg f$w-v$E?F4 \&&\:`*V@aV}osWG8TyTyS#O#t5(j"AM狠 ,VʼBZ2.=\Y]/;v$] /D]:1ֆ"ز4ܴ#tROϓ~[y-h4 LTlG^DEg~nDA9iRQbRRn:QB͕^<[x Bm ,9?Uyr ^&|t2,-TUu< ~Zh5ݰ|R"nD`5x9l`rǍKgL 0&`L 0&`L 0&`L *yرt"##ꊣG6$'&CHw~|1v7ލ̴L > 6d꽫cAliC[Z8xE0|&Jv ڬjoXiw'N ;`r) gxDPNU̼4WfC 9ZjbYk}0i6b.; rc Ǹ1.ynX=dX;{Fx D9G3υ_$.F\D\=¹3&]RmOySNL5uZ(2HOll Mh'& #K# _1g#-9 pziy.UzSKO0rHx~޷ 9o~?7ߊk[/ Py}@N%'`P_ $HK.y,˅RqRYF5CžY{nh 0&`L 0&`L 0&`L 0&Ԛ{' 000֭[cŊh޼9n߾U+qp m״FYG^sgt9!Cpf~zIBhN<:}{94=;ڬnN68>8RSVdef)̒k.] E "]ILbW;㰼r8u¸-xv ṯR{xh>| zZZygL6.63]̣_$$()tm옼CZ}Ԫ^cv?\U爠lh#<'{*}S{蟑2$ĤwUVT1> nxT;X=x5l~Һh:p|:0SzDEo9_`L 0&`L 0&`L 0&`&^ Hv͚5ラSbر#>|q(ihjU+cBX[DuZS|66h|$RU..Fv]y]XmVAخ0DPHx=ݺswU+ln>lrQu8aDF+δ@IDAT;_,P 'Bc6pJBﻎUW.a @ ToZ]RS"P{<7k^gƈ#y@FE8=GP|E^~ZqG j'pl鈎_uĞ{@-UW{߰g 抨c:|A'&`L 0&`L 0&`L 0&`y( MMM㏸x""##UVŋ>T"o~tFFhG y/|e@a5Q:8YHWz)@4 VVz}smaWf+aFCKCZ/q;ޭ9nb;X԰J%aw22yWTc]sA0J$X[=t5L?VU\{HSNNCVeDydR=$_z]6fnȯGT"2 y^"XѢ:cv!9 ԒSxz)mzgTv?LMchn)`L 0&`L 0&`L 0&`L JkSʚ4i???|w0av!$jrn>^&TF>z''量Jwxz)#rgMQ[5Q|As<yusêq@,X@T.=C{ntŁ6%w^)i'@QafgVҢ޹Mvs<sTO>tnBwruWlx6FU޷ / =%]ԫʂ#)6)Gњ:e v ^B`jk|\zWpkS/Is (rC/|W;F}]q3ҽH$^!Ni >Z*9? o&>A^Akz̷` W5Ƅ}0}>Ny_z* Cs\y6FŊ?o/$W.GW@:)hxwNQn tHާ/zFz eAbe:H=[(S{K^cڰwCuJi'PHh>Qo) ӻҞKAU;W7_`L 0&`L 0&`L 0&`L Fؔ:::_ILLp#_իrл邑cKŚakpkH|̬7(m|r[ZnUJ{ԩPܠ ] l.M`P@ŽS-BN=m7RR,=/ 5=DEXkj vQx\~)UEӈ+GK3]Ï ~/@Hc-Jo^THƞ{SA7 eqAoJw 7+ۯcpJPLǖ϶ p«,k롮.܇ҖK g@k.0Tv~rLK$$JEA) )\љ]#;15uJSSSClAJp|'z'Mee=rkgkYqF;`L 0&`L 0&`L 0&`L 0A$LMիo#;._On>\K[K< VP`'iJր}{Z#j A"+MYGFtD|]]_¿ŭ|o\{WI4&MYD\sʶix1l]3_#G1b4߆W/^C;( /vo>9H\2)^vWfbʩ)]3hivڸuһB IJ|dsQmC[p;d'b8H(nԺ"W6 Gn97kj%\tw^_L=;&6&9 GCEM忦shϢ'm`b]2>E;w~rWToR]qd6( _> W5A.#ōdA͒RBHnL}Zv%61:7QFY\IGc/B̻¹{uAQu YhQCIHpiST{UUNeʰg%-ey}u!T;pࣾoQi Nfr,B,rʝ[qq^`L 0&`L 0&`L 0&`LH ZZZB@hǏG|||A\VQIo^gMV*+2e%* g E&/\¦VzB>Oˈhb+?/GѬFy: v%g9.) sx?]d\;{݅KZnQ  Ғ҄$w;+W^C qZG_$xRE.Ⱥu u,oI|$iy)蠁;)(ѬY455s+Η +(;Q2#Zৈ EӡMZOa'\;,ѰW{Fa}6CAWE =-%wy.,[zF.y=cJTpZcj N`̆1^$#5.]`j'R&#=CsXgPZpaM_4'@Dܾ}GJ]^jB?tO7VY_sGy#ڕ$住&o$a@kqͯ <k*`L 0&`L 0&`L 0&`Lx7vE 1bn߾bhժ_qRR8{B J_7EFWg/Ywg?>Q^-(ŧ7j S lObw6ՆY3hhRCТ j┋^]Rf|\6MI9nClA9U\ô)=ϋz诂&.+GQCB J4JW0ޠz]fgy BpN!35v]+TGCOͩ:a"{xc~<@=pBCVZBpg!DB ,b!$%Ip*Ӗ[@dguGMo&mow^q(W^?# `㸍]}7Vowi%G욺 ['l&_Ϸv=Hv? I lU0Kz,f |XW_ZZ1Pv"4;pDG5 :>ބ$t3< ~"' Cq$L*P6qۛ|)OH,Xh}gH:$er9RUEDB(hD3 W=IvHOT_CƙOW ^?Osm툵T$[,\(htk<< ֍Z#Hĵ%Nͮ5[~M}aJkV<-k[炞U/_bI%Byjg!r!Ji'#>SʬGSKO݄vpl(֕+ۯEdA6AsD.=\0|j'^sWgD445Y6?㒱vZ,]8XI,Md6.$ ?_#TV*Eގ+}v3JHv)#ki&z^{FZrZf;g8'qqE|W;i9}-F9prIq*l}xQ旼֣(6 D-R/E￪Hu\橢N 0&`L 0&`L 0&`L 0&qLLLl2\rE8j4i~)bbX{ݱgR/0 B)FQ;ڮk+&vڡ墖h ^>} bB@Kky Y g r{n. bdÃY/zVGQQ"Nm !@ g3A?Z \݂0Q]UScS2JOP^@fk  Fĉ!!:p&HRsHMTnXYIHPD.2Mw5c"Bȕ'9UX▢m#iw' }0mVɳ8(-_2ibs7BWu uDbQ+n~څʶ+"w=rCϙ[v&S[S uJpN°e"z"(f" vuo?=>\!>?9zgFRQ5`MnHߕ+c{ݟaj9 $7 .Tv"H=MOo=';?sTj)P4oN Ig]=QҮ m?^d*Oep=j-v@[69e' k9@rlJ_"ఠ!õ+hw~C Ct_'@# uj+{I@>%Jf0n8|ct G߹HX3xfL91$6i(39H­Ƶm\l1$1/6:I$:@|#G=-"! iwy\гK­v:F@'\J N=SUȅcCZZSr'r 1G98w2Bk 7rȽRy懾>F-#F WGH5Ltz̵MZ*ǻ f ]oUPx)%=ҿCD$$? 3lf޹{9x0^Ļ"WѳNB +QLQAzg^Q^ FO\z7EsZ.D b5Wz?`L 0&`L 0&`L 0&`L sq pA899aޱŖ M aig;o'JL" a.W+]H1jGIⓂy#N"%:FFp IPARLum*D$v'fy}cQG7%76ǘ1޶{Lĥ闄xGR"%%^6[yp%B} 1' y&U|znO̹ NkFȆ|"G f|tƵ<*!Vk}k} ˒I\y4|W)"Q:G_yU  QCShMc7=E[_[du}HLJ#&,[DILoѮx]!\wO-\Gy$!2xvD|4(>J޼|%i1UExw\p4$q} ;?z3?yA'|cy sGɕ\1hxigPs<)qGvt]eVS`ĕ)J$'<|ĨF9RO)9\(Q4Qp>TPPljԿћPͭR^sP;>)MN)ij:)ܘz^M4'o{VQ{5# 1:Qud'S՟wNygZȵ*򄵲m>Y4x`phez{MYNPVyKnP$ ?SOOObg$w!?]!wY kг֭*ރHE N|Q_1*`L 0&`L 0&`L 0&`L 02B@Sm9bÌ3|r,X{V6F\Z B`iTN w ߇p:|_mv l:ؠ=?NǼ mo VBs-;;>76 B {vv9bTV˲w#]K3+3j4ŶۀwEWC33D^J\XHCIVr!!Q-#HZ|{Wڹy=e3T77(&*ϋ@{eqHOIG2_ebͰ5aԚQ\:(RRt,keڅ\L('02&IKEO4_e|6 n)7e#-/\BcZ}c噠7(G@N.s$P r:Df(OlHM&Cqvwܥ#AA$),= ~*L6j]K|%gR^ARwbeMoI@&2CQlB_w}~ HfU4δ#ߏ!`oyE~'?~x^ϽNVʨ4#-ל" r:&&]rK hi<4oCz"wS!/)]פ; 6#ge%P{UOplQV=[q[nQ!Q שnxxQDXZE)QIAiHrV&%,<36݈^7-t%8 SݯąrL 0&`L 0&`L 0&`L 0&P.[.Rj000O?۷o}􁧧'JMVqÖ x1P~fH87ny Bqf\zKs\}~sf1F)U+<9$g]};sڞg9xc :B*PLb>P6od.< t!ҠGiP󠷻#krSukU+<~ D"]+;h@#x}7E !be}+~+|lCw"Yj炉swg!-XS[.,c$'t';Y!ݡZ푧Q-Ny>rg*.aŋgj}~T9QP0cy5c@D'LZtHr [wQ~''悄zguGey^.۞ #_ pன@"-z(3jDW_Em1gϔSNiӻ<\xS/%2E)k\C:.(Jp =JAE3$zM|(GxHAW]հwCT6 R_:)tyy+lx3!"A!ȡ/hM򋚏DQ`L 0&`L 0&`L 0&`L@ DSzuر>>>HJJBƍ1zh<~X͢n x;@IpkRoKa x#`i FIיoNK\Q zC0WDmT C冕$|AJ=GɊB*CY[pY IrsmcmZ!qzhu|тwii+A tw]$=Jl}vΑr)y:JBs23-5PhM|ds\XAibL;wueR!gCp"m䪑y=[@Tojn`\8<x*l vANONǙOqL_ά8r XU֟9^(*161~腺"h02=#=Tv @8w/(($Im\lD䎠t(B U]׳.mu<3wfv1|7q@Ṽ$%á( dӓOF >u AM5ԕ*' HFJyI=ٵ}&W r8שfH .:,bBR五$Jk(1X|"O1 HJsvDk|պUqpm9O-;dI/Ϩ(@^BQE|Ts%Tt]G!Ww^YUQ3?dfWd}kFvyD.SMq`eV#wkG//%Eʛkgiݳ$PPr#S$)B1-IH'&`L 0&`L 0&`L 0&` $7|oٲ%|}}e;wNNN1cPz,v04Ow1\::( AJ ot3$$owOIJ_}cf%MT[o)+YUBJd ' !4)ϲiBzz)"F"-. T_zb,^ܨ2B6gq"PuзӇT_,@ܭ8 ŹO΁ kȤH\pziXn3J"Gf`~?)Mx4 Γ`,^E[458 ~\s/aP@8Pgvf;ISzV+tɭt/JJٻ+ -w;u(JIAw oT/kW^yx&d*"Cl7vVZ"&03dP> f!ࡋҒĵ>NJ'(Of h)>ȾwrDhG=}qE:,Ri];xoV-[LHHIM/ʧū֩ M '{..8hnzpm` .j1^* Ş%AMcs`I%oKkɽoǠvha OVPDWU$s%eQ- (,"_yԄ:eߣhRyG'/@WRڋ'/Ď BX*5U>íchLu s]s}s8tTI$\5Ki8fvϨsd_z)޻_/ ^m=m1" gDd~J!&HRt񂴌>_qos-,kϓȀ4Z3NgupeݨuUqtDA6TvḤ2i#4:Qi9$ zg<,  {2tukW;]CKm>m#&mC³!t%zg:gRlxΓ8<MnI.(:"](?YXOHTh-gpׯ~rL 0&`L 0&`L 0&`L 0&P|KR/+#@:;;c011ŋMMMLB9I HHn~>ߌQ,g(Bjc{5ׄF?kp\:.FHTQQ< )Q)0c--\yĢ$?{-~n߻ D>jIxx!Zpm%PRX6iAqp}h-tLu@uCp0xYhw-`ho(y.]~EyfѿG6u6 ;72/^!\Em:WQxNJ&ۡo͡g'J2ob,u!B#e3Kplkk&DF5S x\ ?O肣o 2{61*Q$ xx!ⓝvCż#Q3MhG4\-YȁZBa}.YE}8q1KD{(j츂5֠Cފj LsswgX(hQӶ/qpwQ>GZ{D!~Xjju$v:uܦIIŸ[/ zH <7K=>;sToZ]lH(E0UkWEY_5ͦ Z)CDB$M1~h݁D+'6R!kaBK84^DB8*rkfe( ao!KqQt=W7|Y6M-{^=Ft?:#W8[ö5b͐h_x\ܫ5-=o89ugkK^D4ܢg9Oim$gDt䵎HкO"!"N$\cXG]whKXBCSX҂,$?`L 0&`L 0&`L 0&`L [xaΜ9=z4ʫ$x&!4}3τw7*[V3(9(ɐ5%'a_}0m.-eb r! N(Ils4"\9+Id[6$>L8j!il~E~qEw7x(H˸m #G#+NƬ,BjR ͆j@.6/MNG]X˖ߟ]y};`H@b#@(yf_lWx`ga?\:ȥ@XN>䎠Xd6v^\ he=lQl>zENnkޟù2ʳ콳ⓘv~j3.lM" OZ(:3=Q-4(ڗyVbCl*Nɵ7;y^LeNcJ^yCʼn/Hg]K@"&[$.j773?dStsz]aƱ,в6~QVnvZ sy$?4J}3/i;I~m+_cijfAn>4f$!y\Ol W@EK7YrX+YHUW;uu,jOhK~ K|ԓpbL 0&`L 0&`L 0&`L 0GmDk{j1ϟ{W^0aׯGzn%]q%(2[8qqԘTV郒^<#tD%bqLFLBߋ+kuLtyr-)"X'gxs#64ƑG'\\lL #M=M7{GhJfpJ') {8N-=W8F$2-83;|#v/ NO#u.\=RxCJ;iiúƒ| +K}/bbɇՕ˨B=]wCRi*t:댴irTr4< mb T68ة89Î/w\2%ӔRS l=B#GXc)w~?+&R>.7 ;,DݨRkTk"!fTwD2 3!.n@#@?~8(gm[vMërJd-T;PF*'ȒKD`?+K|WsYlI%­e᜺ϐc_BJqUcL95E+?)vW)P %Bυ1y]Ԧ%%]Ğ`L 0&`L 0&`L 0&`L D@{I*(SSSS̙#GZjpt,? HNzzXzt#L-Ls~=d% QȒ7xz)̾"4RŭSG7ҳhwTmYUq$rboǨ޷p)FQ|@$xuBfj&zJU+KT@#ogÿVoZ]fb]SwAD5PX)(A |wxF©"S-pf'#E LlL@An-l]@vjhcȢ~V}T2ٞĮՖVkTMi5( .PP \0C k^AN=wNA^ @nDC .<v9TYE1}3}+3}s(]R7Wc6)%(+N^rh:)MNt66)JлOވ ERlalU]\ӣB-[Uw^g|l2j4+,a OaI ZpbL 0&`L 0&`L 0&`L 0GkI*{.-rx{{?<==lGgגDӭS?3ΐ=ϑ/D䧤uk(D$jy+X^ ^F4_|FE-m>qpa x]@N7F 7 G^=t=v %N؊o`ݹ-(J9%{c=}7Z|V  J#JnHXB!ш+ $?h2 yXߗ4A0EbBZaزa*<(Օ!^/$:OM\.|HōqףCImf7P:, phS9}>X%';,B)\I.]qwq(cxTu+3#gƉ?Nوf`0\wMkRSA4v%7! *T4ő_QCm!2R.ЖzNL 0&`L 0&`L 0&`L 0&PD};֭[ !Iլ7 7cJy; t}% sCԅ(ܾw+i;.o~]K9Mv~\ÖS`|]N<>ބG0x`Mhuvk_Zmkp u ".3 YCiܪs8,ҒV<3Lm_Jg>Hd0SQD:Z?GkU'vokmu֭P IINHȞB?-8@IDATwssrs9{||~8h;4qF*rrk:r+(M/ŭު*W u,erޏB'ZdM|c+1Ι eíQ3*r**||a[CeD=K P(@ P(@ P(@ P2 1~ڵkz)lٲsUAikݬ յX?s?n^Y{/\پ w6au|zRIw~ f ݟTXR5p*MX:#'Gbk2:d25wfC*if:6R*em *Ƽ@r]ȿDN<.?*r+!%RHފ +&*-)MVvݲȼ+;45붿lCظ0uNJ >q?9~zc_!$')@ P(@ P(@ P(@ $f%7hΝ*H_b޼yj$@^z%l`3䮁 ~o%cHtoonɿıqaO';K77_O+^ߎUx-B_cCUIAn}cȶK@(8(CݱlPHʳd⓸1`S?Æ[M קTݢgFcCXwN~v$ͿیFPX¨0@O(@ P(@ P(@ P@ AHVdf .:<ޕ:ｂ1$H$LZGռ`R]]88I<01ѰHosr#H}9Q]WOC6=(\Bϯք_N=ODVxN0,L 2;'\ȏ:fՅ_UwO  ,֣2R >'3W̋nk Ԝ{ǮQ.r~J*ea0z2,`V$hx4^8RץQU)6A+L N\?]K [WoWcxp,n Y{l36[>a>X LaVIJ5ݎ1>}&״i Pgj}Z3RH5-5{k>xl(@ P(@ P(@ P 3 ɓO>+b ;'cL KnNr 8QHbEa*y dsX܈iH1ptN]^=yg[badwhKőf #xLyv nH x7!ooaC0q69P\wCj\iM 5Аo/pf5>~%o_^O^k39JELHcÙ3 D$$.JĨ+Ffߑ6@*7G\uf̌HXlŠ 6`Tْ3+ Z_᫗RA1 H n}"zFrM%*P eprv5lb_"a/mVWeO-SG{_@* IXh{!4I}-s,-4'\I! ז֪t י2\P|C}g/~n^nm[ؖtnϳiNznټW{ܕY*0,bugvGne"[ RqC>H\k=QKő5)p9'Ժ7.9t~|qmLSa#nnbg"vV,mwP~oXD<ʁejowzz(l0R!o_% 3m"` ndmRdи"-`QQͿo0YyL|.Uaol:nk_kFuBI7NBɈ͊j:(m^^U 7WJ,2@bg(@ P(@ P(@ PP 0@2ݻUxd͘5k"ɢE e61+_|/ot}iPHz j8"F jegܝi 4d&\,.>W}YʲSާy|+{顂#I'-a CHjXc{\xaYҟ>~^ن9&5Y]:>QBr~O ,xͲc( {g 5I?5 sw& nNbOgl̀Tj2>aAsNmݽ^\$ !3 YIv )Q9u$"'G"||l׶ (:d5{ *0"9H2A+^CHeϭTrtLĔNQ.ӓ[N5"م׎AڀWkkٲzKELB U u(zrM(NH5rH ujxVܦHy? g] Cz~0@2О(@ P(@ P(@ P(@ X$w|Ϟ="ɦM0c $ꪫ{)h+W⊕WWi@ח!@pmETxK1+84;?WvTBR,Eٮ24Wv[ Rk"m y2p]!2D<7E"HxXS͉-@HAǨF!P2@ag_~ӟƈF-KU=o/N@/̊Adf ]3Ho:ֆVDMۧcVԯ̫Tw Nwvwƨ+FaH\8ˬ6!mɉ3ڮolUvt}l|6IB j* OcB!V2kG{}Xzaqj1JN’0rH5EOTg+bv/L g\Ң$51*mnM4iDQ- ̗Ѓ$#U! n @@6h`o2EȀ3Π"(*Ss~UA H;WCDŽ"l|"&D"]m '}!W[^ڂ/m+>TUpp暸AWhonW%$)g13clVU$!-Uٕ..PAڈT` >[W\7ވa>ðv4UqE&X"zpW-qs+k32I?Ke\= _Qbg\HLN;cE_vP߫r?/^M^ =97_@F~t88] Ԫʤ/d^ST6/U֤g+ź IUS<K·3LRJ+uߙ U  ͹ao;Hzkp(@ P(@ P(@ Pu 0@bsTTAkbҤI*Hlٲka0iC:V<۬:@r16f֪@T@I]ȩCcY[OKE ڗ4\{9Nߚ$!a Hŋ VilVw_+A ,xǝ hsxo0-~9˹Ruj5Z[_ bsuT/'2 >p}\;O$ځΖST+U^h\1b\w@HUтB>>vnfCH^Ϋ(?Er|HKCL`Wy@i= \|+¥*TQvNiU[չ$dl3d-2lywX@!2 npԶˇa*2XTW`Lw_w5Y\˲K\*3DRBZ9 =ܒ!c,2[L· HMRj+h!@ڳg(d h{s2X^/'d޳Uܒe|Ad]]w 4ܤ[>7JLrN*m ~@7I7WBе]q可G.7# ޖ1](Q>}&!ir^J u7L'#<3 y' VIS>BuXd.|l=L}OUf=qתr"ʤrK\ ԖhAKY#.=!6EY%wrjknS} Iז֪PN|TM]ɇ ZI`~B#㗏W7#鏒Z^BޓC [>K-syKѾ_eڵ\vu\;CMg RjOת9&ygOE 6IPNZ]Dלt7 P(@ P(@ P(@ P!ucGqa$Yf Ə'x_3" OntE-^u1q[ZP'HJ rs\D!Dw$u` h.p t|]=(-;`rYӪ$UBZLOD HD-8"煜r%2хNTE Heh/xTs'jPd V{*),,}tULe'(]Եl@nn Q/򤂅 h,N26x\KT9q`T}{H>m *&izen6:F>oZ:mve 5kG;w-!v^- "2!*ɹ`.p"ł)9-@ n`y&yVz&;_ a̻o> 0N1 "S4ujmת8-( $ s9dRkReGBZRTsБ||#pb y| aҍ*P+_pTJk sG7 kOJ?kg #[hUMl= t=o/©cU_*]xN*ҿ=F-( zZ_*@Bz낯&u*^YkX]DDTْkYy\X)C(@ P(@ P(@ P(@`ļ;z(y|7n XaNav9N89;Oʡj@k$)`C?9?˰ qP)axU,׵j-8 {\,yd f:SGGgGH ?*6B nV UqODpb/$uJ P(@ P(@ P(@ P2/s=fR}?FjjHr 7`̘1x!CyGUGGG_cUxc -TͦY`O{m 5;(@ P*YUs*|X@L{fҿLG‚PwR7^ Pe4iĶl×Mw<,"52/NHlϏǃ_=$_onlvg#vv,z.La"̷l(@ P(@ P(@ P(@ P g  v$׿$z+oD?tV\pzn~ $ @0fDp/?ބ?Z` HlyK@XKUG2@`,zh: o'PUP*I5 ̼sk,[4h֦V'8Le DL 0@b}ǖS(@ P(@ P(@ PG T^z O<{9}xgTdժU>>6 DLMgs\&Ga#Kß qa" n(`.MMlVgcUM?F$si"a@ lϏ;\9΁M @gG'2fA?>Ay(}R(@ P(@ P(@ P(`dV 12l>77?<~mGwq !*]~ݎz13bE $"9cW tuY/ yNU Uw/8rJU>髦}=l:~c7HENbf`.L#s,wUhd[}pG>9zuiMS7l c $@&(@ P(@ P(@ P(@ $fAּ|$y7*~prr: tvvܽ_oyb<B 0EDvWUg'<,+{>HOyD@s}3;_ y&bcƝ3vU 5!em i I!|dlO|q)kR.UF'cM1I'z (@ P(@ P(@ P(@`jָVPP$o *$ ȑ4s~ ?d E@K?x?bwS` 2z&ޙ=oPU&9A‚;1TH*]t4H\π7 0]˸'}ʳq|qOEW=#% w\J ҎaQ(@ P(@ P(@ P%I/ .^@$=z-.TV\~.qJMq ~;pvO~!Iaڏ)oڑǏ> oS 199wH TV{ދJ Ŭ*P}܁c,x|rLU_LܓpA@IǮ^*4n8]:%e Xi(@ P(@ P(@ P(@ `/_oÇǪVembPUA~?!BDŽ^(@c45;~ 썱nC*ɐs0|g6"UG<W9 0@bνöQ q-EhH>1lg-N@GؚßV!4Y'[1r[ۑ''TS|==HHUӖx`İ(@ P(@ P(@ P(@s`{ ڤ ttv`纝/`{;! 4G[ ]|As;((âa/õuG Px#b0}.W˕z0@Yf o?3돩LU{pӶ{WMU8MAcMrdbhD_aӭ/]t: S7MH\ }OlqO b)@ P(@ P(@ P(@[`zD{HQv>GX:a撙X~r̾v6k?~WckTu/Ƃ-0^"(@ twO %'JGmpo0$Ff)`AHhPS7#4 shmBچ4Hh$u} ̌Q EC3نTTTI2@ ݡڦH( 0@b Hn(@ P(@ P(@ P 0@bƝcM+چmm}[{7|o Yu &'kK45aK[[,΃K)@ UL#VO_ WOW:T,prLT *`=*P]Xck)s[&ZExL\9㗏gP\;vW#s{fOh"NnNQ GHp]&i 13B P(@ P(@ P(@ P`( J}+@ %%X:g= 3 5*JI}wѥ !yZZ1*H:&t)@ -P]gx`ppr{R)- cá'`hqab5c|~u?Y@ȩT8hU|}gww<0jo* dl@qZ19)Hh88ِ ՜ 1a(@ P(@ P(@ P(@ F8r+ 4@{i*H_LDM'cMZnmjŞ IΎb pvs6" P_{$/K?!P!`dcЅF~pPU/ IԵǫjW6NdҦB)kRpl19u>>*$},G2nniP$,"S)u_Xr"axyu6+v=(@ P(@ P(@ P!HlMy ѵڀ-oO@EOV G^:yיv(]1IyL̊@+>'>ٷn6|Ccu#$|<ƅ ~ys 7Wݵyw rR䠶S ~acꕃ]Y0@bFXT08F@+Xrwvt"wO Hh8u(] ݾf,||,ueuޙYޑEBX-0UHܼ8[z ޾Q(@ P(@ P(@ P 0@ܠH.k[3q#N̵%Ÿe㐼,80Ɂ@yf9c1~xLX1#Rw;U_/j|F 6ĊΜ>B#?9mw4rӹJ# XtoוĦH]5Wa HɢZ_S#RR#Aܜ8?Ta<.`:K P(@ P(@ P(@ ؤ$6?@֗JJ6 %ac0zAݹHrr#(=Y @O$_0..i>_K PO=o[ KY-#MsRʲpӣ8J7V*IF,gq|qU4 #ҿ{VNUF**M ]5% 1|Z9 Y@ P(@ P(@ P(@ P >#/_~ua5=#ckZ[:61K zf[Qg6kU4*"pŏvvvP 1^`,Up Hhx <O t4T5+ /? ia=DP-Nܼ8=)@ )1 T0p>7?R  3*|lVoq4iBpR0/B#Q8m Z-'%. |B8'aшښ9o{k;ϖ;GMkahሞ1j5C`(0$ ;wJ P(@ P(@ P(@ P vvoD/%-!H$ҿJGή6B ID&zo>یY*[3 wGPu7itXxy PZ'H1.C¼ʳˑ6ޙ ;;;u8n8$_ V0Hk.0"mMm*x>j(H%B߁4kjKjHBj̣Do@`2(@ P(@ P(@ P(0HX@rgZ+ S|}77NMs4*M64 k{2Dl)DWGc;;.rj{{~P%pi?;cE`|mh-F*6ԈRN*[{ )kRP^a>01Јݼ݌n%'K-\QWvFd>1m~#\ SGMQ 2:3"Z5z9.QH7+(@ P(@ P(@ P(@ X$ރf~} ,m-mjRYI6c13c3+b99Ύ}F6UUJd;2^%#D(޹OI#PW^W{ee0?vGj1 XLWMǑ>M%\#S4TEThd[ΖUҗ)l\(cvpۗVqZ_J* vuv;[/%O"n^ n]Z@ oWP(@ P(@ P(@ PtH,ʹ@]P,(<\*dVXB$(Qa-"zS)6$X7jo?Mp7 PJZZogGqnĂ-#aY$sl`Pp@F$4 hClP7@YVYO ԖE$ ~~<"'E~6^+ z"RaD*6~Joo_(@`2и (@ P(@ P(@ P(@ `:RoDT]]9JJO;F0#<|B8\lZFɝte@,7V7j ' ?RdgcSk1i[PuE $}l|? 5 8ʼn*#lY 1WQSDztiU PUܑӵpvwV%,"f嘡鱚S5(8XZy}E_(tL #I M7q6&u8(@ P(@ P(@ PIHlۍ@]GTD*UA889 t6iJTwum>E*r+ԝvURL pJ%#<.>E X@چ4~5}rx .w @gg6wb>sz13cC#׌Aظ/)]90;XW/WH9q: wE#s h8q*#_$#sVc4mpo 0@(@ P(@&@IDAT P(@ P 0@b};GoD൝KUUDGё"5E?z }{rENFžٲ0}}ư0XJ%2ޡPq$TWQUPU_I7N؊|$`Y @v2"StHE8`o$]׌E$y= 47vޑܭ DXύWsFZεD .v DL`U07 Xsw(@ P(@ P(@ P@!@]w}s3h%RPT #AAppȵ%@ɩcL)PY.89!dtBƄ tl(BDŽ!͍ ܆~~k̾g6n~f89`M }۪*nKr>֜QqzW%_/нs @kS+R㛎x ]UE j^2! e&m.׾r+UzF.>4T)*WE=Az@"Qj.a7/ " ',% P(@ P(@ P(@ P*K[_{k;S{+w蕐I{K;]@bK$ɠ^ HD-llywaz$I*d"s>?R!pxwԝ]C|POHۘt'm{඿Nj' F@TH֎,7#xt Hh$nnxڋ_ș3ppr@0ΊE̊җEf rH P(@ P(@ P(@ PF`Ķ} o2XDI]|UmVSm?ƅ!,Yvv>uuj T~vGI$P4*H  c(0Յxב7K_%\oŢh'i=ۏo}vm{y$%P_/{& zy`QL>1N=st/O}IžVH9fFwPD#QS1A'Wգ8RUDHiz):;E$#Aw''-} P(@ P(@ P(@ PC/U@[je^*RtH #j0+BƄ"2xK-ks2ר VN ,AcuZEI$PM2O?Px__}wy oܲ- 4 Yr oKoRy V[3prIȩbgbԕ0QUAz# 6p ͅFjj`goFNG #r_P͵wu`TIB#6j/e9 .|_YiqHlS(@ P(@ P(@ P6!MtRMf5K$"i= /u7` T I [%'KՀ2 jZ~R$0> *T"s}xpW/aJ3Jo;_5hs+%w_zZ-:897 )`0 2eBt HԔȕ̀ ! *#r*,$ A DOV}js+*/*$D$("r}/!g Bv(` Xw(@ P(@ P(@ P(@ $<"oDrPQ&wօJTe-Ъ@*P2;P"{G؊25PueY/w Pw'@ܥX7yqZ|)щ/m/|#}qnCܜAn/@)M_/ա_!bb%?P`R"wO2-SUK*#0v/_2 #ZhPZζQUw;⚗hkR@ijPR0,Y \ $<(@ P(@ P(@ P(@ X$Cr@]HڌwՅd*TrR]D,@%!81XM2L~ PEZg0{r5)?V ha]ۛ"FA=mHì/n4[g12plwXwes~@[s[w`d[ CGk^H‚auдF[A  hsSU"D"R%FB (+*Ov=/x YU {]e$4nؖrk% 0@bIŶR(@ P(@ P(@ P<H.ύk#oDi|N@%2Ȭ4TIJO~3Wr挀%h-T9W~-e5j%Z"(? 8jwA~~jGwMyi@><>d0_/üw_O{7@$=y,{r))0 6Sa -4"-1r'G|}=ȸ55(<\CڤͥHZS KHD7I5"^?\B*DӴJZhD]U[* ň (`  XC/(@ P(@ P(@ P(@ -I>e wl6W%  f,g^[3xX 0>Tqtv쵵K/ݫ%P%.ɭC~?[~gE /.Q! d .w`,.ؼTXzlU?ބEI6B2g<z Hܽ:KMެFAȹЈo#؆d;,r.("uMfHHG}*QIxo+E# ~]]D \r2yA-0r:4[Ue ᐐFƇx -wJ~QE"uCШs!`H`D~3+X ã 0@bƝæQ(@ P(@ P(@ P0$f7緆TȮPaVA*$)>.L?uwr PI6U*HWW*LRP`\U0ikj릱{B%0P HDۯ X'<5j0yXxzYa&*O~{g awyRQ]ٕ#. ማ"c1ߟ3JJѮ8XG*Jn. CXr H`D"!I!-Pך5"'tlI0UID > j P B(@ P(@ P(@ P(0 ][-X[K zHD=\:\6#@.TҳݭYi#8[q;LJb [.F}E}ϖܜԾ{%ZD-kaUՓw tu m@F\\U66a%Ggv̬ VjUIUHSm:rUI$ڿ' "a7 $bVձE H1E(@ P(@ P(@ P,Z>m}7_C%ZDWMD%jYKEtC`OعTCG&jز\{s{0g/-A˾{.sp ՅuMޑ0,x`:uz;DٻqӣH]ғRh6RMQSeHP.~wpa_I'!aߙ*6#gONO`DB (9 KPޞ yHu {N\cHE 2HhAUC@\# nsޖ!RwPD\;;U_%(oTHDsonν̶QC)Ps(@ P(@ P(@ PL#imn/@]yFU1@TZ-&dboO0]=D'Ohu햁6V_'e5"t4pIZ~+H0MRa*ujT&8A8;c]1yG `߻ ]:Fܜ88:;QHŒHېKUyUjU1m499dKU- *T tG݂|.! 2H%SQHhlYP 3 $ll|8-iihQqڤB""U@\WI@D"jҾt{{*(@+`;G P(@ P(@ P(@ P@`Q 軾Q@=!-T溊" ɯDuA+{h0E & 'r #a P(@ P(@ P(@ P,9M[0nU*` HCwuvH ]=DWE˩h"wU-y]idnY=/7MR(΅IԼײM<=!˲T@:NMŎvpunjg`](-(Nl>  ;;WJ_>ޢ* 7[EG??+^XB3My誋ȼ<\mxDU]D#;ӫ%Le@B6@bBE*WګZikVimmU\EĊzjl.@DAi@=̖{3swIdfys>yXr뒘x^Y;q_O8uA'L۷xVDz_,@)5yTa3"),n:tTeo9ҙREY y5笲HjS:ٹ'l^9oH.[lI "gσ!˩jfd d|w @ @ @}# @7β@o =~xK"bD UEݞQv6=k=ԙ*GpI_$UIQG8l*!PIzB(M;J͐9q/ }*ZMGk)}qu7ܟ9!/cUu㦏ӭyಿ,N<ĊC(7^W?򨮩q>kYEVܿ"hӒR0kƢy (E&͙TAݻ7w4R,HrL!gOs&ƤګHh0M)RTGۼzslY%6eΰHkӳC㧍 M:1dDhA @ @ @ mnGR҃zHlo}ץ;,lpBEhKץBcÎ vrY @@E T4 @ @ @t+ @-m'0voݵRHi#U) z>pjDPGV1KxѦPJNR&~0li*&MZK0Yĩo_)Pr.k>)<6޶;q7x,P N.^csx'vTջ+9gω?ĸ O|u}|m"Y=݁;#UYUy5yea1mA{eMC#=btu)"m 6ƥ#ouVm?k.!E%)c+:Xռ9l$RBȖ5[ԏSƸ*!yOI*K @`  [n @ @ @ BAxӏĐ{GbA@Dz7l*8 tm]jtN269q{c޿IojӺ)Uvޖ*Fظ#χGh^`3c bkƔS]#.Ѕq'/>xU>|Q^[o]X9|nK}EHdVVƺ'xNkOOǜ|̠|q@lC l^=UIAҐH EmkO 54&̘ b \$sʪ Y(޵yWFis9p3 vC'5uY!mG<>nx^i$P>y%[:bVlhԥJ{v)l%\RMR_!}nP]]yr[hkk,oz0GbՃghV&;sc gj x S^yJ~_;_Kx^ul[-nȍqwG yu˿%|ۙRlͣkH(RTIUOH4=;) l^9Ju)0~?-vܴqy[FFO]lJ߾ WjVCR")I,5C^œTGo}4!9䗝'}BL?u=L}o߻"zAGr&/$o;ط2Kxsgo48R 1EV?:ZZvXmKD"ǝr\6~۲zK>o^9Ru>-mVU$iȡ}"yP$ 6} {PAoӾnTVAT ZH "$Ҁ8 ɠM @ @ @  d7H :T@[k[`t()\.S޽e~0/)ѹ\9I9 _jShvG ^?LIWG QCcD 0!)Ɛw}bmg=[~119 9lU'~D|K?qi\ +f\}=w}~8<J  !{[IӁI'Nv<[Uȱ'[T5d˚`Hf9EJCjwhԱ6D "MyJIE /dR($U+d..ȃ HSTQ@)WUd"@e* @R7N  @ @ @ `zS{ @;F kڒͩ-KAxxIWfFIA`LBǔσ3B2ӏ<OTgOOw[P۶7[p\\pqO2c~G?+\W{v5}g>'aVC;)(c:FKC rѦJ߱!Cb1c1cYX40BE %RCv%$o$FҺ}+)*~02FLr ~i[1 @ tb- @ @ @*I@Ko =~Q ] U)Nm>w6)Y׸1vo{ܲ~C dv `[/?SP=$(X.ܹ>GEjj:C')XRMR%U]I]9RՅ+7PIz~)S SMcSNyNغfkKd,u?:;}׹1]gҽEqч/o XL:aR{r]4jwL{v*=W̍+otU5@HC!;bۺm)*H.O#15nʿ)HV*+po8$[~k}E^(b8H$Bwhak @! @r4] @ @ @GV^ @:bhy씱}ꖦh*Iy}j(]魱nOM>R#ͣ&O̗izAkKki=yXlgC4,)Xe\ڷtc1q1aք7u\z Ϥ>y-uuP͍ͥk_B5M;#nq¹' zAԶWG5?^q[s@Ȝ8N{iyXq#HY=ن8ДAPDQT(mKK!)>)2r<2%;RWWWK=Z_O{vuEȫYC )ؕARŠcO>P~ĸ,eyMj=3 @ @ @ @=8a  &H8"G Ma.<<({v.-oڴ)^/T`%7'U((y%{0?C `{ eTdᧂ(YEttHU҃ K7tPrk*)&a4M{۲dӓ?~2G4s~^'_I3t|O'_C:lƢ1+GqY 1_iL?uzw)@Tx{moDvmʂ#vwڡaU3cHi!#mkSyGw&}JߡP};@GNΒWJa,(:QG=. O?H  @ @ @ @@U eӋzXFbU^{Arj @a큓"XROIrzTiW=PA:IUPIA)MI^1%KRJ hʮO]q {tv^? .]3O~敛,?to:^skW`n-^JKui34E(hEƏCJUUUڦXKҶtؖ> |!TTu3lT{EG鲮Ni`$L @$0?{e皲|17{ @ @ @ @T ){ @`P Gz@>}=j)a}&E`e͖ضv[T$([k0H׵Ws會í)̰荋|G|<@rJR3 kzI=O6RՍdqxg"Uiil۴>}f\.R?$Α*tgZΈy;lHJF4t/m'U)"Et. @ @ @ @詀IOOT@W`!5ikƖ[by{n8A|їSuMu.__ Equy5k4:䟏) RvX" ڎ9\'@ @ @ @ @( @ҏNM !CDì|.F}TȈ#bdC߆GR-Vtm8{b욟S/;5޷4~>nx,tay+΍'~D<ߏةc̷.J/%ޥ)k53Oյ+ŤM[>UbJʖ_}zK @ @ @ @*C@2Q @&3eL̿x~}8邓;N^hgg^#O'<<3녳⚷^q7hnl̶S=_'>xfHMf<ϋ?c)2T-$H.ĥzuk<'WU`I[a֖~鏓 @ @ @ @ @ @2> @'д1pW̍y΋_vr^tǡ#ƞ{JWuڿ{m|_x<&?1֧ƔySb[Ƀ$0M}S|ߏrwsߙW%9xg};~[Hi]|~/$/b㲍]$U`SNJ @ @ @ @Q.OT@IUuUL?uzSӦGuu=nڸ/-^/k̏%- Jcwܸؾ~{ڲ+gYU z\_m\)sD/%qؼjsb; @ @ @ @([ @@ѓH̎!5%G}/ةc5<&xjjkگ=ͱp|C+iZӗ1aDL7G0cB9sN3 @ @ @ @('r[JT@x˞Ǻwރ^6^'/|-/f}~o\8-go<}k 5,N1uUU/(bMѴ){{;=]gLTV?8s;髅+NS: @ @ @ @BT@UUUo/\8mgܗӡzH|!7M^wvxߔDR]Kcy߾6.Kbo7Dì^exk~OT|霃 @ @ @ @T@uōȀ @ 0 w];76~HBɔOH|rnȫ8mFe- @ @ @ @ @$>  @*/9Z/hkm;b\~K?o5o&.Ѕ^iWSFn_1vظ/;tmIDAT  @ @ @ @ P$eyt &+wE<'\{="۶7-^?q8f6w{qo"W~ձqƸ]CG K:? @ @ @ @([A#$bU.{MO!@V/qޗ~/?UUZjF]}3lijMxsΚsĮB @J.{=T17{ @ @ @ @j˯zL\ /]λ^oѸ1F~7J55=~LAƝvƗ/r,oY\y˕1%rM @ @ @ @*B|uE0 @ Sc?zbo|`e\Xĺx/?]4/N81nDvo[-=H8{b-/3|Fe @ 9H @ @ @#- @rz0  @! <7by~'Ǭ͊/SN'MS9kT]dĚG{ƥ*fxv̻x^fpsv @~ g`'@ @ @ @ 7HoDSc"@}%cÎ=,/[v:rhL31;&FO#FƐ!1d萨V5Cj5ZDscs4jtέlk֧ƺE#'fg)R?< @} @NA @ @ @. @2oPv_nMj!k_~!u۞;7̃"),B#-M-Q;3PRW_)d'&1njC(ǜtL^d䄑GkXK p$e7 @ @ @@m]  @H6r9' @ @ @ @H3B @ @ @ @ @ $}o @ @ @ @ @ @% @2n @ @ @ @ @ @^@M @ @ @ @ @ 0H @ @ @ @ @ @@ 3 @ @ @ @ @ @ɀ:C @ @ @ @ @{7uF @ @ @ @ @ @ PCg @ @ @ @ @ @}/PtFc){ @ @W&jbH2 @ @ @ @@e T-эW@  @ @ @ @ @ @@} @ @ @ @ @ @~ T$@ @ @ @ @ @ $t7 @ @ @ @ @ $ @ @ @ @ @ @$ @2 @ @ @ @ @ @A@P @ @ @ @ @ 0H @ @ @ @ @ @@?S @ @ @ @ @ @@ԗD @ P9'V4 @ @ @@ll6hؑH @ @GJ>cX2 @ @ @ @@ =c @ @ @ @ @ @@{  @ @ @ @ @ @N@n @ @ @ @ @ @z& @3/{ @ @ @ @ @ @N@n @ @ @ @ @ @z& @3/{ @ @ @ @ @ @N@n @ @ @ @ @ @z& @3/{ @ @ @ @ @ @N@n @ @ @ @ @ @z& @3/{ @ @ @ @ @ @N@n @ @ @ @ @ @z& @3/{ @ @ @ @ @ @N@n @ @ @ @ @ @z& @3/{ @ @ @ @ @ @N@n @ @ @ @ @ @z& @3/{ @ @ @ @ @ @NIENDB`lens-4.14/lens-properties/0000755000000000000000000000000012710476104013726 5ustar0000000000000000lens-4.14/lens-properties/CHANGELOG.markdown0000644000000000000000000000017612710476104016765 0ustar00000000000000004.0 --- * Initial release containing the properties: * `isIso` * `isLens` * `isPrism` * `isSetter` * `isTraversal` lens-4.14/lens-properties/LICENSE0000644000000000000000000000252112710476104014733 0ustar0000000000000000Copyright (c) 2012-2014, Edward Kmett Copyright (c) 2014, Oliver Charles All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. lens-4.14/lens-properties/Setup.hs0000644000000000000000000000005612710476104015363 0ustar0000000000000000import Distribution.Simple main = defaultMain lens-4.14/lens-properties/src/0000755000000000000000000000000012710476104014515 5ustar0000000000000000lens-4.14/lens-properties/src/Control/0000755000000000000000000000000012710476104016135 5ustar0000000000000000lens-4.14/lens-properties/src/Control/Lens/0000755000000000000000000000000012710476104017036 5ustar0000000000000000lens-4.14/lens-properties/src/Control/Lens/Properties.hs0000644000000000000000000001065112710476104021531 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} {-# LANGUAGE LiberalTypeSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} -- | A collection of properties that can be tested with QuickCheck, to guarantee -- that you are working with valid 'Lens'es, 'Setter's, 'Traversal's, 'Iso's and -- 'Prism's. module Control.Lens.Properties ( isLens , isTraversal , isSetter , isIso , isPrism ) where import Control.Applicative import Control.Lens import Data.Functor.Compose import Test.QuickCheck import Test.QuickCheck.Function -------------------------------------------------------------------------------- -- | A 'Setter' is only legal if the following 3 laws hold: -- -- 1. @set l y (set l x a) ≡ set l y a@ -- -- 2. @over l id ≡ id@ -- -- 3. @over l f . over l g ≡ over l (f . g)@ isSetter :: (Arbitrary s, Arbitrary a, CoArbitrary a, Show s, Show a, Eq s, Function a) => Setter' s a -> Property isSetter l = setter_id l .&. setter_composition l .&. setter_set_set l -------------------------------------------------------------------------------- -- | A 'Traversal' is only legal if it is a valid 'Setter' (see 'isSetter' for -- what makes a 'Setter' valid), and the following laws hold: -- -- 1. @t pure ≡ pure@ -- -- 2. @fmap (t f) . t g ≡ getCompose . t (Compose . fmap f . g)@ isTraversal :: (Arbitrary s, Arbitrary a, CoArbitrary a, Show s, Show a, Eq s, Function a) => Traversal' s a -> Property isTraversal l = isSetter l .&. traverse_pureMaybe l .&. traverse_pureList l .&. do as <- arbitrary bs <- arbitrary t <- arbitrary return $ traverse_compose l (\x -> as++[x]++bs) (\x -> if t then Just x else Nothing) -------------------------------------------------------------------------------- -- | A 'Lens' is only legal if it is a valid 'Traversal' (see 'isTraversal' for -- what this means), and if the following laws hold: -- -- 1. @view l (set l b a) ≡ b@ -- -- 2. @set l (view l a) a ≡ a@ -- -- 3. @set l c (set l b a) ≡ set l c a@ isLens :: (Arbitrary s, Arbitrary a, CoArbitrary a, Show s, Show a, Eq s, Eq a, Function a) => Lens' s a -> Property isLens l = lens_set_view l .&. lens_view_set l .&. isTraversal l -------------------------------------------------------------------------------- isIso :: (Arbitrary s, Arbitrary a, CoArbitrary s, CoArbitrary a, Show s, Show a, Eq s, Eq a, Function s, Function a) => Iso' s a -> Property isIso l = iso_hither l .&. iso_yon l .&. isLens l .&. isLens (from l) -------------------------------------------------------------------------------- isPrism :: (Arbitrary s, Arbitrary a, CoArbitrary a, Show s, Show a, Eq s, Eq a, Function a) => Prism' s a -> Property isPrism l = isTraversal l .&. prism_yin l .&. prism_yang l -------------------------------------------------------------------------------- -- The first setter law: setter_id :: Eq s => Setter' s a -> s -> Bool setter_id l s = over l id s == s -- The second setter law: setter_composition :: Eq s => Setter' s a -> s -> Fun a a -> Fun a a -> Bool setter_composition l s (Fun _ f) (Fun _ g) = over l f (over l g s) == over l (f . g) s lens_set_view :: Eq s => Lens' s a -> s -> Bool lens_set_view l s = set l (view l s) s == s lens_view_set :: Eq a => Lens' s a -> s -> a -> Bool lens_view_set l s a = view l (set l a s) == a setter_set_set :: Eq s => Setter' s a -> s -> a -> a -> Bool setter_set_set l s a b = set l b (set l a s) == set l b s iso_hither :: Eq s => AnIso' s a -> s -> Bool iso_hither l s = s ^.cloneIso l.from l == s iso_yon :: Eq a => AnIso' s a -> a -> Bool iso_yon l a = a^.from l.cloneIso l == a prism_yin :: Eq a => Prism' s a -> a -> Bool prism_yin l a = preview l (review l a) == Just a prism_yang :: Eq s => Prism' s a -> s -> Bool prism_yang l s = maybe s (review l) (preview l s) == s traverse_pure :: forall f s a. (Applicative f, Eq (f s)) => LensLike' f s a -> s -> Bool traverse_pure l s = l pure s == (pure s :: f s) traverse_pureMaybe :: Eq s => LensLike' Maybe s a -> s -> Bool traverse_pureMaybe = traverse_pure traverse_pureList :: Eq s => LensLike' [] s a -> s -> Bool traverse_pureList = traverse_pure traverse_compose :: (Applicative f, Applicative g, Eq (f (g s))) => Traversal' s a -> (a -> g a) -> (a -> f a) -> s -> Bool traverse_compose t f g s = (fmap (t f) . t g) s == (getCompose . t (Compose . fmap f . g)) s lens-4.14/src/0000755000000000000000000000000012710476104011362 5ustar0000000000000000lens-4.14/src/Control/0000755000000000000000000000000012710476104013002 5ustar0000000000000000lens-4.14/src/Control/Lens.hs0000644000000000000000000000540412710476104014242 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- Usage: -- -- You can derive lenses automatically for many data types: -- -- @ -- import Control.Lens -- -- data FooBar a -- = Foo { _x :: ['Int'], _y :: a } -- | Bar { _x :: ['Int'] } -- 'makeLenses' ''FooBar -- @ -- -- This defines the following lenses: -- -- @ -- x :: 'Lens'' (FooBar a) ['Int'] -- y :: 'Traversal' (FooBar a) (FooBar b) a b -- @ -- -- You can then access the value of @_x@ with ('^.'), the value of @_y@ – -- with ('^?') or ('^?!') (since it can fail), set the values with ('.~'), -- modify them with ('%~'), and use almost any other combinator that is -- re-exported here on those fields. -- -- The combinators here have unusually specific type signatures, so for -- particularly tricky ones, the simpler type signatures you might want to -- pretend the combinators have are specified as well. -- -- More information on how to use lenses is available on the lens wiki: -- -- -- -- <> ---------------------------------------------------------------------------- module Control.Lens ( module Control.Lens.At , module Control.Lens.Cons , module Control.Lens.Each , module Control.Lens.Empty , module Control.Lens.Equality , module Control.Lens.Fold , module Control.Lens.Getter , module Control.Lens.Indexed , module Control.Lens.Iso , module Control.Lens.Lens , module Control.Lens.Level , module Control.Lens.Plated , module Control.Lens.Prism , module Control.Lens.Reified , module Control.Lens.Review , module Control.Lens.Setter #ifndef DISABLE_TEMPLATE_HASKELL , module Control.Lens.TH #endif , module Control.Lens.Traversal , module Control.Lens.Tuple , module Control.Lens.Type , module Control.Lens.Wrapped , module Control.Lens.Zoom ) where import Control.Lens.At import Control.Lens.Cons import Control.Lens.Each import Control.Lens.Empty import Control.Lens.Equality import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Indexed import Control.Lens.Iso import Control.Lens.Lens import Control.Lens.Level import Control.Lens.Plated import Control.Lens.Prism import Control.Lens.Reified import Control.Lens.Review import Control.Lens.Setter #ifndef DISABLE_TEMPLATE_HASKELL import Control.Lens.TH #endif import Control.Lens.Traversal import Control.Lens.Tuple import Control.Lens.Type import Control.Lens.Wrapped import Control.Lens.Zoom #ifdef HLINT {-# ANN module "HLint: ignore Use import/export shortcut" #-} #endif lens-4.14/src/Control/Exception/0000755000000000000000000000000012710476104014740 5ustar0000000000000000lens-4.14/src/Control/Exception/Lens.hs0000644000000000000000000011742512710476104016207 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #ifndef MIN_VERSION_exceptions #define MIN_VERSION_exceptions 1 #endif #if !(MIN_VERSION_exceptions(0,4,0)) #define MonadThrow MonadCatch #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Exception.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Control.Exception -- -- @Control.Exception@ provides an example of a large open hierarchy -- that we can model with prisms and isomorphisms. -- -- Additional combinators for working with 'IOException' results can -- be found in "System.IO.Error.Lens". -- -- The combinators in this module have been generalized to work with -- 'MonadCatch' instead of just 'IO'. This enables them to be used -- more easily in 'Monad' transformer stacks. ---------------------------------------------------------------------------- module Control.Exception.Lens ( -- * Handling catching, catching_ , handling, handling_ -- * Trying , trying, trying_ -- * Throwing , throwing , throwingM , throwingTo -- * Mapping , mappedException, mappedException' -- * Exceptions , exception #if __GLASGOW_HASKELL__ >= 710 , pattern Exception #endif -- * Exception Handlers , Handleable(..) -- ** IOExceptions , AsIOException(..) #if __GLASGOW_HASKELL__ >= 710 , pattern IOException_ #endif -- ** Arithmetic Exceptions , AsArithException(..) , _Overflow, _Underflow, _LossOfPrecision, _DivideByZero, _Denormal #if MIN_VERSION_base(4,6,0) , _RatioZeroDenominator #endif #if __GLASGOW_HASKELL__ >= 710 , pattern ArithException_ , pattern Overflow_ , pattern Underflow_ , pattern LossOfPrecision_ , pattern DivideByZero_ , pattern Denormal_ , pattern RatioZeroDenominator_ #endif -- ** Array Exceptions , AsArrayException(..) , _IndexOutOfBounds , _UndefinedElement #if __GLASGOW_HASKELL__ >= 710 , pattern ArrayException_ , pattern IndexOutOfBounds_ , pattern UndefinedElement_ #endif -- ** Assertion Failed , AsAssertionFailed(..) #if __GLASGOW_HASKELL__ >= 710 , pattern AssertionFailed_ #endif -- ** Async Exceptions , AsAsyncException(..) , _StackOverflow , _HeapOverflow , _ThreadKilled , _UserInterrupt #if __GLASGOW_HASKELL__ >= 710 , pattern AsyncException_ , pattern StackOverflow_ , pattern HeapOverflow_ , pattern ThreadKilled_ , pattern UserInterrupt_ #endif -- ** Non-Termination , AsNonTermination(..) #if __GLASGOW_HASKELL__ >= 710 , pattern NonTermination_ #endif -- ** Nested Atomically , AsNestedAtomically(..) #if __GLASGOW_HASKELL__ >= 710 , pattern NestedAtomically_ #endif -- ** Blocked Indefinitely -- *** on MVar , AsBlockedIndefinitelyOnMVar(..) #if __GLASGOW_HASKELL__ >= 710 , pattern BlockedIndefinitelyOnMVar_ #endif -- *** on STM , AsBlockedIndefinitelyOnSTM(..) #if __GLASGOW_HASKELL__ >= 710 , pattern BlockedIndefinitelyOnSTM_ #endif -- ** Deadlock , AsDeadlock(..) #if __GLASGOW_HASKELL__ >= 710 , pattern Deadlock_ #endif -- ** No Such Method , AsNoMethodError(..) #if __GLASGOW_HASKELL__ >= 710 , pattern NoMethodError_ #endif -- ** Pattern Match Failure , AsPatternMatchFail(..) #if __GLASGOW_HASKELL__ >= 710 , pattern PatternMatchFail_ #endif -- ** Record , AsRecConError(..) , AsRecSelError(..) , AsRecUpdError(..) #if __GLASGOW_HASKELL__ >= 710 , pattern RecConError_ , pattern RecSelError_ , pattern RecUpdError_ #endif -- ** Error Call , AsErrorCall(..) #if __GLASGOW_HASKELL__ >= 710 , pattern ErrorCall_ #endif -- * Handling Exceptions , AsHandlingException(..) #if __GLASGOW_HASKELL__ >= 710 , pattern HandlingException_ #endif ) where import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Control.Monad.Catch as Catch import Control.Exception as Exception hiding (try, tryJust, catchJust) import Control.Lens import Control.Lens.Internal.Exception import Data.Monoid import GHC.Conc (ThreadId) import Prelude ( const, either, flip, id , (.) , Maybe(..), Either(..), String #if __GLASGOW_HASKELL__ >= 710 , Bool(..) #endif ) #ifdef HLINT {-# ANN module "HLint: ignore Use Control.Exception.catch" #-} #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> :m + Control.Exception Control.Monad Data.List Prelude ------------------------------------------------------------------------------ -- Exceptions as Prisms ------------------------------------------------------------------------------ -- | Traverse the strongly typed 'Exception' contained in 'SomeException' where the type of your function matches -- the desired 'Exception'. -- -- @ -- 'exception' :: ('Applicative' f, 'Exception' a) -- => (a -> f a) -> 'SomeException' -> f 'SomeException' -- @ exception :: Exception a => Prism' SomeException a exception = prism' toException fromException {-# INLINE exception #-} #if __GLASGOW_HASKELL__ >= 710 pattern Exception e <- (preview exception -> Just e) where Exception e = review exception e #endif ------------------------------------------------------------------------------ -- Catching ------------------------------------------------------------------------------ -- | Catch exceptions that match a given 'Prism' (or any 'Fold', really). -- -- >>> catching _AssertionFailed (assert False (return "uncaught")) $ \ _ -> return "caught" -- "caught" -- -- @ -- 'catching' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> (a -> m r) -> m r -- @ catching :: MonadCatch m => Getting (First a) SomeException a -> m r -> (a -> m r) -> m r catching l = catchJust (preview l) {-# INLINE catching #-} -- | Catch exceptions that match a given 'Prism' (or any 'Getter'), discarding -- the information about the match. This is particuarly useful when you have -- a @'Prism'' e ()@ where the result of the 'Prism' or 'Fold' isn't -- particularly valuable, just the fact that it matches. -- -- >>> catching_ _AssertionFailed (assert False (return "uncaught")) $ return "caught" -- "caught" -- -- @ -- 'catching_' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> m r -> m r -- @ catching_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m r -> m r catching_ l a b = catchJust (preview l) a (const b) {-# INLINE catching_ #-} ------------------------------------------------------------------------------ -- Handling ------------------------------------------------------------------------------ -- | A version of 'catching' with the arguments swapped around; useful in -- situations where the code for the handler is shorter. -- -- >>> handling _NonTermination (\_ -> return "caught") $ throwIO NonTermination -- "caught" -- -- @ -- 'handling' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> (a -> m r) -> m r -> m r -- @ handling :: MonadCatch m => Getting (First a) SomeException a -> (a -> m r) -> m r -> m r handling l = flip (catching l) {-# INLINE handling #-} -- | A version of 'catching_' with the arguments swapped around; useful in -- situations where the code for the handler is shorter. -- -- >>> handling_ _NonTermination (return "caught") $ throwIO NonTermination -- "caught" -- -- @ -- 'handling_' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> m r -> m r -- @ handling_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m r -> m r handling_ l = flip (catching_ l) {-# INLINE handling_ #-} ------------------------------------------------------------------------------ -- Trying ------------------------------------------------------------------------------ -- | A variant of 'Control.Exception.try' that takes a 'Prism' (or any 'Fold') to select which -- exceptions are caught (c.f. 'Control.Exception.tryJust', 'Control.Exception.catchJust'). If the -- 'Exception' does not match the predicate, it is re-thrown. -- -- @ -- 'trying' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> m ('Either' a r) -- @ trying :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Either a r) trying l = tryJust (preview l) {-# INLINE trying #-} -- | A version of 'trying' that discards the specific exception thrown. -- -- @ -- 'trying_' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> m (Maybe r) -- @ trying_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Maybe r) trying_ l m = preview _Right `liftM` trying l m {-# INLINE trying_ #-} ------------------------------------------------------------------------------ -- Throwing ------------------------------------------------------------------------------ -- | Throw an 'Exception' described by a 'Prism'. Exceptions may be thrown from -- purely functional code, but may only be caught within the 'IO' 'Monad'. -- -- @ -- 'throwing' l ≡ 'reviews' l 'throw' -- @ -- -- @ -- 'throwing' :: 'Prism'' 'SomeException' t -> t -> r -- 'throwing' :: 'Iso'' 'SomeException' t -> t -> r -- @ throwing :: AReview SomeException b -> b -> r throwing l = reviews l Exception.throw {-# INLINE throwing #-} -- | A variant of 'throwing' that can only be used within the 'IO' 'Monad' -- (or any other 'MonadCatch' instance) to throw an 'Exception' described -- by a 'Prism'. -- -- Although 'throwingM' has a type that is a specialization of the type of -- 'throwing', the two functions are subtly different: -- -- @ -- 'throwing' l e \`seq\` x ≡ 'throwing' e -- 'throwingM' l e \`seq\` x ≡ x -- @ -- -- The first example will cause the 'Exception' @e@ to be raised, whereas the -- second one won't. In fact, 'throwingM' will only cause an 'Exception' to -- be raised when it is used within the 'MonadCatch' instance. The 'throwingM' -- variant should be used in preference to 'throwing' to raise an 'Exception' -- within the 'Monad' because it guarantees ordering with respect to other -- monadic operations, whereas 'throwing' does not. -- -- @ -- 'throwingM' l ≡ 'reviews' l 'CatchIO.throw' -- @ -- -- @ -- 'throwingM' :: 'MonadThrow' m => 'Prism'' 'SomeException' t -> t -> m r -- 'throwingM' :: 'MonadThrow' m => 'Iso'' 'SomeException' t -> t -> m r -- @ throwingM :: MonadThrow m => AReview SomeException b -> b -> m r throwingM l = reviews l throwM {-# INLINE throwingM #-} -- | 'throwingTo' raises an 'Exception' specified by a 'Prism' in the target thread. -- -- @ -- 'throwingTo' thread l ≡ 'reviews' l ('throwTo' thread) -- @ -- -- @ -- 'throwingTo' :: 'ThreadId' -> 'Prism'' 'SomeException' t -> t -> m a -- 'throwingTo' :: 'ThreadId' -> 'Iso'' 'SomeException' t -> t -> m a -- @ throwingTo :: MonadIO m => ThreadId -> AReview SomeException b -> b -> m () throwingTo tid l = reviews l (liftIO . throwTo tid) {-# INLINE throwingTo #-} ---------------------------------------------------------------------------- -- Mapping ---------------------------------------------------------------------------- -- | This 'Setter' can be used to purely map over the 'Exception's an -- arbitrary expression might throw; it is a variant of 'mapException' in -- the same way that 'mapped' is a variant of 'fmap'. -- -- > 'mapException' ≡ 'over' 'mappedException' -- -- This view that every Haskell expression can be regarded as carrying a bag -- of 'Exception's is detailed in “A Semantics for Imprecise Exceptions” by -- Peyton Jones & al. at PLDI ’99. -- -- The following maps failed assertions to arithmetic overflow: -- -- >>> handling _Overflow (\_ -> return "caught") $ assert False (return "uncaught") & mappedException %~ \ (AssertionFailed _) -> Overflow -- "caught" mappedException :: (Exception e, Exception e') => Setter s s e e' mappedException = sets mapException {-# INLINE mappedException #-} -- | This is a type restricted version of 'mappedException', which avoids -- the type ambiguity in the input 'Exception' when using 'set'. -- -- The following maps any exception to arithmetic overflow: -- -- >>> handling _Overflow (\_ -> return "caught") $ assert False (return "uncaught") & mappedException' .~ Overflow -- "caught" mappedException' :: Exception e' => Setter s s SomeException e' mappedException' = mappedException {-# INLINE mappedException' #-} ---------------------------------------------------------------------------- -- IOException ---------------------------------------------------------------------------- -- | Exceptions that occur in the 'IO' 'Monad'. An 'IOException' records a -- more specific error type, a descriptive string and maybe the handle that was -- used when the error was flagged. -- -- Due to their richer structure relative to other exceptions, these have -- a more carefully overloaded signature. class AsIOException t where -- | Unfortunately the name 'ioException' is taken by @base@ for -- throwing IOExceptions. -- -- @ -- '_IOException' :: 'Prism'' 'IOException' 'IOException' -- '_IOException' :: 'Prism'' 'SomeException' 'IOException' -- @ -- -- Many combinators for working with an 'IOException' are available -- in "System.IO.Error.Lens". _IOException :: Prism' t IOException instance AsIOException IOException where _IOException = id {-# INLINE _IOException #-} instance AsIOException SomeException where _IOException = exception {-# INLINE _IOException #-} #if __GLASGOW_HASKELL__ >= 710 pattern IOException_ a <- (preview _IOException -> Just a) where IOException_ a = review _IOException a #endif ---------------------------------------------------------------------------- -- ArithException ---------------------------------------------------------------------------- -- | Arithmetic exceptions. class AsArithException t where -- '_ArithException' :: 'Prism'' 'ArithException' 'ArithException' -- '_ArithException' :: 'Prism'' 'SomeException' 'ArithException' _ArithException :: Prism' t ArithException #if __GLASGOW_HASKELL__ >= 710 pattern ArithException_ a <- (preview _ArithException -> Just a) where ArithException_ a = review _ArithException a #endif instance AsArithException ArithException where _ArithException = id {-# INLINE _ArithException #-} instance AsArithException SomeException where _ArithException = exception {-# INLINE _ArithException #-} -- | Handle arithmetic '_Overflow'. -- -- @ -- '_Overflow' ≡ '_ArithException' '.' '_Overflow' -- @ -- -- @ -- '_Overflow' :: 'Prism'' 'ArithException' 'ArithException' -- '_Overflow' :: 'Prism'' 'SomeException' 'ArithException' -- @ _Overflow :: AsArithException t => Prism' t () _Overflow = _ArithException . dimap seta (either id id) . right' . rmap (Overflow <$) where seta Overflow = Right () seta t = Left (pure t) {-# INLINE _Overflow #-} #if __GLASGOW_HASKELL__ >= 710 pattern Overflow_ <- (has _Overflow -> True) where Overflow_ = review _Overflow () #endif -- | Handle arithmetic '_Underflow'. -- -- @ -- '_Underflow' ≡ '_ArithException' '.' '_Underflow' -- @ -- -- @ -- '_Underflow' :: 'Prism'' 'ArithException' 'ArithException' -- '_Underflow' :: 'Prism'' 'SomeException' 'ArithException' -- @ _Underflow :: AsArithException t => Prism' t () _Underflow = _ArithException . dimap seta (either id id) . right' . rmap (Underflow <$) where seta Underflow = Right () seta t = Left (pure t) {-# INLINE _Underflow #-} #if __GLASGOW_HASKELL__ >= 710 pattern Underflow_ <- (has _Underflow -> True) where Underflow_ = review _Underflow () #endif -- | Handle arithmetic loss of precision. -- -- @ -- '_LossOfPrecision' ≡ '_ArithException' '.' '_LossOfPrecision' -- @ -- -- @ -- '_LossOfPrecision' :: 'Prism'' 'ArithException' 'ArithException' -- '_LossOfPrecision' :: 'Prism'' 'SomeException' 'ArithException' -- @ _LossOfPrecision :: AsArithException t => Prism' t () _LossOfPrecision = _ArithException . dimap seta (either id id) . right' . rmap (LossOfPrecision <$) where seta LossOfPrecision = Right () seta t = Left (pure t) {-# INLINE _LossOfPrecision #-} #if __GLASGOW_HASKELL__ >= 710 pattern LossOfPrecision_ <- (has _LossOfPrecision -> True) where LossOfPrecision_ = review _LossOfPrecision () #endif -- | Handle division by zero. -- -- @ -- '_DivideByZero' ≡ '_ArithException' '.' '_DivideByZero' -- @ -- -- @ -- '_DivideByZero' :: 'Prism'' 'ArithException' 'ArithException' -- '_DivideByZero' :: 'Prism'' 'SomeException' 'ArithException' -- @ _DivideByZero :: AsArithException t => Prism' t () _DivideByZero = _ArithException . dimap seta (either id id) . right' . rmap (DivideByZero <$) where seta DivideByZero = Right () seta t = Left (pure t) {-# INLINE _DivideByZero #-} #if __GLASGOW_HASKELL__ >= 710 pattern DivideByZero_ <- (has _DivideByZero -> True) where DivideByZero_ = review _DivideByZero () #endif -- | Handle exceptional _Denormalized floating pure. -- -- @ -- '_Denormal' ≡ '_ArithException' '.' '_Denormal' -- @ -- -- @ -- '_Denormal' :: 'Prism'' 'ArithException' 'ArithException' -- '_Denormal' :: 'Prism'' 'SomeException' 'ArithException' -- @ _Denormal :: AsArithException t => Prism' t () _Denormal = _ArithException . dimap seta (either id id) . right' . rmap (Denormal <$) where seta Denormal = Right () seta t = Left (pure t) {-# INLINE _Denormal #-} #if __GLASGOW_HASKELL__ >= 710 pattern Denormal_ <- (has _Denormal -> True) where Denormal_ = review _Denormal () #endif #if MIN_VERSION_base(4,6,0) -- | Added in @base@ 4.6 in response to this libraries discussion: -- -- -- -- @ -- '_RatioZeroDenominator' ≡ '_ArithException' '.' '_RatioZeroDenominator' -- @ -- -- @ -- '_RatioZeroDenominator' :: 'Prism'' 'ArithException' 'ArithException' -- '_RatioZeroDenominator' :: 'Prism'' 'SomeException' 'ArithException' -- @ _RatioZeroDenominator :: AsArithException t => Prism' t () _RatioZeroDenominator = _ArithException . dimap seta (either id id) . right' . rmap (RatioZeroDenominator <$) where seta RatioZeroDenominator = Right () seta t = Left (pure t) {-# INLINE _RatioZeroDenominator #-} #if __GLASGOW_HASKELL__ >= 710 pattern RatioZeroDenominator_ <- (has _RatioZeroDenominator -> True) where RatioZeroDenominator_ = review _RatioZeroDenominator () #endif #endif ---------------------------------------------------------------------------- -- ArrayException ---------------------------------------------------------------------------- -- | Exceptions generated by array operations. class AsArrayException t where -- | Extract information about an 'ArrayException'. -- -- @ -- '_ArrayException' :: 'Prism'' 'ArrayException' 'ArrayException' -- '_ArrayException' :: 'Prism'' 'SomeException' 'ArrayException' -- @ _ArrayException :: Prism' t ArrayException instance AsArrayException ArrayException where _ArrayException = id {-# INLINE _ArrayException #-} instance AsArrayException SomeException where _ArrayException = exception {-# INLINE _ArrayException #-} #if __GLASGOW_HASKELL__ >= 710 pattern ArrayException_ e <- (preview _ArrayException -> Just e) where ArrayException_ e = review _ArrayException e #endif -- | An attempt was made to index an array outside its declared bounds. -- -- @ -- '_IndexOutOfBounds' ≡ '_ArrayException' '.' '_IndexOutOfBounds' -- @ -- -- @ -- '_IndexOutOfBounds' :: 'Prism'' 'ArrayException' 'String' -- '_IndexOutOfBounds' :: 'Prism'' 'SomeException' 'String' -- @ _IndexOutOfBounds :: AsArrayException t => Prism' t String _IndexOutOfBounds = _ArrayException . dimap seta (either id id) . right' . rmap (fmap IndexOutOfBounds) where seta (IndexOutOfBounds r) = Right r seta t = Left (pure t) {-# INLINE _IndexOutOfBounds #-} #if __GLASGOW_HASKELL__ >= 710 pattern IndexOutOfBounds_ e <- (preview _IndexOutOfBounds -> Just e) where IndexOutOfBounds_ e = review _IndexOutOfBounds e #endif -- | An attempt was made to evaluate an element of an array that had not been initialized. -- -- @ -- '_UndefinedElement' ≡ '_ArrayException' '.' '_UndefinedElement' -- @ -- -- @ -- '_UndefinedElement' :: 'Prism'' 'ArrayException' 'String' -- '_UndefinedElement' :: 'Prism'' 'SomeException' 'String' -- @ _UndefinedElement :: AsArrayException t => Prism' t String _UndefinedElement = _ArrayException . dimap seta (either id id) . right' . rmap (fmap UndefinedElement) where seta (UndefinedElement r) = Right r seta t = Left (pure t) {-# INLINE _UndefinedElement #-} #if __GLASGOW_HASKELL__ >= 710 pattern UndefinedElement_ e <- (preview _UndefinedElement -> Just e) where UndefinedElement_ e = review _UndefinedElement e #endif ---------------------------------------------------------------------------- -- AssertionFailed ---------------------------------------------------------------------------- -- | 'assert' was applied to 'Prelude.False'. class AsAssertionFailed t where -- | This 'Exception' contains provides information about what assertion failed in the 'String'. -- -- >>> handling _AssertionFailed (\ xs -> "caught" <$ guard ("" `isInfixOf` xs) ) $ assert False (return "uncaught") -- "caught" -- -- @ -- '_AssertionFailed' :: 'Prism'' 'AssertionFailed' 'String' -- '_AssertionFailed' :: 'Prism'' 'SomeException' 'String' -- @ _AssertionFailed :: Prism' t String instance AsAssertionFailed AssertionFailed where _AssertionFailed = _Wrapping AssertionFailed {-# INLINE _AssertionFailed #-} instance AsAssertionFailed SomeException where _AssertionFailed = exception._Wrapping AssertionFailed {-# INLINE _AssertionFailed #-} #if __GLASGOW_HASKELL__ >= 710 pattern AssertionFailed_ e <- (preview _AssertionFailed -> Just e) where AssertionFailed_ e = review _AssertionFailed e #endif ---------------------------------------------------------------------------- -- AsyncException ---------------------------------------------------------------------------- -- | Asynchronous exceptions. class AsAsyncException t where -- | There are several types of 'AsyncException'. -- -- @ -- '_AsyncException' :: 'Equality'' 'AsyncException' 'AsyncException' -- '_AsyncException' :: 'Prism'' 'SomeException' 'AsyncException' -- @ _AsyncException :: Prism' t AsyncException instance AsAsyncException AsyncException where _AsyncException = id {-# INLINE _AsyncException #-} instance AsAsyncException SomeException where _AsyncException = exception {-# INLINE _AsyncException #-} #if __GLASGOW_HASKELL__ >= 710 pattern AsyncException_ e <- (preview _AsyncException -> Just e) where AsyncException_ e = review _AsyncException e #endif -- | The current thread's stack exceeded its limit. Since an 'Exception' has -- been raised, the thread's stack will certainly be below its limit again, -- but the programmer should take remedial action immediately. -- -- @ -- '_StackOverflow' :: 'Prism'' 'AsyncException' () -- '_StackOverflow' :: 'Prism'' 'SomeException' () -- @ _StackOverflow :: AsAsyncException t => Prism' t () _StackOverflow = _AsyncException . dimap seta (either id id) . right' . rmap (StackOverflow <$) where seta StackOverflow = Right () seta t = Left (pure t) {-# INLINE _StackOverflow #-} #if __GLASGOW_HASKELL__ >= 710 pattern StackOverflow_ <- (has _StackOverflow -> True) where StackOverflow_ = review _StackOverflow () #endif -- | The program's heap is reaching its limit, and the program should take action -- to reduce the amount of live data it has. -- -- Notes: -- -- * It is undefined which thread receives this 'Exception'. -- -- * GHC currently does not throw 'HeapOverflow' exceptions. -- -- @ -- '_HeapOverflow' :: 'Prism'' 'AsyncException' () -- '_HeapOverflow' :: 'Prism'' 'SomeException' () -- @ _HeapOverflow :: AsAsyncException t => Prism' t () _HeapOverflow = _AsyncException . dimap seta (either id id) . right' . rmap (HeapOverflow <$) where seta HeapOverflow = Right () seta t = Left (pure t) {-# INLINE _HeapOverflow #-} #if __GLASGOW_HASKELL__ >= 710 pattern HeapOverflow_ <- (has _HeapOverflow -> True) where HeapOverflow_ = review _HeapOverflow () #endif -- | This 'Exception' is raised by another thread calling -- 'Control.Concurrent.killThread', or by the system if it needs to terminate -- the thread for some reason. -- -- @ -- '_ThreadKilled' :: 'Prism'' 'AsyncException' () -- '_ThreadKilled' :: 'Prism'' 'SomeException' () -- @ _ThreadKilled :: AsAsyncException t => Prism' t () _ThreadKilled = _AsyncException . dimap seta (either id id) . right' . rmap (ThreadKilled <$) where seta ThreadKilled = Right () seta t = Left (pure t) {-# INLINE _ThreadKilled #-} #if __GLASGOW_HASKELL__ >= 710 pattern ThreadKilled_ <- (has _ThreadKilled -> True) where ThreadKilled_ = review _ThreadKilled () #endif -- | This 'Exception' is raised by default in the main thread of the program when -- the user requests to terminate the program via the usual mechanism(s) -- (/e.g./ Control-C in the console). -- -- @ -- '_UserInterrupt' :: 'Prism'' 'AsyncException' () -- '_UserInterrupt' :: 'Prism'' 'SomeException' () -- @ _UserInterrupt :: AsAsyncException t => Prism' t () _UserInterrupt = _AsyncException . dimap seta (either id id) . right' . rmap (UserInterrupt <$) where seta UserInterrupt = Right () seta t = Left (pure t) {-# INLINE _UserInterrupt #-} #if __GLASGOW_HASKELL__ >= 710 pattern UserInterrupt_ <- (has _UserInterrupt -> True) where UserInterrupt_ = review _UserInterrupt () #endif ---------------------------------------------------------------------------- -- AsyncException ---------------------------------------------------------------------------- -- | Thrown when the runtime system detects that the computation is guaranteed -- not to terminate. Note that there is no guarantee that the runtime system -- will notice whether any given computation is guaranteed to terminate or not. class AsNonTermination t where -- | There is no additional information carried in a 'NonTermination' 'Exception'. -- -- @ -- '_NonTermination' :: 'Prism'' 'NonTermination' () -- '_NonTermination' :: 'Prism'' 'SomeException' () -- @ _NonTermination :: Prism' t () instance AsNonTermination NonTermination where _NonTermination = trivial NonTermination {-# INLINE _NonTermination #-} instance AsNonTermination SomeException where _NonTermination = exception.trivial NonTermination {-# INLINE _NonTermination #-} #if __GLASGOW_HASKELL__ >= 710 pattern NonTermination_ <- (has _NonTermination -> True) where NonTermination_ = review _NonTermination () #endif ---------------------------------------------------------------------------- -- NestedAtomically ---------------------------------------------------------------------------- -- | Thrown when the program attempts to call atomically, from the -- 'Control.Monad.STM' package, inside another call to atomically. class AsNestedAtomically t where -- | There is no additional information carried in a 'NestedAtomically' 'Exception'. -- -- @ -- '_NestedAtomically' :: 'Prism'' 'NestedAtomically' () -- '_NestedAtomically' :: 'Prism'' 'SomeException' () -- @ _NestedAtomically :: Prism' t () instance AsNestedAtomically NestedAtomically where _NestedAtomically = trivial NestedAtomically {-# INLINE _NestedAtomically #-} instance AsNestedAtomically SomeException where _NestedAtomically = exception.trivial NestedAtomically {-# INLINE _NestedAtomically #-} #if __GLASGOW_HASKELL__ >= 710 pattern NestedAtomically_ <- (has _NestedAtomically -> True) where NestedAtomically_ = review _NestedAtomically () #endif ---------------------------------------------------------------------------- -- BlockedIndefinitelyOnMVar ---------------------------------------------------------------------------- -- | The thread is blocked on an 'Control.Concurrent.MVar.MVar', but there -- are no other references to the 'Control.Concurrent.MVar.MVar' so it can't -- ever continue. class AsBlockedIndefinitelyOnMVar t where -- | There is no additional information carried in a 'BlockedIndefinitelyOnMVar' 'Exception'. -- -- @ -- '_BlockedIndefinitelyOnMVar' :: 'Prism'' 'BlockedIndefinitelyOnMVar' () -- '_BlockedIndefinitelyOnMVar' :: 'Prism'' 'SomeException' () -- @ _BlockedIndefinitelyOnMVar :: Prism' t () instance AsBlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar where _BlockedIndefinitelyOnMVar = trivial BlockedIndefinitelyOnMVar {-# INLINE _BlockedIndefinitelyOnMVar #-} instance AsBlockedIndefinitelyOnMVar SomeException where _BlockedIndefinitelyOnMVar = exception.trivial BlockedIndefinitelyOnMVar {-# INLINE _BlockedIndefinitelyOnMVar #-} #if __GLASGOW_HASKELL__ >= 710 pattern BlockedIndefinitelyOnMVar_ <- (has _BlockedIndefinitelyOnMVar -> True) where BlockedIndefinitelyOnMVar_ = review _BlockedIndefinitelyOnMVar () #endif ---------------------------------------------------------------------------- -- BlockedIndefinitelyOnSTM ---------------------------------------------------------------------------- -- | The thread is waiting to retry an 'Control.Monad.STM.STM' transaction, -- but there are no other references to any TVars involved, so it can't ever -- continue. class AsBlockedIndefinitelyOnSTM t where -- | There is no additional information carried in a 'BlockedIndefinitelyOnSTM' 'Exception'. -- -- @ -- '_BlockedIndefinitelyOnSTM' :: 'Prism'' 'BlockedIndefinitelyOnSTM' () -- '_BlockedIndefinitelyOnSTM' :: 'Prism'' 'SomeException' () -- @ _BlockedIndefinitelyOnSTM :: Prism' t () instance AsBlockedIndefinitelyOnSTM BlockedIndefinitelyOnSTM where _BlockedIndefinitelyOnSTM = trivial BlockedIndefinitelyOnSTM {-# INLINE _BlockedIndefinitelyOnSTM #-} instance AsBlockedIndefinitelyOnSTM SomeException where _BlockedIndefinitelyOnSTM = exception.trivial BlockedIndefinitelyOnSTM {-# INLINE _BlockedIndefinitelyOnSTM #-} #if __GLASGOW_HASKELL__ >= 710 pattern BlockedIndefinitelyOnSTM_ <- (has _BlockedIndefinitelyOnSTM -> True) where BlockedIndefinitelyOnSTM_ = review _BlockedIndefinitelyOnSTM () #endif ---------------------------------------------------------------------------- -- Deadlock ---------------------------------------------------------------------------- -- | There are no runnable threads, so the program is deadlocked. The -- 'Deadlock' 'Exception' is raised in the main thread only. class AsDeadlock t where -- | There is no information carried in a 'Deadlock' 'Exception'. -- -- @ -- '_Deadlock' :: 'Prism'' 'Deadlock' () -- '_Deadlock' :: 'Prism'' 'SomeException' () -- @ _Deadlock :: Prism' t () instance AsDeadlock Deadlock where _Deadlock = trivial Deadlock {-# INLINE _Deadlock #-} instance AsDeadlock SomeException where _Deadlock = exception.trivial Deadlock {-# INLINE _Deadlock #-} #if __GLASGOW_HASKELL__ >= 710 pattern Deadlock_ <- (has _Deadlock -> True) where Deadlock_ = review _Deadlock () #endif ---------------------------------------------------------------------------- -- NoMethodError ---------------------------------------------------------------------------- -- | A class method without a definition (neither a default definition, -- nor a definition in the appropriate instance) was called. class AsNoMethodError t where -- | Extract a description of the missing method. -- -- @ -- '_NoMethodError' :: 'Prism'' 'NoMethodError' 'String' -- '_NoMethodError' :: 'Prism'' 'SomeException' 'String' -- @ _NoMethodError :: Prism' t String instance AsNoMethodError NoMethodError where _NoMethodError = _Wrapping NoMethodError {-# INLINE _NoMethodError #-} instance AsNoMethodError SomeException where _NoMethodError = exception._Wrapping NoMethodError {-# INLINE _NoMethodError #-} #if __GLASGOW_HASKELL__ >= 710 pattern NoMethodError_ e <- (preview _NoMethodError -> Just e) where NoMethodError_ e = review _NoMethodError e #endif ---------------------------------------------------------------------------- -- PatternMatchFail ---------------------------------------------------------------------------- -- | A pattern match failed. class AsPatternMatchFail t where -- | Information about the source location of the pattern. -- -- @ -- '_PatternMatchFail' :: 'Prism'' 'PatternMatchFail' 'String' -- '_PatternMatchFail' :: 'Prism'' 'SomeException' 'String' -- @ _PatternMatchFail :: Prism' t String instance AsPatternMatchFail PatternMatchFail where _PatternMatchFail = _Wrapping PatternMatchFail {-# INLINE _PatternMatchFail #-} instance AsPatternMatchFail SomeException where _PatternMatchFail = exception._Wrapping PatternMatchFail {-# INLINE _PatternMatchFail #-} #if __GLASGOW_HASKELL__ >= 710 pattern PatternMatchFail_ e <- (preview _PatternMatchFail -> Just e) where PatternMatchFail_ e = review _PatternMatchFail e #endif ---------------------------------------------------------------------------- -- RecConError ---------------------------------------------------------------------------- -- | An uninitialised record field was used. class AsRecConError t where -- | Information about the source location where the record was -- constructed. -- -- @ -- '_RecConError' :: 'Prism'' 'RecConError' 'String' -- '_RecConError' :: 'Prism'' 'SomeException' 'String' -- @ _RecConError :: Prism' t String instance AsRecConError RecConError where _RecConError = _Wrapping RecConError {-# INLINE _RecConError #-} instance AsRecConError SomeException where _RecConError = exception._Wrapping RecConError {-# INLINE _RecConError #-} #if __GLASGOW_HASKELL__ >= 710 pattern RecConError_ e <- (preview _RecConError -> Just e) where RecConError_ e = review _RecConError e #endif ---------------------------------------------------------------------------- -- RecSelError ---------------------------------------------------------------------------- -- | A record selector was applied to a constructor without the appropriate -- field. This can only happen with a datatype with multiple constructors, -- where some fields are in one constructor but not another. class AsRecSelError t where -- | Information about the source location where the record selection occurred. _RecSelError :: Prism' t String instance AsRecSelError RecSelError where _RecSelError = _Wrapping RecSelError {-# INLINE _RecSelError #-} instance AsRecSelError SomeException where _RecSelError = exception._Wrapping RecSelError {-# INLINE _RecSelError #-} #if __GLASGOW_HASKELL__ >= 710 pattern RecSelError_ e <- (preview _RecSelError -> Just e) where RecSelError_ e = review _RecSelError e #endif ---------------------------------------------------------------------------- -- RecUpdError ---------------------------------------------------------------------------- -- | A record update was performed on a constructor without the -- appropriate field. This can only happen with a datatype with multiple -- constructors, where some fields are in one constructor but not another. class AsRecUpdError t where -- | Information about the source location where the record was updated. _RecUpdError :: Prism' t String instance AsRecUpdError RecUpdError where _RecUpdError = _Wrapping RecUpdError {-# INLINE _RecUpdError #-} instance AsRecUpdError SomeException where _RecUpdError = exception._Wrapping RecUpdError {-# INLINE _RecUpdError #-} #if __GLASGOW_HASKELL__ >= 710 pattern RecUpdError_ e <- (preview _RecUpdError -> Just e) where RecUpdError_ e = review _RecUpdError e #endif ---------------------------------------------------------------------------- -- ErrorCall ---------------------------------------------------------------------------- -- | This is thrown when the user calls 'Prelude.error'. class AsErrorCall t where -- | Retrieve the argument given to 'Prelude.error'. -- -- 'ErrorCall' is isomorphic to a 'String'. -- -- >>> catching _ErrorCall (error "touch down!") return -- "touch down!" _ErrorCall :: Prism' t String instance AsErrorCall ErrorCall where _ErrorCall = _Wrapping ErrorCall {-# INLINE _ErrorCall #-} instance AsErrorCall SomeException where _ErrorCall = exception._Wrapping ErrorCall {-# INLINE _ErrorCall #-} #if __GLASGOW_HASKELL__ >= 710 pattern ErrorCall_ e <- (preview _ErrorCall -> Just e) where ErrorCall_ e = review _ErrorCall e #endif ------------------------------------------------------------------------------ -- HandlingException ------------------------------------------------------------------------------ -- | This 'Exception' is thrown by @lens@ when the user somehow manages to rethrow -- an internal 'HandlingException'. class AsHandlingException t where -- | There is no information carried in a 'HandlingException'. -- -- @ -- '_HandlingException' :: 'Prism'' 'HandlingException' () -- '_HandlingException' :: 'Prism'' 'SomeException' () -- @ _HandlingException :: Prism' t () instance AsHandlingException HandlingException where _HandlingException = trivial HandlingException {-# INLINE _HandlingException #-} instance AsHandlingException SomeException where _HandlingException = exception.trivial HandlingException {-# INLINE _HandlingException #-} #if __GLASGOW_HASKELL__ >= 710 pattern HandlingException_ <- (has _HandlingException -> True) where HandlingException_ = review _HandlingException () #endif ------------------------------------------------------------------------------ -- Helper Functions ------------------------------------------------------------------------------ trivial :: t -> Iso' t () trivial t = const () `iso` const t lens-4.14/src/Control/Lens/0000755000000000000000000000000012710476104013703 5ustar0000000000000000lens-4.14/src/Control/Lens/At.hs0000644000000000000000000004053412710476104014611 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeOperators #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 711 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.At -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.At ( -- * At At(at) , sans , iat -- * Ixed , Index , IxValue , Ixed(ix) , ixAt , iix -- * Contains , Contains(contains) , icontains ) where import Control.Lens.Each import Control.Lens.Traversal import Control.Lens.Lens import Control.Lens.Setter import Control.Lens.Type import Control.Lens.Indexed import Data.Array.IArray as Array import Data.Array.Unboxed import Data.ByteString as StrictB import Data.ByteString.Lazy as LazyB import Data.Complex import Data.Hashable import Data.HashMap.Lazy as HashMap import Data.HashSet as HashSet import Data.Int import Data.IntMap as IntMap import Data.IntSet as IntSet import Data.List.NonEmpty as NonEmpty import Data.Map as Map import Data.Set as Set import Data.Sequence as Seq import Data.Text as StrictT import Data.Text.Lazy as LazyT import Data.Tree import Data.Vector as Vector hiding (indexed) import Data.Vector.Primitive as Prim import Data.Vector.Storable as Storable import Data.Vector.Unboxed as Unboxed hiding (indexed) import Data.Word #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif type family Index (s :: *) :: * type instance Index (e -> a) = e type instance Index IntSet = Int type instance Index (Set a) = a type instance Index (HashSet a) = a type instance Index [a] = Int type instance Index (NonEmpty a) = Int type instance Index (Seq a) = Int type instance Index (a,b) = Int type instance Index (a,b,c) = Int type instance Index (a,b,c,d) = Int type instance Index (a,b,c,d,e) = Int type instance Index (a,b,c,d,e,f) = Int type instance Index (a,b,c,d,e,f,g) = Int type instance Index (a,b,c,d,e,f,g,h) = Int type instance Index (a,b,c,d,e,f,g,h,i) = Int type instance Index (IntMap a) = Int type instance Index (Map k a) = k type instance Index (HashMap k a) = k type instance Index (Array.Array i e) = i type instance Index (UArray i e) = i type instance Index (Vector.Vector a) = Int type instance Index (Prim.Vector a) = Int type instance Index (Storable.Vector a) = Int type instance Index (Unboxed.Vector a) = Int type instance Index (Complex a) = Int type instance Index (Identity a) = () type instance Index (Maybe a) = () type instance Index (Tree a) = [Int] type instance Index StrictT.Text = Int type instance Index LazyT.Text = Int64 type instance Index StrictB.ByteString = Int type instance Index LazyB.ByteString = Int64 -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g) -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- >>> let f' :: Int -> Expr -> Expr; f' = Debug.SimpleReflect.Vars.f' -- >>> let h :: Int -> Expr; h = Debug.SimpleReflect.Vars.h -- | -- This class provides a simple 'Lens' that lets you view (and modify) -- information about whether or not a container contains a given 'Index'. class Contains m where -- | -- >>> IntSet.fromList [1,2,3,4] ^. contains 3 -- True -- -- >>> IntSet.fromList [1,2,3,4] ^. contains 5 -- False -- -- >>> IntSet.fromList [1,2,3,4] & contains 3 .~ False -- fromList [1,2,4] contains :: Index m -> Lens' m Bool -- | An indexed version of 'contains'. -- -- >>> IntSet.fromList [1,2,3,4] ^@. icontains 3 -- (3,True) -- -- >>> IntSet.fromList [1,2,3,4] ^@. icontains 5 -- (5,False) -- -- >>> IntSet.fromList [1,2,3,4] & icontains 3 %@~ \i x -> if odd i then not x else x -- fromList [1,2,4] -- -- >>> IntSet.fromList [1,2,3,4] & icontains 3 %@~ \i x -> if even i then not x else x -- fromList [1,2,3,4] icontains :: Contains m => Index m -> IndexedLens' (Index m) m Bool icontains i f = contains i (indexed f i) {-# INLINE icontains #-} instance Contains IntSet where contains k f s = f (IntSet.member k s) <&> \b -> if b then IntSet.insert k s else IntSet.delete k s {-# INLINE contains #-} instance Ord a => Contains (Set a) where contains k f s = f (Set.member k s) <&> \b -> if b then Set.insert k s else Set.delete k s {-# INLINE contains #-} instance (Eq a, Hashable a) => Contains (HashSet a) where contains k f s = f (HashSet.member k s) <&> \b -> if b then HashSet.insert k s else HashSet.delete k s {-# INLINE contains #-} -- | This provides a common notion of a value at an index that is shared by both 'Ixed' and 'At'. type family IxValue (m :: *) :: * -- | This simple 'Traversal' lets you 'traverse' the value at a given -- key in a 'Map' or element at an ordinal position in a list or 'Seq'. class Ixed m where -- | This simple 'Traversal' lets you 'traverse' the value at a given -- key in a 'Map' or element at an ordinal position in a list or 'Seq'. -- -- /NB:/ Setting the value of this 'Traversal' will only set the value in -- 'at' if it is already present. -- -- If you want to be able to insert /missing/ values, you want 'at'. -- -- >>> Seq.fromList [a,b,c,d] & ix 2 %~ f -- fromList [a,b,f c,d] -- -- >>> Seq.fromList [a,b,c,d] & ix 2 .~ e -- fromList [a,b,e,d] -- -- >>> Seq.fromList [a,b,c,d] ^? ix 2 -- Just c -- -- >>> Seq.fromList [] ^? ix 2 -- Nothing ix :: Index m -> Traversal' m (IxValue m) default ix :: (Applicative f, At m) => Index m -> LensLike' f m (IxValue m) ix = ixAt {-# INLINE ix #-} -- | An indexed version of 'ix'. -- -- >>> Seq.fromList [a,b,c,d] & iix 2 %@~ f' -- fromList [a,b,f' 2 c,d] -- -- >>> Seq.fromList [a,b,c,d] & iix 2 .@~ h -- fromList [a,b,h 2,d] -- -- >>> Seq.fromList [a,b,c,d] ^@? iix 2 -- Just (2,c) -- -- >>> Seq.fromList [] ^@? iix 2 -- Nothing iix :: Ixed m => Index m -> IndexedTraversal' (Index m) m (IxValue m) iix i f = ix i (indexed f i) {-# INLINE iix #-} -- | A definition of 'ix' for types with an 'At' instance. This is the default -- if you don't specify a definition for 'ix'. ixAt :: At m => Index m -> Traversal' m (IxValue m) ixAt i = at i . traverse {-# INLINE ixAt #-} type instance IxValue (e -> a) = a instance Eq e => Ixed (e -> a) where ix e p f = p (f e) <&> \a e' -> if e == e' then a else f e' {-# INLINE ix #-} type instance IxValue (Maybe a) = a instance Ixed (Maybe a) where ix () f (Just a) = Just <$> f a ix () _ Nothing = pure Nothing {-# INLINE ix #-} type instance IxValue [a] = a instance Ixed [a] where ix k f xs0 | k < 0 = pure xs0 | otherwise = go xs0 k where go [] _ = pure [] go (a:as) 0 = f a <&> (:as) go (a:as) i = (a:) <$> (go as $! i - 1) {-# INLINE ix #-} type instance IxValue (NonEmpty a) = a instance Ixed (NonEmpty a) where ix k f xs0 | k < 0 = pure xs0 | otherwise = go xs0 k where go (a:|as) 0 = f a <&> (:|as) go (a:|as) i = (a:|) <$> ix (i - 1) f as {-# INLINE ix #-} type instance IxValue (Identity a) = a instance Ixed (Identity a) where ix () f (Identity a) = Identity <$> f a {-# INLINE ix #-} type instance IxValue (Tree a) = a instance Ixed (Tree a) where ix xs0 f = go xs0 where go [] (Node a as) = f a <&> \a' -> Node a' as go (i:is) t@(Node a as) | i < 0 = pure t | otherwise = Node a <$> ix i (go is) as {-# INLINE ix #-} type instance IxValue (Seq a) = a instance Ixed (Seq a) where ix i f m | 0 <= i && i < Seq.length m = f (Seq.index m i) <&> \a -> Seq.update i a m | otherwise = pure m {-# INLINE ix #-} type instance IxValue (IntMap a) = a instance Ixed (IntMap a) where ix k f m = case IntMap.lookup k m of Just v -> f v <&> \v' -> IntMap.insert k v' m Nothing -> pure m {-# INLINE ix #-} type instance IxValue (Map k a) = a instance Ord k => Ixed (Map k a) where ix k f m = case Map.lookup k m of Just v -> f v <&> \v' -> Map.insert k v' m Nothing -> pure m {-# INLINE ix #-} type instance IxValue (HashMap k a) = a instance (Eq k, Hashable k) => Ixed (HashMap k a) where ix k f m = case HashMap.lookup k m of Just v -> f v <&> \v' -> HashMap.insert k v' m Nothing -> pure m {-# INLINE ix #-} type instance IxValue (Set k) = () instance Ord k => Ixed (Set k) where ix k f m = if Set.member k m then f () <&> \() -> Set.insert k m else pure m {-# INLINE ix #-} type instance IxValue IntSet = () instance Ixed IntSet where ix k f m = if IntSet.member k m then f () <&> \() -> IntSet.insert k m else pure m {-# INLINE ix #-} type instance IxValue (HashSet k) = () instance (Eq k, Hashable k) => Ixed (HashSet k) where ix k f m = if HashSet.member k m then f () <&> \() -> HashSet.insert k m else pure m {-# INLINE ix #-} type instance IxValue (Array.Array i e) = e -- | -- @ -- arr '!' i ≡ arr 'Control.Lens.Getter.^.' 'ix' i -- arr '//' [(i,e)] ≡ 'ix' i 'Control.Lens.Setter..~' e '$' arr -- @ instance Ix i => Ixed (Array.Array i e) where ix i f arr | inRange (bounds arr) i = f (arr Array.! i) <&> \e -> arr Array.// [(i,e)] | otherwise = pure arr {-# INLINE ix #-} type instance IxValue (UArray i e) = e -- | -- @ -- arr '!' i ≡ arr 'Control.Lens.Getter.^.' 'ix' i -- arr '//' [(i,e)] ≡ 'ix' i 'Control.Lens.Setter..~' e '$' arr -- @ instance (IArray UArray e, Ix i) => Ixed (UArray i e) where ix i f arr | inRange (bounds arr) i = f (arr Array.! i) <&> \e -> arr Array.// [(i,e)] | otherwise = pure arr {-# INLINE ix #-} type instance IxValue (Vector.Vector a) = a instance Ixed (Vector.Vector a) where ix i f v | 0 <= i && i < Vector.length v = f (v Vector.! i) <&> \a -> v Vector.// [(i, a)] | otherwise = pure v {-# INLINE ix #-} type instance IxValue (Prim.Vector a) = a instance Prim a => Ixed (Prim.Vector a) where ix i f v | 0 <= i && i < Prim.length v = f (v Prim.! i) <&> \a -> v Prim.// [(i, a)] | otherwise = pure v {-# INLINE ix #-} type instance IxValue (Storable.Vector a) = a instance Storable a => Ixed (Storable.Vector a) where ix i f v | 0 <= i && i < Storable.length v = f (v Storable.! i) <&> \a -> v Storable.// [(i, a)] | otherwise = pure v {-# INLINE ix #-} type instance IxValue (Unboxed.Vector a) = a instance Unbox a => Ixed (Unboxed.Vector a) where ix i f v | 0 <= i && i < Unboxed.length v = f (v Unboxed.! i) <&> \a -> v Unboxed.// [(i, a)] | otherwise = pure v {-# INLINE ix #-} type instance IxValue StrictT.Text = Char instance Ixed StrictT.Text where ix e f s = case StrictT.splitAt e s of (l, mr) -> case StrictT.uncons mr of Nothing -> pure s Just (c, xs) -> f c <&> \d -> StrictT.concat [l, StrictT.singleton d, xs] {-# INLINE ix #-} type instance IxValue LazyT.Text = Char instance Ixed LazyT.Text where ix e f s = case LazyT.splitAt e s of (l, mr) -> case LazyT.uncons mr of Nothing -> pure s Just (c, xs) -> f c <&> \d -> LazyT.append l (LazyT.cons d xs) {-# INLINE ix #-} type instance IxValue StrictB.ByteString = Word8 instance Ixed StrictB.ByteString where ix e f s = case StrictB.splitAt e s of (l, mr) -> case StrictB.uncons mr of Nothing -> pure s Just (c, xs) -> f c <&> \d -> StrictB.concat [l, StrictB.singleton d, xs] {-# INLINE ix #-} type instance IxValue LazyB.ByteString = Word8 instance Ixed LazyB.ByteString where -- TODO: we could be lazier, returning each chunk as it is passed ix e f s = case LazyB.splitAt e s of (l, mr) -> case LazyB.uncons mr of Nothing -> pure s Just (c, xs) -> f c <&> \d -> LazyB.append l (LazyB.cons d xs) {-# INLINE ix #-} -- | 'At' provides a 'Lens' that can be used to read, -- write or delete the value associated with a key in a 'Map'-like -- container on an ad hoc basis. -- -- An instance of 'At' should satisfy: -- -- @ -- 'ix' k ≡ 'at' k '.' 'traverse' -- @ class Ixed m => At m where -- | -- >>> Map.fromList [(1,"world")] ^.at 1 -- Just "world" -- -- >>> at 1 ?~ "hello" $ Map.empty -- fromList [(1,"hello")] -- -- /Note:/ 'Map'-like containers form a reasonable instance, but not 'Array'-like ones, where -- you cannot satisfy the 'Lens' laws. at :: Index m -> Lens' m (Maybe (IxValue m)) -- | Delete the value associated with a key in a 'Map'-like container -- -- @ -- 'sans' k = 'at' k .~ Nothing -- @ sans :: At m => Index m -> m -> m sans k m = m & at k .~ Nothing {-# INLINE sans #-} -- | An indexed version of 'at'. -- -- >>> Map.fromList [(1,"world")] ^@. iat 1 -- (1,Just "world") -- -- >>> iat 1 %@~ (\i x -> if odd i then Just "hello" else Nothing) $ Map.empty -- fromList [(1,"hello")] -- -- >>> iat 2 %@~ (\i x -> if odd i then Just "hello" else Nothing) $ Map.empty -- fromList [] -- iat :: At m => Index m -> IndexedLens' (Index m) m (Maybe (IxValue m)) iat i f = at i (indexed f i) {-# INLINE iat #-} instance At (Maybe a) where at () f = f {-# INLINE at #-} instance At (IntMap a) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (IntMap.delete k m)) mv Just v' -> IntMap.insert k v' m where mv = IntMap.lookup k m {-# INLINE at #-} instance Ord k => At (Map k a) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (Map.delete k m)) mv Just v' -> Map.insert k v' m where mv = Map.lookup k m {-# INLINE at #-} instance (Eq k, Hashable k) => At (HashMap k a) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (HashMap.delete k m)) mv Just v' -> HashMap.insert k v' m where mv = HashMap.lookup k m {-# INLINE at #-} instance At IntSet where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (IntSet.delete k m)) mv Just () -> IntSet.insert k m where mv = if IntSet.member k m then Just () else Nothing {-# INLINE at #-} instance Ord k => At (Set k) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (Set.delete k m)) mv Just () -> Set.insert k m where mv = if Set.member k m then Just () else Nothing {-# INLINE at #-} instance (Eq k, Hashable k) => At (HashSet k) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (HashSet.delete k m)) mv Just () -> HashSet.insert k m where mv = if HashSet.member k m then Just () else Nothing {-# INLINE at #-} -- | @'ix' :: 'Int' -> 'Traversal'' (a,a) a@ type instance IxValue (a,a2) = a instance (a~a2) => Ixed (a,a2) where ix = elementOf each -- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a) a@ type instance IxValue (a,a2,a3) = a instance (a~a2, a~a3) => Ixed (a,a2,a3) where ix = elementOf each -- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a) a@ type instance IxValue (a,a2,a3,a4) = a instance (a~a2, a~a3, a~a4) => Ixed (a,a2,a3,a4) where ix = elementOf each -- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a) a@ type instance IxValue (a,a2,a3,a4,a5) = a instance (a~a2, a~a3, a~a4, a~a5) => Ixed (a,a2,a3,a4,a5) where ix = elementOf each -- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a,a) a@ type instance IxValue (a,a2,a3,a4,a5,a6) = a instance (a~a2, a~a3, a~a4, a~a5, a~a6) => Ixed (a,a2,a3,a4,a5,a6) where ix = elementOf each -- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a,a,a) a@ type instance IxValue (a,a2,a3,a4,a5,a6,a7) = a instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7) => Ixed (a,a2,a3,a4,a5,a6,a7) where ix = elementOf each -- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a,a,a,a) a@ type instance IxValue (a,a2,a3,a4,a5,a6,a7,a8) = a instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, a~a8) => Ixed (a,a2,a3,a4,a5,a6,a7,a8) where ix = elementOf each -- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a,a,a,a,a) a@ type instance IxValue (a,a2,a3,a4,a5,a6,a7,a8,a9) = a instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, a~a8, a~a9) => Ixed (a,a2,a3,a4,a5,a6,a7,a8,a9) where ix = elementOf each lens-4.14/src/Control/Lens/Combinators.hs0000644000000000000000000000375312710476104016527 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Combinators -- Copyright : (C) 2013-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This lets the subset of users who vociferously disagree about the full -- scope and set of operators that should be exported from lens to not have -- to look at any operator with which they disagree. -- -- > import Control.Lens.Combinators -------------------------------------------------------------------------------- module Control.Lens.Combinators ( module Control.Lens ) where import Control.Lens hiding ( -- output from scripts/operators (<|) , (|>) , (^..) , (^?) , (^?!) , (^@..) , (^@?) , (^@?!) , (^.) , (^@.) , (<.) , (.>) , (<.>) , (%%~) , (%%=) , (&) , (&~) , (<&>) , (??) , (<%~) , (<+~) , (<-~) , (<*~) , (~) , (<%=) , (<+=) , (<-=) , (<*=) , (=) , (<<~) , (<<>~) , (<<>=) , (<%@~) , (<<%@~) , (%%@~) , (%%@=) , (<%@=) , (<<%@=) , (^#) , ( #~ ) , ( #%~ ) , ( #%%~ ) , ( #= ) , ( #%= ) , (<#%~) , (<#%=) , ( #%%= ) , (<#~) , (<#=) , (...) , ( # ) , (%~) , (.~) , (?~) , (<.~) , (~) , (<>=) , (%@~) , (%@=) ) lens-4.14/src/Control/Lens/Cons.hs0000644000000000000000000003265312710476104015152 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Cons -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ----------------------------------------------------------------------------- module Control.Lens.Cons ( -- * Cons Cons(..) , (<|) , cons , uncons , _head, _tail #if __GLASGOW_HASKELL__ >= 710 , pattern (:>) #endif -- * Snoc , Snoc(..) , (|>) , snoc , unsnoc , _init, _last #if __GLASGOW_HASKELL__ >= 710 , pattern (:<) #endif ) where import Control.Lens.Equality (simply) import Control.Lens.Fold import Control.Lens.Prism import Control.Lens.Review import Control.Lens.Tuple import Control.Lens.Type import qualified Data.ByteString as StrictB import qualified Data.ByteString.Lazy as LazyB import Data.Monoid import qualified Data.Sequence as Seq import Data.Sequence hiding ((<|), (|>), (:<), (:>)) import qualified Data.Text as StrictT import qualified Data.Text.Lazy as LazyT import Data.Vector (Vector) import qualified Data.Vector as Vector import Data.Vector.Storable (Storable) import qualified Data.Vector.Storable as Storable import Data.Vector.Primitive (Prim) import qualified Data.Vector.Primitive as Prim import Data.Vector.Unboxed (Unbox) import qualified Data.Vector.Unboxed as Unbox import Data.Word import Prelude {-# ANN module "HLint: ignore Eta reduce" #-} -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g) -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g infixr 5 <|, `cons` infixl 5 |>, `snoc` #if __GLASGOW_HASKELL__ >= 710 pattern (:<) a s <- (preview _Cons -> Just (a,s)) where (:<) a s = _Cons # (a,s) infixr 5 :< infixl 5 :> pattern (:>) s a <- (preview _Snoc -> Just (s,a)) where (:>) a s = _Snoc # (a,s) #endif ------------------------------------------------------------------------------ -- Cons ------------------------------------------------------------------------------ -- | This class provides a way to attach or detach elements on the left -- side of a structure in a flexible manner. class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | -- -- @ -- '_Cons' :: 'Prism' [a] [b] (a, [a]) (b, [b]) -- '_Cons' :: 'Prism' ('Seq' a) ('Seq' b) (a, 'Seq' a) (b, 'Seq' b) -- '_Cons' :: 'Prism' ('Vector' a) ('Vector' b) (a, 'Vector' a) (b, 'Vector' b) -- '_Cons' :: 'Prism'' 'String' ('Char', 'String') -- '_Cons' :: 'Prism'' 'StrictT.Text' ('Char', 'StrictT.Text') -- '_Cons' :: 'Prism'' 'StrictB.ByteString' ('Word8', 'StrictB.ByteString') -- @ _Cons :: Prism s t (a,s) (b,t) instance Cons [a] [b] a b where _Cons = prism (uncurry (:)) $ \ aas -> case aas of (a:as) -> Right (a, as) [] -> Left [] {-# INLINE _Cons #-} instance Cons (Seq a) (Seq b) a b where _Cons = prism (uncurry (Seq.<|)) $ \aas -> case viewl aas of a Seq.:< as -> Right (a, as) EmptyL -> Left mempty {-# INLINE _Cons #-} instance Cons StrictB.ByteString StrictB.ByteString Word8 Word8 where _Cons = prism' (uncurry StrictB.cons) StrictB.uncons {-# INLINE _Cons #-} instance Cons LazyB.ByteString LazyB.ByteString Word8 Word8 where _Cons = prism' (uncurry LazyB.cons) LazyB.uncons {-# INLINE _Cons #-} instance Cons StrictT.Text StrictT.Text Char Char where _Cons = prism' (uncurry StrictT.cons) StrictT.uncons {-# INLINE _Cons #-} instance Cons LazyT.Text LazyT.Text Char Char where _Cons = prism' (uncurry LazyT.cons) LazyT.uncons {-# INLINE _Cons #-} instance Cons (Vector a) (Vector b) a b where _Cons = prism (uncurry Vector.cons) $ \v -> if Vector.null v then Left Vector.empty else Right (Vector.unsafeHead v, Vector.unsafeTail v) {-# INLINE _Cons #-} instance (Prim a, Prim b) => Cons (Prim.Vector a) (Prim.Vector b) a b where _Cons = prism (uncurry Prim.cons) $ \v -> if Prim.null v then Left Prim.empty else Right (Prim.unsafeHead v, Prim.unsafeTail v) {-# INLINE _Cons #-} instance (Storable a, Storable b) => Cons (Storable.Vector a) (Storable.Vector b) a b where _Cons = prism (uncurry Storable.cons) $ \v -> if Storable.null v then Left Storable.empty else Right (Storable.unsafeHead v, Storable.unsafeTail v) {-# INLINE _Cons #-} instance (Unbox a, Unbox b) => Cons (Unbox.Vector a) (Unbox.Vector b) a b where _Cons = prism (uncurry Unbox.cons) $ \v -> if Unbox.null v then Left Unbox.empty else Right (Unbox.unsafeHead v, Unbox.unsafeTail v) {-# INLINE _Cons #-} -- | 'cons' an element onto a container. -- -- This is an infix alias for 'cons'. -- -- >>> a <| [] -- [a] -- -- >>> a <| [b, c] -- [a,b,c] -- -- >>> a <| Seq.fromList [] -- fromList [a] -- -- >>> a <| Seq.fromList [b, c] -- fromList [a,b,c] (<|) :: Cons s s a a => a -> s -> s (<|) = curry (simply review _Cons) {-# INLINE (<|) #-} -- | 'cons' an element onto a container. -- -- >>> cons a [] -- [a] -- -- >>> cons a [b, c] -- [a,b,c] -- -- >>> cons a (Seq.fromList []) -- fromList [a] -- -- >>> cons a (Seq.fromList [b, c]) -- fromList [a,b,c] cons :: Cons s s a a => a -> s -> s cons = curry (simply review _Cons) {-# INLINE cons #-} -- | Attempt to extract the left-most element from a container, and a version of the container without that element. -- -- >>> uncons [] -- Nothing -- -- >>> uncons [a, b, c] -- Just (a,[b,c]) uncons :: Cons s s a a => s -> Maybe (a, s) uncons = simply preview _Cons {-# INLINE uncons #-} -- | A 'Traversal' reading and writing to the 'head' of a /non-empty/ container. -- -- >>> [a,b,c]^? _head -- Just a -- -- >>> [a,b,c] & _head .~ d -- [d,b,c] -- -- >>> [a,b,c] & _head %~ f -- [f a,b,c] -- -- >>> [] & _head %~ f -- [] -- -- >>> [1,2,3]^?!_head -- 1 -- -- >>> []^?_head -- Nothing -- -- >>> [1,2]^?_head -- Just 1 -- -- >>> [] & _head .~ 1 -- [] -- -- >>> [0] & _head .~ 2 -- [2] -- -- >>> [0,1] & _head .~ 2 -- [2,1] -- -- This isn't limited to lists. -- -- For instance you can also 'Data.Traversable.traverse' the head of a 'Seq': -- -- >>> Seq.fromList [a,b,c,d] & _head %~ f -- fromList [f a,b,c,d] -- -- >>> Seq.fromList [] ^? _head -- Nothing -- -- >>> Seq.fromList [a,b,c,d] ^? _head -- Just a -- -- @ -- '_head' :: 'Traversal'' [a] a -- '_head' :: 'Traversal'' ('Seq' a) a -- '_head' :: 'Traversal'' ('Vector' a) a -- @ _head :: Cons s s a a => Traversal' s a _head = _Cons._1 {-# INLINE _head #-} -- | A 'Traversal' reading and writing to the 'tail' of a /non-empty/ container. -- -- >>> [a,b] & _tail .~ [c,d,e] -- [a,c,d,e] -- -- >>> [] & _tail .~ [a,b] -- [] -- -- >>> [a,b,c,d,e] & _tail.traverse %~ f -- [a,f b,f c,f d,f e] -- -- >>> [1,2] & _tail .~ [3,4,5] -- [1,3,4,5] -- -- >>> [] & _tail .~ [1,2] -- [] -- -- >>> [a,b,c]^?_tail -- Just [b,c] -- -- >>> [1,2]^?!_tail -- [2] -- -- >>> "hello"^._tail -- "ello" -- -- >>> ""^._tail -- "" -- -- This isn't limited to lists. For instance you can also 'Control.Traversable.traverse' the tail of a 'Seq'. -- -- >>> Seq.fromList [a,b] & _tail .~ Seq.fromList [c,d,e] -- fromList [a,c,d,e] -- -- >>> Seq.fromList [a,b,c] ^? _tail -- Just (fromList [b,c]) -- -- >>> Seq.fromList [] ^? _tail -- Nothing -- -- @ -- '_tail' :: 'Traversal'' [a] [a] -- '_tail' :: 'Traversal'' ('Seq' a) ('Seq' a) -- '_tail' :: 'Traversal'' ('Vector' a) ('Vector' a) -- @ _tail :: Cons s s a a => Traversal' s s _tail = _Cons._2 {-# INLINE _tail #-} ------------------------------------------------------------------------------ -- Snoc ------------------------------------------------------------------------------ -- | This class provides a way to attach or detach elements on the right -- side of a structure in a flexible manner. class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | -- -- @ -- '_Snoc' :: 'Prism' [a] [b] ([a], a) ([b], b) -- '_Snoc' :: 'Prism' ('Seq' a) ('Seq' b) ('Seq' a, a) ('Seq' b, b) -- '_Snoc' :: 'Prism' ('Vector' a) ('Vector' b) ('Vector' a, a) ('Vector' b, b) -- '_Snoc' :: 'Prism'' 'String' ('String', 'Char') -- '_Snoc' :: 'Prism'' 'StrictT.Text' ('StrictT.Text', 'Char') -- '_Snoc' :: 'Prism'' 'StrictB.ByteString' ('StrictB.ByteString', 'Word8') -- @ _Snoc :: Prism s t (s,a) (t,b) instance Snoc [a] [b] a b where _Snoc = prism (\(as,a) -> as Prelude.++ [a]) $ \aas -> if Prelude.null aas then Left [] else Right (Prelude.init aas, Prelude.last aas) {-# INLINE _Snoc #-} instance Snoc (Seq a) (Seq b) a b where _Snoc = prism (uncurry (Seq.|>)) $ \aas -> case viewr aas of as Seq.:> a -> Right (as, a) EmptyR -> Left mempty {-# INLINE _Snoc #-} instance Snoc (Vector a) (Vector b) a b where _Snoc = prism (uncurry Vector.snoc) $ \v -> if Vector.null v then Left Vector.empty else Right (Vector.unsafeInit v, Vector.unsafeLast v) {-# INLINE _Snoc #-} instance (Prim a, Prim b) => Snoc (Prim.Vector a) (Prim.Vector b) a b where _Snoc = prism (uncurry Prim.snoc) $ \v -> if Prim.null v then Left Prim.empty else Right (Prim.unsafeInit v, Prim.unsafeLast v) {-# INLINE _Snoc #-} instance (Storable a, Storable b) => Snoc (Storable.Vector a) (Storable.Vector b) a b where _Snoc = prism (uncurry Storable.snoc) $ \v -> if Storable.null v then Left Storable.empty else Right (Storable.unsafeInit v, Storable.unsafeLast v) {-# INLINE _Snoc #-} instance (Unbox a, Unbox b) => Snoc (Unbox.Vector a) (Unbox.Vector b) a b where _Snoc = prism (uncurry Unbox.snoc) $ \v -> if Unbox.null v then Left Unbox.empty else Right (Unbox.unsafeInit v, Unbox.unsafeLast v) {-# INLINE _Snoc #-} instance Snoc StrictB.ByteString StrictB.ByteString Word8 Word8 where _Snoc = prism (uncurry StrictB.snoc) $ \v -> if StrictB.null v then Left StrictB.empty else Right (StrictB.init v, StrictB.last v) {-# INLINE _Snoc #-} instance Snoc LazyB.ByteString LazyB.ByteString Word8 Word8 where _Snoc = prism (uncurry LazyB.snoc) $ \v -> if LazyB.null v then Left LazyB.empty else Right (LazyB.init v, LazyB.last v) {-# INLINE _Snoc #-} instance Snoc StrictT.Text StrictT.Text Char Char where _Snoc = prism (uncurry StrictT.snoc) $ \v -> if StrictT.null v then Left StrictT.empty else Right (StrictT.init v, StrictT.last v) {-# INLINE _Snoc #-} instance Snoc LazyT.Text LazyT.Text Char Char where _Snoc = prism (uncurry LazyT.snoc) $ \v -> if LazyT.null v then Left LazyT.empty else Right (LazyT.init v, LazyT.last v) {-# INLINE _Snoc #-} -- | A 'Traversal' reading and replacing all but the a last element of a /non-empty/ container. -- -- >>> [a,b,c,d]^?_init -- Just [a,b,c] -- -- >>> []^?_init -- Nothing -- -- >>> [a,b] & _init .~ [c,d,e] -- [c,d,e,b] -- -- >>> [] & _init .~ [a,b] -- [] -- -- >>> [a,b,c,d] & _init.traverse %~ f -- [f a,f b,f c,d] -- -- >>> [1,2,3]^?_init -- Just [1,2] -- -- >>> [1,2,3,4]^?!_init -- [1,2,3] -- -- >>> "hello"^._init -- "hell" -- -- >>> ""^._init -- "" -- -- @ -- '_init' :: 'Traversal'' [a] [a] -- '_init' :: 'Traversal'' ('Seq' a) ('Seq' a) -- '_init' :: 'Traversal'' ('Vector' a) ('Vector' a) -- @ _init :: Snoc s s a a => Traversal' s s _init = _Snoc._1 {-# INLINE _init #-} -- | A 'Traversal' reading and writing to the last element of a /non-empty/ container. -- -- >>> [a,b,c]^?!_last -- c -- -- >>> []^?_last -- Nothing -- -- >>> [a,b,c] & _last %~ f -- [a,b,f c] -- -- >>> [1,2]^?_last -- Just 2 -- -- >>> [] & _last .~ 1 -- [] -- -- >>> [0] & _last .~ 2 -- [2] -- -- >>> [0,1] & _last .~ 2 -- [0,2] -- -- This 'Traversal' is not limited to lists, however. We can also work with other containers, such as a 'Vector'. -- -- >>> Vector.fromList "abcde" ^? _last -- Just 'e' -- -- >>> Vector.empty ^? _last -- Nothing -- -- >>> (Vector.fromList "abcde" & _last .~ 'Q') == Vector.fromList "abcdQ" -- True -- -- @ -- '_last' :: 'Traversal'' [a] a -- '_last' :: 'Traversal'' ('Seq' a) a -- '_last' :: 'Traversal'' ('Vector' a) a -- @ _last :: Snoc s s a a => Traversal' s a _last = _Snoc._2 {-# INLINE _last #-} -- | 'snoc' an element onto the end of a container. -- -- This is an infix alias for 'snoc'. -- -- >>> Seq.fromList [] |> a -- fromList [a] -- -- >>> Seq.fromList [b, c] |> a -- fromList [b,c,a] -- -- >>> LazyT.pack "hello" |> '!' -- "hello!" (|>) :: Snoc s s a a => s -> a -> s (|>) = curry (simply review _Snoc) {-# INLINE (|>) #-} -- | 'snoc' an element onto the end of a container. -- -- >>> snoc (Seq.fromList []) a -- fromList [a] -- -- >>> snoc (Seq.fromList [b, c]) a -- fromList [b,c,a] -- -- >>> snoc (LazyT.pack "hello") '!' -- "hello!" snoc :: Snoc s s a a => s -> a -> s snoc = curry (simply review _Snoc) {-# INLINE snoc #-} -- | Attempt to extract the right-most element from a container, and a version of the container without that element. -- -- >>> unsnoc (LazyT.pack "hello!") -- Just ("hello",'!') -- -- >>> unsnoc (LazyT.pack "") -- Nothing -- -- >>> unsnoc (Seq.fromList [b,c,a]) -- Just (fromList [b,c],a) -- -- >>> unsnoc (Seq.fromList []) -- Nothing unsnoc :: Snoc s s a a => s -> Maybe (s, a) unsnoc s = simply preview _Snoc s {-# INLINE unsnoc #-} lens-4.14/src/Control/Lens/Each.hs0000644000000000000000000002037712710476104015110 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FunctionalDependencies #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Each -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ----------------------------------------------------------------------------- module Control.Lens.Each ( -- * Each Each(..) ) where import Control.Lens.Traversal import Control.Lens.Internal.ByteString import Data.Array.Unboxed as Unboxed import Data.Array.IArray as IArray import Data.ByteString as StrictB import Data.ByteString.Lazy as LazyB import Data.Complex import Data.Functor.Identity import Data.HashMap.Lazy as HashMap import Data.IntMap as IntMap import Data.List.NonEmpty import Data.Map as Map import Data.Sequence as Seq import Data.Text.Lens (text) import Data.Text as StrictT import Data.Text.Lazy as LazyT import Data.Tree as Tree import Data.Vector.Generic.Lens (vectorTraverse) import qualified Data.Vector as Vector import qualified Data.Vector.Primitive as Prim import Data.Vector.Primitive (Prim) import qualified Data.Vector.Storable as Storable import Data.Vector.Storable (Storable) import qualified Data.Vector.Unboxed as Unboxed import Data.Vector.Unboxed (Unbox) import Data.Word #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Data.Text.Strict.Lens as Text -- >>> import Data.Char as Char -- | Extract 'each' element of a (potentially monomorphic) container. -- -- Notably, when applied to a tuple, this generalizes 'Control.Lens.Traversal.both' to arbitrary homogeneous tuples. -- -- >>> (1,2,3) & each *~ 10 -- (10,20,30) -- -- It can also be used on monomorphic containers like 'StrictT.Text' or 'StrictB.ByteString'. -- -- >>> over each Char.toUpper ("hello"^.Text.packed) -- "HELLO" -- -- >>> ("hello","world") & each.each %~ Char.toUpper -- ("HELLO","WORLD") class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where each :: Traversal s t a b default each :: (Traversable g, s ~ g a, t ~ g b) => Traversal s t a b each = traverse {-# INLINE each #-} -- | @'each' :: 'Traversal' (a,a) (b,b) a b@ instance (a~a', b~b') => Each (a,a') (b,b') a b where each f ~(a,b) = (,) <$> f a <*> f b {-# INLINE each #-} -- | @'each' :: 'Traversal' (a,a,a) (b,b,b) a b@ instance (a~a2, a~a3, b~b2, b~b3) => Each (a,a2,a3) (b,b2,b3) a b where each f ~(a,b,c) = (,,) <$> f a <*> f b <*> f c {-# INLINE each #-} -- | @'each' :: 'Traversal' (a,a,a,a) (b,b,b,b) a b@ instance (a~a2, a~a3, a~a4, b~b2, b~b3, b~b4) => Each (a,a2,a3,a4) (b,b2,b3,b4) a b where each f ~(a,b,c,d) = (,,,) <$> f a <*> f b <*> f c <*> f d {-# INLINE each #-} -- | @'each' :: 'Traversal' (a,a,a,a,a) (b,b,b,b,b) a b@ instance (a~a2, a~a3, a~a4, a~a5, b~b2, b~b3, b~b4, b~b5) => Each (a,a2,a3,a4,a5) (b,b2,b3,b4,b5) a b where each f ~(a,b,c,d,e) = (,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e {-# INLINE each #-} -- | @'each' :: 'Traversal' (a,a,a,a,a,a) (b,b,b,b,b,b) a b@ instance (a~a2, a~a3, a~a4, a~a5, a~a6, b~b2, b~b3, b~b4, b~b5, b~b6) => Each (a,a2,a3,a4,a5,a6) (b,b2,b3,b4,b5,b6) a b where each f ~(a,b,c,d,e,g) = (,,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e <*> f g {-# INLINE each #-} -- | @'each' :: 'Traversal' (a,a,a,a,a,a,a) (b,b,b,b,b,b,b) a b@ instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, b~b2, b~b3, b~b4, b~b5, b~b6, b~b7) => Each (a,a2,a3,a4,a5,a6,a7) (b,b2,b3,b4,b5,b6,b7) a b where each f ~(a,b,c,d,e,g,h) = (,,,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e <*> f g <*> f h {-# INLINE each #-} -- | @'each' :: 'Traversal' (a,a,a,a,a,a,a,a) (b,b,b,b,b,b,b,b) a b@ instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, a~a8, b~b2, b~b3, b~b4, b~b5, b~b6, b~b7, b~b8) => Each (a,a2,a3,a4,a5,a6,a7,a8) (b,b2,b3,b4,b5,b6,b7,b8) a b where each f ~(a,b,c,d,e,g,h,i) = (,,,,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e <*> f g <*> f h <*> f i {-# INLINE each #-} -- | @'each' :: 'Traversal' (a,a,a,a,a,a,a,a,a) (b,b,b,b,b,b,b,b,b) a b@ instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, a~a8, a~a9, b~b2, b~b3, b~b4, b~b5, b~b6, b~b7, b~b8, b~b9) => Each (a,a2,a3,a4,a5,a6,a7,a8,a9) (b,b2,b3,b4,b5,b6,b7,b8,b9) a b where each f ~(a,b,c,d,e,g,h,i,j) = (,,,,,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e <*> f g <*> f h <*> f i <*> f j {-# INLINE each #-} -- | @'each' :: ('RealFloat' a, 'RealFloat' b) => 'Traversal' ('Complex' a) ('Complex' b) a b@ instance Each (Complex a) (Complex b) a b where each f (a :+ b) = (:+) <$> f a <*> f b {-# INLINE each #-} -- | @'each' :: 'Traversal' ('Map' c a) ('Map' c b) a b@ instance (c ~ d) => Each (Map c a) (Map d b) a b where each = traversed {-# INLINE each #-} -- | @'each' :: 'Traversal' ('Map' c a) ('Map' c b) a b@ instance Each (IntMap a) (IntMap b) a b where each = traversed {-# INLINE each #-} -- | @'each' :: 'Traversal' ('HashMap' c a) ('HashMap' c b) a b@ instance (c ~ d) => Each (HashMap c a) (HashMap d b) a b where each = traversed {-# INLINE each #-} -- | @'each' :: 'Traversal' [a] [b] a b@ instance Each [a] [b] a b where each = traversed {-# INLINE each #-} -- | @'each' :: 'Traversal' (NonEmpty a) (NonEmpty b) a b@ instance Each (NonEmpty a) (NonEmpty b) a b -- | @'each' :: 'Traversal' ('Identity' a) ('Identity' b) a b@ instance Each (Identity a) (Identity b) a b -- | @'each' :: 'Traversal' ('Maybe' a) ('Maybe' b) a b@ instance Each (Maybe a) (Maybe b) a b -- | @'each' :: 'Traversal' ('Seq' a) ('Seq' b) a b@ instance Each (Seq a) (Seq b) a b where each = traversed {-# INLINE each #-} -- | @'each' :: 'Traversal' ('Tree' a) ('Tree' b) a b@ instance Each (Tree a) (Tree b) a b -- | @'each' :: 'Traversal' ('Vector.Vector' a) ('Vector.Vector' b) a b@ instance Each (Vector.Vector a) (Vector.Vector b) a b where each = vectorTraverse {-# INLINE each #-} -- | @'each' :: ('Prim' a, 'Prim' b) => 'Traversal' ('Prim.Vector' a) ('Prim.Vector' b) a b@ instance (Prim a, Prim b) => Each (Prim.Vector a) (Prim.Vector b) a b where each = vectorTraverse {-# INLINE each #-} -- | @'each' :: ('Storable' a, 'Storable' b) => 'Traversal' ('Storable.Vector' a) ('Storable.Vector' b) a b@ instance (Storable a, Storable b) => Each (Storable.Vector a) (Storable.Vector b) a b where each = vectorTraverse {-# INLINE each #-} -- | @'each' :: ('Unbox' a, 'Unbox' b) => 'Traversal' ('Unboxed.Vector' a) ('Unboxed.Vector' b) a b@ instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b where each = vectorTraverse {-# INLINE each #-} -- | @'each' :: 'Traversal' 'StrictT.Text' 'StrictT.Text' 'Char' 'Char'@ instance (a ~ Char, b ~ Char) => Each StrictT.Text StrictT.Text a b where each = text {-# INLINE each #-} -- | @'each' :: 'Traversal' 'LazyT.Text' 'LazyT.Text' 'Char' 'Char'@ instance (a ~ Char, b ~ Char) => Each LazyT.Text LazyT.Text a b where each = text {-# INLINE each #-} -- | @'each' :: 'Traversal' 'StrictB.ByteString' 'StrictB.ByteString' 'Word8' 'Word8'@ instance (a ~ Word8, b ~ Word8) => Each StrictB.ByteString StrictB.ByteString a b where each = traversedStrictTree {-# INLINE each #-} -- | @'each' :: 'Traversal' 'LazyB.ByteString' 'LazyB.ByteString' 'Word8' 'Word8'@ instance (a ~ Word8, b ~ Word8) => Each LazyB.ByteString LazyB.ByteString a b where each = traversedLazy {-# INLINE each #-} -- | @'each' :: 'Ix' i => 'Traversal' ('Array' i a) ('Array' i b) a b@ instance (Ix i, i ~ j) => Each (Array i a) (Array j b) a b where each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f a) (IArray.assocs arr) {-# INLINE each #-} -- | @'each' :: ('Ix' i, 'IArray' 'UArray' a, 'IArray' 'UArray' b) => 'Traversal' ('Array' i a) ('Array' i b) a b@ instance (Ix i, IArray UArray a, IArray UArray b, i ~ j) => Each (UArray i a) (UArray j b) a b where each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f a) (IArray.assocs arr) {-# INLINE each #-} lens-4.14/src/Control/Lens/Empty.hs0000644000000000000000000001120312710476104015332 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE DefaultSignatures #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Empty -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- ------------------------------------------------------------------------------- module Control.Lens.Empty ( AsEmpty(..) #if __GLASGOW_HASKELL__ >= 710 , pattern Empty #endif ) where import Control.Lens.Iso #if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Fold #endif import Control.Lens.Prism import Control.Lens.Review import Data.ByteString as StrictB import Data.ByteString.Lazy as LazyB import Data.HashMap.Lazy as HashMap import Data.HashSet as HashSet import Data.IntMap as IntMap import Data.IntSet as IntSet import Data.Map as Map import Data.Maybe import Data.Monoid import Data.Profunctor.Unsafe import Data.Sequence as Seq import Data.Set as Set import Data.Text as StrictT import Data.Text.Lazy as LazyT import Data.Vector as Vector import Data.Vector.Unboxed as Unboxed import Data.Vector.Storable as Storable #if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) import GHC.Event #endif class AsEmpty a where -- | -- -- >>> isn't _Empty [1,2,3] -- True _Empty :: Prism' a () default _Empty :: (Monoid a, Eq a) => Prism' a () _Empty = only mempty {-# INLINE _Empty #-} #if __GLASGOW_HASKELL__ >= 710 pattern Empty <- (has _Empty -> True) where Empty = review _Empty () #endif {- Default Monoid instances -} instance AsEmpty Ordering instance AsEmpty () instance AsEmpty Any instance AsEmpty All #if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) instance AsEmpty Event #endif instance (Eq a, Num a) => AsEmpty (Product a) instance (Eq a, Num a) => AsEmpty (Sum a) instance AsEmpty (Maybe a) where _Empty = _Nothing {-# INLINE _Empty #-} instance AsEmpty (Last a) where _Empty = nearly (Last Nothing) (isNothing .# getLast) {-# INLINE _Empty #-} instance AsEmpty (First a) where _Empty = nearly (First Nothing) (isNothing .# getFirst) {-# INLINE _Empty #-} instance AsEmpty a => AsEmpty (Dual a) where _Empty = iso getDual Dual . _Empty {-# INLINE _Empty #-} instance (AsEmpty a, AsEmpty b) => AsEmpty (a,b) where _Empty = prism' (\() -> (_Empty # (), _Empty # ())) $ \(s,s') -> case _Empty Left s of Left () -> case _Empty Left s' of Left () -> Just () _ -> Nothing _ -> Nothing {-# INLINE _Empty #-} instance (AsEmpty a, AsEmpty b, AsEmpty c) => AsEmpty (a,b,c) where _Empty = prism' (\() -> (_Empty # (), _Empty # (), _Empty # ())) $ \(s,s',s'') -> case _Empty Left s of Left () -> case _Empty Left s' of Left () -> case _Empty Left s'' of Left () -> Just () Right _ -> Nothing Right _ -> Nothing Right _ -> Nothing {-# INLINE _Empty #-} instance AsEmpty [a] where _Empty = nearly [] Prelude.null {-# INLINE _Empty #-} instance AsEmpty (Map k a) where _Empty = nearly Map.empty Map.null {-# INLINE _Empty #-} instance AsEmpty (HashMap k a) where _Empty = nearly HashMap.empty HashMap.null {-# INLINE _Empty #-} instance AsEmpty (IntMap a) where _Empty = nearly IntMap.empty IntMap.null {-# INLINE _Empty #-} instance AsEmpty (Set a) where _Empty = nearly Set.empty Set.null {-# INLINE _Empty #-} instance AsEmpty (HashSet a) where _Empty = nearly HashSet.empty HashSet.null {-# INLINE _Empty #-} instance AsEmpty IntSet where _Empty = nearly IntSet.empty IntSet.null {-# INLINE _Empty #-} instance AsEmpty (Vector.Vector a) where _Empty = nearly Vector.empty Vector.null {-# INLINE _Empty #-} instance Unbox a => AsEmpty (Unboxed.Vector a) where _Empty = nearly Unboxed.empty Unboxed.null {-# INLINE _Empty #-} instance Storable a => AsEmpty (Storable.Vector a) where _Empty = nearly Storable.empty Storable.null {-# INLINE _Empty #-} instance AsEmpty (Seq a) where _Empty = nearly Seq.empty Seq.null {-# INLINE _Empty #-} instance AsEmpty StrictB.ByteString where _Empty = nearly StrictB.empty StrictB.null {-# INLINE _Empty #-} instance AsEmpty LazyB.ByteString where _Empty = nearly LazyB.empty LazyB.null {-# INLINE _Empty #-} instance AsEmpty StrictT.Text where _Empty = nearly StrictT.empty StrictT.null {-# INLINE _Empty #-} instance AsEmpty LazyT.Text where _Empty = nearly LazyT.empty LazyT.null {-# INLINE _Empty #-} lens-4.14/src/Control/Lens/Equality.hs0000644000000000000000000000605512710476104016042 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Equality -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- ---------------------------------------------------------------------------- module Control.Lens.Equality ( -- * Type Equality Equality, Equality' , AnEquality, AnEquality' , runEq , substEq , mapEq , fromEq , simply -- * The Trivial Equality , simple -- * Implementation Details , Identical(..) ) where import Control.Lens.Type import Data.Proxy (Proxy) #ifdef HLINT {-# ANN module "HLint: ignore Use id" #-} {-# ANN module "HLint: ignore Eta reduce" #-} #endif -- $setup -- >>> import Control.Lens ----------------------------------------------------------------------------- -- Equality ----------------------------------------------------------------------------- -- | Provides witness that @(s ~ a, b ~ t)@ holds. data Identical a b s t where Identical :: Identical a b a b -- | When you see this as an argument to a function, it expects an 'Equality'. #if __GLASGOW_HASKELL__ >= 706 type AnEquality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = Identical a (Proxy b) a (Proxy b) -> Identical a (Proxy b) s (Proxy t) #else type AnEquality s t a b = Identical a (Proxy b) a (Proxy b) -> Identical a (Proxy b) s (Proxy t) #endif -- | A 'Simple' 'AnEquality'. type AnEquality' s a = AnEquality s s a a -- | Extract a witness of type 'Equality'. runEq :: AnEquality s t a b -> Identical s t a b runEq l = case l Identical of Identical -> Identical {-# INLINE runEq #-} -- | Substituting types with 'Equality'. substEq :: AnEquality s t a b -> ((s ~ a, t ~ b) => r) -> r substEq l = case runEq l of Identical -> \r -> r {-# INLINE substEq #-} -- | We can use 'Equality' to do substitution into anything. #if __GLASGOW_HASKELL__ >= 706 mapEq :: forall (s :: k1) (t :: k2) (a :: k1) (b :: k2) (f :: k1 -> *) . AnEquality s t a b -> f s -> f a #else mapEq :: AnEquality s t a b -> f s -> f a #endif mapEq l r = substEq l r {-# INLINE mapEq #-} -- | 'Equality' is symmetric. fromEq :: AnEquality s t a b -> Equality b a t s fromEq l = substEq l id {-# INLINE fromEq #-} -- | This is an adverb that can be used to modify many other 'Lens' combinators to make them require -- simple lenses, simple traversals, simple prisms or simple isos as input. simply :: (Optic' p f s a -> r) -> Optic' p f s a -> r simply = id {-# INLINE simply #-} -- | Composition with this isomorphism is occasionally useful when your 'Lens', -- 'Control.Lens.Traversal.Traversal' or 'Iso' has a constraint on an unused -- argument to force that argument to agree with the -- type of a used argument and avoid @ScopedTypeVariables@ or other ugliness. simple :: Equality' a a simple = id {-# INLINE simple #-} lens-4.14/src/Control/Lens/Extras.hs0000644000000000000000000000150012710476104015501 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.List.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- A few extra names that didn't make it into Control.Lens. -- ---------------------------------------------------------------------------- module Control.Lens.Extras ( is , module Data.Data.Lens ) where import Control.Lens import Data.Data.Lens -- $setup -- >>> import Control.Lens -- >>> import Numeric.Lens (hex) -- | Check to see if this 'Prism' matches. -- -- >>> is _Left (Right 12) -- False -- -- >>> is hex "3f79" -- True is :: APrism s t a b -> s -> Bool is k = not . isn't k {-# INLINE is #-} lens-4.14/src/Control/Lens/Fold.hs0000644000000000000000000026654512710476104015145 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #ifndef MIN_VERSION_reflection #define MIN_VERSION_reflection(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} ---------------------------------------------------------------------------- -- | -- Module : Control.Lens.Fold -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- A @'Fold' s a@ is a generalization of something 'Foldable'. It allows -- you to extract multiple results from a container. A 'Foldable' container -- can be characterized by the behavior of -- @'Data.Foldable.foldMap' :: ('Foldable' t, 'Monoid' m) => (a -> m) -> t a -> m@. -- Since we want to be able to work with monomorphic containers, we could -- generalize this signature to @forall m. 'Monoid' m => (a -> m) -> s -> m@, -- and then decorate it with 'Const' to obtain -- -- @type 'Fold' s a = forall m. 'Monoid' m => 'Getting' m s a@ -- -- Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' -- it is passed. -- -- In practice the type we use is slightly more complicated to allow for -- better error messages and for it to be transformed by certain -- 'Applicative' transformers. -- -- Everything you can do with a 'Foldable' container, you can with with a 'Fold' and there are -- combinators that generalize the usual 'Foldable' operations here. ---------------------------------------------------------------------------- module Control.Lens.Fold ( -- * Folds Fold , IndexedFold -- * Getting Started , (^..) , (^?) , (^?!) , pre, ipre , preview, previews, ipreview, ipreviews , preuse, preuses, ipreuse, ipreuses , has, hasn't -- ** Building Folds , folding, ifolding , foldring, ifoldring , folded , folded64 , unfolded , iterated , filtered , backwards , repeated , replicated , cycled , takingWhile , droppingWhile , worded, lined -- ** Folding , foldMapOf, foldOf , foldrOf, foldlOf , toListOf , anyOf, allOf, noneOf , andOf, orOf , productOf, sumOf , traverseOf_, forOf_, sequenceAOf_ , mapMOf_, forMOf_, sequenceOf_ , asumOf, msumOf , concatMapOf, concatOf , elemOf, notElemOf , lengthOf , nullOf, notNullOf , firstOf, lastOf , maximumOf, minimumOf , maximumByOf, minimumByOf , findOf , findMOf , foldrOf', foldlOf' , foldr1Of, foldl1Of , foldr1Of', foldl1Of' , foldrMOf, foldlMOf , lookupOf -- * Indexed Folds , (^@..) , (^@?) , (^@?!) -- ** Indexed Folding , ifoldMapOf , ifoldrOf , ifoldlOf , ianyOf , iallOf , inoneOf , itraverseOf_ , iforOf_ , imapMOf_ , iforMOf_ , iconcatMapOf , ifindOf , ifindMOf , ifoldrOf' , ifoldlOf' , ifoldrMOf , ifoldlMOf , itoListOf , elemIndexOf , elemIndicesOf , findIndexOf , findIndicesOf -- ** Building Indexed Folds , ifiltered , itakingWhile , idroppingWhile -- * Internal types , Leftmost , Rightmost , Traversed , Sequenced -- * Fold with Reified Monoid , foldBy , foldByOf , foldMapBy , foldMapByOf ) where import Control.Applicative as Applicative import Control.Applicative.Backwards import Control.Comonad import Control.Lens.Getter import Control.Lens.Internal.Fold import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Control.Lens.Internal.Magma import Control.Lens.Type import Control.Monad as Monad import Control.Monad.Reader import Control.Monad.State import Data.Foldable import Data.Functor.Apply import Data.Functor.Compose import Data.Functor.Contravariant import Data.Int (Int64) import Data.List (intercalate) import Data.Maybe import Data.Monoid import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Profunctor.Unsafe #if MIN_VERSION_reflection(2,1,0) import Data.Reflection #endif import Data.Traversable import Prelude hiding (foldr) -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Control.Lens.Extras (is) -- >>> import Data.Function -- >>> import Data.List.Lens -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g) -- >>> import Control.DeepSeq (NFData (..), force) -- >>> import Control.Exception (evaluate) -- >>> import Data.Maybe (fromMaybe) -- >>> import System.Timeout (timeout) -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force #ifdef HLINT {-# ANN module "HLint: ignore Eta reduce" #-} {-# ANN module "HLint: ignore Use camelCase" #-} {-# ANN module "HLint: ignore Use curry" #-} {-# ANN module "HLint: ignore Use fmap" #-} #endif infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?! -------------------------- -- Folds -------------------------- -- | Obtain a 'Fold' by lifting an operation that returns a 'Foldable' result. -- -- This can be useful to lift operations from @Data.List@ and elsewhere into a 'Fold'. -- -- >>> [1,2,3,4]^..folding tail -- [2,3,4] folding :: Foldable f => (s -> f a) -> Fold s a folding sfa agb = phantom . traverse_ agb . sfa {-# INLINE folding #-} ifolding :: (Foldable f, Indexable i p, Contravariant g, Applicative g) => (s -> f (i, a)) -> Over p g s t a b ifolding sfa f = phantom . traverse_ (phantom . uncurry (indexed f)) . sfa {-# INLINE ifolding #-} -- | Obtain a 'Fold' by lifting 'foldr' like function. -- -- >>> [1,2,3,4]^..foldring foldr -- [1,2,3,4] foldring :: (Contravariant f, Applicative f) => ((a -> f a -> f a) -> f a -> s -> f a) -> LensLike f s t a b foldring fr f = phantom . fr (\a fa -> f a *> fa) noEffect {-# INLINE foldring #-} -- | Obtain 'FoldWithIndex' by lifting 'ifoldr' like function. ifoldring :: (Indexable i p, Contravariant f, Applicative f) => ((i -> a -> f a -> f a) -> f a -> s -> f a) -> Over p f s t a b ifoldring ifr f = phantom . ifr (\i a fa -> indexed f i a *> fa) noEffect {-# INLINE ifoldring #-} -- | Obtain a 'Fold' from any 'Foldable' indexed by ordinal position. -- -- >>> Just 3^..folded -- [3] -- -- >>> Nothing^..folded -- [] -- -- >>> [(1,2),(3,4)]^..folded.both -- [1,2,3,4] folded :: Foldable f => IndexedFold Int (f a) a folded = conjoined (foldring foldr) (ifoldring ifoldr) {-# INLINE folded #-} ifoldr :: Foldable f => (Int -> a -> b -> b) -> b -> f a -> b ifoldr f z xs = foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 {-# INLINE ifoldr #-} -- | Obtain a 'Fold' from any 'Foldable' indexed by ordinal position. folded64 :: Foldable f => IndexedFold Int64 (f a) a folded64 = conjoined (foldring foldr) (ifoldring ifoldr64) {-# INLINE folded64 #-} ifoldr64 :: Foldable f => (Int64 -> a -> b -> b) -> b -> f a -> b ifoldr64 f z xs = foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 {-# INLINE ifoldr64 #-} -- | Form a 'Fold1' by repeating the input forever. -- -- @ -- 'repeat' ≡ 'toListOf' 'repeated' -- @ -- -- >>> timingOut $ 5^..taking 20 repeated -- [5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5] -- -- @ -- 'repeated' :: 'Fold1' a a -- @ repeated :: Apply f => LensLike' f a a repeated f a = as where as = f a .> as {-# INLINE repeated #-} -- | A 'Fold' that replicates its input @n@ times. -- -- @ -- 'replicate' n ≡ 'toListOf' ('replicated' n) -- @ -- -- >>> 5^..replicated 20 -- [5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5] replicated :: Int -> Fold a a replicated n0 f a = go n0 where m = f a go 0 = noEffect go n = m *> go (n - 1) {-# INLINE replicated #-} -- | Transform a non-empty 'Fold' into a 'Fold1' that loops over its elements over and over. -- -- >>> timingOut $ [1,2,3]^..taking 7 (cycled traverse) -- [1,2,3,1,2,3,1] -- -- @ -- 'cycled' :: 'Fold1' s a -> 'Fold1' s a -- @ cycled :: Apply f => LensLike f s t a b -> LensLike f s t a b cycled l f a = as where as = l f a .> as {-# INLINE cycled #-} -- | Build a 'Fold' that unfolds its values from a seed. -- -- @ -- 'Prelude.unfoldr' ≡ 'toListOf' '.' 'unfolded' -- @ -- -- >>> 10^..unfolded (\b -> if b == 0 then Nothing else Just (b, b-1)) -- [10,9,8,7,6,5,4,3,2,1] unfolded :: (b -> Maybe (a, b)) -> Fold b a unfolded f g b0 = go b0 where go b = case f b of Just (a, b') -> g a *> go b' Nothing -> noEffect {-# INLINE unfolded #-} -- | @x '^.' 'iterated' f@ returns an infinite 'Fold1' of repeated applications of @f@ to @x@. -- -- @ -- 'toListOf' ('iterated' f) a ≡ 'iterate' f a -- @ -- -- @ -- 'iterated' :: (a -> a) -> 'Fold1' a a -- @ iterated :: Apply f => (a -> a) -> LensLike' f a a iterated f g a0 = go a0 where go a = g a .> go (f a) {-# INLINE iterated #-} -- | Obtain an 'Fold' that can be composed with to filter another 'Lens', 'Iso', 'Getter', 'Fold' (or 'Traversal'). -- -- Note: This is /not/ a legal 'Traversal', unless you are very careful not to invalidate the predicate on the target. -- -- Note: This is also /not/ a legal 'Prism', unless you are very careful not to inject a value that matches the predicate. -- -- As a counter example, consider that given @evens = 'filtered' 'even'@ the second 'Traversal' law is violated: -- -- @ -- 'Control.Lens.Setter.over' evens 'succ' '.' 'Control.Lens.Setter.over' evens 'succ' '/=' 'Control.Lens.Setter.over' evens ('succ' '.' 'succ') -- @ -- -- So, in order for this to qualify as a legal 'Traversal' you can only use it for actions that preserve the result of the predicate! -- -- >>> [1..10]^..folded.filtered even -- [2,4,6,8,10] -- -- This will preserve an index if it is present. filtered :: (Choice p, Applicative f) => (a -> Bool) -> Optic' p f a a filtered p = dimap (\x -> if p x then Right x else Left x) (either pure id) . right' {-# INLINE filtered #-} -- | Obtain a 'Fold' by taking elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds. -- -- @ -- 'takeWhile' p ≡ 'toListOf' ('takingWhile' p 'folded') -- @ -- -- >>> timingOut $ toListOf (takingWhile (<=3) folded) [1..] -- [1,2,3] -- -- @ -- 'takingWhile' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s a -- 'takingWhile' :: (a -> 'Bool') -> 'Getter' s a -> 'Fold' s a -- 'takingWhile' :: (a -> 'Bool') -> 'Traversal'' s a -> 'Fold' s a -- * See note below -- 'takingWhile' :: (a -> 'Bool') -> 'Lens'' s a -> 'Fold' s a -- * See note below -- 'takingWhile' :: (a -> 'Bool') -> 'Prism'' s a -> 'Fold' s a -- * See note below -- 'takingWhile' :: (a -> 'Bool') -> 'Iso'' s a -> 'Fold' s a -- * See note below -- 'takingWhile' :: (a -> 'Bool') -> 'IndexedTraversal'' i s a -> 'IndexedFold' i s a -- * See note below -- 'takingWhile' :: (a -> 'Bool') -> 'IndexedLens'' i s a -> 'IndexedFold' i s a -- * See note below -- 'takingWhile' :: (a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' i s a -- 'takingWhile' :: (a -> 'Bool') -> 'IndexedGetter' i s a -> 'IndexedFold' i s a -- @ -- -- /Note:/ When applied to a 'Traversal', 'takingWhile' yields something that can be used as if it were a 'Traversal', but -- which is not a 'Traversal' per the laws, unless you are careful to ensure that you do not invalidate the predicate when -- writing back through it. takingWhile :: (Conjoined p, Applicative f) => (a -> Bool) -> Over p (TakingWhile p f a a) s t a a -> Over p f s t a a takingWhile p l pafb = fmap runMagma . traverse (cosieve pafb) . runTakingWhile . l flag where flag = cotabulate $ \wa -> let a = extract wa; r = p a in TakingWhile r a $ \pr -> if pr && r then Magma () wa else MagmaPure a {-# INLINE takingWhile #-} -- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds. -- -- @ -- 'dropWhile' p ≡ 'toListOf' ('droppingWhile' p 'folded') -- @ -- -- >>> toListOf (droppingWhile (<=3) folded) [1..6] -- [4,5,6] -- -- >>> toListOf (droppingWhile (<=3) folded) [1,6,1] -- [6,1] -- -- @ -- 'droppingWhile' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s a -- 'droppingWhile' :: (a -> 'Bool') -> 'Getter' s a -> 'Fold' s a -- 'droppingWhile' :: (a -> 'Bool') -> 'Traversal'' s a -> 'Fold' s a -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'Lens'' s a -> 'Fold' s a -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'Prism'' s a -> 'Fold' s a -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'Iso'' s a -> 'Fold' s a -- see notes -- @ -- -- @ -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingTraversal'' s a -> 'IndexPreservingFold' s a -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingLens'' s a -> 'IndexPreservingFold' s a -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingGetter' s a -> 'IndexPreservingFold' s a -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingFold' s a -> 'IndexPreservingFold' s a -- @ -- -- @ -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedTraversal'' i s a -> 'IndexedFold' i s a -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedLens'' i s a -> 'IndexedFold' i s a -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedGetter' i s a -> 'IndexedFold' i s a -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' i s a -- @ -- -- Note: Many uses of this combinator will yield something that meets the types, but not the laws of a valid -- 'Traversal' or 'IndexedTraversal'. The 'Traversal' and 'IndexedTraversal' laws are only satisfied if the -- new values you assign also pass the predicate! Otherwise subsequent traversals will visit fewer elements -- and 'Traversal' fusion is not sound. droppingWhile :: (Conjoined p, Profunctor q, Applicative f) => (a -> Bool) -> Optical p q (Compose (State Bool) f) s t a a -> Optical p q f s t a a droppingWhile p l f = (flip evalState True .# getCompose) `rmap` l g where g = cotabulate $ \wa -> Compose $ state $ \b -> let a = extract wa b' = b && p a in (if b' then pure a else cosieve f wa, b') {-# INLINE droppingWhile #-} -- | A 'Fold' over the individual 'words' of a 'String'. -- -- @ -- 'worded' :: 'Fold' 'String' 'String' -- 'worded' :: 'Traversal'' 'String' 'String' -- @ -- -- @ -- 'worded' :: 'IndexedFold' 'Int' 'String' 'String' -- 'worded' :: 'IndexedTraversal'' 'Int' 'String' 'String' -- @ -- -- Note: This function type-checks as a 'Traversal' but it doesn't satisfy the laws. It's only valid to use it -- when you don't insert any whitespace characters while traversing, and if your original 'String' contains only -- isolated space characters (and no other characters that count as space, such as non-breaking spaces). worded :: Applicative f => IndexedLensLike' Int f String String worded f = fmap unwords . conjoined traverse (indexing traverse) f . words {-# INLINE worded #-} -- | A 'Fold' over the individual 'lines' of a 'String'. -- -- @ -- 'lined' :: 'Fold' 'String' 'String' -- 'lined' :: 'Traversal'' 'String' 'String' -- @ -- -- @ -- 'lined' :: 'IndexedFold' 'Int' 'String' 'String' -- 'lined' :: 'IndexedTraversal'' 'Int' 'String' 'String' -- @ -- -- Note: This function type-checks as a 'Traversal' but it doesn't satisfy the laws. It's only valid to use it -- when you don't insert any newline characters while traversing, and if your original 'String' contains only -- isolated newline characters. lined :: Applicative f => IndexedLensLike' Int f String String lined f = fmap (intercalate "\n") . conjoined traverse (indexing traverse) f . lines {-# INLINE lined #-} -------------------------- -- Fold/Getter combinators -------------------------- -- | Map each part of a structure viewed through a 'Lens', 'Getter', -- 'Fold' or 'Traversal' to a monoid and combine the results. -- -- >>> foldMapOf (folded . both . _Just) Sum [(Just 21, Just 21)] -- Sum {getSum = 42} -- -- @ -- 'Data.Foldable.foldMap' = 'foldMapOf' 'folded' -- @ -- -- @ -- 'foldMapOf' ≡ 'views' -- 'ifoldMapOf' l = 'foldMapOf' l '.' 'Indexed' -- @ -- -- @ -- 'foldMapOf' :: 'Getter' s a -> (a -> r) -> s -> r -- 'foldMapOf' :: 'Monoid' r => 'Fold' s a -> (a -> r) -> s -> r -- 'foldMapOf' :: 'Lens'' s a -> (a -> r) -> s -> r -- 'foldMapOf' :: 'Iso'' s a -> (a -> r) -> s -> r -- 'foldMapOf' :: 'Monoid' r => 'Traversal'' s a -> (a -> r) -> s -> r -- 'foldMapOf' :: 'Monoid' r => 'Prism'' s a -> (a -> r) -> s -> r -- @ -- -- @ -- 'foldMapOf' :: 'Getting' r s a -> (a -> r) -> s -> r -- @ foldMapOf :: Getting r s a -> (a -> r) -> s -> r foldMapOf l f = getConst #. l (Const #. f) {-# INLINE foldMapOf #-} -- | Combine the elements of a structure viewed through a 'Lens', 'Getter', -- 'Fold' or 'Traversal' using a monoid. -- -- >>> foldOf (folded.folded) [[Sum 1,Sum 4],[Sum 8, Sum 8],[Sum 21]] -- Sum {getSum = 42} -- -- @ -- 'Data.Foldable.fold' = 'foldOf' 'folded' -- @ -- -- @ -- 'foldOf' ≡ 'view' -- @ -- -- @ -- 'foldOf' :: 'Getter' s m -> s -> m -- 'foldOf' :: 'Monoid' m => 'Fold' s m -> s -> m -- 'foldOf' :: 'Lens'' s m -> s -> m -- 'foldOf' :: 'Iso'' s m -> s -> m -- 'foldOf' :: 'Monoid' m => 'Traversal'' s m -> s -> m -- 'foldOf' :: 'Monoid' m => 'Prism'' s m -> s -> m -- @ foldOf :: Getting a s a -> s -> a foldOf l = getConst #. l Const {-# INLINE foldOf #-} -- | Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'. -- -- @ -- 'Data.Foldable.foldr' ≡ 'foldrOf' 'folded' -- @ -- -- @ -- 'foldrOf' :: 'Getter' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf' :: 'Fold' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf' :: 'Lens'' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf' :: 'Iso'' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf' :: 'Traversal'' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf' :: 'Prism'' s a -> (a -> r -> r) -> r -> s -> r -- @ -- -- @ -- 'ifoldrOf' l ≡ 'foldrOf' l '.' 'Indexed' -- @ -- -- @ -- 'foldrOf' :: 'Getting' ('Endo' r) s a -> (a -> r -> r) -> r -> s -> r -- @ foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f) {-# INLINE foldrOf #-} -- | Left-associative fold of the parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'. -- -- @ -- 'Data.Foldable.foldl' ≡ 'foldlOf' 'folded' -- @ -- -- @ -- 'foldlOf' :: 'Getter' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf' :: 'Fold' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf' :: 'Lens'' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf' :: 'Iso'' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf' :: 'Prism'' s a -> (r -> a -> r) -> r -> s -> r -- @ foldlOf :: Getting (Dual (Endo r)) s a -> (r -> a -> r) -> r -> s -> r foldlOf l f z = (flip appEndo z .# getDual) `rmap` foldMapOf l (Dual #. Endo #. flip f) {-# INLINE foldlOf #-} -- | Extract a list of the targets of a 'Fold'. See also ('^..'). -- -- @ -- 'Data.Foldable.toList' ≡ 'toListOf' 'folded' -- ('^..') ≡ 'flip' 'toListOf' -- @ -- >>> toListOf both ("hello","world") -- ["hello","world"] -- -- @ -- 'toListOf' :: 'Getter' s a -> s -> [a] -- 'toListOf' :: 'Fold' s a -> s -> [a] -- 'toListOf' :: 'Lens'' s a -> s -> [a] -- 'toListOf' :: 'Iso'' s a -> s -> [a] -- 'toListOf' :: 'Traversal'' s a -> s -> [a] -- 'toListOf' :: 'Prism'' s a -> s -> [a] -- @ toListOf :: Getting (Endo [a]) s a -> s -> [a] toListOf l = foldrOf l (:) [] {-# INLINE toListOf #-} -- | A convenient infix (flipped) version of 'toListOf'. -- -- >>> [[1,2],[3]]^..id -- [[[1,2],[3]]] -- >>> [[1,2],[3]]^..traverse -- [[1,2],[3]] -- >>> [[1,2],[3]]^..traverse.traverse -- [1,2,3] -- -- >>> (1,2)^..both -- [1,2] -- -- @ -- 'Data.Foldable.toList' xs ≡ xs '^..' 'folded' -- ('^..') ≡ 'flip' 'toListOf' -- @ -- -- @ -- ('^..') :: s -> 'Getter' s a -> [a] -- ('^..') :: s -> 'Fold' s a -> [a] -- ('^..') :: s -> 'Lens'' s a -> [a] -- ('^..') :: s -> 'Iso'' s a -> [a] -- ('^..') :: s -> 'Traversal'' s a -> [a] -- ('^..') :: s -> 'Prism'' s a -> [a] -- @ (^..) :: s -> Getting (Endo [a]) s a -> [a] s ^.. l = toListOf l s {-# INLINE (^..) #-} -- | Returns 'True' if every target of a 'Fold' is 'True'. -- -- >>> andOf both (True,False) -- False -- >>> andOf both (True,True) -- True -- -- @ -- 'Data.Foldable.and' ≡ 'andOf' 'folded' -- @ -- -- @ -- 'andOf' :: 'Getter' s 'Bool' -> s -> 'Bool' -- 'andOf' :: 'Fold' s 'Bool' -> s -> 'Bool' -- 'andOf' :: 'Lens'' s 'Bool' -> s -> 'Bool' -- 'andOf' :: 'Iso'' s 'Bool' -> s -> 'Bool' -- 'andOf' :: 'Traversal'' s 'Bool' -> s -> 'Bool' -- 'andOf' :: 'Prism'' s 'Bool' -> s -> 'Bool' -- @ andOf :: Getting All s Bool -> s -> Bool andOf l = getAll #. foldMapOf l All {-# INLINE andOf #-} -- | Returns 'True' if any target of a 'Fold' is 'True'. -- -- >>> orOf both (True,False) -- True -- >>> orOf both (False,False) -- False -- -- @ -- 'Data.Foldable.or' ≡ 'orOf' 'folded' -- @ -- -- @ -- 'orOf' :: 'Getter' s 'Bool' -> s -> 'Bool' -- 'orOf' :: 'Fold' s 'Bool' -> s -> 'Bool' -- 'orOf' :: 'Lens'' s 'Bool' -> s -> 'Bool' -- 'orOf' :: 'Iso'' s 'Bool' -> s -> 'Bool' -- 'orOf' :: 'Traversal'' s 'Bool' -> s -> 'Bool' -- 'orOf' :: 'Prism'' s 'Bool' -> s -> 'Bool' -- @ orOf :: Getting Any s Bool -> s -> Bool orOf l = getAny #. foldMapOf l Any {-# INLINE orOf #-} -- | Returns 'True' if any target of a 'Fold' satisfies a predicate. -- -- >>> anyOf both (=='x') ('x','y') -- True -- >>> import Data.Data.Lens -- >>> anyOf biplate (== "world") (((),2::Int),"hello",("world",11::Int)) -- True -- -- @ -- 'Data.Foldable.any' ≡ 'anyOf' 'folded' -- @ -- -- @ -- 'ianyOf' l ≡ 'anyOf' l '.' 'Indexed' -- @ -- -- @ -- 'anyOf' :: 'Getter' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'anyOf' :: 'Fold' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'anyOf' :: 'Lens'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'anyOf' :: 'Iso'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'anyOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'anyOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' -- @ anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool anyOf l f = getAny #. foldMapOf l (Any #. f) {-# INLINE anyOf #-} -- | Returns 'True' if every target of a 'Fold' satisfies a predicate. -- -- >>> allOf both (>=3) (4,5) -- True -- >>> allOf folded (>=2) [1..10] -- False -- -- @ -- 'Data.Foldable.all' ≡ 'allOf' 'folded' -- @ -- -- @ -- 'iallOf' l = 'allOf' l '.' 'Indexed' -- @ -- -- @ -- 'allOf' :: 'Getter' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'allOf' :: 'Fold' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'allOf' :: 'Lens'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'allOf' :: 'Iso'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'allOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'allOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' -- @ allOf :: Getting All s a -> (a -> Bool) -> s -> Bool allOf l f = getAll #. foldMapOf l (All #. f) {-# INLINE allOf #-} -- | Returns 'True' only if no targets of a 'Fold' satisfy a predicate. -- -- >>> noneOf each (is _Nothing) (Just 3, Just 4, Just 5) -- True -- >>> noneOf (folded.folded) (<10) [[13,99,20],[3,71,42]] -- False -- -- @ -- 'inoneOf' l = 'noneOf' l '.' 'Indexed' -- @ -- -- @ -- 'noneOf' :: 'Getter' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'noneOf' :: 'Fold' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'noneOf' :: 'Lens'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'noneOf' :: 'Iso'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'noneOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'noneOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' -- @ noneOf :: Getting Any s a -> (a -> Bool) -> s -> Bool noneOf l f = not . anyOf l f {-# INLINE noneOf #-} -- | Calculate the 'Product' of every number targeted by a 'Fold'. -- -- >>> productOf both (4,5) -- 20 -- >>> productOf folded [1,2,3,4,5] -- 120 -- -- @ -- 'Data.Foldable.product' ≡ 'productOf' 'folded' -- @ -- -- This operation may be more strict than you would expect. If you -- want a lazier version use @'ala' 'Product' '.' 'foldMapOf'@ -- -- @ -- 'productOf' :: 'Num' a => 'Getter' s a -> s -> a -- 'productOf' :: 'Num' a => 'Fold' s a -> s -> a -- 'productOf' :: 'Num' a => 'Lens'' s a -> s -> a -- 'productOf' :: 'Num' a => 'Iso'' s a -> s -> a -- 'productOf' :: 'Num' a => 'Traversal'' s a -> s -> a -- 'productOf' :: 'Num' a => 'Prism'' s a -> s -> a -- @ productOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a productOf l = foldlOf' l (*) 1 {-# INLINE productOf #-} -- | Calculate the 'Sum' of every number targeted by a 'Fold'. -- -- >>> 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 -- -- @ -- 'Data.Foldable.sum' ≡ 'sumOf' 'folded' -- @ -- -- This operation may be more strict than you would expect. If you -- want a lazier version use @'ala' 'Sum' '.' 'foldMapOf'@ -- -- @ -- 'sumOf' '_1' :: 'Num' a => (a, b) -> a -- 'sumOf' ('folded' '.' 'Control.Lens.Tuple._1') :: ('Foldable' f, 'Num' a) => f (a, b) -> a -- @ -- -- @ -- 'sumOf' :: 'Num' a => 'Getter' s a -> s -> a -- 'sumOf' :: 'Num' a => 'Fold' s a -> s -> a -- 'sumOf' :: 'Num' a => 'Lens'' s a -> s -> a -- 'sumOf' :: 'Num' a => 'Iso'' s a -> s -> a -- 'sumOf' :: 'Num' a => 'Traversal'' s a -> s -> a -- 'sumOf' :: 'Num' a => 'Prism'' s a -> s -> a -- @ sumOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a sumOf l = foldlOf' l (+) 0 {-# INLINE sumOf #-} -- | 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 'Getter', 'traverseOf_' can work over any 'Functor', but when passed a 'Fold', 'traverseOf_' requires -- an 'Applicative'. -- -- >>> traverseOf_ both putStrLn ("hello","world") -- hello -- world -- -- @ -- 'Data.Foldable.traverse_' ≡ 'traverseOf_' 'folded' -- @ -- -- @ -- 'traverseOf_' '_2' :: 'Functor' f => (c -> f r) -> (d, c) -> f () -- 'traverseOf_' 'Control.Lens.Prism._Left' :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f () -- @ -- -- @ -- 'itraverseOf_' l ≡ 'traverseOf_' l '.' 'Indexed' -- @ -- -- The rather specific signature of 'traverseOf_' allows it to be used as if the signature was any of: -- -- @ -- 'traverseOf_' :: 'Functor' f => 'Getter' s a -> (a -> f r) -> s -> f () -- 'traverseOf_' :: 'Applicative' f => 'Fold' s a -> (a -> f r) -> s -> f () -- 'traverseOf_' :: 'Functor' f => 'Lens'' s a -> (a -> f r) -> s -> f () -- 'traverseOf_' :: 'Functor' f => 'Iso'' s a -> (a -> f r) -> s -> f () -- 'traverseOf_' :: 'Applicative' f => 'Traversal'' s a -> (a -> f r) -> s -> f () -- 'traverseOf_' :: 'Applicative' f => 'Prism'' s a -> (a -> f r) -> s -> f () -- @ traverseOf_ :: Functor f => Getting (Traversed r f) s a -> (a -> f r) -> s -> f () traverseOf_ l f = void . getTraversed #. foldMapOf l (Traversed #. f) {-# INLINE traverseOf_ #-} -- | 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' -- @ -- -- >>> forOf_ both ("hello","world") putStrLn -- hello -- world -- -- The rather specific signature of 'forOf_' allows it to be used as if the signature was any of: -- -- @ -- 'iforOf_' l s ≡ 'forOf_' l s '.' 'Indexed' -- @ -- -- @ -- 'forOf_' :: 'Functor' f => 'Getter' s a -> s -> (a -> f r) -> f () -- 'forOf_' :: 'Applicative' f => 'Fold' s a -> s -> (a -> f r) -> f () -- 'forOf_' :: 'Functor' f => 'Lens'' s a -> s -> (a -> f r) -> f () -- 'forOf_' :: 'Functor' f => 'Iso'' s a -> s -> (a -> f r) -> f () -- 'forOf_' :: 'Applicative' f => 'Traversal'' s a -> s -> (a -> f r) -> f () -- 'forOf_' :: 'Applicative' f => 'Prism'' s a -> s -> (a -> f r) -> f () -- @ forOf_ :: Functor f => Getting (Traversed r f) s a -> s -> (a -> f r) -> f () forOf_ = flip . traverseOf_ {-# INLINE forOf_ #-} -- | Evaluate each action in observed by a 'Fold' on a structure from left to right, ignoring the results. -- -- @ -- 'sequenceA_' ≡ 'sequenceAOf_' 'folded' -- @ -- -- >>> sequenceAOf_ both (putStrLn "hello",putStrLn "world") -- hello -- world -- -- @ -- 'sequenceAOf_' :: 'Functor' f => 'Getter' s (f a) -> s -> f () -- 'sequenceAOf_' :: 'Applicative' f => 'Fold' s (f a) -> s -> f () -- 'sequenceAOf_' :: 'Functor' f => 'Lens'' s (f a) -> s -> f () -- 'sequenceAOf_' :: 'Functor' f => 'Iso'' s (f a) -> s -> f () -- 'sequenceAOf_' :: 'Applicative' f => 'Traversal'' s (f a) -> s -> f () -- 'sequenceAOf_' :: 'Applicative' f => 'Prism'' s (f a) -> s -> f () -- @ sequenceAOf_ :: Functor f => Getting (Traversed a f) s (f a) -> s -> f () sequenceAOf_ l = void . getTraversed #. foldMapOf l Traversed {-# INLINE sequenceAOf_ #-} -- | Map each target of a 'Fold' on a structure to a monadic action, evaluate these actions from left to right, and ignore the results. -- -- >>> mapMOf_ both putStrLn ("hello","world") -- hello -- world -- -- @ -- 'Data.Foldable.mapM_' ≡ 'mapMOf_' 'folded' -- @ -- -- @ -- 'mapMOf_' :: 'Monad' m => 'Getter' s a -> (a -> m r) -> s -> m () -- 'mapMOf_' :: 'Monad' m => 'Fold' s a -> (a -> m r) -> s -> m () -- 'mapMOf_' :: 'Monad' m => 'Lens'' s a -> (a -> m r) -> s -> m () -- 'mapMOf_' :: 'Monad' m => 'Iso'' s a -> (a -> m r) -> s -> m () -- 'mapMOf_' :: 'Monad' m => 'Traversal'' s a -> (a -> m r) -> s -> m () -- 'mapMOf_' :: 'Monad' m => 'Prism'' s a -> (a -> m r) -> s -> m () -- @ mapMOf_ :: Monad m => Getting (Sequenced r m) s a -> (a -> m r) -> s -> m () mapMOf_ l f = liftM skip . getSequenced #. foldMapOf l (Sequenced #. f) {-# INLINE mapMOf_ #-} -- | 'forMOf_' is 'mapMOf_' with two of its arguments flipped. -- -- >>> forMOf_ both ("hello","world") putStrLn -- hello -- world -- -- @ -- 'Data.Foldable.forM_' ≡ 'forMOf_' 'folded' -- @ -- -- @ -- 'forMOf_' :: 'Monad' m => 'Getter' s a -> s -> (a -> m r) -> m () -- 'forMOf_' :: 'Monad' m => 'Fold' s a -> s -> (a -> m r) -> m () -- 'forMOf_' :: 'Monad' m => 'Lens'' s a -> s -> (a -> m r) -> m () -- 'forMOf_' :: 'Monad' m => 'Iso'' s a -> s -> (a -> m r) -> m () -- 'forMOf_' :: 'Monad' m => 'Traversal'' s a -> s -> (a -> m r) -> m () -- 'forMOf_' :: 'Monad' m => 'Prism'' s a -> s -> (a -> m r) -> m () -- @ forMOf_ :: Monad m => Getting (Sequenced r m) s a -> s -> (a -> m r) -> m () forMOf_ = flip . mapMOf_ {-# INLINE forMOf_ #-} -- | Evaluate each monadic action referenced by a 'Fold' on the structure from left to right, and ignore the results. -- -- >>> sequenceOf_ both (putStrLn "hello",putStrLn "world") -- hello -- world -- -- @ -- 'Data.Foldable.sequence_' ≡ 'sequenceOf_' 'folded' -- @ -- -- @ -- 'sequenceOf_' :: 'Monad' m => 'Getter' s (m a) -> s -> m () -- 'sequenceOf_' :: 'Monad' m => 'Fold' s (m a) -> s -> m () -- 'sequenceOf_' :: 'Monad' m => 'Lens'' s (m a) -> s -> m () -- 'sequenceOf_' :: 'Monad' m => 'Iso'' s (m a) -> s -> m () -- 'sequenceOf_' :: 'Monad' m => 'Traversal'' s (m a) -> s -> m () -- 'sequenceOf_' :: 'Monad' m => 'Prism'' s (m a) -> s -> m () -- @ sequenceOf_ :: Monad m => Getting (Sequenced a m) s (m a) -> s -> m () sequenceOf_ l = liftM skip . getSequenced #. foldMapOf l Sequenced {-# INLINE sequenceOf_ #-} -- | The sum of a collection of actions, generalizing 'concatOf'. -- -- >>> asumOf both ("hello","world") -- "helloworld" -- -- >>> asumOf each (Nothing, Just "hello", Nothing) -- Just "hello" -- -- @ -- 'asum' ≡ 'asumOf' 'folded' -- @ -- -- @ -- 'asumOf' :: 'Alternative' f => 'Getter' s (f a) -> s -> f a -- 'asumOf' :: 'Alternative' f => 'Fold' s (f a) -> s -> f a -- 'asumOf' :: 'Alternative' f => 'Lens'' s (f a) -> s -> f a -- 'asumOf' :: 'Alternative' f => 'Iso'' s (f a) -> s -> f a -- 'asumOf' :: 'Alternative' f => 'Traversal'' s (f a) -> s -> f a -- 'asumOf' :: 'Alternative' f => 'Prism'' s (f a) -> s -> f a -- @ asumOf :: Alternative f => Getting (Endo (f a)) s (f a) -> s -> f a asumOf l = foldrOf l (<|>) Applicative.empty {-# INLINE asumOf #-} -- | The sum of a collection of actions, generalizing 'concatOf'. -- -- >>> msumOf both ("hello","world") -- "helloworld" -- -- >>> msumOf each (Nothing, Just "hello", Nothing) -- Just "hello" -- -- @ -- 'msum' ≡ 'msumOf' 'folded' -- @ -- -- @ -- 'msumOf' :: 'MonadPlus' m => 'Getter' s (m a) -> s -> m a -- 'msumOf' :: 'MonadPlus' m => 'Fold' s (m a) -> s -> m a -- 'msumOf' :: 'MonadPlus' m => 'Lens'' s (m a) -> s -> m a -- 'msumOf' :: 'MonadPlus' m => 'Iso'' s (m a) -> s -> m a -- 'msumOf' :: 'MonadPlus' m => 'Traversal'' s (m a) -> s -> m a -- 'msumOf' :: 'MonadPlus' m => 'Prism'' s (m a) -> s -> m a -- @ msumOf :: MonadPlus m => Getting (Endo (m a)) s (m a) -> s -> m a msumOf l = foldrOf l mplus mzero {-# INLINE msumOf #-} -- | Does the element occur anywhere within a given 'Fold' of the structure? -- -- >>> elemOf both "hello" ("hello","world") -- True -- -- @ -- 'elem' ≡ 'elemOf' 'folded' -- @ -- -- @ -- 'elemOf' :: 'Eq' a => 'Getter' s a -> a -> s -> 'Bool' -- 'elemOf' :: 'Eq' a => 'Fold' s a -> a -> s -> 'Bool' -- 'elemOf' :: 'Eq' a => 'Lens'' s a -> a -> s -> 'Bool' -- 'elemOf' :: 'Eq' a => 'Iso'' s a -> a -> s -> 'Bool' -- 'elemOf' :: 'Eq' a => 'Traversal'' s a -> a -> s -> 'Bool' -- 'elemOf' :: 'Eq' a => 'Prism'' s a -> a -> s -> 'Bool' -- @ elemOf :: Eq a => Getting Any s a -> a -> s -> Bool elemOf l = anyOf l . (==) {-# INLINE elemOf #-} -- | Does the element not occur anywhere within a given 'Fold' of the structure? -- -- >>> notElemOf each 'd' ('a','b','c') -- True -- -- >>> notElemOf each 'a' ('a','b','c') -- False -- -- @ -- 'notElem' ≡ 'notElemOf' 'folded' -- @ -- -- @ -- 'notElemOf' :: 'Eq' a => 'Getter' s a -> a -> s -> 'Bool' -- 'notElemOf' :: 'Eq' a => 'Fold' s a -> a -> s -> 'Bool' -- 'notElemOf' :: 'Eq' a => 'Iso'' s a -> a -> s -> 'Bool' -- 'notElemOf' :: 'Eq' a => 'Lens'' s a -> a -> s -> 'Bool' -- 'notElemOf' :: 'Eq' a => 'Traversal'' s a -> a -> s -> 'Bool' -- 'notElemOf' :: 'Eq' a => 'Prism'' s a -> a -> s -> 'Bool' -- @ notElemOf :: Eq a => Getting All s a -> a -> s -> Bool notElemOf l = allOf l . (/=) {-# INLINE notElemOf #-} -- | Map a function over all the targets of a 'Fold' of a container and concatenate the resulting lists. -- -- >>> concatMapOf both (\x -> [x, x + 1]) (1,3) -- [1,2,3,4] -- -- @ -- 'concatMap' ≡ 'concatMapOf' 'folded' -- @ -- -- @ -- 'concatMapOf' :: 'Getter' s a -> (a -> [r]) -> s -> [r] -- 'concatMapOf' :: 'Fold' s a -> (a -> [r]) -> s -> [r] -- 'concatMapOf' :: 'Lens'' s a -> (a -> [r]) -> s -> [r] -- 'concatMapOf' :: 'Iso'' s a -> (a -> [r]) -> s -> [r] -- 'concatMapOf' :: 'Traversal'' s a -> (a -> [r]) -> s -> [r] -- @ concatMapOf :: Getting [r] s a -> (a -> [r]) -> s -> [r] concatMapOf l ces = getConst #. l (Const #. ces) {-# INLINE concatMapOf #-} -- | Concatenate all of the lists targeted by a 'Fold' into a longer list. -- -- >>> concatOf both ("pan","ama") -- "panama" -- -- @ -- 'concat' ≡ 'concatOf' 'folded' -- 'concatOf' ≡ 'view' -- @ -- -- @ -- 'concatOf' :: 'Getter' s [r] -> s -> [r] -- 'concatOf' :: 'Fold' s [r] -> s -> [r] -- 'concatOf' :: 'Iso'' s [r] -> s -> [r] -- 'concatOf' :: 'Lens'' s [r] -> s -> [r] -- 'concatOf' :: 'Traversal'' s [r] -> s -> [r] -- @ concatOf :: Getting [r] s [r] -> s -> [r] concatOf l = getConst #. l Const {-# INLINE concatOf #-} -- | Calculate the number of targets there are for a 'Fold' in a given container. -- -- /Note:/ This can be rather inefficient for large containers and just like 'length', -- this will not terminate for infinite folds. -- -- @ -- 'length' ≡ 'lengthOf' 'folded' -- @ -- -- >>> lengthOf _1 ("hello",()) -- 1 -- -- >>> lengthOf traverse [1..10] -- 10 -- -- >>> lengthOf (traverse.traverse) [[1,2],[3,4],[5,6]] -- 6 -- -- @ -- 'lengthOf' ('folded' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a) -> 'Int' -- @ -- -- @ -- 'lengthOf' :: 'Getter' s a -> s -> 'Int' -- 'lengthOf' :: 'Fold' s a -> s -> 'Int' -- 'lengthOf' :: 'Lens'' s a -> s -> 'Int' -- 'lengthOf' :: 'Iso'' s a -> s -> 'Int' -- 'lengthOf' :: 'Traversal'' s a -> s -> 'Int' -- @ lengthOf :: Getting (Endo (Endo Int)) s a -> s -> Int lengthOf l = foldlOf' l (\a _ -> a + 1) 0 {-# INLINE lengthOf #-} -- | Perform a safe 'head' of a 'Fold' or 'Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'. -- -- When using a 'Traversal' as a partial 'Lens', or a 'Fold' as a partial 'Getter' this can be a convenient -- way to extract the optional value. -- -- Note: if you get stack overflows due to this, you may want to use 'firstOf' instead, which can deal -- more gracefully with heavily left-biased trees. -- -- >>> Left 4 ^?_Left -- Just 4 -- -- >>> Right 4 ^?_Left -- Nothing -- -- >>> "world" ^? ix 3 -- Just 'l' -- -- >>> "world" ^? ix 20 -- Nothing -- -- @ -- ('^?') ≡ 'flip' 'preview' -- @ -- -- @ -- ('^?') :: s -> 'Getter' s a -> 'Maybe' a -- ('^?') :: s -> 'Fold' s a -> 'Maybe' a -- ('^?') :: s -> 'Lens'' s a -> 'Maybe' a -- ('^?') :: s -> 'Iso'' s a -> 'Maybe' a -- ('^?') :: s -> 'Traversal'' s a -> 'Maybe' a -- @ (^?) :: s -> Getting (First a) s a -> Maybe a s ^? l = getFirst (foldMapOf l (First #. Just) s) {-# INLINE (^?) #-} -- | Perform an *UNSAFE* 'head' of a 'Fold' or 'Traversal' assuming that it is there. -- -- >>> Left 4 ^?! _Left -- 4 -- -- >>> "world" ^?! ix 3 -- 'l' -- -- @ -- ('^?!') :: s -> 'Getter' s a -> a -- ('^?!') :: s -> 'Fold' s a -> a -- ('^?!') :: s -> 'Lens'' s a -> a -- ('^?!') :: s -> 'Iso'' s a -> a -- ('^?!') :: s -> 'Traversal'' s a -> a -- @ (^?!) :: s -> Getting (Endo a) s a -> a s ^?! l = foldrOf l const (error "(^?!): empty Fold") s {-# INLINE (^?!) #-} -- | Retrieve the 'First' entry of a 'Fold' or 'Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'. -- -- The answer is computed in a manner that leaks space less than @'ala' 'First' '.' 'foldMapOf'@ -- and gives you back access to the outermost 'Just' constructor more quickly, but may have worse -- constant factors. -- -- >>> firstOf traverse [1..10] -- Just 1 -- -- >>> firstOf both (1,2) -- Just 1 -- -- >>> firstOf ignored () -- Nothing -- -- @ -- 'firstOf' :: 'Getter' s a -> s -> 'Maybe' a -- 'firstOf' :: 'Fold' s a -> s -> 'Maybe' a -- 'firstOf' :: 'Lens'' s a -> s -> 'Maybe' a -- 'firstOf' :: 'Iso'' s a -> s -> 'Maybe' a -- 'firstOf' :: 'Traversal'' s a -> s -> 'Maybe' a -- @ firstOf :: Getting (Leftmost a) s a -> s -> Maybe a firstOf l = getLeftmost . foldMapOf l LLeaf {-# INLINE firstOf #-} -- | Retrieve the 'Last' entry of a 'Fold' or 'Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'. -- -- The answer is computed in a manner that leaks space less than @'ala' 'Last' '.' 'foldMapOf'@ -- and gives you back access to the outermost 'Just' constructor more quickly, but may have worse -- constant factors. -- -- >>> lastOf traverse [1..10] -- Just 10 -- -- >>> lastOf both (1,2) -- Just 2 -- -- >>> lastOf ignored () -- Nothing -- -- @ -- 'lastOf' :: 'Getter' s a -> s -> 'Maybe' a -- 'lastOf' :: 'Fold' s a -> s -> 'Maybe' a -- 'lastOf' :: 'Lens'' s a -> s -> 'Maybe' a -- 'lastOf' :: 'Iso'' s a -> s -> 'Maybe' a -- 'lastOf' :: 'Traversal'' s a -> s -> 'Maybe' a -- @ lastOf :: Getting (Rightmost a) s a -> s -> Maybe a lastOf l = getRightmost . foldMapOf l RLeaf {-# INLINE lastOf #-} -- | Returns 'True' if this 'Fold' or 'Traversal' has no targets in the given container. -- -- Note: 'nullOf' on a valid 'Iso', 'Lens' or 'Getter' should always return 'False'. -- -- @ -- 'null' ≡ 'nullOf' 'folded' -- @ -- -- This may be rather inefficient compared to the 'null' check of many containers. -- -- >>> nullOf _1 (1,2) -- False -- -- >>> nullOf ignored () -- True -- -- >>> nullOf traverse [] -- True -- -- >>> nullOf (element 20) [1..10] -- True -- -- @ -- 'nullOf' ('folded' '.' '_1' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a, b) -> 'Bool' -- @ -- -- @ -- 'nullOf' :: 'Getter' s a -> s -> 'Bool' -- 'nullOf' :: 'Fold' s a -> s -> 'Bool' -- 'nullOf' :: 'Iso'' s a -> s -> 'Bool' -- 'nullOf' :: 'Lens'' s a -> s -> 'Bool' -- 'nullOf' :: 'Traversal'' s a -> s -> 'Bool' -- @ nullOf :: Getting All s a -> s -> Bool nullOf = hasn't {-# INLINE nullOf #-} -- | Returns 'True' if this 'Fold' or 'Traversal' has any targets in the given container. -- -- A more \"conversational\" alias for this combinator is 'has'. -- -- Note: 'notNullOf' on a valid 'Iso', 'Lens' or 'Getter' should always return 'True'. -- -- @ -- 'not' '.' 'null' ≡ 'notNullOf' 'folded' -- @ -- -- This may be rather inefficient compared to the @'not' '.' 'null'@ check of many containers. -- -- >>> notNullOf _1 (1,2) -- True -- -- >>> notNullOf traverse [1..10] -- True -- -- >>> notNullOf folded [] -- False -- -- >>> notNullOf (element 20) [1..10] -- False -- -- @ -- 'notNullOf' ('folded' '.' '_1' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a, b) -> 'Bool' -- @ -- -- @ -- 'notNullOf' :: 'Getter' s a -> s -> 'Bool' -- 'notNullOf' :: 'Fold' s a -> s -> 'Bool' -- 'notNullOf' :: 'Iso'' s a -> s -> 'Bool' -- 'notNullOf' :: 'Lens'' s a -> s -> 'Bool' -- 'notNullOf' :: 'Traversal'' s a -> s -> 'Bool' -- @ notNullOf :: Getting Any s a -> s -> Bool notNullOf = has {-# INLINE notNullOf #-} -- | Obtain the maximum element (if any) targeted by a 'Fold' or 'Traversal' safely. -- -- Note: 'maximumOf' on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value. -- -- >>> maximumOf traverse [1..10] -- Just 10 -- -- >>> maximumOf traverse [] -- Nothing -- -- >>> maximumOf (folded.filtered even) [1,4,3,6,7,9,2] -- Just 6 -- -- @ -- 'maximum' ≡ 'fromMaybe' ('error' \"empty\") '.' 'maximumOf' 'folded' -- @ -- -- In the interest of efficiency, This operation has semantics more strict than strictly necessary. -- @'rmap' 'getMax' ('foldMapOf' l 'Max')@ has lazier semantics but could leak memory. -- -- @ -- 'maximumOf' :: 'Ord' a => 'Getter' s a -> s -> 'Maybe' a -- 'maximumOf' :: 'Ord' a => 'Fold' s a -> s -> 'Maybe' a -- 'maximumOf' :: 'Ord' a => 'Iso'' s a -> s -> 'Maybe' a -- 'maximumOf' :: 'Ord' a => 'Lens'' s a -> s -> 'Maybe' a -- 'maximumOf' :: 'Ord' a => 'Traversal'' s a -> s -> 'Maybe' a -- @ maximumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a maximumOf l = foldlOf' l mf Nothing where mf Nothing y = Just $! y mf (Just x) y = Just $! max x y {-# INLINE maximumOf #-} -- | Obtain the minimum element (if any) targeted by a 'Fold' or 'Traversal' safely. -- -- Note: 'minimumOf' on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value. -- -- >>> minimumOf traverse [1..10] -- Just 1 -- -- >>> minimumOf traverse [] -- Nothing -- -- >>> minimumOf (folded.filtered even) [1,4,3,6,7,9,2] -- Just 2 -- -- @ -- 'minimum' ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'minimumOf' 'folded' -- @ -- -- In the interest of efficiency, This operation has semantics more strict than strictly necessary. -- @'rmap' 'getMin' ('foldMapOf' l 'Min')@ has lazier semantics but could leak memory. -- -- -- @ -- 'minimumOf' :: 'Ord' a => 'Getter' s a -> s -> 'Maybe' a -- 'minimumOf' :: 'Ord' a => 'Fold' s a -> s -> 'Maybe' a -- 'minimumOf' :: 'Ord' a => 'Iso'' s a -> s -> 'Maybe' a -- 'minimumOf' :: 'Ord' a => 'Lens'' s a -> s -> 'Maybe' a -- 'minimumOf' :: 'Ord' a => 'Traversal'' s a -> s -> 'Maybe' a -- @ minimumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a minimumOf l = foldlOf' l mf Nothing where mf Nothing y = Just $! y mf (Just x) y = Just $! min x y {-# INLINE minimumOf #-} -- | Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso', -- or 'Getter' according to a user supplied 'Ordering'. -- -- >>> maximumByOf traverse (compare `on` length) ["mustard","relish","ham"] -- Just "mustard" -- -- In the interest of efficiency, This operation has semantics more strict than strictly necessary. -- -- @ -- 'Data.Foldable.maximumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'maximumByOf' 'folded' cmp -- @ -- -- @ -- 'maximumByOf' :: 'Getter' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'maximumByOf' :: 'Fold' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'maximumByOf' :: 'Iso'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'maximumByOf' :: 'Lens'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'maximumByOf' :: 'Traversal'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- @ maximumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a maximumByOf l cmp = foldlOf' l mf Nothing where mf Nothing y = Just $! y mf (Just x) y = Just $! if cmp x y == GT then x else y {-# INLINE maximumByOf #-} -- | Obtain the minimum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso' -- or 'Getter' according to a user supplied 'Ordering'. -- -- In the interest of efficiency, This operation has semantics more strict than strictly necessary. -- -- >>> minimumByOf traverse (compare `on` length) ["mustard","relish","ham"] -- Just "ham" -- -- @ -- 'minimumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'minimumByOf' 'folded' cmp -- @ -- -- @ -- 'minimumByOf' :: 'Getter' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'minimumByOf' :: 'Fold' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'minimumByOf' :: 'Iso'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'minimumByOf' :: 'Lens'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'minimumByOf' :: 'Traversal'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- @ minimumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a minimumByOf l cmp = foldlOf' l mf Nothing where mf Nothing y = Just $! y mf (Just x) y = Just $! if cmp x y == GT then y else x {-# INLINE minimumByOf #-} -- | The 'findOf' function takes a 'Lens' (or 'Getter', 'Iso', 'Fold', or 'Traversal'), -- a predicate and a structure and returns the leftmost element of the structure -- matching the predicate, or 'Nothing' if there is no such element. -- -- >>> findOf each even (1,3,4,6) -- Just 4 -- -- >>> findOf folded even [1,3,5,7] -- Nothing -- -- @ -- 'findOf' :: 'Getter' s a -> (a -> 'Bool') -> s -> 'Maybe' a -- 'findOf' :: 'Fold' s a -> (a -> 'Bool') -> s -> 'Maybe' a -- 'findOf' :: 'Iso'' s a -> (a -> 'Bool') -> s -> 'Maybe' a -- 'findOf' :: 'Lens'' s a -> (a -> 'Bool') -> s -> 'Maybe' a -- 'findOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Maybe' a -- @ -- -- @ -- 'Data.Foldable.find' ≡ 'findOf' 'folded' -- 'ifindOf' l ≡ 'findOf' l '.' 'Indexed' -- @ -- -- A simpler version that didn't permit indexing, would be: -- -- @ -- 'findOf' :: 'Getting' ('Endo' ('Maybe' a)) s a -> (a -> 'Bool') -> s -> 'Maybe' a -- 'findOf' l p = 'foldrOf' l (\a y -> if p a then 'Just' a else y) 'Nothing' -- @ findOf :: Getting (Endo (Maybe a)) s a -> (a -> Bool) -> s -> Maybe a findOf l f = foldrOf l (\a y -> if f a then Just a else y) Nothing {-# INLINE findOf #-} -- | The 'findMOf' function takes a 'Lens' (or 'Getter', 'Iso', 'Fold', or 'Traversal'), -- a monadic predicate and a structure and returns in the monad the leftmost element of the structure -- matching the predicate, or 'Nothing' if there is no such element. -- -- >>> findMOf each ( \x -> print ("Checking " ++ show x) >> return (even x)) (1,3,4,6) -- "Checking 1" -- "Checking 3" -- "Checking 4" -- Just 4 -- -- >>> findMOf each ( \x -> print ("Checking " ++ show x) >> return (even x)) (1,3,5,7) -- "Checking 1" -- "Checking 3" -- "Checking 5" -- "Checking 7" -- Nothing -- -- @ -- 'findMOf' :: ('Monad' m, 'Getter' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) -- 'findMOf' :: ('Monad' m, 'Fold' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) -- 'findMOf' :: ('Monad' m, 'Iso'' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) -- 'findMOf' :: ('Monad' m, 'Lens'' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) -- 'findMOf' :: ('Monad' m, 'Traversal'' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) -- @ -- -- @ -- 'findMOf' 'folded' :: (Monad m, Foldable f) => (a -> m Bool) -> f a -> m (Maybe a) -- 'ifindMOf' l ≡ 'findMOf' l '.' 'Indexed' -- @ -- -- A simpler version that didn't permit indexing, would be: -- -- @ -- 'findMOf' :: Monad m => 'Getting' ('Endo' (m ('Maybe' a))) s a -> (a -> m 'Bool') -> s -> m ('Maybe' a) -- 'findMOf' l p = 'foldrOf' l (\a y -> p a >>= \x -> if x then return ('Just' a) else y) $ return 'Nothing' -- @ findMOf :: Monad m => Getting (Endo (m (Maybe a))) s a -> (a -> m Bool) -> s -> m (Maybe a) findMOf l f = foldrOf l (\a y -> f a >>= \r -> if r then return (Just a) else y) $ return Nothing {-# INLINE findMOf #-} -- | The 'lookupOf' function takes a 'Fold' (or 'Getter', 'Traversal', -- 'Lens', 'Iso', etc.), a key, and a structure containing key/value pairs. -- It returns the first value corresponding to the given key. This function -- generalizes 'lookup' to work on an arbitrary 'Fold' instead of lists. -- -- >>> lookupOf folded 4 [(2, 'a'), (4, 'b'), (4, 'c')] -- Just 'b' -- -- >>> lookupOf each 2 [(2, 'a'), (4, 'b'), (4, 'c')] -- Just 'a' -- -- @ -- 'lookupOf' :: 'Eq' k => 'Fold' s (k,v) -> k -> s -> 'Maybe' v -- @ lookupOf :: Eq k => Getting (Endo (Maybe v)) s (k,v) -> k -> s -> Maybe v lookupOf l k = foldrOf l (\(k',v) next -> if k == k' then Just v else next) Nothing {-# INLINE lookupOf #-} -- | A variant of 'foldrOf' that has no base case and thus may only be applied -- to lenses and structures such that the 'Lens' views at least one element of -- the structure. -- -- >>> foldr1Of each (+) (1,2,3,4) -- 10 -- -- @ -- 'foldr1Of' l f ≡ 'Prelude.foldr1' f '.' 'toListOf' l -- 'Data.Foldable.foldr1' ≡ 'foldr1Of' 'folded' -- @ -- -- @ -- 'foldr1Of' :: 'Getter' s a -> (a -> a -> a) -> s -> a -- 'foldr1Of' :: 'Fold' s a -> (a -> a -> a) -> s -> a -- 'foldr1Of' :: 'Iso'' s a -> (a -> a -> a) -> s -> a -- 'foldr1Of' :: 'Lens'' s a -> (a -> a -> a) -> s -> a -- 'foldr1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldr1Of :: Getting (Endo (Maybe a)) s a -> (a -> a -> a) -> s -> a foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure") (foldrOf l mf Nothing xs) where mf x my = Just $ case my of Nothing -> x Just y -> f x y {-# INLINE foldr1Of #-} -- | A variant of 'foldlOf' that has no base case and thus may only be applied to lenses and structures such -- that the 'Lens' views at least one element of the structure. -- -- >>> foldl1Of each (+) (1,2,3,4) -- 10 -- -- @ -- 'foldl1Of' l f ≡ 'Prelude.foldl1' f '.' 'toListOf' l -- 'Data.Foldable.foldl1' ≡ 'foldl1Of' 'folded' -- @ -- -- @ -- 'foldl1Of' :: 'Getter' s a -> (a -> a -> a) -> s -> a -- 'foldl1Of' :: 'Fold' s a -> (a -> a -> a) -> s -> a -- 'foldl1Of' :: 'Iso'' s a -> (a -> a -> a) -> s -> a -- 'foldl1Of' :: 'Lens'' s a -> (a -> a -> a) -> s -> a -- 'foldl1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldl1Of :: Getting (Dual (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where mf mx y = Just $ case mx of Nothing -> y Just x -> f x y {-# INLINE foldl1Of #-} -- | Strictly fold right over the elements of a structure. -- -- @ -- 'Data.Foldable.foldr'' ≡ 'foldrOf'' 'folded' -- @ -- -- @ -- 'foldrOf'' :: 'Getter' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf'' :: 'Fold' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf'' :: 'Iso'' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf'' :: 'Lens'' s a -> (a -> r -> r) -> r -> s -> r -- 'foldrOf'' :: 'Traversal'' s a -> (a -> r -> r) -> r -> s -> r -- @ foldrOf' :: Getting (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r foldrOf' l f z0 xs = foldlOf l f' (Endo id) xs `appEndo` z0 where f' (Endo k) x = Endo $ \ 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' -- @ -- -- @ -- 'foldlOf'' :: 'Getter' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf'' :: 'Fold' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf'' :: 'Iso'' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf'' :: 'Lens'' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf'' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r -- @ foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r foldlOf' l f z0 xs = foldrOf l f' (Endo id) xs `appEndo` z0 where f' x (Endo k) = Endo $ \z -> k $! f z x {-# INLINE foldlOf' #-} -- | A variant of 'foldrOf'' that has no base case and thus may only be applied -- to folds and structures such that the fold views at least one element of the -- structure. -- -- @ -- 'foldr1Of' l f ≡ 'Prelude.foldr1' f '.' 'toListOf' l -- @ -- -- @ -- 'foldr1Of'' :: 'Getter' s a -> (a -> a -> a) -> s -> a -- 'foldr1Of'' :: 'Fold' s a -> (a -> a -> a) -> s -> a -- 'foldr1Of'' :: 'Iso'' s a -> (a -> a -> a) -> s -> a -- 'foldr1Of'' :: 'Lens'' s a -> (a -> a -> a) -> s -> a -- 'foldr1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldr1Of' :: Getting (Dual (Endo (Endo (Maybe a)))) s a -> (a -> a -> a) -> s -> a foldr1Of' l f xs = fromMaybe (error "foldr1Of': empty structure") (foldrOf' l mf Nothing xs) where mf x Nothing = Just $! x mf x (Just y) = Just $! f x y {-# INLINE foldr1Of' #-} -- | A variant of 'foldlOf'' that has no base case and thus may only be applied -- to folds and structures such that the fold views at least one element of -- the structure. -- -- @ -- 'foldl1Of'' l f ≡ 'Data.List.foldl1'' f '.' 'toListOf' l -- @ -- -- @ -- 'foldl1Of'' :: 'Getter' s a -> (a -> a -> a) -> s -> a -- 'foldl1Of'' :: 'Fold' s a -> (a -> a -> a) -> s -> a -- 'foldl1Of'' :: 'Iso'' s a -> (a -> a -> a) -> s -> a -- 'foldl1Of'' :: 'Lens'' s a -> (a -> a -> a) -> s -> a -- 'foldl1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldl1Of' :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a 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 {-# INLINE foldl1Of' #-} -- | Monadic fold over the elements of a structure, associating to the right, -- i.e. from right to left. -- -- @ -- 'Data.Foldable.foldrM' ≡ 'foldrMOf' 'folded' -- @ -- -- @ -- 'foldrMOf' :: 'Monad' m => 'Getter' s a -> (a -> r -> m r) -> r -> s -> m r -- 'foldrMOf' :: 'Monad' m => 'Fold' s a -> (a -> r -> m r) -> r -> s -> m r -- 'foldrMOf' :: 'Monad' m => 'Iso'' s a -> (a -> r -> m r) -> r -> s -> m r -- 'foldrMOf' :: 'Monad' m => 'Lens'' s a -> (a -> r -> m r) -> r -> s -> m r -- 'foldrMOf' :: 'Monad' m => 'Traversal'' s a -> (a -> r -> m r) -> r -> s -> m r -- @ foldrMOf :: Monad m => Getting (Dual (Endo (r -> m r))) s a -> (a -> r -> m r) -> r -> s -> m r foldrMOf l f z0 xs = foldlOf l f' return xs z0 where f' k x z = f x z >>= k {-# INLINE foldrMOf #-} -- | Monadic fold over the elements of a structure, associating to the left, -- i.e. from left to right. -- -- @ -- 'Data.Foldable.foldlM' ≡ 'foldlMOf' 'folded' -- @ -- -- @ -- 'foldlMOf' :: 'Monad' m => 'Getter' s a -> (r -> a -> m r) -> r -> s -> m r -- 'foldlMOf' :: 'Monad' m => 'Fold' s a -> (r -> a -> m r) -> r -> s -> m r -- 'foldlMOf' :: 'Monad' m => 'Iso'' s a -> (r -> a -> m r) -> r -> s -> m r -- 'foldlMOf' :: 'Monad' m => 'Lens'' s a -> (r -> a -> m r) -> r -> s -> m r -- 'foldlMOf' :: 'Monad' m => 'Traversal'' s a -> (r -> a -> m r) -> r -> s -> m r -- @ foldlMOf :: Monad m => Getting (Endo (r -> m r)) s a -> (r -> a -> m r) -> r -> s -> m r foldlMOf l f z0 xs = foldrOf l f' return xs z0 where f' x k z = f z x >>= k {-# INLINE foldlMOf #-} -- | Check to see if this 'Fold' or 'Traversal' matches 1 or more entries. -- -- >>> has (element 0) [] -- False -- -- >>> has _Left (Left 12) -- True -- -- >>> has _Right (Left 12) -- False -- -- This will always return 'True' for a 'Lens' or 'Getter'. -- -- >>> has _1 ("hello","world") -- True -- -- @ -- 'has' :: 'Getter' s a -> s -> 'Bool' -- 'has' :: 'Fold' s a -> s -> 'Bool' -- 'has' :: 'Iso'' s a -> s -> 'Bool' -- 'has' :: 'Lens'' s a -> s -> 'Bool' -- 'has' :: 'Traversal'' s a -> s -> 'Bool' -- @ has :: Getting Any s a -> s -> Bool has l = getAny #. foldMapOf l (\_ -> Any True) {-# INLINE has #-} -- | Check to see if this 'Fold' or 'Traversal' has no matches. -- -- >>> hasn't _Left (Right 12) -- True -- -- >>> hasn't _Left (Left 12) -- False hasn't :: Getting All s a -> s -> Bool hasn't l = getAll #. foldMapOf l (\_ -> All False) {-# INLINE hasn't #-} ------------------------------------------------------------------------------ -- Pre ------------------------------------------------------------------------------ -- | This converts a 'Fold' to a 'IndexPreservingGetter' that returns the first element, if it -- exists, as a 'Maybe'. -- -- @ -- 'pre' :: 'Getter' s a -> 'IndexPreservingGetter' s ('Maybe' a) -- 'pre' :: 'Fold' s a -> 'IndexPreservingGetter' s ('Maybe' a) -- 'pre' :: 'Traversal'' s a -> 'IndexPreservingGetter' s ('Maybe' a) -- 'pre' :: 'Lens'' s a -> 'IndexPreservingGetter' s ('Maybe' a) -- 'pre' :: 'Iso'' s a -> 'IndexPreservingGetter' s ('Maybe' a) -- 'pre' :: 'Prism'' s a -> 'IndexPreservingGetter' s ('Maybe' a) -- @ pre :: Getting (First a) s a -> IndexPreservingGetter s (Maybe a) pre l = dimap (getFirst . getConst #. l (Const #. First #. Just)) phantom {-# INLINE pre #-} -- | This converts an 'IndexedFold' to an 'IndexPreservingGetter' that returns the first index -- and element, if they exist, as a 'Maybe'. -- -- @ -- 'ipre' :: 'IndexedGetter' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) -- 'ipre' :: 'IndexedFold' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) -- 'ipre' :: 'IndexedTraversal'' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) -- 'ipre' :: 'IndexedLens'' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) -- @ ipre :: IndexedGetting i (First (i, a)) s a -> IndexPreservingGetter s (Maybe (i, a)) ipre l = dimap (getFirst . getConst #. l (Indexed $ \i a -> Const (First (Just (i, a))))) phantom {-# INLINE ipre #-} ------------------------------------------------------------------------------ -- Preview ------------------------------------------------------------------------------ -- | Retrieve the first value targeted by a 'Fold' or 'Traversal' (or 'Just' the result -- from a 'Getter' or 'Lens'). See also ('^?'). -- -- @ -- 'Data.Maybe.listToMaybe' '.' 'toList' ≡ 'preview' 'folded' -- @ -- -- This is usually applied in the 'Control.Monad.Reader.Reader' -- 'Control.Monad.Monad' @(->) s@. -- -- @ -- 'preview' = 'view' '.' 'pre' -- @ -- -- @ -- 'preview' :: 'Getter' s a -> s -> 'Maybe' a -- 'preview' :: 'Fold' s a -> s -> 'Maybe' a -- 'preview' :: 'Lens'' s a -> s -> 'Maybe' a -- 'preview' :: 'Iso'' s a -> s -> 'Maybe' a -- 'preview' :: 'Traversal'' s a -> s -> 'Maybe' a -- @ -- -- However, it may be useful to think of its full generality when working with -- a 'Control.Monad.Monad' transformer stack: -- -- @ -- 'preview' :: 'MonadReader' s m => 'Getter' s a -> m ('Maybe' a) -- 'preview' :: 'MonadReader' s m => 'Fold' s a -> m ('Maybe' a) -- 'preview' :: 'MonadReader' s m => 'Lens'' s a -> m ('Maybe' a) -- 'preview' :: 'MonadReader' s m => 'Iso'' s a -> m ('Maybe' a) -- 'preview' :: 'MonadReader' s m => 'Traversal'' s a -> m ('Maybe' a) -- @ preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a) preview l = asks (getFirst #. foldMapOf l (First #. Just)) {-# INLINE preview #-} -- | Retrieve the first index and value targeted by a 'Fold' or 'Traversal' (or 'Just' the result -- from a 'Getter' or 'Lens'). See also ('^@?'). -- -- @ -- 'ipreview' = 'view' '.' 'ipre' -- @ -- -- This is usually applied in the 'Control.Monad.Reader.Reader' -- 'Control.Monad.Monad' @(->) s@. -- -- @ -- 'ipreview' :: 'IndexedGetter' i s a -> s -> 'Maybe' (i, a) -- 'ipreview' :: 'IndexedFold' i s a -> s -> 'Maybe' (i, a) -- 'ipreview' :: 'IndexedLens'' i s a -> s -> 'Maybe' (i, a) -- 'ipreview' :: 'IndexedTraversal'' i s a -> s -> 'Maybe' (i, a) -- @ -- -- However, it may be useful to think of its full generality when working with -- a 'Control.Monad.Monad' transformer stack: -- -- @ -- 'ipreview' :: 'MonadReader' s m => 'IndexedGetter' s a -> m ('Maybe' (i, a)) -- 'ipreview' :: 'MonadReader' s m => 'IndexedFold' s a -> m ('Maybe' (i, a)) -- 'ipreview' :: 'MonadReader' s m => 'IndexedLens'' s a -> m ('Maybe' (i, a)) -- 'ipreview' :: 'MonadReader' s m => 'IndexedTraversal'' s a -> m ('Maybe' (i, a)) -- @ ipreview :: MonadReader s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a)) ipreview l = asks (getFirst #. ifoldMapOf l (\i a -> First (Just (i, a)))) {-# INLINE ipreview #-} -- | Retrieve a function of the first value targeted by a 'Fold' or -- 'Traversal' (or 'Just' the result from a 'Getter' or 'Lens'). -- -- This is usually applied in the 'Control.Monad.Reader.Reader' -- 'Control.Monad.Monad' @(->) s@. -- @ -- 'previews' = 'views' '.' 'pre' -- @ -- -- @ -- 'previews' :: 'Getter' s a -> (a -> r) -> s -> 'Maybe' r -- 'previews' :: 'Fold' s a -> (a -> r) -> s -> 'Maybe' r -- 'previews' :: 'Lens'' s a -> (a -> r) -> s -> 'Maybe' r -- 'previews' :: 'Iso'' s a -> (a -> r) -> s -> 'Maybe' r -- 'previews' :: 'Traversal'' s a -> (a -> r) -> s -> 'Maybe' r -- @ -- -- However, it may be useful to think of its full generality when working with -- a 'Monad' transformer stack: -- -- @ -- 'previews' :: 'MonadReader' s m => 'Getter' s a -> (a -> r) -> m ('Maybe' r) -- 'previews' :: 'MonadReader' s m => 'Fold' s a -> (a -> r) -> m ('Maybe' r) -- 'previews' :: 'MonadReader' s m => 'Lens'' s a -> (a -> r) -> m ('Maybe' r) -- 'previews' :: 'MonadReader' s m => 'Iso'' s a -> (a -> r) -> m ('Maybe' r) -- 'previews' :: 'MonadReader' s m => 'Traversal'' s a -> (a -> r) -> m ('Maybe' r) -- @ previews :: MonadReader s m => Getting (First r) s a -> (a -> r) -> m (Maybe r) previews l f = asks (getFirst . foldMapOf l (First #. Just . f)) {-# INLINE previews #-} -- | Retrieve a function of the first index and value targeted by an 'IndexedFold' or -- 'IndexedTraversal' (or 'Just' the result from an 'IndexedGetter' or 'IndexedLens'). -- See also ('^@?'). -- -- @ -- 'ipreviews' = 'views' '.' 'ipre' -- @ -- -- This is usually applied in the 'Control.Monad.Reader.Reader' -- 'Control.Monad.Monad' @(->) s@. -- -- @ -- 'ipreviews' :: 'IndexedGetter' i s a -> (i -> a -> r) -> s -> 'Maybe' r -- 'ipreviews' :: 'IndexedFold' i s a -> (i -> a -> r) -> s -> 'Maybe' r -- 'ipreviews' :: 'IndexedLens'' i s a -> (i -> a -> r) -> s -> 'Maybe' r -- 'ipreviews' :: 'IndexedTraversal'' i s a -> (i -> a -> r) -> s -> 'Maybe' r -- @ -- -- However, it may be useful to think of its full generality when working with -- a 'Control.Monad.Monad' transformer stack: -- -- @ -- 'ipreviews' :: 'MonadReader' s m => 'IndexedGetter' i s a -> (i -> a -> r) -> m ('Maybe' r) -- 'ipreviews' :: 'MonadReader' s m => 'IndexedFold' i s a -> (i -> a -> r) -> m ('Maybe' r) -- 'ipreviews' :: 'MonadReader' s m => 'IndexedLens'' i s a -> (i -> a -> r) -> m ('Maybe' r) -- 'ipreviews' :: 'MonadReader' s m => 'IndexedTraversal'' i s a -> (i -> a -> r) -> m ('Maybe' r) -- @ ipreviews :: MonadReader s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r) ipreviews l f = asks (getFirst . ifoldMapOf l (\i -> First #. Just . f i)) {-# INLINE ipreviews #-} ------------------------------------------------------------------------------ -- Preuse ------------------------------------------------------------------------------ -- | Retrieve the first value targeted by a 'Fold' or 'Traversal' (or 'Just' the result -- from a 'Getter' or 'Lens') into the current state. -- -- @ -- 'preuse' = 'use' '.' 'pre' -- @ -- -- @ -- 'preuse' :: 'MonadState' s m => 'Getter' s a -> m ('Maybe' a) -- 'preuse' :: 'MonadState' s m => 'Fold' s a -> m ('Maybe' a) -- 'preuse' :: 'MonadState' s m => 'Lens'' s a -> m ('Maybe' a) -- 'preuse' :: 'MonadState' s m => 'Iso'' s a -> m ('Maybe' a) -- 'preuse' :: 'MonadState' s m => 'Traversal'' s a -> m ('Maybe' a) -- @ preuse :: MonadState s m => Getting (First a) s a -> m (Maybe a) preuse l = gets (preview l) {-# INLINE preuse #-} -- | Retrieve the first index and value targeted by an 'IndexedFold' or 'IndexedTraversal' (or 'Just' the index -- and result from an 'IndexedGetter' or 'IndexedLens') into the current state. -- -- @ -- 'ipreuse' = 'use' '.' 'ipre' -- @ -- -- @ -- 'ipreuse' :: 'MonadState' s m => 'IndexedGetter' i s a -> m ('Maybe' (i, a)) -- 'ipreuse' :: 'MonadState' s m => 'IndexedFold' i s a -> m ('Maybe' (i, a)) -- 'ipreuse' :: 'MonadState' s m => 'IndexedLens'' i s a -> m ('Maybe' (i, a)) -- 'ipreuse' :: 'MonadState' s m => 'IndexedTraversal'' i s a -> m ('Maybe' (i, a)) -- @ ipreuse :: MonadState s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a)) ipreuse l = gets (ipreview l) {-# INLINE ipreuse #-} -- | Retrieve a function of the first value targeted by a 'Fold' or -- 'Traversal' (or 'Just' the result from a 'Getter' or 'Lens') into the current state. -- -- @ -- 'preuses' = 'uses' '.' 'pre' -- @ -- -- @ -- 'preuses' :: 'MonadState' s m => 'Getter' s a -> (a -> r) -> m ('Maybe' r) -- 'preuses' :: 'MonadState' s m => 'Fold' s a -> (a -> r) -> m ('Maybe' r) -- 'preuses' :: 'MonadState' s m => 'Lens'' s a -> (a -> r) -> m ('Maybe' r) -- 'preuses' :: 'MonadState' s m => 'Iso'' s a -> (a -> r) -> m ('Maybe' r) -- 'preuses' :: 'MonadState' s m => 'Traversal'' s a -> (a -> r) -> m ('Maybe' r) -- @ preuses :: MonadState s m => Getting (First r) s a -> (a -> r) -> m (Maybe r) preuses l f = gets (previews l f) {-# INLINE preuses #-} -- | Retrieve a function of the first index and value targeted by an 'IndexedFold' or -- 'IndexedTraversal' (or a function of 'Just' the index and result from an 'IndexedGetter' -- or 'IndexedLens') into the current state. -- -- @ -- 'ipreuses' = 'uses' '.' 'ipre' -- @ -- -- @ -- 'ipreuses' :: 'MonadState' s m => 'IndexedGetter' i s a -> (i -> a -> r) -> m ('Maybe' r) -- 'ipreuses' :: 'MonadState' s m => 'IndexedFold' i s a -> (i -> a -> r) -> m ('Maybe' r) -- 'ipreuses' :: 'MonadState' s m => 'IndexedLens'' i s a -> (i -> a -> r) -> m ('Maybe' r) -- 'ipreuses' :: 'MonadState' s m => 'IndexedTraversal'' i s a -> (i -> a -> r) -> m ('Maybe' r) -- @ ipreuses :: MonadState s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r) ipreuses l f = gets (ipreviews l f) {-# INLINE ipreuses #-} ------------------------------------------------------------------------------ -- Profunctors ------------------------------------------------------------------------------ -- | This allows you to 'Control.Traversable.traverse' the elements of a pretty much any 'LensLike' construction in the opposite order. -- -- This will preserve indexes on 'Indexed' types and will give you the elements of a (finite) 'Fold' or 'Traversal' in the opposite order. -- -- This has no practical impact on a 'Getter', 'Setter', 'Lens' or 'Iso'. -- -- /NB:/ To write back through an 'Iso', you want to use 'Control.Lens.Isomorphic.from'. -- Similarly, to write back through an 'Prism', you want to use 'Control.Lens.Review.re'. backwards :: (Profunctor p, Profunctor q) => Optical p q (Backwards f) s t a b -> Optical p q f s t a b backwards l f = forwards #. l (Backwards #. f) {-# INLINE backwards #-} ------------------------------------------------------------------------------ -- Indexed Folds ------------------------------------------------------------------------------ -- | Fold an 'IndexedFold' or 'IndexedTraversal' by mapping indices and values to an arbitrary 'Monoid' with access -- to the @i@. -- -- When you don't need access to the index then 'foldMapOf' is more flexible in what it accepts. -- -- @ -- 'foldMapOf' l ≡ 'ifoldMapOf' l '.' 'const' -- @ -- -- @ -- 'ifoldMapOf' :: 'IndexedGetter' i s a -> (i -> a -> m) -> s -> m -- 'ifoldMapOf' :: 'Monoid' m => 'IndexedFold' i s a -> (i -> a -> m) -> s -> m -- 'ifoldMapOf' :: 'IndexedLens'' i s a -> (i -> a -> m) -> s -> m -- 'ifoldMapOf' :: 'Monoid' m => 'IndexedTraversal'' i s a -> (i -> a -> m) -> s -> m -- @ -- ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m ifoldMapOf l f = getConst #. l (Const #. Indexed f) {-# INLINE ifoldMapOf #-} -- | Right-associative fold of parts of a structure that are viewed through an 'IndexedFold' or 'IndexedTraversal' with -- access to the @i@. -- -- When you don't need access to the index then 'foldrOf' is more flexible in what it accepts. -- -- @ -- 'foldrOf' l ≡ 'ifoldrOf' l '.' 'const' -- @ -- -- @ -- 'ifoldrOf' :: 'IndexedGetter' i s a -> (i -> a -> r -> r) -> r -> s -> r -- 'ifoldrOf' :: 'IndexedFold' i s a -> (i -> a -> r -> r) -> r -> s -> r -- 'ifoldrOf' :: 'IndexedLens'' i s a -> (i -> a -> r -> r) -> r -> s -> r -- 'ifoldrOf' :: 'IndexedTraversal'' i s a -> (i -> a -> r -> r) -> r -> s -> r -- @ ifoldrOf :: IndexedGetting i (Endo r) s a -> (i -> a -> r -> r) -> r -> s -> r ifoldrOf l f z = flip appEndo z . getConst #. l (Const #. Endo #. Indexed f) {-# INLINE ifoldrOf #-} -- | Left-associative fold of the parts of a structure that are viewed through an 'IndexedFold' or 'IndexedTraversal' with -- access to the @i@. -- -- When you don't need access to the index then 'foldlOf' is more flexible in what it accepts. -- -- @ -- 'foldlOf' l ≡ 'ifoldlOf' l '.' 'const' -- @ -- -- @ -- 'ifoldlOf' :: 'IndexedGetter' i s a -> (i -> r -> a -> r) -> r -> s -> r -- 'ifoldlOf' :: 'IndexedFold' i s a -> (i -> r -> a -> r) -> r -> s -> r -- 'ifoldlOf' :: 'IndexedLens'' i s a -> (i -> r -> a -> r) -> r -> s -> r -- 'ifoldlOf' :: 'IndexedTraversal'' i s a -> (i -> r -> a -> r) -> r -> s -> r -- @ ifoldlOf :: IndexedGetting i (Dual (Endo r)) s a -> (i -> r -> a -> r) -> r -> s -> r ifoldlOf l f z = (flip appEndo z .# getDual) `rmap` ifoldMapOf l (\i -> Dual #. Endo #. flip (f i)) {-# INLINE ifoldlOf #-} -- | Return whether or not any element viewed through an 'IndexedFold' or 'IndexedTraversal' -- satisfy a predicate, with access to the @i@. -- -- When you don't need access to the index then 'anyOf' is more flexible in what it accepts. -- -- @ -- 'anyOf' l ≡ 'ianyOf' l '.' 'const' -- @ -- -- @ -- 'ianyOf' :: 'IndexedGetter' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'ianyOf' :: 'IndexedFold' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'ianyOf' :: 'IndexedLens'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'ianyOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @ ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool ianyOf l f = getAny #. getConst #. l (Const #. Any #. Indexed f) {-# INLINE ianyOf #-} -- | Return whether or not all elements viewed through an 'IndexedFold' or 'IndexedTraversal' -- satisfy a predicate, with access to the @i@. -- -- When you don't need access to the index then 'allOf' is more flexible in what it accepts. -- -- @ -- 'allOf' l ≡ 'iallOf' l '.' 'const' -- @ -- -- @ -- 'iallOf' :: 'IndexedGetter' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'iallOf' :: 'IndexedFold' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'iallOf' :: 'IndexedLens'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'iallOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @ iallOf :: IndexedGetting i All s a -> (i -> a -> Bool) -> s -> Bool iallOf l f = getAll #. getConst #. l (Const #. All #. Indexed f) {-# INLINE iallOf #-} -- | Return whether or not none of the elements viewed through an 'IndexedFold' or 'IndexedTraversal' -- satisfy a predicate, with access to the @i@. -- -- When you don't need access to the index then 'noneOf' is more flexible in what it accepts. -- -- @ -- 'noneOf' l ≡ 'inoneOf' l '.' 'const' -- @ -- -- @ -- 'inoneOf' :: 'IndexedGetter' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'inoneOf' :: 'IndexedFold' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'inoneOf' :: 'IndexedLens'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'inoneOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @ inoneOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool inoneOf l f = not . ianyOf l f {-# INLINE inoneOf #-} -- | Traverse the targets of an 'IndexedFold' or 'IndexedTraversal' with access to the @i@, discarding the results. -- -- When you don't need access to the index then 'traverseOf_' is more flexible in what it accepts. -- -- @ -- 'traverseOf_' l ≡ 'Control.Lens.Traversal.itraverseOf' l '.' 'const' -- @ -- -- @ -- 'itraverseOf_' :: 'Functor' f => 'IndexedGetter' i s a -> (i -> a -> f r) -> s -> f () -- 'itraverseOf_' :: 'Applicative' f => 'IndexedFold' i s a -> (i -> a -> f r) -> s -> f () -- 'itraverseOf_' :: 'Functor' f => 'IndexedLens'' i s a -> (i -> a -> f r) -> s -> f () -- 'itraverseOf_' :: 'Applicative' f => 'IndexedTraversal'' i s a -> (i -> a -> f r) -> s -> f () -- @ itraverseOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> (i -> a -> f r) -> s -> f () itraverseOf_ l f = void . getTraversed #. getConst #. l (Const #. Traversed #. Indexed f) {-# INLINE itraverseOf_ #-} -- | Traverse the targets of an 'IndexedFold' or 'IndexedTraversal' with access to the index, discarding the results -- (with the arguments flipped). -- -- @ -- 'iforOf_' ≡ 'flip' '.' 'itraverseOf_' -- @ -- -- When you don't need access to the index then 'forOf_' is more flexible in what it accepts. -- -- @ -- 'forOf_' l a ≡ 'iforOf_' l a '.' 'const' -- @ -- -- @ -- 'iforOf_' :: 'Functor' f => 'IndexedGetter' i s a -> s -> (i -> a -> f r) -> f () -- 'iforOf_' :: 'Applicative' f => 'IndexedFold' i s a -> s -> (i -> a -> f r) -> f () -- 'iforOf_' :: 'Functor' f => 'IndexedLens'' i s a -> s -> (i -> a -> f r) -> f () -- 'iforOf_' :: 'Applicative' f => 'IndexedTraversal'' i s a -> s -> (i -> a -> f r) -> f () -- @ iforOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> s -> (i -> a -> f r) -> f () iforOf_ = flip . itraverseOf_ {-# INLINE iforOf_ #-} -- | Run monadic actions for each target of an 'IndexedFold' or 'IndexedTraversal' with access to the index, -- discarding the results. -- -- When you don't need access to the index then 'mapMOf_' is more flexible in what it accepts. -- -- @ -- 'mapMOf_' l ≡ 'Control.Lens.Setter.imapMOf' l '.' 'const' -- @ -- -- @ -- 'imapMOf_' :: 'Monad' m => 'IndexedGetter' i s a -> (i -> a -> m r) -> s -> m () -- 'imapMOf_' :: 'Monad' m => 'IndexedFold' i s a -> (i -> a -> m r) -> s -> m () -- 'imapMOf_' :: 'Monad' m => 'IndexedLens'' i s a -> (i -> a -> m r) -> s -> m () -- 'imapMOf_' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> m r) -> s -> m () -- @ imapMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> (i -> a -> m r) -> s -> m () imapMOf_ l f = liftM skip . getSequenced #. getConst #. l (Const #. Sequenced #. Indexed f) {-# INLINE imapMOf_ #-} -- | Run monadic actions for each target of an 'IndexedFold' or 'IndexedTraversal' with access to the index, -- discarding the results (with the arguments flipped). -- -- @ -- 'iforMOf_' ≡ 'flip' '.' 'imapMOf_' -- @ -- -- When you don't need access to the index then 'forMOf_' is more flexible in what it accepts. -- -- @ -- 'forMOf_' l a ≡ 'Control.Lens.Traversal.iforMOf' l a '.' 'const' -- @ -- -- @ -- 'iforMOf_' :: 'Monad' m => 'IndexedGetter' i s a -> s -> (i -> a -> m r) -> m () -- 'iforMOf_' :: 'Monad' m => 'IndexedFold' i s a -> s -> (i -> a -> m r) -> m () -- 'iforMOf_' :: 'Monad' m => 'IndexedLens'' i s a -> s -> (i -> a -> m r) -> m () -- 'iforMOf_' :: 'Monad' m => 'IndexedTraversal'' i s a -> s -> (i -> a -> m r) -> m () -- @ iforMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> s -> (i -> a -> m r) -> m () iforMOf_ = flip . imapMOf_ {-# INLINE iforMOf_ #-} -- | Concatenate the results of a function of the elements of an 'IndexedFold' or 'IndexedTraversal' -- with access to the index. -- -- When you don't need access to the index then 'concatMapOf' is more flexible in what it accepts. -- -- @ -- 'concatMapOf' l ≡ 'iconcatMapOf' l '.' 'const' -- 'iconcatMapOf' ≡ 'ifoldMapOf' -- @ -- -- @ -- 'iconcatMapOf' :: 'IndexedGetter' i s a -> (i -> a -> [r]) -> s -> [r] -- 'iconcatMapOf' :: 'IndexedFold' i s a -> (i -> a -> [r]) -> s -> [r] -- 'iconcatMapOf' :: 'IndexedLens'' i s a -> (i -> a -> [r]) -> s -> [r] -- 'iconcatMapOf' :: 'IndexedTraversal'' i s a -> (i -> a -> [r]) -> s -> [r] -- @ iconcatMapOf :: IndexedGetting i [r] s a -> (i -> a -> [r]) -> s -> [r] iconcatMapOf = ifoldMapOf {-# INLINE iconcatMapOf #-} -- | The 'ifindOf' function takes an 'IndexedFold' or 'IndexedTraversal', a predicate that is also -- supplied the index, a structure and returns the left-most element of the structure -- matching the predicate, or 'Nothing' if there is no such element. -- -- When you don't need access to the index then 'findOf' is more flexible in what it accepts. -- -- @ -- 'findOf' l ≡ 'ifindOf' l '.' 'const' -- @ -- -- @ -- 'ifindOf' :: 'IndexedGetter' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a -- 'ifindOf' :: 'IndexedFold' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a -- 'ifindOf' :: 'IndexedLens'' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a -- 'ifindOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a -- @ ifindOf :: IndexedGetting i (Endo (Maybe a)) s a -> (i -> a -> Bool) -> s -> Maybe a ifindOf l f = ifoldrOf l (\i a y -> if f i a then Just a else y) Nothing {-# INLINE ifindOf #-} -- | The 'ifindMOf' function takes an 'IndexedFold' or 'IndexedTraversal', a monadic predicate that is also -- supplied the index, a structure and returns in the monad the left-most element of the structure -- matching the predicate, or 'Nothing' if there is no such element. -- -- When you don't need access to the index then 'findMOf' is more flexible in what it accepts. -- -- @ -- 'findMOf' l ≡ 'ifindMOf' l '.' 'const' -- @ -- -- @ -- 'ifindMOf' :: 'Monad' m => 'IndexedGetter' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) -- 'ifindMOf' :: 'Monad' m => 'IndexedFold' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) -- 'ifindMOf' :: 'Monad' m => 'IndexedLens'' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) -- 'ifindMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) -- @ ifindMOf :: Monad m => IndexedGetting i (Endo (m (Maybe a))) s a -> (i -> a -> m Bool) -> s -> m (Maybe a) ifindMOf l f = ifoldrOf l (\i a y -> f i a >>= \r -> if r then return (Just a) else y) $ return Nothing {-# INLINE ifindMOf #-} -- | /Strictly/ fold right over the elements of a structure with an index. -- -- When you don't need access to the index then 'foldrOf'' is more flexible in what it accepts. -- -- @ -- 'foldrOf'' l ≡ 'ifoldrOf'' l '.' 'const' -- @ -- -- @ -- 'ifoldrOf'' :: 'IndexedGetter' i s a -> (i -> a -> r -> r) -> r -> s -> r -- 'ifoldrOf'' :: 'IndexedFold' i s a -> (i -> a -> r -> r) -> r -> s -> r -- 'ifoldrOf'' :: 'IndexedLens'' i s a -> (i -> a -> r -> r) -> r -> s -> r -- 'ifoldrOf'' :: 'IndexedTraversal'' i s a -> (i -> a -> r -> r) -> r -> s -> r -- @ ifoldrOf' :: IndexedGetting i (Dual (Endo (r -> r))) s a -> (i -> a -> r -> r) -> r -> s -> r ifoldrOf' l f z0 xs = ifoldlOf l f' id xs z0 where f' i k x z = k $! f i x z {-# INLINE ifoldrOf' #-} -- | Fold over the elements of a structure with an index, associating to the left, but /strictly/. -- -- When you don't need access to the index then 'foldlOf'' is more flexible in what it accepts. -- -- @ -- 'foldlOf'' l ≡ 'ifoldlOf'' l '.' 'const' -- @ -- -- @ -- 'ifoldlOf'' :: 'IndexedGetter' i s a -> (i -> r -> a -> r) -> r -> s -> r -- 'ifoldlOf'' :: 'IndexedFold' i s a -> (i -> r -> a -> r) -> r -> s -> r -- 'ifoldlOf'' :: 'IndexedLens'' i s a -> (i -> r -> a -> r) -> r -> s -> r -- 'ifoldlOf'' :: 'IndexedTraversal'' i s a -> (i -> r -> a -> r) -> r -> s -> r -- @ ifoldlOf' :: IndexedGetting i (Endo (r -> r)) s a -> (i -> r -> a -> r) -> r -> s -> r ifoldlOf' l f z0 xs = ifoldrOf l f' id xs z0 where f' i x k z = k $! f i z x {-# INLINE ifoldlOf' #-} -- | Monadic fold right over the elements of a structure with an index. -- -- When you don't need access to the index then 'foldrMOf' is more flexible in what it accepts. -- -- @ -- 'foldrMOf' l ≡ 'ifoldrMOf' l '.' 'const' -- @ -- -- @ -- 'ifoldrMOf' :: 'Monad' m => 'IndexedGetter' i s a -> (i -> a -> r -> m r) -> r -> s -> m r -- 'ifoldrMOf' :: 'Monad' m => 'IndexedFold' i s a -> (i -> a -> r -> m r) -> r -> s -> m r -- 'ifoldrMOf' :: 'Monad' m => 'IndexedLens'' i s a -> (i -> a -> r -> m r) -> r -> s -> m r -- 'ifoldrMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> r -> m r) -> r -> s -> m r -- @ ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (r -> m r))) s a -> (i -> a -> r -> m r) -> r -> s -> m r ifoldrMOf l f z0 xs = ifoldlOf l f' return xs z0 where f' i k x z = f i x z >>= k {-# INLINE ifoldrMOf #-} -- | Monadic fold over the elements of a structure with an index, associating to the left. -- -- When you don't need access to the index then 'foldlMOf' is more flexible in what it accepts. -- -- @ -- 'foldlMOf' l ≡ 'ifoldlMOf' l '.' 'const' -- @ -- -- @ -- 'ifoldlMOf' :: 'Monad' m => 'IndexedGetter' i s a -> (i -> r -> a -> m r) -> r -> s -> m r -- 'ifoldlMOf' :: 'Monad' m => 'IndexedFold' i s a -> (i -> r -> a -> m r) -> r -> s -> m r -- 'ifoldlMOf' :: 'Monad' m => 'IndexedLens'' i s a -> (i -> r -> a -> m r) -> r -> s -> m r -- 'ifoldlMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> r -> a -> m r) -> r -> s -> m r -- @ ifoldlMOf :: Monad m => IndexedGetting i (Endo (r -> m r)) s a -> (i -> r -> a -> m r) -> r -> s -> m r ifoldlMOf l f z0 xs = ifoldrOf l f' return xs z0 where f' i x k z = f i z x >>= k {-# INLINE ifoldlMOf #-} -- | Extract the key-value pairs from a structure. -- -- When you don't need access to the indices in the result, then 'toListOf' is more flexible in what it accepts. -- -- @ -- 'toListOf' l ≡ 'map' 'snd' '.' 'itoListOf' l -- @ -- -- @ -- 'itoListOf' :: 'IndexedGetter' i s a -> s -> [(i,a)] -- 'itoListOf' :: 'IndexedFold' i s a -> s -> [(i,a)] -- 'itoListOf' :: 'IndexedLens'' i s a -> s -> [(i,a)] -- 'itoListOf' :: 'IndexedTraversal'' i s a -> s -> [(i,a)] -- @ itoListOf :: IndexedGetting i (Endo [(i,a)]) s a -> s -> [(i,a)] itoListOf l = ifoldrOf l (\i a -> ((i,a):)) [] {-# INLINE itoListOf #-} -- | An infix version of 'itoListOf'. -- @ -- ('^@..') :: s -> 'IndexedGetter' i s a -> [(i,a)] -- ('^@..') :: s -> 'IndexedFold' i s a -> [(i,a)] -- ('^@..') :: s -> 'IndexedLens'' i s a -> [(i,a)] -- ('^@..') :: s -> 'IndexedTraversal'' i s a -> [(i,a)] -- @ (^@..) :: s -> IndexedGetting i (Endo [(i,a)]) s a -> [(i,a)] s ^@.. l = ifoldrOf l (\i a -> ((i,a):)) [] s {-# INLINE (^@..) #-} -- | Perform a safe 'head' (with index) of an 'IndexedFold' or 'IndexedTraversal' or retrieve 'Just' the index and result -- from an 'IndexedGetter' or 'IndexedLens'. -- -- When using a 'IndexedTraversal' as a partial 'IndexedLens', or an 'IndexedFold' as a partial 'IndexedGetter' this can be a convenient -- way to extract the optional value. -- -- @ -- ('^@?') :: s -> 'IndexedGetter' i s a -> 'Maybe' (i, a) -- ('^@?') :: s -> 'IndexedFold' i s a -> 'Maybe' (i, a) -- ('^@?') :: s -> 'IndexedLens'' i s a -> 'Maybe' (i, a) -- ('^@?') :: s -> 'IndexedTraversal'' i s a -> 'Maybe' (i, a) -- @ (^@?) :: s -> IndexedGetting i (Endo (Maybe (i, a))) s a -> Maybe (i, a) s ^@? l = ifoldrOf l (\i x _ -> Just (i,x)) Nothing s {-# INLINE (^@?) #-} -- | Perform an *UNSAFE* 'head' (with index) of an 'IndexedFold' or 'IndexedTraversal' assuming that it is there. -- -- @ -- ('^@?!') :: s -> 'IndexedGetter' i s a -> (i, a) -- ('^@?!') :: s -> 'IndexedFold' i s a -> (i, a) -- ('^@?!') :: s -> 'IndexedLens'' i s a -> (i, a) -- ('^@?!') :: s -> 'IndexedTraversal'' i s a -> (i, a) -- @ (^@?!) :: s -> IndexedGetting i (Endo (i, a)) s a -> (i, a) s ^@?! l = ifoldrOf l (\i x _ -> (i,x)) (error "(^@?!): empty Fold") s {-# INLINE (^@?!) #-} -- | Retrieve the index of the first value targeted by a 'IndexedFold' or 'IndexedTraversal' which is equal to a given value. -- -- @ -- 'Data.List.elemIndex' ≡ 'elemIndexOf' 'folded' -- @ -- -- @ -- 'elemIndexOf' :: 'Eq' a => 'IndexedFold' i s a -> a -> s -> 'Maybe' i -- 'elemIndexOf' :: 'Eq' a => 'IndexedTraversal'' i s a -> a -> s -> 'Maybe' i -- @ elemIndexOf :: Eq a => IndexedGetting i (First i) s a -> a -> s -> Maybe i elemIndexOf l a = findIndexOf l (a ==) {-# INLINE elemIndexOf #-} -- | Retrieve the indices of the values targeted by a 'IndexedFold' or 'IndexedTraversal' which are equal to a given value. -- -- @ -- 'Data.List.elemIndices' ≡ 'elemIndicesOf' 'folded' -- @ -- -- @ -- 'elemIndicesOf' :: 'Eq' a => 'IndexedFold' i s a -> a -> s -> [i] -- 'elemIndicesOf' :: 'Eq' a => 'IndexedTraversal'' i s a -> a -> s -> [i] -- @ elemIndicesOf :: Eq a => IndexedGetting i (Endo [i]) s a -> a -> s -> [i] elemIndicesOf l a = findIndicesOf l (a ==) {-# INLINE elemIndicesOf #-} -- | Retrieve the index of the first value targeted by a 'IndexedFold' or 'IndexedTraversal' which satisfies a predicate. -- -- @ -- 'Data.List.findIndex' ≡ 'findIndexOf' 'folded' -- @ -- -- @ -- 'findIndexOf' :: 'IndexedFold' i s a -> (a -> 'Bool') -> s -> 'Maybe' i -- 'findIndexOf' :: 'IndexedTraversal'' i s a -> (a -> 'Bool') -> s -> 'Maybe' i -- @ findIndexOf :: IndexedGetting i (First i) s a -> (a -> Bool) -> s -> Maybe i findIndexOf l p = preview (l . filtered p . asIndex) {-# INLINE findIndexOf #-} -- | Retrieve the indices of the values targeted by a 'IndexedFold' or 'IndexedTraversal' which satisfy a predicate. -- -- @ -- 'Data.List.findIndices' ≡ 'findIndicesOf' 'folded' -- @ -- -- @ -- 'findIndicesOf' :: 'IndexedFold' i s a -> (a -> 'Bool') -> s -> [i] -- 'findIndicesOf' :: 'IndexedTraversal'' i s a -> (a -> 'Bool') -> s -> [i] -- @ findIndicesOf :: IndexedGetting i (Endo [i]) s a -> (a -> Bool) -> s -> [i] findIndicesOf l p = toListOf (l . filtered p . asIndex) {-# INLINE findIndicesOf #-} ------------------------------------------------------------------------------- -- Converting to Folds ------------------------------------------------------------------------------- -- | Filter an 'IndexedFold' or 'IndexedGetter', obtaining an 'IndexedFold'. -- -- >>> [0,0,0,5,5,5]^..traversed.ifiltered (\i a -> i <= a) -- [0,5,5,5] -- -- Compose with 'filtered' to filter another 'IndexedLens', 'IndexedIso', 'IndexedGetter', 'IndexedFold' (or 'IndexedTraversal') with -- access to both the value and the index. -- -- Note: As with 'filtered', this is /not/ a legal 'IndexedTraversal', unless you are very careful not to invalidate the predicate on the target! ifiltered :: (Indexable i p, Applicative f) => (i -> a -> Bool) -> Optical' p (Indexed i) f a a ifiltered p f = Indexed $ \i a -> if p i a then indexed f i a else pure a {-# INLINE ifiltered #-} -- | Obtain an 'IndexedFold' by taking elements from another -- 'IndexedFold', 'IndexedLens', 'IndexedGetter' or 'IndexedTraversal' while a predicate holds. -- -- @ -- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' i s a -- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedTraversal'' i s a -> 'IndexedFold' i s a -- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedLens'' i s a -> 'IndexedFold' i s a -- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedGetter' i s a -> 'IndexedFold' i s a -- @ itakingWhile :: (Indexable i p, Profunctor q, Contravariant f, Applicative f) => (i -> a -> Bool) -> Optical' (Indexed i) q (Const (Endo (f s))) s a -> Optical' p q f s a itakingWhile p l f = (flip appEndo noEffect .# getConst) `rmap` l g where g = Indexed $ \i a -> Const . Endo $ if p i a then (indexed f i a *>) else const noEffect {-# INLINE itakingWhile #-} -- | Obtain an 'IndexedFold' by dropping elements from another 'IndexedFold', 'IndexedLens', 'IndexedGetter' or 'IndexedTraversal' while a predicate holds. -- -- @ -- 'idroppingWhile' :: (i -> a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' i s a -- 'idroppingWhile' :: (i -> a -> 'Bool') -> 'IndexedTraversal'' i s a -> 'IndexedFold' i s a -- see notes -- 'idroppingWhile' :: (i -> a -> 'Bool') -> 'IndexedLens'' i s a -> 'IndexedFold' i s a -- see notes -- 'idroppingWhile' :: (i -> a -> 'Bool') -> 'IndexedGetter' i s a -> 'IndexedFold' i s a -- @ -- -- Applying 'idroppingWhile' to an 'IndexedLens' or 'IndexedTraversal' will still allow you to use it as a -- pseudo-'IndexedTraversal', but if you change the value of the targets to ones where the predicate returns -- 'True', then you will break the 'Traversal' laws and 'Traversal' fusion will no longer be sound. idroppingWhile :: (Indexable i p, Profunctor q, Applicative f) => (i -> a -> Bool) -> Optical (Indexed i) q (Compose (State Bool) f) s t a a -> Optical p q f s t a a idroppingWhile p l f = (flip evalState True .# getCompose) `rmap` l g where g = Indexed $ \ i a -> Compose $ state $ \b -> let b' = b && p i a in (if b' then pure a else indexed f i a, b') {-# INLINE idroppingWhile #-} ------------------------------------------------------------------------------ -- Misc. ------------------------------------------------------------------------------ skip :: a -> () skip _ = () {-# INLINE skip #-} ------------------------------------------------------------------------------ -- Folds with Reified Monoid ------------------------------------------------------------------------------ -- | Fold a value using a specified 'Fold' and 'Monoid' operations. -- This is like 'foldBy' where the 'Foldable' instance can be -- manually specified. -- -- @ -- 'foldByOf' 'folded' ≡ 'foldBy' -- @ -- -- @ -- 'foldByOf' :: 'Getter' s a -> (a -> a -> a) -> a -> s -> a -- 'foldByOf' :: 'Fold' s a -> (a -> a -> a) -> a -> s -> a -- 'foldByOf' :: 'Lens'' s a -> (a -> a -> a) -> a -> s -> a -- 'foldByOf' :: 'Traversal'' s a -> (a -> a -> a) -> a -> s -> a -- 'foldByOf' :: 'Iso'' s a -> (a -> a -> a) -> a -> s -> a -- @ -- -- >>> foldByOf both (++) [] ("hello","world") -- "helloworld" foldByOf :: Fold s a -> (a -> a -> a) -> a -> s -> a foldByOf l f z = reifyMonoid f z (foldMapOf l ReflectedMonoid) -- | Fold a value using a specified 'Fold' and 'Monoid' operations. -- This is like 'foldMapBy' where the 'Foldable' instance can be -- manually specified. -- -- @ -- 'foldMapByOf' 'folded' ≡ 'foldMapBy' -- @ -- -- @ -- 'foldMapByOf' :: 'Getter' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r -- 'foldMapByOf' :: 'Fold' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r -- 'foldMapByOf' :: 'Traversal'' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r -- 'foldMapByOf' :: 'Lens'' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r -- 'foldMapByOf' :: 'Iso'' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r -- @ -- -- >>> foldMapByOf both (+) 0 length ("hello","world") -- 10 foldMapByOf :: Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r foldMapByOf l f z g = reifyMonoid f z (foldMapOf l (ReflectedMonoid #. g)) lens-4.14/src/Control/Lens/Getter.hs0000644000000000000000000004546612710476104015510 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE NoPolyKinds #-} {-# LANGUAGE NoDataKinds #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Getter -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- -- A @'Getter' s a@ is just any function @(s -> a)@, which we've flipped -- into continuation passing style, @(a -> r) -> s -> r@ and decorated -- with 'Const' to obtain: -- -- @type 'Getting' r s a = (a -> 'Const' r a) -> s -> 'Const' r s@ -- -- If we restrict access to knowledge about the type 'r', we could get: -- -- @type 'Getter' s a = forall r. 'Getting' r s a@ -- -- However, for 'Getter' (but not for 'Getting') we actually permit any -- functor @f@ which is an instance of both 'Functor' and 'Contravariant': -- -- @type 'Getter' s a = forall f. ('Contravariant' f, 'Functor' f) => (a -> f a) -> s -> f s@ -- -- Everything you can do with a function, you can do with a 'Getter', but -- note that because of the continuation passing style ('.') composes them -- in the opposite order. -- -- Since it is only a function, every 'Getter' obviously only retrieves a -- single value for a given input. -- -- A common question is whether you can combine multiple 'Getter's to -- retrieve multiple values. Recall that all 'Getter's are 'Fold's and that -- we have a @'Monoid' m => 'Applicative' ('Const' m)@ instance to play -- with. Knowing this, we can use @'Data.Monoid.<>'@ to glue 'Fold's -- together: -- -- >>> import Data.Monoid -- >>> (1, 2, 3, 4, 5) ^.. (_2 <> _3 <> _5) -- [2,3,5] -- ------------------------------------------------------------------------------- module Control.Lens.Getter ( -- * Getters Getter, IndexedGetter , Getting, IndexedGetting , Accessing -- * Building Getters , to , ito , like , ilike -- * Combinators for Getters and Folds , (^.) , view, views , use, uses , listening, listenings -- * Indexed Getters -- ** Indexed Getter Combinators , (^@.) , iview, iviews , iuse, iuses , ilistening, ilistenings -- * Implementation Details , Contravariant(..) , getting , Const(..) ) where import Control.Applicative import Control.Lens.Internal.Indexed import Control.Lens.Type import Control.Monad.Reader.Class as Reader import Control.Monad.State as State import Control.Monad.Writer as Writer import Data.Functor.Contravariant import Data.Profunctor import Data.Profunctor.Unsafe -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Data.List.Lens -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g) -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g infixl 8 ^., ^@. ------------------------------------------------------------------------------- -- Getters ------------------------------------------------------------------------------- -- | Build an (index-preserving) 'Getter' from an arbitrary Haskell function. -- -- @ -- 'to' f '.' 'to' g ≡ 'to' (g '.' f) -- @ -- -- @ -- a '^.' 'to' f ≡ f a -- @ -- -- >>> a ^.to f -- f a -- -- >>> ("hello","world")^.to snd -- "world" -- -- >>> 5^.to succ -- 6 -- -- >>> (0, -5)^._2.to abs -- 5 -- -- @ -- 'to' :: (s -> a) -> 'IndexPreservingGetter' s a -- @ to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a to k = dimap k (contramap k) {-# INLINE to #-} -- | -- @ -- 'ito' :: (s -> (i, a)) -> 'IndexedGetter' i s a -- @ ito :: (Indexable i p, Contravariant f) => (s -> (i, a)) -> Over' p f s a ito k = dimap k (contramap (snd . k)) . uncurry . indexed {-# INLINE ito #-} -- | Build an constant-valued (index-preserving) 'Getter' from an arbitrary Haskell value. -- -- @ -- 'like' a '.' 'like' b ≡ 'like' b -- a '^.' 'like' b ≡ b -- a '^.' 'like' b ≡ a '^.' 'to' ('const' b) -- @ -- -- This can be useful as a second case 'failing' a 'Fold' -- e.g. @foo `failing` 'like' 0@ -- -- @ -- 'like' :: a -> 'IndexPreservingGetter' s a -- @ like :: (Profunctor p, Contravariant f) => a -> Optic' p f s a like a = to (const a) {-# INLINE like #-} -- | -- @ -- 'ilike' :: i -> a -> 'IndexedGetter' i s a -- @ ilike :: (Indexable i p, Contravariant f) => i -> a -> Over' p f s a ilike i a = ito (const (i, a)) {-# INLINE ilike #-} -- | When you see this in a type signature it indicates that you can -- pass the function a 'Lens', 'Getter', -- 'Control.Lens.Traversal.Traversal', 'Control.Lens.Fold.Fold', -- 'Control.Lens.Prism.Prism', 'Control.Lens.Iso.Iso', or one of -- the indexed variants, and it will just \"do the right thing\". -- -- Most 'Getter' combinators are able to be used with both a 'Getter' or a -- 'Control.Lens.Fold.Fold' in limited situations, to do so, they need to be -- monomorphic in what we are going to extract with 'Control.Applicative.Const'. To be compatible -- with 'Lens', 'Control.Lens.Traversal.Traversal' and -- 'Control.Lens.Iso.Iso' we also restricted choices of the irrelevant @t@ and -- @b@ parameters. -- -- If a function accepts a @'Getting' r s a@, then when @r@ is a 'Data.Monoid.Monoid', then -- you can pass a 'Control.Lens.Fold.Fold' (or -- 'Control.Lens.Traversal.Traversal'), otherwise you can only pass this a -- 'Getter' or 'Lens'. type Getting r s a = (a -> Const r a) -> s -> Const r s -- | Used to consume an 'Control.Lens.Fold.IndexedFold'. type IndexedGetting i m s a = Indexed i a (Const m a) -> s -> Const m s -- | This is a convenient alias used when consuming (indexed) getters and (indexed) folds -- in a highly general fashion. type Accessing p m s a = p a (Const m a) -> s -> Const m s ------------------------------------------------------------------------------- -- Getting Values ------------------------------------------------------------------------------- -- | View the value pointed to by a 'Getter', 'Control.Lens.Iso.Iso' or -- 'Lens' or the result of folding over all the results of a -- 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that points -- at a monoidal value. -- -- @ -- 'view' '.' 'to' ≡ 'id' -- @ -- -- >>> view (to f) a -- f a -- -- >>> view _2 (1,"hello") -- "hello" -- -- >>> view (to succ) 5 -- 6 -- -- >>> view (_2._1) ("hello",("world","!!!")) -- "world" -- -- -- As 'view' is commonly used to access the target of a 'Getter' or obtain a monoidal summary of the targets of a 'Fold', -- It may be useful to think of it as having one of these more restricted signatures: -- -- @ -- 'view' :: 'Getter' s a -> s -> a -- 'view' :: 'Data.Monoid.Monoid' m => 'Control.Lens.Fold.Fold' s m -> s -> m -- 'view' :: 'Control.Lens.Iso.Iso'' s a -> s -> a -- 'view' :: 'Lens'' s a -> s -> a -- 'view' :: 'Data.Monoid.Monoid' m => 'Control.Lens.Traversal.Traversal'' s m -> s -> m -- @ -- -- In a more general setting, such as when working with a 'Monad' transformer stack you can use: -- -- @ -- 'view' :: 'MonadReader' s m => 'Getter' s a -> m a -- 'view' :: ('MonadReader' s m, 'Data.Monoid.Monoid' a) => 'Control.Lens.Fold.Fold' s a -> m a -- 'view' :: 'MonadReader' s m => 'Control.Lens.Iso.Iso'' s a -> m a -- 'view' :: 'MonadReader' s m => 'Lens'' s a -> m a -- 'view' :: ('MonadReader' s m, 'Data.Monoid.Monoid' a) => 'Control.Lens.Traversal.Traversal'' s a -> m a -- @ view :: MonadReader s m => Getting a s a -> m a view l = Reader.asks (getConst #. l Const) {-# INLINE view #-} -- | View a function of the value pointed to by a 'Getter' or 'Lens' or the result of -- folding over the result of mapping the targets of a 'Control.Lens.Fold.Fold' or -- 'Control.Lens.Traversal.Traversal'. -- -- @ -- 'views' l f ≡ 'view' (l '.' 'to' f) -- @ -- -- >>> views (to f) g a -- g (f a) -- -- >>> views _2 length (1,"hello") -- 5 -- -- As 'views' is commonly used to access the target of a 'Getter' or obtain a monoidal summary of the targets of a 'Fold', -- It may be useful to think of it as having one of these more restricted signatures: -- -- @ -- 'views' :: 'Getter' s a -> (a -> r) -> s -> r -- 'views' :: 'Data.Monoid.Monoid' m => 'Control.Lens.Fold.Fold' s a -> (a -> m) -> s -> m -- 'views' :: 'Control.Lens.Iso.Iso'' s a -> (a -> r) -> s -> r -- 'views' :: 'Lens'' s a -> (a -> r) -> s -> r -- 'views' :: 'Data.Monoid.Monoid' m => 'Control.Lens.Traversal.Traversal'' s a -> (a -> m) -> s -> m -- @ -- -- In a more general setting, such as when working with a 'Monad' transformer stack you can use: -- -- @ -- 'views' :: 'MonadReader' s m => 'Getter' s a -> (a -> r) -> m r -- 'views' :: ('MonadReader' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Fold.Fold' s a -> (a -> r) -> m r -- 'views' :: 'MonadReader' s m => 'Control.Lens.Iso.Iso'' s a -> (a -> r) -> m r -- 'views' :: 'MonadReader' s m => 'Lens'' s a -> (a -> r) -> m r -- 'views' :: ('MonadReader' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> r) -> m r -- @ -- -- @ -- 'views' :: 'MonadReader' s m => 'Getting' r s a -> (a -> r) -> m r -- @ views :: MonadReader s m => LensLike' (Const r) s a -> (a -> r) -> m r views l f = Reader.asks (getConst #. l (Const #. f)) {-# INLINE views #-} -- | View the value pointed to by a 'Getter' or 'Lens' or the -- result of folding over all the results of a 'Control.Lens.Fold.Fold' or -- 'Control.Lens.Traversal.Traversal' that points at a monoidal values. -- -- This is the same operation as 'view' with the arguments flipped. -- -- The fixity and semantics are such that subsequent field accesses can be -- performed with ('Prelude..'). -- -- >>> (a,b)^._2 -- b -- -- >>> ("hello","world")^._2 -- "world" -- -- >>> import Data.Complex -- >>> ((0, 1 :+ 2), 3)^._1._2.to magnitude -- 2.23606797749979 -- -- @ -- ('^.') :: s -> 'Getter' s a -> a -- ('^.') :: 'Data.Monoid.Monoid' m => s -> 'Control.Lens.Fold.Fold' s m -> m -- ('^.') :: s -> 'Control.Lens.Iso.Iso'' s a -> a -- ('^.') :: s -> 'Lens'' s a -> a -- ('^.') :: 'Data.Monoid.Monoid' m => s -> 'Control.Lens.Traversal.Traversal'' s m -> m -- @ (^.) :: s -> Getting a s a -> a s ^. l = getConst (l Const s) {-# INLINE (^.) #-} ------------------------------------------------------------------------------- -- MonadState ------------------------------------------------------------------------------- -- | Use the target of a 'Lens', 'Control.Lens.Iso.Iso', or -- 'Getter' in the current state, or use a summary of a -- 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that points -- to a monoidal value. -- -- >>> evalState (use _1) (a,b) -- a -- -- >>> evalState (use _1) ("hello","world") -- "hello" -- -- @ -- 'use' :: 'MonadState' s m => 'Getter' s a -> m a -- 'use' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Fold.Fold' s r -> m r -- 'use' :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s a -> m a -- 'use' :: 'MonadState' s m => 'Lens'' s a -> m a -- 'use' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Traversal.Traversal'' s r -> m r -- @ use :: MonadState s m => Getting a s a -> m a use l = State.gets (view l) {-# INLINE use #-} -- | Use the target of a 'Lens', 'Control.Lens.Iso.Iso' or -- 'Getter' in the current state, or use a summary of a -- 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that -- points to a monoidal value. -- -- >>> evalState (uses _1 length) ("hello","world") -- 5 -- -- @ -- 'uses' :: 'MonadState' s m => 'Getter' s a -> (a -> r) -> m r -- 'uses' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Fold.Fold' s a -> (a -> r) -> m r -- 'uses' :: 'MonadState' s m => 'Lens'' s a -> (a -> r) -> m r -- 'uses' :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s a -> (a -> r) -> m r -- 'uses' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> r) -> m r -- @ -- -- @ -- 'uses' :: 'MonadState' s m => 'Getting' r s t a b -> (a -> r) -> m r -- @ uses :: MonadState s m => LensLike' (Const r) s a -> (a -> r) -> m r uses l f = State.gets (views l f) {-# INLINE uses #-} -- | This is a generalized form of 'listen' that only extracts the portion of -- the log that is focused on by a 'Getter'. If given a 'Fold' or a 'Traversal' -- then a monoidal summary of the parts of the log that are visited will be -- returned. -- -- @ -- 'listening' :: 'MonadWriter' w m => 'Getter' w u -> m a -> m (a, u) -- 'listening' :: 'MonadWriter' w m => 'Lens'' w u -> m a -> m (a, u) -- 'listening' :: 'MonadWriter' w m => 'Iso'' w u -> m a -> m (a, u) -- 'listening' :: ('MonadWriter' w m, 'Monoid' u) => 'Fold' w u -> m a -> m (a, u) -- 'listening' :: ('MonadWriter' w m, 'Monoid' u) => 'Traversal'' w u -> m a -> m (a, u) -- 'listening' :: ('MonadWriter' w m, 'Monoid' u) => 'Prism'' w u -> m a -> m (a, u) -- @ listening :: MonadWriter w m => Getting u w u -> m a -> m (a, u) listening l m = do (a, w) <- listen m return (a, view l w) {-# INLINE listening #-} -- | This is a generalized form of 'listen' that only extracts the portion of -- the log that is focused on by a 'Getter'. If given a 'Fold' or a 'Traversal' -- then a monoidal summary of the parts of the log that are visited will be -- returned. -- -- @ -- 'ilistening' :: 'MonadWriter' w m => 'IndexedGetter' i w u -> m a -> m (a, (i, u)) -- 'ilistening' :: 'MonadWriter' w m => 'IndexedLens'' i w u -> m a -> m (a, (i, u)) -- 'ilistening' :: ('MonadWriter' w m, 'Monoid' u) => 'IndexedFold' i w u -> m a -> m (a, (i, u)) -- 'ilistening' :: ('MonadWriter' w m, 'Monoid' u) => 'IndexedTraversal'' i w u -> m a -> m (a, (i, u)) -- @ ilistening :: MonadWriter w m => IndexedGetting i (i, u) w u -> m a -> m (a, (i, u)) ilistening l m = do (a, w) <- listen m return (a, iview l w) {-# INLINE ilistening #-} -- | This is a generalized form of 'listen' that only extracts the portion of -- the log that is focused on by a 'Getter'. If given a 'Fold' or a 'Traversal' -- then a monoidal summary of the parts of the log that are visited will be -- returned. -- -- @ -- 'listenings' :: 'MonadWriter' w m => 'Getter' w u -> (u -> v) -> m a -> m (a, v) -- 'listenings' :: 'MonadWriter' w m => 'Lens'' w u -> (u -> v) -> m a -> m (a, v) -- 'listenings' :: 'MonadWriter' w m => 'Iso'' w u -> (u -> v) -> m a -> m (a, v) -- 'listenings' :: ('MonadWriter' w m, 'Monoid' v) => 'Fold' w u -> (u -> v) -> m a -> m (a, v) -- 'listenings' :: ('MonadWriter' w m, 'Monoid' v) => 'Traversal'' w u -> (u -> v) -> m a -> m (a, v) -- 'listenings' :: ('MonadWriter' w m, 'Monoid' v) => 'Prism'' w u -> (u -> v) -> m a -> m (a, v) -- @ listenings :: MonadWriter w m => Getting v w u -> (u -> v) -> m a -> m (a, v) listenings l uv m = do (a, w) <- listen m return (a, views l uv w) {-# INLINE listenings #-} -- | This is a generalized form of 'listen' that only extracts the portion of -- the log that is focused on by a 'Getter'. If given a 'Fold' or a 'Traversal' -- then a monoidal summary of the parts of the log that are visited will be -- returned. -- -- @ -- 'ilistenings' :: 'MonadWriter' w m => 'IndexedGetter' w u -> (i -> u -> v) -> m a -> m (a, v) -- 'ilistenings' :: 'MonadWriter' w m => 'IndexedLens'' w u -> (i -> u -> v) -> m a -> m (a, v) -- 'ilistenings' :: ('MonadWriter' w m, 'Monoid' v) => 'IndexedFold' w u -> (i -> u -> v) -> m a -> m (a, v) -- 'ilistenings' :: ('MonadWriter' w m, 'Monoid' v) => 'IndexedTraversal'' w u -> (i -> u -> v) -> m a -> m (a, v) -- @ ilistenings :: MonadWriter w m => IndexedGetting i v w u -> (i -> u -> v) -> m a -> m (a, v) ilistenings l iuv m = do (a, w) <- listen m return (a, iviews l iuv w) {-# INLINE ilistenings #-} ------------------------------------------------------------------------------ -- Indexed Getters ------------------------------------------------------------------------------ -- | View the index and value of an 'IndexedGetter' into the current environment as a pair. -- -- When applied to an 'IndexedFold' the result will most likely be a nonsensical monoidal summary of -- the indices tupled with a monoidal summary of the values and probably not whatever it is you wanted. iview :: MonadReader s m => IndexedGetting i (i,a) s a -> m (i,a) iview l = asks (getConst #. l (Indexed $ \i -> Const #. (,) i)) {-# INLINE iview #-} -- | View a function of the index and value of an 'IndexedGetter' into the current environment. -- -- When applied to an 'IndexedFold' the result will be a monoidal summary instead of a single answer. -- -- @ -- 'iviews' ≡ 'Control.Lens.Fold.ifoldMapOf' -- @ iviews :: MonadReader s m => IndexedGetting i r s a -> (i -> a -> r) -> m r iviews l f = asks (getConst #. l (Const #. Indexed f)) {-# INLINE iviews #-} -- | Use the index and value of an 'IndexedGetter' into the current state as a pair. -- -- When applied to an 'IndexedFold' the result will most likely be a nonsensical monoidal summary of -- the indices tupled with a monoidal summary of the values and probably not whatever it is you wanted. iuse :: MonadState s m => IndexedGetting i (i,a) s a -> m (i,a) iuse l = gets (getConst #. l (Indexed $ \i -> Const #. (,) i)) {-# INLINE iuse #-} -- | Use a function of the index and value of an 'IndexedGetter' into the current state. -- -- When applied to an 'IndexedFold' the result will be a monoidal summary instead of a single answer. iuses :: MonadState s m => IndexedGetting i r s a -> (i -> a -> r) -> m r iuses l f = gets (getConst #. l (Const #. Indexed f)) {-# INLINE iuses #-} -- | View the index and value of an 'IndexedGetter' or 'IndexedLens'. -- -- This is the same operation as 'iview' with the arguments flipped. -- -- The fixity and semantics are such that subsequent field accesses can be -- performed with ('Prelude..'). -- -- @ -- ('^@.') :: s -> 'IndexedGetter' i s a -> (i, a) -- ('^@.') :: s -> 'IndexedLens'' i s a -> (i, a) -- @ -- -- The result probably doesn't have much meaning when applied to an 'IndexedFold'. (^@.) :: s -> IndexedGetting i (i, a) s a -> (i, a) s ^@. l = getConst $ l (Indexed $ \i -> Const #. (,) i) s {-# INLINE (^@.) #-} -- | Coerce a 'Getter'-compatible 'LensLike' to a 'LensLike''. This -- is useful when using a 'Traversal' that is not simple as a 'Getter' or a -- 'Fold'. getting :: (Functor f, Contravariant f) => LensLike f s t a b -> LensLike' f s a getting l f = phantom . l (phantom . f) lens-4.14/src/Control/Lens/Indexed.hs0000644000000000000000000007673212710476104015636 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} -- vector, hashable #endif #if __GLASGOW_HASKELL__ >= 711 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #ifndef MIN_VERSION_containers #define MIN_VERSION_containers(x,y,z) 1 #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Indexed -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- (The classes in here need to be defined together for @DefaultSignatures@ to work.) ------------------------------------------------------------------------------- module Control.Lens.Indexed ( -- * Indexing Indexable(..) , Conjoined(..) , Indexed(..) , (<.), (<.>), (.>) , selfIndex , reindexed , icompose , indexing , indexing64 -- * Indexed Functors , FunctorWithIndex(..) -- * Indexed Foldables , FoldableWithIndex(..) -- ** Indexed Foldable Combinators , iany , iall , inone, none , itraverse_ , ifor_ , imapM_ , iforM_ , iconcatMap , ifind , ifoldrM , ifoldlM , itoList -- * Converting to Folds , withIndex , asIndex -- * Restricting by Index , indices , index -- * Indexed Traversables , TraversableWithIndex(..) -- * Indexed Traversable Combinators , ifor , imapM , iforM , imapAccumR , imapAccumL -- * Indexed Folds with Reified Monoid , ifoldMapBy , ifoldMapByOf -- * Indexed Traversals with Reified Applicative , itraverseBy , itraverseByOf ) where import Control.Applicative import Control.Applicative.Backwards import Control.Comonad.Cofree import Control.Comonad.Trans.Traced import Control.Monad (void, liftM) import Control.Monad.Trans.Identity import Control.Monad.Trans.Reader import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Free import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Internal.Fold import Control.Lens.Internal.Indexed import Control.Lens.Internal.Level import Control.Lens.Internal.Magma import Control.Lens.Setter import Control.Lens.Traversal import Control.Lens.Type import Data.Array (Array) import qualified Data.Array as Array import Data.Foldable import Data.Functor.Compose import Data.Functor.Contravariant import Data.Functor.Product import Data.Functor.Reverse import Data.Hashable import Data.HashMap.Lazy as HashMap import Data.IntMap as IntMap import Data.Ix (Ix) import Data.List.NonEmpty as NonEmpty import Data.Map as Map import Data.Monoid hiding (Product) import Data.Profunctor.Unsafe import Data.Reflection import Data.Sequence hiding ((:<), index) import Data.Tree import Data.Tuple (swap) import Data.Vector (Vector) import qualified Data.Vector as V import Prelude #if !(MIN_VERSION_base(4,8,0)) import Data.Traversable (sequenceA) #endif #ifdef HLINT {-# ANN module "HLint: ignore Use fmap" #-} #endif infixr 9 <.>, <., .> -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- | Compose an 'Indexed' function with a non-indexed function. -- -- Mnemonically, the @<@ points to the indexing we want to preserve. -- -- >>> let nestedMap = (fmap Map.fromList . Map.fromList) [(1, [(10, "one,ten"), (20, "one,twenty")]), (2, [(30, "two,thirty"), (40,"two,forty")])] -- >>> nestedMap^..(itraversed<.itraversed).withIndex -- [(1,"one,ten"),(1,"one,twenty"),(2,"two,thirty"),(2,"two,forty")] (<.) :: Indexable i p => (Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r (<.) f g h = f . Indexed $ g . indexed h {-# INLINE (<.) #-} -- | Compose a non-indexed function with an 'Indexed' function. -- -- Mnemonically, the @>@ points to the indexing we want to preserve. -- -- This is the same as @('.')@. -- -- @f '.' g@ (and @f '.>' g@) gives you the index of @g@ unless @g@ is index-preserving, like a -- 'Prism', 'Iso' or 'Equality', in which case it'll pass through the index of @f@. -- -- >>> let nestedMap = (fmap Map.fromList . Map.fromList) [(1, [(10, "one,ten"), (20, "one,twenty")]), (2, [(30, "two,thirty"), (40,"two,forty")])] -- >>> nestedMap^..(itraversed.>itraversed).withIndex -- [(10,"one,ten"),(20,"one,twenty"),(30,"two,thirty"),(40,"two,forty")] (.>) :: (st -> r) -> (kab -> st) -> kab -> r (.>) = (.) {-# INLINE (.>) #-} -- | Use a value itself as its own index. This is essentially an indexed version of 'id'. -- -- Note: When used to modify the value, this can break the index requirements assumed by 'indices' and similar, -- so this is only properly an 'IndexedGetter', but it can be used as more. -- -- @ -- 'selfIndex' :: 'IndexedGetter' a a b -- @ selfIndex :: Indexable a p => p a fb -> a -> fb selfIndex f a = indexed f a a {-# INLINE selfIndex #-} -- | Remap the index. reindexed :: Indexable j p => (i -> j) -> (Indexed i a b -> r) -> p a b -> r reindexed ij f g = f . Indexed $ indexed g . ij {-# INLINE reindexed #-} -- | Composition of 'Indexed' functions. -- -- Mnemonically, the @\<@ and @\>@ points to the fact that we want to preserve the indices. -- -- >>> let nestedMap = (fmap Map.fromList . Map.fromList) [(1, [(10, "one,ten"), (20, "one,twenty")]), (2, [(30, "two,thirty"), (40,"two,forty")])] -- >>> nestedMap^..(itraversed<.>itraversed).withIndex -- [((1,10),"one,ten"),((1,20),"one,twenty"),((2,30),"two,thirty"),((2,40),"two,forty")] (<.>) :: Indexable (i, j) p => (Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> p a b -> r f <.> g = icompose (,) f g {-# INLINE (<.>) #-} -- | Composition of 'Indexed' functions with a user supplied function for combining indices. icompose :: Indexable p c => (i -> j -> p) -> (Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> c a b -> r icompose ijk istr jabst cab = istr . Indexed $ \i -> jabst . Indexed $ \j -> indexed cab $ ijk i j {-# INLINE icompose #-} ------------------------------------------------------------------------------- -- Restricting by index ------------------------------------------------------------------------------- -- | This allows you to filter an 'IndexedFold', 'IndexedGetter', 'IndexedTraversal' or 'IndexedLens' based on a predicate -- on the indices. -- -- >>> ["hello","the","world","!!!"]^..traversed.indices even -- ["hello","world"] -- -- >>> over (traversed.indices (>0)) Prelude.reverse $ ["He","was","stressed","o_O"] -- ["He","saw","desserts","O_o"] indices :: (Indexable i p, Applicative f) => (i -> Bool) -> Optical' p (Indexed i) f a a indices p f = Indexed $ \i a -> if p i then indexed f i a else pure a {-# INLINE indices #-} -- | This allows you to filter an 'IndexedFold', 'IndexedGetter', 'IndexedTraversal' or 'IndexedLens' based on an index. -- -- >>> ["hello","the","world","!!!"]^?traversed.index 2 -- Just "world" index :: (Indexable i p, Eq i, Applicative f) => i -> Optical' p (Indexed i) f a a index j f = Indexed $ \i a -> if j == i then indexed f i a else pure a {-# INLINE index #-} ------------------------------------------------------------------------------- -- FunctorWithIndex ------------------------------------------------------------------------------- -- | A 'Functor' with an additional index. -- -- Instances must satisfy a modified form of the 'Functor' laws: -- -- @ -- '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. imap :: (i -> a -> b) -> f a -> f b default imap :: TraversableWithIndex i f => (i -> a -> b) -> f a -> f b imap = iover itraversed {-# INLINE imap #-} -- | The 'IndexedSetter' for a 'FunctorWithIndex'. -- -- If you don't need access to the index, then 'mapped' is more flexible in what it accepts. imapped :: IndexedSetter i (f a) (f b) a b imapped = conjoined mapped (isets imap) {-# INLINE imapped #-} ------------------------------------------------------------------------------- -- FoldableWithIndex ------------------------------------------------------------------------------- -- | A container that supports folding with an additional index. class Foldable f => FoldableWithIndex i f | f -> i where -- -- | Fold a container by mapping value to an arbitrary 'Monoid' with access to the index @i@. -- -- When you don't need access to the index then 'foldMap' is more flexible in what it accepts. -- -- @ -- 'foldMap' ≡ 'ifoldMap' '.' 'const' -- @ ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m #ifndef HLINT default ifoldMap :: (TraversableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m ifoldMap = ifoldMapOf itraversed {-# INLINE ifoldMap #-} #endif -- | The 'IndexedFold' of a 'FoldableWithIndex' container. -- -- @'ifolded' '.' 'asIndex'@ is a fold over the keys of a 'FoldableWithIndex'. -- -- >>> Data.Map.fromList [(2, "hello"), (1, "world")]^..ifolded.asIndex -- [1,2] ifolded :: IndexedFold i (f a) a ifolded = conjoined folded $ \f -> phantom . getFolding . ifoldMap (\i -> Folding #. indexed f i) {-# INLINE ifolded #-} -- | Right-associative fold of an indexed container with access to the index @i@. -- -- 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' -- @ ifoldr :: (i -> a -> b -> b) -> b -> f a -> b ifoldr f z t = appEndo (ifoldMap (\i -> Endo #. f i) t) z {-# INLINE ifoldr #-} -- | Left-associative fold of an indexed container with access to the index @i@. -- -- When you don't need access to the index then 'Data.Foldable.foldl' is more flexible in what it accepts. -- -- @ -- 'Data.Foldable.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 {-# INLINE ifoldl #-} -- | /Strictly/ fold right over the elements of a structure with access to the index @i@. -- -- When you don't need access to the index then 'foldr'' is more flexible in what it accepts. -- -- @ -- '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 {-# INLINE ifoldr' #-} -- | Fold over the elements of a structure with an index, associating to the left, but /strictly/. -- -- 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' -- @ ifoldl' :: (i -> b -> a -> b) -> b -> f a -> b ifoldl' f z0 xs = ifoldr f' id xs z0 where f' i x k z = k $! f i z x {-# INLINE ifoldl' #-} -- | Return whether or not any element in a container satisfies a predicate, with access to the index @i@. -- -- When you don't need access to the index then 'any' is more flexible in what it accepts. -- -- @ -- 'any' ≡ 'iany' '.' 'const' -- @ iany :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool iany f = getAny #. ifoldMap (\i -> Any #. f i) {-# INLINE iany #-} -- | Return whether or not all elements in a container satisfy a predicate, with access to the index @i@. -- -- When you don't need access to the index then 'all' is more flexible in what it accepts. -- -- @ -- 'all' ≡ 'iall' '.' 'const' -- @ iall :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool iall f = getAll #. ifoldMap (\i -> All #. f i) {-# INLINE iall #-} -- | Return whether or not none of the elements in a container satisfy a predicate, with access to the index @i@. -- -- When you don't need access to the index then 'none' is more flexible in what it accepts. -- -- @ -- 'none' ≡ 'inone' '.' 'const' -- 'inone' f ≡ 'not' '.' 'iany' f -- @ inone :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool inone f = not . iany f {-# INLINE inone #-} -- | Determines whether no elements of the structure satisfy the predicate. -- -- @ -- 'none' f ≡ 'not' '.' 'any' f -- @ none :: Foldable f => (a -> Bool) -> f a -> Bool none f = not . Data.Foldable.any f {-# INLINE none #-} -- | Traverse elements with access to the index @i@, discarding the results. -- -- When you don't need access to the index then 'traverse_' is more flexible in what it accepts. -- -- @ -- 'traverse_' l = 'itraverse' '.' 'const' -- @ itraverse_ :: (FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f () itraverse_ f = void . getTraversed #. ifoldMap (\i -> Traversed #. f i) {-# INLINE itraverse_ #-} -- | Traverse elements with access to the index @i@, discarding the results (with the arguments flipped). -- -- @ -- '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' -- @ ifor_ :: (FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f () ifor_ = flip itraverse_ {-# INLINE ifor_ #-} -- | Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index, -- discarding the results. -- -- When you don't need access to the index then 'Control.Lens.Fold.mapMOf_' is more flexible in what it accepts. -- -- @ -- 'mapM_' ≡ 'imapM' '.' 'const' -- @ imapM_ :: (FoldableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m () imapM_ f = liftM skip . getSequenced #. ifoldMap (\i -> Sequenced #. f i) {-# INLINE imapM_ #-} -- | 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_' -- @ -- -- 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' -- @ iforM_ :: (FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m () iforM_ = flip imapM_ {-# INLINE iforM_ #-} -- | Concatenate the results of a function of the elements of an indexed container with access to the index. -- -- When you don't need access to the index then 'concatMap' is more flexible in what it accepts. -- -- @ -- 'concatMap' ≡ 'iconcatMap' '.' 'const' -- 'iconcatMap' ≡ 'ifoldMap' -- @ iconcatMap :: FoldableWithIndex i f => (i -> a -> [b]) -> f a -> [b] iconcatMap = ifoldMap {-# INLINE iconcatMap #-} -- | Searches a container with a predicate that is also supplied the index, returning the left-most element of the structure -- matching the predicate, or 'Nothing' if there is no such element. -- -- When you don't need access to the index then 'find' is more flexible in what it accepts. -- -- @ -- 'find' ≡ 'ifind' '.' 'const' -- @ ifind :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Maybe (i, a) ifind p = ifoldr (\i a y -> if p i a then Just (i, a) else y) Nothing {-# INLINE ifind #-} -- | Monadic fold right over the elements of a structure with an index. -- -- When you don't need access to the index then 'foldrM' is more flexible in what it accepts. -- -- @ -- '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 {-# INLINE ifoldrM #-} -- | Monadic fold over the elements of a structure with an index, associating to the left. -- -- When you don't need access to the index then 'foldlM' is more flexible in what it accepts. -- -- @ -- '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 {-# INLINE ifoldlM #-} -- | Extract the key-value pairs from a structure. -- -- When you don't need access to the indices in the result, then 'Data.Foldable.toList' is more flexible in what it accepts. -- -- @ -- 'Data.Foldable.toList' ≡ 'Data.List.map' 'snd' '.' 'itoList' -- @ itoList :: FoldableWithIndex i f => f a -> [(i,a)] itoList = ifoldr (\i c -> ((i,c):)) [] {-# INLINE itoList #-} ------------------------------------------------------------------------------- -- TraversableWithIndex ------------------------------------------------------------------------------- -- | A 'Traversable' with an additional index. -- -- An instance must satisfy a (modified) form of the 'Traversable' laws: -- -- @ -- 'itraverse' ('const' 'Identity') ≡ 'Identity' -- 'fmap' ('itraverse' f) '.' 'itraverse' g ≡ 'Data.Functor.Compose.getCompose' '.' 'itraverse' (\\i -> 'Data.Functor.Compose.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. -- -- @ -- 'itraverse' ≡ 'itraverseOf' 'itraversed' -- @ itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b) #ifndef HLINT default itraverse :: Applicative f => (Int -> a -> f b) -> t a -> f (t b) itraverse = traversed .# Indexed {-# INLINE itraverse #-} #endif -- | The 'IndexedTraversal' of a 'TraversableWithIndex' container. itraversed :: IndexedTraversal i (t a) (t b) a b itraversed = conjoined traverse (itraverse . indexed) {-# INLINE itraversed #-} -- | Traverse with an index (and the arguments flipped). -- -- @ -- '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 {-# INLINE ifor #-} -- | Map each element of a structure to a monadic action, -- evaluate these actions from left to right, and collect the results, with access -- the index. -- -- When you don't need access to the index 'mapM' is more liberal in what it can accept. -- -- @ -- '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 #-} -- | Map each element of a structure to a monadic action, -- evaluate these actions from left to right, and collect the results, with access -- its position (and the arguments flipped). -- -- @ -- '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 {-# INLINE iforM #-} -- | Generalizes 'Data.Traversable.mapAccumR' to add access to the index. -- -- 'imapAccumROf' accumulates state from right to left. -- -- @ -- '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 (forwards (itraverse (\i c -> Backwards (Lazy.state (\s -> swap (f i s c)))) a)) s0) {-# INLINE imapAccumR #-} -- | Generalizes 'Data.Traversable.mapAccumL' to add access to the index. -- -- 'imapAccumLOf' accumulates state from left to right. -- -- @ -- '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 (itraverse (\i c -> Lazy.state (\s -> swap (f i s c))) a) s0) {-# INLINE imapAccumL #-} ------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------- instance FunctorWithIndex i f => FunctorWithIndex i (Backwards f) where imap f = Backwards . imap f . forwards {-# INLINE imap #-} instance FoldableWithIndex i f => FoldableWithIndex i (Backwards f) where ifoldMap f = ifoldMap f . forwards {-# INLINE ifoldMap #-} instance TraversableWithIndex i f => TraversableWithIndex i (Backwards f) where itraverse f = fmap Backwards . itraverse f . forwards {-# INLINE itraverse #-} instance FunctorWithIndex i f => FunctorWithIndex i (Reverse f) where imap f = Reverse . imap f . getReverse {-# INLINE imap #-} instance FoldableWithIndex i f => FoldableWithIndex i (Reverse f) where ifoldMap f = getDual . ifoldMap (\i -> Dual #. f i) . getReverse {-# INLINE ifoldMap #-} instance TraversableWithIndex i f => TraversableWithIndex i (Reverse f) where itraverse f = fmap Reverse . forwards . itraverse (\i -> Backwards . f i) . getReverse {-# INLINE itraverse #-} instance FunctorWithIndex () Identity where imap f (Identity a) = Identity (f () a) {-# INLINE imap #-} instance FoldableWithIndex () Identity where ifoldMap f (Identity a) = f () a {-# INLINE ifoldMap #-} instance TraversableWithIndex () Identity where itraverse f (Identity a) = Identity <$> f () a {-# INLINE itraverse #-} instance FunctorWithIndex k ((,) k) where imap f (k,a) = (k, f k a) {-# INLINE imap #-} instance FoldableWithIndex k ((,) k) where ifoldMap = uncurry {-# INLINE ifoldMap #-} instance TraversableWithIndex k ((,) k) where itraverse f (k, a) = (,) k <$> f k a {-# INLINE itraverse #-} -- | The position in the list is available as the index. instance FunctorWithIndex Int [] instance FoldableWithIndex Int [] instance TraversableWithIndex Int [] where itraversed = traversed {-# INLINE itraversed #-} instance FunctorWithIndex Int NonEmpty instance FoldableWithIndex Int NonEmpty instance TraversableWithIndex Int NonEmpty where itraverse = itraverseOf traversed {-# INLINE itraverse #-} instance FunctorWithIndex () Maybe where imap f = fmap (f ()) {-# INLINE imap #-} instance FoldableWithIndex () Maybe where ifoldMap f = foldMap (f ()) {-# INLINE ifoldMap #-} instance TraversableWithIndex () Maybe where itraverse f = traverse (f ()) {-# INLINE itraverse #-} -- | The position in the 'Seq' is available as the index. instance FunctorWithIndex Int Seq where imap = mapWithIndex instance FoldableWithIndex Int Seq where ifoldMap f = Data.Foldable.fold . mapWithIndex f ifoldr = foldrWithIndex ifoldl f = foldlWithIndex (flip f) {-# INLINE ifoldl #-} instance TraversableWithIndex Int Seq where -- The next version of containers will probably offer traverseWithIndex; -- when that comes out, it should be used for this. itraverse f = sequenceA . mapWithIndex f instance FunctorWithIndex Int Vector where imap = V.imap {-# INLINE imap #-} instance FoldableWithIndex Int Vector where ifoldr = V.ifoldr {-# INLINE ifoldr #-} ifoldl = V.ifoldl . flip {-# INLINE ifoldl #-} ifoldr' = V.ifoldr' {-# INLINE ifoldr' #-} ifoldl' = V.ifoldl' . flip {-# INLINE ifoldl' #-} instance TraversableWithIndex Int Vector where itraversed = traversed {-# INLINE itraversed #-} instance FunctorWithIndex Int IntMap instance FoldableWithIndex Int IntMap instance TraversableWithIndex Int IntMap where #if MIN_VERSION_containers(0,5,0) itraverse = IntMap.traverseWithKey #else itraverse f = sequenceA . IntMap.mapWithKey f #endif {-# INLINE [0] itraverse #-} {-# RULES "itraversed -> mapIntMap" itraversed = sets IntMap.map :: ASetter (IntMap a) (IntMap b) a b; "itraversed -> imapIntMap" itraversed = isets IntMap.mapWithKey :: AnIndexedSetter Int (IntMap a) (IntMap b) a b; "itraversed -> foldrIntMap" itraversed = foldring IntMap.foldr :: Getting (Endo r) (IntMap a) a; "itraversed -> ifoldrIntMap" itraversed = ifoldring IntMap.foldrWithKey :: IndexedGetting Int (Endo r) (IntMap a) a; #-} instance FunctorWithIndex k (Map k) instance FoldableWithIndex k (Map k) instance TraversableWithIndex k (Map k) where #if MIN_VERSION_containers(0,5,0) itraverse = Map.traverseWithKey #else itraverse f = sequenceA . Map.mapWithKey f #endif {-# INLINE [0] itraverse #-} {-# RULES "itraversed -> mapMap" itraversed = sets Map.map :: ASetter (Map k a) (Map k b) a b; "itraversed -> imapMap" itraversed = isets Map.mapWithKey :: AnIndexedSetter k (Map k a) (Map k b) a b; "itraversed -> foldrMap" itraversed = foldring Map.foldr :: Getting (Endo r) (Map k a) a; "itraversed -> ifoldrMap" itraversed = ifoldring Map.foldrWithKey :: IndexedGetting k (Endo r) (Map k a) a; #-} instance (Eq k, Hashable k) => FunctorWithIndex k (HashMap k) instance (Eq k, Hashable k) => FoldableWithIndex k (HashMap k) instance (Eq k, Hashable k) => TraversableWithIndex k (HashMap k) where itraverse = HashMap.traverseWithKey {-# INLINE [0] itraverse #-} {-# RULES "itraversed -> mapHashMap" itraversed = sets HashMap.map :: ASetter (HashMap k a) (HashMap k b) a b; "itraversed -> imapHashMap" itraversed = isets HashMap.mapWithKey :: AnIndexedSetter k (HashMap k a) (HashMap k b) a b; "itraversed -> foldrHashMap" itraversed = foldring HashMap.foldr :: Getting (Endo r) (HashMap k a) a; "itraversed -> ifoldrHashMap" itraversed = ifoldring HashMap.foldrWithKey :: IndexedGetting k (Endo r) (HashMap k a) a; #-} instance FunctorWithIndex r ((->) r) where imap f g x = f x (g x) {-# INLINE imap #-} instance FunctorWithIndex i (Level i) where imap f = go where go (Two n l r) = Two n (go l) (go r) go (One i a) = One i (f i a) go Zero = Zero {-# INLINE imap #-} instance FoldableWithIndex i (Level i) where ifoldMap f = go where go (Two _ l r) = go l `mappend` go r go (One i a) = f i a go Zero = mempty {-# INLINE ifoldMap #-} instance TraversableWithIndex i (Level i) where itraverse f = go where go (Two n l r) = Two n <$> go l <*> go r go (One i a) = One i <$> f i a go Zero = pure Zero {-# INLINE itraverse #-} instance FunctorWithIndex i (Magma i t b) where imap f (MagmaAp x y) = MagmaAp (imap f x) (imap f y) imap _ (MagmaPure x) = MagmaPure x imap f (MagmaFmap xy x) = MagmaFmap xy (imap f x) imap f (Magma i a) = Magma i (f i a) {-# INLINE imap #-} instance FoldableWithIndex i (Magma i t b) where ifoldMap f (MagmaAp x y) = ifoldMap f x `mappend` ifoldMap f y ifoldMap _ MagmaPure{} = mempty ifoldMap f (MagmaFmap _ x) = ifoldMap f x ifoldMap f (Magma i a) = f i a {-# INLINE ifoldMap #-} instance TraversableWithIndex i (Magma i t b) where itraverse f (MagmaAp x y) = MagmaAp <$> itraverse f x <*> itraverse f y itraverse _ (MagmaPure x) = pure (MagmaPure x) itraverse f (MagmaFmap xy x) = MagmaFmap xy <$> itraverse f x itraverse f (Magma i a) = Magma i <$> f i a {-# INLINE itraverse #-} instance FunctorWithIndex i f => FunctorWithIndex [i] (Free f) where imap f (Pure a) = Pure $ f [] a imap f (Free s) = Free $ imap (\i -> imap (f . (:) i)) s {-# INLINE imap #-} instance FoldableWithIndex i f => FoldableWithIndex [i] (Free f) where ifoldMap f (Pure a) = f [] a ifoldMap f (Free s) = ifoldMap (\i -> ifoldMap (f . (:) i)) s {-# INLINE ifoldMap #-} instance TraversableWithIndex i f => TraversableWithIndex [i] (Free f) where itraverse f (Pure a) = Pure <$> f [] a itraverse f (Free s) = Free <$> itraverse (\i -> itraverse (f . (:) i)) s {-# INLINE itraverse #-} instance Ix i => FunctorWithIndex i (Array i) where imap f arr = Array.listArray (Array.bounds arr) . fmap (uncurry f) $ Array.assocs arr {-# INLINE imap #-} instance Ix i => FoldableWithIndex i (Array i) where ifoldMap f = foldMap (uncurry f) . Array.assocs {-# INLINE ifoldMap #-} instance Ix i => TraversableWithIndex i (Array i) where itraverse f arr = Array.listArray (Array.bounds arr) <$> traverse (uncurry f) (Array.assocs arr) {-# INLINE itraverse #-} instance FunctorWithIndex i f => FunctorWithIndex [i] (Cofree f) where imap f (a :< as) = f [] a :< imap (\i -> imap (f . (:) i)) as {-# INLINE imap #-} instance FoldableWithIndex i f => FoldableWithIndex [i] (Cofree f) where ifoldMap f (a :< as) = f [] a `mappend` ifoldMap (\i -> ifoldMap (f . (:) i)) as {-# INLINE ifoldMap #-} instance TraversableWithIndex i f => TraversableWithIndex [i] (Cofree f) where itraverse f (a :< as) = (:<) <$> f [] a <*> itraverse (\i -> itraverse (f . (:) i)) as {-# INLINE itraverse #-} instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (i, j) (Compose f g) where imap f (Compose fg) = Compose $ imap (\k -> imap (f . (,) k)) fg {-# INLINE imap #-} instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (Compose f g) where ifoldMap f (Compose fg) = ifoldMap (\k -> ifoldMap (f . (,) k)) fg {-# INLINE ifoldMap #-} instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (i, j) (Compose f g) where itraverse f (Compose fg) = Compose <$> itraverse (\k -> itraverse (f . (,) k)) fg {-# INLINE itraverse #-} instance FunctorWithIndex i m => FunctorWithIndex i (IdentityT m) where imap f (IdentityT m) = IdentityT $ imap f m {-# INLINE imap #-} instance FoldableWithIndex i m => FoldableWithIndex i (IdentityT m) where ifoldMap f (IdentityT m) = ifoldMap f m {-# INLINE ifoldMap #-} instance TraversableWithIndex i m => TraversableWithIndex i (IdentityT m) where itraverse f (IdentityT m) = IdentityT <$> itraverse f m {-# INLINE itraverse #-} instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (Product f g) where imap f (Pair a b) = Pair (imap (f . Left) a) (imap (f . Right) b) {-# INLINE imap #-} instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (Product f g) where ifoldMap f (Pair a b) = ifoldMap (f . Left) a `mappend` ifoldMap (f . Right) b {-# INLINE ifoldMap #-} instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (Product f g) where itraverse f (Pair a b) = Pair <$> itraverse (f . Left) a <*> itraverse (f . Right) b {-# INLINE itraverse #-} instance FunctorWithIndex i m => FunctorWithIndex (e, i) (ReaderT e m) where imap f (ReaderT m) = ReaderT $ \k -> imap (f . (,) k) (m k) {-# INLINE imap #-} instance FunctorWithIndex i w => FunctorWithIndex (s, i) (TracedT s w) where imap f (TracedT w) = TracedT $ imap (\k' g k -> f (k, k') (g k)) w {-# INLINE imap #-} instance FunctorWithIndex [Int] Tree where imap f (Node a as) = Node (f [] a) $ imap (\i -> imap (f . (:) i)) as {-# INLINE imap #-} instance FoldableWithIndex [Int] Tree where ifoldMap f (Node a as) = f [] a `mappend` ifoldMap (\i -> ifoldMap (f . (:) i)) as {-# INLINE ifoldMap #-} instance TraversableWithIndex [Int] Tree where itraverse f (Node a as) = Node <$> f [] a <*> itraverse (\i -> itraverse (f . (:) i)) as {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- Misc. ------------------------------------------------------------------------------- skip :: a -> () skip _ = () {-# INLINE skip #-} ------------------------------------------------------------------------------- -- Indexed Folds with Reified Monoid ------------------------------------------------------------------------------- ifoldMapBy :: FoldableWithIndex i t => (r -> r -> r) -> r -> (i -> a -> r) -> t a -> r ifoldMapBy f z g = reifyMonoid f z (ifoldMap (\i a -> ReflectedMonoid (g i a))) ifoldMapByOf :: IndexedFold i t a -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r ifoldMapByOf l f z g = reifyMonoid f z (ifoldMapOf l (\i a -> ReflectedMonoid (g i a))) itraverseBy :: TraversableWithIndex i t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> t a -> f (t b) itraverseBy pur app f = reifyApplicative pur app (itraverse (\i a -> ReflectedApplicative (f i a))) itraverseByOf :: IndexedTraversal i s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> s -> f t itraverseByOf l pur app f = reifyApplicative pur app (itraverseOf l (\i a -> ReflectedApplicative (f i a))) lens-4.14/src/Control/Lens/Internal.hs0000644000000000000000000000321412710476104016013 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : Rank2Types -- -- These are some of the explicit 'Functor' instances that leak into the -- type signatures of @Control.Lens@. You shouldn't need to import this -- module directly for most use-cases. -- ---------------------------------------------------------------------------- module Control.Lens.Internal ( module Control.Lens.Internal.Bazaar , module Control.Lens.Internal.Context , module Control.Lens.Internal.Fold , module Control.Lens.Internal.Getter , module Control.Lens.Internal.Indexed , module Control.Lens.Internal.Iso , module Control.Lens.Internal.Level , module Control.Lens.Internal.Magma , module Control.Lens.Internal.Prism , module Control.Lens.Internal.Review , module Control.Lens.Internal.Setter , module Control.Lens.Internal.Zoom ) where import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context import Control.Lens.Internal.Fold import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Control.Lens.Internal.Instances () import Control.Lens.Internal.Iso import Control.Lens.Internal.Level import Control.Lens.Internal.Magma import Control.Lens.Internal.Prism import Control.Lens.Internal.Review import Control.Lens.Internal.Setter import Control.Lens.Internal.Zoom #ifdef HLINT {-# ANN module "HLint: ignore Use import/export shortcut" #-} #endif lens-4.14/src/Control/Lens/Iso.hs0000644000000000000000000004605412710476104015002 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE ScopedTypeVariables #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif #ifndef MIN_VERSION_bytestring #define MIN_VERSION_bytestring(x,y,z) 1 #endif #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Iso -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- ---------------------------------------------------------------------------- module Control.Lens.Iso ( -- * Isomorphism Lenses Iso, Iso' , AnIso, AnIso' -- * Isomorphism Construction , iso -- * Consuming Isomorphisms , from , cloneIso , withIso -- * Working with isomorphisms , au , auf , under , mapping -- ** Common Isomorphisms , simple , non, non' , anon , enum , curried, uncurried , flipped , Swapped(..) #if __GLASGOW_HASKELL__ >= 710 , pattern Swapped #endif , Strict(..) #if __GLASGOW_HASKELL__ >= 710 , pattern Strict , pattern Lazy #endif , lazy , Reversing(..) , reversed #if __GLASGOW_HASKELL__ >= 710 , pattern Reversed #endif , involuted #if __GLASGOW_HASKELL__ >= 710 , pattern List #endif -- ** Uncommon Isomorphisms , magma , imagma , Magma -- ** Contravariant functors , contramapping -- * Profunctors , Profunctor(dimap,rmap,lmap) , dimapping , lmapping , rmapping -- * Bifunctors , bimapping , firsting , seconding #if __GLASGOW_HASKELL__ >= 710 -- * Coercions , coerced #endif ) where import Control.Lens.Equality (simple) import Control.Lens.Getter import Control.Lens.Fold import Control.Lens.Internal.Context import Control.Lens.Internal.Coerce import Control.Lens.Internal.Indexed import Control.Lens.Internal.Iso as Iso import Control.Lens.Internal.Magma import Control.Lens.Prism import Control.Lens.Review import Control.Lens.Type import Control.Monad.State.Lazy as Lazy import Control.Monad.State.Strict as Strict import Control.Monad.Writer.Lazy as Lazy import Control.Monad.Writer.Strict as Strict import Control.Monad.RWS.Lazy as Lazy import Control.Monad.RWS.Strict as Strict import Data.Bifunctor import Data.ByteString as StrictB hiding (reverse) import Data.ByteString.Lazy as LazyB hiding (reverse) #if __GLASGOW_HASKELL__ >= 708 import Data.Coerce #endif import Data.Functor.Identity import Data.Text as StrictT hiding (reverse) import Data.Text.Lazy as LazyT hiding (reverse) import Data.Tuple (swap) import Data.Maybe import Data.Profunctor import Data.Profunctor.Unsafe #if __GLASGOW_HASKELL__ >= 710 import qualified GHC.Exts as Exts #endif #ifdef HLINT {-# ANN module "HLint: ignore Use on" #-} #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Data.Map as Map -- >>> import Data.Foldable -- >>> import Data.Monoid ---------------------------------------------------------------------------- -- Isomorphisms ----------------------------------------------------------------------------- -- | When you see this as an argument to a function, it expects an 'Iso'. type AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s (Identity t) -- | A 'Simple' 'AnIso'. type AnIso' s a = AnIso s s a a -- | Build a simple isomorphism from a pair of inverse functions. -- -- @ -- 'Control.Lens.Getter.view' ('iso' f g) ≡ f -- 'Control.Lens.Getter.view' ('Control.Lens.Iso.from' ('iso' f g)) ≡ g -- 'Control.Lens.Setter.over' ('iso' f g) h ≡ g '.' h '.' f -- 'Control.Lens.Setter.over' ('Control.Lens.Iso.from' ('iso' f g)) h ≡ f '.' h '.' g -- @ iso :: (s -> a) -> (b -> t) -> Iso s t a b iso sa bt = dimap sa (fmap bt) {-# INLINE iso #-} ---------------------------------------------------------------------------- -- Consuming Isomorphisms ----------------------------------------------------------------------------- -- | Invert an isomorphism. -- -- @ -- 'from' ('from' l) ≡ l -- @ from :: AnIso s t a b -> Iso b a t s from l = withIso l $ \ sa bt -> iso bt sa {-# INLINE from #-} -- | Extract the two functions, one from @s -> a@ and -- one from @b -> t@ that characterize an 'Iso'. withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r withIso ai k = case ai (Exchange id Identity) of Exchange sa bt -> k sa (runIdentity #. bt) {-# INLINE withIso #-} -- | Convert from 'AnIso' back to any 'Iso'. -- -- This is useful when you need to store an isomorphism as a data type inside a container -- and later reconstitute it as an overloaded function. -- -- See 'Control.Lens.Lens.cloneLens' or 'Control.Lens.Traversal.cloneTraversal' for more information on why you might want to do this. cloneIso :: AnIso s t a b -> Iso s t a b cloneIso k = withIso k iso {-# INLINE cloneIso #-} ----------------------------------------------------------------------------- -- Isomorphisms families as Lenses ----------------------------------------------------------------------------- -- | Based on 'Control.Lens.Wrapped.ala' from Conor McBride's work on Epigram. -- -- This version is generalized to accept any 'Iso', not just a @newtype@. -- -- >>> au (_Wrapping Sum) foldMap [1,2,3,4] -- 10 -- -- You may want to think of this combinator as having the following, simpler type: -- -- @ -- au :: AnIso s t a b -> ((b -> t) -> e -> s) -> e -> a -- @ au :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a au k = withIso k $ \ sa bt f -> fmap sa (f bt) {-# INLINE au #-} -- | Based on @ala'@ from Conor McBride's work on Epigram. -- -- This version is generalized to accept any 'Iso', not just a @newtype@. -- -- For a version you pass the name of the @newtype@ constructor to, see 'Control.Lens.Wrapped.alaf'. -- -- >>> auf (_Unwrapping Sum) (foldMapOf both) Prelude.length ("hello","world") -- 10 -- -- Mnemonically, the German /auf/ plays a similar role to /à la/, and the combinator -- is 'au' with an extra function argument: -- -- @ -- 'auf' :: 'Iso' s t a b -> ((r -> a) -> e -> b) -> (r -> s) -> e -> t -- @ -- -- but the signature is general. auf :: Optic (Costar f) g s t a b -> (f a -> g b) -> f s -> g t auf = coerce {-# INLINE auf #-} -- | The opposite of working 'Control.Lens.Setter.over' a 'Setter' is working 'under' an isomorphism. -- -- @ -- 'under' ≡ 'Control.Lens.Setter.over' '.' 'from' -- @ -- -- @ -- 'under' :: 'Iso' s t a b -> (t -> s) -> b -> a -- @ under :: AnIso s t a b -> (t -> s) -> b -> a under k = withIso k $ \ sa bt ts -> sa . ts . bt {-# INLINE under #-} ----------------------------------------------------------------------------- -- Isomorphisms ----------------------------------------------------------------------------- -- | This isomorphism can be used to convert to or from an instance of 'Enum'. -- -- >>> LT^.from enum -- 0 -- -- >>> 97^.enum :: Char -- 'a' -- -- Note: this is only an isomorphism from the numeric range actually used -- and it is a bit of a pleasant fiction, since there are questionable -- 'Enum' instances for 'Double', and 'Float' that exist solely for -- @[1.0 .. 4.0]@ sugar and the instances for those and 'Integer' don't -- cover all values in their range. enum :: Enum a => Iso' Int a enum = iso toEnum fromEnum {-# INLINE enum #-} -- | This can be used to lift any 'Iso' into an arbitrary 'Functor'. mapping :: (Functor f, Functor g) => AnIso s t a b -> Iso (f s) (g t) (f a) (g b) mapping k = withIso k $ \ sa bt -> iso (fmap sa) (fmap bt) {-# INLINE mapping #-} -- | If @v@ is an element of a type @a@, and @a'@ is @a@ sans the element @v@, then @'non' v@ is an isomorphism from -- @'Maybe' a'@ to @a@. -- -- @ -- 'non' ≡ 'non'' '.' 'only' -- @ -- -- Keep in mind this is only a real isomorphism if you treat the domain as being @'Maybe' (a sans v)@. -- -- This is practically quite useful when you want to have a 'Data.Map.Map' where all the entries should have non-zero values. -- -- >>> Map.fromList [("hello",1)] & at "hello" . non 0 +~ 2 -- fromList [("hello",3)] -- -- >>> Map.fromList [("hello",1)] & at "hello" . non 0 -~ 1 -- fromList [] -- -- >>> Map.fromList [("hello",1)] ^. at "hello" . non 0 -- 1 -- -- >>> Map.fromList [] ^. at "hello" . non 0 -- 0 -- -- This combinator is also particularly useful when working with nested maps. -- -- /e.g./ When you want to create the nested 'Data.Map.Map' when it is missing: -- -- >>> Map.empty & at "hello" . non Map.empty . at "world" ?~ "!!!" -- fromList [("hello",fromList [("world","!!!")])] -- -- and when have deleting the last entry from the nested 'Data.Map.Map' mean that we -- should delete its entry from the surrounding one: -- -- >>> fromList [("hello",fromList [("world","!!!")])] & at "hello" . non Map.empty . at "world" .~ Nothing -- fromList [] -- -- It can also be used in reverse to exclude a given value: -- -- >>> non 0 # rem 10 4 -- Just 2 -- -- >>> non 0 # rem 10 5 -- Nothing non :: Eq a => a -> Iso' (Maybe a) a non = non' . only {-# INLINE non #-} -- | @'non'' p@ generalizes @'non' (p # ())@ to take any unit 'Prism' -- -- This function generates an isomorphism between @'Maybe' (a | 'isn't' p a)@ and @a@. -- -- >>> Map.singleton "hello" Map.empty & at "hello" . non' _Empty . at "world" ?~ "!!!" -- fromList [("hello",fromList [("world","!!!")])] -- -- >>> fromList [("hello",fromList [("world","!!!")])] & at "hello" . non' _Empty . at "world" .~ Nothing -- fromList [] non' :: APrism' a () -> Iso' (Maybe a) a non' p = iso (fromMaybe def) go where def = review (clonePrism p) () go b | has (clonePrism p) b = Nothing | otherwise = Just b {-# INLINE non' #-} -- | @'anon' a p@ generalizes @'non' a@ to take any value and a predicate. -- -- This function assumes that @p a@ holds @'True'@ and generates an isomorphism between @'Maybe' (a | 'not' (p a))@ and @a@. -- -- >>> Map.empty & at "hello" . anon Map.empty Map.null . at "world" ?~ "!!!" -- fromList [("hello",fromList [("world","!!!")])] -- -- >>> fromList [("hello",fromList [("world","!!!")])] & at "hello" . anon Map.empty Map.null . at "world" .~ Nothing -- fromList [] anon :: a -> (a -> Bool) -> Iso' (Maybe a) a anon a p = iso (fromMaybe a) go where go b | p b = Nothing | otherwise = Just b {-# INLINE anon #-} -- | The canonical isomorphism for currying and uncurrying a function. -- -- @ -- 'curried' = 'iso' 'curry' 'uncurry' -- @ -- -- >>> (fst^.curried) 3 4 -- 3 -- -- >>> view curried fst 3 4 -- 3 curried :: Iso ((a,b) -> c) ((d,e) -> f) (a -> b -> c) (d -> e -> f) curried = iso curry uncurry {-# INLINE curried #-} -- | The canonical isomorphism for uncurrying and currying a function. -- -- @ -- 'uncurried' = 'iso' 'uncurry' 'curry' -- @ -- -- @ -- 'uncurried' = 'from' 'curried' -- @ -- -- >>> ((+)^.uncurried) (1,2) -- 3 uncurried :: Iso (a -> b -> c) (d -> e -> f) ((a,b) -> c) ((d,e) -> f) uncurried = iso uncurry curry {-# INLINE uncurried #-} -- | The isomorphism for flipping a function. -- -- >>>((,)^.flipped) 1 2 -- (2,1) flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c') flipped = iso flip flip {-# INLINE flipped #-} -- | This class provides for symmetric bifunctors. class Bifunctor p => Swapped p where -- | -- @ -- 'swapped' '.' 'swapped' ≡ 'id' -- 'first' f '.' 'swapped' = 'swapped' '.' 'second' f -- 'second' g '.' 'swapped' = 'swapped' '.' 'first' g -- 'bimap' f g '.' 'swapped' = 'swapped' '.' 'bimap' g f -- @ -- -- >>> (1,2)^.swapped -- (2,1) swapped :: Iso (p a b) (p c d) (p b a) (p d c) instance Swapped (,) where swapped = iso swap swap instance Swapped Either where swapped = iso (either Right Left) (either Right Left) -- | Ad hoc conversion between \"strict\" and \"lazy\" versions of a structure, -- such as 'StrictT.Text' or 'StrictB.ByteString'. class Strict lazy strict | lazy -> strict, strict -> lazy where strict :: Iso' lazy strict #if __GLASGOW_HASKELL__ >= 710 pattern Strict a <- (view strict -> a) where Strict a = review strict a pattern Lazy a <- (view lazy -> a) where Lazy a = review lazy a pattern Swapped a <- (view swapped -> a) where Swapped a = review swapped a pattern Reversed a <- (view reversed -> a) where Reversed a = review reversed a #endif instance Strict LazyB.ByteString StrictB.ByteString where #if MIN_VERSION_bytestring(0,10,0) strict = iso LazyB.toStrict LazyB.fromStrict #else strict = iso (StrictB.concat . LazyB.toChunks) (LazyB.fromChunks . return) #endif {-# INLINE strict #-} instance Strict LazyT.Text StrictT.Text where strict = iso LazyT.toStrict LazyT.fromStrict {-# INLINE strict #-} instance Strict (Lazy.StateT s m a) (Strict.StateT s m a) where strict = iso (Strict.StateT . Lazy.runStateT) (Lazy.StateT . Strict.runStateT) {-# INLINE strict #-} instance Strict (Lazy.WriterT w m a) (Strict.WriterT w m a) where strict = iso (Strict.WriterT . Lazy.runWriterT) (Lazy.WriterT . Strict.runWriterT) {-# INLINE strict #-} instance Strict (Lazy.RWST r w s m a) (Strict.RWST r w s m a) where strict = iso (Strict.RWST . Lazy.runRWST) (Lazy.RWST . Strict.runRWST) {-# INLINE strict #-} -- | An 'Iso' between the strict variant of a structure and its lazy -- counterpart. -- -- @ -- 'lazy' = 'from' 'strict' -- @ -- -- See for an example -- use. lazy :: Strict lazy strict => Iso' strict lazy lazy = from strict -- | An 'Iso' between a list, 'ByteString', 'Text' fragment, etc. and its reversal. -- -- >>> "live" ^. reversed -- "evil" -- -- >>> "live" & reversed %~ ('d':) -- "lived" reversed :: Reversing a => Iso' a a reversed = involuted Iso.reversing -- | Given a function that is its own inverse, this gives you an 'Iso' using it in both directions. -- -- @ -- 'involuted' ≡ 'Control.Monad.join' 'iso' -- @ -- -- >>> "live" ^. involuted reverse -- "evil" -- -- >>> "live" & involuted reverse %~ ('d':) -- "lived" involuted :: (a -> a) -> Iso' a a involuted a = iso a a {-# INLINE involuted #-} #if __GLASGOW_HASKELL__ >= 710 pattern List a <- (Exts.toList -> a) where List a = Exts.fromList a #endif ------------------------------------------------------------------------------ -- Magma ------------------------------------------------------------------------------ -- | This isomorphism can be used to inspect a 'Traversal' to see how it associates -- the structure and it can also be used to bake the 'Traversal' into a 'Magma' so -- that you can traverse over it multiple times. magma :: LensLike (Mafic a b) s t a b -> Iso s u (Magma Int t b a) (Magma j u c c) magma l = iso (runMafic `rmap` l sell) runMagma {-# INLINE magma #-} -- | This isomorphism can be used to inspect an 'IndexedTraversal' to see how it associates -- the structure and it can also be used to bake the 'IndexedTraversal' into a 'Magma' so -- that you can traverse over it multiple times with access to the original indices. imagma :: Over (Indexed i) (Molten i a b) s t a b -> Iso s t' (Magma i t b a) (Magma j t' c c) imagma l = iso (runMolten #. l sell) (iextract .# Molten) {-# INLINE imagma #-} ------------------------------------------------------------------------------ -- Contravariant ------------------------------------------------------------------------------ -- | Lift an 'Iso' into a 'Contravariant' functor. -- -- @ -- contramapping :: 'Contravariant' f => 'Iso' s t a b -> 'Iso' (f a) (f b) (f s) (f t) -- contramapping :: 'Contravariant' f => 'Iso'' s a -> 'Iso'' (f a) (f s) -- @ contramapping :: Contravariant f => AnIso s t a b -> Iso (f a) (f b) (f s) (f t) contramapping f = withIso f $ \ sa bt -> iso (contramap sa) (contramap bt) {-# INLINE contramapping #-} ------------------------------------------------------------------------------ -- Profunctor ------------------------------------------------------------------------------ -- | Lift two 'Iso's into both arguments of a 'Profunctor' simultaneously. -- -- @ -- dimapping :: 'Profunctor' p => 'Iso' s t a b -> 'Iso' s' t' a' b' -> 'Iso' (p a s') (p b t') (p s a') (p t b') -- dimapping :: 'Profunctor' p => 'Iso'' s a -> 'Iso'' s' a' -> 'Iso'' (p a s') (p s a') -- @ dimapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b') dimapping f g = withIso f $ \ sa bt -> withIso g $ \ s'a' b't' -> iso (dimap sa s'a') (dimap bt b't') {-# INLINE dimapping #-} -- | Lift an 'Iso' contravariantly into the left argument of a 'Profunctor'. -- -- @ -- lmapping :: 'Profunctor' p => 'Iso' s t a b -> 'Iso' (p a x) (p b y) (p s x) (p t y) -- lmapping :: 'Profunctor' p => 'Iso'' s a -> 'Iso'' (p a x) (p s x) -- @ lmapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p a x) (q b y) (p s x) (q t y) lmapping f = withIso f $ \ sa bt -> iso (lmap sa) (lmap bt) {-# INLINE lmapping #-} -- | Lift an 'Iso' covariantly into the right argument of a 'Profunctor'. -- -- @ -- rmapping :: 'Profunctor' p => 'Iso' s t a b -> 'Iso' (p x s) (p y t) (p x a) (p y b) -- rmapping :: 'Profunctor' p => 'Iso'' s a -> 'Iso'' (p x s) (p x a) -- @ rmapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p x s) (q y t) (p x a) (q y b) rmapping g = withIso g $ \ sa bt -> iso (rmap sa) (rmap bt) {-# INLINE rmapping #-} ------------------------------------------------------------------------------ -- Bifunctor ------------------------------------------------------------------------------ -- | Lift two 'Iso's into both arguments of a 'Bifunctor'. -- -- @ -- bimapping :: 'Bifunctor' p => 'Iso' s t a b -> 'Iso' s' t' a' b' -> 'Iso' (p s s') (p t t') (p a a') (p b b') -- bimapping :: 'Bifunctor' p => 'Iso'' s a -> 'Iso'' s' a' -> 'Iso'' (p s s') (p a a') -- @ bimapping :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b') bimapping f g = withIso f $ \ sa bt -> withIso g $ \s'a' b't' -> iso (bimap sa s'a') (bimap bt b't') {-# INLINE bimapping #-} -- | Lift an 'Iso' into the first argument of a 'Bifunctor'. -- -- @ -- firsting :: 'Bifunctor' p => 'Iso' s t a b -> 'Iso' (p s x) (p t y) (p a x) (p b y) -- firsting :: 'Bifunctor' p => 'Iso'' s a -> 'Iso'' (p s x) (p a x) -- @ firsting :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f s x) (g t y) (f a x) (g b y) firsting p = withIso p $ \ sa bt -> iso (first sa) (first bt) {-# INLINE firsting #-} -- | Lift an 'Iso' into the second argument of a 'Bifunctor'. This is -- essentially the same as 'mapping', but it takes a 'Bifunctor p' -- constraint instead of a 'Functor (p a)' one. -- -- @ -- seconding :: 'Bifunctor' p => 'Iso' s t a b -> 'Iso' (p x s) (p y t) (p x a) (p y b) -- seconding :: 'Bifunctor' p => 'Iso'' s a -> 'Iso'' (p x s) (p x a) -- @ seconding :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f x s) (g y t) (f x a) (g y b) seconding p = withIso p $ \ sa bt -> iso (second sa) (second bt) {-# INLINE seconding #-} #if __GLASGOW_HASKELL__ >= 710 -- | Data types that are representationally equal are isomorphic. -- -- This is only available on GHC 7.10+ -- -- @since 4.13 coerced :: forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b coerced l = rmap (fmap coerce') l .# coerce #endif lens-4.14/src/Control/Lens/Lens.hs0000644000000000000000000014637512710476104015160 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifndef MIN_VERSION_mtl #define MIN_VERSION_mtl(x,y,z) 1 #endif #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- A @'Lens' s t a b@ is a purely functional reference. -- -- While a 'Control.Lens.Traversal.Traversal' could be used for -- 'Control.Lens.Getter.Getting' like a valid 'Control.Lens.Fold.Fold', it -- wasn't a valid 'Control.Lens.Getter.Getter' as a -- 'Control.Lens.Getter.Getter' can't require an 'Applicative' constraint. -- -- 'Functor', however, is a constraint on both. -- -- @ -- type 'Lens' s t a b = forall f. 'Functor' f => (a -> f b) -> s -> f t -- @ -- -- Every 'Lens' is a valid 'Control.Lens.Setter.Setter'. -- -- Every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a -- 'Control.Lens.Fold.Fold' that doesn't use the 'Applicative' or -- 'Contravariant'. -- -- Every 'Lens' is a valid 'Control.Lens.Traversal.Traversal' that only uses -- the 'Functor' part of the 'Applicative' it is supplied. -- -- Every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a valid -- 'Control.Lens.Getter.Getter'. -- -- Since every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a -- valid 'Control.Lens.Getter.Getter' it follows that it must view exactly one element in the -- structure. -- -- The 'Lens' laws follow from this property and the desire for it to act like -- a 'Data.Traversable.Traversable' when used as a -- 'Control.Lens.Traversal.Traversal'. -- -- In the examples below, 'getter' and 'setter' are supplied as example getters -- and setters, and are not actual functions supplied by this package. ------------------------------------------------------------------------------- module Control.Lens.Lens ( -- * Lenses Lens, Lens' , IndexedLens, IndexedLens' -- ** Concrete Lenses , ALens, ALens' , AnIndexedLens, AnIndexedLens' -- * Combinators , lens, ilens, iplens , (%%~), (%%=) , (%%@~), (%%@=) , (<%@~), (<%@=) , (<<%@~), (<<%@=) -- ** General Purpose Combinators , (&), (<&>), (??) , (&~) -- * Lateral Composition , choosing , chosen , alongside , inside -- * Setting Functionally with Passthrough , (<%~), (<+~), (<-~), (<*~), (~) , (<<%~), (<<.~), (<<+~), (<<-~), (<<*~) , (<~) -- * Setting State with Passthrough , (<%=), (<+=), (<-=), (<*=), (=) , (<<%=), (<<.=), (<<+=), (<<-=), (<<*=) , (<=) , (<<~) -- * Cloning Lenses , cloneLens , cloneIndexPreservingLens , cloneIndexedLens -- * Arrow operators , overA -- * ALens Combinators , storing , (^#) , ( #~ ), ( #%~ ), ( #%%~ ), (<#~), (<#%~) , ( #= ), ( #%= ), ( #%%= ), (<#=), (<#%=) -- * Common Lenses , devoid , united -- * Context , Context(..) , Context' , locus -- * Lens fusion , fusing ) where import Control.Applicative import Control.Arrow import Control.Comonad import Control.Lens.Internal.Context import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Control.Lens.Type import Control.Monad.State as State import Data.Functor.Yoneda import Data.Monoid import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Profunctor.Unsafe import Data.Void import Prelude #if __GLASGOW_HASKELL__ >= 710 import Data.Function ((&)) #endif #ifdef HLINT {-# ANN module "HLint: ignore Use ***" #-} #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Control.Monad.State -- >>> import Data.Char (chr) -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g,h) -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- >>> let h :: Expr -> Expr -> Expr; h = Debug.SimpleReflect.Vars.h -- >>> let getter :: Expr -> Expr; getter = fun "getter" -- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter" infixl 8 ^# infixr 4 %%@~, <%@~, <<%@~, %%~, <+~, <*~, <-~, ~, <%~, <<%~, <<.~, <#~, #~, #%~, <#%~, #%%~ , <<+~, <<-~, <<*~, <~ infix 4 %%@=, <%@=, <<%@=, %%=, <+=, <*=, <-=, =, <%=, <<%=, <<.=, <#=, #=, #%=, <#%=, #%%= , <<+=, <<-=, <<*=, <= infixr 2 <<~ infixl 1 <&>, ??, &~ ------------------------------------------------------------------------------- -- Lenses ------------------------------------------------------------------------------- -- | When you see this as an argument to a function, it expects a 'Lens'. -- -- This type can also be used when you need to store a 'Lens' in a container, -- since it is rank-1. You can turn them back into a 'Lens' with 'cloneLens', -- or use it directly with combinators like 'storing' and ('^#'). type ALens s t a b = LensLike (Pretext (->) a b) s t a b -- | @ -- type 'ALens'' = 'Simple' 'ALens' -- @ type ALens' s a = ALens s s a a -- | When you see this as an argument to a function, it expects an 'IndexedLens' type AnIndexedLens i s t a b = Optical (Indexed i) (->) (Pretext (Indexed i) a b) s t a b -- | @ -- type 'AnIndexedLens'' = 'Simple' ('AnIndexedLens' i) -- @ type AnIndexedLens' i s a = AnIndexedLens i s s a a -------------------------- -- Constructing Lenses -------------------------- -- | Build a 'Lens' from a getter and a setter. -- -- @ -- 'lens' :: 'Functor' f => (s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t -- @ -- -- >>> s ^. lens getter setter -- getter s -- -- >>> s & lens getter setter .~ b -- setter s b -- -- >>> s & lens getter setter %~ f -- setter s (f (getter s)) -- -- @ -- 'lens' :: (s -> a) -> (s -> a -> s) -> 'Lens'' s a -- @ lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b lens sa sbt afb s = sbt s <$> afb (sa s) {-# INLINE lens #-} -- | Build an index-preserving 'Lens' from a 'Control.Lens.Getter.Getter' and a -- 'Control.Lens.Setter.Setter'. iplens :: (s -> a) -> (s -> b -> t) -> IndexPreservingLens s t a b iplens sa sbt pafb = cotabulate $ \ws -> sbt (extract ws) <$> cosieve pafb (sa <$> ws) {-# INLINE iplens #-} -- | Build an 'IndexedLens' from a 'Control.Lens.Getter.Getter' and -- a 'Control.Lens.Setter.Setter'. ilens :: (s -> (i, a)) -> (s -> b -> t) -> IndexedLens i s t a b ilens sia sbt iafb s = sbt s <$> uncurry (indexed iafb) (sia s) {-# INLINE ilens #-} -- | This can be used to chain lens operations using @op=@ syntax -- rather than @op~@ syntax for simple non-type-changing cases. -- -- >>> (10,20) & _1 .~ 30 & _2 .~ 40 -- (30,40) -- -- >>> (10,20) &~ do _1 .= 30; _2 .= 40 -- (30,40) -- -- This does not support type-changing assignment, /e.g./ -- -- >>> (10,20) & _1 .~ "hello" -- ("hello",20) (&~) :: s -> State s a -> s s &~ l = execState l s {-# INLINE (&~) #-} -- | ('%%~') can be used in one of two scenarios: -- -- When applied to a 'Lens', it can edit the target of the 'Lens' in a -- structure, extracting a functorial result. -- -- When applied to a 'Traversal', it can edit the -- targets of the traversals, extracting an applicative summary of its -- actions. -- -- >>> [66,97,116,109,97,110] & each %%~ \a -> ("na", chr a) -- ("nananananana","Batman") -- -- For all that the definition of this combinator is just: -- -- @ -- ('%%~') ≡ 'id' -- @ -- -- It may be beneficial to think about it as if it had these even more -- restricted types, however: -- -- @ -- ('%%~') :: 'Functor' f => 'Control.Lens.Iso.Iso' s t a b -> (a -> f b) -> s -> f t -- ('%%~') :: 'Functor' f => 'Lens' s t a b -> (a -> f b) -> s -> f t -- ('%%~') :: 'Applicative' f => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> f b) -> s -> f t -- @ -- -- When applied to a 'Traversal', it can edit the -- targets of the traversals, extracting a supplemental monoidal summary -- of its actions, by choosing @f = ((,) m)@ -- -- @ -- ('%%~') :: 'Control.Lens.Iso.Iso' s t a b -> (a -> (r, b)) -> s -> (r, t) -- ('%%~') :: 'Lens' s t a b -> (a -> (r, b)) -> s -> (r, t) -- ('%%~') :: 'Monoid' m => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> (m, b)) -> s -> (m, t) -- @ (%%~) :: LensLike f s t a b -> (a -> f b) -> s -> f t (%%~) = id {-# INLINE (%%~) #-} -- | Modify the target of a 'Lens' in the current state returning some extra -- information of type @r@ or modify all targets of a -- 'Control.Lens.Traversal.Traversal' in the current state, extracting extra -- information of type @r@ and return a monoidal summary of the changes. -- -- >>> runState (_1 %%= \x -> (f x, g x)) (a,b) -- (f a,(g a,b)) -- -- @ -- ('%%=') ≡ ('state' '.') -- @ -- -- It may be useful to think of ('%%='), instead, as having either of the -- following more restricted type signatures: -- -- @ -- ('%%=') :: 'MonadState' s m => 'Control.Lens.Iso.Iso' s s a b -> (a -> (r, b)) -> m r -- ('%%=') :: 'MonadState' s m => 'Lens' s s a b -> (a -> (r, b)) -> m r -- ('%%=') :: ('MonadState' s m, 'Monoid' r) => 'Control.Lens.Traversal.Traversal' s s a b -> (a -> (r, b)) -> m r -- @ (%%=) :: MonadState s m => Over p ((,) r) s s a b -> p a (r, b) -> m r #if MIN_VERSION_mtl(2,1,1) l %%= f = State.state (l f) #else l %%= f = do (r, s) <- State.gets (l f) State.put s return r #endif {-# INLINE (%%=) #-} ------------------------------------------------------------------------------- -- General Purpose Combinators ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ < 710 -- | Passes the result of the left side to the function on the right side (forward pipe operator). -- -- This is the flipped version of ('$'), which is more common in languages like F# as (@|>@) where it is needed -- for inference. Here it is supplied for notational convenience and given a precedence that allows it -- to be nested inside uses of ('$'). -- -- >>> a & f -- f a -- -- >>> "hello" & length & succ -- 6 -- -- This combinator is commonly used when applying multiple 'Lens' operations in sequence. -- -- >>> ("hello","world") & _1.element 0 .~ 'j' & _1.element 4 .~ 'y' -- ("jelly","world") -- -- This reads somewhat similar to: -- -- >>> flip execState ("hello","world") $ do _1.element 0 .= 'j'; _1.element 4 .= 'y' -- ("jelly","world") (&) :: a -> (a -> b) -> b a & f = f a {-# INLINE (&) #-} infixl 1 & #endif -- | Infix flipped 'fmap'. -- -- @ -- ('<&>') = 'flip' 'fmap' -- @ (<&>) :: Functor f => f a -> (a -> b) -> f b as <&> f = f <$> as {-# INLINE (<&>) #-} -- | This is convenient to 'flip' argument order of composite functions defined as: -- -- @ -- fab ?? a = fmap ($ a) fab -- @ -- -- For the 'Functor' instance @f = ((->) r)@ you can reason about this function as if the definition was @('??') ≡ 'flip'@: -- -- >>> (h ?? x) a -- h a x -- -- >>> execState ?? [] $ modify (1:) -- [1] -- -- >>> over _2 ?? ("hello","world") $ length -- ("hello",5) -- -- >>> over ?? length ?? ("hello","world") $ _2 -- ("hello",5) (??) :: Functor f => f (a -> b) -> a -> f b fab ?? a = fmap ($ a) fab {-# INLINE (??) #-} ------------------------------------------------------------------------------- -- Common Lenses ------------------------------------------------------------------------------- -- | Lift a 'Lens' so it can run under a function (or other corepresentable profunctor). -- -- @ -- 'inside' :: 'Lens' s t a b -> 'Lens' (e -> s) (e -> t) (e -> a) (e -> b) -- @ -- -- -- >>> (\x -> (x-1,x+1)) ^. inside _1 $ 5 -- 4 -- -- >>> runState (modify (1:) >> modify (2:)) ^. (inside _2) $ [] -- [2,1] inside :: Corepresentable p => ALens s t a b -> Lens (p e s) (p e t) (p e a) (p e b) inside l f es = o <$> f i where i = cotabulate $ \ e -> ipos $ l sell (cosieve es e) o ea = cotabulate $ \ e -> ipeek (cosieve ea e) $ l sell (cosieve es e) {-# INLINE inside #-} {- -- | Lift a 'Lens' so it can run under a function (or any other corepresentable functor). insideF :: F.Representable f => ALens s t a b -> Lens (f s) (f t) (f a) (f b) insideF l f es = o <$> f i where i = F.tabulate $ \e -> ipos $ l sell (F.index es e) o ea = F.tabulate $ \ e -> ipeek (F.index ea e) $ l sell (F.index es e) {-# INLINE inside #-} -} -- | Merge two lenses, getters, setters, folds or traversals. -- -- @ -- 'chosen' ≡ 'choosing' 'id' 'id' -- @ -- -- @ -- 'choosing' :: 'Control.Lens.Getter.Getter' s a -> 'Control.Lens.Getter.Getter' s' a -> 'Control.Lens.Getter.Getter' ('Either' s s') a -- 'choosing' :: 'Control.Lens.Fold.Fold' s a -> 'Control.Lens.Fold.Fold' s' a -> 'Control.Lens.Fold.Fold' ('Either' s s') a -- 'choosing' :: 'Lens'' s a -> 'Lens'' s' a -> 'Lens'' ('Either' s s') a -- 'choosing' :: 'Control.Lens.Traversal.Traversal'' s a -> 'Control.Lens.Traversal.Traversal'' s' a -> 'Control.Lens.Traversal.Traversal'' ('Either' s s') a -- 'choosing' :: 'Control.Lens.Setter.Setter'' s a -> 'Control.Lens.Setter.Setter'' s' a -> 'Control.Lens.Setter.Setter'' ('Either' s s') a -- @ choosing :: Functor f => LensLike f s t a b -> LensLike f s' t' a b -> LensLike f (Either s s') (Either t t') a b choosing l _ f (Left a) = Left <$> l f a choosing _ r f (Right a') = Right <$> r f a' {-# INLINE choosing #-} -- | This is a 'Lens' that updates either side of an 'Either', where both sides have the same type. -- -- @ -- 'chosen' ≡ 'choosing' 'id' 'id' -- @ -- -- >>> Left a^.chosen -- a -- -- >>> Right a^.chosen -- a -- -- >>> Right "hello"^.chosen -- "hello" -- -- >>> Right a & chosen *~ b -- Right (a * b) -- -- @ -- 'chosen' :: 'Lens' ('Either' a a) ('Either' b b) a b -- 'chosen' f ('Left' a) = 'Left' '<$>' f a -- 'chosen' f ('Right' a) = 'Right' '<$>' f a -- @ chosen :: IndexPreservingLens (Either a a) (Either b b) a b chosen pafb = cotabulate $ \weaa -> cosieve (either id id `lmap` pafb) weaa <&> \b -> case extract weaa of Left _ -> Left b Right _ -> Right b {-# INLINE chosen #-} -- | 'alongside' makes a 'Lens' from two other lenses or a 'Getter' from two other getters -- by executing them on their respective halves of a product. -- -- >>> (Left a, Right b)^.alongside chosen chosen -- (a,b) -- -- >>> (Left a, Right b) & alongside chosen chosen .~ (c,d) -- (Left c,Right d) -- -- @ -- 'alongside' :: 'Lens' s t a b -> 'Lens' s' t' a' b' -> 'Lens' (s,s') (t,t') (a,a') (b,b') -- 'alongside' :: 'Getter' s t a b -> 'Getter' s' t' a' b' -> 'Getter' (s,s') (t,t') (a,a') (b,b') -- @ alongside :: LensLike (AlongsideLeft f b') s t a b -> LensLike (AlongsideRight f t) s' t' a' b' -> LensLike f (s, s') (t, t') (a, a') (b, b') alongside l1 l2 f (a1, a2) = getAlongsideRight $ l2 ?? a2 $ \b2 -> AlongsideRight $ getAlongsideLeft $ l1 ?? a1 $ \b1 -> AlongsideLeft $ f (b1,b2) {-# INLINE alongside #-} -- | This 'Lens' lets you 'view' the current 'pos' of any indexed -- store comonad and 'seek' to a new position. This reduces the API -- for working these instances to a single 'Lens'. -- -- @ -- 'ipos' w ≡ w 'Control.Lens.Getter.^.' 'locus' -- 'iseek' s w ≡ w '&' 'locus' 'Control.Lens.Setter..~' s -- 'iseeks' f w ≡ w '&' 'locus' 'Control.Lens.Setter.%~' f -- @ -- -- @ -- 'locus' :: 'Lens'' ('Context'' a s) a -- 'locus' :: 'Conjoined' p => 'Lens'' ('Pretext'' p a s) a -- 'locus' :: 'Conjoined' p => 'Lens'' ('PretextT'' p g a s) a -- @ locus :: IndexedComonadStore p => Lens (p a c s) (p b c s) a b locus f w = (`iseek` w) <$> f (ipos w) {-# INLINE locus #-} ------------------------------------------------------------------------------- -- Cloning Lenses ------------------------------------------------------------------------------- -- | Cloning a 'Lens' is one way to make sure you aren't given -- something weaker, such as a 'Control.Lens.Traversal.Traversal' and can be -- used as a way to pass around lenses that have to be monomorphic in @f@. -- -- Note: This only accepts a proper 'Lens'. -- -- >>> let example l x = set (cloneLens l) (x^.cloneLens l + 1) x in example _2 ("hello",1,"you") -- ("hello",2,"you") cloneLens :: ALens s t a b -> Lens s t a b cloneLens l afb s = runPretext (l sell s) afb {-# INLINE cloneLens #-} -- | Clone a 'Lens' as an 'IndexedPreservingLens' that just passes through whatever -- index is on any 'IndexedLens', 'IndexedFold', 'IndexedGetter' or 'IndexedTraversal' it is composed with. cloneIndexPreservingLens :: ALens s t a b -> IndexPreservingLens s t a b cloneIndexPreservingLens l pafb = cotabulate $ \ws -> runPretext (l sell (extract ws)) $ \a -> cosieve pafb (a <$ ws) {-# INLINE cloneIndexPreservingLens #-} -- | Clone an 'IndexedLens' as an 'IndexedLens' with the same index. cloneIndexedLens :: AnIndexedLens i s t a b -> IndexedLens i s t a b cloneIndexedLens l f s = runPretext (l sell s) (Indexed (indexed f)) {-# INLINE cloneIndexedLens #-} ------------------------------------------------------------------------------- -- Setting and Remembering ------------------------------------------------------------------------------- -- | Modify the target of a 'Lens' and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.%~') is more flexible. -- -- @ -- ('<%~') :: 'Lens' s t a b -> (a -> b) -> s -> (b, t) -- ('<%~') :: 'Control.Lens.Iso.Iso' s t a b -> (a -> b) -> s -> (b, t) -- ('<%~') :: 'Monoid' b => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> b) -> s -> (b, t) -- @ (<%~) :: LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t) l <%~ f = l $ (\t -> (t, t)) . f {-# INLINE (<%~) #-} -- | 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' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<+~') :: 'Num' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @ (<+~) :: Num a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <+~ a = l <%~ (+ a) {-# INLINE (<+~) #-} -- | 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' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<-~') :: 'Num' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @ (<-~) :: Num a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <-~ a = l <%~ subtract a {-# INLINE (<-~) #-} -- | Multiply the target of a numerically valued 'Lens' and return the result. -- -- When you do not need the result of the multiplication, ('Control.Lens.Setter.*~') is more -- flexible. -- -- @ -- ('<*~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<*~') :: 'Num' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @ (<*~) :: Num a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <*~ a = l <%~ (* a) {-# INLINE (<*~) #-} -- | 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. -- -- @ -- (' 'Lens'' s a -> a -> s -> (a, s) -- (' 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @ ( LensLike ((,)a) s t a a -> a -> s -> (a, t) l 'Lens'' s a -> e -> s -> (a, s) -- ('<^~') :: ('Num' a, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> s -> (a, s) -- @ (<^~) :: (Num a, Integral e) => LensLike ((,)a) s t a a -> e -> s -> (a, t) l <^~ e = l <%~ (^ e) {-# INLINE (<^~) #-} -- | Raise the target of a fractionally valued 'Lens' to an 'Integral' power -- and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.^^~') is more flexible. -- -- @ -- ('<^^~') :: ('Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s) -- ('<^^~') :: ('Fractional' a, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> s -> (a, s) -- @ (<^^~) :: (Fractional a, Integral e) => LensLike ((,)a) s t a a -> e -> s -> (a, t) l <^^~ e = l <%~ (^^ e) {-# INLINE (<^^~) #-} -- | Raise the target of a floating-point valued 'Lens' to an arbitrary power -- and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.**~') is more flexible. -- -- @ -- ('<**~') :: 'Floating' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<**~') :: 'Floating' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @ (<**~) :: Floating a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <**~ a = l <%~ (** a) {-# INLINE (<**~) #-} -- | 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. -- -- @ -- ('<||~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- ('<||~') :: 'Control.Lens.Iso.Iso'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- @ (<||~) :: LensLike ((,)Bool) s t Bool Bool -> Bool -> s -> (Bool, t) l <||~ b = l <%~ (|| b) {-# INLINE (<||~) #-} -- | 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. -- -- @ -- ('<&&~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- ('<&&~') :: 'Control.Lens.Iso.Iso'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- @ (<&&~) :: LensLike ((,)Bool) s t Bool Bool -> Bool -> s -> (Bool, t) l <&&~ b = l <%~ (&& b) {-# INLINE (<&&~) #-} -- | Modify the target of a 'Lens', but return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.%~') is more flexible. -- -- @ -- ('<<%~') :: 'Lens' s t a b -> (a -> b) -> s -> (a, t) -- ('<<%~') :: 'Control.Lens.Iso.Iso' s t a b -> (a -> b) -> s -> (a, t) -- ('<<%~') :: 'Monoid' a => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> b) -> s -> (a, t) -- @ (<<%~) :: LensLike ((,)a) s t a b -> (a -> b) -> s -> (a, t) (<<%~) l = l . lmap (\a -> (a, a)) . second' {-# INLINE (<<%~) #-} -- | Replace the target of a 'Lens', but return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter..~') is more flexible. -- -- @ -- ('<<.~') :: 'Lens' s t a b -> b -> s -> (a, t) -- ('<<.~') :: 'Control.Lens.Iso.Iso' s t a b -> b -> s -> (a, t) -- ('<<.~') :: 'Monoid' a => 'Control.Lens.Traversal.Traversal' s t a b -> b -> s -> (a, t) -- @ (<<.~) :: LensLike ((,)a) s t a b -> b -> s -> (a, t) l <<.~ b = l $ \a -> (a, b) {-# INLINE (<<.~) #-} -- | Increment the target of a numerically valued 'Lens' and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.+~') is more flexible. -- -- >>> (a,b) & _1 <<+~ c -- (a,(a + c,b)) -- -- >>> (a,b) & _2 <<+~ c -- (b,(a,b + c)) -- -- @ -- ('<<+~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<+~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s) -- @ (<<+~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<+~ b = l $ \a -> (a, a + b) {-# INLINE (<<+~) #-} -- | Decrement the target of a numerically valued 'Lens' and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.-~') is more flexible. -- -- >>> (a,b) & _1 <<-~ c -- (a,(a - c,b)) -- -- >>> (a,b) & _2 <<-~ c -- (b,(a,b - c)) -- -- @ -- ('<<-~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<-~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s) -- @ (<<-~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<-~ b = l $ \a -> (a, a - b) {-# INLINE (<<-~) #-} -- | Multiply the target of a numerically valued 'Lens' and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.-~') is more flexible. -- -- >>> (a,b) & _1 <<*~ c -- (a,(a * c,b)) -- -- >>> (a,b) & _2 <<*~ c -- (b,(a,b * c)) -- -- @ -- ('<<*~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<*~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s) -- @ (<<*~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<*~ b = l $ \a -> (a, a * b) {-# INLINE (<<*~) #-} -- | Divide the target of a numerically valued 'Lens' and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.//~') is more flexible. -- -- >>> (a,b) & _1 <>> ("Hawaii",10) & _2 < 'Lens'' s a -> a -> s -> (a, s) -- ('< 'Iso'' s a -> a -> s -> (a, s) -- @ (< LensLike' ((,) a) s a -> a -> s -> (a, s) l < (a, a / b) {-# INLINE (< 'Lens'' s a -> e -> s -> (a, s) -- ('<<^~') :: ('Num' a, 'Integral' e) => 'Iso'' s a -> e -> s -> (a, s) -- @ (<<^~) :: (Num a, Integral e) => LensLike' ((,) a) s a -> e -> s -> (a, s) l <<^~ e = l $ \a -> (a, a ^ e) {-# INLINE (<<^~) #-} -- | Raise the target of a fractionally valued 'Lens' to an integral power and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.^^~') is more flexible. -- -- @ -- ('<<^^~') :: ('Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s) -- ('<<^^~') :: ('Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> S -> (a, s) -- @ (<<^^~) :: (Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> s -> (a, s) l <<^^~ e = l $ \a -> (a, a ^^ e) {-# INLINE (<<^^~) #-} -- | Raise the target of a floating-point valued 'Lens' to an arbitrary power and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.**~') is more flexible. -- -- >>> (a,b) & _1 <<**~ c -- (a,(a**c,b)) -- -- >>> (a,b) & _2 <<**~ c -- (b,(a,b**c)) -- -- @ -- ('<<**~') :: 'Floating' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<**~') :: 'Floating' a => 'Iso'' s a -> a -> s -> (a, s) -- @ (<<**~) :: Floating a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<**~ e = l $ \a -> (a, a ** e) {-# INLINE (<<**~) #-} -- | Logically '||' the target of a 'Bool'-valued 'Lens' and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.||~') is more flexible. -- -- >>> (False,6) & _1 <<||~ True -- (False,(True,6)) -- -- >>> ("hello",True) & _2 <<||~ False -- (True,("hello",True)) -- -- @ -- ('<<||~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- ('<<||~') :: 'Iso'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- @ (<<||~) :: LensLike' ((,) Bool) s Bool -> Bool -> s -> (Bool, s) l <<||~ b = l $ \a -> (a, b || a) {-# INLINE (<<||~) #-} -- | Logically '&&' the target of a 'Bool'-valued 'Lens' and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.&&~') is more flexible. -- -- >>> (False,6) & _1 <<&&~ True -- (False,(False,6)) -- -- >>> ("hello",True) & _2 <<&&~ False -- (True,("hello",False)) -- -- @ -- ('<<&&~') :: 'Lens'' s Bool -> Bool -> s -> (Bool, s) -- ('<<&&~') :: 'Iso'' s Bool -> Bool -> s -> (Bool, s) -- @ (<<&&~) :: LensLike' ((,) Bool) s Bool -> Bool -> s -> (Bool, s) l <<&&~ b = l $ \a -> (a, b && a) {-# INLINE (<<&&~) #-} -- | Modify the target of a monoidally valued 'Lens' by 'mappend'ing a new value and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.<>~') is more flexible. -- -- >>> (Sum a,b) & _1 <<<>~ Sum c -- (Sum {getSum = a},(Sum {getSum = a + c},b)) -- -- >>> _2 <<<>~ ", 007" $ ("James", "Bond") -- ("Bond",("James","Bond, 007")) -- -- @ -- ('<<<>~') :: 'Monoid' r => 'Lens'' s r -> r -> s -> (r, s) -- ('<<<>~') :: 'Monoid' r => 'Iso'' s r -> r -> s -> (r, s) -- @ (<<<>~) :: Monoid r => LensLike' ((,) r) s r -> r -> s -> (r, s) l <<<>~ b = l $ \a -> (a, a `mappend` b) {-# INLINE (<<<>~) #-} ------------------------------------------------------------------------------- -- Setting and Remembering State ------------------------------------------------------------------------------- -- | 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' s m => 'Lens'' s a -> (a -> a) -> m a -- ('<%=') :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s a -> (a -> a) -> m a -- ('<%=') :: ('MonadState' s m, 'Monoid' a) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> a) -> m a -- @ (<%=) :: MonadState s m => LensLike ((,)b) s s a b -> (a -> b) -> m b l <%= f = l %%= (\b -> (b, b)) . f {-# INLINE (<%=) #-} -- | Add to the target of a numerically valued 'Lens' into your 'Monad''s state -- and return the result. -- -- When you do not need the result of the addition, ('Control.Lens.Setter.+=') is more -- flexible. -- -- @ -- ('<+=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a -- ('<+=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a -- @ (<+=) :: (MonadState s m, Num a) => LensLike' ((,)a) s a -> a -> m a l <+= a = l <%= (+ a) {-# INLINE (<+=) #-} -- | Subtract from the target of a numerically valued 'Lens' into your 'Monad''s -- state and return the result. -- -- When you do not need the result of the subtraction, ('Control.Lens.Setter.-=') is more -- flexible. -- -- @ -- ('<-=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a -- ('<-=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a -- @ (<-=) :: (MonadState s m, Num a) => LensLike' ((,)a) s a -> a -> m a l <-= a = l <%= subtract a {-# INLINE (<-=) #-} -- | Multiply the target of a numerically valued 'Lens' into your 'Monad''s -- state and return the result. -- -- When you do not need the result of the multiplication, ('Control.Lens.Setter.*=') is more -- flexible. -- -- @ -- ('<*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a -- ('<*=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a -- @ (<*=) :: (MonadState s m, Num a) => LensLike' ((,)a) s a -> a -> m a l <*= a = l <%= (* a) {-# INLINE (<*=) #-} -- | Divide the target of a fractionally valued 'Lens' into your 'Monad''s state -- and return the result. -- -- When you do not need the result of the division, ('Control.Lens.Setter.//=') is more flexible. -- -- @ -- (' 'Lens'' s a -> a -> m a -- (' 'Control.Lens.Iso.Iso'' s a -> a -> m a -- @ ( LensLike' ((,)a) s a -> a -> m a l 'Lens'' s a -> e -> m a -- ('<^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> m a -- @ (<^=) :: (MonadState s m, Num a, Integral e) => LensLike' ((,)a) s a -> e -> m a l <^= e = l <%= (^ e) {-# INLINE (<^=) #-} -- | Raise the target of a fractionally valued 'Lens' into your 'Monad''s state -- 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' s m, 'Fractional' b, 'Integral' e) => 'Lens'' s a -> e -> m a -- ('<^^=') :: ('MonadState' s m, 'Fractional' b, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> m a -- @ (<^^=) :: (MonadState s m, Fractional a, Integral e) => LensLike' ((,)a) s a -> e -> m a l <^^= e = l <%= (^^ e) {-# INLINE (<^^=) #-} -- | Raise the target of a floating-point valued 'Lens' into your 'Monad''s -- 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' s m, 'Floating' a) => 'Lens'' s a -> a -> m a -- ('<**=') :: ('MonadState' s m, 'Floating' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a -- @ (<**=) :: (MonadState s m, Floating a) => LensLike' ((,)a) s a -> a -> m a l <**= a = l <%= (** a) {-# INLINE (<**=) #-} -- | Logically '||' a Boolean valued 'Lens' into your 'Monad''s state and return -- the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.||=') is more flexible. -- -- @ -- ('<||=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m 'Bool' -- ('<||=') :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s 'Bool' -> 'Bool' -> m 'Bool' -- @ (<||=) :: MonadState s m => LensLike' ((,)Bool) s Bool -> Bool -> m Bool l <||= b = l <%= (|| b) {-# INLINE (<||=) #-} -- | Logically '&&' a Boolean valued 'Lens' into your 'Monad''s state and return -- the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.&&=') is more flexible. -- -- @ -- ('<&&=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m 'Bool' -- ('<&&=') :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s 'Bool' -> 'Bool' -> m 'Bool' -- @ (<&&=) :: MonadState s m => LensLike' ((,)Bool) s Bool -> Bool -> m Bool l <&&= b = l <%= (&& b) {-# INLINE (<&&=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by a user supplied -- function and return the /old/ value that was replaced. -- -- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the old values -- present. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.%=') is more flexible. -- -- @ -- ('<<%=') :: 'MonadState' s m => 'Lens'' s a -> (a -> a) -> m a -- ('<<%=') :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s a -> (a -> a) -> m a -- ('<<%=') :: ('MonadState' s m, 'Monoid' a) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> a) -> m a -- @ -- -- @('<<%=') :: 'MonadState' s m => 'LensLike' ((,)a) s s a b -> (a -> b) -> m a@ (<<%=) :: (Strong p, MonadState s m) => Over p ((,)a) s s a b -> p a b -> m a l <<%= f = l %%= lmap (\a -> (a,a)) (second' f) {-# INLINE (<<%=) #-} -- | Replace the target of a 'Lens' into your 'Monad''s state with a user supplied -- value and return the /old/ value that was replaced. -- -- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the old values -- present. -- -- When you do not need the result of the operation, ('Control.Lens.Setter..=') is more flexible. -- -- @ -- ('<<.=') :: 'MonadState' s m => 'Lens'' s a -> a -> m a -- ('<<.=') :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s a -> a -> m a -- ('<<.=') :: ('MonadState' s m, 'Monoid' t) => 'Control.Lens.Traversal.Traversal'' s a -> a -> m a -- @ (<<.=) :: MonadState s m => LensLike ((,)a) s s a b -> b -> m a l <<.= b = l %%= \a -> (a,b) {-# INLINE (<<.=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by adding a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.+=') is more flexible. -- -- @ -- ('<<+=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a -- ('<<+=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m a -- @ (<<+=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a l <<+= n = l %%= \a -> (a, a + n) {-# INLINE (<<+=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by subtracting a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.-=') is more flexible. -- -- @ -- ('<<-=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a -- ('<<-=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m a -- @ (<<-=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a l <<-= n = l %%= \a -> (a, a - n) {-# INLINE (<<-=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by multipling a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.*=') is more flexible. -- -- @ -- ('<<*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a -- ('<<*=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m a -- @ (<<*=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a l <<*= n = l %%= \a -> (a, a * n) {-# INLINE (<<*=) #-} -- | Modify the target of a 'Lens' into your 'Monad'\s state by dividing by a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.//=') is more flexible. -- -- @ -- ('< 'Lens'' s a -> a -> m a -- ('< 'Iso'' s a -> a -> m a -- @ (< LensLike' ((,) a) s a -> a -> m a l < (a, a / n) {-# INLINE (< 'Lens'' s a -> e -> m a -- ('<<^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Iso'' s a -> a -> m a -- @ (<<^=) :: (MonadState s m, Num a, Integral e) => LensLike' ((,) a) s a -> e -> m a l <<^= n = l %%= \a -> (a, a ^ n) {-# INLINE (<<^=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by raising it by an integral power -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.^^=') is more flexible. -- -- @ -- ('<<^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> m a -- ('<<^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> m a -- @ (<<^^=) :: (MonadState s m, Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> m a l <<^^= n = l %%= \a -> (a, a ^^ n) {-# INLINE (<<^^=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by raising it by an arbitrary power -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.**=') is more flexible. -- -- @ -- ('<<**=') :: ('MonadState' s m, 'Floating' a) => 'Lens'' s a -> a -> m a -- ('<<**=') :: ('MonadState' s m, 'Floating' a) => 'Iso'' s a -> a -> m a -- @ (<<**=) :: (MonadState s m, Floating a) => LensLike' ((,) a) s a -> a -> m a l <<**= n = l %%= \a -> (a, a ** n) {-# INLINE (<<**=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by taking its logical '||' with a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.||=') is more flexible. -- -- @ -- ('<<||=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m 'Bool' -- ('<<||=') :: 'MonadState' s m => 'Iso'' s 'Bool' -> 'Bool' -> m 'Bool' -- @ (<<||=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool l <<||= b = l %%= \a -> (a, a || b) {-# INLINE (<<||=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by taking its logical '&&' with a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.&&=') is more flexible. -- -- @ -- ('<<&&=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m 'Bool' -- ('<<&&=') :: 'MonadState' s m => 'Iso'' s 'Bool' -> 'Bool' -> m 'Bool' -- @ (<<&&=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool l <<&&= b = l %%= \a -> (a, a && b) {-# INLINE (<<&&=) #-} -- | Modify the target of a 'Lens' into your 'Monad''s state by 'mappend'ing a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>=') is more flexible. -- -- @ -- ('<<<>=') :: ('MonadState' s m, 'Monoid' r) => 'Lens'' s r -> r -> m r -- ('<<<>=') :: ('MonadState' s m, 'Monoid' r) => 'Iso'' s r -> r -> m r -- @ (<<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,) r) s r -> r -> m r l <<<>= b = l %%= \a -> (a, a `mappend` b) {-# INLINE (<<<>=) #-} -- | Run a monadic action, and set the target of 'Lens' to its result. -- -- @ -- ('<<~') :: 'MonadState' s m => 'Control.Lens.Iso.Iso' s s a b -> m b -> m b -- ('<<~') :: 'MonadState' s m => 'Lens' s s a b -> m b -> m b -- @ -- -- NB: This is limited to taking an actual 'Lens' than admitting a 'Control.Lens.Traversal.Traversal' because -- there are potential loss of state issues otherwise. (<<~) :: MonadState s m => ALens s s a b -> m b -> m b l <<~ mb = do b <- mb modify $ \s -> ipeek b (l sell s) return b {-# INLINE (<<~) #-} -- | 'mappend' a monoidal value onto the end of the target of a 'Lens' and -- return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>~') is more flexible. (<<>~) :: Monoid m => LensLike ((,)m) s t m m -> m -> s -> (m, t) l <<>~ m = l <%~ (`mappend` m) {-# INLINE (<<>~) #-} -- | 'mappend' a monoidal value onto the end of the target of a 'Lens' into -- your 'Monad''s state and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>=') is more flexible. (<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,)r) s r -> r -> m r l <<>= r = l <%= (`mappend` r) {-# INLINE (<<>=) #-} ------------------------------------------------------------------------------ -- Arrow operators ------------------------------------------------------------------------------ -- | 'Control.Lens.Setter.over' for Arrows. -- -- Unlike 'Control.Lens.Setter.over', 'overA' can't accept a simple -- 'Control.Lens.Setter.Setter', but requires a full lens, or close -- enough. -- -- @ -- overA :: Arrow ar => Lens s t a b -> ar a b -> ar s t -- @ overA :: Arrow ar => LensLike (Context a b) s t a b -> ar a b -> ar s t overA l p = arr (\s -> let (Context f a) = l sell s in (f, a)) >>> second p >>> arr (uncurry id) ------------------------------------------------------------------------------ -- Indexed ------------------------------------------------------------------------------ -- | Adjust the target of an 'IndexedLens' returning the intermediate result, or -- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' and return a monoidal summary -- along with the answer. -- -- @ -- l '<%~' f ≡ l '<%@~' 'const' f -- @ -- -- When you do not need access to the index then ('<%~') is more liberal in what it can accept. -- -- If you do not need the intermediate result, you can use ('Control.Lens.Setter.%@~') or even ('Control.Lens.Setter.%~'). -- -- @ -- ('<%@~') :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> (b, t) -- ('<%@~') :: 'Monoid' b => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> (b, t) -- @ (<%@~) :: Over (Indexed i) ((,) b) s t a b -> (i -> a -> b) -> s -> (b, t) l <%@~ f = l (Indexed $ \i a -> let b = f i a in (b, b)) {-# INLINE (<%@~) #-} -- | Adjust the target of an 'IndexedLens' returning the old value, or -- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' and return a monoidal summary -- of the old values along with the answer. -- -- @ -- ('<<%@~') :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> (a, t) -- ('<<%@~') :: 'Monoid' a => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> (a, t) -- @ (<<%@~) :: Over (Indexed i) ((,) a) s t a b -> (i -> a -> b) -> s -> (a, t) l <<%@~ f = l $ Indexed $ \i a -> second' (f i) (a,a) {-# INLINE (<<%@~) #-} -- | Adjust the target of an 'IndexedLens' returning a supplementary result, or -- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' and return a monoidal summary -- of the supplementary results and the answer. -- -- @ -- ('%%@~') ≡ 'Control.Lens.Indexed.withIndex' -- @ -- -- @ -- ('%%@~') :: 'Functor' f => 'IndexedLens' i s t a b -> (i -> a -> f b) -> s -> f t -- ('%%@~') :: 'Applicative' f => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> f b) -> s -> f t -- @ -- -- In particular, it is often useful to think of this function as having one of these even more -- restricted type signatures: -- -- @ -- ('%%@~') :: 'IndexedLens' i s t a b -> (i -> a -> (r, b)) -> s -> (r, t) -- ('%%@~') :: 'Monoid' r => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> (r, b)) -> s -> (r, t) -- @ (%%@~) :: IndexedLensLike i f s t a b -> (i -> a -> f b) -> s -> f t (%%@~) l = l .# Indexed {-# INLINE (%%@~) #-} -- | Adjust the target of an 'IndexedLens' returning a supplementary result, or -- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' within the current state, and -- return a monoidal summary of the supplementary results. -- -- @ -- l '%%@=' f ≡ 'state' (l '%%@~' f) -- @ -- -- @ -- ('%%@=') :: 'MonadState' s m => 'IndexedLens' i s s a b -> (i -> a -> (r, b)) -> s -> m r -- ('%%@=') :: ('MonadState' s m, 'Monoid' r) => 'Control.Lens.Traversal.IndexedTraversal' i s s a b -> (i -> a -> (r, b)) -> s -> m r -- @ (%%@=) :: MonadState s m => IndexedLensLike i ((,) r) s s a b -> (i -> a -> (r, b)) -> m r #if MIN_VERSION_mtl(2,1,0) l %%@= f = State.state (l %%@~ f) #else l %%@= f = do (r, s) <- State.gets (l %%@~ f) State.put s return r #endif {-# INLINE (%%@=) #-} -- | Adjust the target of an 'IndexedLens' returning the intermediate result, or -- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' within the current state, and -- return a monoidal summary of the intermediate results. -- -- @ -- ('<%@=') :: 'MonadState' s m => 'IndexedLens' i s s a b -> (i -> a -> b) -> m b -- ('<%@=') :: ('MonadState' s m, 'Monoid' b) => 'Control.Lens.Traversal.IndexedTraversal' i s s a b -> (i -> a -> b) -> m b -- @ (<%@=) :: MonadState s m => IndexedLensLike i ((,) b) s s a b -> (i -> a -> b) -> m b l <%@= f = l %%@= \ i a -> let b = f i a in (b, b) {-# INLINE (<%@=) #-} -- | Adjust the target of an 'IndexedLens' returning the old value, or -- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' within the current state, and -- return a monoidal summary of the old values. -- -- @ -- ('<<%@=') :: 'MonadState' s m => 'IndexedLens' i s s a b -> (i -> a -> b) -> m a -- ('<<%@=') :: ('MonadState' s m, 'Monoid' b) => 'Control.Lens.Traversal.IndexedTraversal' i s s a b -> (i -> a -> b) -> m a -- @ (<<%@=) :: MonadState s m => IndexedLensLike i ((,) a) s s a b -> (i -> a -> b) -> m a #if MIN_VERSION_mtl(2,1,0) l <<%@= f = State.state (l (Indexed $ \ i a -> (a, f i a))) #else l <<%@= f = do (r, s) <- State.gets (l (Indexed $ \ i a -> (a, f i a))) State.put s return r #endif {-# INLINE (<<%@=) #-} ------------------------------------------------------------------------------ -- ALens Combinators ------------------------------------------------------------------------------ -- | A version of ('Control.Lens.Getter.^.') that works on 'ALens'. -- -- >>> ("hello","world")^#_2 -- "world" (^#) :: s -> ALens s t a b -> a s ^# l = ipos (l sell s) {-# INLINE (^#) #-} -- | A version of 'Control.Lens.Setter.set' that works on 'ALens'. -- -- >>> storing _2 "world" ("hello","there") -- ("hello","world") storing :: ALens s t a b -> b -> s -> t storing l b s = ipeek b (l sell s) {-# INLINE storing #-} -- | A version of ('Control.Lens.Setter..~') that works on 'ALens'. -- -- >>> ("hello","there") & _2 #~ "world" -- ("hello","world") ( #~ ) :: ALens s t a b -> b -> s -> t ( #~ ) l b s = ipeek b (l sell s) {-# INLINE ( #~ ) #-} -- | A version of ('Control.Lens.Setter.%~') that works on 'ALens'. -- -- >>> ("hello","world") & _2 #%~ length -- ("hello",5) ( #%~ ) :: ALens s t a b -> (a -> b) -> s -> t ( #%~ ) l f s = ipeeks f (l sell s) {-# INLINE ( #%~ ) #-} -- | A version of ('%%~') that works on 'ALens'. -- -- >>> ("hello","world") & _2 #%%~ \x -> (length x, x ++ "!") -- (5,("hello","world!")) ( #%%~ ) :: Functor f => ALens s t a b -> (a -> f b) -> s -> f t ( #%%~ ) l f s = runPretext (l sell s) f {-# INLINE ( #%%~ ) #-} -- | A version of ('Control.Lens.Setter..=') that works on 'ALens'. ( #= ) :: MonadState s m => ALens s s a b -> b -> m () l #= f = modify (l #~ f) {-# INLINE ( #= ) #-} -- | A version of ('Control.Lens.Setter.%=') that works on 'ALens'. ( #%= ) :: MonadState s m => ALens s s a b -> (a -> b) -> m () l #%= f = modify (l #%~ f) {-# INLINE ( #%= ) #-} -- | A version of ('<%~') that works on 'ALens'. -- -- >>> ("hello","world") & _2 <#%~ length -- (5,("hello",5)) (<#%~) :: ALens s t a b -> (a -> b) -> s -> (b, t) l <#%~ f = \s -> runPretext (l sell s) $ \a -> let b = f a in (b, b) {-# INLINE (<#%~) #-} -- | A version of ('<%=') that works on 'ALens'. (<#%=) :: MonadState s m => ALens s s a b -> (a -> b) -> m b l <#%= f = l #%%= \a -> let b = f a in (b, b) {-# INLINE (<#%=) #-} -- | A version of ('%%=') that works on 'ALens'. ( #%%= ) :: MonadState s m => ALens s s a b -> (a -> (r, b)) -> m r #if MIN_VERSION_mtl(2,1,1) l #%%= f = State.state $ \s -> runPretext (l sell s) f #else l #%%= f = do p <- State.gets (l sell) let (r, t) = runPretext p f State.put t return r #endif {-# INLINE ( #%%= ) #-} -- | A version of ('Control.Lens.Setter.<.~') that works on 'ALens'. -- -- >>> ("hello","there") & _2 <#~ "world" -- ("world",("hello","world")) (<#~) :: ALens s t a b -> b -> s -> (b, t) l <#~ b = \s -> (b, storing l b s) {-# INLINE (<#~) #-} -- | A version of ('Control.Lens.Setter.<.=') that works on 'ALens'. (<#=) :: MonadState s m => ALens s s a b -> b -> m b l <#= b = do l #= b return b {-# INLINE (<#=) #-} -- | There is a field for every type in the 'Void'. Very zen. -- -- >>> [] & mapped.devoid +~ 1 -- [] -- -- >>> Nothing & mapped.devoid %~ abs -- Nothing -- -- @ -- 'devoid' :: 'Lens'' 'Void' a -- @ devoid :: Over p f Void Void a b devoid _ = absurd {-# INLINE devoid #-} -- | We can always retrieve a @()@ from any type. -- -- >>> "hello"^.united -- () -- -- >>> "hello" & united .~ () -- "hello" united :: Lens' a () united f v = f () <&> \ () -> v {-# INLINE united #-} -- | Fuse a composition of lenses using 'Yoneda' to provide 'fmap' fusion. -- -- In general, given a pair of lenses 'foo' and 'bar' -- -- @ -- fusing (foo.bar) = foo.bar -- @ -- -- however, @foo@ and @bar@ are either going to 'fmap' internally or they are trivial. -- -- 'fusing' exploits the 'Yoneda' lemma to merge these separate uses into a single 'fmap'. -- -- This is particularly effective when the choice of functor 'f' is unknown at compile -- time or when the 'Lens' @foo.bar@ in the above description is recursive or complex -- enough to prevent inlining. -- -- @ -- 'fusing' :: 'Lens' s t a b -> 'Lens' s t a b -- @ fusing :: Functor f => LensLike (Yoneda f) s t a b -> LensLike f s t a b fusing t = \f -> lowerYoneda . t (liftYoneda . f) {-# INLINE fusing #-} lens-4.14/src/Control/Lens/Level.hs0000644000000000000000000001177612710476104015322 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Level -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- This module provides combinators for breadth-first searching within -- arbitrary traversals. ---------------------------------------------------------------------------- module Control.Lens.Level ( Level , levels , ilevels ) where import Control.Applicative import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed import Control.Lens.Internal.Level import Control.Lens.Traversal import Data.Profunctor.Unsafe -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Data.Char levelIns :: Bazaar (->) a b t -> [Level () a] levelIns = go 0 . (getConst #. bazaar (rmapConst (deepening ()))) where go k z = k `seq` runDeepening z k $ \ xs b -> xs : if b then (go $! k + 1) z else [] {-# INLINE levelIns #-} levelOuts :: Bazaar (->) a b t -> [Level j b] -> t levelOuts bz = runFlows $ runBazaar bz $ \ _ -> Flows $ \t -> case t of One _ a : _ -> a _ -> error "levelOuts: wrong shape" {-# INLINE levelOuts #-} -- | This provides a breadth-first 'Traversal' of the individual 'levels' of any other 'Traversal' -- via iterative deepening depth-first search. The levels are returned to you in a compressed format. -- -- This can permit us to extract the 'levels' directly: -- -- >>> ["hello","world"]^..levels (traverse.traverse) -- [Zero,Zero,One () 'h',Two 0 (One () 'e') (One () 'w'),Two 0 (One () 'l') (One () 'o'),Two 0 (One () 'l') (One () 'r'),Two 0 (One () 'o') (One () 'l'),One () 'd'] -- -- But we can also traverse them in turn: -- -- >>> ["hello","world"]^..levels (traverse.traverse).traverse -- "hewlolrold" -- -- We can use this to traverse to a fixed depth in the tree of ('<*>') used in the 'Traversal': -- -- >>> ["hello","world"] & taking 4 (levels (traverse.traverse)).traverse %~ toUpper -- ["HEllo","World"] -- -- Or we can use it to traverse the first @n@ elements in found in that 'Traversal' regardless of the depth -- at which they were found. -- -- >>> ["hello","world"] & taking 4 (levels (traverse.traverse).traverse) %~ toUpper -- ["HELlo","World"] -- -- The resulting 'Traversal' of the 'levels' which is indexed by the depth of each 'Level'. -- -- >>> ["dog","cat"]^@..levels (traverse.traverse) <. traverse -- [(2,'d'),(3,'o'),(3,'c'),(4,'g'),(4,'a'),(5,'t')] -- -- /Note:/ Internally this is implemented by using an illegal 'Applicative', as it extracts information -- in an order that violates the 'Applicative' laws. levels :: ATraversal s t a b -> IndexedTraversal Int s t (Level () a) (Level () b) levels l f s = levelOuts bz <$> traversed f (levelIns bz) where bz = l sell s {-# INLINE levels #-} -- This is only a temporary work around added to deal with a bug in an unreleased version -- of GHC 7.10. We should remove it as soon as we're able. rmapConst :: Profunctor p => p a b -> p a (Const b x) rmapConst p = Const #. p {-# INLINE rmapConst #-} ilevelIns :: Bazaar (Indexed i) a b t -> [Level i a] ilevelIns = go 0 . (getConst #. bazaar (Indexed $ \ i -> rmapConst (deepening i))) where go k z = k `seq` runDeepening z k $ \ xs b -> xs : if b then (go $! k + 1) z else [] {-# INLINE ilevelIns #-} ilevelOuts :: Bazaar (Indexed i) a b t -> [Level j b] -> t ilevelOuts bz = runFlows $ runBazaar bz $ Indexed $ \ _ _ -> Flows $ \t -> case t of One _ a : _ -> a _ -> error "ilevelOuts: wrong shape" {-# INLINE ilevelOuts #-} -- | This provides a breadth-first 'Traversal' of the individual levels of any other 'Traversal' -- via iterative deepening depth-first search. The levels are returned to you in a compressed format. -- -- This is similar to 'levels', but retains the index of the original 'IndexedTraversal', so you can -- access it when traversing the levels later on. -- -- >>> ["dog","cat"]^@..ilevels (traversed<.>traversed).itraversed -- [((0,0),'d'),((0,1),'o'),((1,0),'c'),((0,2),'g'),((1,1),'a'),((1,2),'t')] -- -- The resulting 'Traversal' of the levels which is indexed by the depth of each 'Level'. -- -- >>> ["dog","cat"]^@..ilevels (traversed<.>traversed)<.>itraversed -- [((2,(0,0)),'d'),((3,(0,1)),'o'),((3,(1,0)),'c'),((4,(0,2)),'g'),((4,(1,1)),'a'),((5,(1,2)),'t')] -- -- /Note:/ Internally this is implemented by using an illegal 'Applicative', as it extracts information -- in an order that violates the 'Applicative' laws. ilevels :: AnIndexedTraversal i s t a b -> IndexedTraversal Int s t (Level i a) (Level j b) ilevels l f s = ilevelOuts bz <$> traversed f (ilevelIns bz) where bz = l sell s {-# INLINE ilevels #-} lens-4.14/src/Control/Lens/Operators.hs0000644000000000000000000000416112710476104016217 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Operators -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module exists for users who like to work with qualified imports -- but want access to the operators from Lens. -- -- > import qualified Control.Lens as L -- > import Control.Lens.Operators ---------------------------------------------------------------------------- module Control.Lens.Operators ( -- output from scripts/operators -h -- * "Control.Lens.Cons" (<|) , (|>) -- * "Control.Lens.Fold" , (^..) , (^?) , (^?!) , (^@..) , (^@?) , (^@?!) -- * "Control.Lens.Getter" , (^.) , (^@.) -- * "Control.Lens.Indexed" , (<.) , (.>) , (<.>) -- * "Control.Lens.Lens" , (%%~) , (%%=) , (&) , (&~) , (<&>) , (??) , (<%~) , (<+~) , (<-~) , (<*~) , (~) , (<%=) , (<+=) , (<-=) , (<*=) , (=) , (<<~) , (<<>~) , (<<>=) , (<%@~) , (<<%@~) , (%%@~) , (%%@=) , (<%@=) , (<<%@=) , (^#) , ( #~ ) , ( #%~ ) , ( #%%~ ) , ( #= ) , ( #%= ) , (<#%~) , (<#%=) , ( #%%= ) , (<#~) , (<#=) -- * "Control.Lens.Plated" , (...) -- * "Control.Lens.Review" , ( # ) -- * "Control.Lens.Setter" , (%~) , (.~) , (?~) , (<.~) , (~) , (<>=) , (%@~) , (%@=) ) where import Control.Lens lens-4.14/src/Control/Lens/Plated.hs0000644000000000000000000006572612710476104015470 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-} #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-} #define OVERLAPPING_PRAGMA #else #define OVERLAPPING_PRAGMA {-# OVERLAPPING #-} #endif #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} -- template-haskell #endif #ifndef MIN_VERSION_template_haskell #define MIN_VERSION_template_haskell(x,y,z) 1 #endif #ifndef MIN_VERSION_free #define MIN_VERSION_free(x,y,z) 1 #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Plated -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- The name \"plate\" stems originally from \"boilerplate\", which was the term -- used by the \"Scrap Your Boilerplate\" papers, and later inherited by Neil -- Mitchell's \"Uniplate\". -- -- -- -- The combinators in here are designed to be compatible with and subsume the -- @uniplate@ API with the notion of a 'Traversal' replacing -- a 'Data.Data.Lens.uniplate' or 'Data.Data.Lens.biplate'. -- -- By implementing these combinators in terms of 'plate' instead of -- 'Data.Data.Lens.uniplate' additional type safety is gained, as the user is -- no longer responsible for maintaining invariants such as the number of -- children they received. -- -- Note: The @Biplate@ is /deliberately/ excluded from the API here, with the -- intention that you replace them with either explicit traversals, or by using the -- @On@ variants of the combinators below with 'Data.Data.Lens.biplate' from -- @Data.Data.Lens@. As a design, it forced the user into too many situations where -- they had to choose between correctness and ease of use, and it was brittle in the -- face of competing imports. -- -- The sensible use of these combinators makes some simple assumptions. Notably, any -- of the @On@ combinators are expecting a 'Traversal', 'Setter' or 'Fold' -- to play the role of the 'Data.Data.Lens.biplate' combinator, and so when the -- types of the contents and the container match, they should be the 'id' 'Traversal', -- 'Setter' or 'Fold'. -- -- It is often beneficial to use the combinators in this module with the combinators -- from @Data.Data.Lens@ or @GHC.Generics.Lens@ to make it easier to automatically -- derive definitions for 'plate', or to derive custom traversals. ------------------------------------------------------------------------------- module Control.Lens.Plated ( -- * Uniplate Plated(..) -- * Uniplate Combinators , children , rewrite, rewriteOf, rewriteOn, rewriteOnOf , rewriteM, rewriteMOf, rewriteMOn, rewriteMOnOf , universe, universeOf, universeOn, universeOnOf , cosmos, cosmosOf, cosmosOn, cosmosOnOf , transform, transformOf, transformOn, transformOnOf , transformM, transformMOf, transformMOn, transformMOnOf , contexts, contextsOf, contextsOn, contextsOnOf , holes, holesOn, holesOnOf , para, paraOf , (...), deep -- * Compos -- $compos , composOpFold -- * Parts , parts -- * Generics , gplate , GPlated ) where import Control.Applicative import Control.Comonad.Cofree import qualified Control.Comonad.Trans.Cofree as CoTrans import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Indexed import Control.Lens.Internal.Context import Control.Lens.Type import Control.Lens.Setter import Control.Lens.Traversal import Control.Monad.Free as Monad import Control.Monad.Free.Church as Church import Control.Monad.Trans.Free as Trans #if !(MIN_VERSION_free(4,6,0)) import Control.MonadPlus.Free as MonadPlus #endif import qualified Language.Haskell.TH as TH import Data.Data import Data.Data.Lens import Data.Monoid import Data.Tree import GHC.Generics #ifdef HLINT {-# ANN module "HLint: ignore Reduce duplication" #-} #endif -- | A 'Plated' type is one where we know how to extract its immediate self-similar children. -- -- /Example 1/: -- -- @ -- import Control.Applicative -- import Control.Lens -- import Control.Lens.Plated -- import Data.Data -- import Data.Data.Lens ('Data.Data.Lens.uniplate') -- @ -- -- @ -- data Expr -- = Val 'Int' -- | Neg Expr -- | Add Expr Expr -- deriving ('Eq','Ord','Show','Read','Data','Typeable') -- @ -- -- @ -- instance 'Plated' Expr where -- 'plate' f (Neg e) = Neg '<$>' f e -- 'plate' f (Add a b) = Add '<$>' f a '<*>' f b -- 'plate' _ a = 'pure' a -- @ -- -- /or/ -- -- @ -- instance 'Plated' Expr where -- 'plate' = 'Data.Data.Lens.uniplate' -- @ -- -- /Example 2/: -- -- @ -- import Control.Applicative -- import Control.Lens -- import Control.Lens.Plated -- import Data.Data -- import Data.Data.Lens ('Data.Data.Lens.uniplate') -- @ -- -- @ -- data Tree a -- = Bin (Tree a) (Tree a) -- | Tip a -- deriving ('Eq','Ord','Show','Read','Data','Typeable') -- @ -- -- @ -- instance 'Plated' (Tree a) where -- 'plate' f (Bin l r) = Bin '<$>' f l '<*>' f r -- 'plate' _ t = 'pure' t -- @ -- -- /or/ -- -- @ -- instance 'Data' a => 'Plated' (Tree a) where -- 'plate' = 'uniplate' -- @ -- -- Note the big distinction between these two implementations. -- -- The former will only treat children directly in this tree as descendents, -- the latter will treat trees contained in the values under the tips also -- as descendants! -- -- When in doubt, pick a 'Traversal' and just use the various @...Of@ combinators -- rather than pollute 'Plated' with orphan instances! -- -- If you want to find something unplated and non-recursive with 'Data.Data.Lens.biplate' -- 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' -- @ -- -- This same ability to explicitly pass the 'Traversal' in question is why there is no -- analogue to uniplate's @Biplate@. -- -- Moreover, since we can allow custom traversals, we implement reasonable defaults for -- polymorphic data types, that only 'Control.Traversable.traverse' into themselves, and /not/ their -- polymorphic arguments. class Plated a where -- | 'Traversal' of the immediate children of this structure. -- -- If you're using GHC 7.2 or newer and your type has a 'Data' instance, -- 'plate' will default to 'uniplate' and you can choose to not override -- it with your own definition. plate :: Traversal' a a default plate :: Data a => Traversal' a a plate = uniplate instance Plated [a] where plate f (x:xs) = (x:) <$> f xs plate _ [] = pure [] instance Traversable f => Plated (Monad.Free f a) where plate f (Monad.Free as) = Monad.Free <$> traverse f as plate _ x = pure x instance (Traversable f, Traversable m) => Plated (Trans.FreeT f m a) where plate f (Trans.FreeT xs) = Trans.FreeT <$> traverse (traverse f) xs #if !(MIN_VERSION_free(4,6,0)) instance Traversable f => Plated (MonadPlus.Free f a) where plate f (MonadPlus.Free as) = MonadPlus.Free <$> traverse f as plate f (MonadPlus.Plus as) = MonadPlus.Plus <$> traverse f as plate _ x = pure x #endif instance Traversable f => Plated (Church.F f a) where plate f = fmap Church.toF . plate (fmap Church.fromF . f . Church.toF) . Church.fromF -- -- This one can't work -- -- instance (Traversable f, Traversable m) => Plated (ChurchT.FT f m a) where -- plate f = fmap ChurchT.toFT . plate (fmap ChurchT.fromFT . f . ChurchT.toFT) . ChurchT.fromFT instance (Traversable f, Traversable w) => Plated (CoTrans.CofreeT f w a) where plate f (CoTrans.CofreeT xs) = CoTrans.CofreeT <$> traverse (traverse f) xs instance Traversable f => Plated (Cofree f a) where plate f (a :< as) = (:<) a <$> traverse f as instance Plated (Tree a) where plate f (Node a as) = Node a <$> traverse f as {- Default uniplate instances -} instance Plated TH.Exp instance Plated TH.Dec instance Plated TH.Con instance Plated TH.Type #if !(MIN_VERSION_template_haskell(2,8,0)) instance Plated TH.Kind -- in 2.8 Kind is an alias for Type #endif instance Plated TH.Stmt instance Plated TH.Pat infixr 9 ... -- | Compose through a plate (...) :: (Applicative f, Plated c) => LensLike f s t c c -> Over p f c c a b -> Over p f s t a b l ... m = l . plate . m {-# INLINE (...) #-} -- | Try to apply a traversal to all transitive descendants of a 'Plated' container, but -- do not recurse through matching descendants. -- -- @ -- 'deep' :: 'Plated' s => 'Fold' s a -> 'Fold' s a -- 'deep' :: 'Plated' s => 'IndexedFold' s a -> 'IndexedFold' s a -- 'deep' :: 'Plated' s => 'Traversal' s s a b -> 'Traversal' s s a b -- 'deep' :: 'Plated' s => 'IndexedTraversal' s s a b -> 'IndexedTraversal' s s a b -- @ deep :: (Conjoined p, Applicative f, Plated s) => Traversing p f s s a b -> Over p f s s a b deep = deepOf plate ------------------------------------------------------------------------------- -- Children ------------------------------------------------------------------------------- -- | Extract the immediate descendants of a 'Plated' container. -- -- @ -- 'children' ≡ 'toListOf' 'plate' -- @ children :: Plated a => a -> [a] children = toListOf plate {-# INLINE children #-} ------------------------------------------------------------------------------- -- Rewriting ------------------------------------------------------------------------------- -- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot -- be applied anywhere in the result: -- -- @ -- propRewrite r x = 'all' ('Data.Just.isNothing' '.' r) ('universe' ('rewrite' r x)) -- @ -- -- Usually 'transform' is more appropriate, but 'rewrite' can give better -- compositionality. Given two single transformations @f@ and @g@, you can -- construct @\a -> f a `mplus` g a@ which performs both rewrites until a fixed point. rewrite :: Plated a => (a -> Maybe a) -> a -> a rewrite = rewriteOf plate {-# INLINE rewrite #-} -- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot -- be applied anywhere in the result: -- -- @ -- propRewriteOf l r x = 'all' ('Data.Just.isNothing' '.' r) ('universeOf' l ('rewriteOf' l r x)) -- @ -- -- Usually 'transformOf' is more appropriate, but 'rewriteOf' can give better -- compositionality. Given two single transformations @f@ and @g@, you can -- construct @\a -> f a `mplus` g a@ which performs both rewrites until a fixed point. -- -- @ -- 'rewriteOf' :: 'Control.Lens.Iso.Iso'' a a -> (a -> 'Maybe' a) -> a -> a -- 'rewriteOf' :: 'Lens'' a a -> (a -> 'Maybe' a) -> a -> a -- 'rewriteOf' :: 'Traversal'' a a -> (a -> 'Maybe' a) -> a -> a -- 'rewriteOf' :: 'Setter'' a a -> (a -> 'Maybe' a) -> a -> a -- @ rewriteOf :: ASetter' a a -> (a -> Maybe a) -> a -> a rewriteOf l f = go where go = transformOf l (\x -> maybe x go (f x)) {-# INLINE rewriteOf #-} -- | Rewrite recursively over part of a larger structure. -- -- @ -- 'rewriteOn' :: 'Plated' a => 'Control.Lens.Iso.Iso'' s a -> (a -> 'Maybe' a) -> s -> s -- 'rewriteOn' :: 'Plated' a => 'Lens'' s a -> (a -> 'Maybe' a) -> s -> s -- 'rewriteOn' :: 'Plated' a => 'Traversal'' s a -> (a -> 'Maybe' a) -> s -> s -- 'rewriteOn' :: 'Plated' a => 'ASetter'' s a -> (a -> 'Maybe' a) -> s -> s -- @ rewriteOn :: Plated a => ASetter s t a a -> (a -> Maybe a) -> s -> t rewriteOn b = over b . rewrite {-# INLINE rewriteOn #-} -- | Rewrite recursively over part of a larger structure using a specified 'Setter'. -- -- @ -- 'rewriteOnOf' :: 'Control.Lens.Iso.Iso'' s a -> 'Control.Lens.Iso.Iso'' a a -> (a -> 'Maybe' a) -> s -> s -- 'rewriteOnOf' :: 'Lens'' s a -> 'Lens'' a a -> (a -> 'Maybe' a) -> s -> s -- 'rewriteOnOf' :: 'Traversal'' s a -> 'Traversal'' a a -> (a -> 'Maybe' a) -> s -> s -- 'rewriteOnOf' :: 'Setter'' s a -> 'Setter'' a a -> (a -> 'Maybe' a) -> s -> s -- @ rewriteOnOf :: ASetter s t a a -> ASetter' a a -> (a -> Maybe a) -> s -> t rewriteOnOf b l = over b . rewriteOf l {-# INLINE rewriteOnOf #-} -- | Rewrite by applying a monadic rule everywhere you can. Ensures that the rule cannot -- be applied anywhere in the result. rewriteM :: (Monad m, Plated a) => (a -> m (Maybe a)) -> a -> m a rewriteM = rewriteMOf plate {-# INLINE rewriteM #-} -- | Rewrite by applying a monadic rule everywhere you recursing with a user-specified 'Traversal'. -- Ensures that the rule cannot be applied anywhere in the result. rewriteMOf :: Monad m => LensLike' (WrappedMonad m) a a -> (a -> m (Maybe a)) -> a -> m a rewriteMOf l f = go where go = transformMOf l (\x -> f x >>= maybe (return x) go) {-# INLINE rewriteMOf #-} -- | Rewrite by applying a monadic rule everywhere inside of a structure located by a user-specified 'Traversal'. -- Ensures that the rule cannot be applied anywhere in the result. rewriteMOn :: (Monad m, Plated a) => LensLike (WrappedMonad m) s t a a -> (a -> m (Maybe a)) -> s -> m t rewriteMOn b = mapMOf b . rewriteM {-# INLINE rewriteMOn #-} -- | Rewrite by applying a monadic rule everywhere inside of a structure located by a user-specified 'Traversal', -- using a user-specified 'Traversal' for recursion. Ensures that the rule cannot be applied anywhere in the result. rewriteMOnOf :: Monad m => LensLike (WrappedMonad m) s t a a -> LensLike' (WrappedMonad m) a a -> (a -> m (Maybe a)) -> s -> m t rewriteMOnOf b l = mapMOf b . rewriteMOf l {-# INLINE rewriteMOnOf #-} ------------------------------------------------------------------------------- -- Universe ------------------------------------------------------------------------------- -- | Retrieve all of the transitive descendants of a 'Plated' container, including itself. universe :: Plated a => a -> [a] universe = universeOf plate {-# INLINE universe #-} -- | 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 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 a => Getting [a] s a -> s -> [a] 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 [a] s a -> Getting [a] a a -> s -> [a] universeOnOf b = foldMapOf b . universeOf {-# INLINE universeOnOf #-} -- | Fold over all transitive descendants of a 'Plated' container, including itself. cosmos :: Plated a => Fold a a cosmos = cosmosOf plate {-# INLINE cosmos #-} -- | Given a 'Fold' that knows how to locate immediate children, fold all of the transitive descendants of a node, including itself. -- -- @ -- 'cosmosOf' :: 'Fold' a a -> 'Fold' a a -- @ cosmosOf :: (Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a cosmosOf d f s = f s *> d (cosmosOf d f) s {-# INLINE cosmosOf #-} -- | Given a 'Fold' that knows how to find 'Plated' parts of a container fold them and all of their descendants, recursively. -- -- @ -- 'cosmosOn' :: 'Plated' a => 'Fold' s a -> 'Fold' s a -- @ cosmosOn :: (Applicative f, Contravariant f, Plated a) => LensLike' f s a -> LensLike' f s a cosmosOn d = cosmosOnOf d plate {-# INLINE cosmosOn #-} -- | Given a 'Fold' that knows how to locate immediate children, fold all of the transitive descendants of a node, including itself that lie -- in a region indicated by another 'Fold'. -- -- @ -- 'cosmosOnOf' :: 'Fold' s a -> 'Fold' a a -> 'Fold' s a -- @ cosmosOnOf :: (Applicative f, Contravariant f) => LensLike' f s a -> LensLike' f a a -> LensLike' f s a cosmosOnOf d p = d . cosmosOf p {-# INLINE cosmosOnOf #-} ------------------------------------------------------------------------------- -- Transformation ------------------------------------------------------------------------------- -- | Transform every element in the tree, in a bottom-up manner. -- -- For example, replacing negative literals with literals: -- -- @ -- negLits = 'transform' $ \\x -> case x of -- Neg (Lit i) -> Lit ('negate' i) -- _ -> x -- @ transform :: Plated a => (a -> a) -> a -> a transform = transformOf plate {-# INLINE transform #-} -- | Transform every element in the tree in a bottom-up manner over a region indicated by a 'Setter'. -- -- @ -- 'transformOn' :: 'Plated' a => 'Traversal'' s a -> (a -> a) -> s -> s -- 'transformOn' :: 'Plated' a => 'Setter'' s a -> (a -> a) -> s -> s -- @ transformOn :: Plated a => ASetter s t a a -> (a -> a) -> s -> t transformOn b = over b . transform {-# INLINE transformOn #-} -- | Transform every element by recursively applying a given 'Setter' in a bottom-up manner. -- -- @ -- 'transformOf' :: 'Traversal'' a a -> (a -> a) -> a -> a -- 'transformOf' :: 'Setter'' a a -> (a -> a) -> a -> a -- @ transformOf :: ASetter' a a -> (a -> a) -> a -> a transformOf l f = go where go = f . over l go {-# INLINE transformOf #-} -- | Transform every element in a region indicated by a 'Setter' by recursively applying another 'Setter' -- in a bottom-up manner. -- -- @ -- 'transformOnOf' :: 'Setter'' s a -> 'Traversal'' a a -> (a -> a) -> s -> s -- 'transformOnOf' :: 'Setter'' s a -> 'Setter'' a a -> (a -> a) -> s -> s -- @ transformOnOf :: ASetter s t a a -> ASetter' a a -> (a -> a) -> s -> t transformOnOf b l = over b . transformOf l {-# INLINE transformOnOf #-} -- | Transform every element in the tree, in a bottom-up manner, monadically. transformM :: (Monad m, Plated a) => (a -> m a) -> a -> m a transformM = transformMOf plate {-# INLINE transformM #-} -- | Transform every element in the tree in a region indicated by a supplied 'Traversal', in a bottom-up manner, monadically. -- -- @ -- 'transformMOn' :: ('Monad' m, 'Plated' a) => 'Traversal'' s a -> (a -> m a) -> s -> m s -- @ transformMOn :: (Monad m, Plated a) => LensLike (WrappedMonad m) s t a a -> (a -> m a) -> s -> m t transformMOn b = mapMOf b . transformM {-# INLINE transformMOn #-} -- | Transform every element in a tree using a user supplied 'Traversal' in a bottom-up manner with a monadic effect. -- -- @ -- 'transformMOf' :: 'Monad' m => 'Traversal'' a a -> (a -> m a) -> a -> m a -- @ transformMOf :: Monad m => LensLike' (WrappedMonad m) a a -> (a -> m a) -> a -> m a transformMOf l f = go where go t = mapMOf l go t >>= f {-# INLINE transformMOf #-} -- | Transform every element in a tree that lies in a region indicated by a supplied 'Traversal', walking with a user supplied 'Traversal' in -- a bottom-up manner with a monadic effect. -- -- @ -- 'transformMOnOf' :: 'Monad' m => 'Traversal'' s a -> 'Traversal'' a a -> (a -> m a) -> s -> m s -- @ transformMOnOf :: Monad m => LensLike (WrappedMonad m) s t a a -> LensLike' (WrappedMonad m) a a -> (a -> m a) -> s -> m t transformMOnOf b l = mapMOf b . transformMOf l {-# INLINE transformMOnOf #-} ------------------------------------------------------------------------------- -- Holes and Contexts ------------------------------------------------------------------------------- -- | Return a list of all of the editable contexts for every location in the structure, recursively. -- -- @ -- propUniverse x = 'universe' x '==' 'map' 'Control.Comonad.Store.Class.pos' ('contexts' x) -- propId x = 'all' ('==' x) ['Control.Lens.Internal.Context.extract' w | w <- 'contexts' x] -- @ -- -- @ -- 'contexts' ≡ 'contextsOf' 'plate' -- @ contexts :: Plated a => a -> [Context a a a] contexts = contextsOf plate {-# INLINE contexts #-} -- | Return a list of all of the editable contexts for every location in the structure, recursively, using a user-specified 'Traversal' to walk each layer. -- -- @ -- propUniverse l x = 'universeOf' l x '==' 'map' 'Control.Comonad.Store.Class.pos' ('contextsOf' l x) -- propId l x = 'all' ('==' x) ['Control.Lens.Internal.Context.extract' w | w <- 'contextsOf' l x] -- @ -- -- @ -- 'contextsOf' :: 'Traversal'' a a -> a -> ['Context' a a a] -- @ contextsOf :: ATraversal' a a -> a -> [Context a a a] contextsOf l x = sell x : f (map context (holesOf l x)) where f xs = do Context ctx child <- xs Context cont y <- contextsOf l child return $ Context (ctx . cont) y {-# INLINE contextsOf #-} -- | 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' :: 'Plated' a => 'Traversal'' s a -> s -> ['Context' a a s] -- @ contextsOn :: Plated a => ATraversal s t a a -> s -> [Context a a t] contextsOn b = contextsOnOf b plate {-# INLINE contextsOn #-} -- | 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 -- another user-supplied 'Traversal' to walk each layer. -- -- @ -- 'contextsOnOf' :: 'Traversal'' s a -> 'Traversal'' a a -> s -> ['Context' a a s] -- @ contextsOnOf :: ATraversal s t a a -> ATraversal' a a -> s -> [Context a a t] contextsOnOf b l = f . map context . holesOf b where f xs = do Context ctx child <- xs Context cont y <- contextsOf l child return $ Context (ctx . cont) y {-# INLINE contextsOnOf #-} -- | The one-level version of 'context'. This extracts a list of the immediate children as editable contexts. -- -- Given a context you can use 'Control.Comonad.Store.Class.pos' to see the values, 'Control.Comonad.Store.Class.peek' at what the structure would be like with an edited result, or simply 'Control.Lens.Internal.Context.extract' the original structure. -- -- @ -- propChildren x = 'children' l x '==' 'map' 'Control.Comonad.Store.Class.pos' ('holes' l x) -- propId x = 'all' ('==' x) ['Control.Lens.Internal.Context.extract' w | w <- 'holes' l x] -- @ -- -- @ -- 'holes' = 'holesOf' 'plate' -- @ holes :: Plated a => a -> [Pretext (->) a a a] holes = holesOf plate {-# INLINE holes #-} -- | An alias for 'holesOf', provided for consistency with the other combinators. -- -- @ -- 'holesOn' ≡ 'holesOf' -- @ -- -- @ -- 'holesOn' :: 'Iso'' s a -> s -> ['Pretext' (->) a a s] -- 'holesOn' :: 'Lens'' s a -> s -> ['Pretext' (->) a a s] -- 'holesOn' :: 'Traversal'' s a -> s -> ['Pretext' (->) a a s] -- 'holesOn' :: 'IndexedLens'' i s a -> s -> ['Pretext' ('Control.Lens.Internal.Indexed.Indexed' i) a a s] -- 'holesOn' :: 'IndexedTraversal'' i s a -> s -> ['Pretext' ('Control.Lens.Internal.Indexed.Indexed' i) a a s] -- @ holesOn :: Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t] holesOn = holesOf {-# INLINE holesOn #-} -- | Extract one level of 'holes' from a container in a region specified by one 'Traversal', using another. -- -- @ -- 'holesOnOf' b l ≡ 'holesOf' (b '.' l) -- @ -- -- @ -- 'holesOnOf' :: 'Iso'' s a -> 'Iso'' a a -> s -> ['Pretext' (->) a a s] -- 'holesOnOf' :: 'Lens'' s a -> 'Lens'' a a -> s -> ['Pretext' (->) a a s] -- 'holesOnOf' :: 'Traversal'' s a -> 'Traversal'' a a -> s -> ['Pretext' (->) a a s] -- 'holesOnOf' :: 'Lens'' s a -> 'IndexedLens'' i a a -> s -> ['Pretext' ('Control.Lens.Internal.Indexed.Indexed' i) a a s] -- 'holesOnOf' :: 'Traversal'' s a -> 'IndexedTraversal'' i a a -> s -> ['Pretext' ('Control.Lens.Internal.Indexed.Indexed' i) a a s] -- @ holesOnOf :: Conjoined p => LensLike (Bazaar p r r) s t a b -> Over p (Bazaar p r r) a b r r -> s -> [Pretext p r r t] holesOnOf b l = holesOf (b . l) {-# INLINE holesOnOf #-} ------------------------------------------------------------------------------- -- Paramorphisms ------------------------------------------------------------------------------- -- | Perform a fold-like computation on each value, technically a paramorphism. -- -- @ -- 'paraOf' :: 'Fold' a a -> (a -> [r] -> r) -> a -> r -- @ paraOf :: Getting (Endo [a]) a a -> (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 :: Plated a => (a -> [r] -> r) -> a -> r para = paraOf plate {-# INLINE para #-} ------------------------------------------------------------------------------- -- Compos ------------------------------------------------------------------------------- -- $compos -- -- Provided for compatibility with Björn Bringert's @compos@ library. -- -- Note: Other operations from compos that were inherited by @uniplate@ are /not/ included -- 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' -- @ -- | Fold the immediate children of a 'Plated' container. -- -- @ -- 'composOpFold' z c f = 'foldrOf' 'plate' (c '.' f) z -- @ composOpFold :: Plated a => b -> (b -> b -> b) -> (a -> b) -> a -> b composOpFold z c f = foldrOf plate (c . f) z {-# INLINE composOpFold #-} ------------------------------------------------------------------------------- -- Parts ------------------------------------------------------------------------------- -- | The original @uniplate@ combinator, implemented in terms of 'Plated' as a 'Lens'. -- -- @ -- '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'! parts :: Plated a => Lens' a [a] parts = partsOf plate {-# INLINE parts #-} ------------------------------------------------------------------------------- -- Generics ------------------------------------------------------------------------------- -- | Implement 'plate' operation for a type using its 'Generic' instance. gplate :: (Generic a, GPlated a (Rep a)) => Traversal' a a gplate f x = GHC.Generics.to <$> gplate' f (GHC.Generics.from x) {-# INLINE gplate #-} class GPlated a g where gplate' :: Traversal' (g p) a instance GPlated a f => GPlated a (M1 i c f) where gplate' f (M1 x) = M1 <$> gplate' f x {-# INLINE gplate' #-} instance (GPlated a f, GPlated a g) => GPlated a (f :+: g) where gplate' f (L1 x) = L1 <$> gplate' f x gplate' f (R1 x) = R1 <$> gplate' f x {-# INLINE gplate' #-} instance (GPlated a f, GPlated a g) => GPlated a (f :*: g) where gplate' f (x :*: y) = (:*:) <$> gplate' f x <*> gplate' f y {-# INLINE gplate' #-} instance OVERLAPPING_PRAGMA GPlated a (K1 i a) where gplate' f (K1 x) = K1 <$> f x {-# INLINE gplate' #-} instance GPlated a (K1 i b) where gplate' _ = pure {-# INLINE gplate' #-} instance GPlated a U1 where gplate' _ = pure {-# INLINE gplate' #-} instance GPlated a V1 where gplate' _ v = v `seq` error "GPlated/V1" {-# INLINE gplate' #-} lens-4.14/src/Control/Lens/Prism.hs0000644000000000000000000002436512710476104015343 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Prism -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- ------------------------------------------------------------------------------- module Control.Lens.Prism ( -- * Prisms Prism, Prism' , APrism, APrism' -- * Constructing Prisms , prism , prism' -- * Consuming Prisms , withPrism , clonePrism , outside , aside , without , below , isn't , matching -- * Common Prisms , _Left , _Right , _Just , _Nothing , _Void , _Show , only , nearly -- * Prismatic profunctors , Choice(..) ) where import Control.Applicative import Control.Lens.Internal.Prism import Control.Lens.Lens import Control.Lens.Review import Control.Lens.Type import Control.Monad import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Traversable import Data.Void #if MIN_VERSION_base(4,7,0) import Data.Coerce #elif defined(SAFE) import Data.Profunctor.Unsafe #else import Unsafe.Coerce #endif import Prelude {-# ANN module "HLint: ignore Use camelCase" #-} -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Numeric.Natural -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g) -- >>> let isLeft (Left _) = True; isLeft _ = False -- >>> let isRight (Right _) = True; isRight _ = False -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g ------------------------------------------------------------------------------ -- Prism Internals ------------------------------------------------------------------------------ -- | If you see this in a signature for a function, the function is expecting a 'Prism'. type APrism s t a b = Market a b a (Identity b) -> Market a b s (Identity t) -- | @ -- type APrism' = 'Simple' 'APrism' -- @ type APrism' s a = APrism s s a a -- | Convert 'APrism' to the pair of functions that characterize it. withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r #if MIN_VERSION_base(4,7,0) withPrism k f = case coerce (k (Market Identity Right)) of Market bt seta -> f bt seta #elif defined(SAFE) withPrism k f = case k (Market Identity Right) of Market bt seta -> f (runIdentity #. bt) (either (Left . runIdentity) Right . seta) #else withPrism k f = case unsafeCoerce (k (Market Identity Right)) of Market bt seta -> f bt seta #endif {-# INLINE withPrism #-} -- | Clone a 'Prism' so that you can reuse the same monomorphically typed 'Prism' for different purposes. -- -- See 'Control.Lens.Lens.cloneLens' and 'Control.Lens.Traversal.cloneTraversal' for examples of why you might want to do this. clonePrism :: APrism s t a b -> Prism s t a b clonePrism k = withPrism k prism {-# INLINE clonePrism #-} ------------------------------------------------------------------------------ -- Prism Combinators ------------------------------------------------------------------------------ -- | Build a 'Control.Lens.Prism.Prism'. -- -- @'Either' t a@ is used instead of @'Maybe' a@ to permit the types of @s@ and @t@ to differ. -- prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b prism bt seta = dimap seta (either pure (fmap bt)) . right' {-# INLINE prism #-} -- | This is usually used to build a 'Prism'', when you have to use an operation like -- 'Data.Typeable.cast' which already returns a 'Maybe'. prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b prism' bs sma = prism bs (\s -> maybe (Left s) Right (sma s)) {-# INLINE prism' #-} -- | Use a 'Prism' as a kind of first-class pattern. -- -- @'outside' :: 'Prism' s t a b -> 'Lens' (t -> r) (s -> r) (b -> r) (a -> r)@ -- TODO: can we make this work with merely Strong? outside :: Representable p => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r) outside k = withPrism k $ \bt seta f ft -> f (lmap bt ft) <&> \fa -> tabulate $ either (sieve ft) (sieve fa) . seta {-# INLINE outside #-} -- | Given a pair of prisms, project sums. -- -- Viewing a 'Prism' as a co-'Lens', this combinator can be seen to be dual to 'Control.Lens.Lens.alongside'. without :: APrism s t a b -> APrism u v c d -> Prism (Either s u) (Either t v) (Either a c) (Either b d) without k = withPrism k $ \bt seta k' -> withPrism k' $ \dv uevc -> prism (bimap bt dv) $ \su -> case su of Left s -> bimap Left Left (seta s) Right u -> bimap Right Right (uevc u) {-# INLINE without #-} -- | Use a 'Prism' to work over part of a structure. -- aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b) aside k = withPrism k $ \bt seta -> prism (fmap bt) $ \(e,s) -> case seta s of Left t -> Left (e,t) Right a -> Right (e,a) {-# INLINE aside #-} -- | 'lift' a 'Prism' through a 'Traversable' functor, giving a Prism that matches only if all the elements of the container match the 'Prism'. -- -- >>> [Left 1, Right "foo", Left 4, Right "woot"]^..below _Right -- [] -- -- >>> [Right "hail hydra!", Right "foo", Right "blah", Right "woot"]^..below _Right -- [["hail hydra!","foo","blah","woot"]] below :: Traversable f => APrism' s a -> Prism' (f s) (f a) below k = withPrism k $ \bt seta -> prism (fmap bt) $ \s -> case traverse seta s of Left _ -> Left s Right t -> Right t {-# INLINE below #-} -- | Check to see if this 'Prism' doesn't match. -- -- >>> isn't _Left (Right 12) -- True -- -- >>> isn't _Left (Left 12) -- False -- -- >>> isn't _Empty [] -- False isn't :: APrism s t a b -> s -> Bool isn't k s = case matching k s of Left _ -> True Right _ -> False {-# INLINE isn't #-} -- | Retrieve the value targeted by a 'Prism' or return the -- original value while allowing the type to change if it does -- not match. -- -- >>> matching _Just (Just 12) -- Right 12 -- -- >>> matching _Just (Nothing :: Maybe Int) :: Either (Maybe Bool) Int -- Left Nothing matching :: APrism s t a b -> s -> Either t a matching k = withPrism k $ \_ seta -> seta {-# INLINE matching #-} ------------------------------------------------------------------------------ -- Common Prisms ------------------------------------------------------------------------------ -- | This 'Prism' provides a 'Traversal' for tweaking the 'Left' half of an 'Either': -- -- >>> over _Left (+1) (Left 2) -- Left 3 -- -- >>> over _Left (+1) (Right 2) -- Right 2 -- -- >>> Right 42 ^._Left :: String -- "" -- -- >>> Left "hello" ^._Left -- "hello" -- -- It also can be turned around to obtain the embedding into the 'Left' half of an 'Either': -- -- >>> _Left # 5 -- Left 5 -- -- >>> 5^.re _Left -- Left 5 _Left :: Prism (Either a c) (Either b c) a b _Left = prism Left $ either Right (Left . Right) {-# INLINE _Left #-} -- | This 'Prism' provides a 'Traversal' for tweaking the 'Right' half of an 'Either': -- -- >>> over _Right (+1) (Left 2) -- Left 2 -- -- >>> over _Right (+1) (Right 2) -- Right 3 -- -- >>> Right "hello" ^._Right -- "hello" -- -- >>> Left "hello" ^._Right :: [Double] -- [] -- -- It also can be turned around to obtain the embedding into the 'Right' half of an 'Either': -- -- >>> _Right # 5 -- Right 5 -- -- >>> 5^.re _Right -- Right 5 _Right :: Prism (Either c a) (Either c b) a b _Right = prism Right $ either (Left . Left) Right {-# INLINE _Right #-} -- | This 'Prism' provides a 'Traversal' for tweaking the target of the value of 'Just' in a 'Maybe'. -- -- >>> over _Just (+1) (Just 2) -- Just 3 -- -- Unlike 'Data.Traversable.traverse' this is a 'Prism', and so you can use it to inject as well: -- -- >>> _Just # 5 -- Just 5 -- -- >>> 5^.re _Just -- Just 5 -- -- Interestingly, -- -- @ -- m '^?' '_Just' ≡ m -- @ -- -- >>> Just x ^? _Just -- Just x -- -- >>> Nothing ^? _Just -- Nothing _Just :: Prism (Maybe a) (Maybe b) a b _Just = prism Just $ maybe (Left Nothing) Right {-# INLINE _Just #-} -- | This 'Prism' provides the 'Traversal' of a 'Nothing' in a 'Maybe'. -- -- >>> Nothing ^? _Nothing -- Just () -- -- >>> Just () ^? _Nothing -- Nothing -- -- But you can turn it around and use it to construct 'Nothing' as well: -- -- >>> _Nothing # () -- Nothing _Nothing :: Prism' (Maybe a) () _Nothing = prism' (const Nothing) $ maybe (Just ()) (const Nothing) {-# INLINE _Nothing #-} -- | 'Void' is a logically uninhabited data type. -- -- This is a 'Prism' that will always fail to match. _Void :: Prism s s a Void _Void = prism absurd Left {-# INLINE _Void #-} -- | This 'Prism' compares for exact equality with a given value. -- -- >>> only 4 # () -- 4 -- -- >>> 5 ^? only 4 -- Nothing only :: Eq a => a -> Prism' a () only a = prism' (\() -> a) $ guard . (a ==) {-# INLINE only #-} -- | This 'Prism' compares for approximate equality with a given value and a predicate for testing, -- an example where the value is the empty list and the predicate checks that a list is empty (same -- as 'Control.Lens.Empty._Empty' with the 'Control.Lens.Empty.AsEmpty' list instance): -- -- >>> nearly [] null # () -- [] -- >>> [1,2,3,4] ^? nearly [] null -- Nothing -- -- @'nearly' [] 'Prelude.null' :: 'Prism'' [a] ()@ -- -- To comply with the 'Prism' laws the arguments you supply to @nearly a p@ are somewhat constrained. -- -- We assume @p x@ holds iff @x ≡ a@. Under that assumption then this is a valid 'Prism'. -- -- This is useful when working with a type where you can test equality for only a subset of its -- values, and the prism selects such a value. nearly :: a -> (a -> Bool) -> Prism' a () nearly a p = prism' (\() -> a) $ guard . p {-# INLINE nearly #-} -- | This is an improper prism for text formatting based on 'Read' and 'Show'. -- -- This 'Prism' is \"improper\" in the sense that it normalizes the text formatting, but round tripping -- is idempotent given sane 'Read'/'Show' instances. -- -- >>> _Show # 2 -- "2" -- -- >>> "EQ" ^? _Show :: Maybe Ordering -- Just EQ -- -- @ -- '_Show' ≡ 'prism'' 'show' 'readMaybe' -- @ _Show :: (Read a, Show a) => Prism' String a _Show = prism show $ \s -> case reads s of [(a,"")] -> Right a _ -> Left s {-# INLINE _Show #-} lens-4.14/src/Control/Lens/Reified.hs0000644000000000000000000004147212710476104015616 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} ------------------------------------------------------------------------------ -- | -- Module : Control.Lens.Reified -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- ------------------------------------------------------------------------------ module Control.Lens.Reified where import Control.Applicative import Control.Arrow import qualified Control.Category as Cat import Control.Comonad import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Internal.Indexed import Control.Lens.Traversal (ignored) import Control.Lens.Type import Control.Monad import Control.Monad.Reader.Class import Data.Distributive import Data.Foldable import Data.Functor.Compose import Data.Functor.Contravariant import Data.Functor.Bind import Data.Functor.Extend import Data.Functor.Identity import Data.Functor.Plus import Data.Profunctor.Closed import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Semigroup -- $setup -- >>> import Control.Lens ------------------------------------------------------------------------------ -- Lens ------------------------------------------------------------------------------ -- | Reify a 'Lens' so it can be stored safely in a container. newtype ReifiedLens s t a b = Lens { runLens :: Lens s t a b } -- | @ -- type 'ReifiedLens'' = 'Simple' 'ReifiedLens' -- @ type ReifiedLens' s a = ReifiedLens s s a a ------------------------------------------------------------------------------ -- IndexedLens ------------------------------------------------------------------------------ -- | Reify an 'IndexedLens' so it can be stored safely in a container. newtype ReifiedIndexedLens i s t a b = IndexedLens { runIndexedLens :: IndexedLens i s t a b } -- | @ -- type 'ReifiedIndexedLens'' i = 'Simple' ('ReifiedIndexedLens' i) -- @ type ReifiedIndexedLens' i s a = ReifiedIndexedLens i s s a a ------------------------------------------------------------------------------ -- IndexedTraversal ------------------------------------------------------------------------------ -- | Reify an 'IndexedTraversal' so it can be stored safely in a container. newtype ReifiedIndexedTraversal i s t a b = IndexedTraversal { runIndexedTraversal :: IndexedTraversal i s t a b } -- | @ -- type 'ReifiedIndexedTraversal'' i = 'Simple' ('ReifiedIndexedTraversal' i) -- @ type ReifiedIndexedTraversal' i s a = ReifiedIndexedTraversal i s s a a ------------------------------------------------------------------------------ -- Traversal ------------------------------------------------------------------------------ -- | A form of 'Traversal' that can be stored monomorphically in a container. newtype ReifiedTraversal s t a b = Traversal { runTraversal :: Traversal s t a b } -- | @ -- type 'ReifiedTraversal'' = 'Simple' 'ReifiedTraversal' -- @ type ReifiedTraversal' s a = ReifiedTraversal s s a a ------------------------------------------------------------------------------ -- Getter ------------------------------------------------------------------------------ -- | Reify a 'Getter' so it can be stored safely in a container. -- -- This can also be useful when combining getters in novel ways, as -- 'ReifiedGetter' is isomorphic to '(->)' and provides similar instances. -- -- >>> ("hello","world","!!!")^.runGetter ((,) <$> Getter _2 <*> Getter (_1.to length)) -- ("world",5) newtype ReifiedGetter s a = Getter { runGetter :: Getter s a } instance Distributive (ReifiedGetter s) where distribute as = Getter $ to $ \s -> fmap (\(Getter l) -> view l s) as instance Functor (ReifiedGetter s) where fmap f l = Getter (runGetter l.to f) {-# INLINE fmap #-} instance Semigroup s => Extend (ReifiedGetter s) where duplicated (Getter l) = Getter $ to $ \m -> Getter $ to $ \n -> view l (m <> n) {-# INLINE duplicated #-} instance Monoid s => Comonad (ReifiedGetter s) where extract (Getter l) = view l mempty {-# INLINE extract #-} duplicate (Getter l) = Getter $ to $ \m -> Getter $ to $ \n -> view l (mappend m n) {-# INLINE duplicate #-} instance Monoid s => ComonadApply (ReifiedGetter s) where Getter mf <@> Getter ma = Getter $ to $ \s -> view mf s (view ma s) {-# INLINE (<@>) #-} m <@ _ = m {-# INLINE (<@) #-} _ @> m = m {-# INLINE (@>) #-} instance Apply (ReifiedGetter s) where Getter mf <.> Getter ma = Getter $ to $ \s -> view mf s (view ma s) {-# INLINE (<.>) #-} m <. _ = m {-# INLINE (<.) #-} _ .> m = m {-# INLINE (.>) #-} instance Applicative (ReifiedGetter s) where pure a = Getter $ to $ \_ -> a {-# INLINE pure #-} Getter mf <*> Getter ma = Getter $ to $ \s -> view mf s (view ma s) {-# INLINE (<*>) #-} m <* _ = m {-# INLINE (<*) #-} _ *> m = m {-# INLINE (*>) #-} instance Bind (ReifiedGetter s) where Getter ma >>- f = Getter $ to $ \s -> view (runGetter (f (view ma s))) s {-# INLINE (>>-) #-} instance Monad (ReifiedGetter s) where return = pure {-# INLINE return #-} Getter ma >>= f = Getter $ to $ \s -> view (runGetter (f (view ma s))) s {-# INLINE (>>=) #-} instance MonadReader s (ReifiedGetter s) where ask = Getter id {-# INLINE ask #-} local f m = Getter (to f . runGetter m) {-# INLINE local #-} instance Profunctor ReifiedGetter where dimap f g l = Getter $ to f.runGetter l.to g {-# INLINE dimap #-} lmap g l = Getter $ to g.runGetter l {-# INLINE lmap #-} rmap f l = Getter $ runGetter l.to f {-# INLINE rmap #-} instance Closed ReifiedGetter where closed l = Getter $ to $ \f -> view (runGetter l) . f instance Cosieve ReifiedGetter Identity where cosieve (Getter l) = view l . runIdentity instance Corepresentable ReifiedGetter where type Corep ReifiedGetter = Identity cotabulate f = Getter $ to (f . Identity) instance Sieve ReifiedGetter Identity where sieve (Getter l) = Identity . view l instance Representable ReifiedGetter where type Rep ReifiedGetter = Identity tabulate f = Getter $ to (runIdentity . f) instance Costrong ReifiedGetter where unfirst l = Getter $ to $ unfirst $ view (runGetter l) instance Conjoined ReifiedGetter instance Strong ReifiedGetter where first' l = Getter $ \f (s,c) -> phantom $ runGetter l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = Getter $ \f (c,s) -> phantom $ runGetter l (dimap ((,) c) phantom f) s {-# INLINE second' #-} instance Choice ReifiedGetter where left' l = Getter $ to $ left' $ view $ runGetter l {-# INLINE left' #-} right' l = Getter $ to $ right' $ view $ runGetter l {-# INLINE right' #-} instance Cat.Category ReifiedGetter where id = Getter id l . r = Getter (runGetter r.runGetter l) {-# INLINE (.) #-} instance Arrow ReifiedGetter where arr f = Getter (to f) {-# INLINE arr #-} first l = Getter $ to $ first $ view $ runGetter l {-# INLINE first #-} second l = Getter $ to $ second $ view $ runGetter l {-# INLINE second #-} Getter l *** Getter r = Getter $ to $ view l *** view r {-# INLINE (***) #-} Getter l &&& Getter r = Getter $ to $ view l &&& view r {-# INLINE (&&&) #-} instance ArrowApply ReifiedGetter where app = Getter $ to $ \(Getter bc, b) -> view bc b {-# INLINE app #-} instance ArrowChoice ReifiedGetter where left l = Getter $ to $ left $ view $ runGetter l {-# INLINE left #-} right l = Getter $ to $ right $ view $ runGetter l {-# INLINE right #-} Getter l +++ Getter r = Getter $ to $ view l +++ view r {-# INLINE (+++) #-} Getter l ||| Getter r = Getter $ to $ view l ||| view r {-# INLINE (|||) #-} instance ArrowLoop ReifiedGetter where loop l = Getter $ to $ loop $ view $ runGetter l {-# INLINE loop #-} ------------------------------------------------------------------------------ -- IndexedGetter ------------------------------------------------------------------------------ -- | Reify an 'IndexedGetter' so it can be stored safely in a container. newtype ReifiedIndexedGetter i s a = IndexedGetter { runIndexedGetter :: IndexedGetter i s a } instance Profunctor (ReifiedIndexedGetter i) where dimap f g l = IndexedGetter (to f . runIndexedGetter l . to g) {-# INLINE dimap #-} instance Sieve (ReifiedIndexedGetter i) ((,) i) where sieve = iview . runIndexedGetter {-# INLINE sieve #-} instance Representable (ReifiedIndexedGetter i) where type Rep (ReifiedIndexedGetter i) = (,) i tabulate f = IndexedGetter $ ito f {-# INLINE tabulate #-} instance Strong (ReifiedIndexedGetter i) where first' l = IndexedGetter $ \f (s,c) -> phantom $ runIndexedGetter l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = IndexedGetter $ \f (c,s) -> phantom $ runIndexedGetter l (dimap ((,) c) phantom f) s {-# INLINE second' #-} instance Functor (ReifiedIndexedGetter i s) where fmap f l = IndexedGetter (runIndexedGetter l.to f) {-# INLINE fmap #-} instance Semigroup i => Apply (ReifiedIndexedGetter i s) where IndexedGetter mf <.> IndexedGetter ma = IndexedGetter $ \k s -> case iview mf s of (i, f) -> case iview ma s of (j, a) -> phantom $ indexed k (i <> j) (f a) {-# INLINE (<.>) #-} ------------------------------------------------------------------------------ -- Fold ------------------------------------------------------------------------------ -- | Reify a 'Fold' so it can be stored safely in a container. -- -- This can also be useful for creatively combining folds as -- @'ReifiedFold' s@ is isomorphic to @ReaderT s []@ and provides similar -- instances. -- -- >>> ("hello","world")^..runFold ((,) <$> Fold _2 <*> Fold both) -- [("world","hello"),("world","world")] newtype ReifiedFold s a = Fold { runFold :: Fold s a } instance Profunctor ReifiedFold where dimap f g l = Fold (to f . runFold l . to g) {-# INLINE dimap #-} rmap g l = Fold (runFold l . to g) {-# INLINE rmap #-} lmap f l = Fold (to f . runFold l) {-# INLINE lmap #-} instance Sieve ReifiedFold [] where sieve = toListOf . runFold instance Representable ReifiedFold where type Rep ReifiedFold = [] tabulate f = Fold (folding f) instance Strong ReifiedFold where first' l = Fold $ \f (s,c) -> phantom $ runFold l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = Fold $ \f (c,s) -> phantom $ runFold l (dimap ((,) c) phantom f) s {-# INLINE second' #-} instance Choice ReifiedFold where left' (Fold l) = Fold $ folding $ \esc -> case esc of Left s -> Left <$> toListOf l s Right c -> [Right c] {-# INLINE left' #-} right' (Fold l) = Fold $ folding $ \ecs -> case ecs of Left c -> [Left c] Right s -> Right <$> toListOf l s {-# INLINE right' #-} instance Cat.Category ReifiedFold where id = Fold id l . r = Fold (runFold r . runFold l) {-# INLINE (.) #-} instance Arrow ReifiedFold where arr f = Fold (to f) {-# INLINE arr #-} first = first' {-# INLINE first #-} second = second' {-# INLINE second #-} Fold l *** Fold r = Fold $ folding $ \(x,y) -> (,) <$> toListOf l x <*> toListOf r y {-# INLINE (***) #-} Fold l &&& Fold r = Fold $ folding $ \x -> (,) <$> toListOf l x <*> toListOf r x {-# INLINE (&&&) #-} instance ArrowChoice ReifiedFold where left = left' {-# INLINE left #-} right = right' {-# INLINE right #-} instance ArrowApply ReifiedFold where app = Fold $ folding $ \(Fold bc, b) -> toListOf bc b {-# INLINE app #-} instance Functor (ReifiedFold s) where fmap f l = Fold (runFold l.to f) {-# INLINE fmap #-} instance Apply (ReifiedFold s) where Fold mf <.> Fold ma = Fold $ folding $ \s -> toListOf mf s <.> toListOf ma s {-# INLINE (<.>) #-} Fold mf <. Fold ma = Fold $ folding $ \s -> toListOf mf s <. toListOf ma s {-# INLINE (<.) #-} Fold mf .> Fold ma = Fold $ folding $ \s -> toListOf mf s .> toListOf ma s {-# INLINE (.>) #-} instance Applicative (ReifiedFold s) where pure a = Fold $ folding $ \_ -> [a] {-# INLINE pure #-} Fold mf <*> Fold ma = Fold $ folding $ \s -> toListOf mf s <*> toListOf ma s {-# INLINE (<*>) #-} Fold mf <* Fold ma = Fold $ folding $ \s -> toListOf mf s <* toListOf ma s {-# INLINE (<*) #-} Fold mf *> Fold ma = Fold $ folding $ \s -> toListOf mf s *> toListOf ma s {-# INLINE (*>) #-} instance Alternative (ReifiedFold s) where empty = Fold ignored {-# INLINE empty #-} Fold ma <|> Fold mb = Fold $ folding (\s -> toListOf ma s ++ toListOf mb s) {-# INLINE (<|>) #-} instance Bind (ReifiedFold s) where Fold ma >>- f = Fold $ folding $ \s -> toListOf ma s >>- \a -> toListOf (runFold (f a)) s {-# INLINE (>>-) #-} instance Monad (ReifiedFold s) where return = pure {-# INLINE return #-} Fold ma >>= f = Fold $ folding $ \s -> toListOf ma s >>= \a -> toListOf (runFold (f a)) s {-# INLINE (>>=) #-} instance MonadPlus (ReifiedFold s) where mzero = empty {-# INLINE mzero #-} mplus = (<|>) {-# INLINE mplus #-} instance MonadReader s (ReifiedFold s) where ask = Fold id {-# INLINE ask #-} local f m = Fold (to f . runFold m) {-# INLINE local #-} instance Semigroup (ReifiedFold s a) where (<>) = (<|>) {-# INLINE (<>) #-} instance Monoid (ReifiedFold s a) where mempty = Fold ignored {-# INLINE mempty #-} mappend = (<|>) {-# INLINE mappend #-} instance Alt (ReifiedFold s) where () = (<|>) {-# INLINE () #-} instance Plus (ReifiedFold s) where zero = Fold ignored {-# INLINE zero #-} ------------------------------------------------------------------------------ -- IndexedFold ------------------------------------------------------------------------------ newtype ReifiedIndexedFold i s a = IndexedFold { runIndexedFold :: IndexedFold i s a } instance Semigroup (ReifiedIndexedFold i s a) where (<>) = () {-# INLINE (<>) #-} instance Monoid (ReifiedIndexedFold i s a) where mempty = IndexedFold ignored {-# INLINE mempty #-} mappend = () {-# INLINE mappend #-} instance Alt (ReifiedIndexedFold i s) where IndexedFold ma IndexedFold mb = IndexedFold $ ifolding $ \s -> itoListOf ma s ++ itoListOf mb s {-# INLINE () #-} instance Plus (ReifiedIndexedFold i s) where zero = IndexedFold ignored {-# INLINE zero #-} instance Functor (ReifiedIndexedFold i s) where fmap f l = IndexedFold (runIndexedFold l . to f) {-# INLINE fmap #-} instance Profunctor (ReifiedIndexedFold i) where dimap f g l = IndexedFold (to f . runIndexedFold l . to g) {-# INLINE dimap #-} lmap f l = IndexedFold (to f . runIndexedFold l) {-# INLINE lmap #-} rmap g l = IndexedFold (runIndexedFold l . to g) {-# INLINE rmap #-} instance Sieve (ReifiedIndexedFold i) (Compose [] ((,) i)) where sieve (IndexedFold l) = Compose . itoListOf l {-# INLINE sieve #-} instance Representable (ReifiedIndexedFold i) where type Rep (ReifiedIndexedFold i) = Compose [] ((,) i) tabulate k = IndexedFold $ \f -> phantom . traverse_ (phantom . uncurry (indexed f)) . getCompose . k {-# INLINE tabulate #-} instance Strong (ReifiedIndexedFold i) where first' l = IndexedFold $ \f (s,c) -> phantom $ runIndexedFold l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = IndexedFold $ \f (c,s) -> phantom $ runIndexedFold l (dimap ((,) c) phantom f) s {-# INLINE second' #-} ------------------------------------------------------------------------------ -- Setter ------------------------------------------------------------------------------ -- | Reify a 'Setter' so it can be stored safely in a container. newtype ReifiedSetter s t a b = Setter { runSetter :: Setter s t a b } -- | @ -- type 'ReifiedSetter'' = 'Simple' 'ReifiedSetter' -- @ type ReifiedSetter' s a = ReifiedSetter s s a a ------------------------------------------------------------------------------ -- IndexedSetter ------------------------------------------------------------------------------ -- | Reify an 'IndexedSetter' so it can be stored safely in a container. newtype ReifiedIndexedSetter i s t a b = IndexedSetter { runIndexedSetter :: IndexedSetter i s t a b } -- | @ -- type 'ReifiedIndexedSetter'' i = 'Simple' ('ReifiedIndexedSetter' i) -- @ type ReifiedIndexedSetter' i s a = ReifiedIndexedSetter i s s a a ------------------------------------------------------------------------------ -- Iso ------------------------------------------------------------------------------ -- | Reify an 'Iso' so it can be stored safely in a container. newtype ReifiedIso s t a b = Iso { runIso :: Iso s t a b } -- | @ -- type 'ReifiedIso'' = 'Simple' 'ReifiedIso' -- @ type ReifiedIso' s a = ReifiedIso s s a a ------------------------------------------------------------------------------ -- Prism ------------------------------------------------------------------------------ -- | Reify a 'Prism' so it can be stored safely in a container. newtype ReifiedPrism s t a b = Prism { runPrism :: Prism s t a b } -- | @ -- type 'ReifiedPrism'' = 'Simple' 'ReifiedPrism' -- @ type ReifiedPrism' s a = ReifiedPrism s s a a lens-4.14/src/Control/Lens/Review.hs0000644000000000000000000001551412710476104015506 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Review -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- -- A 'Review' is a type-restricted form of a 'Prism' that can only be used for -- writing back via 're', 'review', 'reuse'. ------------------------------------------------------------------------------- module Control.Lens.Review ( -- * Reviewing Review , AReview , unto , un , re , review, reviews , reuse, reuses , ( # ) , Bifunctor(bimap) , retagged , Reviewable ) where import Control.Monad.Reader as Reader import Control.Monad.State as State import Control.Lens.Getter import Control.Lens.Internal.Review import Control.Lens.Type import Data.Bifunctor import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Unsafe import Data.Tagged import Data.Void -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Numeric.Lens -- >>> let isLeft (Left _) = True; isLeft _ = False -- >>> let isRight (Right _) = True; isRight _ = False infixr 8 # ------------------------------------------------------------------------------ -- Review ------------------------------------------------------------------------------ -- | An analogue of 'to' for 'review'. -- -- @ -- 'unto' :: (b -> t) -> 'Review'' t b -- @ -- -- @ -- 'unto' = 'un' . 'to' -- @ unto :: (Profunctor p, Bifunctor p, Functor f) => (b -> t) -> Optic p f s t a b unto f = first absurd . lmap absurd . rmap (fmap f) {-# INLINE unto #-} -- | Turn a 'Getter' around to get a 'Review' -- -- @ -- 'un' = 'unto' . 'view' -- 'unto' = 'un' . 'to' -- @ -- -- >>> un (to length) # [1,2,3] -- 3 un :: (Profunctor p, Bifunctor p, Functor f) => Getting a s a -> Optic' p f a s un = unto . view -- | Turn a 'Prism' or 'Control.Lens.Iso.Iso' around to build a 'Getter'. -- -- If you have an 'Control.Lens.Iso.Iso', 'Control.Lens.Iso.from' is a more powerful version of this function -- that will return an 'Control.Lens.Iso.Iso' instead of a mere 'Getter'. -- -- >>> 5 ^.re _Left -- Left 5 -- -- >>> 6 ^.re (_Left.unto succ) -- Left 7 -- -- @ -- 'review' ≡ 'view' '.' 're' -- 'reviews' ≡ 'views' '.' 're' -- 'reuse' ≡ 'use' '.' 're' -- 'reuses' ≡ 'uses' '.' 're' -- @ -- -- @ -- 're' :: 'Prism' s t a b -> 'Getter' b t -- 're' :: 'Iso' s t a b -> 'Getter' b t -- @ re :: Contravariant f => AReview t b -> LensLike' f b t re p = to (runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE re #-} -- | This can be used to turn an 'Control.Lens.Iso.Iso' or 'Prism' around and 'view' a value (or the current environment) through it the other way. -- -- @ -- 'review' ≡ 'view' '.' 're' -- 'review' . 'unto' ≡ 'id' -- @ -- -- >>> review _Left "mustard" -- Left "mustard" -- -- >>> review (unto succ) 5 -- 6 -- -- Usually 'review' is used in the @(->)@ 'Monad' with a 'Prism' or 'Control.Lens.Iso.Iso', in which case it may be useful to think of -- it as having one of these more restricted type signatures: -- -- @ -- 'review' :: 'Iso'' s a -> a -> s -- 'review' :: 'Prism'' s a -> a -> s -- @ -- -- However, when working with a 'Monad' transformer stack, it is sometimes useful to be able to 'review' the current environment, in which case -- it may be beneficial to think of it as having one of these slightly more liberal type signatures: -- -- @ -- 'review' :: 'MonadReader' a m => 'Iso'' s a -> m s -- 'review' :: 'MonadReader' a m => 'Prism'' s a -> m s -- @ review :: MonadReader b m => AReview t b -> m t review p = asks (runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE review #-} -- | An infix alias for 'review'. -- -- @ -- 'unto' f # x ≡ f x -- l # x ≡ x '^.' 're' l -- @ -- -- This is commonly used when using a 'Prism' as a smart constructor. -- -- >>> _Left # 4 -- Left 4 -- -- But it can be used for any 'Prism' -- -- >>> base 16 # 123 -- "7b" -- -- @ -- (#) :: 'Iso'' s a -> a -> s -- (#) :: 'Prism'' s a -> a -> s -- (#) :: 'Review' s a -> a -> s -- (#) :: 'Equality'' s a -> a -> s -- @ ( # ) :: AReview t b -> b -> t ( # ) p = runIdentity #. unTagged #. p .# Tagged .# Identity {-# INLINE ( # ) #-} -- | This can be used to turn an 'Control.Lens.Iso.Iso' or 'Prism' around and 'view' a value (or the current environment) through it the other way, -- applying a function. -- -- @ -- 'reviews' ≡ 'views' '.' 're' -- 'reviews' ('unto' f) g ≡ g '.' f -- @ -- -- >>> reviews _Left isRight "mustard" -- False -- -- >>> reviews (unto succ) (*2) 3 -- 8 -- -- Usually this function is used in the @(->)@ 'Monad' with a 'Prism' or 'Control.Lens.Iso.Iso', in which case it may be useful to think of -- it as having one of these more restricted type signatures: -- -- @ -- 'reviews' :: 'Iso'' s a -> (s -> r) -> a -> r -- 'reviews' :: 'Prism'' s a -> (s -> r) -> a -> r -- @ -- -- However, when working with a 'Monad' transformer stack, it is sometimes useful to be able to 'review' the current environment, in which case -- it may be beneficial to think of it as having one of these slightly more liberal type signatures: -- -- @ -- 'reviews' :: 'MonadReader' a m => 'Iso'' s a -> (s -> r) -> m r -- 'reviews' :: 'MonadReader' a m => 'Prism'' s a -> (s -> r) -> m r -- @ reviews :: MonadReader b m => AReview t b -> (t -> r) -> m r reviews p tr = asks (tr . runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE reviews #-} -- | This can be used to turn an 'Control.Lens.Iso.Iso' or 'Prism' around and 'use' a value (or the current environment) through it the other way. -- -- @ -- 'reuse' ≡ 'use' '.' 're' -- 'reuse' '.' 'unto' ≡ 'gets' -- @ -- -- >>> evalState (reuse _Left) 5 -- Left 5 -- -- >>> evalState (reuse (unto succ)) 5 -- 6 -- -- @ -- 'reuse' :: 'MonadState' a m => 'Prism'' s a -> m s -- 'reuse' :: 'MonadState' a m => 'Iso'' s a -> m s -- @ reuse :: MonadState b m => AReview t b -> m t reuse p = gets (runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE reuse #-} -- | This can be used to turn an 'Control.Lens.Iso.Iso' or 'Prism' around and 'use' the current state through it the other way, -- applying a function. -- -- @ -- 'reuses' ≡ 'uses' '.' 're' -- 'reuses' ('unto' f) g ≡ 'gets' (g '.' f) -- @ -- -- >>> evalState (reuses _Left isLeft) (5 :: Int) -- True -- -- @ -- 'reuses' :: 'MonadState' a m => 'Prism'' s a -> (s -> r) -> m r -- 'reuses' :: 'MonadState' a m => 'Iso'' s a -> (s -> r) -> m r -- @ reuses :: MonadState b m => AReview t b -> (t -> r) -> m r reuses p tr = gets (tr . runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE reuses #-} lens-4.14/src/Control/Lens/Setter.hs0000644000000000000000000012330612710476104015512 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Setter -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- A @'Setter' s t a b@ 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 => (a -> b) -> f a -> f b@ -- we monomorphize the type to obtain @(a -> b) -> s -> t@ and then decorate it with 'Data.Functor.Identity.Identity' to obtain: -- -- @ -- type 'Setter' s t a b = (a -> 'Data.Functor.Identity.Identity' b) -> s -> 'Data.Functor.Identity.Identity' t -- @ -- -- Every '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 ('<$'). ---------------------------------------------------------------------------- module Control.Lens.Setter ( -- * Setters Setter, Setter' , IndexedSetter, IndexedSetter' , ASetter, ASetter' , AnIndexedSetter, AnIndexedSetter' , Setting, Setting' -- * Building Setters , sets, setting , cloneSetter , cloneIndexPreservingSetter , cloneIndexedSetter -- * Common Setters , mapped, lifted , contramapped , argument -- * Functional Combinators , over , set , (.~), (%~) , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (<>~), (&&~), (<.~), (?~), (=), (&&=), (<.=), (?=), (>> import Control.Lens -- >>> import Control.Monad.State -- >>> import Data.Char -- >>> import Data.Map as Map -- >>> import Debug.SimpleReflect.Expr as Expr -- >>> import Debug.SimpleReflect.Vars as Vars -- >>> let f :: Expr -> Expr; f = Vars.f -- >>> let g :: Expr -> Expr; g = Vars.g -- >>> let h :: Expr -> Expr -> Expr; h = Vars.h -- >>> let getter :: Expr -> Expr; getter = fun "getter" -- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter" -- >>> :set -XNoOverloadedStrings infixr 4 %@~, .@~, .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, <>~, ||~, %~, <.~, ?~, =, ||=, %=, <.=, ?=, Identity b) -> s -> Identity t -- | This is a useful alias for use when consuming a 'Setter''. -- -- Most user code will never have to use this type. -- -- @ -- type 'ASetter'' = 'Simple' 'ASetter' -- @ type ASetter' s a = ASetter s s a a -- | Running an 'IndexedSetter' instantiates it to a concrete type. -- -- 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. type AnIndexedSetter i s t a b = Indexed i a (Identity b) -> s -> Identity t -- | @ -- type 'AnIndexedSetter'' i = 'Simple' ('AnIndexedSetter' i) -- @ type AnIndexedSetter' i s a = AnIndexedSetter i s s a a -- | This is a convenient alias when defining highly polymorphic code that takes both -- 'ASetter' and 'AnIndexedSetter' as appropriate. If a function takes this it is -- expecting one of those two things based on context. type Setting p s t a b = p a (Identity b) -> s -> Identity t -- | This is a convenient alias when defining highly polymorphic code that takes both -- 'ASetter'' and 'AnIndexedSetter'' as appropriate. If a function takes this it is -- expecting one of those two things based on context. type Setting' p s a = Setting p s s a a ----------------------------------------------------------------------------- -- Setters ----------------------------------------------------------------------------- -- | 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' -- @ -- -- >>> over mapped f [a,b,c] -- [f a,f b,f c] -- -- >>> over mapped (+1) [1,2,3] -- [2,3,4] -- -- >>> set mapped x [a,b,c] -- [x,x,x] -- -- >>> [[a,b],[c]] & mapped.mapped +~ x -- [[a + x,b + x],[c + x]] -- -- >>> over (mapped._2) length [("hello","world"),("leaders","!!!")] -- [("hello",5),("leaders",3)] -- -- @ -- 'mapped' :: 'Functor' f => 'Setter' (f a) (f b) a b -- @ -- -- If you want an 'IndexPreservingSetter' use @'setting' 'fmap'@. mapped :: Functor f => Setter (f a) (f b) a b mapped = sets fmap {-# INLINE mapped #-} -- | This 'setter' can be used to modify all of the values in a 'Monad'. -- -- You sometimes have to use this rather than 'mapped' -- due to -- temporary insanity 'Functor' is not a superclass of 'Monad'. -- -- @ -- 'liftM' ≡ 'over' 'lifted' -- @ -- -- >>> over lifted f [a,b,c] -- [f a,f b,f c] -- -- >>> set lifted b (Just a) -- Just b -- -- If you want an 'IndexPreservingSetter' use @'setting' 'liftM'@. lifted :: Monad m => Setter (m a) (m b) a b lifted = sets liftM {-# INLINE lifted #-} -- | This 'Setter' can be used to map over all of the inputs to a 'Contravariant'. -- -- @ -- 'contramap' ≡ 'over' 'contramapped' -- @ -- -- >>> getPredicate (over contramapped (*2) (Predicate even)) 5 -- True -- -- >>> getOp (over contramapped (*5) (Op show)) 100 -- "500" -- -- >>> Prelude.map ($ 1) $ over (mapped . _Unwrapping' Op . contramapped) (*12) [(*2),(+1),(^3)] -- [24,13,1728] -- contramapped :: Contravariant f => Setter (f b) (f a) a b contramapped = sets contramap {-# INLINE contramapped #-} -- | This 'Setter' can be used to map over the input of a 'Profunctor'. -- -- The most common 'Profunctor' to use this with is @(->)@. -- -- >>> (argument %~ f) g x -- g (f x) -- -- >>> (argument %~ show) length [1,2,3] -- 7 -- -- >>> (argument %~ f) h x y -- h (f x) y -- -- Map over the argument of the result of a function -- i.e., its second -- argument: -- -- >>> (mapped.argument %~ f) h x y -- h x (f y) -- -- @ -- 'argument' :: 'Setter' (b -> r) (a -> r) a b -- @ argument :: Profunctor p => Setter (p b r) (p a r) a b argument = sets lmap {-# INLINE argument #-} -- | Build an index-preserving 'Setter' from a map-like function. -- -- Your supplied function @f@ is required to satisfy: -- -- @ -- f 'id' ≡ 'id' -- f g '.' f h ≡ f (g '.' h) -- @ -- -- Equational reasoning: -- -- @ -- 'setting' '.' 'over' ≡ 'id' -- 'over' '.' 'setting' ≡ 'id' -- @ -- -- Another way to view 'sets' is that it takes a \"semantic editor combinator\" -- and transforms it into a 'Setter'. -- -- @ -- 'setting' :: ((a -> b) -> s -> t) -> 'Setter' s t a b -- @ setting :: ((a -> b) -> s -> t) -> IndexPreservingSetter s t a b setting l pafb = cotabulate $ \ws -> pure $ l (\a -> untainted (cosieve pafb (a <$ ws))) (extract ws) {-# INLINE setting #-} -- | Build a 'Setter', 'IndexedSetter' or 'IndexPreservingSetter' depending on your choice of 'Profunctor'. -- -- @ -- 'sets' :: ((a -> b) -> s -> t) -> 'Setter' s t a b -- @ sets :: (Profunctor p, Profunctor q, Settable f) => (p a b -> q s t) -> Optical p q f s t a b sets f g = taintedDot (f (untaintedDot g)) {-# INLINE sets #-} -- | Restore 'ASetter' to a full 'Setter'. cloneSetter :: ASetter s t a b -> Setter s t a b cloneSetter l afb = taintedDot $ runIdentity #. l (Identity #. untaintedDot afb) {-# INLINE cloneSetter #-} -- | Build an 'IndexPreservingSetter' from any 'Setter'. cloneIndexPreservingSetter :: ASetter s t a b -> IndexPreservingSetter s t a b cloneIndexPreservingSetter l pafb = cotabulate $ \ws -> taintedDot runIdentity $ l (\a -> Identity (untainted (cosieve pafb (a <$ ws)))) (extract ws) {-# INLINE cloneIndexPreservingSetter #-} -- | Clone an 'IndexedSetter'. cloneIndexedSetter :: AnIndexedSetter i s t a b -> IndexedSetter i s t a b cloneIndexedSetter l pafb = taintedDot (runIdentity #. l (Indexed $ \i -> Identity #. untaintedDot (indexed pafb i))) {-# INLINE cloneIndexedSetter #-} ----------------------------------------------------------------------------- -- Using Setters ----------------------------------------------------------------------------- -- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal' -- with a function. -- -- @ -- 'fmap' ≡ 'over' 'mapped' -- 'Data.Traversable.fmapDefault' ≡ 'over' 'Data.Traversable.traverse' -- 'sets' '.' 'over' ≡ 'id' -- 'over' '.' 'sets' ≡ 'id' -- @ -- -- Given any valid 'Setter' @l@, you can also rely on the law: -- -- @ -- 'over' l f '.' 'over' l g = 'over' l (f '.' g) -- @ -- -- /e.g./ -- -- >>> over mapped f (over mapped g [a,b,c]) == over mapped (f . g) [a,b,c] -- True -- -- Another way to view 'over' is to say that it transforms a 'Setter' into a -- \"semantic editor combinator\". -- -- >>> over mapped f (Just a) -- Just (f a) -- -- >>> over mapped (*10) [1,2,3] -- [10,20,30] -- -- >>> over _1 f (a,b) -- (f a,b) -- -- >>> over _1 show (10,20) -- ("10",20) -- -- @ -- 'over' :: 'Setter' s t a b -> (a -> b) -> s -> t -- 'over' :: 'ASetter' s t a b -> (a -> b) -> s -> t -- @ over :: ASetter s t a b -> (a -> b) -> s -> t over l f = runIdentity #. l (Identity #. f) {-# INLINE over #-} -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' -- or 'Traversal' with a constant value. -- -- @ -- ('<$') ≡ 'set' 'mapped' -- @ -- -- >>> set _2 "hello" (1,()) -- (1,"hello") -- -- >>> set mapped () [1,2,3,4] -- [(),(),(),()] -- -- Note: Attempting to 'set' a 'Fold' or 'Getter' will fail at compile time with an -- relatively nice error message. -- -- @ -- 'set' :: 'Setter' s t a b -> b -> s -> t -- 'set' :: 'Iso' s t a b -> b -> s -> t -- 'set' :: 'Lens' s t a b -> b -> s -> t -- 'set' :: 'Traversal' s t a b -> b -> s -> t -- @ set :: ASetter s t a b -> b -> s -> t set l b = runIdentity #. l (\_ -> Identity b) {-# INLINE set #-} -- | Replace the target of a 'Lens' or all of the targets of a 'Setter'' -- or 'Traversal' with a constant value, without changing its type. -- -- This is a type restricted version of 'set', which retains the type of the original. -- -- >>> set' mapped x [a,b,c,d] -- [x,x,x,x] -- -- >>> set' _2 "hello" (1,"world") -- (1,"hello") -- -- >>> set' mapped 0 [1,2,3,4] -- [0,0,0,0] -- -- Note: Attempting to adjust 'set'' a 'Fold' or 'Getter' will fail at compile time with an -- relatively nice error message. -- -- @ -- 'set'' :: 'Setter'' s a -> a -> s -> s -- 'set'' :: 'Iso'' s a -> a -> s -> s -- 'set'' :: 'Lens'' s a -> a -> s -> s -- 'set'' :: 'Traversal'' s a -> a -> s -> s -- @ set' :: ASetter' s a -> a -> s -> s set' l b = runIdentity #. l (\_ -> Identity b) {-# INLINE set' #-} -- | Modifies the target of a 'Lens' or all of the targets of a 'Setter' or -- 'Traversal' with a user supplied function. -- -- This is an infix version of 'over'. -- -- @ -- 'fmap' f ≡ 'mapped' '%~' f -- 'Data.Traversable.fmapDefault' f ≡ 'Data.Traversable.traverse' '%~' f -- @ -- -- >>> (a,b,c) & _3 %~ f -- (a,b,f c) -- -- >>> (a,b) & both %~ f -- (f a,f b) -- -- >>> _2 %~ length $ (1,"hello") -- (1,5) -- -- >>> traverse %~ f $ [a,b,c] -- [f a,f b,f c] -- -- >>> traverse %~ even $ [1,2,3] -- [False,True,False] -- -- >>> traverse.traverse %~ length $ [["hello","world"],["!!!"]] -- [[5,5],[3]] -- -- @ -- ('%~') :: 'Setter' s t a b -> (a -> b) -> s -> t -- ('%~') :: 'Iso' s t a b -> (a -> b) -> s -> t -- ('%~') :: 'Lens' s t a b -> (a -> b) -> s -> t -- ('%~') :: 'Traversal' s t a b -> (a -> b) -> s -> t -- @ (%~) :: ASetter s t a b -> (a -> b) -> s -> t (%~) = over {-# INLINE (%~) #-} -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' -- or 'Traversal' with a constant value. -- -- This is an infix version of 'set', provided for consistency with ('.='). -- -- @ -- f '<$' a ≡ 'mapped' '.~' f '$' a -- @ -- -- >>> (a,b,c,d) & _4 .~ e -- (a,b,c,e) -- -- >>> (42,"world") & _1 .~ "hello" -- ("hello","world") -- -- >>> (a,b) & both .~ c -- (c,c) -- -- @ -- ('.~') :: 'Setter' s t a b -> b -> s -> t -- ('.~') :: 'Iso' s t a b -> b -> s -> t -- ('.~') :: 'Lens' s t a b -> b -> s -> t -- ('.~') :: 'Traversal' s t a b -> b -> s -> t -- @ (.~) :: ASetter s t a b -> b -> s -> t (.~) = set {-# INLINE (.~) #-} -- | Set the target of a 'Lens', 'Traversal' or 'Setter' to 'Just' a value. -- -- @ -- l '?~' t ≡ 'set' l ('Just' t) -- @ -- -- >>> Nothing & id ?~ a -- Just a -- -- >>> Map.empty & at 3 ?~ x -- fromList [(3,x)] -- -- @ -- ('?~') :: 'Setter' s t a ('Maybe' b) -> b -> s -> t -- ('?~') :: 'Iso' s t a ('Maybe' b) -> b -> s -> t -- ('?~') :: 'Lens' s t a ('Maybe' b) -> b -> s -> t -- ('?~') :: 'Traversal' s t a ('Maybe' b) -> b -> s -> t -- @ (?~) :: ASetter s t a (Maybe b) -> b -> s -> t l ?~ b = set l (Just b) {-# INLINE (?~) #-} -- | Set with pass-through. -- -- This is mostly present for consistency, but may be useful for chaining assignments. -- -- If you do not need a copy of the intermediate result, then using @l '.~' t@ directly is a good idea. -- -- >>> (a,b) & _1 <.~ c -- (c,(c,b)) -- -- >>> ("good","morning","vietnam") & _3 <.~ "world" -- ("world",("good","morning","world")) -- -- >>> (42,Map.fromList [("goodnight","gracie")]) & _2.at "hello" <.~ Just "world" -- (Just "world",(42,fromList [("goodnight","gracie"),("hello","world")])) -- -- @ -- ('<.~') :: 'Setter' s t a b -> b -> s -> (b, t) -- ('<.~') :: 'Iso' s t a b -> b -> s -> (b, t) -- ('<.~') :: 'Lens' s t a b -> b -> s -> (b, t) -- ('<.~') :: 'Traversal' s t a b -> b -> s -> (b, t) -- @ (<.~) :: ASetter s t a b -> b -> s -> (b, t) l <.~ b = \s -> (b, set l b s) {-# INLINE (<.~) #-} -- | Set to 'Just' a value with pass-through. -- -- This is mostly present for consistency, but may be useful for for chaining assignments. -- -- If you do not need a copy of the intermediate result, then using @l '?~' d@ directly is a good idea. -- -- >>> import Data.Map as Map -- >>> _2.at "hello" b -> s -> (b, t) -- (' b -> s -> (b, t) -- (' b -> s -> (b, t) -- (' b -> s -> (b, t) -- @ ( b -> s -> (b, t) l (b, set l (Just b) s) {-# INLINE (>> (a,b) & _1 +~ c -- (a + c,b) -- -- >>> (a,b) & both +~ c -- (a + c,b + c) -- -- >>> (1,2) & _2 +~ 1 -- (1,3) -- -- >>> [(a,b),(c,d)] & traverse.both +~ e -- [(a + e,b + e),(c + e,d + e)] -- -- @ -- ('+~') :: 'Num' a => 'Setter'' s a -> a -> s -> s -- ('+~') :: 'Num' a => 'Iso'' s a -> a -> s -> s -- ('+~') :: 'Num' a => 'Lens'' s a -> a -> s -> s -- ('+~') :: 'Num' a => 'Traversal'' s a -> a -> s -> s -- @ (+~) :: Num a => ASetter s t a a -> a -> s -> t l +~ n = over l (+ n) {-# INLINE (+~) #-} -- | Multiply the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'. -- -- >>> (a,b) & _1 *~ c -- (a * c,b) -- -- >>> (a,b) & both *~ c -- (a * c,b * c) -- -- >>> (1,2) & _2 *~ 4 -- (1,8) -- -- >>> Just 24 & mapped *~ 2 -- Just 48 -- -- @ -- ('*~') :: 'Num' a => 'Setter'' s a -> a -> s -> s -- ('*~') :: 'Num' a => 'Iso'' s a -> a -> s -> s -- ('*~') :: 'Num' a => 'Lens'' s a -> a -> s -> s -- ('*~') :: 'Num' a => 'Traversal'' s a -> a -> s -> s -- @ (*~) :: Num a => ASetter s t a a -> a -> s -> t l *~ n = over l (* n) {-# INLINE (*~) #-} -- | Decrement the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'. -- -- >>> (a,b) & _1 -~ c -- (a - c,b) -- -- >>> (a,b) & both -~ c -- (a - c,b - c) -- -- >>> _1 -~ 2 $ (1,2) -- (-1,2) -- -- >>> mapped.mapped -~ 1 $ [[4,5],[6,7]] -- [[3,4],[5,6]] -- -- @ -- ('-~') :: 'Num' a => 'Setter'' s a -> a -> s -> s -- ('-~') :: 'Num' a => 'Iso'' s a -> a -> s -> s -- ('-~') :: 'Num' a => 'Lens'' s a -> a -> s -> s -- ('-~') :: 'Num' a => 'Traversal'' s a -> a -> s -> s -- @ (-~) :: Num a => ASetter s t a a -> a -> s -> t l -~ n = over l (subtract n) {-# INLINE (-~) #-} -- | Divide the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'. -- -- >>> (a,b) & _1 //~ c -- (a / c,b) -- -- >>> (a,b) & both //~ c -- (a / c,b / c) -- -- >>> ("Hawaii",10) & _2 //~ 2 -- ("Hawaii",5.0) -- -- @ -- ('//~') :: 'Fractional' a => 'Setter'' s a -> a -> s -> s -- ('//~') :: 'Fractional' a => 'Iso'' s a -> a -> s -> s -- ('//~') :: 'Fractional' a => 'Lens'' s a -> a -> s -> s -- ('//~') :: 'Fractional' a => 'Traversal'' s a -> a -> s -> s -- @ (//~) :: Fractional a => ASetter s t a a -> a -> s -> t l //~ n = over l (/ n) {-# INLINE (//~) #-} -- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to a non-negative integral power. -- -- >>> (1,3) & _2 ^~ 2 -- (1,9) -- -- @ -- ('^~') :: ('Num' a, 'Integral' e) => 'Setter'' s a -> e -> s -> s -- ('^~') :: ('Num' a, 'Integral' e) => 'Iso'' s a -> e -> s -> s -- ('^~') :: ('Num' a, 'Integral' e) => 'Lens'' s a -> e -> s -> s -- ('^~') :: ('Num' a, 'Integral' e) => 'Traversal'' s a -> e -> s -> s -- @ (^~) :: (Num a, Integral e) => ASetter s t a a -> e -> s -> t l ^~ n = over l (^ n) {-# INLINE (^~) #-} -- | Raise the target(s) of a fractionally valued 'Lens', 'Setter' or 'Traversal' to an integral power. -- -- >>> (1,2) & _2 ^^~ (-1) -- (1,0.5) -- -- @ -- ('^^~') :: ('Fractional' a, 'Integral' e) => 'Setter'' s a -> e -> s -> s -- ('^^~') :: ('Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> s -> s -- ('^^~') :: ('Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> s -> s -- ('^^~') :: ('Fractional' a, 'Integral' e) => 'Traversal'' s a -> e -> s -> s -- @ -- (^^~) :: (Fractional a, Integral e) => ASetter s t a a -> e -> s -> t l ^^~ n = over l (^^ n) {-# INLINE (^^~) #-} -- | Raise the target(s) of a floating-point valued 'Lens', 'Setter' or 'Traversal' to an arbitrary power. -- -- >>> (a,b) & _1 **~ c -- (a**c,b) -- -- >>> (a,b) & both **~ c -- (a**c,b**c) -- -- >>> _2 **~ 10 $ (3,2) -- (3,1024.0) -- -- @ -- ('**~') :: 'Floating' a => 'Setter'' s a -> a -> s -> s -- ('**~') :: 'Floating' a => 'Iso'' s a -> a -> s -> s -- ('**~') :: 'Floating' a => 'Lens'' s a -> a -> s -> s -- ('**~') :: 'Floating' a => 'Traversal'' s a -> a -> s -> s -- @ (**~) :: Floating a => ASetter s t a a -> a -> s -> t l **~ n = over l (** n) {-# INLINE (**~) #-} -- | Logically '||' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'. -- -- >>> both ||~ True $ (False,True) -- (True,True) -- -- >>> both ||~ False $ (False,True) -- (False,True) -- -- @ -- ('||~') :: 'Setter'' s 'Bool' -> 'Bool' -> s -> s -- ('||~') :: 'Iso'' s 'Bool' -> 'Bool' -> s -> s -- ('||~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> s -- ('||~') :: 'Traversal'' s 'Bool' -> 'Bool' -> s -> s -- @ (||~):: ASetter s t Bool Bool -> Bool -> s -> t l ||~ n = over l (|| n) {-# INLINE (||~) #-} -- | Logically '&&' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'. -- -- >>> both &&~ True $ (False, True) -- (False,True) -- -- >>> both &&~ False $ (False, True) -- (False,False) -- -- @ -- ('&&~') :: 'Setter'' s 'Bool' -> 'Bool' -> s -> s -- ('&&~') :: 'Iso'' s 'Bool' -> 'Bool' -> s -> s -- ('&&~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> s -- ('&&~') :: 'Traversal'' s 'Bool' -> 'Bool' -> s -> s -- @ (&&~) :: ASetter s t Bool Bool -> Bool -> s -> t l &&~ n = over l (&& n) {-# INLINE (&&~) #-} ------------------------------------------------------------------------------ -- Using Setters with State ------------------------------------------------------------------------------ -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic -- state with a new value, irrespective of the old. -- -- This is an alias for ('.='). -- -- >>> execState (do assign _1 c; assign _2 d) (a,b) -- (c,d) -- -- >>> execState (both .= c) (a,b) -- (c,c) -- -- @ -- 'assign' :: 'MonadState' s m => 'Iso'' s a -> a -> m () -- 'assign' :: 'MonadState' s m => 'Lens'' s a -> a -> m () -- 'assign' :: 'MonadState' s m => 'Traversal'' s a -> a -> m () -- 'assign' :: 'MonadState' s m => 'Setter'' s a -> a -> m () -- @ assign :: MonadState s m => ASetter s s a b -> b -> m () assign l b = State.modify (set l b) {-# INLINE assign #-} -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' -- or 'Traversal' in our monadic state with a new value, irrespective of the -- old. -- -- This is an infix version of 'assign'. -- -- >>> execState (do _1 .= c; _2 .= d) (a,b) -- (c,d) -- -- >>> execState (both .= c) (a,b) -- (c,c) -- -- @ -- ('.=') :: 'MonadState' s m => 'Iso'' s a -> a -> m () -- ('.=') :: 'MonadState' s m => 'Lens'' s a -> a -> m () -- ('.=') :: 'MonadState' s m => 'Traversal'' s a -> a -> m () -- ('.=') :: 'MonadState' s m => 'Setter'' s a -> a -> m () -- @ -- -- /It puts the state in the monad or it gets the hose again./ (.=) :: MonadState s m => ASetter s s a b -> b -> m () l .= b = State.modify (l .~ b) {-# INLINE (.=) #-} -- | Map over the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic state. -- -- >>> execState (do _1 %= f;_2 %= g) (a,b) -- (f a,g b) -- -- >>> execState (do both %= f) (a,b) -- (f a,f b) -- -- @ -- ('%=') :: 'MonadState' s m => 'Iso'' s a -> (a -> a) -> m () -- ('%=') :: 'MonadState' s m => 'Lens'' s a -> (a -> a) -> m () -- ('%=') :: 'MonadState' s m => 'Traversal'' s a -> (a -> a) -> m () -- ('%=') :: 'MonadState' s m => 'Setter'' s a -> (a -> a) -> m () -- @ -- -- @ -- ('%=') :: 'MonadState' s m => 'ASetter' s s a b -> (a -> b) -> m () -- @ (%=) :: MonadState s m => ASetter s s a b -> (a -> b) -> m () l %= f = State.modify (l %~ f) {-# INLINE (%=) #-} -- | This is an alias for ('%='). modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m () modifying l f = State.modify (over l f) {-# INLINE modifying #-} -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic -- state with 'Just' a new value, irrespective of the old. -- -- >>> execState (do at 1 ?= a; at 2 ?= b) Map.empty -- fromList [(1,a),(2,b)] -- -- >>> execState (do _1 ?= b; _2 ?= c) (Just a, Nothing) -- (Just b,Just c) -- -- @ -- ('?=') :: 'MonadState' s m => 'Iso'' s ('Maybe' a) -> a -> m () -- ('?=') :: 'MonadState' s m => 'Lens'' s ('Maybe' a) -> a -> m () -- ('?=') :: 'MonadState' s m => 'Traversal'' s ('Maybe' a) -> a -> m () -- ('?=') :: 'MonadState' s m => 'Setter'' s ('Maybe' a) -> a -> m () -- @ (?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m () l ?= b = State.modify (l ?~ b) {-# INLINE (?=) #-} -- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by adding a value. -- -- Example: -- -- @ -- 'fresh' :: 'MonadState' 'Int' m => m 'Int' -- 'fresh' = do -- 'id' '+=' 1 -- 'Control.Lens.Getter.use' 'id' -- @ -- -- >>> execState (do _1 += c; _2 += d) (a,b) -- (a + c,b + d) -- -- >>> execState (do _1.at 1.non 0 += 10) (Map.fromList [(2,100)],"hello") -- (fromList [(1,10),(2,100)],"hello") -- -- @ -- ('+=') :: ('MonadState' s m, 'Num' a) => 'Setter'' s a -> a -> m () -- ('+=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m () -- ('+=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m () -- ('+=') :: ('MonadState' s m, 'Num' a) => 'Traversal'' s a -> a -> m () -- @ (+=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () l += b = State.modify (l +~ b) {-# INLINE (+=) #-} -- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by subtracting a value. -- -- >>> execState (do _1 -= c; _2 -= d) (a,b) -- (a - c,b - d) -- -- @ -- ('-=') :: ('MonadState' s m, 'Num' a) => 'Setter'' s a -> a -> m () -- ('-=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m () -- ('-=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m () -- ('-=') :: ('MonadState' s m, 'Num' a) => 'Traversal'' s a -> a -> m () -- @ (-=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () l -= b = State.modify (l -~ b) {-# INLINE (-=) #-} -- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by multiplying by value. -- -- >>> execState (do _1 *= c; _2 *= d) (a,b) -- (a * c,b * d) -- -- @ -- ('*=') :: ('MonadState' s m, 'Num' a) => 'Setter'' s a -> a -> m () -- ('*=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m () -- ('*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m () -- ('*=') :: ('MonadState' s m, 'Num' a) => 'Traversal'' s a -> a -> m () -- @ (*=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () l *= b = State.modify (l *~ b) {-# INLINE (*=) #-} -- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by dividing by a value. -- -- >>> execState (do _1 //= c; _2 //= d) (a,b) -- (a / c,b / d) -- -- @ -- ('//=') :: ('MonadState' s m, 'Fractional' a) => 'Setter'' s a -> a -> m () -- ('//=') :: ('MonadState' s m, 'Fractional' a) => 'Iso'' s a -> a -> m () -- ('//=') :: ('MonadState' s m, 'Fractional' a) => 'Lens'' s a -> a -> m () -- ('//=') :: ('MonadState' s m, 'Fractional' a) => 'Traversal'' s a -> a -> m () -- @ (//=) :: (MonadState s m, Fractional a) => ASetter' s a -> a -> m () l //= a = State.modify (l //~ a) {-# INLINE (//=) #-} -- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to a non-negative integral power. -- -- @ -- ('^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Setter'' s a -> e -> m () -- ('^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Iso'' s a -> e -> m () -- ('^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Lens'' s a -> e -> m () -- ('^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Traversal'' s a -> e -> m () -- @ (^=) :: (MonadState s m, Num a, Integral e) => ASetter' s a -> e -> m () l ^= e = State.modify (l ^~ e) {-# INLINE (^=) #-} -- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to an integral power. -- -- @ -- ('^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Setter'' s a -> e -> m () -- ('^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> m () -- ('^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> m () -- ('^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Traversal'' s a -> e -> m () -- @ (^^=) :: (MonadState s m, Fractional a, Integral e) => ASetter' s a -> e -> m () l ^^= e = State.modify (l ^^~ e) {-# INLINE (^^=) #-} -- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to an arbitrary power -- -- >>> execState (do _1 **= c; _2 **= d) (a,b) -- (a**c,b**d) -- -- @ -- ('**=') :: ('MonadState' s m, 'Floating' a) => 'Setter'' s a -> a -> m () -- ('**=') :: ('MonadState' s m, 'Floating' a) => 'Iso'' s a -> a -> m () -- ('**=') :: ('MonadState' s m, 'Floating' a) => 'Lens'' s a -> a -> m () -- ('**=') :: ('MonadState' s m, 'Floating' a) => 'Traversal'' s a -> a -> m () -- @ (**=) :: (MonadState s m, Floating a) => ASetter' s a -> a -> m () l **= a = State.modify (l **~ a) {-# INLINE (**=) #-} -- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by taking their logical '&&' with a value. -- -- >>> execState (do _1 &&= True; _2 &&= False; _3 &&= True; _4 &&= False) (True,True,False,False) -- (True,False,False,False) -- -- @ -- ('&&=') :: 'MonadState' s m => 'Setter'' s 'Bool' -> 'Bool' -> m () -- ('&&=') :: 'MonadState' s m => 'Iso'' s 'Bool' -> 'Bool' -> m () -- ('&&=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m () -- ('&&=') :: 'MonadState' s m => 'Traversal'' s 'Bool' -> 'Bool' -> m () -- @ (&&=):: MonadState s m => ASetter' s Bool -> Bool -> m () l &&= b = State.modify (l &&~ b) {-# INLINE (&&=) #-} -- | Modify the target(s) of a 'Lens'', 'Iso, 'Setter' or 'Traversal' by taking their logical '||' with a value. -- -- >>> execState (do _1 ||= True; _2 ||= False; _3 ||= True; _4 ||= False) (True,True,False,False) -- (True,True,True,False) -- -- @ -- ('||=') :: 'MonadState' s m => 'Setter'' s 'Bool' -> 'Bool' -> m () -- ('||=') :: 'MonadState' s m => 'Iso'' s 'Bool' -> 'Bool' -> m () -- ('||=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m () -- ('||=') :: 'MonadState' s m => 'Traversal'' s 'Bool' -> 'Bool' -> m () -- @ (||=) :: MonadState s m => ASetter' s Bool -> Bool -> m () l ||= b = State.modify (l ||~ b) {-# INLINE (||=) #-} -- | Run a monadic action, and set all of the targets of a 'Lens', 'Setter' or 'Traversal' to its result. -- -- @ -- ('<~') :: 'MonadState' s m => 'Iso' s s a b -> m b -> m () -- ('<~') :: 'MonadState' s m => 'Lens' s s a b -> m b -> m () -- ('<~') :: 'MonadState' s m => 'Traversal' s s a b -> m b -> m () -- ('<~') :: 'MonadState' s m => 'Setter' s s a b -> m b -> 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 -- ... -- @ -- -- will store the result in a variable, while -- -- @ -- do foo '<~' bar -- ... -- @ -- -- will store the result in a 'Lens', 'Setter', or 'Traversal'. (<~) :: MonadState s m => ASetter s s a b -> m b -> m () l <~ mb = mb >>= (l .=) {-# INLINE (<~) #-} -- | Set with pass-through -- -- This is useful for chaining assignment without round-tripping through your 'Monad' stack. -- -- @ -- do x <- 'Control.Lens.Tuple._2' '<.=' ninety_nine_bottles_of_beer_on_the_wall -- @ -- -- If you do not need a copy of the intermediate result, then using @l '.=' d@ will avoid unused binding warnings. -- -- @ -- ('<.=') :: 'MonadState' s m => 'Setter' s s a b -> b -> m b -- ('<.=') :: 'MonadState' s m => 'Iso' s s a b -> b -> m b -- ('<.=') :: 'MonadState' s m => 'Lens' s s a b -> b -> m b -- ('<.=') :: 'MonadState' s m => 'Traversal' s s a b -> b -> m b -- @ (<.=) :: MonadState s m => ASetter s s a b -> b -> m b l <.= b = do l .= b return b {-# INLINE (<.=) #-} -- | Set 'Just' a value with pass-through -- -- This is useful for chaining assignment without round-tripping through your 'Monad' stack. -- -- @ -- do x <- 'Control.Lens.At.at' "foo" ' 'Setter' s s a ('Maybe' b) -> b -> m b -- (' 'Iso' s s a ('Maybe' b) -> b -> m b -- (' 'Lens' s s a ('Maybe' b) -> b -> m b -- (' 'Traversal' s s a ('Maybe' b) -> b -> m b -- @ ( ASetter s s a (Maybe b) -> b -> m b l >> (Sum a,b) & _1 <>~ Sum c -- (Sum {getSum = a + c},b) -- -- >>> (Sum a,Sum b) & both <>~ Sum c -- (Sum {getSum = a + c},Sum {getSum = b + c}) -- -- >>> both <>~ "!!!" $ ("hello","world") -- ("hello!!!","world!!!") -- -- @ -- ('<>~') :: 'Monoid' a => 'Setter' s t a a -> a -> s -> t -- ('<>~') :: 'Monoid' a => 'Iso' s t a a -> a -> s -> t -- ('<>~') :: 'Monoid' a => 'Lens' s t a a -> a -> s -> t -- ('<>~') :: 'Monoid' a => 'Traversal' s t a a -> a -> s -> t -- @ (<>~) :: Monoid a => ASetter s t a a -> a -> s -> t l <>~ n = over l (`mappend` n) {-# INLINE (<>~) #-} -- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by 'mappend'ing a value. -- -- >>> execState (do _1 <>= Sum c; _2 <>= Product d) (Sum a,Product b) -- (Sum {getSum = a + c},Product {getProduct = b * d}) -- -- >>> execState (both <>= "!!!") ("hello","world") -- ("hello!!!","world!!!") -- -- @ -- ('<>=') :: ('MonadState' s m, 'Monoid' a) => 'Setter'' s a -> a -> m () -- ('<>=') :: ('MonadState' s m, 'Monoid' a) => 'Iso'' s a -> a -> m () -- ('<>=') :: ('MonadState' s m, 'Monoid' a) => 'Lens'' s a -> a -> m () -- ('<>=') :: ('MonadState' s m, 'Monoid' a) => 'Traversal'' s a -> a -> m () -- @ (<>=) :: (MonadState s m, Monoid a) => ASetter' s a -> a -> m () l <>= a = State.modify (l <>~ a) {-# INLINE (<>=) #-} ----------------------------------------------------------------------------- -- Writer Operations ---------------------------------------------------------------------------- -- | Write to a fragment of a larger 'Writer' format. scribe :: (MonadWriter t m, Monoid s) => ASetter s t a b -> b -> m () scribe l b = tell (set l b mempty) {-# INLINE scribe #-} -- | This is a generalization of 'pass' that alows you to modify just a -- portion of the resulting 'MonadWriter'. passing :: MonadWriter w m => Setter w w u v -> m (a, u -> v) -> m a passing l m = pass $ do (a, uv) <- m return (a, over l uv) {-# INLINE passing #-} -- | This is a generalization of 'pass' that alows you to modify just a -- portion of the resulting 'MonadWriter' with access to the index of an -- 'IndexedSetter'. ipassing :: MonadWriter w m => IndexedSetter i w w u v -> m (a, i -> u -> v) -> m a ipassing l m = pass $ do (a, uv) <- m return (a, iover l uv) {-# INLINE ipassing #-} -- | This is a generalization of 'censor' that alows you to 'censor' just a -- portion of the resulting 'MonadWriter'. censoring :: MonadWriter w m => Setter w w u v -> (u -> v) -> m a -> m a censoring l uv = censor (over l uv) {-# INLINE censoring #-} -- | This is a generalization of 'censor' that alows you to 'censor' just a -- portion of the resulting 'MonadWriter', with access to the index of an -- 'IndexedSetter'. icensoring :: MonadWriter w m => IndexedSetter i w w u v -> (i -> u -> v) -> m a -> m a icensoring l uv = censor (iover l uv) {-# INLINE icensoring #-} ----------------------------------------------------------------------------- -- Indexed Setters ---------------------------------------------------------------------------- -- | Map with index. This is an alias for 'imapOf'. -- -- When you do not need access to the index, then 'over' is more liberal in what it can accept. -- -- @ -- 'over' l ≡ 'iover' l '.' 'const' -- 'iover' l ≡ 'over' l '.' 'Indexed' -- @ -- -- @ -- 'iover' :: 'IndexedSetter' i s t a b -> (i -> a -> b) -> s -> t -- 'iover' :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> t -- 'iover' :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t -- @ iover :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t iover l f = runIdentity #. l (Identity #. Indexed f) {-# INLINE iover #-} -- | Set with index. Equivalent to 'iover' with the current value ignored. -- -- When you do not need access to the index, then 'set' is more liberal in what it can accept. -- -- @ -- 'set' l ≡ 'iset' l '.' 'const' -- @ -- -- @ -- 'iset' :: 'IndexedSetter' i s t a b -> (i -> b) -> s -> t -- 'iset' :: 'IndexedLens' i s t a b -> (i -> b) -> s -> t -- 'iset' :: 'IndexedTraversal' i s t a b -> (i -> b) -> s -> t -- @ iset :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t iset l = iover l . (const .) {-# INLINE iset #-} -- | Build an 'IndexedSetter' from an 'Control.Lens.Indexed.imap'-like function. -- -- Your supplied function @f@ is required to satisfy: -- -- @ -- f 'id' ≡ 'id' -- f g '.' f h ≡ f (g '.' h) -- @ -- -- Equational reasoning: -- -- @ -- 'isets' '.' 'iover' ≡ 'id' -- 'iover' '.' 'isets' ≡ 'id' -- @ -- -- Another way to view 'isets' is that it takes a \"semantic editor combinator\" -- which has been modified to carry an index and transforms it into a 'IndexedSetter'. isets :: ((i -> a -> b) -> s -> t) -> IndexedSetter i s t a b isets f = sets (f . indexed) {-# INLINE isets #-} -- | Adjust every target of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' -- with access to the index. -- -- @ -- ('%@~') ≡ 'iover' -- @ -- -- When you do not need access to the index then ('%~') is more liberal in what it can accept. -- -- @ -- l '%~' f ≡ l '%@~' 'const' f -- @ -- -- @ -- ('%@~') :: 'IndexedSetter' i s t a b -> (i -> a -> b) -> s -> t -- ('%@~') :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> t -- ('%@~') :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t -- @ (%@~) :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t (%@~) = iover {-# INLINE (%@~) #-} -- | Replace every target of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' -- with access to the index. -- -- @ -- ('.@~') ≡ 'iset' -- @ -- -- When you do not need access to the index then ('.~') is more liberal in what it can accept. -- -- @ -- l '.~' b ≡ l '.@~' 'const' b -- @ -- -- @ -- ('.@~') :: 'IndexedSetter' i s t a b -> (i -> b) -> s -> t -- ('.@~') :: 'IndexedLens' i s t a b -> (i -> b) -> s -> t -- ('.@~') :: 'IndexedTraversal' i s t a b -> (i -> b) -> s -> t -- @ (.@~) :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t l .@~ f = runIdentity #. l (Identity #. Indexed (const . f)) {-# INLINE (.@~) #-} -- | Adjust every target in the current state of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' -- with access to the index. -- -- When you do not need access to the index then ('%=') is more liberal in what it can accept. -- -- @ -- l '%=' f ≡ l '%@=' 'const' f -- @ -- -- @ -- ('%@=') :: 'MonadState' s m => 'IndexedSetter' i s s a b -> (i -> a -> b) -> m () -- ('%@=') :: 'MonadState' s m => 'IndexedLens' i s s a b -> (i -> a -> b) -> m () -- ('%@=') :: 'MonadState' s m => 'IndexedTraversal' i s t a b -> (i -> a -> b) -> m () -- @ (%@=) :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m () l %@= f = State.modify (l %@~ f) {-# INLINE (%@=) #-} -- | This is an alias for ('%@='). imodifying :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m () imodifying l f = State.modify (iover l f) {-# INLINE imodifying #-} -- | Replace every target in the current state of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' -- with access to the index. -- -- When you do not need access to the index then ('.=') is more liberal in what it can accept. -- -- @ -- l '.=' b ≡ l '.@=' 'const' b -- @ -- -- @ -- ('.@=') :: 'MonadState' s m => 'IndexedSetter' i s s a b -> (i -> b) -> m () -- ('.@=') :: 'MonadState' s m => 'IndexedLens' i s s a b -> (i -> b) -> m () -- ('.@=') :: 'MonadState' s m => 'IndexedTraversal' i s t a b -> (i -> b) -> m () -- @ (.@=) :: MonadState s m => AnIndexedSetter i s s a b -> (i -> b) -> m () l .@= f = State.modify (l .@~ f) {-# INLINE (.@=) #-} ------------------------------------------------------------------------------ -- Arrows ------------------------------------------------------------------------------ -- | Run an arrow command and use the output to set all the targets of -- a 'Lens', 'Setter' or 'Traversal' to the result. -- -- 'assignA' can be used very similarly to ('<~'), except that the type of -- the object being modified can change; for example: -- -- @ -- runKleisli action ((), (), ()) where -- action = assignA _1 (Kleisli (const getVal1)) -- \>>> assignA _2 (Kleisli (const getVal2)) -- \>>> assignA _3 (Kleisli (const getVal3)) -- getVal1 :: Either String Int -- getVal1 = ... -- getVal2 :: Either String Bool -- getVal2 = ... -- getVal3 :: Either String Char -- getVal3 = ... -- @ -- -- has the type @'Either' 'String' ('Int', 'Bool', 'Char')@ -- -- @ -- 'assignA' :: 'Arrow' p => 'Iso' s t a b -> p s b -> p s t -- 'assignA' :: 'Arrow' p => 'Lens' s t a b -> p s b -> p s t -- 'assignA' :: 'Arrow' p => 'Traversal' s t a b -> p s b -> p s t -- 'assignA' :: 'Arrow' p => 'Setter' s t a b -> p s b -> p s t -- @ assignA :: Arrow p => ASetter s t a b -> p s b -> p s t assignA l p = arr (flip $ set l) &&& p >>> arr (uncurry id) {-# INLINE assignA #-} ------------------------------------------------------------------------------ -- Deprecated ------------------------------------------------------------------------------ -- | 'mapOf' is a deprecated alias for 'over'. mapOf :: ASetter s t a b -> (a -> b) -> s -> t mapOf = over {-# INLINE mapOf #-} {-# DEPRECATED mapOf "Use `over`" #-} -- | Map with index. (Deprecated alias for 'iover'). -- -- When you do not need access to the index, then 'mapOf' is more liberal in what it can accept. -- -- @ -- 'mapOf' l ≡ 'imapOf' l '.' 'const' -- @ -- -- @ -- 'imapOf' :: 'IndexedSetter' i s t a b -> (i -> a -> b) -> s -> t -- 'imapOf' :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> t -- 'imapOf' :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t -- @ imapOf :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t imapOf = iover {-# INLINE imapOf #-} {-# DEPRECATED imapOf "Use `iover`" #-} lens-4.14/src/Control/Lens/TH.hs0000644000000000000000000006552012710476104014562 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #ifndef MIN_VERSION_template_haskell #define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706) #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.TH -- Copyright : (C) 2012-16 Edward Kmett, 2012-13 Michael Sloan -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ----------------------------------------------------------------------------- module Control.Lens.TH ( -- * Constructing Lenses Automatically -- ** Lenses for data fields makeLenses, makeLensesFor , makeClassy, makeClassyFor, makeClassy_ , makeFields -- ** Prisms , makePrisms , makeClassyPrisms -- ** Wrapped , makeWrapped -- * Constructing Lenses Given a Declaration Quote -- ** Lenses for data fields , declareLenses, declareLensesFor , declareClassy, declareClassyFor , declareFields -- ** Prisms , declarePrisms -- ** Wrapped , declareWrapped -- * Configuring Lenses -- ** Running LensRules , makeLensesWith , declareLensesWith -- ** LensRules type , LensRules -- ** Predefined LensRules , lensRules , lensRulesFor , classyRules , classyRules_ , defaultFieldRules , camelCaseFields , underscoreFields , abbreviatedFields -- ** LensRules configuration accessors , lensField , FieldNamer , DefName(..) , lensClass , ClassyNamer , simpleLenses , createClass , generateSignatures , generateUpdateableOptics , generateLazyPatterns -- ** FieldNamers , underscoreNoPrefixNamer , lookingupNamer , mappingNamer , camelCaseNamer , underscoreNamer , abbreviatedNamer ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif #if !(MIN_VERSION_template_haskell(2,7,0)) import Control.Monad (ap) #endif import qualified Control.Monad.Trans as Trans import Control.Monad.Trans.Writer import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Lens import Control.Lens.Setter import Control.Lens.Tuple import Control.Lens.Traversal import Control.Lens.Internal.TH import Control.Lens.Internal.FieldTH import Control.Lens.Internal.PrismTH import Control.Lens.Wrapped () -- haddocks import Control.Lens.Type () -- haddocks import Data.Char (toLower, isUpper) import Data.Foldable hiding (concat, any) import Data.List as List import Data.Map as Map hiding (toList,map,filter) import Data.Maybe (maybeToList) import Data.Monoid import Data.Set as Set hiding (toList,map,filter) import Data.Set.Lens import Data.Traversable hiding (mapM) import Language.Haskell.TH import Language.Haskell.TH.Lens import Language.Haskell.TH.Syntax #ifdef HLINT {-# ANN module "HLint: ignore Eta reduce" #-} {-# ANN module "HLint: ignore Use fewer imports" #-} {-# ANN module "HLint: ignore Use foldl" #-} #endif -- | Generate "simple" optics even when type-changing optics are possible. -- (e.g. 'Lens'' instead of 'Lens') simpleLenses :: Lens' LensRules Bool simpleLenses f r = fmap (\x -> r { _simpleLenses = x}) (f (_simpleLenses r)) -- | Indicate whether or not to supply the signatures for the generated -- lenses. -- -- Disabling this can be useful if you want to provide a more restricted type -- signature or if you want to supply hand-written haddocks. generateSignatures :: Lens' LensRules Bool generateSignatures f r = fmap (\x -> r { _generateSigs = x}) (f (_generateSigs r)) -- | Generate "updateable" optics when 'True'. When 'False', 'Fold's will be -- generated instead of 'Traversal's and 'Getter's will be generated instead -- of 'Lens'es. This mode is intended to be used for types with invariants -- which must be maintained by "smart" constructors. generateUpdateableOptics :: Lens' LensRules Bool generateUpdateableOptics f r = fmap (\x -> r { _allowUpdates = x}) (f (_allowUpdates r)) -- | Generate optics using lazy pattern matches. This can -- allow fields of an undefined value to be initialized with lenses: -- -- @ -- data Foo = Foo {_x :: Int, _y :: Bool} -- deriving Show -- -- 'makeLensesWith' ('lensRules' & 'generateLazyPatterns' .~ True) ''Foo -- @ -- -- @ -- > undefined & x .~ 8 & y .~ True -- Foo {_x = 8, _y = True} -- @ -- -- The downside of this flag is that it can lead to space-leaks and -- code-size/compile-time increases when generated for large records. By -- default this flag is turned off, and strict optics are generated. -- -- When using lazy optics the strict optic can be recovered by composing -- with '$!': -- -- @ -- strictOptic = ($!) . lazyOptic -- @ generateLazyPatterns :: Lens' LensRules Bool generateLazyPatterns f r = fmap (\x -> r { _lazyPatterns = x}) (f (_lazyPatterns r)) -- | Create the class if the constructor is 'Control.Lens.Type.Simple' and the -- 'lensClass' rule matches. createClass :: Lens' LensRules Bool createClass f r = fmap (\x -> r { _generateClasses = x}) (f (_generateClasses r)) -- | 'Lens'' to access the convention for naming fields in our 'LensRules'. lensField :: Lens' LensRules FieldNamer lensField f r = fmap (\x -> r { _fieldToDef = x}) (f (_fieldToDef r)) -- | The rule to create function names of lenses for data fields. -- -- Although it's sometimes useful, you won't need the first two -- arguments most of the time. type FieldNamer = Name -- ^ Name of the data type that lenses are being generated for. -> [Name] -- ^ Names of all fields (including the field being named) in the data type. -> Name -- ^ Name of the field being named. -> [DefName] -- ^ Name(s) of the lens functions. If empty, no lens is created for that field. -- | 'Lens'' to access the option for naming "classy" lenses. lensClass :: Lens' LensRules ClassyNamer lensClass f r = fmap (\x -> r { _classyLenses = x }) (f (_classyLenses r)) -- | The optional rule to create a class and method around a -- monomorphic data type. If this naming convention is provided, it -- generates a "classy" lens. type ClassyNamer = Name -- ^ Name of the data type that lenses are being generated for. -> Maybe (Name, Name) -- ^ Names of the class and the main method it generates, respectively. -- | Rules for making fairly simple partial lenses, ignoring the special cases -- for isomorphisms and traversals, and not making any classes. -- It uses 'underscoreNoPrefixNamer'. lensRules :: LensRules lensRules = LensRules { _simpleLenses = False , _generateSigs = True , _generateClasses = False , _allowIsos = True , _allowUpdates = True , _lazyPatterns = False , _classyLenses = const Nothing , _fieldToDef = underscoreNoPrefixNamer } -- | A 'FieldNamer' that strips the _ off of the field name, -- lowercases the name, and skips the field if it doesn't start with -- an '_'. underscoreNoPrefixNamer :: FieldNamer underscoreNoPrefixNamer _ _ n = case nameBase n of '_':x:xs -> [TopName (mkName (toLower x:xs))] _ -> [] -- | Construct a 'LensRules' value for generating top-level definitions -- using the given map from field names to definition names. lensRulesFor :: [(String, String)] {- ^ [(Field Name, Definition Name)] -} -> LensRules lensRulesFor fields = lensRules & lensField .~ lookingupNamer fields -- | Create a 'FieldNamer' from explicit pairings of @(fieldName, lensName)@. lookingupNamer :: [(String,String)] -> FieldNamer lookingupNamer kvs _ _ field = [ TopName (mkName v) | (k,v) <- kvs, k == nameBase field] -- | Create a 'FieldNamer' from a mapping function. If the function -- returns @[]@, it creates no lens for the field. mappingNamer :: (String -> [String]) -- ^ A function that maps a @fieldName@ to @lensName@s. -> FieldNamer mappingNamer mapper _ _ = fmap (TopName . mkName) . mapper . nameBase -- | Rules for making lenses and traversals that precompose another 'Lens'. classyRules :: LensRules classyRules = LensRules { _simpleLenses = True , _generateSigs = True , _generateClasses = True , _allowIsos = False -- generating Isos would hinder "subtyping" , _allowUpdates = True , _lazyPatterns = False , _classyLenses = \n -> case nameBase n of x:xs -> Just (mkName ("Has" ++ x:xs), mkName (toLower x:xs)) [] -> Nothing , _fieldToDef = underscoreNoPrefixNamer } -- | Rules for making lenses and traversals that precompose another 'Lens' -- using a custom function for naming the class, main class method, and a -- mapping from field names to definition names. classyRulesFor :: (String -> Maybe (String, String)) {- ^ Type Name -> Maybe (Class Name, Method Name) -} -> [(String, String)] {- ^ [(Field Name, Method Name)] -} -> LensRules classyRulesFor classFun fields = classyRules & lensClass .~ (over (mapped . both) mkName . classFun . nameBase) & lensField .~ lookingupNamer fields -- | A 'LensRules' used by 'makeClassy_'. classyRules_ :: LensRules classyRules_ = classyRules & lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))] -- | Build lenses (and traversals) with a sensible default configuration. -- -- /e.g./ -- -- @ -- data FooBar -- = Foo { _x, _y :: 'Int' } -- | Bar { _x :: 'Int' } -- 'makeLenses' ''FooBar -- @ -- -- will create -- -- @ -- x :: 'Lens'' FooBar 'Int' -- x f (Foo a b) = (\\a\' -> Foo a\' b) \<$\> f a -- x f (Bar a) = Bar \<$\> f a -- y :: 'Traversal'' FooBar 'Int' -- y f (Foo a b) = (\\b\' -> Foo a b\') \<$\> f b -- y _ c\@(Bar _) = pure c -- @ -- -- @ -- 'makeLenses' = 'makeLensesWith' 'lensRules' -- @ makeLenses :: Name -> DecsQ makeLenses = makeFieldOptics lensRules -- | Make lenses and traversals for a type, and create a class when the -- type has no arguments. -- -- /e.g./ -- -- @ -- data Foo = Foo { _fooX, _fooY :: 'Int' } -- 'makeClassy' ''Foo -- @ -- -- will create -- -- @ -- class HasFoo t where -- foo :: 'Lens'' t Foo -- fooX :: 'Lens'' t 'Int' -- fooX = foo . go where go f (Foo x y) = (\\x\' -> Foo x' y) \<$\> f x -- fooY :: 'Lens'' t 'Int' -- fooY = foo . go where go f (Foo x y) = (\\y\' -> Foo x y') \<$\> f y -- instance HasFoo Foo where -- foo = id -- @ -- -- @ -- 'makeClassy' = 'makeLensesWith' 'classyRules' -- @ makeClassy :: Name -> DecsQ makeClassy = makeFieldOptics classyRules -- | Make lenses and traversals for a type, and create a class when the type -- has no arguments. Works the same as 'makeClassy' except that (a) it -- expects that record field names do not begin with an underscore, (b) all -- record fields are made into lenses, and (c) the resulting lens is prefixed -- with an underscore. makeClassy_ :: Name -> DecsQ makeClassy_ = makeFieldOptics classyRules_ -- | Derive lenses and traversals, specifying explicit pairings -- of @(fieldName, lensName)@. -- -- If you map multiple names to the same label, and it is present in the same -- constructor then this will generate a 'Traversal'. -- -- /e.g./ -- -- @ -- 'makeLensesFor' [(\"_foo\", \"fooLens\"), (\"baz\", \"lbaz\")] ''Foo -- 'makeLensesFor' [(\"_barX\", \"bar\"), (\"_barY\", \"bar\")] ''Bar -- @ makeLensesFor :: [(String, String)] -> Name -> DecsQ makeLensesFor fields = makeFieldOptics (lensRulesFor fields) -- | Derive lenses and traversals, using a named wrapper class, and -- specifying explicit pairings of @(fieldName, traversalName)@. -- -- Example usage: -- -- @ -- 'makeClassyFor' \"HasFoo\" \"foo\" [(\"_foo\", \"fooLens\"), (\"bar\", \"lbar\")] ''Foo -- @ makeClassyFor :: String -> String -> [(String, String)] -> Name -> DecsQ makeClassyFor clsName funName fields = makeFieldOptics $ classyRulesFor (const (Just (clsName, funName))) fields -- | Build lenses with a custom configuration. makeLensesWith :: LensRules -> Name -> DecsQ makeLensesWith = makeFieldOptics -- | Make lenses for all records in the given declaration quote. All record -- syntax in the input will be stripped off. -- -- /e.g./ -- -- @ -- declareLenses [d| -- data Foo = Foo { fooX, fooY :: 'Int' } -- deriving 'Show' -- |] -- @ -- -- will create -- -- @ -- data Foo = Foo 'Int' 'Int' deriving 'Show' -- fooX, fooY :: 'Lens'' Foo Int -- @ declareLenses :: DecsQ -> DecsQ declareLenses = declareLensesWith $ lensRules & lensField .~ \_ _ n -> [TopName n] -- | Similar to 'makeLensesFor', but takes a declaration quote. declareLensesFor :: [(String, String)] -> DecsQ -> DecsQ declareLensesFor fields = declareLensesWith $ lensRulesFor fields & lensField .~ \_ _ n -> [TopName n] -- | For each record in the declaration quote, make lenses and traversals for -- it, and create a class when the type has no arguments. All record syntax -- in the input will be stripped off. -- -- /e.g./ -- -- @ -- declareClassy [d| -- data Foo = Foo { fooX, fooY :: 'Int' } -- deriving 'Show' -- |] -- @ -- -- will create -- -- @ -- data Foo = Foo 'Int' 'Int' deriving 'Show' -- class HasFoo t where -- foo :: 'Lens'' t Foo -- instance HasFoo Foo where foo = 'id' -- fooX, fooY :: HasFoo t => 'Lens'' t 'Int' -- @ declareClassy :: DecsQ -> DecsQ declareClassy = declareLensesWith $ classyRules & lensField .~ \_ _ n -> [TopName n] -- | Similar to 'makeClassyFor', but takes a declaration quote. declareClassyFor :: [(String, (String, String))] -> [(String, String)] -> DecsQ -> DecsQ declareClassyFor classes fields = declareLensesWith $ classyRulesFor (`Prelude.lookup`classes) fields & lensField .~ \_ _ n -> [TopName n] -- | Generate a 'Control.Lens.Type.Prism' for each constructor of each data type. -- -- /e.g./ -- -- @ -- declarePrisms [d| -- data Exp = Lit Int | Var String | Lambda{ bound::String, body::Exp } -- |] -- @ -- -- will create -- -- @ -- data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp } -- _Lit :: 'Prism'' Exp Int -- _Var :: 'Prism'' Exp String -- _Lambda :: 'Prism'' Exp (String, Exp) -- @ declarePrisms :: DecsQ -> DecsQ declarePrisms = declareWith $ \dec -> do emit =<< Trans.lift (makeDecPrisms True dec) return dec -- | Build 'Control.Lens.Wrapped.Wrapped' instance for each newtype. declareWrapped :: DecsQ -> DecsQ declareWrapped = declareWith $ \dec -> do maybeDecs <- Trans.lift (makeWrappedForDec dec) forM_ maybeDecs emit return dec -- | @ declareFields = 'declareLensesWith' 'defaultFieldRules' @ declareFields :: DecsQ -> DecsQ declareFields = declareLensesWith defaultFieldRules -- | Declare lenses for each records in the given declarations, using the -- specified 'LensRules'. Any record syntax in the input will be stripped -- off. declareLensesWith :: LensRules -> DecsQ -> DecsQ declareLensesWith rules = declareWith $ \dec -> do emit =<< Trans.lift (makeFieldOpticsForDec rules dec) return $ stripFields dec ----------------------------------------------------------------------------- -- Internal TH Implementation ----------------------------------------------------------------------------- -- | Transform @NewtypeD@s declarations to @DataD@s and @NewtypeInstD@s to -- @DataInstD@s. deNewtype :: Dec -> Dec #if MIN_VERSION_template_haskell(2,11,0) deNewtype (NewtypeD ctx tyName args kind c d) = DataD ctx tyName args kind [c] d deNewtype (NewtypeInstD ctx tyName args kind c d) = DataInstD ctx tyName args kind [c] d #else deNewtype (NewtypeD ctx tyName args c d) = DataD ctx tyName args [c] d deNewtype (NewtypeInstD ctx tyName args c d) = DataInstD ctx tyName args [c] d #endif deNewtype d = d -- | Given a set of names, build a map from those names to a set of fresh names -- based on them. freshMap :: Set Name -> Q (Map Name Name) freshMap ns = Map.fromList <$> for (toList ns) (\ n -> (,) n <$> newName (nameBase n)) apps :: Type -> [Type] -> Type apps = Prelude.foldl AppT makeDataDecl :: Dec -> Maybe DataDecl makeDataDecl dec = case deNewtype dec of DataD ctx tyName args #if MIN_VERSION_template_haskell(2,11,0) _ #endif cons _ -> Just DataDecl { dataContext = ctx , tyConName = Just tyName , dataParameters = args , fullType = apps $ ConT tyName , constructors = cons } DataInstD ctx familyName args #if MIN_VERSION_template_haskell(2,11,0) _ #endif cons _ -> Just DataDecl { dataContext = ctx , tyConName = Nothing , dataParameters = map PlainTV vars , fullType = \tys -> apps (ConT familyName) $ substType (Map.fromList $ zip vars tys) args , constructors = cons } where -- The list of "type parameters" to a data family instance is not -- explicitly specified in the source. Here we define it to be -- the set of distinct type variables that appear in the LHS. e.g. -- -- data instance F a Int (Maybe (a, b)) = G -- -- has 2 type parameters: a and b. vars = toList $ setOf typeVars args _ -> Nothing -- | A data, newtype, data instance or newtype instance declaration. data DataDecl = DataDecl { dataContext :: Cxt -- ^ Datatype context. , tyConName :: Maybe Name -- ^ Type constructor name, or Nothing for a data family instance. , dataParameters :: [TyVarBndr] -- ^ List of type parameters , fullType :: [Type] -> Type -- ^ Create a concrete record type given a substitution to -- 'detaParameters'. , constructors :: [Con] -- ^ Constructors -- , derivings :: [Name] -- currently not needed } -- | Build 'Wrapped' instance for a given newtype makeWrapped :: Name -> DecsQ makeWrapped nm = do inf <- reify nm case inf of TyConI decl -> do maybeDecs <- makeWrappedForDec decl maybe (fail "makeWrapped: Unsupported data type") return maybeDecs _ -> fail "makeWrapped: Expected the name of a newtype or datatype" makeWrappedForDec :: Dec -> Q (Maybe [Dec]) makeWrappedForDec decl = case makeDataDecl decl of Just dataDecl | [con] <- constructors dataDecl , [field] <- toListOf (conFields._2) con -> do wrapped <- makeWrappedInstance dataDecl con field rewrapped <- makeRewrappedInstance dataDecl return (Just [rewrapped, wrapped]) _ -> return Nothing makeRewrappedInstance :: DataDecl -> DecQ makeRewrappedInstance dataDecl = do t <- varT <$> newName "t" let typeArgs = map (view name) (dataParameters dataDecl) typeArgs' <- do m <- freshMap (Set.fromList typeArgs) return (substTypeVars m typeArgs) -- Con a b c... let appliedType = return (fullType dataDecl (map VarT typeArgs)) -- Con a' b' c'... appliedType' = return (fullType dataDecl (map VarT typeArgs')) -- Con a' b' c'... ~ t #if MIN_VERSION_template_haskell(2,10,0) eq = AppT. AppT EqualityT <$> appliedType' <*> t #else eq = equalP appliedType' t #endif -- Rewrapped (Con a b c...) t klass = conT rewrappedTypeName `appsT` [appliedType, t] -- instance (Con a' b' c'... ~ t) => Rewrapped (Con a b c...) t instanceD (cxt [eq]) klass [] makeWrappedInstance :: DataDecl-> Con -> Type -> DecQ makeWrappedInstance dataDecl con fieldType = do let conName = view name con let typeArgs = toListOf typeVars (dataParameters dataDecl) -- Con a b c... let appliedType = fullType dataDecl (map VarT typeArgs) -- type Unwrapped (Con a b c...) = $fieldType let unwrappedATF = tySynInstD' unwrappedTypeName [return appliedType] (return fieldType) -- Wrapped (Con a b c...) let klass = conT wrappedTypeName `appT` return appliedType -- _Wrapped' = iso (\(Con x) -> x) Con let wrapFun = conE conName let unwrapFun = newName "x" >>= \x -> lam1E (conP conName [varP x]) (varE x) let body = appsE [varE isoValName, unwrapFun, wrapFun] let isoMethod = funD _wrapped'ValName [clause [] (normalB body) []] -- instance Wrapped (Con a b c...) where -- type Unwrapped (Con a b c...) = fieldType -- _Wrapped' = iso (\(Con x) -> x) Con instanceD (cxt []) klass [unwrappedATF, isoMethod] #if !(MIN_VERSION_template_haskell(2,7,0)) -- | The orphan instance for old versions is bad, but programming without 'Applicative' is worse. instance Applicative Q where pure = return (<*>) = ap #endif overHead :: (a -> a) -> [a] -> [a] overHead _ [] = [] overHead f (x:xs) = f x : xs -- | Field rules for fields in the form @ _prefix_fieldname @ underscoreFields :: LensRules underscoreFields = defaultFieldRules & lensField .~ underscoreNamer -- | A 'FieldNamer' for 'underscoreFields'. underscoreNamer :: FieldNamer underscoreNamer _ _ field = maybeToList $ do _ <- prefix field' method <- niceLens cls <- classNaming return (MethodName (mkName cls) (mkName method)) where field' = nameBase field prefix ('_':xs) | '_' `List.elem` xs = Just (takeWhile (/= '_') xs) prefix _ = Nothing niceLens = prefix field' <&> \n -> drop (length n + 2) field' classNaming = niceLens <&> ("Has_" ++) -- | Field rules for fields in the form @ prefixFieldname or _prefixFieldname @ -- If you want all fields to be lensed, then there is no reason to use an @_@ before the prefix. -- If any of the record fields leads with an @_@ then it is assume a field without an @_@ should not have a lens created. -- -- __Note__: The @prefix@ must be the same as the typename (with the first -- letter lowercased). This is a change from lens versions before lens 4.5. -- If you want the old behaviour, use 'makeLensesWith' 'abbreviatedFields' camelCaseFields :: LensRules camelCaseFields = defaultFieldRules -- | A 'FieldNamer' for 'camelCaseFields'. camelCaseNamer :: FieldNamer camelCaseNamer tyName fields field = maybeToList $ do fieldPart <- stripPrefix expectedPrefix (nameBase field) method <- computeMethod fieldPart let cls = "Has" ++ fieldPart return (MethodName (mkName cls) (mkName method)) where expectedPrefix = optUnderscore ++ overHead toLower (nameBase tyName) optUnderscore = ['_' | any (isPrefixOf "_" . nameBase) fields ] computeMethod (x:xs) | isUpper x = Just (toLower x : xs) computeMethod _ = Nothing -- | Field rules fields in the form @ prefixFieldname or _prefixFieldname @ -- If you want all fields to be lensed, then there is no reason to use an @_@ before the prefix. -- If any of the record fields leads with an @_@ then it is assume a field without an @_@ should not have a lens created. -- -- Note that @prefix@ may be any string of characters that are not uppercase -- letters. (In particular, it may be arbitrary string of lowercase letters -- and numbers) This is the behavior that 'defaultFieldRules' had in lens -- 4.4 and earlier. abbreviatedFields :: LensRules abbreviatedFields = defaultFieldRules { _fieldToDef = abbreviatedNamer } -- | A 'FieldNamer' for 'abbreviatedFields'. abbreviatedNamer :: FieldNamer abbreviatedNamer _ fields field = maybeToList $ do fieldPart <- stripMaxLc (nameBase field) method <- computeMethod fieldPart let cls = "Has" ++ fieldPart return (MethodName (mkName cls) (mkName method)) where stripMaxLc f = do x <- stripPrefix optUnderscore f case break isUpper x of (p,s) | List.null p || List.null s -> Nothing | otherwise -> Just s optUnderscore = ['_' | any (isPrefixOf "_" . nameBase) fields ] computeMethod (x:xs) | isUpper x = Just (toLower x : xs) computeMethod _ = Nothing -- | Generate overloaded field accessors. -- -- /e.g/ -- -- @ -- data Foo a = Foo { _fooX :: 'Int', _fooY : a } -- newtype Bar = Bar { _barX :: 'Char' } -- makeFields ''Foo -- makeFields ''Bar -- @ -- -- will create -- -- @ -- _fooXLens :: Lens' (Foo a) Int -- _fooYLens :: Lens (Foo a) (Foo b) a b -- class HasX s a | s -> a where -- x :: Lens' s a -- instance HasX (Foo a) Int where -- x = _fooXLens -- class HasY s a | s -> a where -- y :: Lens' s a -- instance HasY (Foo a) a where -- y = _fooYLens -- _barXLens :: Iso' Bar Char -- instance HasX Bar Char where -- x = _barXLens -- @ -- -- For details, see 'camelCaseFields'. -- -- @ -- makeFields = 'makeLensesWith' 'defaultFieldRules' -- @ makeFields :: Name -> DecsQ makeFields = makeFieldOptics camelCaseFields defaultFieldRules :: LensRules defaultFieldRules = LensRules { _simpleLenses = True , _generateSigs = True , _generateClasses = True -- classes will still be skipped if they already exist , _allowIsos = False -- generating Isos would hinder field class reuse , _allowUpdates = True , _lazyPatterns = False , _classyLenses = const Nothing , _fieldToDef = camelCaseNamer } -- Declaration quote stuff declareWith :: (Dec -> Declare Dec) -> DecsQ -> DecsQ declareWith fun = (runDeclare . traverseDataAndNewtype fun =<<) -- | Monad for emitting top-level declarations as a side effect. type Declare = WriterT (Endo [Dec]) Q runDeclare :: Declare [Dec] -> DecsQ runDeclare dec = do (out, endo) <- runWriterT dec return $ out ++ appEndo endo [] emit :: [Dec] -> Declare () emit decs = tell $ Endo (decs++) -- | Traverse each data, newtype, data instance or newtype instance -- declaration. traverseDataAndNewtype :: (Applicative f) => (Dec -> f Dec) -> [Dec] -> f [Dec] traverseDataAndNewtype f decs = traverse go decs where go dec = case dec of DataD{} -> f dec NewtypeD{} -> f dec DataInstD{} -> f dec NewtypeInstD{} -> f dec -- Recurse into instance declarations because they main contain -- associated data family instances. #if MIN_VERSION_template_haskell(2,11,0) InstanceD moverlap ctx inst body -> InstanceD moverlap ctx inst <$> traverse go body #else InstanceD ctx inst body -> InstanceD ctx inst <$> traverse go body #endif _ -> pure dec stripFields :: Dec -> Dec stripFields dec = case dec of #if MIN_VERSION_template_haskell(2,11,0) DataD ctx tyName tyArgs kind cons derivings -> DataD ctx tyName tyArgs kind (map deRecord cons) derivings NewtypeD ctx tyName tyArgs kind con derivings -> NewtypeD ctx tyName tyArgs kind (deRecord con) derivings DataInstD ctx tyName tyArgs kind cons derivings -> DataInstD ctx tyName tyArgs kind (map deRecord cons) derivings NewtypeInstD ctx tyName tyArgs kind con derivings -> NewtypeInstD ctx tyName tyArgs kind (deRecord con) derivings #else DataD ctx tyName tyArgs cons derivings -> DataD ctx tyName tyArgs (map deRecord cons) derivings NewtypeD ctx tyName tyArgs con derivings -> NewtypeD ctx tyName tyArgs (deRecord con) derivings DataInstD ctx tyName tyArgs cons derivings -> DataInstD ctx tyName tyArgs (map deRecord cons) derivings NewtypeInstD ctx tyName tyArgs con derivings -> NewtypeInstD ctx tyName tyArgs (deRecord con) derivings #endif _ -> dec deRecord :: Con -> Con deRecord con@NormalC{} = con deRecord con@InfixC{} = con deRecord (ForallC tyVars ctx con) = ForallC tyVars ctx $ deRecord con deRecord (RecC conName fields) = NormalC conName (map dropFieldName fields) #if MIN_VERSION_template_haskell(2,11,0) deRecord con@GadtC{} = con deRecord (RecGadtC ns fields retTy) = GadtC ns (map dropFieldName fields) retTy #endif #if MIN_VERSION_template_haskell(2,11,0) dropFieldName :: VarBangType -> BangType #else dropFieldName :: VarStrictType -> StrictType #endif dropFieldName (_, str, typ) = (str, typ) lens-4.14/src/Control/Lens/Traversal.hs0000644000000000000000000014303412710476104016207 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} #ifndef MIN_VERSION_containers #define MIN_VERSION_containers(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Traversal -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- A @'Traversal' s t a b@ is a generalization of 'traverse' from -- 'Traversable'. It allows you to 'traverse' over a structure and change out -- its contents with monadic or 'Applicative' side-effects. Starting from -- -- @ -- 'traverse' :: ('Traversable' t, 'Applicative' f) => (a -> f b) -> t a -> f (t b) -- @ -- -- we monomorphize the contents and result to obtain -- -- @ -- type 'Traversal' s t a b = forall f. 'Applicative' f => (a -> f b) -> s -> f t -- @ -- -- A 'Traversal' can be used as a 'Fold'. -- Any 'Traversal' can be used for 'Control.Lens.Getter.Getting' like a 'Fold', -- because given a 'Data.Monoid.Monoid' @m@, we have an 'Applicative' for -- @('Const' m)@. Everything you know how to do with a 'Traversable' container, -- you can with a 'Traversal', and here we provide combinators that generalize -- the usual 'Traversable' operations. ---------------------------------------------------------------------------- module Control.Lens.Traversal ( -- * Traversals Traversal, Traversal' , Traversal1, Traversal1' , IndexedTraversal, IndexedTraversal' , IndexedTraversal1, IndexedTraversal1' , ATraversal, ATraversal' , ATraversal1, ATraversal1' , AnIndexedTraversal, AnIndexedTraversal' , AnIndexedTraversal1, AnIndexedTraversal1' , Traversing, Traversing' , Traversing1, Traversing1' -- * Traversing and Lensing , traverseOf, forOf, sequenceAOf , mapMOf, forMOf, sequenceOf , transposeOf , mapAccumLOf, mapAccumROf , scanr1Of, scanl1Of , failover, ifailover -- * Monomorphic Traversals , cloneTraversal , cloneIndexPreservingTraversal , cloneIndexedTraversal , cloneTraversal1 , cloneIndexPreservingTraversal1 , cloneIndexedTraversal1 -- * Parts and Holes , partsOf, partsOf' , unsafePartsOf, unsafePartsOf' , holesOf , singular, unsafeSingular -- * Common Traversals , Traversable(traverse) , Traversable1(traverse1) , both , beside , taking , dropping , failing , deepOf -- * Indexed Traversals -- ** Common , ignored , TraverseMin(..) , TraverseMax(..) , traversed , traversed1 , traversed64 , elementOf , element , elementsOf , elements -- ** Combinators , ipartsOf , ipartsOf' , iunsafePartsOf , iunsafePartsOf' , itraverseOf , iforOf , imapMOf , iforMOf , imapAccumROf , imapAccumLOf -- * Reflection , traverseBy , traverseByOf , sequenceBy , sequenceByOf -- * Implementation Details , Bazaar(..), Bazaar' , Bazaar1(..), Bazaar1' , loci , iloci -- * Fusion , confusing ) where import Control.Applicative as Applicative import Control.Applicative.Backwards import Control.Category import Control.Comonad import Control.Lens.Fold import Control.Lens.Getter (Getting, IndexedGetting, getting) import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed import Control.Lens.Lens import Control.Lens.Setter (ASetter, AnIndexedSetter, isets, sets) import Control.Lens.Type import Control.Monad import Control.Monad.Trans.State.Lazy import Data.Bitraversable #if __GLASGOW_HASKELL__ < 710 import Data.Foldable (Foldable) #endif import Data.Functor.Compose import Data.Functor.Day.Curried import Data.Functor.Yoneda import Data.Int import Data.IntMap as IntMap import Data.Map as Map import Data.Sequence (Seq, mapWithIndex) import Data.Vector as Vector (Vector, imap) import Data.Monoid import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Profunctor.Unsafe import Data.Reflection import Data.Semigroup.Traversable import Data.Tagged import Data.Traversable import Data.Tuple (swap) import GHC.Magic (inline) import Prelude hiding ((.),id) -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Control.DeepSeq (NFData (..), force) -- >>> import Control.Exception (evaluate) -- >>> import Data.Maybe (fromMaybe) -- >>> import Debug.SimpleReflect.Vars -- >>> import Data.Void -- >>> import Data.List (sort) -- >>> import System.Timeout (timeout) -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force ------------------------------------------------------------------------------ -- Traversals ------------------------------------------------------------------------------ -- | When you see this as an argument to a function, it expects a 'Traversal'. type ATraversal s t a b = LensLike (Bazaar (->) a b) s t a b -- | @ -- type 'ATraversal'' = 'Simple' 'ATraversal' -- @ type ATraversal' s a = ATraversal s s a a -- | When you see this as an argument to a function, it expects a 'Traversal1'. type ATraversal1 s t a b = LensLike (Bazaar1 (->) a b) s t a b -- | @ -- type 'ATraversal1'' = 'Simple' 'ATraversal1' -- @ type ATraversal1' s a = ATraversal1 s s a a -- | When you see this as an argument to a function, it expects an 'IndexedTraversal'. type AnIndexedTraversal i s t a b = Over (Indexed i) (Bazaar (Indexed i) a b) s t a b -- | When you see this as an argument to a function, it expects an 'IndexedTraversal1'. type AnIndexedTraversal1 i s t a b = Over (Indexed i) (Bazaar1 (Indexed i) a b) s t a b -- | @ -- type 'AnIndexedTraversal'' = 'Simple' ('AnIndexedTraversal' i) -- @ type AnIndexedTraversal' i s a = AnIndexedTraversal i s s a a -- | @ -- type 'AnIndexedTraversal1'' = 'Simple' ('AnIndexedTraversal1' i) -- @ type AnIndexedTraversal1' i s a = AnIndexedTraversal1 i s s a a -- | When you see this as an argument to a function, it expects -- -- * to be indexed if @p@ is an instance of 'Indexed' i, -- -- * to be unindexed if @p@ is @(->)@, -- -- * a 'Traversal' if @f@ is 'Applicative', -- -- * a 'Getter' if @f@ is only a 'Functor' and 'Contravariant', -- -- * a 'Lens' if @p@ is only a 'Functor', -- -- * a 'Fold' if @f@ is 'Functor', 'Contravariant' and 'Applicative'. type Traversing p f s t a b = Over p (BazaarT p f a b) s t a b type Traversing1 p f s t a b = Over p (BazaarT1 p f a b) s t a b -- | @ -- type 'Traversing'' f = 'Simple' ('Traversing' f) -- @ type Traversing' p f s a = Traversing p f s s a a type Traversing1' p f s a = Traversing1 p f s s a a -------------------------- -- Traversal Combinators -------------------------- -- | Map each element of a structure targeted by a 'Lens' or 'Traversal', -- evaluate these actions from left to right, and collect the results. -- -- This function is only provided for consistency, 'id' is strictly more general. -- -- >>> traverseOf each print (1,2,3) -- 1 -- 2 -- 3 -- ((),(),()) -- -- @ -- 'traverseOf' ≡ 'id' -- 'itraverseOf' l ≡ 'traverseOf' l '.' 'Indexed' -- 'itraverseOf' 'itraversed' ≡ 'itraverse' -- @ -- -- -- This yields the obvious law: -- -- @ -- 'traverse' ≡ 'traverseOf' 'traverse' -- @ -- -- @ -- 'traverseOf' :: 'Functor' f => 'Iso' s t a b -> (a -> f b) -> s -> f t -- 'traverseOf' :: 'Functor' f => 'Lens' s t a b -> (a -> f b) -> s -> f t -- 'traverseOf' :: 'Applicative' f => 'Traversal' s t a b -> (a -> f b) -> s -> f t -- @ traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t traverseOf = id {-# INLINE traverseOf #-} -- | A version of 'traverseOf' with the arguments flipped, such that: -- -- >>> forOf each (1,2,3) print -- 1 -- 2 -- 3 -- ((),(),()) -- -- This function is only provided for consistency, 'flip' is strictly more general. -- -- @ -- 'forOf' ≡ 'flip' -- 'forOf' ≡ 'flip' . 'traverseOf' -- @ -- -- @ -- 'for' ≡ 'forOf' 'traverse' -- 'Control.Lens.Indexed.ifor' l s ≡ 'for' l s '.' 'Indexed' -- @ -- -- @ -- 'forOf' :: 'Functor' f => 'Iso' s t a b -> s -> (a -> f b) -> f t -- 'forOf' :: 'Functor' f => 'Lens' s t a b -> s -> (a -> f b) -> f t -- 'forOf' :: 'Applicative' f => 'Traversal' s t a b -> s -> (a -> f b) -> f t -- @ forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t forOf = flip {-# INLINE forOf #-} -- | Evaluate each action in the structure from left to right, and collect -- the results. -- -- >>> sequenceAOf both ([1,2],[3,4]) -- [(1,3),(1,4),(2,3),(2,4)] -- -- @ -- 'sequenceA' ≡ 'sequenceAOf' 'traverse' ≡ 'traverse' 'id' -- 'sequenceAOf' l ≡ 'traverseOf' l 'id' ≡ l 'id' -- @ -- -- @ -- 'sequenceAOf' :: 'Functor' f => 'Iso' s t (f b) b -> s -> f t -- 'sequenceAOf' :: 'Functor' f => 'Lens' s t (f b) b -> s -> f t -- 'sequenceAOf' :: 'Applicative' f => 'Traversal' s t (f b) b -> s -> f t -- @ sequenceAOf :: LensLike f s t (f b) b -> s -> f t sequenceAOf l = l id {-# INLINE sequenceAOf #-} -- | 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. -- -- >>> mapMOf both (\x -> [x, x + 1]) (1,3) -- [(1,3),(1,4),(2,3),(2,4)] -- -- @ -- 'mapM' ≡ 'mapMOf' 'traverse' -- 'imapMOf' l ≡ 'forM' l '.' 'Indexed' -- @ -- -- @ -- 'mapMOf' :: 'Monad' m => 'Iso' s t a b -> (a -> m b) -> s -> m t -- 'mapMOf' :: 'Monad' m => 'Lens' s t a b -> (a -> m b) -> s -> m t -- 'mapMOf' :: 'Monad' m => 'Traversal' s t a b -> (a -> m b) -> s -> m t -- @ mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t mapMOf l cmd = unwrapMonad #. l (WrapMonad #. cmd) {-# INLINE mapMOf #-} -- | 'forMOf' is a flipped version of 'mapMOf', consistent with the definition of 'forM'. -- -- >>> forMOf both (1,3) $ \x -> [x, x + 1] -- [(1,3),(1,4),(2,3),(2,4)] -- -- @ -- 'forM' ≡ 'forMOf' 'traverse' -- 'forMOf' l ≡ 'flip' ('mapMOf' l) -- 'iforMOf' l s ≡ 'forM' l s '.' 'Indexed' -- @ -- -- @ -- 'forMOf' :: 'Monad' m => 'Iso' s t a b -> s -> (a -> m b) -> m t -- 'forMOf' :: 'Monad' m => 'Lens' s t a b -> s -> (a -> m b) -> m t -- 'forMOf' :: 'Monad' m => 'Traversal' s t a b -> s -> (a -> m b) -> m t -- @ forMOf :: LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t forMOf l a cmd = unwrapMonad (l (WrapMonad #. cmd) a) {-# INLINE forMOf #-} -- | Sequence the (monadic) effects targeted by a 'Lens' in a container from left to right. -- -- >>> sequenceOf each ([1,2],[3,4],[5,6]) -- [(1,3,5),(1,3,6),(1,4,5),(1,4,6),(2,3,5),(2,3,6),(2,4,5),(2,4,6)] -- -- @ -- 'sequence' ≡ 'sequenceOf' 'traverse' -- 'sequenceOf' l ≡ 'mapMOf' l 'id' -- 'sequenceOf' l ≡ 'unwrapMonad' '.' l 'WrapMonad' -- @ -- -- @ -- 'sequenceOf' :: 'Monad' m => 'Iso' s t (m b) b -> s -> m t -- 'sequenceOf' :: 'Monad' m => 'Lens' s t (m b) b -> s -> m t -- 'sequenceOf' :: 'Monad' m => 'Traversal' s t (m b) b -> s -> m t -- @ sequenceOf :: LensLike (WrappedMonad m) s t (m b) b -> s -> m t sequenceOf l = unwrapMonad #. l WrapMonad {-# INLINE sequenceOf #-} -- | This generalizes 'Data.List.transpose' to an arbitrary 'Traversal'. -- -- Note: 'Data.List.transpose' handles ragged inputs more intelligently, but for non-ragged inputs: -- -- >>> transposeOf traverse [[1,2,3],[4,5,6]] -- [[1,4],[2,5],[3,6]] -- -- @ -- 'Data.List.transpose' ≡ 'transposeOf' 'traverse' -- @ -- -- Since every 'Lens' is a 'Traversal', we can use this as a form of -- monadic strength as well: -- -- @ -- 'transposeOf' 'Control.Lens.Tuple._2' :: (b, [a]) -> [(b, a)] -- @ transposeOf :: LensLike ZipList s t [a] a -> s -> [t] transposeOf l = getZipList #. l ZipList {-# INLINE transposeOf #-} -- | This generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'Traversal'. -- -- @ -- 'mapAccumR' ≡ 'mapAccumROf' 'traverse' -- @ -- -- 'mapAccumROf' accumulates 'State' from right to left. -- -- @ -- 'mapAccumROf' :: 'Iso' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- 'mapAccumROf' :: 'Lens' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- 'mapAccumROf' :: 'Traversal' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- @ -- -- @ -- 'mapAccumROf' :: 'LensLike' ('Backwards' ('State' acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- @ mapAccumROf :: LensLike (Backwards (State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) mapAccumROf = mapAccumLOf . backwards {-# INLINE mapAccumROf #-} -- | This generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'. -- -- @ -- 'mapAccumL' ≡ 'mapAccumLOf' 'traverse' -- @ -- -- 'mapAccumLOf' accumulates 'State' from left to right. -- -- @ -- 'mapAccumLOf' :: 'Iso' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- 'mapAccumLOf' :: 'Lens' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- 'mapAccumLOf' :: 'Traversal' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- @ -- -- @ -- 'mapAccumLOf' :: 'LensLike' ('State' acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- 'mapAccumLOf' l f acc0 s = 'swap' ('runState' (l (\a -> 'state' (\acc -> 'swap' (f acc a))) s) acc0) -- @ -- mapAccumLOf :: LensLike (State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) mapAccumLOf l f acc0 s = swap (runState (l g s) acc0) where g a = state $ \acc -> swap (f acc a) -- This would be much cleaner if the argument order for the function was swapped. {-# INLINE mapAccumLOf #-} -- | This permits the use of 'scanr1' over an arbitrary 'Traversal' or 'Lens'. -- -- @ -- 'scanr1' ≡ 'scanr1Of' 'traverse' -- @ -- -- @ -- 'scanr1Of' :: 'Iso' s t a a -> (a -> a -> a) -> s -> t -- 'scanr1Of' :: 'Lens' s t a a -> (a -> a -> a) -> s -> t -- 'scanr1Of' :: 'Traversal' s t a a -> (a -> a -> a) -> s -> t -- @ scanr1Of :: LensLike (Backwards (State (Maybe a))) s t a a -> (a -> a -> a) -> s -> t scanr1Of l f = snd . mapAccumROf l step Nothing where step Nothing a = (Just a, a) step (Just s) a = (Just r, r) where r = f a s {-# INLINE scanr1Of #-} -- | This permits the use of 'scanl1' over an arbitrary 'Traversal' or 'Lens'. -- -- @ -- 'scanl1' ≡ 'scanl1Of' 'traverse' -- @ -- -- @ -- 'scanl1Of' :: 'Iso' s t a a -> (a -> a -> a) -> s -> t -- 'scanl1Of' :: 'Lens' s t a a -> (a -> a -> a) -> s -> t -- 'scanl1Of' :: 'Traversal' s t a a -> (a -> a -> a) -> s -> t -- @ scanl1Of :: LensLike (State (Maybe a)) s t a a -> (a -> a -> a) -> s -> t scanl1Of l f = snd . mapAccumLOf l step Nothing where step Nothing a = (Just a, a) step (Just s) a = (Just r, r) where r = f s a {-# INLINE scanl1Of #-} -- | This 'Traversal' allows you to 'traverse' the individual stores in a 'Bazaar'. loci :: Traversal (Bazaar (->) a c s) (Bazaar (->) b c s) a b loci f w = getCompose (runBazaar w (Compose #. fmap sell . f)) {-# INLINE loci #-} -- | This 'IndexedTraversal' allows you to 'traverse' the individual stores in -- a 'Bazaar' with access to their indices. iloci :: IndexedTraversal i (Bazaar (Indexed i) a c s) (Bazaar (Indexed i) b c s) a b iloci f w = getCompose (runBazaar w (Compose #. Indexed (\i -> fmap (indexed sell i) . indexed f i))) {-# INLINE iloci #-} ------------------------------------------------------------------------------- -- Parts and Holes ------------------------------------------------------------------------------- -- | 'partsOf' turns a 'Traversal' into a 'Lens' that resembles an early version of the 'Data.Data.Lens.uniplate' (or 'Data.Data.Lens.biplate') type. -- -- /Note:/ You should really try to maintain the invariant of the number of children in the list. -- -- >>> (a,b,c) & partsOf each .~ [x,y,z] -- (x,y,z) -- -- Any extras will be lost. If you do not supply enough, then the remainder will come from the original structure. -- -- >>> (a,b,c) & partsOf each .~ [w,x,y,z] -- (w,x,y) -- -- >>> (a,b,c) & partsOf each .~ [x,y] -- (x,y,c) -- -- >>> ('b', 'a', 'd', 'c') & partsOf each %~ sort -- ('a','b','c','d') -- -- So technically, this is only a 'Lens' if you do not change the number of results it returns. -- -- When applied to a 'Fold' the result is merely a 'Getter'. -- -- @ -- 'partsOf' :: 'Iso'' s a -> 'Lens'' s [a] -- 'partsOf' :: 'Lens'' s a -> 'Lens'' s [a] -- 'partsOf' :: 'Traversal'' s a -> 'Lens'' s [a] -- 'partsOf' :: 'Fold' s a -> 'Getter' s [a] -- 'partsOf' :: 'Getter' s a -> 'Getter' s [a] -- @ partsOf :: Functor f => Traversing (->) f s t a a -> LensLike f s t [a] [a] partsOf l f s = outs b <$> f (ins b) where b = l sell s {-# INLINE partsOf #-} -- | An indexed version of 'partsOf' that receives the entire list of indices as its index. ipartsOf :: forall i p f s t a. (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a a -> Over p f s t [a] [a] ipartsOf l = conjoined (\f s -> let b = inline l sell s in outs b <$> f (wins b)) (\f s -> let b = inline l sell s; (is, as) = unzip (pins b) in outs b <$> indexed f (is :: [i]) as) {-# INLINE ipartsOf #-} -- | A type-restricted version of 'partsOf' that can only be used with a 'Traversal'. partsOf' :: ATraversal s t a a -> Lens s t [a] [a] partsOf' l f s = outs b <$> f (ins b) where b = l sell s {-# INLINE partsOf' #-} -- | A type-restricted version of 'ipartsOf' that can only be used with an 'IndexedTraversal'. ipartsOf' :: forall i p f s t a. (Indexable [i] p, Functor f) => Over (Indexed i) (Bazaar' (Indexed i) a) s t a a -> Over p f s t [a] [a] ipartsOf' l = conjoined (\f s -> let b = inline l sell s in outs b <$> f (wins b)) (\f s -> let b = inline l sell s; (is, as) = unzip (pins b) in outs b <$> indexed f (is :: [i]) as) {-# INLINE ipartsOf' #-} -- | 'unsafePartsOf' turns a 'Traversal' into a 'Data.Data.Lens.uniplate' (or 'Data.Data.Lens.biplate') family. -- -- If you do not need the types of @s@ and @t@ to be different, it is recommended that -- you use 'partsOf'. -- -- It is generally safer to traverse with the 'Bazaar' rather than use this -- combinator. However, it is sometimes convenient. -- -- This is unsafe because if you don't supply at least as many @b@'s as you were -- given @a@'s, then the reconstruction of @t@ /will/ result in an error! -- -- When applied to a 'Fold' the result is merely a 'Getter' (and becomes safe). -- -- @ -- 'unsafePartsOf' :: 'Iso' s t a b -> 'Lens' s t [a] [b] -- 'unsafePartsOf' :: 'Lens' s t a b -> 'Lens' s t [a] [b] -- 'unsafePartsOf' :: 'Traversal' s t a b -> 'Lens' s t [a] [b] -- 'unsafePartsOf' :: 'Fold' s a -> 'Getter' s [a] -- 'unsafePartsOf' :: 'Getter' s a -> 'Getter' s [a] -- @ unsafePartsOf :: Functor f => Traversing (->) f s t a b -> LensLike f s t [a] [b] unsafePartsOf l f s = unsafeOuts b <$> f (ins b) where b = l sell s {-# INLINE unsafePartsOf #-} -- | An indexed version of 'unsafePartsOf' that receives the entire list of indices as its index. iunsafePartsOf :: forall i p f s t a b. (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a b -> Over p f s t [a] [b] iunsafePartsOf l = conjoined (\f s -> let b = inline l sell s in unsafeOuts b <$> f (wins b)) (\f s -> let b = inline l sell s; (is,as) = unzip (pins b) in unsafeOuts b <$> indexed f (is :: [i]) as) {-# INLINE iunsafePartsOf #-} unsafePartsOf' :: ATraversal s t a b -> Lens s t [a] [b] unsafePartsOf' l f s = unsafeOuts b <$> f (ins b) where b = l sell s {-# INLINE unsafePartsOf' #-} iunsafePartsOf' :: forall i s t a b. Over (Indexed i) (Bazaar (Indexed i) a b) s t a b -> IndexedLens [i] s t [a] [b] iunsafePartsOf' l = conjoined (\f s -> let b = inline l sell s in unsafeOuts b <$> f (wins b)) (\f s -> let b = inline l sell s; (is, as) = unzip (pins b) in unsafeOuts b <$> indexed f (is :: [i]) as) {-# INLINE iunsafePartsOf' #-} -- | The one-level version of 'Control.Lens.Plated.contextsOf'. This extracts a list of the immediate children according to a given 'Traversal' as editable contexts. -- -- Given a context you can use 'Control.Comonad.Store.Class.pos' to see the values, 'Control.Comonad.Store.Class.peek' at what the structure would be like with an edited result, or simply 'extract' the original structure. -- -- @ -- propChildren l x = childrenOf l x '==' 'map' 'Control.Comonad.Store.Class.pos' ('holesOf' l x) -- propId l x = 'all' ('==' x) ['extract' w | w <- 'holesOf' l x] -- @ -- -- @ -- 'holesOf' :: 'Iso'' s a -> s -> ['Pretext'' (->) a s] -- 'holesOf' :: 'Lens'' s a -> s -> ['Pretext'' (->) a s] -- 'holesOf' :: 'Traversal'' s a -> s -> ['Pretext'' (->) a s] -- 'holesOf' :: 'IndexedLens'' i s a -> s -> ['Pretext'' ('Indexed' i) a s] -- 'holesOf' :: 'IndexedTraversal'' i s a -> s -> ['Pretext'' ('Indexed' i) a s] -- @ holesOf :: forall p s t a. Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t] holesOf l s = unTagged ( conjoined (Tagged $ let f [] _ = [] f (x:xs) g = Pretext (\xfy -> g . (:xs) <$> xfy x) : f xs (g . (x:)) in f (ins b) (unsafeOuts b)) (Tagged $ let f [] _ = [] f (wx:xs) g = Pretext (\wxfy -> g . (:Prelude.map extract xs) <$> cosieve wxfy wx) : f xs (g . (extract wx:)) in f (pins b) (unsafeOuts b)) :: Tagged (p a b) [Pretext p a a t] ) where b = l sell s {-# INLINE holesOf #-} -- | This converts a 'Traversal' that you \"know\" will target one or more elements to a 'Lens'. It can -- also be used to transform a non-empty 'Fold' into a 'Getter'. -- -- The resulting 'Lens' or 'Getter' will be partial if the supplied 'Traversal' returns -- no results. -- -- >>> [1,2,3] ^. singular _head -- 1 -- -- >>> [] ^. singular _head -- *** Exception: singular: empty traversal -- -- >>> Left 4 ^. singular _Left -- 4 -- -- >>> [1..10] ^. singular (ix 7) -- 8 -- -- >>> [] & singular traverse .~ 0 -- [] -- -- @ -- 'singular' :: 'Traversal' s t a a -> 'Lens' s t a a -- 'singular' :: 'Fold' s a -> 'Getter' s a -- 'singular' :: 'IndexedTraversal' i s t a a -> 'IndexedLens' i s t a a -- 'singular' :: 'IndexedFold' i s a -> 'IndexedGetter' i s a -- @ singular :: (Conjoined p, Functor f) => Traversing p f s t a a -> Over p f s t a a singular l = conjoined (\afb s -> let b = l sell s in case ins b of (w:ws) -> unsafeOuts b . (:ws) <$> afb w [] -> unsafeOuts b . return <$> afb (error "singular: empty traversal")) (\pafb s -> let b = l sell s in case pins b of (w:ws) -> unsafeOuts b . (:Prelude.map extract ws) <$> cosieve pafb w [] -> unsafeOuts b . return <$> cosieve pafb (error "singular: empty traversal")) {-# INLINE singular #-} -- | This converts a 'Traversal' that you \"know\" will target only one element to a 'Lens'. It can also be -- used to transform a 'Fold' into a 'Getter'. -- -- The resulting 'Lens' or 'Getter' will be partial if the 'Traversal' targets nothing -- or more than one element. -- -- >>> [] & unsafeSingular traverse .~ 0 -- *** Exception: unsafeSingular: empty traversal -- -- @ -- 'unsafeSingular' :: 'Traversal' s t a b -> 'Lens' s t a b -- 'unsafeSingular' :: 'Fold' s a -> 'Getter' s a -- 'unsafeSingular' :: 'IndexedTraversal' i s t a b -> 'IndexedLens' i s t a b -- 'unsafeSingular' :: 'IndexedFold' i s a -> 'IndexedGetter' i s a -- @ unsafeSingular :: (Conjoined p, Functor f) => Traversing p f s t a b -> Over p f s t a b unsafeSingular l = conjoined (\afb s -> let b = inline l sell s in case ins b of [w] -> unsafeOuts b . return <$> afb w [] -> error "unsafeSingular: empty traversal" _ -> error "unsafeSingular: traversing multiple results") (\pafb s -> let b = inline l sell s in case pins b of [w] -> unsafeOuts b . return <$> cosieve pafb w [] -> error "unsafeSingular: empty traversal" _ -> error "unsafeSingular: traversing multiple results") {-# INLINE unsafeSingular #-} ------------------------------------------------------------------------------ -- Internal functions used by 'partsOf', 'holesOf', etc. ------------------------------------------------------------------------------ ins :: Bizarre (->) w => w a b t -> [a] ins = toListOf (getting bazaar) {-# INLINE ins #-} wins :: (Bizarre p w, Corepresentable p, Comonad (Corep p)) => w a b t -> [a] wins = getConst #. bazaar (cotabulate $ \ra -> Const [extract ra]) {-# INLINE wins #-} pins :: (Bizarre p w, Corepresentable p) => w a b t -> [Corep p a] pins = getConst #. bazaar (cotabulate $ \ra -> Const [ra]) {-# INLINE pins #-} parr :: (Profunctor p, Category p) => (a -> b) -> p a b parr f = lmap f id {-# INLINE parr #-} outs :: (Bizarre p w, Category p) => w a a t -> [a] -> t outs = evalState `rmap` bazaar (parr (state . unconsWithDefault)) {-# INLINE outs #-} unsafeOuts :: (Bizarre p w, Corepresentable p) => w a b t -> [b] -> t unsafeOuts = evalState `rmap` bazaar (cotabulate (\_ -> state (unconsWithDefault fakeVal))) where fakeVal = error "unsafePartsOf': not enough elements were supplied" {-# INLINE unsafeOuts #-} unconsWithDefault :: a -> [a] -> (a,[a]) unconsWithDefault d [] = (d,[]) unconsWithDefault _ (x:xs) = (x,xs) {-# INLINE unconsWithDefault #-} ------------------------------------------------------------------------------ -- Traversals ------------------------------------------------------------------------------ -- | Traverse both parts of a 'Bitraversable' container with matching types. -- -- Usually that type will be a pair. -- -- >>> (1,2) & both *~ 10 -- (10,20) -- -- >>> over both length ("hello","world") -- (5,5) -- -- >>> ("hello","world")^.both -- "helloworld" -- -- @ -- 'both' :: 'Traversal' (a, a) (b, b) a b -- 'both' :: 'Traversal' ('Either' a a) ('Either' b b) a b -- @ both :: Bitraversable r => Traversal (r a a) (r b b) a b both f = bitraverse f f {-# INLINE both #-} -- | Apply a different 'Traversal' or 'Fold' to each side of a 'Bitraversable' container. -- -- @ -- 'beside' :: 'Traversal' s t a b -> 'Traversal' s' t' a b -> 'Traversal' (r s s') (r t t') a b -- 'beside' :: 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s' t' a b -> 'IndexedTraversal' i (r s s') (r t t') a b -- 'beside' :: 'IndexPreservingTraversal' s t a b -> 'IndexPreservingTraversal' s' t' a b -> 'IndexPreservingTraversal' (r s s') (r t t') a b -- @ -- -- @ -- 'beside' :: 'Traversal' s t a b -> 'Traversal' s' t' a b -> 'Traversal' (s,s') (t,t') a b -- 'beside' :: 'Lens' s t a b -> 'Lens' s' t' a b -> 'Traversal' (s,s') (t,t') a b -- 'beside' :: 'Fold' s a -> 'Fold' s' a -> 'Fold' (s,s') a -- 'beside' :: 'Getter' s a -> 'Getter' s' a -> 'Fold' (s,s') a -- @ -- -- @ -- 'beside' :: 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s' t' a b -> 'IndexedTraversal' i (s,s') (t,t') a b -- 'beside' :: 'IndexedLens' i s t a b -> 'IndexedLens' i s' t' a b -> 'IndexedTraversal' i (s,s') (t,t') a b -- 'beside' :: 'IndexedFold' i s a -> 'IndexedFold' i s' a -> 'IndexedFold' i (s,s') a -- 'beside' :: 'IndexedGetter' i s a -> 'IndexedGetter' i s' a -> 'IndexedFold' i (s,s') a -- @ -- -- @ -- 'beside' :: 'IndexPreservingTraversal' s t a b -> 'IndexPreservingTraversal' s' t' a b -> 'IndexPreservingTraversal' (s,s') (t,t') a b -- 'beside' :: 'IndexPreservingLens' s t a b -> 'IndexPreservingLens' s' t' a b -> 'IndexPreservingTraversal' (s,s') (t,t') a b -- 'beside' :: 'IndexPreservingFold' s a -> 'IndexPreservingFold' s' a -> 'IndexPreservingFold' (s,s') a -- 'beside' :: 'IndexPreservingGetter' s a -> 'IndexPreservingGetter' s' a -> 'IndexPreservingFold' (s,s') a -- @ -- -- >>> ("hello",["world","!!!"])^..beside id traverse -- ["hello","world","!!!"] beside :: (Representable q, Applicative (Rep q), Applicative f, Bitraversable r) => Optical p q f s t a b -> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b beside l r f = tabulate $ getCompose #. bitraverse (Compose #. sieve (l f)) (Compose #. sieve (r f)) {-# INLINE beside #-} -- | Visit the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'. -- -- >>> [("hello","world"),("!!!","!!!")]^.. taking 2 (traverse.both) -- ["hello","world"] -- -- >>> timingOut $ [1..] ^.. taking 3 traverse -- [1,2,3] -- -- >>> over (taking 5 traverse) succ "hello world" -- "ifmmp world" -- -- @ -- 'taking' :: 'Int' -> 'Traversal'' s a -> 'Traversal'' s a -- 'taking' :: 'Int' -> 'Lens'' s a -> 'Traversal'' s a -- 'taking' :: 'Int' -> 'Iso'' s a -> 'Traversal'' s a -- 'taking' :: 'Int' -> 'Prism'' s a -> 'Traversal'' s a -- 'taking' :: 'Int' -> 'Getter' s a -> 'Fold' s a -- 'taking' :: 'Int' -> 'Fold' s a -> 'Fold' s a -- 'taking' :: 'Int' -> 'IndexedTraversal'' i s a -> 'IndexedTraversal'' i s a -- 'taking' :: 'Int' -> 'IndexedLens'' i s a -> 'IndexedTraversal'' i s a -- 'taking' :: 'Int' -> 'IndexedGetter' i s a -> 'IndexedFold' i s a -- 'taking' :: 'Int' -> 'IndexedFold' i s a -> 'IndexedFold' i s a -- @ taking :: (Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a taking n l = conjoined (\ afb s -> let b = inline l sell s in outs b <$> traverse afb (take n $ ins b)) (\ pafb s -> let b = inline l sell s in outs b <$> traverse (cosieve pafb) (take n $ pins b)) {-# INLINE taking #-} -- | Visit all but the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'. -- -- >>> ("hello","world") ^? dropping 1 both -- Just "world" -- -- Dropping works on infinite traversals as well: -- -- >>> [1..] ^? dropping 1 folded -- Just 2 -- -- @ -- 'dropping' :: 'Int' -> 'Traversal'' s a -> 'Traversal'' s a -- 'dropping' :: 'Int' -> 'Lens'' s a -> 'Traversal'' s a -- 'dropping' :: 'Int' -> 'Iso'' s a -> 'Traversal'' s a -- 'dropping' :: 'Int' -> 'Prism'' s a -> 'Traversal'' s a -- 'dropping' :: 'Int' -> 'Getter' s a -> 'Fold' s a -- 'dropping' :: 'Int' -> 'Fold' s a -> 'Fold' s a -- 'dropping' :: 'Int' -> 'IndexedTraversal'' i s a -> 'IndexedTraversal'' i s a -- 'dropping' :: 'Int' -> 'IndexedLens'' i s a -> 'IndexedTraversal'' i s a -- 'dropping' :: 'Int' -> 'IndexedGetter' i s a -> 'IndexedFold' i s a -- 'dropping' :: 'Int' -> 'IndexedFold' i s a -> 'IndexedFold' i s a -- @ dropping :: (Conjoined p, Applicative f) => Int -> Over p (Indexing f) s t a a -> Over p f s t a a dropping n l pafb s = snd $ runIndexing (l paifb s) 0 where paifb = cotabulate $ \wa -> Indexing $ \i -> let i' = i + 1 in i' `seq` (i', if i < n then pure (extract wa) else cosieve pafb wa) {-# INLINE dropping #-} ------------------------------------------------------------------------------ -- Cloning Traversals ------------------------------------------------------------------------------ -- | A 'Traversal' is completely characterized by its behavior on a 'Bazaar'. -- -- Cloning a 'Traversal' is one way to make sure you aren't given -- something weaker, such as a 'Fold' and can be -- used as a way to pass around traversals that have to be monomorphic in @f@. -- -- Note: This only accepts a proper 'Traversal' (or 'Lens'). To clone a 'Lens' -- as such, use 'Control.Lens.Lens.cloneLens'. -- -- Note: It is usually better to use 'Control.Lens.Reified.ReifiedTraversal' and -- 'Control.Lens.Reified.runTraversal' than to 'cloneTraversal'. The -- former can execute at full speed, while the latter needs to round trip through -- the 'Bazaar'. -- -- >>> let foo l a = (view (getting (cloneTraversal l)) a, set (cloneTraversal l) 10 a) -- >>> foo both ("hello","world") -- ("helloworld",(10,10)) -- -- @ -- 'cloneTraversal' :: 'LensLike' ('Bazaar' (->) a b) s t a b -> 'Traversal' s t a b -- @ cloneTraversal :: ATraversal s t a b -> Traversal s t a b cloneTraversal l f = bazaar f . l sell {-# INLINE cloneTraversal #-} -- | Clone a 'Traversal' yielding an 'IndexPreservingTraversal' that passes through -- whatever index it is composed with. cloneIndexPreservingTraversal :: ATraversal s t a b -> IndexPreservingTraversal s t a b cloneIndexPreservingTraversal l pafb = cotabulate $ \ws -> runBazaar (l sell (extract ws)) $ \a -> cosieve pafb (a <$ ws) {-# INLINE cloneIndexPreservingTraversal #-} -- | Clone an 'IndexedTraversal' yielding an 'IndexedTraversal' with the same index. cloneIndexedTraversal :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b cloneIndexedTraversal l f = bazaar (Indexed (indexed f)) . l sell {-# INLINE cloneIndexedTraversal #-} -- | A 'Traversal1' is completely characterized by its behavior on a 'Bazaar1'. cloneTraversal1 :: ATraversal1 s t a b -> Traversal1 s t a b cloneTraversal1 l f = bazaar1 f . l sell {-# INLINE cloneTraversal1 #-} -- | Clone a 'Traversal1' yielding an 'IndexPreservingTraversal1' that passes through -- whatever index it is composed with. cloneIndexPreservingTraversal1 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b cloneIndexPreservingTraversal1 l pafb = cotabulate $ \ws -> runBazaar1 (l sell (extract ws)) $ \a -> cosieve pafb (a <$ ws) {-# INLINE cloneIndexPreservingTraversal1 #-} -- | Clone an 'IndexedTraversal1' yielding an 'IndexedTraversal1' with the same index. cloneIndexedTraversal1 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b cloneIndexedTraversal1 l f = bazaar1 (Indexed (indexed f)) . l sell {-# INLINE cloneIndexedTraversal1 #-} ------------------------------------------------------------------------------ -- Indexed Traversals ------------------------------------------------------------------------------ -- | Traversal with an index. -- -- /NB:/ When you don't need access to the index then you can just apply your 'IndexedTraversal' -- directly as a function! -- -- @ -- 'itraverseOf' ≡ 'Control.Lens.Indexed.withIndex' -- 'Control.Lens.Traversal.traverseOf' l = 'itraverseOf' l '.' 'const' = 'id' -- @ -- -- @ -- 'itraverseOf' :: 'Functor' f => 'IndexedLens' i s t a b -> (i -> a -> f b) -> s -> f t -- 'itraverseOf' :: 'Applicative' f => 'IndexedTraversal' i s t a b -> (i -> a -> f b) -> s -> f t -- 'itraverseOf' :: 'Apply' f => 'IndexedTraversal1' i s t a b -> (i -> a -> f b) -> s -> f t -- @ itraverseOf :: (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t itraverseOf l = l .# Indexed {-# INLINE itraverseOf #-} -- | Traverse with an index (and the arguments flipped). -- -- @ -- 'Control.Lens.Traversal.forOf' l a ≡ 'iforOf' l a '.' 'const' -- 'iforOf' ≡ 'flip' '.' 'itraverseOf' -- @ -- -- @ -- 'iforOf' :: 'Functor' f => 'IndexedLens' i s t a b -> s -> (i -> a -> f b) -> f t -- 'iforOf' :: 'Applicative' f => 'IndexedTraversal' i s t a b -> s -> (i -> a -> f b) -> f t -- 'iforOf' :: 'Apply' f => 'IndexedTraversal1' i s t a b -> s -> (i -> a -> f b) -> f t -- @ iforOf :: (Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t iforOf = flip . itraverseOf {-# INLINE iforOf #-} -- | 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, with access -- its position. -- -- 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' -- @ -- -- @ -- 'imapMOf' :: 'Monad' m => 'IndexedLens' i s t a b -> (i -> a -> m b) -> s -> m t -- 'imapMOf' :: 'Monad' m => 'IndexedTraversal' i s t a b -> (i -> a -> m b) -> s -> m t -- 'imapMOf' :: 'Bind' m => 'IndexedTraversal1' i s t a b -> (i -> a -> m b) -> s -> m t -- @ imapMOf :: Over (Indexed i) (WrappedMonad m) s t a b -> (i -> a -> m b) -> s -> m t imapMOf l cmd = unwrapMonad #. l (WrapMonad #. Indexed cmd) {-# INLINE imapMOf #-} -- | 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, with access -- its position (and the arguments flipped). -- -- @ -- 'Control.Lens.Traversal.forMOf' l a ≡ 'iforMOf' l a '.' 'const' -- 'iforMOf' ≡ 'flip' '.' 'imapMOf' -- @ -- -- @ -- 'iforMOf' :: 'Monad' m => 'IndexedLens' i s t a b -> s -> (i -> a -> m b) -> m t -- 'iforMOf' :: 'Monad' m => 'IndexedTraversal' i s t a b -> s -> (i -> a -> m b) -> m t -- @ iforMOf :: (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t) -> s -> (i -> a -> m b) -> m t iforMOf = flip . imapMOf {-# INLINE iforMOf #-} -- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'IndexedTraversal' with access to the index. -- -- 'imapAccumROf' accumulates state from right to left. -- -- @ -- 'Control.Lens.Traversal.mapAccumROf' l ≡ 'imapAccumROf' l '.' 'const' -- @ -- -- @ -- 'imapAccumROf' :: 'IndexedLens' i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- 'imapAccumROf' :: 'IndexedTraversal' i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- @ imapAccumROf :: Over (Indexed i) (Backwards (State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) imapAccumROf = imapAccumLOf . backwards {-# INLINE imapAccumROf #-} -- | Generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'IndexedTraversal' with access to the index. -- -- 'imapAccumLOf' accumulates state from left to right. -- -- @ -- 'Control.Lens.Traversal.mapAccumLOf' l ≡ 'imapAccumLOf' l '.' 'const' -- @ -- -- @ -- 'imapAccumLOf' :: 'IndexedLens' i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- 'imapAccumLOf' :: 'IndexedTraversal' i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- @ imapAccumLOf :: Over (Indexed i) (State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) imapAccumLOf l f acc0 s = swap (runState (l (Indexed g) s) acc0) where g i a = state $ \acc -> swap (f i acc a) {-# INLINE imapAccumLOf #-} ------------------------------------------------------------------------------ -- Common Indexed Traversals ------------------------------------------------------------------------------ -- | Traverse any 'Traversable' container. This is an 'IndexedTraversal' that is indexed by ordinal position. traversed :: Traversable f => IndexedTraversal Int (f a) (f b) a b traversed = conjoined traverse (indexing traverse) {-# INLINE [0] traversed #-} imapList :: (Int -> a -> b) -> [a] -> [b] imapList f = go 0 where go i (x:xs) = f i x : go (i+1) xs go _ [] = [] {-# INLINE imapList #-} {-# RULES "traversed -> mapped" traversed = sets fmap :: Functor f => ASetter (f a) (f b) a b; "traversed -> folded" traversed = folded :: Foldable f => Getting (Endo r) (f a) a; "traversed -> ifolded" traversed = folded :: Foldable f => IndexedGetting Int (Endo r) (f a) a; "traversed -> imapList" traversed = isets imapList :: AnIndexedSetter Int [a] [b] a b; "traversed -> imapSeq" traversed = isets mapWithIndex :: AnIndexedSetter Int (Seq a) (Seq b) a b; "traversed -> imapVector" traversed = isets Vector.imap :: AnIndexedSetter Int (Vector a) (Vector b) a b; #-} -- | Traverse any 'Traversable1' container. This is an 'IndexedTraversal1' that is indexed by ordinal position. traversed1 :: Traversable1 f => IndexedTraversal1 Int (f a) (f b) a b traversed1 = conjoined traverse1 (indexing traverse1) {-# INLINE traversed1 #-} -- | Traverse any 'Traversable' container. This is an 'IndexedTraversal' that is indexed by ordinal position. traversed64 :: Traversable f => IndexedTraversal Int64 (f a) (f b) a b traversed64 = conjoined traverse (indexing64 traverse) {-# INLINE traversed64 #-} -- | This is the trivial empty 'Traversal'. -- -- @ -- 'ignored' :: 'IndexedTraversal' i s s a b -- @ -- -- @ -- 'ignored' ≡ 'const' 'pure' -- @ -- -- >>> 6 & ignored %~ absurd -- 6 ignored :: Applicative f => pafb -> s -> f s ignored _ = pure {-# INLINE ignored #-} -- | 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 :: IndexedTraversal' k (m v) v instance TraverseMin Int IntMap where traverseMin f m = case IntMap.minViewWithKey m of #if MIN_VERSION_containers(0,5,0) Just ((k,a), _) -> indexed f k a <&> \v -> IntMap.updateMin (const (Just v)) m #else Just ((k,a), _) -> indexed f k a <&> \v -> IntMap.updateMin (const v) m #endif Nothing -> pure m {-# INLINE traverseMin #-} instance Ord k => TraverseMin k (Map k) where traverseMin f m = case Map.minViewWithKey m of Just ((k, a), _) -> indexed f k a <&> \v -> Map.updateMin (const (Just v)) m 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 :: IndexedTraversal' k (m v) v instance TraverseMax Int IntMap where traverseMax f m = case IntMap.maxViewWithKey m of #if MIN_VERSION_containers(0,5,0) Just ((k,a), _) -> indexed f k a <&> \v -> IntMap.updateMax (const (Just v)) m #else Just ((k,a), _) -> indexed f k a <&> \v -> IntMap.updateMax (const v) m #endif Nothing -> pure m {-# INLINE traverseMax #-} instance Ord k => TraverseMax k (Map k) where traverseMax f m = case Map.maxViewWithKey m of Just ((k, a), _) -> indexed f k a <&> \v -> Map.updateMax (const (Just v)) m Nothing -> pure m {-# INLINE traverseMax #-} -- | Traverse the /nth/ 'elementOf' a 'Traversal', 'Lens' or -- 'Iso' if it exists. -- -- >>> [[1],[3,4]] & elementOf (traverse.traverse) 1 .~ 5 -- [[1],[5,4]] -- -- >>> [[1],[3,4]] ^? elementOf (folded.folded) 1 -- Just 3 -- -- >>> timingOut $ ['a'..] ^?! elementOf folded 5 -- 'f' -- -- >>> timingOut $ take 10 $ elementOf traverse 3 .~ 16 $ [0..] -- [0,1,2,16,4,5,6,7,8,9] -- -- @ -- 'elementOf' :: 'Traversal'' s a -> 'Int' -> 'IndexedTraversal'' 'Int' s a -- 'elementOf' :: 'Fold' s a -> 'Int' -> 'IndexedFold' 'Int' s a -- @ elementOf :: Applicative f => LensLike (Indexing f) s t a a -> Int -> IndexedLensLike Int f s t a a elementOf l p = elementsOf l (p ==) {-# INLINE elementOf #-} -- | Traverse the /nth/ element of a 'Traversable' container. -- -- @ -- 'element' ≡ 'elementOf' 'traverse' -- @ element :: Traversable t => Int -> IndexedTraversal' Int (t a) a element = elementOf traverse {-# INLINE element #-} -- | Traverse (or fold) selected elements of a 'Traversal' (or 'Fold') where their ordinal positions match a predicate. -- -- @ -- 'elementsOf' :: 'Traversal'' s a -> ('Int' -> 'Bool') -> 'IndexedTraversal'' 'Int' s a -- 'elementsOf' :: 'Fold' s a -> ('Int' -> 'Bool') -> 'IndexedFold' 'Int' s a -- @ elementsOf :: Applicative f => LensLike (Indexing f) s t a a -> (Int -> Bool) -> IndexedLensLike Int f s t a a elementsOf l p iafb s = snd $ runIndexing (l (\a -> Indexing (\i -> i `seq` (i + 1, if p i then indexed iafb i a else pure a))) s) 0 {-# INLINE elementsOf #-} -- | Traverse elements of a 'Traversable' container where their ordinal positions match a predicate. -- -- @ -- 'elements' ≡ 'elementsOf' 'traverse' -- @ elements :: Traversable t => (Int -> Bool) -> IndexedTraversal' Int (t a) a elements = elementsOf traverse {-# INLINE elements #-} -- | Try to map a function over this 'Traversal', failing if the 'Traversal' has no targets. -- -- >>> failover (element 3) (*2) [1,2] :: Maybe [Int] -- Nothing -- -- >>> failover _Left (*2) (Right 4) :: Maybe (Either Int Int) -- Nothing -- -- >>> failover _Right (*2) (Right 4) :: Maybe (Either Int Int) -- Just (Right 8) -- -- @ -- 'failover' :: Alternative m => Traversal s t a b -> (a -> b) -> s -> m t -- @ failover :: Alternative m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t failover l afb s = case l ((,) (Any True) . afb) s of (Any True, t) -> pure t (Any False, _) -> Applicative.empty {-# INLINE failover #-} -- | Try to map a function which uses the index over this 'IndexedTraversal', failing if the 'IndexedTraversal' has no targets. -- -- @ -- 'ifailover' :: Alternative m => IndexedTraversal i s t a b -> (i -> a -> b) -> s -> m t -- @ ifailover :: Alternative m => Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t ifailover l iafb s = case l ((,) (Any True) `rmap` Indexed iafb) s of (Any True, t) -> pure t (Any False, _) -> Applicative.empty {-# INLINE ifailover #-} -- | Try the first 'Traversal' (or 'Fold'), falling back on the second 'Traversal' (or 'Fold') if it returns no entries. -- -- This is only a valid 'Traversal' if the second 'Traversal' is disjoint from the result of the first or returns -- exactly the same results. These conditions are trivially met when given a 'Lens', 'Iso', 'Getter', 'Prism' or \"affine\" Traversal -- one that -- has 0 or 1 target. -- -- Mutatis mutandis for 'Fold'. -- -- >>> [0,1,2,3] ^? failing (ix 1) (ix 2) -- Just 1 -- -- >>> [0,1,2,3] ^? failing (ix 42) (ix 2) -- Just 2 -- -- @ -- 'failing' :: 'Traversal' s t a b -> 'Traversal' s t a b -> 'Traversal' s t a b -- 'failing' :: 'Prism' s t a b -> 'Prism' s t a b -> 'Traversal' s t a b -- 'failing' :: 'Fold' s a -> 'Fold' s a -> 'Fold' s a -- @ -- -- These cases are also supported, trivially, but are boring, because the left hand side always succeeds. -- -- @ -- 'failing' :: 'Lens' s t a b -> 'Traversal' s t a b -> 'Traversal' s t a b -- 'failing' :: 'Iso' s t a b -> 'Traversal' s t a b -> 'Traversal' s t a b -- 'failing' :: 'Equality' s t a b -> 'Traversal' s t a b -> 'Traversal' s t a b -- 'failing' :: 'Getter' s a -> 'Fold' s a -> 'Fold' s a -- @ -- -- If both of the inputs are indexed, the result is also indexed, so you can apply this to a pair of indexed -- traversals or indexed folds, obtaining an indexed traversal or indexed fold. -- -- @ -- 'failing' :: 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b -- 'failing' :: 'IndexedFold' i s a -> 'IndexedFold' i s a -> 'IndexedFold' i s a -- @ -- -- These cases are also supported, trivially, but are boring, because the left hand side always succeeds. -- -- @ -- 'failing' :: 'IndexedLens' i s t a b -> 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b -- 'failing' :: 'IndexedGetter' i s a -> 'IndexedGetter' i s a -> 'IndexedFold' i s a -- @ failing :: (Conjoined p, Applicative f) => Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b failing l r pafb s = case pins b of [] -> r pafb s _ -> bazaar pafb b where b = l sell s infixl 5 `failing` -- | Try the second traversal. If it returns no entries, try again with all entries from the first traversal, recursively. -- -- @ -- 'deepOf' :: 'Fold' s s -> 'Fold' s a -> 'Fold' s a -- 'deepOf' :: 'Traversal'' s s -> 'Traversal'' s a -> 'Traversal'' s a -- 'deepOf' :: 'Traversal' s t s t -> 'Traversal' s t a b -> 'Traversal' s t a b -- 'deepOf' :: 'Fold' s s -> 'IndexedFold' i s a -> 'IndexedFold' i s a -- 'deepOf' :: 'Traversal' s t s t -> 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b -- @ deepOf :: (Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b deepOf r l pafb = go where go s = case pins b of [] -> r go s xs -> unsafeOuts b <$> traverse (cosieve pafb) xs where b = l sell s -- | "Fuse" a 'Traversal' by reassociating all of the '\<*\>' operations to the -- left and fusing all of the 'fmap' calls into one. This is particularly -- useful when constructing a 'Traversal' using operations from GHC.Generics. -- -- Given a pair of 'Traversal's 'foo' and 'bar', -- -- @ -- 'confusing' (foo.bar) = foo.bar -- @ -- -- However, @foo@ and @bar@ are each going to use the 'Applicative' they are given. -- -- 'confusing' exploits the 'Yoneda' lemma to merge their separate uses of 'fmap' into a single 'fmap'. -- and it further exploits an interesting property of the right Kan lift (or 'Curried') to left associate -- all of the uses of '(<*>)' to make it possible to fuse together more fmaps. -- -- This is particularly effective when the choice of functor 'f' is unknown at compile -- time or when the 'Traversal' @foo.bar@ in the above description is recursive or complex -- enough to prevent inlining. -- -- 'Control.Lens.Lens.fusing' is a version of this combinator suitable for fusing lenses. -- -- @ -- 'confusing' :: 'Traversal' s t a b -> 'Traversal' s t a b -- @ confusing :: Applicative f => LensLike (Curried (Yoneda f) (Yoneda f)) s t a b -> LensLike f s t a b confusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f) where liftCurriedYoneda :: Applicative f => f a -> Curried (Yoneda f) (Yoneda f) a liftCurriedYoneda fa = Curried (`yap` fa) {-# INLINE liftCurriedYoneda #-} yap :: Applicative f => Yoneda f (a -> b) -> f a -> Yoneda f b yap (Yoneda k) fa = Yoneda (\ab_r -> k (ab_r .) <*> fa) {-# INLINE yap #-} {-# INLINE confusing #-} -- | Traverse a container using a specified 'Applicative'. -- -- This is like 'traverseBy' where the 'Traversable' instance can be specified by any 'Traversal' -- -- @ -- 'traverseByOf' 'traverse' ≡ 'traverseBy' -- @ traverseByOf :: Traversal s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t traverseByOf l pur app f = reifyApplicative pur app (l (ReflectedApplicative #. f)) -- | Sequence a container using a specified 'Applicative'. -- -- This is like 'traverseBy' where the 'Traversable' instance can be specified by any 'Traversal' -- -- @ -- 'sequenceByOf' 'traverse' ≡ 'sequenceBy' -- @ sequenceByOf :: Traversal s t (f b) b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> s -> f t sequenceByOf l pur app = reifyApplicative pur app (l ReflectedApplicative) lens-4.14/src/Control/Lens/Tuple.hs0000644000000000000000000003726712710476104015347 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Tuple -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- ------------------------------------------------------------------------------- module Control.Lens.Tuple ( -- * Tuples Field1(..) , Field2(..) , Field3(..) , Field4(..) , Field5(..) , Field6(..) , Field7(..) , Field8(..) , Field9(..) -- * Strict variations , _1', _2', _3', _4', _5', _6', _7', _8', _9' ) where import Control.Lens.Lens import Data.Functor.Identity import Data.Functor.Product import Data.Profunctor (dimap) import Data.Proxy (Proxy (Proxy)) import GHC.Generics (Generic (..), (:*:) (..), K1 (..), M1 (..), U1 (..)) #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- | Provides access to 1st field of a tuple. class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 1st field of a tuple (and possibly change its type). -- -- >>> (1,2)^._1 -- 1 -- -- >>> _1 .~ "hello" $ (1,2) -- ("hello",2) -- -- >>> (1,2) & _1 .~ "hello" -- ("hello",2) -- -- >>> _1 putStrLn ("hello","world") -- hello -- ((),"world") -- -- This can also be used on larger tuples as well: -- -- >>> (1,2,3,4,5) & _1 +~ 41 -- (42,2,3,4,5) -- -- @ -- '_1' :: 'Lens' (a,b) (a',b) a a' -- '_1' :: 'Lens' (a,b,c) (a',b,c) a a' -- '_1' :: 'Lens' (a,b,c,d) (a',b,c,d) a a' -- ... -- '_1' :: 'Lens' (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' -- @ _1 :: Lens s t a b default _1 :: (Generic s, Generic t, GIxed N0 (Rep s) (Rep t) a b) => Lens s t a b _1 = ix proxyN0 {-# INLINE _1 #-} instance Field1 (Identity a) (Identity b) a b where _1 f (Identity a) = Identity <$> f a instance Field1 (Product f g a) (Product f' g a) (f a) (f' a) where _1 f (Pair a b) = flip Pair b <$> f a instance Field1 ((f :*: g) p) ((f' :*: g) p) (f p) (f' p) where _1 f (l :*: r) = (:*: r) <$> f l -- | @ -- '_1' k ~(a,b) = (\\a' -> (a',b)) 'Data.Functor.<$>' k a -- @ instance Field1 (a,b) (a',b) a a' where _1 k ~(a,b) = k a <&> \a' -> (a',b) {-# INLINE _1 #-} instance Field1 (a,b,c) (a',b,c) a a' where _1 k ~(a,b,c) = k a <&> \a' -> (a',b,c) {-# INLINE _1 #-} instance Field1 (a,b,c,d) (a',b,c,d) a a' where _1 k ~(a,b,c,d) = k a <&> \a' -> (a',b,c,d) {-# INLINE _1 #-} instance Field1 (a,b,c,d,e) (a',b,c,d,e) a a' where _1 k ~(a,b,c,d,e) = k a <&> \a' -> (a',b,c,d,e) {-# INLINE _1 #-} instance Field1 (a,b,c,d,e,f) (a',b,c,d,e,f) a a' where _1 k ~(a,b,c,d,e,f) = k a <&> \a' -> (a',b,c,d,e,f) {-# INLINE _1 #-} instance Field1 (a,b,c,d,e,f,g) (a',b,c,d,e,f,g) a a' where _1 k ~(a,b,c,d,e,f,g) = k a <&> \a' -> (a',b,c,d,e,f,g) {-# INLINE _1 #-} instance Field1 (a,b,c,d,e,f,g,h) (a',b,c,d,e,f,g,h) a a' where _1 k ~(a,b,c,d,e,f,g,h) = k a <&> \a' -> (a',b,c,d,e,f,g,h) {-# INLINE _1 #-} instance Field1 (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' where _1 k ~(a,b,c,d,e,f,g,h,i) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i) {-# INLINE _1 #-} -- | Provides access to the 2nd field of a tuple. class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 2nd field of a tuple. -- -- >>> _2 .~ "hello" $ (1,(),3,4) -- (1,"hello",3,4) -- -- >>> (1,2,3,4) & _2 *~ 3 -- (1,6,3,4) -- -- >>> _2 print (1,2) -- 2 -- (1,()) -- -- @ -- 'Control.Lens.Fold.anyOf' '_2' :: (s -> 'Bool') -> (a, s) -> 'Bool' -- 'Data.Traversable.traverse' '.' '_2' :: ('Control.Applicative.Applicative' f, 'Data.Traversable.Traversable' t) => (a -> f b) -> t (s, a) -> f (t (s, b)) -- 'Control.Lens.Fold.foldMapOf' ('Data.Traversable.traverse' '.' '_2') :: ('Data.Traversable.Traversable' t, 'Data.Monoid.Monoid' m) => (s -> m) -> t (b, s) -> m -- @ _2 :: Lens s t a b default _2 :: (Generic s, Generic t, GIxed N1 (Rep s) (Rep t) a b) => Lens s t a b _2 = ix proxyN1 {-# INLINE _2 #-} instance Field2 (Product f g a) (Product f g' a) (g a) (g' a) where _2 f (Pair a b) = Pair a <$> f b instance Field2 ((f :*: g) p) ((f :*: g') p) (g p) (g' p) where _2 f (l :*: r) = (l :*:) <$> f r -- | @ -- '_2' k ~(a,b) = (\\b' -> (a,b')) 'Data.Functor.<$>' k b -- @ instance Field2 (a,b) (a,b') b b' where _2 k ~(a,b) = k b <&> \b' -> (a,b') {-# INLINE _2 #-} instance Field2 (a,b,c) (a,b',c) b b' where _2 k ~(a,b,c) = k b <&> \b' -> (a,b',c) {-# INLINE _2 #-} instance Field2 (a,b,c,d) (a,b',c,d) b b' where _2 k ~(a,b,c,d) = k b <&> \b' -> (a,b',c,d) {-# INLINE _2 #-} instance Field2 (a,b,c,d,e) (a,b',c,d,e) b b' where _2 k ~(a,b,c,d,e) = k b <&> \b' -> (a,b',c,d,e) {-# INLINE _2 #-} instance Field2 (a,b,c,d,e,f) (a,b',c,d,e,f) b b' where _2 k ~(a,b,c,d,e,f) = k b <&> \b' -> (a,b',c,d,e,f) {-# INLINE _2 #-} instance Field2 (a,b,c,d,e,f,g) (a,b',c,d,e,f,g) b b' where _2 k ~(a,b,c,d,e,f,g) = k b <&> \b' -> (a,b',c,d,e,f,g) {-# INLINE _2 #-} instance Field2 (a,b,c,d,e,f,g,h) (a,b',c,d,e,f,g,h) b b' where _2 k ~(a,b,c,d,e,f,g,h) = k b <&> \b' -> (a,b',c,d,e,f,g,h) {-# INLINE _2 #-} instance Field2 (a,b,c,d,e,f,g,h,i) (a,b',c,d,e,f,g,h,i) b b' where _2 k ~(a,b,c,d,e,f,g,h,i) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i) {-# INLINE _2 #-} -- | Provides access to the 3rd field of a tuple. class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 3rd field of a tuple. _3 :: Lens s t a b default _3 :: (Generic s, Generic t, GIxed N2 (Rep s) (Rep t) a b) => Lens s t a b _3 = ix proxyN2 {-# INLINE _3 #-} instance Field3 (a,b,c) (a,b,c') c c' where _3 k ~(a,b,c) = k c <&> \c' -> (a,b,c') {-# INLINE _3 #-} instance Field3 (a,b,c,d) (a,b,c',d) c c' where _3 k ~(a,b,c,d) = k c <&> \c' -> (a,b,c',d) {-# INLINE _3 #-} instance Field3 (a,b,c,d,e) (a,b,c',d,e) c c' where _3 k ~(a,b,c,d,e) = k c <&> \c' -> (a,b,c',d,e) {-# INLINE _3 #-} instance Field3 (a,b,c,d,e,f) (a,b,c',d,e,f) c c' where _3 k ~(a,b,c,d,e,f) = k c <&> \c' -> (a,b,c',d,e,f) {-# INLINE _3 #-} instance Field3 (a,b,c,d,e,f,g) (a,b,c',d,e,f,g) c c' where _3 k ~(a,b,c,d,e,f,g) = k c <&> \c' -> (a,b,c',d,e,f,g) {-# INLINE _3 #-} instance Field3 (a,b,c,d,e,f,g,h) (a,b,c',d,e,f,g,h) c c' where _3 k ~(a,b,c,d,e,f,g,h) = k c <&> \c' -> (a,b,c',d,e,f,g,h) {-# INLINE _3 #-} instance Field3 (a,b,c,d,e,f,g,h,i) (a,b,c',d,e,f,g,h,i) c c' where _3 k ~(a,b,c,d,e,f,g,h,i) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i) {-# INLINE _3 #-} -- | Provide access to the 4th field of a tuple. class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 4th field of a tuple. _4 :: Lens s t a b default _4 :: (Generic s, Generic t, GIxed N3 (Rep s) (Rep t) a b) => Lens s t a b _4 = ix proxyN3 {-# INLINE _4 #-} instance Field4 (a,b,c,d) (a,b,c,d') d d' where _4 k ~(a,b,c,d) = k d <&> \d' -> (a,b,c,d') {-# INLINE _4 #-} instance Field4 (a,b,c,d,e) (a,b,c,d',e) d d' where _4 k ~(a,b,c,d,e) = k d <&> \d' -> (a,b,c,d',e) {-# INLINE _4 #-} instance Field4 (a,b,c,d,e,f) (a,b,c,d',e,f) d d' where _4 k ~(a,b,c,d,e,f) = k d <&> \d' -> (a,b,c,d',e,f) {-# INLINE _4 #-} instance Field4 (a,b,c,d,e,f,g) (a,b,c,d',e,f,g) d d' where _4 k ~(a,b,c,d,e,f,g) = k d <&> \d' -> (a,b,c,d',e,f,g) {-# INLINE _4 #-} instance Field4 (a,b,c,d,e,f,g,h) (a,b,c,d',e,f,g,h) d d' where _4 k ~(a,b,c,d,e,f,g,h) = k d <&> \d' -> (a,b,c,d',e,f,g,h) {-# INLINE _4 #-} instance Field4 (a,b,c,d,e,f,g,h,i) (a,b,c,d',e,f,g,h,i) d d' where _4 k ~(a,b,c,d,e,f,g,h,i) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i) {-# INLINE _4 #-} -- | Provides access to the 5th field of a tuple. class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 5th field of a tuple. _5 :: Lens s t a b default _5 :: (Generic s, Generic t, GIxed N4 (Rep s) (Rep t) a b) => Lens s t a b _5 = ix proxyN4 {-# INLINE _5 #-} instance Field5 (a,b,c,d,e) (a,b,c,d,e') e e' where _5 k ~(a,b,c,d,e) = k e <&> \e' -> (a,b,c,d,e') {-# INLINE _5 #-} instance Field5 (a,b,c,d,e,f) (a,b,c,d,e',f) e e' where _5 k ~(a,b,c,d,e,f) = k e <&> \e' -> (a,b,c,d,e',f) {-# INLINE _5 #-} instance Field5 (a,b,c,d,e,f,g) (a,b,c,d,e',f,g) e e' where _5 k ~(a,b,c,d,e,f,g) = k e <&> \e' -> (a,b,c,d,e',f,g) {-# INLINE _5 #-} instance Field5 (a,b,c,d,e,f,g,h) (a,b,c,d,e',f,g,h) e e' where _5 k ~(a,b,c,d,e,f,g,h) = k e <&> \e' -> (a,b,c,d,e',f,g,h) {-# INLINE _5 #-} instance Field5 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e',f,g,h,i) e e' where _5 k ~(a,b,c,d,e,f,g,h,i) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i) {-# INLINE _5 #-} -- | Provides access to the 6th element of a tuple. class Field6 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 6th field of a tuple. _6 :: Lens s t a b default _6 :: (Generic s, Generic t, GIxed N5 (Rep s) (Rep t) a b) => Lens s t a b _6 = ix proxyN5 {-# INLINE _6 #-} instance Field6 (a,b,c,d,e,f) (a,b,c,d,e,f') f f' where _6 k ~(a,b,c,d,e,f) = k f <&> \f' -> (a,b,c,d,e,f') {-# INLINE _6 #-} instance Field6 (a,b,c,d,e,f,g) (a,b,c,d,e,f',g) f f' where _6 k ~(a,b,c,d,e,f,g) = k f <&> \f' -> (a,b,c,d,e,f',g) {-# INLINE _6 #-} instance Field6 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f',g,h) f f' where _6 k ~(a,b,c,d,e,f,g,h) = k f <&> \f' -> (a,b,c,d,e,f',g,h) {-# INLINE _6 #-} instance Field6 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f',g,h,i) f f' where _6 k ~(a,b,c,d,e,f,g,h,i) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i) {-# INLINE _6 #-} -- | Provide access to the 7th field of a tuple. class Field7 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 7th field of a tuple. _7 :: Lens s t a b default _7 :: (Generic s, Generic t, GIxed N6 (Rep s) (Rep t) a b) => Lens s t a b _7 = ix proxyN6 {-# INLINE _7 #-} instance Field7 (a,b,c,d,e,f,g) (a,b,c,d,e,f,g') g g' where _7 k ~(a,b,c,d,e,f,g) = k g <&> \g' -> (a,b,c,d,e,f,g') {-# INLINE _7 #-} instance Field7 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f,g',h) g g' where _7 k ~(a,b,c,d,e,f,g,h) = k g <&> \g' -> (a,b,c,d,e,f,g',h) {-# INLINE _7 #-} instance Field7 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g',h,i) g g' where _7 k ~(a,b,c,d,e,f,g,h,i) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i) {-# INLINE _7 #-} -- | Provide access to the 8th field of a tuple. class Field8 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 8th field of a tuple. _8 :: Lens s t a b default _8 :: (Generic s, Generic t, GIxed N7 (Rep s) (Rep t) a b) => Lens s t a b _8 = ix proxyN7 {-# INLINE _8 #-} instance Field8 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f,g,h') h h' where _8 k ~(a,b,c,d,e,f,g,h) = k h <&> \h' -> (a,b,c,d,e,f,g,h') {-# INLINE _8 #-} instance Field8 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g,h',i) h h' where _8 k ~(a,b,c,d,e,f,g,h,i) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i) {-# INLINE _8 #-} -- | Provides access to the 9th field of a tuple. class Field9 s t a b | s -> a, t -> b, s b -> t, t a -> s where -- | Access the 9th field of a tuple. _9 :: Lens s t a b default _9 :: (Generic s, Generic t, GIxed N8 (Rep s) (Rep t) a b) => Lens s t a b _9 = ix proxyN8 {-# INLINE _9 #-} instance Field9 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g,h,i') i i' where _9 k ~(a,b,c,d,e,f,g,h,i) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i') {-# INLINE _9 #-} -- Strict versions of the _1 .. _9 operations -- | Strict version of '_1' _1' :: Field1 s t a b => Lens s t a b _1' = \f !x -> _1 f x {-# INLINE _1' #-} -- | Strict version of '_2' _2' :: Field2 s t a b => Lens s t a b _2' = \f !x -> _2 f x {-# INLINE _2' #-} -- | Strict version of '_3' _3' :: Field3 s t a b => Lens s t a b _3' = \f !x -> _3 f x {-# INLINE _3' #-} -- | Strict version of '_4' _4' :: Field4 s t a b => Lens s t a b _4' = \f !x -> _4 f x {-# INLINE _4' #-} -- | Strict version of '_5' _5' :: Field5 s t a b => Lens s t a b _5' = \f !x -> _5 f x {-# INLINE _5' #-} -- | Strict version of '_6' _6' :: Field6 s t a b => Lens s t a b _6' = \f !x -> _6 f x {-# INLINE _6' #-} -- | Strict version of '_7' _7' :: Field7 s t a b => Lens s t a b _7' = \f !x -> _7 f x {-# INLINE _7' #-} -- | Strict version of '_8' _8' :: Field8 s t a b => Lens s t a b _8' = \f !x -> _8 f x {-# INLINE _8' #-} -- | Strict version of '_9' _9' :: Field9 s t a b => Lens s t a b _9' = \f !x -> _9 f x {-# INLINE _9' #-} ix :: (Generic s, Generic t, GIxed n (Rep s) (Rep t) a b) => f n -> Lens s t a b ix n f = fmap to . gix n f . from {-# INLINE ix #-} type family GSize (f :: * -> *) type instance GSize U1 = Z type instance GSize (K1 i c) = S Z type instance GSize (M1 i c f) = GSize f type instance GSize (a :*: b) = Add (GSize a) (GSize b) class GIxed n s t a b | n s -> a, n t -> b, n s b -> t, n t a -> s where gix :: f n -> Lens (s x) (t x) a b instance GIxed N0 (K1 i a) (K1 i b) a b where gix _ = dimap unK1 (fmap K1) {-# INLINE gix #-} instance GIxed n s t a b => GIxed n (M1 i c s) (M1 i c t) a b where gix n = dimap unM1 (fmap M1) . gix n {-# INLINE gix #-} instance (p ~ GT (GSize s) n, p ~ GT (GSize t) n, GIxed' p n s s' t t' a b) => GIxed n (s :*: s') (t :*: t') a b where gix = gix' (Proxy :: Proxy p) {-# INLINE gix #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 -- $gixed-fundeps -- >>> :set -XDeriveGeneric -XFlexibleInstances -XMultiParamTypeClasses -- >>> import GHC.Generics (Generic) -- >>> data Product a b = a :* b deriving Generic -- >>> instance Field1 (Product a b) (Product a' b) a a' -- >>> instance Field2 (Product a b) (Product a b') b b' #endif class (p ~ GT (GSize s) n, p ~ GT (GSize t) n) => GIxed' p n s s' t t' a b | p n s s' -> a , p n t t' -> b , p n s s' b -> t t' , p n t t' a -> s s' where gix' :: f p -> g n -> Lens ((s :*: s') x) ((t :*: t') x) a b instance (GT (GSize s) n ~ T, GT (GSize t) n ~ T, GIxed n s t a b) => GIxed' T n s s' t s' a b where gix' _ n f (s :*: s') = (:*: s') <$> gix n f s {-# INLINE gix' #-} instance (GT (GSize s) n ~ F, n' ~ Subtract (GSize s) n, GIxed n' s' t' a b) => GIxed' F n s s' s t' a b where gix' _ _ f (s :*: s') = (s :*:) <$> gix (Proxy :: Proxy n') f s' {-# INLINE gix' #-} data Z data S a data T data F type family Add x y type instance Add Z y = y type instance Add (S x) y = S (Add x y) type family Subtract x y type instance Subtract Z x = x type instance Subtract (S x) (S y) = Subtract x y type family GT x y type instance GT Z x = F type instance GT (S x) Z = T type instance GT (S x) (S y) = GT x y type N0 = Z type N1 = S N0 type N2 = S N1 type N3 = S N2 type N4 = S N3 type N5 = S N4 type N6 = S N5 type N7 = S N6 type N8 = S N7 proxyN0 :: Proxy N0 proxyN0 = Proxy {-# INLINE proxyN0 #-} proxyN1 :: Proxy N1 proxyN1 = Proxy {-# INLINE proxyN1 #-} proxyN2 :: Proxy N2 proxyN2 = Proxy {-# INLINE proxyN2 #-} proxyN3 :: Proxy N3 proxyN3 = Proxy {-# INLINE proxyN3 #-} proxyN4 :: Proxy N4 proxyN4 = Proxy {-# INLINE proxyN4 #-} proxyN5 :: Proxy N5 proxyN5 = Proxy {-# INLINE proxyN5 #-} proxyN6 :: Proxy N6 proxyN6 = Proxy {-# INLINE proxyN6 #-} proxyN7 :: Proxy N7 proxyN7 = Proxy {-# INLINE proxyN7 #-} proxyN8 :: Proxy N8 proxyN8 = Proxy {-# INLINE proxyN8 #-} lens-4.14/src/Control/Lens/Type.hs0000644000000000000000000005455612710476104015177 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE KindSignatures #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TypeInType #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Type -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- -- This module exports the majority of the types that need to appear in user -- signatures or in documentation when talking about lenses. The remaining types -- for consuming lenses are distributed across various modules in the hierarchy. ------------------------------------------------------------------------------- module Control.Lens.Type ( -- * Other Equality, Equality', As , Iso, Iso' , Prism , Prism' , Review , AReview -- * Lenses, Folds and Traversals , Lens, Lens' , Traversal, Traversal' , Traversal1, Traversal1' , Setter, Setter' , Getter, Fold , Fold1 -- * Indexed , IndexedLens, IndexedLens' , IndexedTraversal, IndexedTraversal' , IndexedTraversal1, IndexedTraversal1' , IndexedSetter, IndexedSetter' , IndexedGetter, IndexedFold , IndexedFold1 -- * Index-Preserving , IndexPreservingLens, IndexPreservingLens' , IndexPreservingTraversal, IndexPreservingTraversal' , IndexPreservingTraversal1, IndexPreservingTraversal1' , IndexPreservingSetter, IndexPreservingSetter' , IndexPreservingGetter, IndexPreservingFold , IndexPreservingFold1 -- * Common , Simple , LensLike, LensLike' , Over, Over' , IndexedLensLike, IndexedLensLike' , Optical, Optical' , Optic, Optic' ) where import Control.Applicative import Control.Lens.Internal.Setter import Control.Lens.Internal.Indexed import Data.Bifunctor import Data.Functor.Identity import Data.Functor.Contravariant import Data.Functor.Apply #if __GLASGOW_HASKELL__ >= 800 import Data.Kind #endif import Data.Profunctor import Data.Tagged import Prelude () -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g,h) -- >>> import Prelude -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- >>> let h :: Expr -> Expr -> Expr; h = Debug.SimpleReflect.Vars.h -- >>> let getter :: Expr -> Expr; getter = fun "getter" -- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter" -- >>> import Numeric.Natural -- >>> let nat :: Prism' Integer Natural; nat = prism toInteger $ \i -> if i < 0 then Left i else Right (fromInteger i) ------------------------------------------------------------------------------- -- Lenses ------------------------------------------------------------------------------- -- | A 'Lens' is actually a lens family as described in -- . -- -- With great power comes great responsibility and a 'Lens' is subject to the -- three common sense 'Lens' laws: -- -- 1) You get back what you put in: -- -- @ -- 'Control.Lens.Getter.view' l ('Control.Lens.Setter.set' l v s) ≡ v -- @ -- -- 2) Putting back what you got doesn't change anything: -- -- @ -- 'Control.Lens.Setter.set' l ('Control.Lens.Getter.view' l s) s ≡ s -- @ -- -- 3) Setting twice is the same as setting once: -- -- @ -- 'Control.Lens.Setter.set' l v' ('Control.Lens.Setter.set' l v s) ≡ 'Control.Lens.Setter.set' l v' s -- @ -- -- These laws are strong enough that the 4 type parameters of a 'Lens' cannot -- vary fully independently. For more on how they interact, read the \"Why is -- it a Lens Family?\" section of -- . -- -- There are some emergent properties of these laws: -- -- 1) @'Control.Lens.Setter.set' l s@ must be injective for every @s@ This is a consequence of law #1 -- -- 2) @'Control.Lens.Setter.set' l@ must be surjective, because of law #2, which indicates that it is possible to obtain any 'v' from some 's' such that @'Control.Lens.Setter.set' s v = s@ -- -- 3) Given just the first two laws you can prove a weaker form of law #3 where the values @v@ that you are setting match: -- -- @ -- 'Control.Lens.Setter.set' l v ('Control.Lens.Setter.set' l v s) ≡ 'Control.Lens.Setter.set' l v s -- @ -- -- Every 'Lens' can be used directly as a 'Control.Lens.Setter.Setter' or 'Traversal'. -- -- You can also use a 'Lens' for 'Control.Lens.Getter.Getting' as if it were a -- 'Fold' or 'Getter'. -- -- Since every 'Lens' is a valid 'Traversal', the -- 'Traversal' laws are required of any 'Lens' you create: -- -- @ -- l 'pure' ≡ 'pure' -- 'fmap' (l f) '.' l g ≡ 'Data.Functor.Compose.getCompose' '.' l ('Data.Functor.Compose.Compose' '.' 'fmap' f '.' g) -- @ -- -- @ -- type 'Lens' s t a b = forall f. 'Functor' f => 'LensLike' f s t a b -- @ type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t -- | @ -- type 'Lens'' = 'Simple' 'Lens' -- @ type Lens' s a = Lens s s a a -- | Every 'IndexedLens' is a valid 'Lens' and a valid 'Control.Lens.Traversal.IndexedTraversal'. type IndexedLens i s t a b = forall f p. (Indexable i p, Functor f) => p a (f b) -> s -> f t -- | @ -- type 'IndexedLens'' i = 'Simple' ('IndexedLens' i) -- @ type IndexedLens' i s a = IndexedLens i s s a a -- | An 'IndexPreservingLens' leaves any index it is composed with alone. type IndexPreservingLens s t a b = forall p f. (Conjoined p, Functor f) => p a (f b) -> p s (f t) -- | @ -- type 'IndexPreservingLens'' = 'Simple' 'IndexPreservingLens' -- @ type IndexPreservingLens' s a = IndexPreservingLens s s a a ------------------------------------------------------------------------------ -- Traversals ------------------------------------------------------------------------------ -- | A 'Traversal' can be used directly as a 'Control.Lens.Setter.Setter' or a 'Fold' (but not as a 'Lens') and provides -- the ability to both read and update multiple fields, subject to some relatively weak 'Traversal' laws. -- -- These have also been known as multilenses, but they have the signature and spirit of -- -- @ -- 'Data.Traversable.traverse' :: 'Data.Traversable.Traversable' f => 'Traversal' (f a) (f b) a b -- @ -- -- and the more evocative name suggests their application. -- -- Most of the time the 'Traversal' you will want to use is just 'Data.Traversable.traverse', but you can also pass any -- 'Lens' or 'Iso' as a 'Traversal', and composition of a 'Traversal' (or 'Lens' or 'Iso') with a 'Traversal' (or 'Lens' or 'Iso') -- using ('.') forms a valid 'Traversal'. -- -- The laws for a 'Traversal' @t@ follow from the laws for 'Data.Traversable.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) -- @ -- -- One consequence of this requirement is that a 'Traversal' needs to leave the same number of elements as a -- candidate for subsequent 'Traversal' that it started with. Another testament to the strength of these laws -- is that the caveat expressed in section 5.5 of the \"Essence of the Iterator Pattern\" about exotic -- 'Data.Traversable.Traversable' instances that 'Data.Traversable.traverse' the same entry multiple times was actually already ruled out by the -- second law in that same paper! type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t -- | @ -- type 'Traversal'' = 'Simple' 'Traversal' -- @ type Traversal' s a = Traversal s s a a type Traversal1 s t a b = forall f. Apply f => (a -> f b) -> s -> f t type Traversal1' s a = Traversal1 s s a a -- | Every 'IndexedTraversal' is a valid 'Control.Lens.Traversal.Traversal' or -- 'Control.Lens.Fold.IndexedFold'. -- -- The 'Indexed' constraint is used to allow an 'IndexedTraversal' to be used -- directly as a 'Control.Lens.Traversal.Traversal'. -- -- The 'Control.Lens.Traversal.Traversal' laws are still required to hold. -- -- In addition, the index @i@ should satisfy the requirement that it stays -- unchanged even when modifying the value @a@, otherwise traversals like -- 'indices' break the 'Traversal' laws. type IndexedTraversal i s t a b = forall p f. (Indexable i p, Applicative f) => p a (f b) -> s -> f t -- | @ -- type 'IndexedTraversal'' i = 'Simple' ('IndexedTraversal' i) -- @ type IndexedTraversal' i s a = IndexedTraversal i s s a a type IndexedTraversal1 i s t a b = forall p f. (Indexable i p, Apply f) => p a (f b) -> s -> f t type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a -- | An 'IndexPreservingLens' leaves any index it is composed with alone. type IndexPreservingTraversal s t a b = forall p f. (Conjoined p, Applicative f) => p a (f b) -> p s (f t) -- | @ -- type 'IndexPreservingTraversal'' = 'Simple' 'IndexPreservingTraversal' -- @ type IndexPreservingTraversal' s a = IndexPreservingTraversal s s a a type IndexPreservingTraversal1 s t a b = forall p f. (Conjoined p, Apply f) => p a (f b) -> p s (f t) type IndexPreservingTraversal1' s a = IndexPreservingTraversal1 s s a a ------------------------------------------------------------------------------ -- Setters ------------------------------------------------------------------------------ -- | The only 'LensLike' law that can apply to a 'Setter' @l@ is that -- -- @ -- 'Control.Lens.Setter.set' l y ('Control.Lens.Setter.set' l x a) ≡ 'Control.Lens.Setter.set' l y a -- @ -- -- You can't 'Control.Lens.Getter.view' a 'Setter' in general, so the other two laws are irrelevant. -- -- However, two 'Functor' laws apply to a 'Setter': -- -- @ -- 'Control.Lens.Setter.over' l 'id' ≡ 'id' -- 'Control.Lens.Setter.over' l f '.' 'Control.Lens.Setter.over' l g ≡ 'Control.Lens.Setter.over' l (f '.' g) -- @ -- -- These can be stated more directly: -- -- @ -- l 'pure' ≡ 'pure' -- l f '.' 'untainted' '.' l g ≡ l (f '.' 'untainted' '.' g) -- @ -- -- You can compose a 'Setter' with a 'Lens' or a 'Traversal' using ('.') from the @Prelude@ -- and the result is always only a 'Setter' and nothing more. -- -- >>> over traverse f [a,b,c,d] -- [f a,f b,f c,f d] -- -- >>> over _1 f (a,b) -- (f a,b) -- -- >>> over (traverse._1) f [(a,b),(c,d)] -- [(f a,b),(f c,d)] -- -- >>> over both f (a,b) -- (f a,f b) -- -- >>> over (traverse.both) f [(a,b),(c,d)] -- [(f a,f b),(f c,f d)] type Setter s t a b = forall f. Settable f => (a -> f b) -> s -> f t -- | A 'Setter'' is just a 'Setter' that doesn't change the types. -- -- These are particularly common when talking about monomorphic containers. /e.g./ -- -- @ -- 'sets' Data.Text.map :: 'Setter'' 'Data.Text.Internal.Text' 'Char' -- @ -- -- @ -- type 'Setter'' = 'Setter'' -- @ type Setter' s a = Setter s s a a -- | Every 'IndexedSetter' is a valid 'Setter'. -- -- The 'Setter' laws are still required to hold. type IndexedSetter i s t a b = forall f p. (Indexable i p, Settable f) => p a (f b) -> s -> f t -- | @ -- type 'IndexedSetter'' i = 'Simple' ('IndexedSetter' i) -- @ type IndexedSetter' i s a = IndexedSetter i s s a a -- | An 'IndexPreservingSetter' can be composed with a 'IndexedSetter', 'IndexedTraversal' or 'IndexedLens' -- and leaves the index intact, yielding an 'IndexedSetter'. type IndexPreservingSetter s t a b = forall p f. (Conjoined p, Settable f) => p a (f b) -> p s (f t) -- | @ -- type 'IndexedPreservingSetter'' i = 'Simple' 'IndexedPreservingSetter' -- @ type IndexPreservingSetter' s a = IndexPreservingSetter s s a a ----------------------------------------------------------------------------- -- Isomorphisms ----------------------------------------------------------------------------- -- | Isomorphism families can be composed with another 'Lens' using ('.') and 'id'. -- -- Note: Composition with an 'Iso' is index- and measure- preserving. type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t) -- | @ -- type 'Iso'' = 'Control.Lens.Type.Simple' 'Iso' -- @ type Iso' s a = Iso s s a a ------------------------------------------------------------------------------ -- Review Internals ------------------------------------------------------------------------------ -- | This is a limited form of a 'Prism' that can only be used for 're' operations. -- -- Like with a 'Getter', there are no laws to state for a 'Review'. -- -- You can generate a 'Review' by using 'unto'. You can also use any 'Prism' or 'Iso' -- directly as a 'Review'. type Review t b = forall p f. (Choice p, Bifunctor p, Settable f) => Optic' p f t b -- | If you see this in a signature for a function, the function is expecting a 'Review' -- (in practice, this usually means a 'Prism'). type AReview t b = Optic' Tagged Identity t b ------------------------------------------------------------------------------ -- Prism Internals ------------------------------------------------------------------------------ -- | A 'Prism' @l@ is a 'Traversal' that can also be turned -- around with 'Control.Lens.Review.re' to obtain a 'Getter' in the -- opposite direction. -- -- There are two laws that a 'Prism' should satisfy: -- -- First, if I 'Control.Lens.Review.re' or 'Control.Lens.Review.review' a value with a 'Prism' and then 'Control.Lens.Fold.preview' or use ('Control.Lens.Fold.^?'), I will get it back: -- -- @ -- 'Control.Lens.Fold.preview' l ('Control.Lens.Review.review' l b) ≡ 'Just' b -- @ -- -- Second, if you can extract a value @a@ using a 'Prism' @l@ from a value @s@, then the value @s@ is completely described by @l@ and @a@: -- -- If @'Control.Lens.Fold.preview' l s ≡ 'Just' a@ then @'Control.Lens.Review.review' l a ≡ s@ -- -- These two laws imply that the 'Traversal' laws hold for every 'Prism' and that we 'Data.Traversable.traverse' at most 1 element: -- -- @ -- 'Control.Lens.Fold.lengthOf' l x '<=' 1 -- @ -- -- It may help to think of this as a 'Iso' that can be partial in one direction. -- -- Every 'Prism' is a valid 'Traversal'. -- -- Every 'Iso' is a valid 'Prism'. -- -- For example, you might have a @'Prism'' 'Integer' 'Numeric.Natural.Natural'@ allows you to always -- go from a 'Numeric.Natural.Natural' to an 'Integer', and provide you with tools to check if an 'Integer' is -- a 'Numeric.Natural.Natural' and/or to edit one if it is. -- -- -- @ -- 'nat' :: 'Prism'' 'Integer' 'Numeric.Natural.Natural' -- 'nat' = 'Control.Lens.Prism.prism' 'toInteger' '$' \\ i -> -- if i '<' 0 -- then 'Left' i -- else 'Right' ('fromInteger' i) -- @ -- -- Now we can ask if an 'Integer' is a 'Numeric.Natural.Natural'. -- -- >>> 5^?nat -- Just 5 -- -- >>> (-5)^?nat -- Nothing -- -- We can update the ones that are: -- -- >>> (-3,4) & both.nat *~ 2 -- (-3,8) -- -- And we can then convert from a 'Numeric.Natural.Natural' to an 'Integer'. -- -- >>> 5 ^. re nat -- :: Natural -- 5 -- -- Similarly we can use a 'Prism' to 'Data.Traversable.traverse' the 'Left' half of an 'Either': -- -- >>> Left "hello" & _Left %~ length -- Left 5 -- -- or to construct an 'Either': -- -- >>> 5^.re _Left -- Left 5 -- -- such that if you query it with the 'Prism', you will get your original input back. -- -- >>> 5^.re _Left ^? _Left -- Just 5 -- -- Another interesting way to think of a 'Prism' is as the categorical dual of a 'Lens' -- -- a co-'Lens', so to speak. This is what permits the construction of 'Control.Lens.Prism.outside'. -- -- Note: Composition with a 'Prism' is index-preserving. type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t) -- | A 'Simple' 'Prism'. type Prism' s a = Prism s s a a ------------------------------------------------------------------------------- -- Equality ------------------------------------------------------------------------------- -- | A witness that @(a ~ s, b ~ t)@. -- -- Note: Composition with an 'Equality' is index-preserving. #if __GLASGOW_HASKELL__ >= 800 type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall k3 (p :: k1 -> k3 -> *) (f :: k2 -> k3) . #elif __GLASGOW_HASKELL__ >= 706 type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall (p :: k1 -> * -> *) (f :: k2 -> *) . #else type Equality s t a b = forall p (f :: * -> *) . #endif p a (f b) -> p s (f t) -- | A 'Simple' 'Equality'. type Equality' s a = Equality s s a a -- | Composable `asTypeOf`. Useful for constraining excess -- polymorphism, @foo . (id :: As Int) . bar@. type As a = Equality' a a ------------------------------------------------------------------------------- -- Getters ------------------------------------------------------------------------------- -- | A 'Getter' describes how to retrieve a single value in a way that can be -- composed with other 'LensLike' constructions. -- -- Unlike a 'Lens' a 'Getter' is read-only. Since a 'Getter' -- cannot be used to write back there are no 'Lens' laws that can be applied to -- it. In fact, it is isomorphic to an arbitrary function from @(s -> a)@. -- -- Moreover, a 'Getter' can be used directly as a 'Control.Lens.Fold.Fold', -- since it just ignores the 'Applicative'. type Getter s a = forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s -- | Every 'IndexedGetter' is a valid 'Control.Lens.Fold.IndexedFold' and can be used for 'Control.Lens.Getter.Getting' like a 'Getter'. type IndexedGetter i s a = forall p f. (Indexable i p, Contravariant f, Functor f) => p a (f a) -> s -> f s -- | An 'IndexPreservingGetter' can be used as a 'Getter', but when composed with an 'IndexedTraversal', -- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold', 'IndexedFold' or 'IndexedGetter' respectively. type IndexPreservingGetter s a = forall p f. (Conjoined p, Contravariant f, Functor f) => p a (f a) -> p s (f s) -------------------------- -- Folds -------------------------- -- | A 'Fold' describes how to retrieve multiple values in a way that can be composed -- with other 'LensLike' constructions. -- -- A @'Fold' s a@ provides a structure with operations very similar to those of the 'Data.Foldable.Foldable' -- typeclass, see 'Control.Lens.Fold.foldMapOf' and the other 'Fold' combinators. -- -- By convention, if there exists a 'foo' method that expects a @'Data.Foldable.Foldable' (f a)@, then there should be a -- @fooOf@ method that takes a @'Fold' s a@ and a value of type @s@. -- -- A 'Getter' is a legal 'Fold' that just ignores the supplied 'Data.Monoid.Monoid'. -- -- Unlike a 'Control.Lens.Traversal.Traversal' a 'Fold' is read-only. Since a 'Fold' cannot be used to write back -- there are no 'Lens' laws that apply. type Fold s a = forall f. (Contravariant f, Applicative f) => (a -> f a) -> s -> f s -- | Every 'IndexedFold' is a valid 'Control.Lens.Fold.Fold' and can be used for 'Control.Lens.Getter.Getting'. type IndexedFold i s a = forall p f. (Indexable i p, Contravariant f, Applicative f) => p a (f a) -> s -> f s -- | An 'IndexPreservingFold' can be used as a 'Fold', but when composed with an 'IndexedTraversal', -- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold' respectively. type IndexPreservingFold s a = forall p f. (Conjoined p, Contravariant f, Applicative f) => p a (f a) -> p s (f s) -- | A relevant Fold (aka 'Fold1') has one or more targets. type Fold1 s a = forall f. (Contravariant f, Apply f) => (a -> f a) -> s -> f s type IndexedFold1 i s a = forall p f. (Indexable i p, Contravariant f, Apply f) => p a (f a) -> s -> f s type IndexPreservingFold1 s a = forall p f. (Conjoined p, Contravariant f, Apply f) => p a (f a) -> p s (f s) ------------------------------------------------------------------------------- -- Simple Overloading ------------------------------------------------------------------------------- -- | A 'Simple' 'Lens', 'Simple' 'Traversal', ... can -- be used instead of a 'Lens','Traversal', ... -- whenever the type variables don't change upon setting a value. -- -- @ -- 'Data.Complex.Lens._imagPart' :: 'Simple' 'Lens' ('Data.Complex.Complex' a) a -- 'Control.Lens.Traversal.traversed' :: 'Simple' ('IndexedTraversal' 'Int') [a] a -- @ -- -- Note: To use this alias in your own code with @'LensLike' f@ or -- 'Setter', you may have to turn on @LiberalTypeSynonyms@. -- -- This is commonly abbreviated as a \"prime\" marker, /e.g./ 'Lens'' = 'Simple' 'Lens'. type Simple f s a = f s s a a ------------------------------------------------------------------------------- -- Optics ------------------------------------------------------------------------------- -- | A valid 'Optic' @l@ should satisfy the laws: -- -- @ -- l 'pure' ≡ 'pure' -- l ('Procompose' f g) = 'Procompose' (l f) (l g) -- @ -- -- This gives rise to the laws for 'Equality', 'Iso', 'Prism', 'Lens', -- 'Traversal', 'Traversal1', 'Setter', 'Fold', 'Fold1', and 'Getter' as well -- along with their index-preserving variants. -- -- @ -- type 'LensLike' f s t a b = 'Optic' (->) f s t a b -- @ type Optic p f s t a b = p a (f b) -> p s (f t) -- | @ -- type 'Optic'' p f s a = 'Simple' ('Optic' p f) s a -- @ type Optic' p f s a = Optic p f s s a a -- | @ -- type 'LensLike' f s t a b = 'Optical' (->) (->) f s t a b -- @ -- -- @ -- type 'Over' p f s t a b = 'Optical' p (->) f s t a b -- @ -- -- @ -- type 'Optic' p f s t a b = 'Optical' p p f s t a b -- @ type Optical p q f s t a b = p a (f b) -> q s (f t) -- | @ -- type 'Optical'' p q f s a = 'Simple' ('Optical' p q f) s a -- @ type Optical' p q f s a = Optical p q f s s a a -- | Many combinators that accept a 'Lens' can also accept a -- 'Traversal' in limited situations. -- -- They do so by specializing the type of 'Functor' that they require of the -- caller. -- -- If a function accepts a @'LensLike' f s t a b@ for some 'Functor' @f@, -- then they may be passed a 'Lens'. -- -- Further, if @f@ is an 'Applicative', they may also be passed a -- 'Traversal'. type LensLike f s t a b = (a -> f b) -> s -> f t -- | @ -- type 'LensLike'' f = 'Simple' ('LensLike' f) -- @ type LensLike' f s a = LensLike f s s a a -- | Convenient alias for constructing indexed lenses and their ilk. type IndexedLensLike i f s t a b = forall p. Indexable i p => p a (f b) -> s -> f t -- | Convenient alias for constructing simple indexed lenses and their ilk. type IndexedLensLike' i f s a = IndexedLensLike i f s s a a -- | This is a convenient alias for use when you need to consume either indexed or non-indexed lens-likes based on context. type Over p f s t a b = p a (f b) -> s -> f t -- | This is a convenient alias for use when you need to consume either indexed or non-indexed lens-likes based on context. -- -- @ -- type 'Over'' p f = 'Simple' ('Over' p f) -- @ type Over' p f s a = Over p f s s a a lens-4.14/src/Control/Lens/Wrapped.hs0000644000000000000000000005762712710476104015662 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Wrapped -- Copyright : (C) 2012-16 Edward Kmett, Michael Sloan -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : Rank2, MPTCs, fundeps -- -- The 'Wrapped' class provides similar functionality as @Control.Newtype@, -- from the @newtype@ package, but in a more convenient and efficient form. -- -- There are a few functions from @newtype@ that are not provided here, because -- they can be done with the 'Iso' directly: -- -- @ -- Control.Newtype.over 'Sum' f ≡ '_Unwrapping' 'Sum' 'Control.Lens.Setter.%~' f -- Control.Newtype.under 'Sum' f ≡ '_Wrapping' 'Sum' 'Control.Lens.Setter.%~' f -- Control.Newtype.overF 'Sum' f ≡ 'mapping' ('_Unwrapping' 'Sum') 'Control.Lens.Setter.%~' f -- Control.Newtype.underF 'Sum' f ≡ 'mapping' ('_Wrapping' 'Sum') 'Control.Lens.Setter.%~' f -- @ -- -- 'under' can also be used with '_Unwrapping' to provide the equivalent of -- @Control.Newtype.under@. Also, most use cases don't need full polymorphism, -- so only the single constructor '_Wrapping' functions would be needed. -- -- These equivalences aren't 100% honest, because @newtype@'s operators -- need to rely on two @Newtype@ constraints. This means that the wrapper used -- for the output is not necessarily the same as the input. -- ---------------------------------------------------------------------------- module Control.Lens.Wrapped ( -- * Wrapping and Unwrapping monomorphically Wrapped(..) , _Unwrapped' , _Wrapping', _Unwrapping' -- * Wrapping and unwrapping polymorphically , Rewrapped, Rewrapping , _Wrapped, _Unwrapped , _Wrapping, _Unwrapping -- * Operations , op , ala, alaf #if __GLASGOW_HASKELL__ >= 710 -- * Pattern Synonyms , pattern Wrapped , pattern Unwrapped #endif ) where import Control.Applicative import Control.Arrow import Control.Applicative.Backwards import Control.Comonad.Trans.Traced import Control.Exception import Control.Lens.Getter import Control.Lens.Iso #if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Review #endif import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader import qualified Control.Monad.Trans.RWS.Lazy as Lazy import qualified Control.Monad.Trans.RWS.Strict as Strict import qualified Control.Monad.Trans.State.Lazy as Lazy import qualified Control.Monad.Trans.State.Strict as Strict import qualified Control.Monad.Trans.Writer.Lazy as Lazy import qualified Control.Monad.Trans.Writer.Strict as Strict import Data.Foldable as Foldable import Data.Functor.Compose import Data.Functor.Contravariant import qualified Data.Functor.Contravariant.Compose as Contravariant import Data.Functor.Constant import Data.Functor.Identity import Data.Functor.Reverse import Data.Hashable import Data.IntSet as IntSet import Data.IntMap as IntMap import Data.HashSet as HashSet import Data.HashMap.Lazy as HashMap import Data.List.NonEmpty import Data.Map as Map import Data.Monoid import qualified Data.Semigroup as S import Data.Sequence as Seq hiding (length) import Data.Set as Set import Data.Tagged import Data.Vector as Vector import Data.Vector.Primitive as Prim import Data.Vector.Unboxed as Unboxed import Data.Vector.Storable as Storable #if MIN_VERSION_base(4,6,0) import Data.Ord (Down(Down)) #else import GHC.Exts (Down(Down)) #endif #ifdef HLINT {-# ANN module "HLint: ignore Use uncurry" #-} #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- | 'Wrapped' provides isomorphisms to wrap and unwrap newtypes or -- data types with one constructor. class Wrapped s where type Unwrapped s :: * -- | An isomorphism between @s@ and @a@. _Wrapped' :: Iso' s (Unwrapped s) #if __GLASGOW_HASKELL__ >= 710 pattern Wrapped a <- (view _Wrapped -> a) where Wrapped a = review _Wrapped a pattern Unwrapped a <- (view _Unwrapped -> a) where Unwrapped a = review _Unwrapped a #endif -- This can be used to help inference between the wrappers class Wrapped s => Rewrapped (s :: *) (t :: *) class (Rewrapped s t, Rewrapped t s) => Rewrapping s t instance (Rewrapped s t, Rewrapped t s) => Rewrapping s t _Unwrapped' :: Wrapped s => Iso' (Unwrapped s) s _Unwrapped' = from _Wrapped' {-# INLINE _Unwrapped' #-} -- | Work under a newtype wrapper. -- -- >>> Const "hello" & _Wrapped %~ Prelude.length & getConst -- 5 -- -- @ -- '_Wrapped' ≡ 'from' '_Unwrapped' -- '_Unwrapped' ≡ 'from' '_Wrapped' -- @ _Wrapped :: Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t) _Wrapped = withIso _Wrapped' $ \ sa _ -> withIso _Wrapped' $ \ _ bt -> iso sa bt {-# INLINE _Wrapped #-} _Unwrapped :: Rewrapping s t => Iso (Unwrapped t) (Unwrapped s) t s _Unwrapped = from _Wrapped {-# INLINE _Unwrapped #-} -- * base instance (t ~ All) => Rewrapped All t instance Wrapped All where type Unwrapped All = Bool _Wrapped' = iso getAll All {-# INLINE _Wrapped' #-} instance (t ~ Any) => Rewrapped Any t instance Wrapped Any where type Unwrapped Any = Bool _Wrapped' = iso getAny Any {-# INLINE _Wrapped' #-} instance (t ~ Sum b) => Rewrapped (Sum a) t instance Wrapped (Sum a) where type Unwrapped (Sum a) = a _Wrapped' = iso getSum Sum {-# INLINE _Wrapped' #-} instance (t ~ Product b) => Rewrapped (Product a) t instance Wrapped (Product a) where type Unwrapped (Product a) = a _Wrapped' = iso getProduct Product {-# INLINE _Wrapped' #-} instance (t ~ Kleisli m' a' b') => Rewrapped (Kleisli m a b) t instance Wrapped (Kleisli m a b) where type Unwrapped (Kleisli m a b) = a -> m b _Wrapped' = iso runKleisli Kleisli {-# INLINE _Wrapped' #-} instance (t ~ WrappedMonad m' a') => Rewrapped (WrappedMonad m a) t instance Wrapped (WrappedMonad m a) where type Unwrapped (WrappedMonad m a) = m a _Wrapped' = iso unwrapMonad WrapMonad {-# INLINE _Wrapped' #-} instance (t ~ WrappedArrow a' b' c') => Rewrapped (WrappedArrow a b c) t instance Wrapped (WrappedArrow a b c) where type Unwrapped (WrappedArrow a b c) = a b c _Wrapped' = iso unwrapArrow WrapArrow {-# INLINE _Wrapped' #-} instance (t ~ ZipList b) => Rewrapped (ZipList a) t instance Wrapped (ZipList a) where type Unwrapped (ZipList a) = [a] _Wrapped' = iso getZipList ZipList {-# INLINE _Wrapped' #-} instance (t ~ NonEmpty b) => Rewrapped (NonEmpty a) t instance Wrapped (NonEmpty a) where type Unwrapped (NonEmpty a) = (a, [a]) _Wrapped' = iso (\(a :| as) -> (a, as)) (\(a,as) -> a :| as) {-# INLINE _Wrapped' #-} instance (t ~ Const a' x') => Rewrapped (Const a x) t instance Wrapped (Const a x) where type Unwrapped (Const a x) = a _Wrapped' = iso getConst Const {-# INLINE _Wrapped' #-} instance (t ~ Dual b) => Rewrapped (Dual a) t instance Wrapped (Dual a) where type Unwrapped (Dual a) = a _Wrapped' = iso getDual Dual {-# INLINE _Wrapped' #-} instance (t ~ Endo b) => Rewrapped (Endo b) t instance Wrapped (Endo a) where type Unwrapped (Endo a) = a -> a _Wrapped' = iso appEndo Endo {-# INLINE _Wrapped' #-} instance (t ~ First b) => Rewrapped (First a) t instance Wrapped (First a) where type Unwrapped (First a) = Maybe a _Wrapped' = iso getFirst First {-# INLINE _Wrapped' #-} instance (t ~ Last b) => Rewrapped (Last a) t instance Wrapped (Last a) where type Unwrapped (Last a) = Maybe a _Wrapped' = iso getLast Last {-# INLINE _Wrapped' #-} #if MIN_VERSION_base(4,8,0) instance (t ~ Alt g b) => Rewrapped (Alt f a) t instance Wrapped (Alt f a) where type Unwrapped (Alt f a) = f a _Wrapped' = iso getAlt Alt {-# INLINE _Wrapped' #-} #endif instance t ~ ArrowMonad m' a' => Rewrapped (ArrowMonad m a) t instance Wrapped (ArrowMonad m a) where type Unwrapped (ArrowMonad m a) = m () a _Wrapped' = iso getArrowMonad ArrowMonad {-# INLINE _Wrapped' #-} instance t ~ Down a => Rewrapped (Down a) t instance Wrapped (Down a) where type Unwrapped (Down a) = a _Wrapped' = iso (\(Down a) -> a) Down -- * transformers instance (t ~ Backwards g b) => Rewrapped (Backwards f a) t instance Wrapped (Backwards f a) where type Unwrapped (Backwards f a) = f a _Wrapped' = iso forwards Backwards instance (t ~ Compose f' g' a') => Rewrapped (Compose f g a) t instance Wrapped (Compose f g a) where type Unwrapped (Compose f g a) = f (g a) _Wrapped' = iso getCompose Compose instance (t ~ Constant a' b') => Rewrapped (Constant a b) t instance Wrapped (Constant a b) where type Unwrapped (Constant a b) = a _Wrapped' = iso getConstant Constant instance (t ~ ContT r' m' a') => Rewrapped (ContT r m a) t instance Wrapped (ContT r m a) where type Unwrapped (ContT r m a) = (a -> m r) -> m r _Wrapped' = iso runContT ContT instance (t ~ ErrorT e' m' a') => Rewrapped (ErrorT e m a) t instance Wrapped (ErrorT e m a) where type Unwrapped (ErrorT e m a) = m (Either e a) _Wrapped' = iso runErrorT ErrorT {-# INLINE _Wrapped' #-} instance (t ~ Identity b) => Rewrapped (Identity a) t instance Wrapped (Identity a) where type Unwrapped (Identity a) = a _Wrapped' = iso runIdentity Identity {-# INLINE _Wrapped' #-} instance (t ~ IdentityT n b) => Rewrapped (IdentityT m a) t instance Wrapped (IdentityT m a) where type Unwrapped (IdentityT m a) = m a _Wrapped' = iso runIdentityT IdentityT {-# INLINE _Wrapped' #-} instance (t ~ ListT n b) => Rewrapped (ListT m a) t instance Wrapped (ListT m a) where type Unwrapped (ListT m a) = m [a] _Wrapped' = iso runListT ListT {-# INLINE _Wrapped' #-} instance (t ~ MaybeT n b) => Rewrapped (MaybeT m a) t instance Wrapped (MaybeT m a) where type Unwrapped (MaybeT m a) = m (Maybe a) _Wrapped' = iso runMaybeT MaybeT {-# INLINE _Wrapped' #-} instance (t ~ ReaderT r n b) => Rewrapped (ReaderT r m a) t instance Wrapped (ReaderT r m a) where type Unwrapped (ReaderT r m a) = r -> m a _Wrapped' = iso runReaderT ReaderT {-# INLINE _Wrapped' #-} instance (t ~ Reverse g b) => Rewrapped (Reverse f a) t instance Wrapped (Reverse f a) where type Unwrapped (Reverse f a) = f a _Wrapped' = iso getReverse Reverse {-# INLINE _Wrapped' #-} instance (t ~ Lazy.RWST r' w' s' m' a') => Rewrapped (Lazy.RWST r w s m a) t instance Wrapped (Lazy.RWST r w s m a) where type Unwrapped (Lazy.RWST r w s m a) = r -> s -> m (a, s, w) _Wrapped' = iso Lazy.runRWST Lazy.RWST {-# INLINE _Wrapped' #-} instance (t ~ Strict.RWST r' w' s' m' a') => Rewrapped (Strict.RWST r w s m a) t instance Wrapped (Strict.RWST r w s m a) where type Unwrapped (Strict.RWST r w s m a) = r -> s -> m (a, s, w) _Wrapped' = iso Strict.runRWST Strict.RWST {-# INLINE _Wrapped' #-} instance (t ~ Lazy.StateT s' m' a') => Rewrapped (Lazy.StateT s m a) t instance Wrapped (Lazy.StateT s m a) where type Unwrapped (Lazy.StateT s m a) = s -> m (a, s) _Wrapped' = iso Lazy.runStateT Lazy.StateT {-# INLINE _Wrapped' #-} instance (t ~ Strict.StateT s' m' a') => Rewrapped (Strict.StateT s m a) t instance Wrapped (Strict.StateT s m a) where type Unwrapped (Strict.StateT s m a) = s -> m (a, s) _Wrapped' = iso Strict.runStateT Strict.StateT {-# INLINE _Wrapped' #-} instance (t ~ Lazy.WriterT w' m' a') => Rewrapped (Lazy.WriterT w m a) t instance Wrapped (Lazy.WriterT w m a) where type Unwrapped (Lazy.WriterT w m a) = m (a, w) _Wrapped' = iso Lazy.runWriterT Lazy.WriterT {-# INLINE _Wrapped' #-} instance (t ~ Strict.WriterT w' m' a') => Rewrapped (Strict.WriterT w m a) t instance Wrapped (Strict.WriterT w m a) where type Unwrapped (Strict.WriterT w m a) = m (a, w) _Wrapped' = iso Strict.runWriterT Strict.WriterT {-# INLINE _Wrapped' #-} -- * comonad-transformers instance (t ~ TracedT m' w' a') => Rewrapped (TracedT m w a) t instance Wrapped (TracedT m w a) where type Unwrapped (TracedT m w a) = w (m -> a) _Wrapped' = iso runTracedT TracedT {-# INLINE _Wrapped' #-} -- * unordered-containers -- | Use @'wrapping' 'HashMap.fromList'@. Unwrapping returns some permutation of the list. instance (t ~ HashMap k' a', Hashable k, Eq k) => Rewrapped (HashMap k a) t instance (Hashable k, Eq k) => Wrapped (HashMap k a) where type Unwrapped (HashMap k a) = [(k, a)] _Wrapped' = iso HashMap.toList HashMap.fromList {-# INLINE _Wrapped' #-} -- | Use @'wrapping' 'HashSet.fromList'@. Unwrapping returns some permutation of the list. instance (t ~ HashSet a', Hashable a, Eq a) => Rewrapped (HashSet a) t instance (Hashable a, Eq a) => Wrapped (HashSet a) where type Unwrapped (HashSet a) = [a] _Wrapped' = iso HashSet.toList HashSet.fromList {-# INLINE _Wrapped' #-} -- * containers -- | Use @'wrapping' 'IntMap.fromList'@. unwrapping returns a /sorted/ list. instance (t ~ IntMap a') => Rewrapped (IntMap a) t instance Wrapped (IntMap a) where type Unwrapped (IntMap a) = [(Int, a)] _Wrapped' = iso IntMap.toAscList IntMap.fromList {-# INLINE _Wrapped' #-} -- | Use @'wrapping' 'IntSet.fromList'@. unwrapping returns a /sorted/ list. instance (t ~ IntSet) => Rewrapped IntSet t instance Wrapped IntSet where type Unwrapped IntSet = [Int] _Wrapped' = iso IntSet.toAscList IntSet.fromList {-# INLINE _Wrapped' #-} -- | Use @'wrapping' 'Map.fromList'@. unwrapping returns a /sorted/ list. instance (t ~ Map k' a', Ord k) => Rewrapped (Map k a) t instance Ord k => Wrapped (Map k a) where type Unwrapped (Map k a) = [(k, a)] _Wrapped' = iso Map.toAscList Map.fromList {-# INLINE _Wrapped' #-} -- | Use @'wrapping' 'Set.fromList'@. unwrapping returns a /sorted/ list. instance (t ~ Set a', Ord a) => Rewrapped (Set a) t instance Ord a => Wrapped (Set a) where type Unwrapped (Set a) = [a] _Wrapped' = iso Set.toAscList Set.fromList {-# INLINE _Wrapped' #-} instance (t ~ Seq a') => Rewrapped (Seq a) t instance Wrapped (Seq a) where type Unwrapped (Seq a) = [a] _Wrapped' = iso Foldable.toList Seq.fromList {-# INLINE _Wrapped' #-} -- * vector instance (t ~ Vector.Vector a') => Rewrapped (Vector.Vector a) t instance Wrapped (Vector.Vector a) where type Unwrapped (Vector.Vector a) = [a] _Wrapped' = iso Vector.toList Vector.fromList {-# INLINE _Wrapped' #-} instance (Prim a, t ~ Prim.Vector a') => Rewrapped (Prim.Vector a) t instance Prim a => Wrapped (Prim.Vector a) where type Unwrapped (Prim.Vector a) = [a] _Wrapped' = iso Prim.toList Prim.fromList {-# INLINE _Wrapped' #-} instance (Unbox a, t ~ Unboxed.Vector a') => Rewrapped (Unboxed.Vector a) t instance Unbox a => Wrapped (Unboxed.Vector a) where type Unwrapped (Unboxed.Vector a) = [a] _Wrapped' = iso Unboxed.toList Unboxed.fromList {-# INLINE _Wrapped' #-} instance (Storable a, t ~ Storable.Vector a') => Rewrapped (Storable.Vector a) t instance Storable a => Wrapped (Storable.Vector a) where type Unwrapped (Storable.Vector a) = [a] _Wrapped' = iso Storable.toList Storable.fromList {-# INLINE _Wrapped' #-} -- * semigroups instance (t ~ S.Min b) => Rewrapped (S.Min a) t instance Wrapped (S.Min a) where type Unwrapped (S.Min a) = a _Wrapped' = iso S.getMin S.Min {-# INLINE _Wrapped' #-} instance (t ~ S.Max b) => Rewrapped (S.Max a) t instance Wrapped (S.Max a) where type Unwrapped (S.Max a) = a _Wrapped' = iso S.getMax S.Max {-# INLINE _Wrapped' #-} instance (t ~ S.First b) => Rewrapped (S.First a) t instance Wrapped (S.First a) where type Unwrapped (S.First a) = a _Wrapped' = iso S.getFirst S.First {-# INLINE _Wrapped' #-} instance (t ~ S.Last b) => Rewrapped (S.Last a) t instance Wrapped (S.Last a) where type Unwrapped (S.Last a) = a _Wrapped' = iso S.getLast S.Last {-# INLINE _Wrapped' #-} instance (t ~ S.WrappedMonoid b) => Rewrapped (S.WrappedMonoid a) t instance Wrapped (S.WrappedMonoid a) where type Unwrapped (S.WrappedMonoid a) = a _Wrapped' = iso S.unwrapMonoid S.WrapMonoid {-# INLINE _Wrapped' #-} instance (t ~ S.Option b) => Rewrapped (S.Option a) t instance Wrapped (S.Option a) where type Unwrapped (S.Option a) = Maybe a _Wrapped' = iso S.getOption S.Option {-# INLINE _Wrapped' #-} -- * contravariant instance (t ~ Predicate b) => Rewrapped (Predicate a) t instance Wrapped (Predicate a) where type Unwrapped (Predicate a) = a -> Bool _Wrapped' = iso getPredicate Predicate {-# INLINE _Wrapped' #-} instance (t ~ Comparison b) => Rewrapped (Comparison a) t instance Wrapped (Comparison a) where type Unwrapped (Comparison a) = a -> a -> Ordering _Wrapped' = iso getComparison Comparison {-# INLINE _Wrapped' #-} instance (t ~ Equivalence b) => Rewrapped (Equivalence a) t instance Wrapped (Equivalence a) where type Unwrapped (Equivalence a) = a -> a -> Bool _Wrapped' = iso getEquivalence Equivalence {-# INLINE _Wrapped' #-} instance (t ~ Op a' b') => Rewrapped (Op a b) t instance Wrapped (Op a b) where type Unwrapped (Op a b) = b -> a _Wrapped' = iso getOp Op {-# INLINE _Wrapped' #-} instance (t ~ Contravariant.Compose f' g' a') => Rewrapped (Contravariant.Compose f g a) t instance Wrapped (Contravariant.Compose f g a) where type Unwrapped (Contravariant.Compose f g a) = f (g a) _Wrapped' = iso Contravariant.getCompose Contravariant.Compose {-# INLINE _Wrapped' #-} instance (t ~ Contravariant.ComposeFC f' g' a') => Rewrapped (Contravariant.ComposeFC f g a) t instance Wrapped (Contravariant.ComposeFC f g a) where type Unwrapped (Contravariant.ComposeFC f g a) = f (g a) _Wrapped' = iso Contravariant.getComposeFC Contravariant.ComposeFC {-# INLINE _Wrapped' #-} instance (t ~ Contravariant.ComposeCF f' g' a') => Rewrapped (Contravariant.ComposeCF f g a) t instance Wrapped (Contravariant.ComposeCF f g a) where type Unwrapped (Contravariant.ComposeCF f g a) = f (g a) _Wrapped' = iso Contravariant.getComposeCF Contravariant.ComposeCF {-# INLINE _Wrapped' #-} -- * tagged instance (t ~ Tagged s' a') => Rewrapped (Tagged s a) t instance Wrapped (Tagged s a) where type Unwrapped (Tagged s a) = a _Wrapped' = iso unTagged Tagged {-# INLINE _Wrapped' #-} -- * Control.Exception instance (t ~ AssertionFailed) => Rewrapped AssertionFailed t instance Wrapped AssertionFailed where type Unwrapped AssertionFailed = String _Wrapped' = iso failedAssertion AssertionFailed {-# INLINE _Wrapped' #-} instance (t ~ NoMethodError) => Rewrapped NoMethodError t instance Wrapped NoMethodError where type Unwrapped NoMethodError = String _Wrapped' = iso getNoMethodError NoMethodError {-# INLINE _Wrapped' #-} instance (t ~ PatternMatchFail) => Rewrapped PatternMatchFail t instance Wrapped PatternMatchFail where type Unwrapped PatternMatchFail = String _Wrapped' = iso getPatternMatchFail PatternMatchFail {-# INLINE _Wrapped' #-} instance (t ~ RecConError) => Rewrapped RecConError t instance Wrapped RecConError where type Unwrapped RecConError = String _Wrapped' = iso getRecConError RecConError {-# INLINE _Wrapped' #-} instance (t ~ RecSelError) => Rewrapped RecSelError t instance Wrapped RecSelError where type Unwrapped RecSelError = String _Wrapped' = iso getRecSelError RecSelError {-# INLINE _Wrapped' #-} instance (t ~ RecUpdError) => Rewrapped RecUpdError t instance Wrapped RecUpdError where type Unwrapped RecUpdError = String _Wrapped' = iso getRecUpdError RecUpdError {-# INLINE _Wrapped' #-} instance (t ~ ErrorCall) => Rewrapped ErrorCall t instance Wrapped ErrorCall where type Unwrapped ErrorCall = String _Wrapped' = iso getErrorCall ErrorCall {-# INLINE _Wrapped' #-} getErrorCall :: ErrorCall -> String #if __GLASGOW_HASKELL__ < 800 getErrorCall (ErrorCall x) = x #else getErrorCall (ErrorCallWithLocation x _) = x #endif {-# INLINE getErrorCall #-} getRecUpdError :: RecUpdError -> String getRecUpdError (RecUpdError x) = x {-# INLINE getRecUpdError #-} getRecSelError :: RecSelError -> String getRecSelError (RecSelError x) = x {-# INLINE getRecSelError #-} getRecConError :: RecConError -> String getRecConError (RecConError x) = x {-# INLINE getRecConError #-} getPatternMatchFail :: PatternMatchFail -> String getPatternMatchFail (PatternMatchFail x) = x {-# INLINE getPatternMatchFail #-} getNoMethodError :: NoMethodError -> String getNoMethodError (NoMethodError x) = x {-# INLINE getNoMethodError #-} failedAssertion :: AssertionFailed -> String failedAssertion (AssertionFailed x) = x {-# INLINE failedAssertion #-} getArrowMonad :: ArrowMonad m a -> m () a getArrowMonad (ArrowMonad x) = x {-# INLINE getArrowMonad #-} -- | Given the constructor for a 'Wrapped' type, return a -- deconstructor that is its inverse. -- -- Assuming the 'Wrapped' instance is legal, these laws hold: -- -- @ -- 'op' f '.' f ≡ 'id' -- f '.' 'op' f ≡ 'id' -- @ -- -- -- >>> op Identity (Identity 4) -- 4 -- -- >>> op Const (Const "hello") -- "hello" op :: Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s op _ = view _Wrapped' {-# INLINE op #-} -- | This is a convenient version of '_Wrapped' with an argument that's ignored. -- -- The user supplied function is /ignored/, merely its type is used. _Wrapping' :: Wrapped s => (Unwrapped s -> s) -> Iso' s (Unwrapped s) _Wrapping' _ = _Wrapped' {-# INLINE _Wrapping' #-} -- | This is a convenient version of '_Wrapped' with an argument that's ignored. -- -- The user supplied function is /ignored/, merely its type is used. _Unwrapping' :: Wrapped s => (Unwrapped s -> s) -> Iso' (Unwrapped s) s _Unwrapping' _ = from _Wrapped' {-# INLINE _Unwrapping' #-} -- | This is a convenient version of '_Wrapped' with an argument that's ignored. -- -- The user supplied function is /ignored/, merely its types are used. _Wrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso s t (Unwrapped s) (Unwrapped t) _Wrapping _ = _Wrapped {-# INLINE _Wrapping #-} -- | This is a convenient version of '_Unwrapped' with an argument that's ignored. -- -- The user supplied function is /ignored/, merely its types are used. _Unwrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso (Unwrapped t) (Unwrapped s) t s _Unwrapping _ = from _Wrapped {-# INLINE _Unwrapping #-} -- | This combinator is based on @ala@ from Conor McBride's work on Epigram. -- -- As with '_Wrapping', the user supplied function for the newtype is /ignored/. -- -- >>> ala Sum foldMap [1,2,3,4] -- 10 -- -- >>> ala All foldMap [True,True] -- True -- -- >>> ala All foldMap [True,False] -- False -- -- >>> ala Any foldMap [False,False] -- False -- -- >>> ala Any foldMap [True,False] -- True -- -- >>> ala Sum foldMap [1,2,3,4] -- 10 -- -- >>> ala Product foldMap [1,2,3,4] -- 24 -- -- -- You may want to think of this combinator as having the following, simpler, type. -- -- @ -- ala :: Rewrapping s t => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> e -> s) -> e -> Unwrapped s -- @ ala :: (Functor f, Rewrapping s t) => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s) ala = au . _Wrapping {-# INLINE ala #-} -- | This combinator is based on @ala'@ from Conor McBride's work on Epigram. -- -- As with '_Wrapping', the user supplied function for the newtype is /ignored/. -- -- @ -- alaf :: Rewrapping s t => (Unwrapped s -> s) -> ((r -> t) -> e -> s) -> (r -> Unwrapped t) -> e -> Unwrapped s -- @ -- -- >>> alaf Sum foldMap Prelude.length ["hello","world"] -- 10 alaf :: (Functor f, Functor g, Rewrapping s t) => (Unwrapped s -> s) -> (f t -> g s) -> f (Unwrapped t) -> g (Unwrapped s) alaf = auf . _Unwrapping {-# INLINE alaf #-} lens-4.14/src/Control/Lens/Zoom.hs0000644000000000000000000002600412710476104015165 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} #ifndef MIN_VERSION_mtl #define MIN_VERSION_mtl(x,y,z) 1 #endif #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Zoom -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Rank2Types -- ------------------------------------------------------------------------------- module Control.Lens.Zoom ( Magnified , Magnify(..) , Zoom(..) , Zoomed ) where import Control.Lens.Getter import Control.Lens.Internal.Zoom import Control.Lens.Type import Control.Monad import Control.Monad.Reader as Reader import Control.Monad.State as State import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict import Control.Monad.Trans.RWS.Lazy as Lazy import Control.Monad.Trans.RWS.Strict as Strict import Control.Monad.Trans.Error import Control.Monad.Trans.Except import Control.Monad.Trans.List import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Control.Monad.Trans.Free import Data.Monoid import Data.Profunctor.Unsafe import Prelude #ifdef HLINT {-# ANN module "HLint: ignore Use fmap" #-} #endif -- $setup -- >>> import Control.Lens -- >>> import Control.Monad.State -- >>> import Data.Map as Map -- >>> import Debug.SimpleReflect.Expr as Expr -- >>> import Debug.SimpleReflect.Vars as Vars -- >>> let f :: Expr -> Expr; f = Vars.f -- >>> let g :: Expr -> Expr; g = Vars.g -- >>> let h :: Expr -> Expr -> Expr; h = Vars.h -- Chosen so that they have lower fixity than ('%='), and to match ('<~'). infixr 2 `zoom`, `magnify` ------------------------------------------------------------------------------ -- Zoomed ------------------------------------------------------------------------------ -- | This type family is used by 'Control.Lens.Zoom.Zoom' to describe the common effect type. type family Zoomed (m :: * -> *) :: * -> * -> * type instance Zoomed (Strict.StateT s z) = Focusing z type instance Zoomed (Lazy.StateT s z) = Focusing z type instance Zoomed (ReaderT e m) = Zoomed m type instance Zoomed (IdentityT m) = Zoomed m type instance Zoomed (Strict.RWST r w s z) = FocusingWith w z type instance Zoomed (Lazy.RWST r w s z) = FocusingWith w z type instance Zoomed (Strict.WriterT w m) = FocusingPlus w (Zoomed m) type instance Zoomed (Lazy.WriterT w m) = FocusingPlus w (Zoomed m) type instance Zoomed (ListT m) = FocusingOn [] (Zoomed m) type instance Zoomed (MaybeT m) = FocusingMay (Zoomed m) type instance Zoomed (ErrorT e m) = FocusingErr e (Zoomed m) type instance Zoomed (ExceptT e m) = FocusingErr e (Zoomed m) type instance Zoomed (FreeT f m) = FocusingFree f m (Zoomed m) ------------------------------------------------------------------------------ -- Magnified ------------------------------------------------------------------------------ -- | This type family is used by 'Control.Lens.Zoom.Magnify' to describe the common effect type. type family Magnified (m :: * -> *) :: * -> * -> * type instance Magnified (ReaderT b m) = Effect m type instance Magnified ((->)b) = Const type instance Magnified (Strict.RWST a w s m) = EffectRWS w s m type instance Magnified (Lazy.RWST a w s m) = EffectRWS w s m type instance Magnified (IdentityT m) = Magnified m ------------------------------------------------------------------------------ -- Zoom ------------------------------------------------------------------------------ -- | This class allows us to use 'zoom' in, changing the 'State' supplied by -- many different 'Control.Monad.Monad' transformers, potentially quite -- deep in a 'Monad' transformer stack. class (MonadState s m, MonadState t n) => Zoom m n s t | m -> s, n -> t, m t -> n, n s -> m where -- | Run a monadic action in a larger 'State' than it was defined in, -- using a 'Lens'' or 'Control.Lens.Traversal.Traversal''. -- -- This is commonly used to lift actions in a simpler 'State' -- 'Monad' into a 'State' 'Monad' with a larger 'State' type. -- -- When applied to a 'Control.Lens.Traversal.Traversal'' over -- multiple values, the actions for each target are executed sequentially -- and the results are aggregated. -- -- This can be used to edit pretty much any 'Monad' transformer stack with a 'State' in it! -- -- >>> flip State.evalState (a,b) $ zoom _1 $ use id -- a -- -- >>> flip State.execState (a,b) $ zoom _1 $ id .= c -- (c,b) -- -- >>> flip State.execState [(a,b),(c,d)] $ zoom traverse $ _2 %= f -- [(a,f b),(c,f d)] -- -- >>> flip State.runState [(a,b),(c,d)] $ zoom traverse $ _2 <%= f -- (f b <> f d <> mempty,[(a,f b),(c,f d)]) -- -- >>> flip State.evalState (a,b) $ zoom both (use id) -- a <> b -- -- @ -- 'zoom' :: 'Monad' m => 'Lens'' s t -> 'StateT' t m a -> 'StateT' s m a -- 'zoom' :: ('Monad' m, 'Monoid' c) => 'Control.Lens.Traversal.Traversal'' s t -> 'StateT' t m c -> 'StateT' s m c -- 'zoom' :: ('Monad' m, 'Monoid' w) => 'Lens'' s t -> 'RWST' r w t m c -> 'RWST' r w s m c -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Monoid' c) => 'Control.Lens.Traversal.Traversal'' s t -> 'RWST' r w t m c -> 'RWST' r w s m c -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Error' e) => 'Lens'' s t -> 'ErrorT' e ('RWST' r w t m) c -> 'ErrorT' e ('RWST' r w s m) c -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Monoid' c, 'Error' e) => 'Control.Lens.Traversal.Traversal'' s t -> 'ErrorT' e ('RWST' r w t m) c -> 'ErrorT' e ('RWST' r w s m) c -- ... -- @ zoom :: LensLike' (Zoomed m c) t s -> m c -> n c instance Monad z => Zoom (Strict.StateT s z) (Strict.StateT t z) s t where zoom l (Strict.StateT m) = Strict.StateT $ unfocusing #. l (Focusing #. m) {-# INLINE zoom #-} instance Monad z => Zoom (Lazy.StateT s z) (Lazy.StateT t z) s t where zoom l (Lazy.StateT m) = Lazy.StateT $ unfocusing #. l (Focusing #. m) {-# INLINE zoom #-} instance Zoom m n s t => Zoom (ReaderT e m) (ReaderT e n) s t where zoom l (ReaderT m) = ReaderT (zoom l . m) {-# INLINE zoom #-} instance Zoom m n s t => Zoom (IdentityT m) (IdentityT n) s t where zoom l (IdentityT m) = IdentityT (zoom l m) {-# INLINE zoom #-} instance (Monoid w, Monad z) => Zoom (Strict.RWST r w s z) (Strict.RWST r w t z) s t where zoom l (Strict.RWST m) = Strict.RWST $ \r -> unfocusingWith #. l (FocusingWith #. m r) {-# INLINE zoom #-} instance (Monoid w, Monad z) => Zoom (Lazy.RWST r w s z) (Lazy.RWST r w t z) s t where zoom l (Lazy.RWST m) = Lazy.RWST $ \r -> unfocusingWith #. l (FocusingWith #. m r) {-# INLINE zoom #-} instance (Monoid w, Zoom m n s t) => Zoom (Strict.WriterT w m) (Strict.WriterT w n) s t where zoom l = Strict.WriterT . zoom (\afb -> unfocusingPlus #. l (FocusingPlus #. afb)) . Strict.runWriterT {-# INLINE zoom #-} instance (Monoid w, Zoom m n s t) => Zoom (Lazy.WriterT w m) (Lazy.WriterT w n) s t where zoom l = Lazy.WriterT . zoom (\afb -> unfocusingPlus #. l (FocusingPlus #. afb)) . Lazy.runWriterT {-# INLINE zoom #-} instance Zoom m n s t => Zoom (ListT m) (ListT n) s t where zoom l = ListT . zoom (\afb -> unfocusingOn . l (FocusingOn . afb)) . runListT {-# INLINE zoom #-} instance Zoom m n s t => Zoom (MaybeT m) (MaybeT n) s t where zoom l = MaybeT . liftM getMay . zoom (\afb -> unfocusingMay #. l (FocusingMay #. afb)) . liftM May . runMaybeT {-# INLINE zoom #-} instance (Error e, Zoom m n s t) => Zoom (ErrorT e m) (ErrorT e n) s t where zoom l = ErrorT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runErrorT {-# INLINE zoom #-} instance Zoom m n s t => Zoom (ExceptT e m) (ExceptT e n) s t where zoom l = ExceptT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runExceptT {-# INLINE zoom #-} instance (Functor f, Zoom m n s t) => Zoom (FreeT f m) (FreeT f n) s t where zoom l = FreeT . liftM (fmap $ zoom l) . liftM getFreed . zoom (\afb -> unfocusingFree #. l (FocusingFree #. afb)) . liftM Freed . runFreeT ------------------------------------------------------------------------------ -- Magnify ------------------------------------------------------------------------------ -- TODO: instance Zoom m m a a => Zoom (ContT r m) (ContT r m) a a where -- | This class allows us to use 'magnify' part of the environment, changing the environment supplied by -- many different 'Monad' transformers. Unlike 'zoom' this can change the environment of a deeply nested 'Monad' transformer. -- -- Also, unlike 'zoom', this can be used with any valid 'Getter', but cannot be used with a 'Traversal' or 'Fold'. class (Magnified m ~ Magnified n, MonadReader b m, MonadReader a n) => Magnify m n b a | m -> b, n -> a, m a -> n, n b -> m where -- | Run a monadic action in a larger environment than it was defined in, using a 'Getter'. -- -- This acts like 'Control.Monad.Reader.Class.local', but can in many cases change the type of the environment as well. -- -- This is commonly used to lift actions in a simpler 'Reader' 'Monad' into a 'Monad' with a larger environment type. -- -- This can be used to edit pretty much any 'Monad' transformer stack with an environment in it: -- -- >>> (1,2) & magnify _2 (+1) -- 3 -- -- >>> flip Reader.runReader (1,2) $ magnify _1 Reader.ask -- 1 -- -- >>> flip Reader.runReader (1,2,[10..20]) $ magnify (_3._tail) Reader.ask -- [11,12,13,14,15,16,17,18,19,20] -- -- @ -- 'magnify' :: 'Getter' s a -> (a -> r) -> s -> r -- 'magnify' :: 'Monoid' r => 'Fold' s a -> (a -> r) -> s -> r -- @ -- -- @ -- 'magnify' :: 'Monoid' w => 'Getter' s t -> 'RWS' t w st c -> 'RWS' s w st c -- 'magnify' :: ('Monoid' w, 'Monoid' c) => 'Fold' s a -> 'RWS' a w st c -> 'RWS' s w st c -- ... -- @ magnify :: LensLike' (Magnified m c) a b -> m c -> n c instance Monad m => Magnify (ReaderT b m) (ReaderT a m) b a where magnify l (ReaderT m) = ReaderT $ getEffect #. l (Effect #. m) {-# INLINE magnify #-} -- | @ -- 'magnify' = 'views' -- @ instance Magnify ((->) b) ((->) a) b a where magnify = views {-# INLINE magnify #-} instance (Monad m, Monoid w) => Magnify (Strict.RWST b w s m) (Strict.RWST a w s m) b a where magnify l (Strict.RWST m) = Strict.RWST $ getEffectRWS #. l (EffectRWS #. m) {-# INLINE magnify #-} instance (Monad m, Monoid w) => Magnify (Lazy.RWST b w s m) (Lazy.RWST a w s m) b a where magnify l (Lazy.RWST m) = Lazy.RWST $ getEffectRWS #. l (EffectRWS #. m) {-# INLINE magnify #-} instance Magnify m n b a => Magnify (IdentityT m) (IdentityT n) b a where magnify l (IdentityT m) = IdentityT (magnify l m) {-# INLINE magnify #-} lens-4.14/src/Control/Lens/Internal/0000755000000000000000000000000012710476104015457 5ustar0000000000000000lens-4.14/src/Control/Lens/Internal/Bazaar.hs0000644000000000000000000002717212710476104017224 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE RoleAnnotations #-} #endif #if __GLASGOW_HASKELL__ >= 711 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Bazaar -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Bazaar ( Bizarre(..) , Bazaar(..), Bazaar' , BazaarT(..), BazaarT' , Bizarre1(..) , Bazaar1(..), Bazaar1' , BazaarT1(..), BazaarT1' ) where import Control.Applicative import Control.Arrow as Arrow import Control.Category import Control.Comonad import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed import Data.Functor.Apply import Data.Functor.Compose import Data.Functor.Contravariant import Data.Functor.Identity import Data.Semigroup import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Profunctor.Unsafe import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- Bizarre ------------------------------------------------------------------------------ -- | This class is used to run the various 'Bazaar' variants used in this -- library. class Profunctor p => Bizarre p w | w -> p where bazaar :: Applicative f => p a (f b) -> w a b t -> f t ------------------------------------------------------------------------------ -- Bazaar ------------------------------------------------------------------------------ -- | This is used to characterize a 'Control.Lens.Traversal.Traversal'. -- -- a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed 'FunList'. -- -- -- -- A 'Bazaar' is like a 'Control.Lens.Traversal.Traversal' that has already been applied to some structure. -- -- Where a @'Context' a b t@ holds an @a@ and a function from @b@ to -- @t@, a @'Bazaar' a b t@ holds @N@ @a@s and a function from @N@ -- @b@s to @t@, (where @N@ might be infinite). -- -- Mnemonically, a 'Bazaar' holds many stores and you can easily add more. -- -- This is a final encoding of 'Bazaar'. newtype Bazaar p a b t = Bazaar { runBazaar :: forall f. Applicative f => p a (f b) -> f t } -- type role Bazaar representatonal nominal nominal nominal -- | This alias is helpful when it comes to reducing repetition in type signatures. -- -- @ -- type 'Bazaar'' p a t = 'Bazaar' p a a t -- @ type Bazaar' p a = Bazaar p a a instance IndexedFunctor (Bazaar p) where ifmap f (Bazaar k) = Bazaar (fmap f . k) {-# INLINE ifmap #-} instance Conjoined p => IndexedComonad (Bazaar p) where iextract (Bazaar m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} iduplicate (Bazaar m) = getCompose $ m (Compose #. distrib sell . sell) {-# INLINE iduplicate #-} instance Corepresentable p => Sellable p (Bazaar p) where sell = cotabulate $ \ w -> Bazaar $ tabulate $ \k -> pure (cosieve k w) {-# INLINE sell #-} instance Profunctor p => Bizarre p (Bazaar p) where bazaar g (Bazaar f) = f g {-# INLINE bazaar #-} instance Functor (Bazaar p a b) where fmap = ifmap {-# INLINE fmap #-} instance Apply (Bazaar p a b) where Bazaar mf <.> Bazaar ma = Bazaar $ \ pafb -> mf pafb <*> ma pafb {-# INLINE (<.>) #-} instance Applicative (Bazaar p a b) where pure a = Bazaar $ \_ -> pure a {-# INLINE pure #-} Bazaar mf <*> Bazaar ma = Bazaar $ \ pafb -> mf pafb <*> ma pafb {-# INLINE (<*>) #-} instance (a ~ b, Conjoined p) => Comonad (Bazaar p a b) where extract = iextract {-# INLINE extract #-} duplicate = iduplicate {-# INLINE duplicate #-} instance (a ~ b, Conjoined p) => ComonadApply (Bazaar p a b) where (<@>) = (<*>) {-# INLINE (<@>) #-} ------------------------------------------------------------------------------ -- BazaarT ------------------------------------------------------------------------------ -- | 'BazaarT' is like 'Bazaar', except that it provides a questionable 'Contravariant' instance -- To protect this instance it relies on the soundness of another 'Contravariant' type, and usage conventions. -- -- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there -- must be a better way! newtype BazaarT p (g :: * -> *) a b t = BazaarT { runBazaarT :: forall f. Applicative f => p a (f b) -> f t } #if __GLASGOW_HASKELL__ >= 707 type role BazaarT representational nominal nominal nominal nominal #endif -- | This alias is helpful when it comes to reducing repetition in type signatures. -- -- @ -- type 'BazaarT'' p g a t = 'BazaarT' p g a a t -- @ type BazaarT' p g a = BazaarT p g a a instance IndexedFunctor (BazaarT p g) where ifmap f (BazaarT k) = BazaarT (fmap f . k) {-# INLINE ifmap #-} instance Conjoined p => IndexedComonad (BazaarT p g) where iextract (BazaarT m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} iduplicate (BazaarT m) = getCompose $ m (Compose #. distrib sell . sell) {-# INLINE iduplicate #-} instance Corepresentable p => Sellable p (BazaarT p g) where sell = cotabulate $ \ w -> BazaarT (`cosieve` w) {-# INLINE sell #-} instance Profunctor p => Bizarre p (BazaarT p g) where bazaar g (BazaarT f) = f g {-# INLINE bazaar #-} instance Functor (BazaarT p g a b) where fmap = ifmap {-# INLINE fmap #-} instance Apply (BazaarT p g a b) where BazaarT mf <.> BazaarT ma = BazaarT $ \ pafb -> mf pafb <*> ma pafb {-# INLINE (<.>) #-} instance Applicative (BazaarT p g a b) where pure a = BazaarT $ tabulate $ \_ -> pure (pure a) {-# INLINE pure #-} BazaarT mf <*> BazaarT ma = BazaarT $ \ pafb -> mf pafb <*> ma pafb {-# INLINE (<*>) #-} instance (a ~ b, Conjoined p) => Comonad (BazaarT p g a b) where extract = iextract {-# INLINE extract #-} duplicate = iduplicate {-# INLINE duplicate #-} instance (a ~ b, Conjoined p) => ComonadApply (BazaarT p g a b) where (<@>) = (<*>) {-# INLINE (<@>) #-} instance (Profunctor p, Contravariant g) => Contravariant (BazaarT p g a b) where contramap _ = (<$) (error "contramap: BazaarT") {-# INLINE contramap #-} instance Contravariant g => Semigroup (BazaarT p g a b t) where BazaarT a <> BazaarT b = BazaarT $ \f -> a f <* b f {-# INLINE (<>) #-} instance Contravariant g => Monoid (BazaarT p g a b t) where mempty = BazaarT $ \_ -> pure (error "mempty: BazaarT") {-# INLINE mempty #-} BazaarT a `mappend` BazaarT b = BazaarT $ \f -> a f <* b f {-# INLINE mappend #-} ------------------------------------------------------------------------------ -- Bizarre1 ------------------------------------------------------------------------------ class Profunctor p => Bizarre1 p w | w -> p where bazaar1 :: Apply f => p a (f b) -> w a b t -> f t ------------------------------------------------------------------------------ -- Bazaar1 ------------------------------------------------------------------------------ -- | This is used to characterize a 'Control.Lens.Traversal.Traversal'. -- -- a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed 'FunList'. -- -- -- -- A 'Bazaar1' is like a 'Control.Lens.Traversal.Traversal' that has already been applied to some structure. -- -- Where a @'Context' a b t@ holds an @a@ and a function from @b@ to -- @t@, a @'Bazaar1' a b t@ holds @N@ @a@s and a function from @N@ -- @b@s to @t@, (where @N@ might be infinite). -- -- Mnemonically, a 'Bazaar1' holds many stores and you can easily add more. -- -- This is a final encoding of 'Bazaar1'. newtype Bazaar1 p a b t = Bazaar1 { runBazaar1 :: forall f. Apply f => p a (f b) -> f t } -- type role Bazaar1 representatonal nominal nominal nominal -- | This alias is helpful when it comes to reducing repetition in type signatures. -- -- @ -- type 'Bazaar1'' p a t = 'Bazaar1' p a a t -- @ type Bazaar1' p a = Bazaar1 p a a instance IndexedFunctor (Bazaar1 p) where ifmap f (Bazaar1 k) = Bazaar1 (fmap f . k) {-# INLINE ifmap #-} instance Conjoined p => IndexedComonad (Bazaar1 p) where iextract (Bazaar1 m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} iduplicate (Bazaar1 m) = getCompose $ m (Compose #. distrib sell . sell) {-# INLINE iduplicate #-} instance Corepresentable p => Sellable p (Bazaar1 p) where sell = cotabulate $ \ w -> Bazaar1 $ tabulate $ \k -> pure (cosieve k w) {-# INLINE sell #-} instance Profunctor p => Bizarre1 p (Bazaar1 p) where bazaar1 g (Bazaar1 f) = f g {-# INLINE bazaar1 #-} instance Functor (Bazaar1 p a b) where fmap = ifmap {-# INLINE fmap #-} instance Apply (Bazaar1 p a b) where Bazaar1 mf <.> Bazaar1 ma = Bazaar1 $ \ pafb -> mf pafb <.> ma pafb {-# INLINE (<.>) #-} instance (a ~ b, Conjoined p) => Comonad (Bazaar1 p a b) where extract = iextract {-# INLINE extract #-} duplicate = iduplicate {-# INLINE duplicate #-} instance (a ~ b, Conjoined p) => ComonadApply (Bazaar1 p a b) where Bazaar1 mf <@> Bazaar1 ma = Bazaar1 $ \ pafb -> mf pafb <.> ma pafb {-# INLINE (<@>) #-} ------------------------------------------------------------------------------ -- BazaarT1 ------------------------------------------------------------------------------ -- | 'BazaarT1' is like 'Bazaar1', except that it provides a questionable 'Contravariant' instance -- To protect this instance it relies on the soundness of another 'Contravariant' type, and usage conventions. -- -- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there -- must be a better way! newtype BazaarT1 p (g :: * -> *) a b t = BazaarT1 { runBazaarT1 :: forall f. Apply f => p a (f b) -> f t } #if __GLASGOW_HASKELL__ >= 707 type role BazaarT1 representational nominal nominal nominal nominal #endif -- | This alias is helpful when it comes to reducing repetition in type signatures. -- -- @ -- type 'BazaarT1'' p g a t = 'BazaarT1' p g a a t -- @ type BazaarT1' p g a = BazaarT1 p g a a instance IndexedFunctor (BazaarT1 p g) where ifmap f (BazaarT1 k) = BazaarT1 (fmap f . k) {-# INLINE ifmap #-} instance Conjoined p => IndexedComonad (BazaarT1 p g) where iextract (BazaarT1 m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} iduplicate (BazaarT1 m) = getCompose $ m (Compose #. distrib sell . sell) {-# INLINE iduplicate #-} instance Corepresentable p => Sellable p (BazaarT1 p g) where sell = cotabulate $ \ w -> BazaarT1 (`cosieve` w) {-# INLINE sell #-} instance Profunctor p => Bizarre1 p (BazaarT1 p g) where bazaar1 g (BazaarT1 f) = f g {-# INLINE bazaar1 #-} instance Functor (BazaarT1 p g a b) where fmap = ifmap {-# INLINE fmap #-} instance Apply (BazaarT1 p g a b) where BazaarT1 mf <.> BazaarT1 ma = BazaarT1 $ \ pafb -> mf pafb <.> ma pafb {-# INLINE (<.>) #-} instance (a ~ b, Conjoined p) => Comonad (BazaarT1 p g a b) where extract = iextract {-# INLINE extract #-} duplicate = iduplicate {-# INLINE duplicate #-} instance (a ~ b, Conjoined p) => ComonadApply (BazaarT1 p g a b) where BazaarT1 mf <@> BazaarT1 ma = BazaarT1 $ \ pafb -> mf pafb <.> ma pafb {-# INLINE (<@>) #-} instance (Profunctor p, Contravariant g) => Contravariant (BazaarT1 p g a b) where contramap _ = (<$) (error "contramap: BazaarT1") {-# INLINE contramap #-} instance Contravariant g => Semigroup (BazaarT1 p g a b t) where BazaarT1 a <> BazaarT1 b = BazaarT1 $ \f -> a f <. b f {-# INLINE (<>) #-} lens-4.14/src/Control/Lens/Internal/ByteString.hs0000644000000000000000000002534212710476104020113 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE FlexibleContexts #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #ifndef MIN_VERSION_bytestring #define MIN_VERSION_bytestring(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Strict.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module spends a lot of time fiddling around with 'Data.ByteString' internals -- to work around on older -- Haskell Platforms and to improve constant and asymptotic factors in our performance. ---------------------------------------------------------------------------- module Control.Lens.Internal.ByteString ( unpackStrict, traversedStrictTree , unpackStrict8, traversedStrictTree8 , unpackLazy, traversedLazy , unpackLazy8, traversedLazy8 ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.Lens.Type import Control.Lens.Getter import Control.Lens.Fold import Control.Lens.Indexed import Control.Lens.Setter import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.ByteString.Internal as BI import qualified Data.ByteString.Unsafe as BU import Data.Bits import Data.Char import Data.Int (Int64) import Data.Word (Word8) import Data.Monoid import Foreign.Ptr import Foreign.Storable #if MIN_VERSION_base(4,8,0) import Foreign.ForeignPtr #elif MIN_VERSION_base(4,4,0) import Foreign.ForeignPtr.Safe #if !MIN_VERSION_bytestring(0,10,4) import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) #endif #else import Foreign.ForeignPtr #endif import GHC.Base (unsafeChr) import GHC.ForeignPtr (mallocPlainForeignPtrBytes) import GHC.IO (unsafeDupablePerformIO) grain :: Int grain = 32 {-# INLINE grain #-} -- | Traverse a strict 'B.ByteString' in a relatively balanced fashion, as a balanced tree with biased runs of -- elements at the leaves. traversedStrictTree :: IndexedTraversal' Int B.ByteString Word8 traversedStrictTree pafb bs = unsafeCreate len <$> go 0 len where len = B.length bs go !i !j | i + grain < j, k <- i + shiftR (j - i) 1 = (\l r q -> l q >> r q) <$> go i k <*> go k j | otherwise = run i j run !i !j | i == j = pure (\_ -> return ()) | otherwise = let !x = BU.unsafeIndex bs i in (\y ys q -> pokeByteOff q i y >> ys q) <$> indexed pafb (i :: Int) x <*> run (i + 1) j {-# INLINE [0] traversedStrictTree #-} {-# RULES "bytes -> map" traversedStrictTree = sets B.map :: ASetter' B.ByteString Word8; "bytes -> imap" traversedStrictTree = isets imapB :: AnIndexedSetter' Int B.ByteString Word8; "bytes -> foldr" traversedStrictTree = foldring B.foldr :: Getting (Endo r) B.ByteString Word8; "bytes -> ifoldr" traversedStrictTree = ifoldring ifoldrB :: IndexedGetting Int (Endo r) B.ByteString Word8; #-} imapB :: (Int -> Word8 -> Word8) -> B.ByteString -> B.ByteString imapB f = snd . B.mapAccumL (\i a -> i `seq` (i + 1, f i a)) 0 {-# INLINE imapB #-} ifoldrB :: (Int -> Word8 -> a -> a) -> a -> B.ByteString -> a ifoldrB f z xs = B.foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 {-# INLINE ifoldrB #-} -- | Traverse a strict 'B.ByteString' in a relatively balanced fashion, as a balanced tree with biased runs of -- elements at the leaves, pretending the bytes are chars. traversedStrictTree8 :: IndexedTraversal' Int B.ByteString Char traversedStrictTree8 pafb bs = unsafeCreate len <$> go 0 len where len = B.length bs go !i !j | i + grain < j = let k = i + shiftR (j - i) 1 in (\l r q -> l q >> r q) <$> go i k <*> go k j | otherwise = run i j run !i !j | i == j = pure (\_ -> return ()) | otherwise = let !x = BU.unsafeIndex bs i in (\y ys q -> pokeByteOff q i (c2w y) >> ys q) <$> indexed pafb (i :: Int) (w2c x) <*> run (i + 1) j {-# INLINE [0] traversedStrictTree8 #-} {-# RULES "chars -> map" traversedStrictTree8 = sets B8.map :: ASetter' B.ByteString Char; "chars -> imap" traversedStrictTree8 = isets imapB8 :: AnIndexedSetter' Int B.ByteString Char; "chars -> foldr" traversedStrictTree8 = foldring B8.foldr :: Getting (Endo r) B.ByteString Char; "chars -> ifoldr" traversedStrictTree8 = ifoldring ifoldrB8 :: IndexedGetting Int (Endo r) B.ByteString Char; #-} imapB8 :: (Int -> Char -> Char) -> B.ByteString -> B.ByteString imapB8 f = snd . B8.mapAccumL (\i a -> i `seq` (i + 1, f i a)) 0 {-# INLINE imapB8 #-} ifoldrB8 :: (Int -> Char -> a -> a) -> a -> B.ByteString -> a ifoldrB8 f z xs = B8.foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 {-# INLINE ifoldrB8 #-} -- | Unpack a lazy 'Bytestring' unpackLazy :: BL.ByteString -> [Word8] unpackLazy = BL.unpack {-# INLINE unpackLazy #-} -- | An 'IndexedTraversal' of the individual bytes in a lazy 'BL.ByteString' traversedLazy :: IndexedTraversal' Int64 BL.ByteString Word8 traversedLazy pafb = \lbs -> foldrChunks go (\_ -> pure BL.empty) lbs 0 where go c fcs acc = BL.append . fromStrict <$> reindexed (\x -> acc + fromIntegral x :: Int64) traversedStrictTree pafb c <*> fcs acc' where acc' :: Int64 !acc' = acc + fromIntegral (B.length c) {-# INLINE [1] traversedLazy #-} {-# RULES "sets lazy bytestring" traversedLazy = sets BL.map :: ASetter' BL.ByteString Word8; "isets lazy bytestring" traversedLazy = isets imapBL :: AnIndexedSetter' Int BL.ByteString Word8; "gets lazy bytestring" traversedLazy = foldring BL.foldr :: Getting (Endo r) BL.ByteString Word8; "igets lazy bytestring" traversedLazy = ifoldring ifoldrBL :: IndexedGetting Int (Endo r) BL.ByteString Word8; #-} imapBL :: (Int -> Word8 -> Word8) -> BL.ByteString -> BL.ByteString imapBL f = snd . BL.mapAccumL (\i a -> i `seq` (i + 1, f i a)) 0 {-# INLINE imapBL #-} ifoldrBL :: (Int -> Word8 -> a -> a) -> a -> BL.ByteString -> a ifoldrBL f z xs = BL.foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 {-# INLINE ifoldrBL #-} -- | Unpack a lazy 'BL.ByteString' pretending the bytes are chars. unpackLazy8 :: BL.ByteString -> String unpackLazy8 = BL8.unpack {-# INLINE unpackLazy8 #-} -- | An 'IndexedTraversal' of the individual bytes in a lazy 'BL.ByteString' pretending the bytes are chars. traversedLazy8 :: IndexedTraversal' Int64 BL.ByteString Char traversedLazy8 pafb = \lbs -> foldrChunks go (\_ -> pure BL.empty) lbs 0 where go c fcs acc = BL.append . fromStrict <$> reindexed (\x -> acc + fromIntegral x :: Int64) traversedStrictTree8 pafb c <*> fcs acc' where acc' :: Int64 !acc' = acc + fromIntegral (B.length c) {-# INLINE [1] traversedLazy8 #-} {-# RULES "sets lazy bytestring" traversedLazy8 = sets BL8.map :: ASetter' BL8.ByteString Char; "isets lazy bytestring" traversedLazy8 = isets imapBL8 :: AnIndexedSetter' Int BL8.ByteString Char; "gets lazy bytestring" traversedLazy8 = foldring BL8.foldr :: Getting (Endo r) BL8.ByteString Char; "igets lazy bytestring" traversedLazy8 = ifoldring ifoldrBL8 :: IndexedGetting Int (Endo r) BL8.ByteString Char; #-} imapBL8 :: (Int -> Char -> Char) -> BL8.ByteString -> BL8.ByteString imapBL8 f = snd . BL8.mapAccumL (\i a -> i `seq` (i + 1, f i a)) 0 {-# INLINE imapBL8 #-} ifoldrBL8 :: (Int -> Char -> a -> a) -> a -> BL8.ByteString -> a ifoldrBL8 f z xs = BL8.foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 {-# INLINE ifoldrBL8 #-} ------------------------------------------------------------------------------ -- ByteString guts ------------------------------------------------------------------------------ fromStrict :: B.ByteString -> BL.ByteString #if MIN_VERSION_bytestring(0,10,0) fromStrict = BL.fromStrict #else fromStrict = \x -> BL.fromChunks [x] #endif {-# INLINE fromStrict #-} foldrChunks :: (B.ByteString -> r -> r) -> r -> BL.ByteString -> r #if MIN_VERSION_bytestring(0,10,0) foldrChunks = BL.foldrChunks #else foldrChunks f z b = foldr f z (BL.toChunks b) #endif {-# INLINE foldrChunks #-} -- | Conversion between 'Word8' and 'Char'. Should compile to a no-op. w2c :: Word8 -> Char w2c = unsafeChr . fromIntegral {-# INLINE w2c #-} -- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and -- silently truncates to 8 bits Chars > '\255'. It is provided as -- convenience for ByteString construction. c2w :: Char -> Word8 c2w = fromIntegral . ord {-# INLINE c2w #-} -- | Unpack a strict 'B.Bytestring' unpackStrict :: B.ByteString -> [Word8] #if MIN_VERSION_bytestring(0,10,4) unpackStrict = B.unpack #else unpackStrict (BI.PS fp off len) = let p = unsafeForeignPtrToPtr fp in go (p `plusPtr` off) (p `plusPtr` (off+len)) where go !p !q | p == q = [] | otherwise = let !x = BI.inlinePerformIO $ do x' <- peek p touchForeignPtr fp return x' in x : go (p `plusPtr` 1) q #endif {-# INLINE unpackStrict #-} -- | Unpack a strict 'B.Bytestring', pretending the bytes are chars. unpackStrict8 :: B.ByteString -> String #if MIN_VERSION_bytestring(0,10,4) unpackStrict8 = B8.unpack #else unpackStrict8 (BI.PS fp off len) = let p = unsafeForeignPtrToPtr fp in go (p `plusPtr` off) (p `plusPtr` (off+len)) where go !p !q | p == q = [] | otherwise = let !x = BI.inlinePerformIO $ do x' <- peek p touchForeignPtr fp return x' in w2c x : go (p `plusPtr` 1) q #endif {-# INLINE unpackStrict8 #-} -- | A way of creating ByteStrings outside the IO monad. The @Int@ -- argument gives the final size of the ByteString. Unlike -- 'createAndTrim' the ByteString is not reallocated if the final size -- is less than the estimated size. unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> B.ByteString unsafeCreate l f = unsafeDupablePerformIO (create l f) {-# INLINE unsafeCreate #-} -- | Create ByteString of size @l@ and use action @f@ to fill it's contents. create :: Int -> (Ptr Word8 -> IO ()) -> IO B.ByteString create l f = do fp <- mallocPlainForeignPtrBytes l withForeignPtr fp $ \p -> f p return $! BI.PS fp 0 l {-# INLINE create #-} lens-4.14/src/Control/Lens/Internal/Coerce.hs0000644000000000000000000000221412710476104017212 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 0 #endif #if (MIN_VERSION_profunctors(4,4,0)) && __GLASGOW_HASKELL__ >= 708 #define USE_COERCE {-# LANGUAGE Trustworthy #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} #else {-# LANGUAGE Unsafe #-} #endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2016 Edward Kmett and Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module provides a shim around 'coerce' that defaults to 'unsafeCoerce' -- on GHC < 7.8 ----------------------------------------------------------------------------- module Control.Lens.Internal.Coerce ( coerce , coerce' ) where #ifdef USE_COERCE import Data.Coerce coerce' :: forall a b. Coercible a b => b -> a coerce' = coerce (id :: a -> a) {-# INLINE coerce' #-} #else import Unsafe.Coerce coerce, coerce' :: a -> b coerce = unsafeCoerce coerce' = unsafeCoerce {-# INLINE coerce #-} {-# INLINE coerce' #-} #endif lens-4.14/src/Control/Lens/Internal/Context.hs0000644000000000000000000003104712710476104017444 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE RoleAnnotations #-} #endif #if __GLASGOW_HASKELL__ >= 711 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Context -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Context ( IndexedFunctor(..) , IndexedComonad(..) , IndexedComonadStore(..) , Sellable(..) , Context(..), Context' , Pretext(..), Pretext' , PretextT(..), PretextT' ) where import Control.Applicative import Control.Arrow import Control.Category import Control.Comonad import Control.Comonad.Store.Class import Control.Lens.Internal.Indexed import Data.Functor.Compose import Data.Functor.Contravariant import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Profunctor.Unsafe import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- IndexedFunctor ------------------------------------------------------------------------------ -- | This is a Bob Atkey -style 2-argument indexed functor. -- -- It exists as a superclass for 'IndexedComonad' and expresses the functoriality -- of an 'IndexedComonad' in its third argument. class IndexedFunctor w where ifmap :: (s -> t) -> w a b s -> w a b t ------------------------------------------------------------------------------ -- IndexedComonad ------------------------------------------------------------------------------ -- | This is a Bob Atkey -style 2-argument indexed comonad. -- -- It exists as a superclass for 'IndexedComonad' and expresses the functoriality -- of an 'IndexedComonad' in its third argument. -- -- The notion of indexed monads is covered in more depth in Bob Atkey's -- "Parameterized Notions of Computation" -- and that construction is dualized here. class IndexedFunctor w => IndexedComonad w where -- | extract from an indexed comonadic value when the indices match. iextract :: w a a t -> t -- | duplicate an indexed comonadic value splitting the index. iduplicate :: w a c t -> w a b (w b c t) iduplicate = iextend id {-# INLINE iduplicate #-} -- | extend a indexed comonadic computation splitting the index. iextend :: (w b c t -> r) -> w a c t -> w a b r iextend f = ifmap f . iduplicate {-# INLINE iextend #-} ------------------------------------------------------------------------------ -- IndexedComonadStore ------------------------------------------------------------------------------ -- | This is an indexed analogue to 'ComonadStore' for when you are working with an -- 'IndexedComonad'. class IndexedComonad w => IndexedComonadStore w where -- | This is the generalization of 'pos' to an indexed comonad store. ipos :: w a c t -> a -- | This is the generalization of 'peek' to an indexed comonad store. ipeek :: c -> w a c t -> t ipeek c = iextract . iseek c {-# INLINE ipeek #-} -- | This is the generalization of 'peeks' to an indexed comonad store. ipeeks :: (a -> c) -> w a c t -> t ipeeks f = iextract . iseeks f {-# INLINE ipeeks #-} -- | This is the generalization of 'seek' to an indexed comonad store. iseek :: b -> w a c t -> w b c t -- | This is the generalization of 'seeks' to an indexed comonad store. iseeks :: (a -> b) -> w a c t -> w b c t -- | This is the generalization of 'experiment' to an indexed comonad store. iexperiment :: Functor f => (b -> f c) -> w b c t -> f t iexperiment bfc wbct = (`ipeek` wbct) <$> bfc (ipos wbct) {-# INLINE iexperiment #-} -- | We can always forget the rest of the structure of 'w' and obtain a simpler -- indexed comonad store model called 'Context'. context :: w a b t -> Context a b t context wabt = Context (`ipeek` wabt) (ipos wabt) {-# INLINE context #-} ------------------------------------------------------------------------------ -- Sellable ------------------------------------------------------------------------------ -- | This is used internally to construct a 'Control.Lens.Internal.Bazaar.Bazaar', 'Context' or 'Pretext' -- from a singleton value. class Corepresentable p => Sellable p w | w -> p where sell :: p a (w a b b) ------------------------------------------------------------------------------ -- Context ------------------------------------------------------------------------------ -- | The indexed store can be used to characterize a 'Control.Lens.Lens.Lens' -- and is used by 'Control.Lens.Lens.clone'. -- -- @'Context' a b t@ is isomorphic to -- @newtype 'Context' a b t = 'Context' { runContext :: forall f. 'Functor' f => (a -> f b) -> f t }@, -- and to @exists s. (s, 'Control.Lens.Lens.Lens' s t a b)@. -- -- A 'Context' is like a 'Control.Lens.Lens.Lens' that has already been applied to a some structure. data Context a b t = Context (b -> t) a -- type role Context representational representational representational instance IndexedFunctor Context where ifmap f (Context g t) = Context (f . g) t {-# INLINE ifmap #-} instance IndexedComonad Context where iextract (Context f a) = f a {-# INLINE iextract #-} iduplicate (Context f a) = Context (Context f) a {-# INLINE iduplicate #-} iextend g (Context f a) = Context (g . Context f) a {-# INLINE iextend #-} instance IndexedComonadStore Context where ipos (Context _ a) = a {-# INLINE ipos #-} ipeek b (Context g _) = g b {-# INLINE ipeek #-} ipeeks f (Context g a) = g (f a) {-# INLINE ipeeks #-} iseek a (Context g _) = Context g a {-# INLINE iseek #-} iseeks f (Context g a) = Context g (f a) {-# INLINE iseeks #-} iexperiment f (Context g a) = g <$> f a {-# INLINE iexperiment #-} context = id {-# INLINE context #-} instance Functor (Context a b) where fmap f (Context g t) = Context (f . g) t {-# INLINE fmap #-} instance a ~ b => Comonad (Context a b) where extract (Context f a) = f a {-# INLINE extract #-} duplicate (Context f a) = Context (Context f) a {-# INLINE duplicate #-} extend g (Context f a) = Context (g . Context f) a {-# INLINE extend #-} instance a ~ b => ComonadStore a (Context a b) where pos = ipos {-# INLINE pos #-} peek = ipeek {-# INLINE peek #-} peeks = ipeeks {-# INLINE peeks #-} seek = iseek {-# INLINE seek #-} seeks = iseeks {-# INLINE seeks #-} experiment = iexperiment {-# INLINE experiment #-} instance Sellable (->) Context where sell = Context id {-# INLINE sell #-} -- | @type 'Context'' a s = 'Context' a a s@ type Context' a = Context a a ------------------------------------------------------------------------------ -- Pretext ------------------------------------------------------------------------------ -- | This is a generalized form of 'Context' that can be repeatedly cloned with less -- impact on its performance, and which permits the use of an arbitrary 'Conjoined' -- 'Profunctor' newtype Pretext p a b t = Pretext { runPretext :: forall f. Functor f => p a (f b) -> f t } -- type role Pretext representational nominal nominal nominal -- | @type 'Pretext'' p a s = 'Pretext' p a a s@ type Pretext' p a = Pretext p a a instance IndexedFunctor (Pretext p) where ifmap f (Pretext k) = Pretext (fmap f . k) {-# INLINE ifmap #-} instance Functor (Pretext p a b) where fmap = ifmap {-# INLINE fmap #-} instance Conjoined p => IndexedComonad (Pretext p) where iextract (Pretext m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} iduplicate (Pretext m) = getCompose $ m (Compose #. distrib sell . sell) {-# INLINE iduplicate #-} instance (a ~ b, Conjoined p) => Comonad (Pretext p a b) where extract = iextract {-# INLINE extract #-} duplicate = iduplicate {-# INLINE duplicate #-} instance Conjoined p => IndexedComonadStore (Pretext p) where ipos (Pretext m) = getConst $ coarr m $ arr Const {-# INLINE ipos #-} ipeek a (Pretext m) = runIdentity $ coarr m $ arr (\_ -> Identity a) {-# INLINE ipeek #-} ipeeks f (Pretext m) = runIdentity $ coarr m $ arr (Identity . f) {-# INLINE ipeeks #-} iseek a (Pretext m) = Pretext (lmap (lmap (const a)) m) {-# INLINE iseek #-} iseeks f (Pretext m) = Pretext (lmap (lmap f) m) {-# INLINE iseeks #-} iexperiment f (Pretext m) = coarr m (arr f) {-# INLINE iexperiment #-} context (Pretext m) = coarr m (arr sell) {-# INLINE context #-} instance (a ~ b, Conjoined p) => ComonadStore a (Pretext p a b) where pos = ipos {-# INLINE pos #-} peek = ipeek {-# INLINE peek #-} peeks = ipeeks {-# INLINE peeks #-} seek = iseek {-# INLINE seek #-} seeks = iseeks {-# INLINE seeks #-} experiment = iexperiment {-# INLINE experiment #-} instance Corepresentable p => Sellable p (Pretext p) where sell = cotabulate $ \ w -> Pretext (`cosieve` w) {-# INLINE sell #-} ------------------------------------------------------------------------------ -- PretextT ------------------------------------------------------------------------------ -- | This is a generalized form of 'Context' that can be repeatedly cloned with less -- impact on its performance, and which permits the use of an arbitrary 'Conjoined' -- 'Profunctor'. -- -- The extra phantom 'Functor' is used to let us lie and claim -- 'Control.Lens.Getter.Getter'-compatibility under limited circumstances. -- This is used internally to permit a number of combinators to gracefully -- degrade when applied to a 'Control.Lens.Fold.Fold' or -- 'Control.Lens.Getter.Getter'. newtype PretextT p (g :: * -> *) a b t = PretextT { runPretextT :: forall f. Functor f => p a (f b) -> f t } #if __GLASGOW_HASKELL__ >= 707 -- really we want PretextT p g a b t to permit the last 3 arguments to be representational iff p and f accept representational arguments -- but that isn't currently an option in GHC type role PretextT representational nominal nominal nominal nominal #endif -- | @type 'PretextT'' p g a s = 'PretextT' p g a a s@ type PretextT' p g a = PretextT p g a a instance IndexedFunctor (PretextT p g) where ifmap f (PretextT k) = PretextT (fmap f . k) {-# INLINE ifmap #-} instance Functor (PretextT p g a b) where fmap = ifmap {-# INLINE fmap #-} instance Conjoined p => IndexedComonad (PretextT p g) where iextract (PretextT m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} iduplicate (PretextT m) = getCompose $ m (Compose #. distrib sell . sell) {-# INLINE iduplicate #-} instance (a ~ b, Conjoined p) => Comonad (PretextT p g a b) where extract = iextract {-# INLINE extract #-} duplicate = iduplicate {-# INLINE duplicate #-} instance Conjoined p => IndexedComonadStore (PretextT p g) where ipos (PretextT m) = getConst $ coarr m $ arr Const {-# INLINE ipos #-} ipeek a (PretextT m) = runIdentity $ coarr m $ arr (\_ -> Identity a) {-# INLINE ipeek #-} ipeeks f (PretextT m) = runIdentity $ coarr m $ arr (Identity . f) {-# INLINE ipeeks #-} iseek a (PretextT m) = PretextT (lmap (lmap (const a)) m) {-# INLINE iseek #-} iseeks f (PretextT m) = PretextT (lmap (lmap f) m) {-# INLINE iseeks #-} iexperiment f (PretextT m) = coarr m (arr f) {-# INLINE iexperiment #-} context (PretextT m) = coarr m (arr sell) {-# INLINE context #-} instance (a ~ b, Conjoined p) => ComonadStore a (PretextT p g a b) where pos = ipos {-# INLINE pos #-} peek = ipeek {-# INLINE peek #-} peeks = ipeeks {-# INLINE peeks #-} seek = iseek {-# INLINE seek #-} seeks = iseeks {-# INLINE seeks #-} experiment = iexperiment {-# INLINE experiment #-} instance Corepresentable p => Sellable p (PretextT p g) where sell = cotabulate $ \ w -> PretextT (`cosieve` w) {-# INLINE sell #-} instance (Profunctor p, Contravariant g) => Contravariant (PretextT p g a b) where contramap _ = (<$) (error "contramap: PretextT") {-# INLINE contramap #-} ------------------------------------------------------------------------------ -- Utilities ------------------------------------------------------------------------------ -- | We can convert any 'Conjoined' 'Profunctor' to a function, -- possibly losing information about an index in the process. coarr :: (Representable q, Comonad (Rep q)) => q a b -> a -> b coarr qab = extract . sieve qab {-# INLINE coarr #-} lens-4.14/src/Control/Lens/Internal/Deque.hs0000644000000000000000000001346412710476104017066 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Deque -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module is designed to be imported qualified. ----------------------------------------------------------------------------- module Control.Lens.Internal.Deque ( Deque(..) , size , fromList , null , singleton ) where import Control.Applicative import Control.Lens.Cons import Control.Lens.Fold import Control.Lens.Indexed hiding ((<.>)) import Control.Lens.Iso import Control.Lens.Lens import Control.Lens.Prism import Control.Monad #if MIN_VERSION_base(4,8,0) import Data.Foldable hiding (null) import qualified Data.Foldable as Foldable #else import Data.Foldable as Foldable #endif import Data.Function import Data.Functor.Bind import Data.Functor.Plus import Data.Functor.Reverse import Data.Traversable as Traversable import Data.Semigroup import Data.Profunctor.Unsafe import Prelude hiding (null) -- | A Banker's deque based on Chris Okasaki's \"Purely Functional Data Structures\" data Deque a = BD !Int [a] !Int [a] deriving Show -- | /O(1)/. Determine if a 'Deque' is 'empty'. -- -- >>> null empty -- True -- -- >>> null (singleton 1) -- False null :: Deque a -> Bool null (BD lf _ lr _) = lf + lr == 0 {-# INLINE null #-} -- | /O(1)/. Generate a singleton 'Deque' -- -- >>> singleton 1 -- BD 1 [1] 0 [] singleton :: a -> Deque a singleton a = BD 1 [a] 0 [] {-# INLINE singleton #-} -- | /O(1)/. Calculate the size of a 'Deque' -- -- >>> size (fromList [1,4,6]) -- 3 size :: Deque a -> Int size (BD lf _ lr _) = lf + lr {-# INLINE size #-} -- | /O(n)/ amortized. Construct a 'Deque' from a list of values. -- -- >>> fromList [1,2] -- BD 1 [1] 1 [2] fromList :: [a] -> Deque a fromList = Prelude.foldr cons empty {-# INLINE fromList #-} instance Eq a => Eq (Deque a) where (==) = (==) `on` toList {-# INLINE (==) #-} instance Ord a => Ord (Deque a) where compare = compare `on` toList {-# INLINE compare #-} instance Functor Deque where fmap h (BD lf f lr r) = BD lf (fmap h f) lr (fmap h r) {-# INLINE fmap #-} instance FunctorWithIndex Int Deque where imap h (BD lf f lr r) = BD lf (imap h f) lr (imap (\j -> h (n - j)) r) where !n = lf + lr instance Apply Deque where fs <.> as = fromList (toList fs <.> toList as) {-# INLINE (<.>) #-} instance Applicative Deque where pure a = BD 1 [a] 0 [] {-# INLINE pure #-} fs <*> as = fromList (toList fs <*> toList as) {-# INLINE (<*>) #-} instance Alt Deque where xs ys | size xs < size ys = Foldable.foldr cons ys xs | otherwise = Foldable.foldl snoc xs ys {-# INLINE () #-} instance Plus Deque where zero = BD 0 [] 0 [] {-# INLINE zero #-} instance Alternative Deque where empty = BD 0 [] 0 [] {-# INLINE empty #-} xs <|> ys | size xs < size ys = Foldable.foldr cons ys xs | otherwise = Foldable.foldl snoc xs ys {-# INLINE (<|>) #-} instance Reversing (Deque a) where reversing (BD lf f lr r) = BD lr r lf f {-# INLINE reversing #-} instance Bind Deque where ma >>- k = fromList (toList ma >>= toList . k) {-# INLINE (>>-) #-} instance Monad Deque where return = pure {-# INLINE return #-} ma >>= k = fromList (toList ma >>= toList . k) {-# INLINE (>>=) #-} instance MonadPlus Deque where mzero = empty {-# INLINE mzero #-} mplus = (<|>) {-# INLINE mplus #-} instance Foldable Deque where foldMap h (BD _ f _ r) = foldMap h f `mappend` getDual (foldMap (Dual #. h) r) {-# INLINE foldMap #-} instance FoldableWithIndex Int Deque where ifoldMap h (BD lf f lr r) = ifoldMap h f `mappend` getDual (ifoldMap (\j -> Dual #. h (n - j)) r) where !n = lf + lr {-# INLINE ifoldMap #-} instance Traversable Deque where traverse h (BD lf f lr r) = (BD lf ?? lr) <$> traverse h f <*> backwards traverse h r {-# INLINE traverse #-} instance TraversableWithIndex Int Deque where itraverse h (BD lf f lr r) = (\f' r' -> BD lr f' lr (getReverse r')) <$> itraverse h f <*> itraverse (\j -> h (n - j)) (Reverse r) where !n = lf + lr {-# INLINE itraverse #-} instance Semigroup (Deque a) where xs <> ys | size xs < size ys = Foldable.foldr cons ys xs | otherwise = Foldable.foldl snoc xs ys {-# INLINE (<>) #-} instance Monoid (Deque a) where mempty = BD 0 [] 0 [] {-# INLINE mempty #-} mappend xs ys | size xs < size ys = Foldable.foldr cons ys xs | otherwise = Foldable.foldl snoc xs ys {-# INLINE mappend #-} -- | Check that a 'Deque' satisfies the balance invariants and rebalance if not. check :: Int -> [a] -> Int -> [a] -> Deque a check lf f lr r | lf > 3*lr + 1, i <- div (lf + lr) 2, (f',f'') <- splitAt i f = BD i f' (lf + lr - i) (r ++ reverse f'') | lr > 3*lf + 1, j <- div (lf + lr) 2, (r',r'') <- splitAt j r = BD (lf + lr - j) (f ++ reverse r'') j r' | otherwise = BD lf f lr r {-# INLINE check #-} instance Cons (Deque a) (Deque b) a b where _Cons = prism (\(x,BD lf f lr r) -> check (lf + 1) (x : f) lr r) $ \ (BD lf f lr r) -> if lf + lr == 0 then Left empty else Right $ case f of [] -> (head r, empty) (x:xs) -> (x, check (lf - 1) xs lr r) {-# INLINE _Cons #-} instance Snoc (Deque a) (Deque b) a b where _Snoc = prism (\(BD lf f lr r,x) -> check lf f (lr + 1) (x : r)) $ \ (BD lf f lr r) -> if lf + lr == 0 then Left empty else Right $ case r of [] -> (empty, head f) (x:xs) -> (check lf f (lr - 1) xs, x) {-# INLINE _Snoc #-} lens-4.14/src/Control/Lens/Internal/Exception.hs0000644000000000000000000002223212710476104017752 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RoleAnnotations #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Exception -- Copyright : (C) 2013-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module uses dirty tricks to generate a 'Handler' from an arbitrary -- 'Fold'. ---------------------------------------------------------------------------- module Control.Lens.Internal.Exception ( Handleable(..) , HandlingException(..) ) where import Control.Exception as Exception import Control.Lens.Fold import Control.Lens.Getter import Control.Monad.Catch as Catch import Data.Monoid import Data.Proxy import Data.Reflection import Data.Typeable -- This is needed because ghc 7.8-rc2 has Typeable1 as a type alias. #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707 #define Typeable1 Typeable #endif ------------------------------------------------------------------------------ -- Handlers ------------------------------------------------------------------------------ -- | Both @exceptions@ and "Control.Exception" provide a 'Handler' type. -- -- This lets us write combinators to build handlers that are agnostic about the choice of -- which of these they use. class Handleable e (m :: * -> *) (h :: * -> *) | h -> e m where -- | This builds a 'Handler' for just the targets of a given 'Control.Lens.Type.Prism' (or any 'Getter', really). -- -- @ -- 'catches' ... [ 'handler' 'Control.Exception.Lens._AssertionFailed' (\s -> 'print' '$' \"Assertion Failed\\n\" '++' s) -- , 'handler' 'Control.Exception.Lens._ErrorCall' (\s -> 'print' '$' \"Error\\n\" '++' s) -- ] -- @ -- -- This works ith both the 'Exception.Handler' type provided by @Control.Exception@: -- -- @ -- 'handler' :: 'Getter' 'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r -- 'handler' :: 'Fold' 'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r -- 'handler' :: 'Control.Lens.Prism.Prism'' 'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r -- 'handler' :: 'Control.Lens.Lens.Lens'' 'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r -- 'handler' :: 'Control.Lens.Traversal.Traversal'' 'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r -- @ -- -- and with the 'Catch.Handler' type provided by @Control.Monad.Catch@: -- -- @ -- 'handler' :: 'Getter' 'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r -- 'handler' :: 'Fold' 'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r -- 'handler' :: 'Control.Lens.Prism.Prism'' 'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r -- 'handler' :: 'Control.Lens.Lens.Lens'' 'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r -- 'handler' :: 'Control.Lens.Traversal.Traversal'' 'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r -- @ -- -- and with the 'Control.Monad.Error.Lens.Handler' type provided by @Control.Monad.Error.Lens@: -- -- @ -- 'handler' :: 'Getter' e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r -- 'handler' :: 'Fold' e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r -- 'handler' :: 'Control.Lens.Prism.Prism'' e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r -- 'handler' :: 'Control.Lens.Lens.Lens'' e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r -- 'handler' :: 'Control.Lens.Traversal.Traversal'' e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r -- @ handler :: Typeable a => Getting (First a) e a -> (a -> m r) -> h r -- | This builds a 'Handler' for just the targets of a given 'Control.Lens.Prism.Prism' (or any 'Getter', really). -- that ignores its input and just recovers with the stated monadic action. -- -- @ -- 'catches' ... [ 'handler_' 'Control.Exception.Lens._NonTermination' ('return' \"looped\") -- , 'handler_' 'Control.Exception.Lens._StackOverflow' ('return' \"overflow\") -- ] -- @ -- -- This works with the 'Exception.Handler' type provided by @Control.Exception@: -- -- @ -- 'handler_' :: 'Getter' 'SomeException' a -> 'IO' r -> 'Exception.Handler' r -- 'handler_' :: 'Fold' 'SomeException' a -> 'IO' r -> 'Exception.Handler' r -- 'handler_' :: 'Control.Lens.Prism.Prism'' 'SomeException' a -> 'IO' r -> 'Exception.Handler' r -- 'handler_' :: 'Control.Lens.Lens.Lens'' 'SomeException' a -> 'IO' r -> 'Exception.Handler' r -- 'handler_' :: 'Control.Lens.Traversal.Traversal'' 'SomeException' a -> 'IO' r -> 'Exception.Handler' r -- @ -- -- and with the 'Catch.Handler' type provided by @Control.Monad.Catch@: -- -- @ -- 'handler_' :: 'Getter' 'SomeException' a -> m r -> 'Catch.Handler' m r -- 'handler_' :: 'Fold' 'SomeException' a -> m r -> 'Catch.Handler' m r -- 'handler_' :: 'Control.Lens.Prism.Prism'' 'SomeException' a -> m r -> 'Catch.Handler' m r -- 'handler_' :: 'Control.Lens.Lens.Lens'' 'SomeException' a -> m r -> 'Catch.Handler' m r -- 'handler_' :: 'Control.Lens.Traversal.Traversal'' 'SomeException' a -> m r -> 'Catch.Handler' m r -- @ -- -- and with the 'Control.Monad.Error.Lens.Handler' type provided by @Control.Monad.Error.Lens@: -- -- @ -- 'handler_' :: 'Getter' e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r -- 'handler_' :: 'Fold' e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r -- 'handler_' :: 'Control.Lens.Prism.Prism'' e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r -- 'handler_' :: 'Control.Lens.Lens.Lens'' e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r -- 'handler_' :: 'Control.Lens.Traversal.Traversal'' e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r -- @ handler_ :: Typeable a => Getting (First a) e a -> m r -> h r handler_ l = handler l . const {-# INLINE handler_ #-} instance Handleable SomeException IO Exception.Handler where handler = handlerIO instance Typeable1 m => Handleable SomeException m (Catch.Handler m) where handler = handlerCatchIO handlerIO :: forall a r. Typeable a => Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r handlerIO l f = reifyTypeable (preview l) $ \ (_ :: Proxy s) -> Exception.Handler (\(Handling a :: Handling a s IO) -> f a) handlerCatchIO :: forall m a r. (Typeable a, Typeable1 m) => Getting (First a) SomeException a -> (a -> m r) -> Catch.Handler m r handlerCatchIO l f = reifyTypeable (preview l) $ \ (_ :: Proxy s) -> Catch.Handler (\(Handling a :: Handling a s m) -> f a) ------------------------------------------------------------------------------ -- Helpers ------------------------------------------------------------------------------ -- | There was an 'Exception' caused by abusing the internals of a 'Handler'. data HandlingException = HandlingException deriving (Show,Typeable) instance Exception HandlingException {- -- | This supplies a globally unique set of IDs so we can hack around the default use of 'cast' in 'SomeException' -- if someone, somehow, somewhere decides to reach in and catch and rethrow a @Handling@ 'Exception' by existentially -- opening a 'Handler' that uses it. supply :: IORef Int supply = unsafePerformIO $ newIORef 0 {-# NOINLINE supply #-} -} -- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does. newtype Handling a s (m :: * -> *) = Handling a #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707 deriving Typeable type role Handling representational nominal nominal #else -- the m parameter exists simply to break the Typeable1 pattern, so we can provide this without overlap. -- here we simply generate a fresh TypeRep so we'll fail to compare as equal to any other TypeRep. instance (Typeable a, Typeable s, Typeable1 m) => Typeable (Handling a s m) where typeOf _ = mkTyConApp handlingTyCon [typeOf (undefined :: a), typeOf (undefined :: s), typeOf1 (undefined :: m a)] {-# INLINE typeOf #-} handlingTyCon :: TyCon handlingTyCon = mkTyCon3 "lens" "Control.Lens.Internal.Exception" "Handling" {-# NOINLINE handlingTyCon #-} #endif -- The @Handling@ wrapper is uninteresting, and should never be thrown, so you won't get much benefit here. instance Show (Handling a s m) where showsPrec d _ = showParen (d > 10) $ showString "Handling ..." {-# INLINE showsPrec #-} instance (Reifies s (SomeException -> Maybe a), Typeable (Handling a s m)) => Exception (Handling a s m) where toException _ = SomeException HandlingException {-# INLINE toException #-} fromException = fmap Handling . reflect (Proxy :: Proxy s) {-# INLINE fromException #-} lens-4.14/src/Control/Lens/Internal/FieldTH.hs0000644000000000000000000005371412710476104017304 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_template_haskell #define MIN_VERSION_template_haskell(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.FieldTH -- Copyright : (C) 2014-2016 Edward Kmett, (C) 2014 Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ----------------------------------------------------------------------------- module Control.Lens.Internal.FieldTH ( LensRules(..) , DefName(..) , makeFieldOptics , makeFieldOpticsForDec ) where import Control.Lens.At import Control.Lens.Fold import Control.Lens.Internal.TH import Control.Lens.Plated import Control.Lens.Prism import Control.Lens.Setter import Control.Lens.Getter import Control.Lens.Traversal import Control.Lens.Tuple import Control.Applicative import Control.Monad import Language.Haskell.TH.Lens import Language.Haskell.TH import Data.Foldable (toList) import Data.Maybe (isJust,maybeToList) import Data.List (nub, findIndices) import Data.Either (partitionEithers) import Data.Set.Lens import Data.Map ( Map ) import Data.Set ( Set ) import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.Traversable as T import Prelude ------------------------------------------------------------------------ -- Field generation entry point ------------------------------------------------------------------------ -- | Compute the field optics for the type identified by the given type name. -- Lenses will be computed when possible, Traversals otherwise. makeFieldOptics :: LensRules -> Name -> DecsQ makeFieldOptics rules tyName = do info <- reify tyName case info of TyConI dec -> makeFieldOpticsForDec rules dec _ -> fail "makeFieldOptics: Expected type constructor name" makeFieldOpticsForDec :: LensRules -> Dec -> DecsQ makeFieldOpticsForDec rules dec = case dec of #if MIN_VERSION_template_haskell(2,11,0) DataD _ tyName vars _ cons _ -> makeFieldOpticsForDec' rules tyName (mkS tyName vars) cons NewtypeD _ tyName vars _ con _ -> makeFieldOpticsForDec' rules tyName (mkS tyName vars) [con] DataInstD _ tyName args _ cons _ -> makeFieldOpticsForDec' rules tyName (tyName `conAppsT` args) cons NewtypeInstD _ tyName args _ con _ -> makeFieldOpticsForDec' rules tyName (tyName `conAppsT` args) [con] #else DataD _ tyName vars cons _ -> makeFieldOpticsForDec' rules tyName (mkS tyName vars) cons NewtypeD _ tyName vars con _ -> makeFieldOpticsForDec' rules tyName (mkS tyName vars) [con] DataInstD _ tyName args cons _ -> makeFieldOpticsForDec' rules tyName (tyName `conAppsT` args) cons NewtypeInstD _ tyName args con _ -> makeFieldOpticsForDec' rules tyName (tyName `conAppsT` args) [con] #endif _ -> fail "makeFieldOptics: Expected data or newtype type-constructor" where mkS tyName vars = tyName `conAppsT` map VarT (toListOf typeVars vars) -- | Compute the field optics for a deconstructed Dec -- When possible build an Iso otherwise build one optic per field. makeFieldOpticsForDec' :: LensRules -> Name -> Type -> [Con] -> DecsQ makeFieldOpticsForDec' rules tyName s cons = do fieldCons <- traverse normalizeConstructor cons let allFields = toListOf (folded . _2 . folded . _1 . folded) fieldCons let defCons = over normFieldLabels (expandName allFields) fieldCons allDefs = setOf (normFieldLabels . folded) defCons perDef <- T.sequenceA (fromSet (buildScaffold rules s defCons) allDefs) let defs = Map.toList perDef case _classyLenses rules tyName of Just (className, methodName) -> makeClassyDriver rules className methodName s defs Nothing -> do decss <- traverse (makeFieldOptic rules) defs return (concat decss) where -- Traverse the field labels of a normalized constructor normFieldLabels :: Traversal [(Name,[(a,Type)])] [(Name,[(b,Type)])] a b normFieldLabels = traverse . _2 . traverse . _1 -- Map a (possibly missing) field's name to zero-to-many optic definitions expandName :: [Name] -> Maybe Name -> [DefName] expandName allFields = concatMap (_fieldToDef rules tyName allFields) . maybeToList -- | Normalized the Con type into a uniform positional representation, -- eliminating the variance between records, infix constructors, and normal -- constructors. -- -- For 'GadtC' and 'RecGadtC', the leftmost name is chosen. normalizeConstructor :: Con -> Q (Name, [(Maybe Name, Type)]) -- ^ constructor name, field name, field type normalizeConstructor (RecC n xs) = return (n, [ (Just fieldName, ty) | (fieldName,_,ty) <- xs]) normalizeConstructor (NormalC n xs) = return (n, [ (Nothing, ty) | (_,ty) <- xs]) normalizeConstructor (InfixC (_,ty1) n (_,ty2)) = return (n, [ (Nothing, ty1), (Nothing, ty2) ]) normalizeConstructor (ForallC _ _ con) = do con' <- normalizeConstructor con return (set (_2 . mapped . _1) Nothing con') #if MIN_VERSION_template_haskell(2,11,0) normalizeConstructor (GadtC ns xs _) = return (head ns, [ (Nothing, ty) | (_,ty) <- xs]) normalizeConstructor (RecGadtC ns xs _) = return (head ns, [ (Just fieldName, ty) | (fieldName,_,ty) <- xs]) #endif data OpticType = GetterType | LensType | IsoType -- | Compute the positional location of the fields involved in -- each constructor for a given optic definition as well as the -- type of clauses to generate and the type to annotate the declaration -- with. buildScaffold :: LensRules -> Type {- ^ outer type -} -> [(Name, [([DefName], Type)])] {- ^ normalized constructors -} -> DefName {- ^ target definition -} -> Q (OpticType, OpticStab, [(Name, Int, [Int])]) {- ^ optic type, definition type, field count, target fields -} buildScaffold rules s cons defName = do (s',t,a,b) <- buildStab s (concatMap snd consForDef) let defType | Just (_,cx,a') <- preview _ForallT a = let optic | lensCase = getterTypeName | otherwise = foldTypeName in OpticSa cx optic s' a' -- Getter and Fold are always simple | not (_allowUpdates rules) = let optic | lensCase = getterTypeName | otherwise = foldTypeName in OpticSa [] optic s' a -- Generate simple Lens and Traversal where possible | _simpleLenses rules || s' == t && a == b = let optic | isoCase && _allowIsos rules = iso'TypeName | lensCase = lens'TypeName | otherwise = traversal'TypeName in OpticSa [] optic s' a -- Generate type-changing Lens and Traversal otherwise | otherwise = let optic | isoCase && _allowIsos rules = isoTypeName | lensCase = lensTypeName | otherwise = traversalTypeName in OpticStab optic s' t a b opticType | has _ForallT a = GetterType | not (_allowUpdates rules) = GetterType | isoCase = IsoType | otherwise = LensType return (opticType, defType, scaffolds) where consForDef :: [(Name, [Either Type Type])] consForDef = over (mapped . _2 . mapped) categorize cons scaffolds :: [(Name, Int, [Int])] scaffolds = [ (n, length ts, rightIndices ts) | (n,ts) <- consForDef ] rightIndices :: [Either Type Type] -> [Int] rightIndices = findIndices (has _Right) -- Right: types for this definition -- Left : other types categorize :: ([DefName], Type) -> Either Type Type categorize (defNames, t) | defName `elem` defNames = Right t | otherwise = Left t lensCase :: Bool lensCase = all (\x -> lengthOf (_2 . folded . _Right) x == 1) consForDef isoCase :: Bool isoCase = case scaffolds of [(_,1,[0])] -> True _ -> False data OpticStab = OpticStab Name Type Type Type Type | OpticSa Cxt Name Type Type stabToType :: OpticStab -> Type stabToType (OpticStab c s t a b) = quantifyType [] (c `conAppsT` [s,t,a,b]) stabToType (OpticSa cx c s a ) = quantifyType cx (c `conAppsT` [s,a]) stabToContext :: OpticStab -> Cxt stabToContext OpticStab{} = [] stabToContext (OpticSa cx _ _ _) = cx stabToOptic :: OpticStab -> Name stabToOptic (OpticStab c _ _ _ _) = c stabToOptic (OpticSa _ c _ _) = c stabToS :: OpticStab -> Type stabToS (OpticStab _ s _ _ _) = s stabToS (OpticSa _ _ s _) = s stabToA :: OpticStab -> Type stabToA (OpticStab _ _ _ a _) = a stabToA (OpticSa _ _ _ a) = a -- | Compute the s t a b types given the outer type 's' and the -- categorized field types. Left for fixed and Right for visited. -- These types are "raw" and will be packaged into an 'OpticStab' -- shortly after creation. buildStab :: Type -> [Either Type Type] -> Q (Type,Type,Type,Type) buildStab s categorizedFields = do (subA,a) <- unifyTypes targetFields let s' = applyTypeSubst subA s -- compute possible type changes sub <- T.sequenceA (fromSet (newName . nameBase) unfixedTypeVars) let (t,b) = over both (substTypeVars sub) (s',a) return (s',t,a,b) where (fixedFields, targetFields) = partitionEithers categorizedFields fixedTypeVars = setOf typeVars fixedFields unfixedTypeVars = setOf typeVars s Set.\\ fixedTypeVars -- | Build the signature and definition for a single field optic. -- In the case of a singleton constructor irrefutable matches are -- used to enable the resulting lenses to be used on a bottom value. makeFieldOptic :: LensRules -> (DefName, (OpticType, OpticStab, [(Name, Int, [Int])])) -> DecsQ makeFieldOptic rules (defName, (opticType, defType, cons)) = do cls <- mkCls T.sequenceA (cls ++ sig ++ def) where mkCls = case defName of MethodName c n | _generateClasses rules -> do classExists <- isJust <$> lookupTypeName (show c) return (if classExists then [] else [makeFieldClass defType c n]) _ -> return [] sig = case defName of _ | not (_generateSigs rules) -> [] TopName n -> [sigD n (return (stabToType defType))] MethodName{} -> [] fun n = funD n clauses : inlinePragma n def = case defName of TopName n -> fun n MethodName c n -> [makeFieldInstance defType c (fun n)] clauses = makeFieldClauses rules opticType cons ------------------------------------------------------------------------ -- Classy class generator ------------------------------------------------------------------------ makeClassyDriver :: LensRules -> Name -> Name -> Type {- ^ Outer 's' type -} -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] -> DecsQ makeClassyDriver rules className methodName s defs = T.sequenceA (cls ++ inst) where cls | _generateClasses rules = [makeClassyClass className methodName s defs] | otherwise = [] inst = [makeClassyInstance rules className methodName s defs] makeClassyClass :: Name -> Name -> Type {- ^ Outer 's' type -} -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] -> DecQ makeClassyClass className methodName s defs = do let ss = map (stabToS . view (_2 . _2)) defs (sub,s') <- unifyTypes (s : ss) c <- newName "c" let vars = toListOf typeVars s' fd | null vars = [] | otherwise = [FunDep [c] vars] classD (cxt[]) className (map PlainTV (c:vars)) fd $ sigD methodName (return (lens'TypeName `conAppsT` [VarT c, s'])) : concat [ [sigD defName (return ty) ,valD (varP defName) (normalB body) [] ] ++ inlinePragma defName | (TopName defName, (_, stab, _)) <- defs , let body = appsE [varE composeValName, varE methodName, varE defName] , let ty = quantifyType' (Set.fromList (c:vars)) (stabToContext stab) $ stabToOptic stab `conAppsT` [VarT c, applyTypeSubst sub (stabToA stab)] ] makeClassyInstance :: LensRules -> Name -> Name -> Type {- ^ Outer 's' type -} -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] -> DecQ makeClassyInstance rules className methodName s defs = do methodss <- traverse (makeFieldOptic rules') defs instanceD (cxt[]) (return instanceHead) $ valD (varP methodName) (normalB (varE idValName)) [] : map return (concat methodss) where instanceHead = className `conAppsT` (s : map VarT vars) vars = toListOf typeVars s rules' = rules { _generateSigs = False , _generateClasses = False } ------------------------------------------------------------------------ -- Field class generation ------------------------------------------------------------------------ makeFieldClass :: OpticStab -> Name -> Name -> DecQ makeFieldClass defType className methodName = classD (cxt []) className [PlainTV s, PlainTV a] [FunDep [s] [a]] [sigD methodName (return methodType)] where methodType = quantifyType' (Set.fromList [s,a]) (stabToContext defType) $ stabToOptic defType `conAppsT` [VarT s,VarT a] s = mkName "s" a = mkName "a" makeFieldInstance :: OpticStab -> Name -> [DecQ] -> DecQ makeFieldInstance defType className = instanceD (cxt []) (return (className `conAppsT` [stabToS defType, stabToA defType])) ------------------------------------------------------------------------ -- Optic clause generators ------------------------------------------------------------------------ makeFieldClauses :: LensRules -> OpticType -> [(Name, Int, [Int])] -> [ClauseQ] makeFieldClauses rules opticType cons = case opticType of IsoType -> [ makeIsoClause conName | (conName, _, _) <- cons ] GetterType -> [ makeGetterClause conName fieldCount fields | (conName, fieldCount, fields) <- cons ] LensType -> [ makeFieldOpticClause conName fieldCount fields irref | (conName, fieldCount, fields) <- cons ] where irref = _lazyPatterns rules && length cons == 1 -- | Construct an optic clause that returns an unmodified value -- given a constructor name and the number of fields on that -- constructor. makePureClause :: Name -> Int -> ClauseQ makePureClause conName fieldCount = do xs <- newNames "x" fieldCount -- clause: _ (Con x1..xn) = pure (Con x1..xn) clause [wildP, conP conName (map varP xs)] (normalB (appE (varE pureValName) (appsE (conE conName : map varE xs)))) [] -- | Construct an optic clause suitable for a Getter or Fold -- by visited the fields identified by their 0 indexed positions makeGetterClause :: Name -> Int -> [Int] -> ClauseQ makeGetterClause conName fieldCount [] = makePureClause conName fieldCount makeGetterClause conName fieldCount fields = do f <- newName "f" xs <- newNames "x" (length fields) let pats (i:is) (y:ys) | i `elem` fields = varP y : pats is ys | otherwise = wildP : pats is (y:ys) pats is _ = map (const wildP) is fxs = [ appE (varE f) (varE x) | x <- xs ] body = foldl (\a b -> appsE [varE apValName, a, b]) (appE (varE phantomValName) (head fxs)) (tail fxs) -- clause f (Con x1..xn) = coerce (f x1) <*> ... <*> f xn clause [varP f, conP conName (pats [0..fieldCount - 1] xs)] (normalB body) [] -- | Build a clause that updates the field at the given indexes -- When irref is 'True' the value with me matched with an irrefutable -- pattern. This is suitable for Lens and Traversal construction makeFieldOpticClause :: Name -> Int -> [Int] -> Bool -> ClauseQ makeFieldOpticClause conName fieldCount [] _ = makePureClause conName fieldCount makeFieldOpticClause conName fieldCount (field:fields) irref = do f <- newName "f" xs <- newNames "x" fieldCount ys <- newNames "y" (1 + length fields) let xs' = foldr (\(i,x) -> set (ix i) x) xs (zip (field:fields) ys) mkFx i = appE (varE f) (varE (xs !! i)) body0 = appsE [ varE fmapValName , lamE (map varP ys) (appsE (conE conName : map varE xs')) , mkFx field ] body = foldl (\a b -> appsE [varE apValName, a, mkFx b]) body0 fields let wrap = if irref then tildeP else id clause [varP f, wrap (conP conName (map varP xs))] (normalB body) [] -- | Build a clause that constructs an Iso makeIsoClause :: Name -> ClauseQ makeIsoClause conName = clause [] (normalB (appsE [varE isoValName, destruct, construct])) [] where destruct = do x <- newName "x" lam1E (conP conName [varP x]) (varE x) construct = conE conName ------------------------------------------------------------------------ -- Unification logic ------------------------------------------------------------------------ -- The field-oriented optic generation supports incorporating fields -- with distinct but unifiable types into a single definition. -- | Unify the given list of types, if possible, and return the -- substitution used to unify the types for unifying the outer -- type when building a definition's type signature. unifyTypes :: [Type] -> Q (Map Name Type, Type) unifyTypes (x:xs) = foldM (uncurry unify1) (Map.empty, x) xs unifyTypes [] = fail "unifyTypes: Bug: Unexpected empty list" -- | Attempt to unify two given types using a running substitution unify1 :: Map Name Type -> Type -> Type -> Q (Map Name Type, Type) unify1 sub (VarT x) y | Just r <- Map.lookup x sub = unify1 sub r y unify1 sub x (VarT y) | Just r <- Map.lookup y sub = unify1 sub x r unify1 sub x y | x == y = return (sub, x) unify1 sub (AppT f1 x1) (AppT f2 x2) = do (sub1, f) <- unify1 sub f1 f2 (sub2, x) <- unify1 sub1 x1 x2 return (sub2, AppT (applyTypeSubst sub2 f) x) unify1 sub x (VarT y) | elemOf typeVars y (applyTypeSubst sub x) = fail "Failed to unify types: occurs check" | otherwise = return (Map.insert y x sub, x) unify1 sub (VarT x) y = unify1 sub y (VarT x) -- TODO: Unify contexts unify1 sub (ForallT v1 [] t1) (ForallT v2 [] t2) = -- This approach works out because by the time this code runs -- all of the type variables have been renamed. No risk of shadowing. do (sub1,t) <- unify1 sub t1 t2 v <- fmap nub (traverse (limitedSubst sub1) (v1++v2)) return (sub1, ForallT v [] t) unify1 _ x y = fail ("Failed to unify types: " ++ show (x,y)) -- | Perform a limited substitution on type variables. This is used -- when unifying rank-2 fields when trying to achieve a Getter or Fold. limitedSubst :: Map Name Type -> TyVarBndr -> Q TyVarBndr limitedSubst sub (PlainTV n) | Just r <- Map.lookup n sub = case r of VarT m -> limitedSubst sub (PlainTV m) _ -> fail "Unable to unify exotic higher-rank type" limitedSubst sub (KindedTV n k) | Just r <- Map.lookup n sub = case r of VarT m -> limitedSubst sub (KindedTV m k) _ -> fail "Unable to unify exotic higher-rank type" limitedSubst _ tv = return tv -- | Apply a substitution to a type. This is used after unifying -- the types of the fields in unifyTypes. applyTypeSubst :: Map Name Type -> Type -> Type applyTypeSubst sub = rewrite aux where aux (VarT n) = Map.lookup n sub aux _ = Nothing ------------------------------------------------------------------------ -- Field generation parameters ------------------------------------------------------------------------ -- | Rules to construct lenses for data fields. data LensRules = LensRules { _simpleLenses :: Bool , _generateSigs :: Bool , _generateClasses :: Bool , _allowIsos :: Bool , _allowUpdates :: Bool -- ^ Allow Lens/Traversal (otherwise Getter/Fold) , _lazyPatterns :: Bool , _fieldToDef :: Name -> [Name] -> Name -> [DefName] -- ^ Type Name -> Field Names -> Target Field Name -> Definition Names , _classyLenses :: Name -> Maybe (Name,Name) -- type name to class name and top method } -- | Name to give to generated field optics. data DefName = TopName Name -- ^ Simple top-level definiton name | MethodName Name Name -- ^ makeFields-style class name and method name deriving (Show, Eq, Ord) ------------------------------------------------------------------------ -- Miscellaneous utility functions ------------------------------------------------------------------------ -- | Template Haskell wants type variables declared in a forall, so -- we find all free type variables in a given type and declare them. quantifyType :: Cxt -> Type -> Type quantifyType c t = ForallT vs c t where vs = map PlainTV (toList (setOf typeVars t)) -- | This function works like 'quantifyType' except that it takes -- a list of variables to exclude from quantification. quantifyType' :: Set Name -> Cxt -> Type -> Type quantifyType' exclude c t = ForallT vs c t where vs = map PlainTV (toList (setOf typeVars t Set.\\ exclude)) ------------------------------------------------------------------------ -- Support for generating inline pragmas ------------------------------------------------------------------------ inlinePragma :: Name -> [DecQ] #ifdef INLINING #if MIN_VERSION_template_haskell(2,8,0) # ifdef OLD_INLINE_PRAGMAS -- 7.6rc1? inlinePragma methodName = [pragInlD methodName (inlineSpecNoPhase Inline False)] # else -- 7.7.20120830 inlinePragma methodName = [pragInlD methodName Inline FunLike AllPhases] # endif #else -- GHC <7.6, TH <2.8.0 inlinePragma methodName = [pragInlD methodName (inlineSpecNoPhase True False)] #endif #else inlinePragma _ = [] #endif lens-4.14/src/Control/Lens/Internal/Fold.hs0000644000000000000000000001534212710476104016704 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 711 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Fold -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Fold ( -- * Monoids for folding Folding(..) , Traversed(..) , Sequenced(..) , Max(..), getMax , Min(..), getMin , Leftmost(..), getLeftmost , Rightmost(..), getRightmost , ReifiedMonoid(..) ) where import Control.Applicative import Control.Lens.Internal.Getter import Data.Functor.Bind import Data.Functor.Contravariant import Data.Maybe import Data.Semigroup hiding (Min, getMin, Max, getMax) import Data.Reflection import Prelude #ifdef HLINT {-# ANN module "HLint: ignore Avoid lambda" #-} #endif ------------------------------------------------------------------------------ -- Folding ------------------------------------------------------------------------------ -- | A 'Monoid' for a 'Contravariant' 'Applicative'. newtype Folding f a = Folding { getFolding :: f a } instance (Contravariant f, Apply f) => Semigroup (Folding f a) where Folding fr <> Folding fs = Folding (fr .> fs) {-# INLINE (<>) #-} instance (Contravariant f, Applicative f) => Monoid (Folding f a) where mempty = Folding noEffect {-# INLINE mempty #-} Folding fr `mappend` Folding fs = Folding (fr *> fs) {-# INLINE mappend #-} ------------------------------------------------------------------------------ -- Traversed ------------------------------------------------------------------------------ -- | Used internally by 'Control.Lens.Traversal.traverseOf_' and the like. -- -- The argument 'a' of the result should not be used! newtype Traversed a f = Traversed { getTraversed :: f a } instance Apply f => Semigroup (Traversed a f) where Traversed ma <> Traversed mb = Traversed (ma .> mb) {-# INLINE (<>) #-} instance Applicative f => Monoid (Traversed a f) where mempty = Traversed (pure (error "Traversed: value used")) {-# INLINE mempty #-} Traversed ma `mappend` Traversed mb = Traversed (ma *> mb) {-# INLINE mappend #-} ------------------------------------------------------------------------------ -- Sequenced ------------------------------------------------------------------------------ -- | Used internally by 'Control.Lens.Traversal.mapM_' and the like. -- -- The argument 'a' of the result should not be used! newtype Sequenced a m = Sequenced { getSequenced :: m a } instance Apply m => Semigroup (Sequenced a m) where Sequenced ma <> Sequenced mb = Sequenced (ma .> mb) {-# INLINE (<>) #-} instance Monad m => Monoid (Sequenced a m) where mempty = Sequenced (return (error "Sequenced: value used")) {-# INLINE mempty #-} Sequenced ma `mappend` Sequenced mb = Sequenced (ma >> mb) {-# INLINE mappend #-} ------------------------------------------------------------------------------ -- Min ------------------------------------------------------------------------------ -- | Used for 'Control.Lens.Fold.minimumOf'. data Min a = NoMin | Min a instance Ord a => Semigroup (Min a) where NoMin <> m = m m <> NoMin = m Min a <> Min b = Min (min a b) {-# INLINE (<>) #-} instance Ord a => Monoid (Min a) where mempty = NoMin {-# INLINE mempty #-} mappend NoMin m = m mappend m NoMin = m mappend (Min a) (Min b) = Min (min a b) {-# INLINE mappend #-} -- | Obtain the minimum. getMin :: Min a -> Maybe a getMin NoMin = Nothing getMin (Min a) = Just a {-# INLINE getMin #-} ------------------------------------------------------------------------------ -- Max ------------------------------------------------------------------------------ -- | Used for 'Control.Lens.Fold.maximumOf'. data Max a = NoMax | Max a instance Ord a => Semigroup (Max a) where NoMax <> m = m m <> NoMax = m Max a <> Max b = Max (max a b) {-# INLINE (<>) #-} instance Ord a => Monoid (Max a) where mempty = NoMax {-# INLINE mempty #-} mappend NoMax m = m mappend m NoMax = m mappend (Max a) (Max b) = Max (max a b) {-# INLINE mappend #-} -- | Obtain the maximum. getMax :: Max a -> Maybe a getMax NoMax = Nothing getMax (Max a) = Just a {-# INLINE getMax #-} ------------------------------------------------------------------------------ -- Leftmost and Rightmost ------------------------------------------------------------------------------ -- | Used for 'Control.Lens.Fold.preview'. data Leftmost a = LPure | LLeaf a | LStep (Leftmost a) instance Semigroup (Leftmost a) where (<>) = mappend {-# INLINE (<>) #-} instance Monoid (Leftmost a) where mempty = LPure {-# INLINE mempty #-} mappend x y = LStep $ case x of LPure -> y LLeaf _ -> x LStep x' -> case y of -- The last two cases make firstOf produce a Just as soon as any element -- is encountered, and possibly serve as a micro-optimisation; this -- behaviour can be disabled by replacing them with _ -> mappend x y'. -- Note that this means that firstOf (backwards folded) [1..] is Just _|_. LPure -> x' LLeaf a -> LLeaf $ fromMaybe a (getLeftmost x') LStep y' -> mappend x' y' -- | Extract the 'Leftmost' element. This will fairly eagerly determine that it can return 'Just' -- the moment it sees any element at all. getLeftmost :: Leftmost a -> Maybe a getLeftmost LPure = Nothing getLeftmost (LLeaf a) = Just a getLeftmost (LStep x) = getLeftmost x -- | Used for 'Control.Lens.Fold.lastOf'. data Rightmost a = RPure | RLeaf a | RStep (Rightmost a) instance Semigroup (Rightmost a) where (<>) = mappend {-# INLINE (<>) #-} instance Monoid (Rightmost a) where mempty = RPure {-# INLINE mempty #-} mappend x y = RStep $ case y of RPure -> x RLeaf _ -> y RStep y' -> case x of -- The last two cases make lastOf produce a Just as soon as any element -- is encountered, and possibly serve as a micro-optimisation; this -- behaviour can be disabled by replacing them with _ -> mappend x y'. -- Note that this means that lastOf folded [1..] is Just _|_. RPure -> y' RLeaf a -> RLeaf $ fromMaybe a (getRightmost y') RStep x' -> mappend x' y' -- | Extract the 'Rightmost' element. This will fairly eagerly determine that it can return 'Just' -- the moment it sees any element at all. getRightmost :: Rightmost a -> Maybe a getRightmost RPure = Nothing getRightmost (RLeaf a) = Just a getRightmost (RStep x) = getRightmost x lens-4.14/src/Control/Lens/Internal/Getter.hs0000644000000000000000000001044512710476104017251 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Getter -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Getter ( noEffect , AlongsideLeft(..) , AlongsideRight(..) ) where import Control.Applicative import Data.Bifoldable import Data.Bifunctor import Data.Bitraversable import Data.Foldable import Data.Functor.Contravariant import Data.Semigroup.Foldable import Data.Semigroup.Traversable import Data.Traversable import Prelude -- | The 'mempty' equivalent for a 'Contravariant' 'Applicative' 'Functor'. noEffect :: (Contravariant f, Applicative f) => f a noEffect = phantom $ pure () {-# INLINE noEffect #-} newtype AlongsideLeft f b a = AlongsideLeft { getAlongsideLeft :: f (a, b) } deriving instance Show (f (a, b)) => Show (AlongsideLeft f b a) deriving instance Read (f (a, b)) => Read (AlongsideLeft f b a) instance Functor f => Functor (AlongsideLeft f b) where fmap f = AlongsideLeft . fmap (first f) . getAlongsideLeft {-# INLINE fmap #-} instance Contravariant f => Contravariant (AlongsideLeft f b) where contramap f = AlongsideLeft . contramap (first f) . getAlongsideLeft {-# INLINE contramap #-} instance Foldable f => Foldable (AlongsideLeft f b) where foldMap f = foldMap (f . fst) . getAlongsideLeft {-# INLINE foldMap #-} instance Traversable f => Traversable (AlongsideLeft f b) where traverse f (AlongsideLeft as) = AlongsideLeft <$> traverse (bitraverse f pure) as {-# INLINE traverse #-} instance Foldable1 f => Foldable1 (AlongsideLeft f b) where foldMap1 f = foldMap1 (f . fst) . getAlongsideLeft {-# INLINE foldMap1 #-} instance Traversable1 f => Traversable1 (AlongsideLeft f b) where traverse1 f (AlongsideLeft as) = AlongsideLeft <$> traverse1 (\(a,b) -> flip (,) b <$> f a) as {-# INLINE traverse1 #-} instance Functor f => Bifunctor (AlongsideLeft f) where bimap f g = AlongsideLeft . fmap (bimap g f) . getAlongsideLeft {-# INLINE bimap #-} instance Foldable f => Bifoldable (AlongsideLeft f) where bifoldMap f g = foldMap (bifoldMap g f) . getAlongsideLeft {-# INLINE bifoldMap #-} instance Traversable f => Bitraversable (AlongsideLeft f) where bitraverse f g (AlongsideLeft as) = AlongsideLeft <$> traverse (bitraverse g f) as {-# INLINE bitraverse #-} newtype AlongsideRight f a b = AlongsideRight { getAlongsideRight :: f (a, b) } deriving instance Show (f (a, b)) => Show (AlongsideRight f a b) deriving instance Read (f (a, b)) => Read (AlongsideRight f a b) instance Functor f => Functor (AlongsideRight f a) where fmap f (AlongsideRight x) = AlongsideRight (fmap (second f) x) {-# INLINE fmap #-} instance Contravariant f => Contravariant (AlongsideRight f a) where contramap f (AlongsideRight x) = AlongsideRight (contramap (second f) x) {-# INLINE contramap #-} instance Foldable f => Foldable (AlongsideRight f a) where foldMap f = foldMap (f . snd) . getAlongsideRight {-# INLINE foldMap #-} instance Traversable f => Traversable (AlongsideRight f a) where traverse f (AlongsideRight as) = AlongsideRight <$> traverse (bitraverse pure f) as {-# INLINE traverse #-} instance Foldable1 f => Foldable1 (AlongsideRight f a) where foldMap1 f = foldMap1 (f . snd) . getAlongsideRight {-# INLINE foldMap1 #-} instance Traversable1 f => Traversable1 (AlongsideRight f a) where traverse1 f (AlongsideRight as) = AlongsideRight <$> traverse1 (\(a,b) -> (,) a <$> f b) as {-# INLINE traverse1 #-} instance Functor f => Bifunctor (AlongsideRight f) where bimap f g = AlongsideRight . fmap (bimap f g) . getAlongsideRight {-# INLINE bimap #-} instance Foldable f => Bifoldable (AlongsideRight f) where bifoldMap f g = foldMap (bifoldMap f g) . getAlongsideRight {-# INLINE bifoldMap #-} instance Traversable f => Bitraversable (AlongsideRight f) where bitraverse f g (AlongsideRight as) = AlongsideRight <$> traverse (bitraverse f g) as {-# INLINE bitraverse #-} lens-4.14/src/Control/Lens/Internal/Indexed.hs0000644000000000000000000003172612710476104017404 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Indexed -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- Internal implementation details for 'Indexed' lens-likes ---------------------------------------------------------------------------- module Control.Lens.Internal.Indexed ( -- * An Indexed Profunctor Indexed(..) -- * Classes , Conjoined(..) , Indexable(..) -- * Indexing , Indexing(..) , indexing -- * 64-bit Indexing , Indexing64(..) , indexing64 -- * Converting to Folds , withIndex , asIndex ) where import Control.Applicative import Control.Arrow as Arrow import Control.Category import Control.Comonad import Control.Lens.Internal.Instances () import Control.Monad import Control.Monad.Fix import Data.Distributive import Data.Functor.Bind import Data.Functor.Contravariant import Data.Int import Data.Profunctor.Closed import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Traversable import Prelude hiding ((.),id) #ifndef SAFE import Data.Profunctor.Unsafe import Control.Lens.Internal.Coerce #endif ------------------------------------------------------------------------------ -- Conjoined ------------------------------------------------------------------------------ -- | This is a 'Profunctor' that is both 'Corepresentable' by @f@ and 'Representable' by @g@ such -- that @f@ is left adjoint to @g@. From this you can derive a lot of structure due -- to the preservation of limits and colimits. class ( Choice p, Corepresentable p, Comonad (Corep p), Traversable (Corep p) , Strong p, Representable p, Monad (Rep p), MonadFix (Rep p), Distributive (Rep p) , Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p, Closed p ) => Conjoined p where -- | 'Conjoined' is strong enough to let us distribute every 'Conjoined' -- 'Profunctor' over every Haskell 'Functor'. This is effectively a -- generalization of 'fmap'. distrib :: Functor f => p a b -> p (f a) (f b) distrib = tabulate . collect . sieve {-# INLINE distrib #-} -- | This permits us to make a decision at an outermost point about whether or not we use an index. -- -- Ideally any use of this function should be done in such a way so that you compute the same answer, -- but this cannot be enforced at the type level. conjoined :: ((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r conjoined _ r = r {-# INLINE conjoined #-} instance Conjoined (->) where distrib = fmap {-# INLINE distrib #-} conjoined l _ = l {-# INLINE conjoined #-} ---------------------------------------------------------------------------- -- Indexable ---------------------------------------------------------------------------- -- | This class permits overloading of function application for things that -- also admit a notion of a key or index. class Conjoined p => Indexable i p where -- | Build a function from an 'indexed' function. indexed :: p a b -> i -> a -> b instance Indexable i (->) where indexed = const {-# INLINE indexed #-} ----------------------------------------------------------------------------- -- Indexed Internals ----------------------------------------------------------------------------- -- | A function with access to a index. This constructor may be useful when you need to store -- an 'Indexable' in a container to avoid @ImpredicativeTypes@. -- -- @index :: Indexed i a b -> i -> a -> b@ newtype Indexed i a b = Indexed { runIndexed :: i -> a -> b } instance Functor (Indexed i a) where fmap g (Indexed f) = Indexed $ \i a -> g (f i a) {-# INLINE fmap #-} instance Apply (Indexed i a) where Indexed f <.> Indexed g = Indexed $ \i a -> f i a (g i a) {-# INLINE (<.>) #-} instance Applicative (Indexed i a) where pure b = Indexed $ \_ _ -> b {-# INLINE pure #-} Indexed f <*> Indexed g = Indexed $ \i a -> f i a (g i a) {-# INLINE (<*>) #-} instance Bind (Indexed i a) where Indexed f >>- k = Indexed $ \i a -> runIndexed (k (f i a)) i a {-# INLINE (>>-) #-} instance Monad (Indexed i a) where return = pure {-# INLINE return #-} Indexed f >>= k = Indexed $ \i a -> runIndexed (k (f i a)) i a {-# INLINE (>>=) #-} instance MonadFix (Indexed i a) where mfix f = Indexed $ \ i a -> let o = runIndexed (f o) i a in o {-# INLINE mfix #-} instance Profunctor (Indexed i) where dimap ab cd ibc = Indexed $ \i -> cd . runIndexed ibc i . ab {-# INLINE dimap #-} lmap ab ibc = Indexed $ \i -> runIndexed ibc i . ab {-# INLINE lmap #-} rmap bc iab = Indexed $ \i -> bc . runIndexed iab i {-# INLINE rmap #-} #ifndef SAFE ( .# ) ibc _ = coerce ibc {-# INLINE ( .# ) #-} ( #. ) _ = coerce' {-# INLINE ( #. ) #-} #endif instance Closed (Indexed i) where closed (Indexed iab) = Indexed $ \i xa x -> iab i (xa x) instance Costrong (Indexed i) where unfirst (Indexed iadbd) = Indexed $ \i a -> let (b, d) = iadbd i (a, d) in b instance Sieve (Indexed i) ((->) i) where sieve = flip . runIndexed {-# INLINE sieve #-} instance Representable (Indexed i) where type Rep (Indexed i) = (->) i tabulate = Indexed . flip {-# INLINE tabulate #-} instance Cosieve (Indexed i) ((,) i) where cosieve = uncurry . runIndexed {-# INLINE cosieve #-} instance Corepresentable (Indexed i) where type Corep (Indexed i) = (,) i cotabulate = Indexed . curry {-# INLINE cotabulate #-} instance Choice (Indexed i) where right' = right {-# INLINE right' #-} instance Strong (Indexed i) where second' = second {-# INLINE second' #-} instance Category (Indexed i) where id = Indexed (const id) {-# INLINE id #-} Indexed f . Indexed g = Indexed $ \i -> f i . g i {-# INLINE (.) #-} instance Arrow (Indexed i) where arr f = Indexed (\_ -> f) {-# INLINE arr #-} first f = Indexed (Arrow.first . runIndexed f) {-# INLINE first #-} second f = Indexed (Arrow.second . runIndexed f) {-# INLINE second #-} Indexed f *** Indexed g = Indexed $ \i -> f i *** g i {-# INLINE (***) #-} Indexed f &&& Indexed g = Indexed $ \i -> f i &&& g i {-# INLINE (&&&) #-} instance ArrowChoice (Indexed i) where left f = Indexed (left . runIndexed f) {-# INLINE left #-} right f = Indexed (right . runIndexed f) {-# INLINE right #-} Indexed f +++ Indexed g = Indexed $ \i -> f i +++ g i {-# INLINE (+++) #-} Indexed f ||| Indexed g = Indexed $ \i -> f i ||| g i {-# INLINE (|||) #-} instance ArrowApply (Indexed i) where app = Indexed $ \ i (f, b) -> runIndexed f i b {-# INLINE app #-} instance ArrowLoop (Indexed i) where loop (Indexed f) = Indexed $ \i b -> let (c,d) = f i (b, d) in c {-# INLINE loop #-} instance Conjoined (Indexed i) where distrib (Indexed iab) = Indexed $ \i fa -> iab i <$> fa {-# INLINE distrib #-} instance i ~ j => Indexable i (Indexed j) where indexed = runIndexed {-# INLINE indexed #-} ------------------------------------------------------------------------------ -- Indexing ------------------------------------------------------------------------------ -- | 'Applicative' composition of @'Control.Monad.Trans.State.Lazy.State' 'Int'@ with a 'Functor', used -- by 'Control.Lens.Indexed.indexed'. newtype Indexing f a = Indexing { runIndexing :: Int -> (Int, f a) } instance Functor f => Functor (Indexing f) where fmap f (Indexing m) = Indexing $ \i -> case m i of (j, x) -> (j, fmap f x) {-# INLINE fmap #-} instance Apply f => Apply (Indexing f) where Indexing mf <.> Indexing ma = Indexing $ \i -> case mf i of (j, ff) -> case ma j of ~(k, fa) -> (k, ff <.> fa) {-# INLINE (<.>) #-} instance Applicative f => Applicative (Indexing f) where pure x = Indexing $ \i -> (i, pure x) {-# INLINE pure #-} Indexing mf <*> Indexing ma = Indexing $ \i -> case mf i of (j, ff) -> case ma j of ~(k, fa) -> (k, ff <*> fa) {-# INLINE (<*>) #-} instance Contravariant f => Contravariant (Indexing f) where contramap f (Indexing m) = Indexing $ \i -> case m i of (j, ff) -> (j, contramap f ff) {-# INLINE contramap #-} -- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or -- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc. -- -- @ -- 'indexing' :: 'Control.Lens.Type.Traversal' s t a b -> 'Control.Lens.Type.IndexedTraversal' 'Int' s t a b -- 'indexing' :: 'Control.Lens.Type.Prism' s t a b -> 'Control.Lens.Type.IndexedTraversal' 'Int' s t a b -- 'indexing' :: 'Control.Lens.Type.Lens' s t a b -> 'Control.Lens.Type.IndexedLens' 'Int' s t a b -- 'indexing' :: 'Control.Lens.Type.Iso' s t a b -> 'Control.Lens.Type.IndexedLens' 'Int' s t a b -- 'indexing' :: 'Control.Lens.Type.Fold' s a -> 'Control.Lens.Type.IndexedFold' 'Int' s a -- 'indexing' :: 'Control.Lens.Type.Getter' s a -> 'Control.Lens.Type.IndexedGetter' 'Int' s a -- @ -- -- @'indexing' :: 'Indexable' 'Int' p => 'Control.Lens.Type.LensLike' ('Indexing' f) s t a b -> 'Control.Lens.Type.Over' p f s t a b@ indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t indexing l iafb s = snd $ runIndexing (l (\a -> Indexing (\i -> i `seq` (i + 1, indexed iafb i a))) s) 0 {-# INLINE indexing #-} ------------------------------------------------------------------------------ -- Indexing64 ------------------------------------------------------------------------------ -- | 'Applicative' composition of @'Control.Monad.Trans.State.Lazy.State' 'Int64'@ with a 'Functor', used -- by 'Control.Lens.Indexed.indexed64'. newtype Indexing64 f a = Indexing64 { runIndexing64 :: Int64 -> (Int64, f a) } instance Functor f => Functor (Indexing64 f) where fmap f (Indexing64 m) = Indexing64 $ \i -> case m i of (j, x) -> (j, fmap f x) {-# INLINE fmap #-} instance Apply f => Apply (Indexing64 f) where Indexing64 mf <.> Indexing64 ma = Indexing64 $ \i -> case mf i of (j, ff) -> case ma j of ~(k, fa) -> (k, ff <.> fa) {-# INLINE (<.>) #-} instance Applicative f => Applicative (Indexing64 f) where pure x = Indexing64 $ \i -> (i, pure x) {-# INLINE pure #-} Indexing64 mf <*> Indexing64 ma = Indexing64 $ \i -> case mf i of (j, ff) -> case ma j of ~(k, fa) -> (k, ff <*> fa) {-# INLINE (<*>) #-} instance Contravariant f => Contravariant (Indexing64 f) where contramap f (Indexing64 m) = Indexing64 $ \i -> case m i of (j, ff) -> (j, contramap f ff) {-# INLINE contramap #-} -- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or -- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc. -- -- This combinator is like 'indexing' except that it handles large traversals and folds gracefully. -- -- @ -- 'indexing64' :: 'Control.Lens.Type.Traversal' s t a b -> 'Control.Lens.Type.IndexedTraversal' 'Int64' s t a b -- 'indexing64' :: 'Control.Lens.Type.Prism' s t a b -> 'Control.Lens.Type.IndexedTraversal' 'Int64' s t a b -- 'indexing64' :: 'Control.Lens.Type.Lens' s t a b -> 'Control.Lens.Type.IndexedLens' 'Int64' s t a b -- 'indexing64' :: 'Control.Lens.Type.Iso' s t a b -> 'Control.Lens.Type.IndexedLens' 'Int64' s t a b -- 'indexing64' :: 'Control.Lens.Type.Fold' s a -> 'Control.Lens.Type.IndexedFold' 'Int64' s a -- 'indexing64' :: 'Control.Lens.Type.Getter' s a -> 'Control.Lens.Type.IndexedGetter' 'Int64' s a -- @ -- -- @'indexing64' :: 'Indexable' 'Int64' p => 'Control.Lens.Type.LensLike' ('Indexing64' f) s t a b -> 'Control.Lens.Type.Over' p f s t a b@ indexing64 :: Indexable Int64 p => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> p a (f b) -> s -> f t indexing64 l iafb s = snd $ runIndexing64 (l (\a -> Indexing64 (\i -> i `seq` (i + 1, indexed iafb i a))) s) 0 {-# INLINE indexing64 #-} ------------------------------------------------------------------------------- -- Converting to Folds ------------------------------------------------------------------------------- -- | Fold a container with indices returning both the indices and the values. -- -- The result is only valid to compose in a 'Traversal', if you don't edit the -- index as edits to the index have no effect. withIndex :: (Indexable i p, Functor f) => p (i, s) (f (j, t)) -> Indexed i s (f t) withIndex f = Indexed $ \i a -> snd <$> indexed f i (i, a) {-# INLINE withIndex #-} -- | When composed with an 'IndexedFold' or 'IndexedTraversal' this yields an -- ('Indexed') 'Fold' of the indices. asIndex :: (Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s) asIndex f = Indexed $ \i _ -> phantom (indexed f i i) {-# INLINE asIndex #-} lens-4.14/src/Control/Lens/Internal/Instances.hs0000644000000000000000000000147612710476104017752 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #ifndef MIN_VERSION_semigroupoids #define MIN_VERSION_semigroupoids(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Instances -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module includes orphan instances for @(,)@, 'Either' and 'Const' that -- should be supplied by base. These have moved to @semigroupoids@ as of 4.2. ---------------------------------------------------------------------------- module Control.Lens.Internal.Instances () where import Data.Orphans () import Data.Traversable.Instances () lens-4.14/src/Control/Lens/Internal/Iso.hs0000644000000000000000000000575712710476104016563 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Iso -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Iso ( Exchange(..) , Reversing(..) ) where import Data.Profunctor #ifndef SAFE import Data.Profunctor.Unsafe import Control.Lens.Internal.Coerce #endif import Data.ByteString as StrictB import Data.ByteString.Lazy as LazyB import Data.List.NonEmpty as NonEmpty import Data.Text as StrictT import Data.Text.Lazy as LazyT import Data.Vector as Vector import Data.Vector.Primitive as Prim import Data.Vector.Storable as Storable import Data.Vector.Unboxed as Unbox import Data.Sequence as Seq ------------------------------------------------------------------------------ -- Isomorphism: Exchange ------------------------------------------------------------------------------ -- | This is used internally by the 'Control.Lens.Iso.Iso' code to provide -- efficient access to the two functions that make up an isomorphism. data Exchange a b s t = Exchange (s -> a) (b -> t) instance Functor (Exchange a b s) where fmap f (Exchange sa bt) = Exchange sa (f . bt) {-# INLINE fmap #-} instance Profunctor (Exchange a b) where dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt) {-# INLINE dimap #-} lmap f (Exchange sa bt) = Exchange (sa . f) bt {-# INLINE lmap #-} rmap f (Exchange sa bt) = Exchange sa (f . bt) {-# INLINE rmap #-} #ifndef SAFE ( #. ) _ = coerce' {-# INLINE ( #. ) #-} ( .# ) p _ = coerce p {-# INLINE ( .# ) #-} #endif ------------------------------------------------------------------------------ -- Reversible ------------------------------------------------------------------------------ -- | This class provides a generalized notion of list reversal extended to other containers. class Reversing t where reversing :: t -> t instance Reversing [a] where reversing = Prelude.reverse instance Reversing (NonEmpty.NonEmpty a) where reversing = NonEmpty.reverse instance Reversing StrictB.ByteString where reversing = StrictB.reverse instance Reversing LazyB.ByteString where reversing = LazyB.reverse instance Reversing StrictT.Text where reversing = StrictT.reverse instance Reversing LazyT.Text where reversing = LazyT.reverse instance Reversing (Vector.Vector a) where reversing = Vector.reverse instance Reversing (Seq a) where reversing = Seq.reverse instance Prim a => Reversing (Prim.Vector a) where reversing = Prim.reverse instance Unbox a => Reversing (Unbox.Vector a) where reversing = Unbox.reverse instance Storable a => Reversing (Storable.Vector a) where reversing = Storable.reverse lens-4.14/src/Control/Lens/Internal/Level.hs0000644000000000000000000001343412710476104017067 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Level -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module provides implementation details of the combinators in -- "Control.Lens.Level", which provides for the breadth-first 'Control.Lens.Traversal.Traversal' of -- an arbitrary 'Control.Lens.Traversal.Traversal'. ---------------------------------------------------------------------------- module Control.Lens.Internal.Level ( -- * Levels Level(..) , Deepening(..), deepening , Flows(..) ) where import Control.Applicative import Control.Category import Control.Comonad import Data.Foldable import Data.Functor.Apply import Data.Int import Data.Semigroup import Data.Traversable import Data.Word import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- Levels ------------------------------------------------------------------------------ -- | This data type represents a path-compressed copy of one level of a source -- data structure. We can safely use path-compression because we know the depth -- of the tree. -- -- Path compression is performed by viewing a 'Level' as a PATRICIA trie of the -- paths into the structure to leaves at a given depth, similar in many ways -- to a 'Data.IntMap.IntMap', but unlike a regular PATRICIA trie we do not need -- to store the mask bits merely the depth of the fork. -- -- One invariant of this structure is that underneath a 'Two' node you will not -- find any 'Zero' nodes, so 'Zero' can only occur at the root. data Level i a = Two {-# UNPACK #-} !Word !(Level i a) !(Level i a) | One i a | Zero deriving (Eq,Ord,Show,Read) -- | Append a pair of 'Level' values to get a new 'Level' with path compression. -- -- As the 'Level' type is user-visible, we do not expose this as an illegal -- 'Semigroup' instance, and just use it directly in 'Deepening' as needed. lappend :: Level i a -> Level i a -> Level i a lappend Zero Zero = Zero lappend Zero r@One{} = r lappend l@One{} Zero = l lappend Zero (Two n l r) = Two (n + 1) l r lappend (Two n l r) Zero = Two (n + 1) l r lappend l r = Two 0 l r {-# INLINE lappend #-} instance Functor (Level i) where fmap f = go where go (Two n l r) = Two n (go l) (go r) go (One i a) = One i (f a) go Zero = Zero {-# INLINE fmap #-} instance Foldable (Level i) where foldMap f = go where go (Two _ l r) = go l `mappend` go r go (One _ a) = f a go Zero = mempty {-# INLINE foldMap #-} instance Traversable (Level i) where traverse f = go where go (Two n l r) = Two n <$> go l <*> go r go (One i a) = One i <$> f a go Zero = pure Zero {-# INLINE traverse #-} ------------------------------------------------------------------------------ -- Generating Levels ------------------------------------------------------------------------------ -- | This is an illegal 'Monoid' used to construct a single 'Level'. newtype Deepening i a = Deepening { runDeepening :: forall r. Int -> (Level i a -> Bool -> r) -> r } instance Semigroup (Deepening i a) where Deepening l <> Deepening r = Deepening $ \ n k -> case n of 0 -> k Zero True _ -> let n' = n - 1 in l n' $ \x a -> r n' $ \y b -> k (lappend x y) (a || b) {-# INLINE (<>) #-} -- | This is an illegal 'Monoid'. instance Monoid (Deepening i a) where mempty = Deepening $ \ _ k -> k Zero False {-# INLINE mempty #-} mappend (Deepening l) (Deepening r) = Deepening $ \ n k -> case n of 0 -> k Zero True _ -> let n' = n - 1 in l n' $ \x a -> r n' $ \y b -> k (lappend x y) (a || b) {-# INLINE mappend #-} -- | Generate the leaf of a given 'Deepening' based on whether or not we're at the correct depth. deepening :: i -> a -> Deepening i a deepening i a = Deepening $ \n k -> k (if n == 0 then One i a else Zero) False {-# INLINE deepening #-} ------------------------------------------------------------------------------ -- Reassembling Levels ------------------------------------------------------------------------------ -- | This is an illegal 'Applicative' used to replace the contents of a list of consecutive 'Level' values -- representing each layer of a structure into the original shape that they were derived from. -- -- Attempting to 'Flow' something back into a shape other than the one it was taken from will fail. newtype Flows i b a = Flows { runFlows :: [Level i b] -> a } instance Functor (Flows i b) where fmap f (Flows g) = Flows (f . g) {-# INLINE fmap #-} -- | Walk down one constructor in a 'Level', veering left. triml :: Level i b -> Level i b triml (Two 0 l _) = l triml (Two n l r) = Two (n - 1) l r triml x = x {-# INLINE triml #-} -- | Walk down one constructor in a 'Level', veering right. trimr :: Level i b -> Level i b trimr (Two 0 _ r) = r trimr (Two n l r) = Two (n - 1) l r trimr x = x {-# INLINE trimr #-} instance Apply (Flows i b) where Flows mf <.> Flows ma = Flows $ \ xss -> case xss of [] -> mf [] (ma []) (_:xs) -> mf (triml <$> xs) $ ma (trimr <$> xs) {-# INLINE (<.>) #-} -- | This is an illegal 'Applicative'. instance Applicative (Flows i b) where pure a = Flows (const a) {-# INLINE pure #-} Flows mf <*> Flows ma = Flows $ \ xss -> case xss of [] -> mf [] (ma []) (_:xs) -> mf (triml <$> xs) $ ma (trimr <$> xs) {-# INLINE (<*>) #-} lens-4.14/src/Control/Lens/Internal/List.hs0000644000000000000000000000257112710476104016733 0ustar0000000000000000------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.List -- Copyright : (C) 2014-2016 Edward Kmett and Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- -- This module provides utility functions on lists used by the library -- implementation. ------------------------------------------------------------------------------- module Control.Lens.Internal.List ( ordinalNub ) where import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet {-# ANN module "HLint: ignore Redundant bracket" #-} -- | Return the the subset of given ordinals within a given bound -- and in order of the first occurrence seen. -- -- Bound: @0 <= x < l@ -- -- >>> ordinalNub 3 [-1,2,1,4,2,3] -- [2,1] ordinalNub :: Int {- ^ strict upper bound -} -> [Int] {- ^ ordinals -} -> [Int] {- ^ unique, in-bound ordinals, in order seen -} ordinalNub l xs = foldr (ordinalNubHelper l) (const []) xs IntSet.empty ordinalNubHelper :: Int -> Int -> (IntSet -> [Int]) -> (IntSet -> [Int]) ordinalNubHelper l x next seen | outOfBounds || notUnique = next seen | otherwise = x : next (IntSet.insert x seen) where outOfBounds = x < 0 || l <= x notUnique = x `IntSet.member` seen lens-4.14/src/Control/Lens/Internal/Magma.hs0000644000000000000000000002256512710476104017047 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE RoleAnnotations #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Magma -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Magma ( -- * Magma Magma(..) , runMagma -- * Molten , Molten(..) -- * Mafic , Mafic(..) , runMafic -- * TakingWhile , TakingWhile(..) , runTakingWhile ) where import Control.Applicative import Control.Category import Control.Comonad import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed import Data.Foldable import Data.Functor.Apply import Data.Functor.Contravariant import Data.Monoid import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Profunctor.Unsafe import Data.Traversable import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- Magma ------------------------------------------------------------------------------ -- | This provides a way to peek at the internal structure of a -- 'Control.Lens.Traversal.Traversal' or 'Control.Lens.Traversal.IndexedTraversal' data Magma i t b a where MagmaAp :: Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a MagmaPure :: x -> Magma i x b a MagmaFmap :: (x -> y) -> Magma i x b a -> Magma i y b a Magma :: i -> a -> Magma i b b a #if __GLASGOW_HASKELL__ >= 707 -- note the 3rd argument infers as phantom, but that would be unsound type role Magma representational nominal nominal nominal #endif instance Functor (Magma i t b) where fmap f (MagmaAp x y) = MagmaAp (fmap f x) (fmap f y) fmap _ (MagmaPure x) = MagmaPure x fmap f (MagmaFmap xy x) = MagmaFmap xy (fmap f x) fmap f (Magma i a) = Magma i (f a) instance Foldable (Magma i t b) where foldMap f (MagmaAp x y) = foldMap f x `mappend` foldMap f y foldMap _ MagmaPure{} = mempty foldMap f (MagmaFmap _ x) = foldMap f x foldMap f (Magma _ a) = f a instance Traversable (Magma i t b) where traverse f (MagmaAp x y) = MagmaAp <$> traverse f x <*> traverse f y traverse _ (MagmaPure x) = pure (MagmaPure x) traverse f (MagmaFmap xy x) = MagmaFmap xy <$> traverse f x traverse f (Magma i a) = Magma i <$> f a instance (Show i, Show a) => Show (Magma i t b a) where showsPrec d (MagmaAp x y) = showParen (d > 4) $ showsPrec 4 x . showString " <*> " . showsPrec 5 y showsPrec d (MagmaPure _) = showParen (d > 10) $ showString "pure .." showsPrec d (MagmaFmap _ x) = showParen (d > 4) $ showString ".. <$> " . showsPrec 5 x showsPrec d (Magma i a) = showParen (d > 10) $ showString "Magma " . showsPrec 11 i . showChar ' ' . showsPrec 11 a -- | Run a 'Magma' where all the individual leaves have been converted to the -- expected type runMagma :: Magma i t a a -> t runMagma (MagmaAp l r) = runMagma l (runMagma r) runMagma (MagmaFmap f r) = f (runMagma r) runMagma (MagmaPure x) = x runMagma (Magma _ a) = a ------------------------------------------------------------------------------ -- Molten ------------------------------------------------------------------------------ -- | This is a a non-reassociating initially encoded version of 'Bazaar'. newtype Molten i a b t = Molten { runMolten :: Magma i t b a } instance Functor (Molten i a b) where fmap f (Molten xs) = Molten (MagmaFmap f xs) {-# INLINE fmap #-} instance Apply (Molten i a b) where (<.>) = (<*>) {-# INLINE (<.>) #-} instance Applicative (Molten i a b) where pure = Molten #. MagmaPure {-# INLINE pure #-} Molten xs <*> Molten ys = Molten (MagmaAp xs ys) {-# INLINE (<*>) #-} instance Sellable (Indexed i) (Molten i) where sell = Indexed (\i -> Molten #. Magma i) {-# INLINE sell #-} instance Bizarre (Indexed i) (Molten i) where bazaar f (Molten (MagmaAp x y)) = bazaar f (Molten x) <*> bazaar f (Molten y) bazaar f (Molten (MagmaFmap g x)) = g <$> bazaar f (Molten x) bazaar _ (Molten (MagmaPure x)) = pure x bazaar f (Molten (Magma i a)) = indexed f i a instance IndexedFunctor (Molten i) where ifmap f (Molten xs) = Molten (MagmaFmap f xs) {-# INLINE ifmap #-} instance IndexedComonad (Molten i) where iextract (Molten (MagmaAp x y)) = iextract (Molten x) (iextract (Molten y)) iextract (Molten (MagmaFmap f y)) = f (iextract (Molten y)) iextract (Molten (MagmaPure x)) = x iextract (Molten (Magma _ a)) = a iduplicate (Molten (Magma i a)) = Molten #. Magma i <$> Molten (Magma i a) iduplicate (Molten (MagmaPure x)) = pure (pure x) iduplicate (Molten (MagmaFmap f y)) = iextend (fmap f) (Molten y) iduplicate (Molten (MagmaAp x y)) = iextend (<*>) (Molten x) <*> iduplicate (Molten y) iextend k (Molten (Magma i a)) = (k .# Molten) . Magma i <$> Molten (Magma i a) iextend k (Molten (MagmaPure x)) = pure (k (pure x)) iextend k (Molten (MagmaFmap f y)) = iextend (k . fmap f) (Molten y) iextend k (Molten (MagmaAp x y)) = iextend (\x' y' -> k $ x' <*> y') (Molten x) <*> iduplicate (Molten y) instance a ~ b => Comonad (Molten i a b) where extract = iextract {-# INLINE extract #-} extend = iextend {-# INLINE extend #-} duplicate = iduplicate {-# INLINE duplicate #-} ------------------------------------------------------------------------------ -- Mafic ------------------------------------------------------------------------------ -- | This is used to generate an indexed magma from an unindexed source -- -- By constructing it this way we avoid infinite reassociations in sums where possible. data Mafic a b t = Mafic Int (Int -> Magma Int t b a) -- | Generate a 'Magma' using from a prefix sum. runMafic :: Mafic a b t -> Magma Int t b a runMafic (Mafic _ k) = k 0 instance Functor (Mafic a b) where fmap f (Mafic w k) = Mafic w (MagmaFmap f . k) {-# INLINE fmap #-} instance Apply (Mafic a b) where Mafic wf mf <.> ~(Mafic wa ma) = Mafic (wf + wa) $ \o -> MagmaAp (mf o) (ma (o + wf)) {-# INLINE (<.>) #-} instance Applicative (Mafic a b) where pure a = Mafic 0 $ \_ -> MagmaPure a {-# INLINE pure #-} Mafic wf mf <*> ~(Mafic wa ma) = Mafic (wf + wa) $ \o -> MagmaAp (mf o) (ma (o + wf)) {-# INLINE (<*>) #-} instance Sellable (->) Mafic where sell a = Mafic 1 $ \ i -> Magma i a {-# INLINE sell #-} instance Bizarre (Indexed Int) Mafic where bazaar (pafb :: Indexed Int a (f b)) (Mafic _ k) = go (k 0) where go :: Magma Int t b a -> f t go (MagmaAp x y) = go x <*> go y go (MagmaFmap f x) = f <$> go x go (MagmaPure x) = pure x go (Magma i a) = indexed pafb (i :: Int) a {-# INLINE bazaar #-} instance IndexedFunctor Mafic where ifmap f (Mafic w k) = Mafic w (MagmaFmap f . k) {-# INLINE ifmap #-} ------------------------------------------------------------------------------ -- TakingWhile ------------------------------------------------------------------------------ -- | This is used to generate an indexed magma from an unindexed source -- -- By constructing it this way we avoid infinite reassociations where possible. -- -- In @'TakingWhile' p g a b t@, @g@ has a @nominal@ role to avoid exposing an illegal _|_ via 'Contravariant', -- while the remaining arguments are degraded to a @nominal@ role by the invariants of 'Magma' data TakingWhile p (g :: * -> *) a b t = TakingWhile Bool t (Bool -> Magma () t b (Corep p a)) #if __GLASGOW_HASKELL__ >= 707 type role TakingWhile nominal nominal nominal nominal nominal #endif -- | Generate a 'Magma' with leaves only while the predicate holds from left to right. runTakingWhile :: TakingWhile p f a b t -> Magma () t b (Corep p a) runTakingWhile (TakingWhile _ _ k) = k True instance Functor (TakingWhile p f a b) where fmap f (TakingWhile w t k) = let ft = f t in TakingWhile w ft $ \b -> if b then MagmaFmap f (k b) else MagmaPure ft {-# INLINE fmap #-} instance Apply (TakingWhile p f a b) where TakingWhile wf tf mf <.> ~(TakingWhile wa ta ma) = TakingWhile (wf && wa) (tf ta) $ \o -> if o then MagmaAp (mf True) (ma wf) else MagmaPure (tf ta) {-# INLINE (<.>) #-} instance Applicative (TakingWhile p f a b) where pure a = TakingWhile True a $ \_ -> MagmaPure a {-# INLINE pure #-} TakingWhile wf tf mf <*> ~(TakingWhile wa ta ma) = TakingWhile (wf && wa) (tf ta) $ \o -> if o then MagmaAp (mf True) (ma wf) else MagmaPure (tf ta) {-# INLINE (<*>) #-} instance Corepresentable p => Bizarre p (TakingWhile p g) where bazaar (pafb :: p a (f b)) ~(TakingWhile _ _ k) = go (k True) where go :: Magma () t b (Corep p a) -> f t go (MagmaAp x y) = go x <*> go y go (MagmaFmap f x) = f <$> go x go (MagmaPure x) = pure x go (Magma _ wa) = cosieve pafb wa {-# INLINE bazaar #-} -- This constraint is unused intentionally, it protects TakingWhile instance Contravariant f => Contravariant (TakingWhile p f a b) where contramap _ = (<$) (error "contramap: TakingWhile") {-# INLINE contramap #-} instance IndexedFunctor (TakingWhile p f) where ifmap = fmap {-# INLINE ifmap #-} lens-4.14/src/Control/Lens/Internal/Prism.hs0000644000000000000000000000403612710476104017110 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Prism -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Prism ( Market(..) , Market' ) where import Data.Profunctor #ifndef SAFE import Data.Profunctor.Unsafe import Control.Lens.Internal.Coerce #endif ------------------------------------------------------------------------------ -- Prism: Market ------------------------------------------------------------------------------ -- | This type is used internally by the 'Control.Lens.Prism.Prism' code to -- provide efficient access to the two parts of a 'Prism'. data Market a b s t = Market (b -> t) (s -> Either t a) -- | @type 'Market'' a s t = 'Market' a a s t@ type Market' a = Market a a instance Functor (Market a b s) where fmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta) {-# INLINE fmap #-} instance Profunctor (Market a b) where dimap f g (Market bt seta) = Market (g . bt) (either (Left . g) Right . seta . f) {-# INLINE dimap #-} lmap f (Market bt seta) = Market bt (seta . f) {-# INLINE lmap #-} rmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta) {-# INLINE rmap #-} #ifndef SAFE ( #. ) _ = coerce' {-# INLINE ( #. ) #-} ( .# ) p _ = coerce p {-# INLINE ( .# ) #-} #endif instance Choice (Market a b) where left' (Market bt seta) = Market (Left . bt) $ \sc -> case sc of Left s -> case seta s of Left t -> Left (Left t) Right a -> Right a Right c -> Left (Right c) {-# INLINE left' #-} right' (Market bt seta) = Market (Right . bt) $ \cs -> case cs of Left c -> Left (Left c) Right s -> case seta s of Left t -> Left (Right t) Right a -> Right a {-# INLINE right' #-} lens-4.14/src/Control/Lens/Internal/PrismTH.hs0000644000000000000000000003703712710476104017353 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_template_haskell #define MIN_VERSION_template_haskell(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.PrismTH -- Copyright : (C) 2014-2016 Edward Kmett and Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ----------------------------------------------------------------------------- module Control.Lens.Internal.PrismTH ( makePrisms , makeClassyPrisms , makeDecPrisms ) where import Control.Applicative import Control.Lens.Getter import Control.Lens.Internal.TH import Control.Lens.Lens import Control.Lens.Setter import Control.Lens.Tuple import Control.Monad import Data.Char (isUpper) import Data.List import Data.Monoid import Data.Set.Lens import Data.Traversable import Language.Haskell.TH import Language.Haskell.TH.Lens import qualified Data.Map as Map import qualified Data.Set as Set import Prelude -- | Generate a 'Prism' for each constructor of a data type. -- Isos generated when possible. -- Reviews are created for constructors with existentially -- quantified constructors and GADTs. -- -- /e.g./ -- -- @ -- data FooBarBaz a -- = Foo Int -- | Bar a -- | Baz Int Char -- makePrisms ''FooBarBaz -- @ -- -- will create -- -- @ -- _Foo :: Prism' (FooBarBaz a) Int -- _Bar :: Prism (FooBarBaz a) (FooBarBaz b) a b -- _Baz :: Prism' (FooBarBaz a) (Int, Char) -- @ makePrisms :: Name {- ^ Type constructor name -} -> DecsQ makePrisms = makePrisms' True -- | Generate a 'Prism' for each constructor of a data type -- and combine them into a single class. No Isos are created. -- Reviews are created for constructors with existentially -- quantified constructors and GADTs. -- -- /e.g./ -- -- @ -- data FooBarBaz a -- = Foo Int -- | Bar a -- | Baz Int Char -- makeClassyPrisms ''FooBarBaz -- @ -- -- will create -- -- @ -- class AsFooBarBaz s a | s -> a where -- _FooBarBaz :: Prism' s (FooBarBaz a) -- _Foo :: Prism' s Int -- _Bar :: Prism' s a -- _Baz :: Prism' s (Int,Char) -- -- _Foo = _FooBarBaz . _Foo -- _Bar = _FooBarBaz . _Bar -- _Baz = _FooBarBaz . _Baz -- -- instance AsFooBarBaz (FooBarBaz a) a -- @ -- -- Generate an "As" class of prisms. Names are selected by prefixing the constructor -- name with an underscore. Constructors with multiple fields will -- construct Prisms to tuples of those fields. makeClassyPrisms :: Name {- ^ Type constructor name -} -> DecsQ makeClassyPrisms = makePrisms' False -- | Main entry point into Prism generation for a given type constructor name. makePrisms' :: Bool -> Name -> DecsQ makePrisms' normal typeName = do info <- reify typeName case info of TyConI dec -> makeDecPrisms normal dec _ -> fail "makePrisms: expected type constructor name" -- | Generate prisms for the given 'Dec' makeDecPrisms :: Bool {- ^ generate top-level definitions -} -> Dec -> DecsQ makeDecPrisms normal dec = case dec of #if MIN_VERSION_template_haskell(2,11,0) DataD _ ty vars _ cons _ -> next ty (convertTVBs vars) cons NewtypeD _ ty vars _ con _ -> next ty (convertTVBs vars) [con] DataInstD _ ty tys _ cons _ -> next ty tys cons NewtypeInstD _ ty tys _ con _ -> next ty tys [con] #else DataD _ ty vars cons _ -> next ty (convertTVBs vars) cons NewtypeD _ ty vars con _ -> next ty (convertTVBs vars) [con] DataInstD _ ty tys cons _ -> next ty tys cons NewtypeInstD _ ty tys con _ -> next ty tys [con] #endif _ -> fail "makePrisms: expected type constructor dec" where convertTVBs = map (VarT . bndrName) next ty args cons = makeConsPrisms (conAppsT ty args) (concatMap normalizeCon cons) cls where cls | normal = Nothing | otherwise = Just ty -- | Generate prisms for the given type, normalized constructors, and -- an optional name to be used for generating a prism class. -- This function dispatches between Iso generation, normal top-level -- prisms, and classy prisms. makeConsPrisms :: Type -> [NCon] -> Maybe Name -> DecsQ -- special case: single constructor, not classy -> make iso makeConsPrisms t [con@(NCon _ Nothing _)] Nothing = makeConIso t con -- top-level definitions makeConsPrisms t cons Nothing = fmap concat $ for cons $ \con -> do let conName = view nconName con stab <- computeOpticType t cons con let n = prismName conName sequenceA [ sigD n (close (stabToType stab)) , valD (varP n) (normalB (makeConOpticExp stab cons con)) [] ] -- classy prism class and instance makeConsPrisms t cons (Just typeName) = sequenceA [ makeClassyPrismClass t className methodName cons , makeClassyPrismInstance t className methodName cons ] where className = mkName ("As" ++ nameBase typeName) methodName = prismName typeName data OpticType = PrismType | ReviewType data Stab = Stab Cxt OpticType Type Type Type Type simplifyStab :: Stab -> Stab simplifyStab (Stab cx ty _ t _ b) = Stab cx ty t t b b -- simplification uses t and b because those types -- are interesting in the Review case stabSimple :: Stab -> Bool stabSimple (Stab _ _ s t a b) = s == t && a == b stabToType :: Stab -> Type stabToType stab@(Stab cx ty s t a b) = ForallT vs cx $ case ty of PrismType | stabSimple stab -> prism'TypeName `conAppsT` [t,b] | otherwise -> prismTypeName `conAppsT` [s,t,a,b] ReviewType -> reviewTypeName `conAppsT` [t,b] where vs = map PlainTV (Set.toList (setOf typeVars cx)) stabType :: Stab -> OpticType stabType (Stab _ o _ _ _ _) = o computeOpticType :: Type -> [NCon] -> NCon -> Q Stab computeOpticType t cons con = do let cons' = delete con cons case view nconCxt con of Just xs -> computeReviewType t xs (view nconTypes con) Nothing -> computePrismType t cons' con computeReviewType :: Type -> Cxt -> [Type] -> Q Stab computeReviewType s' cx tys = do let t = s' s <- fmap VarT (newName "s") a <- fmap VarT (newName "a") b <- toTupleT (map return tys) return (Stab cx ReviewType s t a b) -- | Compute the full type-changing Prism type given an outer type, -- list of constructors, and target constructor name. Additionally -- return 'True' if the resulting type is a "simple" prism. computePrismType :: Type -> [NCon] -> NCon -> Q Stab computePrismType t cons con = do let ts = view nconTypes con unbound = setOf typeVars t Set.\\ setOf typeVars cons sub <- sequenceA (fromSet (newName . nameBase) unbound) b <- toTupleT (map return ts) a <- toTupleT (map return (substTypeVars sub ts)) let s = substTypeVars sub t return (Stab [] PrismType s t a b) computeIsoType :: Type -> [Type] -> TypeQ computeIsoType t' fields = do sub <- sequenceA (fromSet (newName . nameBase) (setOf typeVars t')) let t = return t' s = return (substTypeVars sub t') b = toTupleT (map return fields) a = toTupleT (map return (substTypeVars sub fields)) #ifndef HLINT ty | Map.null sub = appsT (conT iso'TypeName) [t,b] | otherwise = appsT (conT isoTypeName) [s,t,a,b] #endif close =<< ty -- | Construct either a Review or Prism as appropriate makeConOpticExp :: Stab -> [NCon] -> NCon -> ExpQ makeConOpticExp stab cons con = case stabType stab of PrismType -> makeConPrismExp stab cons con ReviewType -> makeConReviewExp con -- | Construct an iso declaration makeConIso :: Type -> NCon -> DecsQ makeConIso s con = do let ty = computeIsoType s (view nconTypes con) defName = prismName (view nconName con) sequenceA [ sigD defName ty , valD (varP defName) (normalB (makeConIsoExp con)) [] ] -- | Construct prism expression -- -- prism <> <> makeConPrismExp :: Stab -> [NCon] {- ^ constructors -} -> NCon {- ^ target constructor -} -> ExpQ makeConPrismExp stab cons con = appsE [varE prismValName, reviewer, remitter] where ts = view nconTypes con fields = length ts conName = view nconName con reviewer = makeReviewer conName fields remitter | stabSimple stab = makeSimpleRemitter conName fields | otherwise = makeFullRemitter cons conName -- | Construct an Iso expression -- -- iso <> <> makeConIsoExp :: NCon -> ExpQ makeConIsoExp con = appsE [varE isoValName, remitter, reviewer] where conName = view nconName con fields = length (view nconTypes con) reviewer = makeReviewer conName fields remitter = makeIsoRemitter conName fields -- | Construct a Review expression -- -- unto (\(x,y,z) -> Con x y z) makeConReviewExp :: NCon -> ExpQ makeConReviewExp con = appE (varE untoValName) reviewer where conName = view nconName con fields = length (view nconTypes con) reviewer = makeReviewer conName fields ------------------------------------------------------------------------ -- Prism and Iso component builders ------------------------------------------------------------------------ -- | Construct the review portion of a prism. -- -- (\(x,y,z) -> Con x y z) :: b -> t makeReviewer :: Name -> Int -> ExpQ makeReviewer conName fields = do xs <- replicateM fields (newName "x") lam1E (toTupleP (map varP xs)) (conE conName `appsE1` map varE xs) -- | Construct the remit portion of a prism. -- Pattern match only target constructor, no type changing -- -- (\x -> case s of -- Con x y z -> Right (x,y,z) -- _ -> Left x -- ) :: s -> Either s a makeSimpleRemitter :: Name -> Int -> ExpQ makeSimpleRemitter conName fields = do x <- newName "x" xs <- newNames "y" fields let matches = [ match (conP conName (map varP xs)) (normalB (appE (conE rightDataName) (toTupleE (map varE xs)))) [] , match wildP (normalB (appE (conE leftDataName) (varE x))) [] ] lam1E (varP x) (caseE (varE x) matches) -- | Pattern match all constructors to enable type-changing -- -- (\x -> case s of -- Con x y z -> Right (x,y,z) -- Other_n w -> Left (Other_n w) -- ) :: s -> Either t a makeFullRemitter :: [NCon] -> Name -> ExpQ makeFullRemitter cons target = do x <- newName "x" lam1E (varP x) (caseE (varE x) (map mkMatch cons)) where mkMatch (NCon conName _ n) = do xs <- newNames "y" (length n) match (conP conName (map varP xs)) (normalB (if conName == target then appE (conE rightDataName) (toTupleE (map varE xs)) else appE (conE leftDataName) (conE conName `appsE1` map varE xs))) [] -- | Construct the remitter suitable for use in an 'Iso' -- -- (\(Con x y z) -> (x,y,z)) :: s -> a makeIsoRemitter :: Name -> Int -> ExpQ makeIsoRemitter conName fields = do xs <- newNames "x" fields lam1E (conP conName (map varP xs)) (toTupleE (map varE xs)) ------------------------------------------------------------------------ -- Classy prisms ------------------------------------------------------------------------ -- | Construct the classy prisms class for a given type and constructors. -- -- class ClassName r <> | r -> <> where -- topMethodName :: Prism' r Type -- conMethodName_n :: Prism' r conTypes_n -- conMethodName_n = topMethodName . conMethodName_n makeClassyPrismClass :: Type {- Outer type -} -> Name {- Class name -} -> Name {- Top method name -} -> [NCon] {- Constructors -} -> DecQ makeClassyPrismClass t className methodName cons = do r <- newName "r" #ifndef HLINT let methodType = appsT (conT prism'TypeName) [varT r,return t] #endif methodss <- traverse (mkMethod (VarT r)) cons' classD (cxt[]) className (map PlainTV (r : vs)) (fds r) ( sigD methodName methodType : map return (concat methodss) ) where mkMethod r con = do Stab cx o _ _ _ b <- computeOpticType t cons con let stab' = Stab cx o r r b b defName = view nconName con body = appsE [varE composeValName, varE methodName, varE defName] sequenceA [ sigD defName (return (stabToType stab')) , valD (varP defName) (normalB body) [] ] cons' = map (over nconName prismName) cons vs = Set.toList (setOf typeVars t) fds r | null vs = [] | otherwise = [FunDep [r] vs] -- | Construct the classy prisms instance for a given type and constructors. -- -- instance Classname OuterType where -- topMethodName = id -- conMethodName_n = <> makeClassyPrismInstance :: Type -> Name {- Class name -} -> Name {- Top method name -} -> [NCon] {- Constructors -} -> DecQ makeClassyPrismInstance s className methodName cons = do let vs = Set.toList (setOf typeVars s) cls = className `conAppsT` (s : map VarT vs) instanceD (cxt[]) (return cls) ( valD (varP methodName) (normalB (varE idValName)) [] : [ do stab <- computeOpticType s cons con let stab' = simplifyStab stab valD (varP (prismName conName)) (normalB (makeConOpticExp stab' cons con)) [] | con <- cons , let conName = view nconName con ] ) ------------------------------------------------------------------------ -- Utilities ------------------------------------------------------------------------ -- | Normalized constructor data NCon = NCon { _nconName :: Name , _nconCxt :: Maybe Cxt , _nconTypes :: [Type] } deriving (Eq) instance HasTypeVars NCon where typeVarsEx s f (NCon x y z) = NCon x <$> typeVarsEx s f y <*> typeVarsEx s f z nconName :: Lens' NCon Name nconName f x = fmap (\y -> x {_nconName = y}) (f (_nconName x)) nconCxt :: Lens' NCon (Maybe Cxt) nconCxt f x = fmap (\y -> x {_nconCxt = y}) (f (_nconCxt x)) nconTypes :: Lens' NCon [Type] nconTypes f x = fmap (\y -> x {_nconTypes = y}) (f (_nconTypes x)) -- | Normalize a single 'Con' to its constructor name and field types. -- Because GADT syntax allows multiple constructors to be defined at -- the same time, this function can return multiple normalized results. normalizeCon :: Con -> [NCon] normalizeCon (RecC conName xs) = [NCon conName Nothing (map (view _3) xs)] normalizeCon (NormalC conName xs) = [NCon conName Nothing (map (view _2) xs)] normalizeCon (InfixC (_,x) conName (_,y)) = [NCon conName Nothing [x,y]] normalizeCon (ForallC [] [] con) = normalizeCon con -- happens in GADTs normalizeCon (ForallC _ cx1 con) = [NCon n (Just cx1 <> cx2) tys | NCon n cx2 tys <- normalizeCon con ] #if MIN_VERSION_template_haskell(2,11,0) normalizeCon (GadtC conNames xs _) = [ NCon conName Nothing (map (view _2) xs) | conName <- conNames ] normalizeCon (RecGadtC conNames xs _) = [ NCon conName Nothing (map (view _3) xs) | conName <- conNames ] #endif -- | Compute a prism's name by prefixing an underscore for normal -- constructors and period for operators. prismName :: Name -> Name prismName n = case nameBase n of [] -> error "prismName: empty name base?" x:xs | isUpper x -> mkName ('_':x:xs) | otherwise -> mkName ('.':x:xs) -- operator -- | Quantify all the free variables in a type. close :: Type -> TypeQ close t = forallT (map PlainTV (Set.toList vs)) (cxt[]) (return t) where vs = setOf typeVars t lens-4.14/src/Control/Lens/Internal/Review.hs0000644000000000000000000000266712710476104017267 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Review -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Review ( -- * Internal Classes Reviewable -- * Reviews , retagged ) where import Data.Bifunctor import Data.Profunctor import Data.Void -- | This class is provided mostly for backwards compatibility with lens 3.8, -- but it can also shorten type signatures. class (Profunctor p, Bifunctor p) => Reviewable p instance (Profunctor p, Bifunctor p) => Reviewable p ------------------------------------------------------------------------------ -- Review: Reviewed ------------------------------------------------------------------------------ -- | This is a profunctor used internally to implement "Review" -- -- It plays a role similar to that of 'Control.Lens.Internal.Getter.Accessor' -- or 'Const' do for "Control.Lens.Getter" retagged :: (Profunctor p, Bifunctor p) => p a b -> p s b retagged = first absurd . lmap absurd lens-4.14/src/Control/Lens/Internal/Setter.hs0000644000000000000000000000413012710476104017257 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 1 #endif #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Setter -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Setter ( -- ** Setters Settable(..) ) where import Control.Applicative import Control.Applicative.Backwards import Data.Distributive import Data.Functor.Compose import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Unsafe import Data.Traversable import Prelude ----------------------------------------------------------------------------- -- Settable ----------------------------------------------------------------------------- -- | Anything 'Settable' must be isomorphic to the 'Identity' 'Functor'. class (Applicative f, Distributive f, Traversable f) => Settable f where untainted :: f a -> a untaintedDot :: Profunctor p => p a (f b) -> p a b untaintedDot g = g `seq` rmap untainted g {-# INLINE untaintedDot #-} taintedDot :: Profunctor p => p a b -> p a (f b) taintedDot g = g `seq` rmap pure g {-# INLINE taintedDot #-} -- | So you can pass our 'Control.Lens.Setter.Setter' into combinators from other lens libraries. instance Settable Identity where untainted = runIdentity {-# INLINE untainted #-} untaintedDot = (runIdentity #.) {-# INLINE untaintedDot #-} taintedDot = (Identity #.) {-# INLINE taintedDot #-} -- | 'Control.Lens.Fold.backwards' instance Settable f => Settable (Backwards f) where untainted = untaintedDot forwards {-# INLINE untainted #-} instance (Settable f, Settable g) => Settable (Compose f g) where untainted = untaintedDot (untaintedDot getCompose) {-# INLINE untainted #-} lens-4.14/src/Control/Lens/Internal/TH.hs0000644000000000000000000001435312710476104016334 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifdef HLINT {-# ANN module "HLint: ignore Use camelCase" #-} #endif #ifndef MIN_VERSION_template_haskell #define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706) #endif #ifndef MIN_VERSION_containers #define MIN_VERSION_containers(x,y,z) 1 #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.TH -- Copyright : (C) 2013-2016 Edward Kmett and Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.TH where import Data.Functor.Contravariant import Language.Haskell.TH import Language.Haskell.TH.Syntax import qualified Data.Map as Map import qualified Data.Set as Set #ifndef CURRENT_PACKAGE_KEY import Data.Version (showVersion) import Paths_lens (version) #endif -- | Compatibility shim for recent changes to template haskell's 'tySynInstD' tySynInstD' :: Name -> [TypeQ] -> TypeQ -> DecQ #if MIN_VERSION_template_haskell(2,9,0) tySynInstD' fam ts r = tySynInstD fam (tySynEqn ts r) #else tySynInstD' = tySynInstD #endif -- | Apply arguments to a type constructor appsT :: TypeQ -> [TypeQ] -> TypeQ appsT = foldl appT -- | Apply arguments to a function appsE1 :: ExpQ -> [ExpQ] -> ExpQ appsE1 = foldl appE -- | Construct a tuple type given a list of types. toTupleT :: [TypeQ] -> TypeQ toTupleT [x] = x toTupleT xs = appsT (tupleT (length xs)) xs -- | Construct a tuple value given a list of expressions. toTupleE :: [ExpQ] -> ExpQ toTupleE [x] = x toTupleE xs = tupE xs -- | Construct a tuple pattern given a list of patterns. toTupleP :: [PatQ] -> PatQ toTupleP [x] = x toTupleP xs = tupP xs -- | Apply arguments to a type constructor. conAppsT :: Name -> [Type] -> Type conAppsT conName = foldl AppT (ConT conName) -- | Return 'Name' contained in a 'TyVarBndr'. bndrName :: TyVarBndr -> Name bndrName (PlainTV n ) = n bndrName (KindedTV n _) = n fromSet :: (k -> v) -> Set.Set k -> Map.Map k v #if MIN_VERSION_containers(0,5,0) fromSet = Map.fromSet #else fromSet f x = Map.fromDistinctAscList [ (k,f k) | k <- Set.toAscList x ] #endif -- | Generate many new names from a given base name. newNames :: String {- ^ base name -} -> Int {- ^ count -} -> Q [Name] newNames base n = sequence [ newName (base++show i) | i <- [1..n] ] ------------------------------------------------------------------------ -- Manually quoted names ------------------------------------------------------------------------ -- By manually generating these names we avoid needing to use the -- TemplateHaskell language extension when compiling the lens library. -- This allows the library to be used in stage1 cross-compilers. lensPackageKey :: String #ifdef CURRENT_PACKAGE_KEY lensPackageKey = CURRENT_PACKAGE_KEY #else lensPackageKey = "lens-" ++ showVersion version #endif mkLensName_tc :: String -> String -> Name mkLensName_tc = mkNameG_tc lensPackageKey mkLensName_v :: String -> String -> Name mkLensName_v = mkNameG_v lensPackageKey traversalTypeName :: Name traversalTypeName = mkLensName_tc "Control.Lens.Type" "Traversal" traversal'TypeName :: Name traversal'TypeName = mkLensName_tc "Control.Lens.Type" "Traversal'" lensTypeName :: Name lensTypeName = mkLensName_tc "Control.Lens.Type" "Lens" lens'TypeName :: Name lens'TypeName = mkLensName_tc "Control.Lens.Type" "Lens'" isoTypeName :: Name isoTypeName = mkLensName_tc "Control.Lens.Type" "Iso" iso'TypeName :: Name iso'TypeName = mkLensName_tc "Control.Lens.Type" "Iso'" getterTypeName :: Name getterTypeName = mkLensName_tc "Control.Lens.Type" "Getter" foldTypeName :: Name foldTypeName = mkLensName_tc "Control.Lens.Type" "Fold" prismTypeName :: Name prismTypeName = mkLensName_tc "Control.Lens.Type" "Prism" prism'TypeName :: Name prism'TypeName = mkLensName_tc "Control.Lens.Type" "Prism'" reviewTypeName :: Name reviewTypeName = mkLensName_tc "Control.Lens.Type" "Review" wrappedTypeName :: Name wrappedTypeName = mkLensName_tc "Control.Lens.Wrapped" "Wrapped" unwrappedTypeName :: Name unwrappedTypeName = mkLensName_tc "Control.Lens.Wrapped" "Unwrapped" rewrappedTypeName :: Name rewrappedTypeName = mkLensName_tc "Control.Lens.Wrapped" "Rewrapped" _wrapped'ValName :: Name _wrapped'ValName = mkLensName_v "Control.Lens.Wrapped" "_Wrapped'" isoValName :: Name isoValName = mkLensName_v "Control.Lens.Iso" "iso" prismValName :: Name prismValName = mkLensName_v "Control.Lens.Prism" "prism" untoValName :: Name untoValName = mkLensName_v "Control.Lens.Review" "unto" phantomValName :: Name phantomValName = mkLensName_v "Control.Lens.Internal.TH" "phantom2" phantom2 :: (Functor f, Contravariant f) => f a -> f b phantom2 = phantom {-# INLINE phantom2 #-} composeValName :: Name composeValName = mkNameG_v "base" "GHC.Base" "." idValName :: Name idValName = mkNameG_v "base" "GHC.Base" "id" fmapValName :: Name fmapValName = mkNameG_v "base" "GHC.Base" "fmap" #if MIN_VERSION_base(4,8,0) pureValName :: Name pureValName = mkNameG_v "base" "GHC.Base" "pure" apValName :: Name apValName = mkNameG_v "base" "GHC.Base" "<*>" #else pureValName :: Name pureValName = mkNameG_v "base" "Control.Applicative" "pure" apValName :: Name apValName = mkNameG_v "base" "Control.Applicative" "<*>" #endif rightDataName :: Name rightDataName = mkNameG_d "base" "Data.Either" "Right" leftDataName :: Name leftDataName = mkNameG_d "base" "Data.Either" "Left" lens-4.14/src/Control/Lens/Internal/Zoom.hs0000644000000000000000000003040412710476104016740 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Zoom -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Zoom ( -- * Zoom Focusing(..) , FocusingWith(..) , FocusingPlus(..) , FocusingOn(..) , FocusingMay(..), May(..) , FocusingErr(..), Err(..) , FocusingFree(..), Freed(..) -- * Magnify , Effect(..) , EffectRWS(..) ) where import Control.Applicative import Control.Category import Control.Comonad import Control.Monad.Reader as Reader import Control.Monad.Trans.Free import Data.Functor.Bind import Data.Functor.Contravariant import Data.Semigroup import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- Focusing ------------------------------------------------------------------------------ -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.State.StateT'. newtype Focusing m s a = Focusing { unfocusing :: m (s, a) } instance Monad m => Functor (Focusing m s) where fmap f (Focusing m) = Focusing $ do (s, a) <- m return (s, f a) {-# INLINE fmap #-} instance (Monad m, Semigroup s) => Apply (Focusing m s) where Focusing mf <.> Focusing ma = Focusing $ do (s, f) <- mf (s', a) <- ma return (s <> s', f a) {-# INLINE (<.>) #-} instance (Monad m, Monoid s) => Applicative (Focusing m s) where pure a = Focusing (return (mempty, a)) {-# INLINE pure #-} Focusing mf <*> Focusing ma = Focusing $ do (s, f) <- mf (s', a) <- ma return (mappend s s', f a) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- FocusingWith ------------------------------------------------------------------------------ -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.RWS.RWST'. newtype FocusingWith w m s a = FocusingWith { unfocusingWith :: m (s, a, w) } instance Monad m => Functor (FocusingWith w m s) where fmap f (FocusingWith m) = FocusingWith $ do (s, a, w) <- m return (s, f a, w) {-# INLINE fmap #-} instance (Monad m, Semigroup s, Semigroup w) => Apply (FocusingWith w m s) where FocusingWith mf <.> FocusingWith ma = FocusingWith $ do (s, f, w) <- mf (s', a, w') <- ma return (s <> s', f a, w <> w') {-# INLINE (<.>) #-} instance (Monad m, Monoid s, Monoid w) => Applicative (FocusingWith w m s) where pure a = FocusingWith (return (mempty, a, mempty)) {-# INLINE pure #-} FocusingWith mf <*> FocusingWith ma = FocusingWith $ do (s, f, w) <- mf (s', a, w') <- ma return (mappend s s', f a, mappend w w') {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- FocusingPlus ------------------------------------------------------------------------------ -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.Writer.WriterT'. newtype FocusingPlus w k s a = FocusingPlus { unfocusingPlus :: k (s, w) a } instance Functor (k (s, w)) => Functor (FocusingPlus w k s) where fmap f (FocusingPlus as) = FocusingPlus (fmap f as) {-# INLINE fmap #-} instance Apply (k (s, w)) => Apply (FocusingPlus w k s) where FocusingPlus kf <.> FocusingPlus ka = FocusingPlus (kf <.> ka) {-# INLINE (<.>) #-} instance Applicative (k (s, w)) => Applicative (FocusingPlus w k s) where pure = FocusingPlus . pure {-# INLINE pure #-} FocusingPlus kf <*> FocusingPlus ka = FocusingPlus (kf <*> ka) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- FocusingOn ------------------------------------------------------------------------------ -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.Trans.Maybe.MaybeT' or 'Control.Monad.Trans.List.ListT'. newtype FocusingOn f k s a = FocusingOn { unfocusingOn :: k (f s) a } instance Functor (k (f s)) => Functor (FocusingOn f k s) where fmap f (FocusingOn as) = FocusingOn (fmap f as) {-# INLINE fmap #-} instance Apply (k (f s)) => Apply (FocusingOn f k s) where FocusingOn kf <.> FocusingOn ka = FocusingOn (kf <.> ka) {-# INLINE (<.>) #-} instance Applicative (k (f s)) => Applicative (FocusingOn f k s) where pure = FocusingOn . pure {-# INLINE pure #-} FocusingOn kf <*> FocusingOn ka = FocusingOn (kf <*> ka) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- May ------------------------------------------------------------------------------ -- | Make a 'Monoid' out of 'Maybe' for error handling. newtype May a = May { getMay :: Maybe a } instance Semigroup a => Semigroup (May a) where May Nothing <> _ = May Nothing _ <> May Nothing = May Nothing May (Just a) <> May (Just b) = May (Just (a <> b)) {-# INLINE (<>) #-} instance Monoid a => Monoid (May a) where mempty = May (Just mempty) {-# INLINE mempty #-} May Nothing `mappend` _ = May Nothing _ `mappend` May Nothing = May Nothing May (Just a) `mappend` May (Just b) = May (Just (mappend a b)) {-# INLINE mappend #-} ------------------------------------------------------------------------------ -- FocusingMay ------------------------------------------------------------------------------ -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.Error.ErrorT'. newtype FocusingMay k s a = FocusingMay { unfocusingMay :: k (May s) a } instance Functor (k (May s)) => Functor (FocusingMay k s) where fmap f (FocusingMay as) = FocusingMay (fmap f as) {-# INLINE fmap #-} instance Apply (k (May s)) => Apply (FocusingMay k s) where FocusingMay kf <.> FocusingMay ka = FocusingMay (kf <.> ka) {-# INLINE (<.>) #-} instance Applicative (k (May s)) => Applicative (FocusingMay k s) where pure = FocusingMay . pure {-# INLINE pure #-} FocusingMay kf <*> FocusingMay ka = FocusingMay (kf <*> ka) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- Err ------------------------------------------------------------------------------ -- | Make a 'Monoid' out of 'Either' for error handling. newtype Err e a = Err { getErr :: Either e a } instance Semigroup a => Semigroup (Err e a) where Err (Left e) <> _ = Err (Left e) _ <> Err (Left e) = Err (Left e) Err (Right a) <> Err (Right b) = Err (Right (a <> b)) {-# INLINE (<>) #-} instance Monoid a => Monoid (Err e a) where mempty = Err (Right mempty) {-# INLINE mempty #-} Err (Left e) `mappend` _ = Err (Left e) _ `mappend` Err (Left e) = Err (Left e) Err (Right a) `mappend` Err (Right b) = Err (Right (mappend a b)) {-# INLINE mappend #-} ------------------------------------------------------------------------------ -- FocusingErr ------------------------------------------------------------------------------ -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.Error.ErrorT'. newtype FocusingErr e k s a = FocusingErr { unfocusingErr :: k (Err e s) a } instance Functor (k (Err e s)) => Functor (FocusingErr e k s) where fmap f (FocusingErr as) = FocusingErr (fmap f as) {-# INLINE fmap #-} instance Apply (k (Err e s)) => Apply (FocusingErr e k s) where FocusingErr kf <.> FocusingErr ka = FocusingErr (kf <.> ka) {-# INLINE (<.>) #-} instance Applicative (k (Err e s)) => Applicative (FocusingErr e k s) where pure = FocusingErr . pure {-# INLINE pure #-} FocusingErr kf <*> FocusingErr ka = FocusingErr (kf <*> ka) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- Freed ------------------------------------------------------------------------------ -- | Make a 'Monoid' out of 'FreeF' for result collection. newtype Freed f m a = Freed { getFreed :: FreeF f a (FreeT f m a) } instance (Applicative f, Semigroup a, Monad m) => Semigroup (Freed f m a) where Freed (Pure a) <> Freed (Pure b) = Freed $ Pure $ a <> b Freed (Pure a) <> Freed (Free g) = Freed $ Free $ liftA2 (liftM2 (<>)) (pure $ return a) g Freed (Free f) <> Freed (Pure b) = Freed $ Free $ liftA2 (liftM2 (<>)) f (pure $ return b) Freed (Free f) <> Freed (Free g) = Freed $ Free $ liftA2 (liftM2 (<>)) f g instance (Applicative f, Monoid a, Monad m) => Monoid (Freed f m a) where mempty = Freed $ Pure mempty Freed (Pure a) `mappend` Freed (Pure b) = Freed $ Pure $ a `mappend` b Freed (Pure a) `mappend` Freed (Free g) = Freed $ Free $ liftA2 (liftM2 mappend) (pure $ return a) g Freed (Free f) `mappend` Freed (Pure b) = Freed $ Free $ liftA2 (liftM2 mappend) f (pure $ return b) Freed (Free f) `mappend` Freed (Free g) = Freed $ Free $ liftA2 (liftM2 mappend) f g ------------------------------------------------------------------------------ -- FocusingFree ------------------------------------------------------------------------------ -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into -- 'Control.Monad.Trans.FreeT' newtype FocusingFree f m k s a = FocusingFree { unfocusingFree :: k (Freed f m s) a } instance Functor (k (Freed f m s)) => Functor (FocusingFree f m k s) where fmap f (FocusingFree as) = FocusingFree (fmap f as) {-# INLINE fmap #-} instance Apply (k (Freed f m s)) => Apply (FocusingFree f m k s) where FocusingFree kf <.> FocusingFree ka = FocusingFree (kf <.> ka) {-# INLINE (<.>) #-} instance Applicative (k (Freed f m s)) => Applicative (FocusingFree f m k s) where pure = FocusingFree . pure {-# INLINE pure #-} FocusingFree kf <*> FocusingFree ka = FocusingFree (kf <*> ka) {-# INLINE (<*>) #-} ----------------------------------------------------------------------------- --- Effect ------------------------------------------------------------------------------- -- | Wrap a monadic effect with a phantom type argument. newtype Effect m r a = Effect { getEffect :: m r } -- type role Effect representational nominal phantom instance Functor (Effect m r) where fmap _ (Effect m) = Effect m {-# INLINE fmap #-} instance Contravariant (Effect m r) where contramap _ (Effect m) = Effect m {-# INLINE contramap #-} instance (Apply m, Semigroup r) => Semigroup (Effect m r a) where Effect ma <> Effect mb = Effect (liftF2 (<>) ma mb) {-# INLINE (<>) #-} instance (Monad m, Monoid r) => Monoid (Effect m r a) where mempty = Effect (return mempty) {-# INLINE mempty #-} Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb) {-# INLINE mappend #-} instance (Apply m, Semigroup r) => Apply (Effect m r) where Effect ma <.> Effect mb = Effect (liftF2 (<>) ma mb) {-# INLINE (<.>) #-} instance (Monad m, Monoid r) => Applicative (Effect m r) where pure _ = Effect (return mempty) {-# INLINE pure #-} Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- EffectRWS ------------------------------------------------------------------------------ -- | Wrap a monadic effect with a phantom type argument. Used when magnifying 'Control.Monad.RWS.RWST'. newtype EffectRWS w st m s a = EffectRWS { getEffectRWS :: st -> m (s,st,w) } instance Functor (EffectRWS w st m s) where fmap _ (EffectRWS m) = EffectRWS m {-# INLINE fmap #-} instance (Semigroup s, Semigroup w, Bind m) => Apply (EffectRWS w st m s) where EffectRWS m <.> EffectRWS n = EffectRWS $ \st -> m st >>- \ (s,t,w) -> fmap (\(s',u,w') -> (s <> s', u, w <> w')) (n t) {-# INLINE (<.>) #-} instance (Monoid s, Monoid w, Monad m) => Applicative (EffectRWS w st m s) where pure _ = EffectRWS $ \st -> return (mempty, st, mempty) {-# INLINE pure #-} EffectRWS m <*> EffectRWS n = EffectRWS $ \st -> m st >>= \ (s,t,w) -> n t >>= \ (s',u,w') -> return (mappend s s', u, mappend w w') {-# INLINE (<*>) #-} instance Contravariant (EffectRWS w st m s) where contramap _ (EffectRWS m) = EffectRWS m {-# INLINE contramap #-} lens-4.14/src/Control/Monad/0000755000000000000000000000000012710476104014040 5ustar0000000000000000lens-4.14/src/Control/Monad/Error/0000755000000000000000000000000012710476104015131 5ustar0000000000000000lens-4.14/src/Control/Monad/Error/Lens.hs0000644000000000000000000002145012710476104016370 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Error.Lens -- Copyright : (C) 2014-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Control.Monad.Error -- ---------------------------------------------------------------------------- module Control.Monad.Error.Lens ( -- * Catching catching, catching_ -- * Handling , handling, handling_ -- * Trying , trying -- * Handlers , catches , Handler(..) , Handleable(..) -- * Throwing , throwing ) where import Control.Applicative import Control.Lens import Control.Lens.Internal.Exception import Control.Monad import Control.Monad.Error.Class import Data.Functor.Plus import qualified Data.Monoid as M import Data.Semigroup (Semigroup(..)) import Prelude #ifdef HLINT {-# ANN module "HLint: ignore Use fmap" #-} #endif ------------------------------------------------------------------------------ -- Catching ------------------------------------------------------------------------------ -- | Catch exceptions that match a given 'Prism' (or any 'Getter', really). -- -- @ -- 'catching' :: 'MonadError' e m => 'Prism'' e a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Lens'' e a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Traversal'' e a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Iso'' e a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Getter' e a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Fold' e a -> m r -> (a -> m r) -> m r -- @ catching :: MonadError e m => Getting (M.First a) e a -> m r -> (a -> m r) -> m r catching l = catchJust (preview l) {-# INLINE catching #-} -- | Catch exceptions that match a given 'Prism' (or any 'Getter'), discarding -- the information about the match. This is particuarly useful when you have -- a @'Prism'' e ()@ where the result of the 'Prism' or 'Fold' isn't -- particularly valuable, just the fact that it matches. -- -- @ -- 'catching_' :: 'MonadError' e m => 'Prism'' e a -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Lens'' e a -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Iso'' e a -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Getter' e a -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Fold' e a -> m r -> m r -> m r -- @ catching_ :: MonadError e m => Getting (M.First a) e a -> m r -> m r -> m r catching_ l a b = catchJust (preview l) a (const b) {-# INLINE catching_ #-} ------------------------------------------------------------------------------ -- Handling ------------------------------------------------------------------------------ -- | A version of 'catching' with the arguments swapped around; useful in -- situations where the code for the handler is shorter. -- -- @ -- 'handling' :: 'MonadError' e m => 'Prism'' e a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Lens'' e a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Traversal'' e a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Iso'' e a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Fold' e a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Getter' e a -> (a -> m r) -> m r -> m r -- @ handling :: MonadError e m => Getting (M.First a) e a -> (a -> m r) -> m r -> m r handling l = flip (catching l) {-# INLINE handling #-} -- | A version of 'catching_' with the arguments swapped around; useful in -- situations where the code for the handler is shorter. -- -- @ -- 'handling_' :: 'MonadError' e m => 'Prism'' e a -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Lens'' e a -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Iso'' e a -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Getter' e a -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Fold' e a -> m r -> m r -> m r -- @ handling_ :: MonadError e m => Getting (M.First a) e a -> m r -> m r -> m r handling_ l = flip (catching_ l) {-# INLINE handling_ #-} ------------------------------------------------------------------------------ -- Trying ------------------------------------------------------------------------------ -- | 'trying' takes a 'Prism' (or any 'Getter') to select which exceptions are caught -- If the 'Exception' does not match the predicate, it is re-thrown. -- -- @ -- 'trying' :: 'MonadError' e m => 'Prism'' e a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Lens'' e a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Iso'' e a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Getter' e a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Fold' e a -> m r -> m ('Either' a r) -- @ trying :: MonadError e m => Getting (M.First a) e a -> m r -> m (Either a r) trying l m = catching l (liftM Right m) (return . Left) ------------------------------------------------------------------------------ -- Catches ------------------------------------------------------------------------------ -- | -- This function exists to remedy a gap between the functionality of @Control.Exception@ -- and @Control.Monad.Error@. @Control.Exception@ supplies 'Control.Exception.catches' and -- a notion of 'Control.Exception.Handler', which we duplicate here in a form suitable for -- working with any 'MonadError' instance. -- -- Sometimes you want to catch two different sorts of error. You could -- do something like -- -- @ -- f = 'handling' _Foo handleFoo ('handling' _Bar handleBar expr) -- @ -- -- -- However, there are a couple of problems with this approach. The first is -- that having two exception handlers is inefficient. However, the more -- serious issue is that the second exception handler will catch exceptions -- in the first, e.g. in the example above, if @handleFoo@ uses 'throwError' -- then the second exception handler will catch it. -- -- Instead, we provide a function 'catches', which would be used thus: -- -- @ -- f = 'catches' expr [ 'handler' _Foo handleFoo -- , 'handler' _Bar handleBar -- ] -- @ catches :: MonadError e m => m a -> [Handler e m a] -> m a catches m hs = catchError m go where go e = foldr tryHandler (throwError e) hs where tryHandler (Handler ema amr) res = maybe res amr (ema e) ------------------------------------------------------------------------------ -- Handlers ------------------------------------------------------------------------------ -- | You need this when using 'catches'. data Handler e m r = forall a. Handler (e -> Maybe a) (a -> m r) instance Monad m => Functor (Handler e m) where fmap f (Handler ema amr) = Handler ema $ \a -> do r <- amr a return (f r) {-# INLINE fmap #-} instance Monad m => Semigroup (Handler e m a) where (<>) = M.mappend {-# INLINE (<>) #-} instance Monad m => Alt (Handler e m) where Handler ema amr Handler emb bmr = Handler emab abmr where emab e = Left <$> ema e <|> Right <$> emb e abmr = either amr bmr {-# INLINE () #-} instance Monad m => Plus (Handler e m) where zero = Handler (const Nothing) undefined {-# INLINE zero #-} instance Monad m => M.Monoid (Handler e m a) where mempty = zero {-# INLINE mempty #-} mappend = () {-# INLINE mappend #-} instance Handleable e m (Handler e m) where handler = Handler . preview {-# INLINE handler #-} ------------------------------------------------------------------------------ -- Throwing ------------------------------------------------------------------------------ -- | Throw an 'Exception' described by a 'Prism'. -- -- @'throwing' l ≡ 'reviews' l 'throwError'@ -- -- @ -- 'throwing' :: 'MonadError' e m => 'Prism'' e t -> t -> a -- 'throwing' :: 'MonadError' e m => 'Iso'' e t -> t -> a -- @ throwing :: MonadError e m => AReview e t -> t -> m x throwing l = reviews l throwError {-# INLINE throwing #-} ------------------------------------------------------------------------------ -- Misc. ------------------------------------------------------------------------------ -- | Helper function to provide conditional catch behavior. catchJust :: MonadError e m => (e -> Maybe t) -> m a -> (t -> m a) -> m a catchJust f m k = catchError m $ \ e -> case f e of Nothing -> throwError e Just x -> k x {-# INLINE catchJust #-} lens-4.14/src/Control/Parallel/0000755000000000000000000000000012710476104014536 5ustar0000000000000000lens-4.14/src/Control/Parallel/Strategies/0000755000000000000000000000000012710476104016650 5ustar0000000000000000lens-4.14/src/Control/Parallel/Strategies/Lens.hs0000644000000000000000000000534212710476104020111 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_parallel #define MIN_VERSION_parallel(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL > 700) #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.Strategies.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- A 'Lens' or 'Traversal' can be used to take the role of 'Traversable' in -- @Control.Parallel.Strategies@, enabling those combinators to work with -- monomorphic containers. ---------------------------------------------------------------------------- module Control.Parallel.Strategies.Lens ( evalOf , parOf , after , throughout ) where import Control.Lens import Control.Parallel.Strategies -- | Evaluate the targets of a 'Lens' or 'Traversal' into a data structure -- according to the given 'Strategy'. -- -- @ -- 'evalTraversable' = 'evalOf' 'traverse' = 'traverse' -- 'evalOf' = 'id' -- @ -- -- @ -- 'evalOf' :: 'Lens'' s a -> 'Strategy' a -> 'Strategy' s -- 'evalOf' :: 'Traversal'' s a -> 'Strategy' a -> 'Strategy' s -- 'evalOf' :: (a -> 'Eval' a) -> s -> 'Eval' s) -> 'Strategy' a -> 'Strategy' s -- @ evalOf :: LensLike' Eval s a -> Strategy a -> Strategy s evalOf l = l {-# INLINE evalOf #-} -- | Evaluate the targets of a 'Lens' or 'Traversal' according into a -- data structure according to a given 'Strategy' in parallel. -- -- @'parTraversable' = 'parOf' 'traverse'@ -- -- @ -- 'parOf' :: 'Lens'' s a -> 'Strategy' a -> 'Strategy' s -- 'parOf' :: 'Traversal'' s a -> 'Strategy' a -> 'Strategy' s -- 'parOf' :: ((a -> 'Eval' a) -> s -> 'Eval' s) -> 'Strategy' a -> 'Strategy' s -- @ parOf :: LensLike' Eval s a -> Strategy a -> Strategy s #if MIN_VERSION_parallel(3,2,0) parOf l s = l (rparWith s) #else parOf l s = l (rpar `dot` s) #endif {-# INLINE parOf #-} -- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to -- first evaluates its argument according to a given 'Strategy' /before/ proceeding. -- -- @ -- 'after' 'rdeepseq' 'traverse' :: 'Traversable' t => 'Strategy' a -> 'Strategy' [a] -- @ after :: Strategy s -> LensLike f s t a b -> LensLike f s t a b after s l f = l f $| s {-# INLINE after #-} -- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to -- evaluate its argument according to a given 'Strategy' /in parallel with/ evaluating. -- -- @ -- 'throughout' 'rdeepseq' 'traverse' :: 'Traversable' t => 'Strategy' a -> 'Strategy' [a] -- @ throughout :: Strategy s -> LensLike f s t a b -> LensLike f s t a b throughout s l f = l f $|| s {-# INLINE throughout #-} lens-4.14/src/Control/Seq/0000755000000000000000000000000012710476104013532 5ustar0000000000000000lens-4.14/src/Control/Seq/Lens.hs0000644000000000000000000000153112710476104014767 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Seq.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- A 'Fold' can be used to take the role of 'Foldable' in @Control.Seq@. ---------------------------------------------------------------------------- module Control.Seq.Lens ( seqOf ) where import Control.Lens import Control.Seq import Data.Monoid -- | Evaluate the elements targeted by a 'Lens', 'Traversal', 'Iso', -- 'Getter' or 'Fold' according to the given strategy. -- -- @'seqFoldable' = 'seqOf' 'folded'@ seqOf :: Getting (Endo [a]) s a -> Strategy a -> Strategy s seqOf l s = seqList s . toListOf l {-# INLINE seqOf #-} lens-4.14/src/Data/0000755000000000000000000000000012710476104012233 5ustar0000000000000000lens-4.14/src/Data/Array/0000755000000000000000000000000012710476104013311 5ustar0000000000000000lens-4.14/src/Data/Array/Lens.hs0000644000000000000000000000214012710476104014543 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Array.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : MPTCs, Rank2Types, LiberalTypeSynonyms -- ---------------------------------------------------------------------------- module Data.Array.Lens ( -- * Setters ixmapped ) where import Control.Lens import Data.Array.IArray hiding (index) -- | This 'setter' can be used to derive a new 'IArray' from an old 'IAarray' by -- applying a function to each of the indices to look it up in the old 'IArray'. -- -- This is a /contravariant/ 'Setter'. -- -- @ -- 'ixmap' ≡ 'over' '.' 'ixmapped' -- 'ixmapped' ≡ 'setting' '.' '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) -> IndexPreservingSetter (a j e) (a i e) i j ixmapped = setting . ixmap {-# INLINE ixmapped #-} lens-4.14/src/Data/Bits/0000755000000000000000000000000012710476104013134 5ustar0000000000000000lens-4.14/src/Data/Bits/Lens.hs0000644000000000000000000002112112710476104014366 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Bits.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : LiberalTypeSynonyms -- ---------------------------------------------------------------------------- module Data.Bits.Lens ( (.|.~), (.&.~), (<.|.~), (<.&.~), (<<.|.~), (<<.&.~) , (.|.=), (.&.=), (<.|.=), (<.&.=), (<<.|.=), (<<.&.=) , bitAt , bits , byteAt , bytewise ) where import Control.Lens import Control.Monad.State import Data.Bits import Data.Word #if !MIN_VERSION_base(4,8,0) import Data.Functor #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Data.Word infixr 4 .|.~, .&.~, <.|.~, <.&.~, <<.|.~, <<.&.~ infix 4 .|.=, .&.=, <.|.=, <.&.=, <<.|.=, <<.&.= -- | Bitwise '.|.' the target(s) of a 'Lens' or 'Setter'. -- -- >>> _2 .|.~ 6 $ ("hello",3) -- ("hello",7) -- -- @ -- ('.|.~') :: 'Bits' a => 'Setter' s t a a -> a -> s -> t -- ('.|.~') :: 'Bits' a => 'Iso' s t a a -> a -> s -> t -- ('.|.~') :: 'Bits' a => 'Lens' s t a a -> a -> s -> t -- ('.|.~') :: ('Data.Monoid.Monoid' a, 'Bits' a) => 'Traversal' s t a a -> a -> s -> t -- @ (.|.~):: Bits a => ASetter s t a a -> a -> s -> t l .|.~ n = over l (.|. n) {-# INLINE (.|.~) #-} -- | Bitwise '.&.' the target(s) of a 'Lens' or 'Setter'. -- -- >>> _2 .&.~ 7 $ ("hello",254) -- ("hello",6) -- -- @ -- ('.&.~') :: 'Bits' a => 'Setter' s t a a -> a -> s -> t -- ('.&.~') :: 'Bits' a => 'Iso' s t a a -> a -> s -> t -- ('.&.~') :: 'Bits' a => 'Lens' s t a a -> a -> s -> t -- ('.&.~') :: ('Data.Monoid.Monoid' a, 'Bits' a) => 'Traversal' s t a a -> a -> s -> t -- @ (.&.~) :: Bits a => ASetter s t a a -> a -> s -> t l .&.~ n = over l (.&. n) {-# INLINE (.&.~) #-} -- | Modify the target(s) of a 'Lens'', 'Setter'' or 'Traversal'' by computing its bitwise '.&.' with another value. -- -- >>> execState (do _1 .&.= 15; _2 .&.= 3) (7,7) -- (7,3) -- -- @ -- ('.&.=') :: ('MonadState' s m, 'Bits' a) => 'Setter'' s a -> a -> m () -- ('.&.=') :: ('MonadState' s m, 'Bits' a) => 'Iso'' s a -> a -> m () -- ('.&.=') :: ('MonadState' s m, 'Bits' a) => 'Lens'' s a -> a -> m () -- ('.&.=') :: ('MonadState' s m, 'Bits' a) => 'Traversal'' s a -> a -> m () -- @ (.&.=):: (MonadState s m, Bits a) => ASetter' s a -> a -> m () l .&.= a = modify (l .&.~ a) {-# INLINE (.&.=) #-} -- | Modify the target(s) of a 'Lens'', 'Setter' or 'Traversal' by computing its bitwise '.|.' with another value. -- -- >>> execState (do _1 .|.= 15; _2 .|.= 3) (7,7) -- (15,7) -- -- @ -- ('.|.=') :: ('MonadState' s m, 'Bits' a) => 'Setter'' s a -> a -> m () -- ('.|.=') :: ('MonadState' s m, 'Bits' a) => 'Iso'' s a -> a -> m () -- ('.|.=') :: ('MonadState' s m, 'Bits' a) => 'Lens'' s a -> a -> m () -- ('.|.=') :: ('MonadState' s m, 'Bits' a) => 'Traversal'' s a -> a -> m () -- @ (.|.=) :: (MonadState s m, Bits a) => ASetter' s a -> a -> m () l .|.= a = modify (l .|.~ a) {-# INLINE (.|.=) #-} -- | Bitwise '.|.' the target(s) of a 'Lens' (or 'Traversal'), returning the result -- (or a monoidal summary of all of the results). -- -- >>> _2 <.|.~ 6 $ ("hello",3) -- (7,("hello",7)) -- -- @ -- ('<.|.~') :: 'Bits' a => 'Iso' s t a a -> a -> s -> (a, t) -- ('<.|.~') :: 'Bits' a => 'Lens' s t a a -> a -> s -> (a, t) -- ('<.|.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => 'Traversal' s t a a -> a -> s -> (a, t) -- @ (<.|.~):: Bits a => LensLike ((,) a) s t a a -> a -> s -> (a, t) l <.|.~ n = l <%~ (.|. n) {-# INLINE (<.|.~) #-} -- | Bitwise '.&.' the target(s) of a 'Lens' or 'Traversal', returning the result -- (or a monoidal summary of all of the results). -- -- >>> _2 <.&.~ 7 $ ("hello",254) -- (6,("hello",6)) -- -- @ -- ('<.&.~') :: 'Bits' a => 'Iso' s t a a -> a -> s -> (a, t) -- ('<.&.~') :: 'Bits' a => 'Lens' s t a a -> a -> s -> (a, t) -- ('<.&.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => 'Traversal' s t a a -> a -> s -> (a, t) -- @ (<.&.~) :: Bits a => LensLike ((,) a) s t a a -> a -> s -> (a, t) l <.&.~ n = l <%~ (.&. n) {-# INLINE (<.&.~) #-} -- | Modify the target(s) of a 'Lens'' (or 'Traversal'') by computing its bitwise '.&.' with another value, -- returning the result (or a monoidal summary of all of the results traversed). -- -- >>> runState (_1 <.&.= 15) (31,0) -- (15,(15,0)) -- -- @ -- ('<.&.=') :: ('MonadState' s m, 'Bits' a) => 'Lens'' s a -> a -> m a -- ('<.&.=') :: ('MonadState' s m, 'Bits' a, 'Data.Monoid.Monoid' a) => 'Traversal'' s a -> a -> m a -- @ (<.&.=):: (MonadState s m, Bits a) => LensLike' ((,)a) s a -> a -> m a l <.&.= b = l <%= (.&. b) {-# INLINE (<.&.=) #-} -- | Modify the target(s) of a 'Lens'', (or 'Traversal') by computing its bitwise '.|.' with another value, -- returning the result (or a monoidal summary of all of the results traversed). -- -- >>> runState (_1 <.|.= 7) (28,0) -- (31,(31,0)) -- -- @ -- ('<.|.=') :: ('MonadState' s m, 'Bits' a) => 'Lens'' s a -> a -> m a -- ('<.|.=') :: ('MonadState' s m, 'Bits' a, 'Data.Monoid.Monoid' a) => 'Traversal'' s a -> a -> m a -- @ (<.|.=) :: (MonadState s m, Bits a) => LensLike' ((,)a) s a -> a -> m a l <.|.= b = l <%= (.|. b) {-# INLINE (<.|.=) #-} (<<.&.~) :: Bits a => Optical' (->) q ((,)a) s a -> a -> q s (a, s) l <<.&.~ b = l $ \a -> (a, a .&. b) {-# INLINE (<<.&.~) #-} (<<.|.~) :: Bits a => Optical' (->) q ((,)a) s a -> a -> q s (a, s) l <<.|.~ b = l $ \a -> (a, a .|. b) {-# INLINE (<<.|.~) #-} (<<.&.=) :: (MonadState s m, Bits a) => LensLike' ((,) a) s a -> a -> m a l <<.&.= b = l %%= \a -> (a, a .&. b) {-# INLINE (<<.&.=) #-} (<<.|.=) :: (MonadState s m, Bits a) => LensLike' ((,) a) s a -> a -> m a l <<.|.= b = l %%= \a -> (a, a .|. b) {-# INLINE (<<.|.=) #-} -- | This 'Lens' can be used to access the value of the nth bit in a number. -- -- @'bitAt' n@ is only a legal 'Lens' into @b@ if @0 '<=' n '<' 'bitSize' ('undefined' :: b)@. -- -- >>> 16^.bitAt 4 -- True -- -- >>> 15^.bitAt 4 -- False -- -- >>> 15 & bitAt 4 .~ True -- 31 -- -- >>> 16 & bitAt 4 .~ False -- 0 bitAt :: Bits b => Int -> IndexedLens' Int b Bool bitAt n f b = indexed f n (testBit b n) <&> \x -> if x then setBit b n else clearBit b n {-# INLINE bitAt #-} -- | Get the nth byte, counting from the low end. -- -- @'byteAt' n@ is a legal 'Lens' into @b@ iff @0 '<=' n '<' 'div' ('bitSize' ('undefined' :: b)) 8@ -- -- >>> (0xff00 :: Word16)^.byteAt 0 -- 0 -- -- >>> (0xff00 :: Word16)^.byteAt 1 -- 255 -- -- >>> byteAt 1 .~ 0 $ 0xff00 :: Word16 -- 0 -- -- >>> byteAt 0 .~ 0xff $ 0 :: Word16 -- 255 byteAt :: (Integral b, Bits b) => Int -> IndexedLens' Int b Word8 byteAt i f b = back <$> indexed f i (forward b) where back w8 = (fromIntegral w8 `shiftL` (i * 8)) .|. (complement (255 `shiftL` (i * 8)) .&. b) forward = fromIntegral . (.&.) 0xff . flip shiftR (i * 8) -- | Traverse over all bits in a numeric type. -- -- The bit position is available as the index. -- -- >>> toListOf bits (5 :: Word8) -- [True,False,True,False,False,False,False,False] -- -- If you supply this an 'Integer', the result will be an infinite 'Traversal', which -- can be productively consumed, but not reassembled. bits :: (Num b, Bits b) => IndexedTraversal' Int b Bool bits f b = Prelude.foldr step 0 <$> traverse g bs where g n = (,) n <$> indexed f n (testBit b n) bs = Prelude.takeWhile hasBit [0..] hasBit n = complementBit b n /= b -- test to make sure that complementing this bit actually changes the value step (n,True) r = setBit r n step _ r = r {-# INLINE bits #-} -- | Traverse over all the bytes in an integral type, from the low end. -- -- The byte position is available as the index. -- -- >>> toListOf bytewise (1312301580 :: Word32) -- [12,34,56,78] -- -- If you supply this an 'Integer', the result will be an infinite 'Traversal', -- which can be productively consumed, but not reassembled. -- -- Why is'nt this function called @bytes@ to match 'bits'? Alas, there -- is already a function by that name in "Data.ByteString.Lens". bytewise :: (Integral b, Bits b) => IndexedTraversal' Int b Word8 bytewise f b = Prelude.foldr step 0 <$> traverse g bs where g n = (,) n <$> indexed f n (fromIntegral $ b `shiftR` (n*8)) bs = Prelude.takeWhile hasByte [0..] hasByte n = complementBit b (n*8) /= b step (n,x) r = r .|. (fromIntegral x `shiftL` (n*8)) {-# INLINE bytewise #-} lens-4.14/src/Data/ByteString/0000755000000000000000000000000012710476104014325 5ustar0000000000000000lens-4.14/src/Data/ByteString/Lens.hs0000644000000000000000000001210312710476104015557 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Data.ByteString.Lens ( IsByteString(..) , unpackedBytes , unpackedChars #if __GLASGOW_HASKELL__ >= 710 , pattern Bytes , pattern Chars #endif ) where import Control.Lens import Data.Word (Word8) import Data.ByteString as Strict import qualified Data.ByteString.Strict.Lens as Strict import Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy.Lens as Lazy -- | Traversals for ByteStrings. class IsByteString t where -- | 'Data.ByteString.pack' (or 'Data.ByteString.unpack') a list of bytes into a strict or lazy 'ByteString'. -- -- @ -- 'Data.ByteString.pack' x ≡ x '^.' 'packedBytes' -- 'Data.ByteString.unpack' x ≡ x '^.' 'from' 'packedBytes' -- 'packedBytes' ≡ 'from' 'unpackedBytes' -- @ packedBytes :: Iso' [Word8] t -- | 'Data.ByteString.Char8.pack' (or 'Data.ByteString.Char8.unpack') a list of characters into a strict or lazy 'ByteString'. -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- @ -- 'Data.ByteString.Char8.pack' x ≡ x '^.' 'packedChars' -- 'Data.ByteString.Char8.unpack' x ≡ x '^.' 'from' 'packedChars' -- 'packedChars' ≡ 'from' 'unpackedChars' -- @ packedChars :: Iso' String t -- | Traverse each 'Word8' in a strict or lazy 'ByteString' -- -- -- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion -- enable zippers to seek to locations more quickly and accelerate -- many monoidal queries, but up to associativity (and constant factors) it is -- equivalent to the much slower: -- -- @ -- 'bytes' ≡ 'unpackedBytes' '.' 'traversed' -- @ -- -- @ -- 'anyOf' 'bytes' ('==' 0x80) :: 'ByteString' -> 'Bool' -- @ bytes :: IndexedTraversal' Int t Word8 bytes = from packedBytes . traversed {-# INLINE bytes #-} -- | Traverse the individual bytes in a strict or lazy 'ByteString' as characters. -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion -- enable zippers to seek to locations more quickly and accelerate -- many monoidal queries, but up to associativity (and constant factors) it is -- equivalent to the much slower: -- -- @ -- 'chars' ≡ 'unpackedChars' '.' 'traversed' -- @ -- -- @ -- 'anyOf' 'chars' ('==' \'c\') :: 'ByteString' -> 'Bool' -- @ chars :: IndexedTraversal' Int t Char chars = from packedChars . traversed {-# INLINE chars #-} -- | 'Data.ByteString.unpack' (or 'Data.ByteString.pack') a 'ByteString' into a list of bytes -- -- @ -- 'unpackedBytes' ≡ 'from' 'packedBytes' -- 'Data.ByteString.unpack' x ≡ x '^.' 'unpackedBytes' -- 'Data.ByteString.pack' x ≡ x '^.' 'from' 'unpackedBytes' -- @ -- -- @ -- 'unpackedBytes' :: 'Iso'' 'Data.ByteString.ByteString' ['Word8'] -- 'unpackedBytes' :: 'Iso'' 'Data.ByteString.Lazy.ByteString' ['Word8'] -- @ unpackedBytes :: IsByteString t => Iso' t [Word8] unpackedBytes = from packedBytes {-# INLINE unpackedBytes #-} #if __GLASGOW_HASKELL__ >= 710 pattern Bytes b <- (view unpackedBytes -> b) where Bytes b = review unpackedBytes b pattern Chars b <- (view unpackedChars -> b) where Chars b = review unpackedChars b #endif -- | 'Data.ByteString.Char8.unpack' (or 'Data.ByteString.Char8.pack') a list of characters into a strict (or lazy) 'ByteString' -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- @ -- 'unpackedChars' ≡ 'from' 'packedChars' -- 'Data.ByteString.Char8.unpack' x ≡ x '^.' 'unpackedChars' -- 'Data.ByteString.Char8.pack' x ≡ x '^.' 'from' 'unpackedChars' -- @ -- -- @ -- 'unpackedChars' :: 'Iso'' 'Data.ByteString.ByteString' 'String' -- 'unpackedChars' :: 'Iso'' 'Data.ByteString.Lazy.ByteString' 'String' -- @ unpackedChars :: IsByteString t => Iso' t String unpackedChars = from packedChars {-# INLINE unpackedChars #-} instance IsByteString Strict.ByteString where packedBytes = Strict.packedBytes {-# INLINE packedBytes #-} packedChars = Strict.packedChars {-# INLINE packedChars #-} bytes = Strict.bytes {-# INLINE bytes #-} chars = Strict.chars {-# INLINE chars #-} instance IsByteString Lazy.ByteString where packedBytes = Lazy.packedBytes {-# INLINE packedBytes #-} packedChars = Lazy.packedChars {-# INLINE packedChars #-} bytes = from packedBytes . traversed {-# INLINE bytes #-} chars = from packedChars . traversed {-# INLINE chars #-} lens-4.14/src/Data/ByteString/Lazy/0000755000000000000000000000000012710476104015244 5ustar0000000000000000lens-4.14/src/Data/ByteString/Lazy/Lens.hs0000644000000000000000000001115612710476104016505 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Lazy.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- Lazy 'ByteString' lenses. ---------------------------------------------------------------------------- module Data.ByteString.Lazy.Lens ( packedBytes, unpackedBytes, bytes , packedChars, unpackedChars, chars #if __GLASGOW_HASKELL__ >= 710 , pattern Bytes , pattern Chars #endif ) where import Control.Lens import Control.Lens.Internal.ByteString import Data.ByteString.Lazy as Words import Data.ByteString.Lazy.Char8 as Char8 import Data.Word (Word8) import Data.Int (Int64) -- $setup -- >>> :set -XOverloadedStrings -- >>> import Numeric.Lens -- | 'Data.ByteString.Lazy.pack' (or 'Data.ByteString.Lazy.unpack') a list of bytes into a 'ByteString'. -- -- @ -- 'packedBytes' ≡ 'from' 'unpackedBytes' -- 'Data.ByteString.pack' x ≡ x '^.' 'packedBytes' -- 'Data.ByteString.unpack' x ≡ x '^.' 'from' 'packedBytes' -- @ -- -- >>> [104,101,108,108,111]^.packedBytes == Char8.pack "hello" -- True packedBytes :: Iso' [Word8] ByteString packedBytes = iso Words.pack unpackLazy {-# INLINE packedBytes #-} -- | 'Data.ByteString.Lazy.unpack' (or 'Data.ByteString.Lazy.pack') a 'ByteString' into a list of bytes -- -- @ -- 'unpackedBytes' ≡ 'from' 'packedBytes' -- 'Data.ByteString.unpack' x ≡ x '^.' 'unpackedBytes' -- 'Data.ByteString.pack' x ≡ x '^.' 'from' 'unpackedBytes' -- @ -- -- >>> "hello"^.packedChars.unpackedBytes -- [104,101,108,108,111] unpackedBytes :: Iso' ByteString [Word8] unpackedBytes = from packedBytes {-# INLINE unpackedBytes #-} -- | Traverse the individual bytes in a 'ByteString'. -- -- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion -- enable zippers to seek to locations more quickly and accelerate -- many monoidal queries, but up to associativity (and constant factors) it is -- equivalent to the much slower: -- -- @ -- 'bytes' ≡ 'unpackedBytes' '.' 'traversed' -- @ -- -- >>> anyOf bytes (== 0x80) (Char8.pack "hello") -- False -- -- Note that when just using this as a 'Setter', @'setting' 'Data.ByteString.Lazy.map'@ -- can be more efficient. bytes :: IndexedTraversal' Int64 ByteString Word8 bytes = traversedLazy {-# INLINE bytes #-} -- | 'Data.ByteString.Lazy.Char8.pack' (or 'Data.ByteString.Lazy.Char8.unpack') a list of characters into a 'ByteString'. -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- @ -- 'packedChars' ≡ 'from' 'unpackedChars' -- 'Data.ByteString.Char8.pack' x ≡ x '^.' 'packedChars' -- 'Data.ByteString.Char8.unpack' x ≡ x '^.' 'from' 'packedChars' -- @ -- -- >>> "hello"^.packedChars.each.re (base 16 . enum).to (\x -> if Prelude.length x == 1 then '0':x else x) -- "68656c6c6f" packedChars :: Iso' String ByteString packedChars = iso Char8.pack unpackLazy8 {-# INLINE packedChars #-} -- | 'Data.ByteString.Lazy.Char8.unpack' (or 'Data.ByteString.Lazy.Char8.pack') a list of characters into a 'ByteString' -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- @ -- 'unpackedChars' ≡ 'from' 'packedChars' -- 'Data.ByteString.Char8.unpack' x ≡ x '^.' 'unpackedChars' -- 'Data.ByteString.Char8.pack' x ≡ x '^.' 'from' 'unpackedChars' -- @ -- -- >>> [104,101,108,108,111]^.packedBytes.unpackedChars -- "hello" unpackedChars :: Iso' ByteString String unpackedChars = from packedChars {-# INLINE unpackedChars #-} -- | Traverse the individual bytes in a 'ByteString' as characters. -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion -- enable zippers to seek to locations more quickly and accelerate -- many monoidal queries, but up to associativity (and constant factors) it is -- equivalent to: -- -- @ -- 'chars' = 'unpackedChars' '.' 'traversed' -- @ -- -- >>> anyOf chars (== 'h') "hello" -- True chars :: IndexedTraversal' Int64 ByteString Char chars = traversedLazy8 {-# INLINE chars #-} #if __GLASGOW_HASKELL__ >= 710 pattern Bytes b <- (view unpackedBytes -> b) where Bytes b = review unpackedBytes b pattern Chars b <- (view unpackedChars -> b) where Chars b = review unpackedChars b #endif lens-4.14/src/Data/ByteString/Strict/0000755000000000000000000000000012710476104015575 5ustar0000000000000000lens-4.14/src/Data/ByteString/Strict/Lens.hs0000644000000000000000000001075512710476104017042 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Strict.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Data.ByteString.Strict.Lens ( packedBytes, unpackedBytes, bytes , packedChars, unpackedChars, chars #if __GLASGOW_HASKELL__ >= 710 , pattern Bytes , pattern Chars #endif ) where import Control.Lens import Control.Lens.Internal.ByteString import Data.ByteString as Words import Data.ByteString.Char8 as Char8 import Data.Word -- $setup -- >>> import Control.Lens -- >>> import Numeric.Lens -- | 'Data.ByteString.pack' (or 'Data.ByteString.unpack') a list of bytes into a 'ByteString' -- -- @ -- 'packedBytes' ≡ 'from' 'unpackedBytes' -- 'Data.ByteString.pack' x ≡ x '^.' 'packedBytes' -- 'Data.ByteString.unpack' x ≡ x '^.' 'from' 'packedBytes' -- @ -- -- >>> [104,101,108,108,111]^.packedBytes -- "hello" packedBytes :: Iso' [Word8] ByteString packedBytes = iso Words.pack unpackStrict {-# INLINE packedBytes #-} -- | 'Data.ByteString.unpack' (or 'Data.ByteString.pack') a 'ByteString' into a list of bytes -- -- @ -- 'unpackedBytes' ≡ 'from' 'packedBytes' -- 'Data.ByteString.unpack' x ≡ x '^.' 'unpackedBytes' -- 'Data.ByteString.pack' x ≡ x '^.' 'from' 'unpackedBytes' -- @ -- -- >>> "hello"^.packedChars.unpackedBytes -- [104,101,108,108,111] unpackedBytes :: Iso' ByteString [Word8] unpackedBytes = from packedBytes {-# INLINE unpackedBytes #-} -- | Traverse each 'Word8' in a 'ByteString'. -- -- This 'Traversal' walks the 'ByteString' in a tree-like fashion -- enable zippers to seek to locations in logarithmic time and accelerating -- many monoidal queries, but up to associativity (and constant factors) -- it is equivalent to the much slower: -- -- @ -- 'bytes' ≡ 'unpackedBytes' '.' 'traversed' -- @ -- -- >>> anyOf bytes (== 0x80) (Char8.pack "hello") -- False -- -- Note that when just using this as a 'Setter', @'setting' 'Data.ByteString.map'@ -- can be more efficient. bytes :: IndexedTraversal' Int ByteString Word8 bytes = traversedStrictTree {-# INLINE bytes #-} -- | 'Data.ByteString.Char8.pack' (or 'Data.ByteString.Char8.unpack') a list of characters into a 'ByteString' -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- @ -- 'packedChars' ≡ 'from' 'unpackedChars' -- 'Data.ByteString.Char8.pack' x ≡ x '^.' 'packedChars' -- 'Data.ByteString.Char8.unpack' x ≡ x '^.' 'from' 'packedChars' -- @ -- -- >>> "hello"^.packedChars.each.re (base 16 . enum).to (\x -> if Prelude.length x == 1 then '0':x else x) -- "68656c6c6f" packedChars :: Iso' String ByteString packedChars = iso Char8.pack unpackStrict8 {-# INLINE packedChars #-} -- | 'Data.ByteString.Char8.unpack' (or 'Data.ByteString.Char8.pack') a list of characters into a 'ByteString' -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- @ -- 'unpackedChars' ≡ 'from' 'packedChars' -- 'Data.ByteString.Char8.unpack' x ≡ x '^.' 'unpackedChars' -- 'Data.ByteString.Char8.pack' x ≡ x '^.' 'from' 'unpackedChars' -- @ -- -- >>> [104,101,108,108,111]^.packedBytes.unpackedChars -- "hello" unpackedChars :: Iso' ByteString String unpackedChars = from packedChars {-# INLINE unpackedChars #-} -- | Traverse the individual bytes in a 'ByteString' as characters. -- -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. -- -- This 'Traversal' walks the 'ByteString' in a tree-like fashion -- enable zippers to seek to locations in logarithmic time and accelerating -- many monoidal queries, but up to associativity (and constant factors) -- it is equivalent to the much slower: -- -- @ -- 'chars' = 'unpackedChars' '.' 'traverse' -- @ -- -- >>> anyOf chars (== 'h') "hello" -- True chars :: IndexedTraversal' Int ByteString Char chars = traversedStrictTree8 {-# INLINE chars #-} #if __GLASGOW_HASKELL__ >= 710 pattern Bytes b <- (view unpackedBytes -> b) where Bytes b = review unpackedBytes b pattern Chars b <- (view unpackedChars -> b) where Chars b = review unpackedChars b #endif lens-4.14/src/Data/Complex/0000755000000000000000000000000012710476104013642 5ustar0000000000000000lens-4.14/src/Data/Complex/Lens.hs0000644000000000000000000001010712710476104015076 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Complex.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- Lenses and traversals for complex numbers -- ---------------------------------------------------------------------------- module Data.Complex.Lens ( _realPart , _imagPart , _polar , _magnitude , _phase , _conjugate #if __GLASGOW_HASKELL__ >= 710 -- * Pattern Synonyms , pattern Polar , pattern Real , pattern Imaginary , pattern Conjugate #endif ) where import Control.Lens import Data.Complex #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -- $setup -- >>> import Debug.SimpleReflect -- >>> let { a ≈ b = abs (a - b) < 1e-6; infix 4 ≈ } -- | Access the 'realPart' of a 'Complex' number. -- -- >>> (a :+ b)^._realPart -- a -- -- >>> a :+ b & _realPart *~ 2 -- a * 2 :+ b -- -- @'_realPart' :: 'Functor' f => (a -> f a) -> 'Complex' a -> f ('Complex' a)@ _realPart :: Lens' (Complex a) a _realPart f (a :+ b) = (:+ b) <$> f a {-# INLINE _realPart #-} -- | Access the 'imagPart' of a 'Complex' number. -- -- >>> (a :+ b)^._imagPart -- b -- -- >>> a :+ b & _imagPart *~ 2 -- a :+ b * 2 -- -- @'_imagPart' :: 'Functor' f => (a -> f a) -> 'Complex' a -> f ('Complex' a)@ _imagPart :: Lens' (Complex a) a _imagPart f (a :+ b) = (a :+) <$> f b {-# INLINE _imagPart #-} -- | This isn't /quite/ a legal 'Lens'. Notably the -- -- @'view' l ('set' l b a) = b@ -- -- law is violated when you set a 'polar' value with 0 'magnitude' and non-zero -- 'phase' as the 'phase' information is lost, or with a negative 'magnitude' -- which flips the 'phase' and retains a positive 'magnitude'. So don't do -- that! -- -- Otherwise, this is a perfectly cromulent 'Lens'. _polar :: RealFloat a => Iso' (Complex a) (a,a) _polar = iso polar (uncurry mkPolar) {-# INLINE _polar #-} #if __GLASGOW_HASKELL__ >= 710 pattern Polar m theta <- (view _polar -> (m, theta)) where Polar m theta = review _polar (m, theta) pattern Real r = r :+ 0 pattern Imaginary i = 0 :+ i #endif -- | Access the 'magnitude' of a 'Complex' number. -- -- >>> (10.0 :+ 20.0) & _magnitude *~ 2 -- 20.0 :+ 40.0 -- -- This isn't /quite/ a legal 'Lens'. Notably the -- -- @'view' l ('set' l b a) = b@ -- -- law is violated when you set a negative 'magnitude'. This flips the 'phase' -- and retains a positive 'magnitude'. So don't do that! -- -- Otherwise, this is a perfectly cromulent 'Lens'. -- -- Setting the 'magnitude' of a zero 'Complex' number assumes the 'phase' is 0. _magnitude :: RealFloat a => Lens' (Complex a) a _magnitude f c = setMag <$> f r where setMag r' | r /= 0 = c * (r' / r :+ 0) | otherwise = r' :+ 0 r = magnitude c {-# INLINE _magnitude #-} -- | Access the 'phase' of a 'Complex' number. -- -- >>> (mkPolar 10 (2-pi) & _phase +~ pi & view _phase) ≈ 2 -- True -- -- This isn't /quite/ a legal 'Lens'. Notably the -- -- @'view' l ('set' l b a) = b@ -- -- law is violated when you set a 'phase' outside the range @(-'pi', 'pi']@. -- The phase is always in that range when queried. So don't do that! -- -- Otherwise, this is a perfectly cromulent 'Lens'. _phase :: RealFloat a => Lens' (Complex a) a _phase f c = setPhase <$> f theta where setPhase theta' = c * cis (theta' - theta) theta = phase c {-# INLINE _phase #-} -- | Access the 'conjugate' of a 'Complex' number. -- -- >>> (2.0 :+ 3.0) & _conjugate . _imagPart -~ 1 -- 2.0 :+ 4.0 -- -- >>> (mkPolar 10.0 2.0 ^. _conjugate . _phase) ≈ (-2.0) -- True _conjugate :: RealFloat a => Iso' (Complex a) (Complex a) _conjugate = involuted conjugate {-# INLINE _conjugate #-} #if __GLASGOW_HASKELL__ >= 710 pattern Conjugate a <- (conjugate -> a) where Conjugate a = conjugate a #endif lens-4.14/src/Data/Data/0000755000000000000000000000000012710476104013104 5ustar0000000000000000lens-4.14/src/Data/Data/Lens.hs0000644000000000000000000003765212710476104014356 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE Rank2Types #-} #ifndef HLINT {-# LANGUAGE UnboxedTuples #-} #endif {-# LANGUAGE PatternGuards #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif {-# OPTIONS_GHC -fno-full-laziness #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Data.Lens -- Copyright : (C) 2012-2016 Edward Kmett, (C) 2006-2012 Neil Mitchell -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : Rank2Types -- -- Smart and naïve generic traversals given 'Data' instances. -- -- 'template', 'uniplate', and 'biplate' each build up information about what -- types can be contained within another type to speed up 'Traversal'. -- ---------------------------------------------------------------------------- module Data.Data.Lens ( -- * Generic Traversal template , tinplate , uniplate , biplate -- * Field Accessor Traversal , upon , upon' , onceUpon , onceUpon' -- * Data Traversal , gtraverse ) where import Control.Applicative import Control.Exception as E import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed import Control.Lens.Lens import Control.Lens.Setter import Control.Lens.Traversal import Control.Lens.Type import Data.Data import GHC.IO import Data.Maybe import Data.Foldable import qualified Data.HashMap.Strict as M import Data.HashMap.Strict (HashMap, (!)) import qualified Data.HashSet as S import Data.HashSet (HashSet) import Data.IORef import Data.Monoid import GHC.Exts (realWorld#) import Prelude #ifdef HLINT {-# ANN module "HLint: ignore Eta reduce" #-} {-# ANN module "HLint: ignore Use foldl" #-} {-# ANN module "HLint: ignore Reduce duplication" #-} {-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-} #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens ------------------------------------------------------------------------------- -- Generic Traversal ------------------------------------------------------------------------------- -- | A generic applicative transformation that maps over the immediate subterms. -- -- 'gtraverse' is to 'traverse' what 'gmapM' is to 'mapM' -- -- This really belongs in @Data.Data@. gtraverse :: (Applicative f, Data a) => (forall d. Data d => d -> f d) -> a -> f a gtraverse f = gfoldl (\x y -> x <*> f y) pure {-# INLINE gtraverse #-} ------------------------------------------------------------------------------- -- Naïve Traversal ------------------------------------------------------------------------------- -- | Naïve 'Traversal' using 'Data'. This does not attempt to optimize the traversal. -- -- This is primarily useful when the children are immediately obvious, and for benchmarking. tinplate :: (Data s, Typeable a) => Traversal' s a tinplate f = gfoldl (step f) pure {-# INLINE tinplate #-} step :: forall s a f r. (Applicative f, Typeable a, Data s) => (a -> f a) -> f (s -> r) -> s -> f r step f w s = w <*> case mightBe :: Maybe (Is s a) of Just Data.Data.Lens.Refl -> f s Nothing -> tinplate f s {-# INLINE step #-} ------------------------------------------------------------------------------- -- Smart Traversal ------------------------------------------------------------------------------- -- | Find every occurrence of a given type @a@ recursively that doesn't require -- passing through something of type @a@ using 'Data', while avoiding traversal -- of areas that cannot contain a value of type @a@. -- -- This is 'uniplate' with a more liberal signature. template :: forall s a. (Data s, Typeable a) => Traversal' s a template = uniplateData (fromOracle answer) where answer = hitTest (undefined :: s) (undefined :: a) {-# INLINE template #-} -- | Find descendants of type @a@ non-transitively, while avoiding computation of areas that cannot contain values of -- type @a@ using 'Data'. -- -- 'uniplate' is a useful default definition for 'Control.Lens.Plated.plate' uniplate :: Data a => Traversal' a a uniplate = template {-# INLINE uniplate #-} -- | 'biplate' performs like 'template', except when @s ~ a@, it returns itself and nothing else. biplate :: forall s a. (Data s, Typeable a) => Traversal' s a biplate = biplateData (fromOracle answer) where answer = hitTest (undefined :: s) (undefined :: a) {-# INLINE biplate #-} ------------------------------------------------------------------------------ -- Automatic Traversal construction from field accessors ------------------------------------------------------------------------------ data FieldException a = FieldException !Int a deriving Typeable instance Show (FieldException a) where showsPrec d (FieldException i _) = showParen (d > 10) $ showString "' instance Typeable a => Exception (FieldException a) lookupon :: Typeable a => LensLike' (Indexing Identity) s a -> (s -> a) -> s -> Maybe (Int, Context a a s) lookupon l field s = case unsafePerformIO $ E.try $ evaluate $ field $ s & indexing l %@~ \i (a::a) -> E.throw (FieldException i a) of Right _ -> Nothing Left e -> case fromException e of Nothing -> Nothing Just (FieldException i a) -> Just (i, Context (\a' -> set (elementOf l i) a' s) a) {-# INLINE lookupon #-} -- | This automatically constructs a 'Traversal'' from an function. -- -- >>> (2,4) & upon fst *~ 5 -- (10,4) -- -- There are however, caveats on how this function can be used! -- -- First, the user supplied function must access only one field of the specified type. That is to say the target -- must be a single element that would be visited by @'holesOnOf' 'template' 'uniplate'@ -- -- Note: this even permits a number of functions to be used directly. -- -- >>> [1,2,3,4] & upon head .~ 0 -- [0,2,3,4] -- -- >>> [1,2,3,4] & upon last .~ 5 -- [1,2,3,5] -- -- >>> [1,2,3,4] ^? upon tail -- Just [2,3,4] -- -- >>> "" ^? upon tail -- Nothing -- -- Accessing parents on the way down to children is okay: -- -- >>> [1,2,3,4] & upon (tail.tail) .~ [10,20] -- [1,2,10,20] -- -- Second, the structure must not contain strict or unboxed fields of the same type that will be visited by 'Data' -- -- @'upon' :: ('Data' s, 'Data' a) => (s -> a) -> 'IndexedTraversal'' [Int] s a@ upon :: forall p f s a. (Indexable [Int] p, Applicative f, Data s, Data a) => (s -> a) -> p a (f a) -> s -> f s upon field f s = case lookupon template field s of Nothing -> pure s Just (i, Context k0 a0) -> let go :: [Int] -> Traversal' s a -> (a -> s) -> a -> f s go is l k a = case lookupon (l.uniplate) field s of Nothing -> k <$> indexed f (reverse is) a Just (j, Context k' a') -> go (j:is) (l.elementOf uniplate j) k' a' in go [i] (elementOf template i) k0 a0 {-# INLINE upon #-} -- | The design of 'onceUpon'' doesn't allow it to search inside of values of type 'a' for other values of type 'a'. -- 'upon'' provides this additional recursion. -- -- Like 'onceUpon'', 'upon'' trusts the user supplied function more than 'upon' using it directly -- as the accessor. This enables reading from the resulting 'Lens' to be considerably faster at the risk of -- generating an illegal lens. -- -- >>> upon' (tail.tail) .~ [10,20] $ [1,2,3,4] -- [1,2,10,20] upon' :: forall s a. (Data s, Data a) => (s -> a) -> IndexedLens' [Int] s a upon' field f s = let ~(isn, kn) = case lookupon template field s of Nothing -> (error "upon': no index, not a member", const s) Just (i, Context k0 _) -> go [i] (elementOf template i) k0 go :: [Int] -> Traversal' s a -> (a -> s) -> ([Int], a -> s) go is l k = case lookupon (l.uniplate) field s of Nothing -> (reverse is, k) Just (j, Context k' _) -> go (j:is) (l.elementOf uniplate j) k' in kn <$> indexed f isn (field s) {-# INLINE upon' #-} -- | This automatically constructs a 'Traversal'' from a field accessor. -- -- The index of the 'Traversal' can be used as an offset into @'elementOf' ('indexing' 'template')@ or into the list -- returned by @'holesOf' 'template'@. -- -- The design of 'onceUpon' doesn't allow it to search inside of values of type 'a' for other values of type 'a'. -- 'upon' provides this additional recursion, but at the expense of performance. -- -- >>> onceUpon (tail.tail) .~ [10,20] $ [1,2,3,4] -- BAD -- [1,10,20] -- -- >>> upon (tail.tail) .~ [10,20] $ [1,2,3,4] -- GOOD -- [1,2,10,20] -- -- When in doubt, use 'upon' instead. onceUpon :: forall s a. (Data s, Typeable a) => (s -> a) -> IndexedTraversal' Int s a onceUpon field f s = case lookupon template field s of Nothing -> pure s Just (i, Context k a) -> k <$> indexed f i a {-# INLINE onceUpon #-} -- | This more trusting version of 'upon' uses your function directly as the getter for a 'Lens'. -- -- This means that reading from 'upon'' is considerably faster than 'upon'. -- -- However, you pay for faster access in two ways: -- -- 1. When passed an illegal field accessor, 'upon'' will give you a 'Lens' that quietly violates -- the laws, unlike 'upon', which will give you a legal 'Traversal' that avoids modifying the target. -- -- 2. Modifying with the lens is slightly slower, since it has to go back and calculate the index after the fact. -- -- When given a legal field accessor, the index of the 'Lens' can be used as an offset into -- @'elementOf' ('indexed' 'template')@ or into the list returned by @'holesOf' 'template'@. -- -- When in doubt, use 'upon'' instead. onceUpon' :: forall s a. (Data s, Typeable a) => (s -> a) -> IndexedLens' Int s a onceUpon' field f s = k <$> indexed f i (field s) where ~(i, Context k _) = fromMaybe (error "upon': no index, not a member") (lookupon template field s) {-# INLINE onceUpon' #-} ------------------------------------------------------------------------------- -- Type equality ------------------------------------------------------------------------------- data Is a b where Refl :: Is a a mightBe :: (Typeable a, Typeable b) => Maybe (Is a b) mightBe = gcast Data.Data.Lens.Refl {-# INLINE mightBe #-} ------------------------------------------------------------------------------- -- Data Box ------------------------------------------------------------------------------- data DataBox = forall a. Data a => DataBox { dataBoxKey :: TypeRep , _dataBoxVal :: a } dataBox :: Data a => a -> DataBox dataBox a = DataBox (typeOf a) a {-# INLINE dataBox #-} -- partial, caught elsewhere sybChildren :: Data a => a -> [DataBox] sybChildren x | isAlgType dt = do c <- dataTypeConstrs dt gmapQ dataBox (fromConstr c `asTypeOf` x) | otherwise = [] where dt = dataTypeOf x {-# INLINE sybChildren #-} ------------------------------------------------------------------------------- -- HitMap ------------------------------------------------------------------------------- type HitMap = HashMap TypeRep (HashSet TypeRep) emptyHitMap :: HitMap emptyHitMap = M.fromList [ (tRational, S.singleton tInteger) , (tInteger, S.empty) ] where tRational = typeOf (undefined :: Rational) tInteger = typeOf (undefined :: Integer ) insertHitMap :: DataBox -> HitMap -> HitMap insertHitMap box hit = fixEq trans (populate box) `mappend` hit where populate :: DataBox -> HitMap populate a = f a M.empty where f (DataBox k v) m | M.member k hit || M.member k m = m | cs <- sybChildren v = fs cs $ M.insert k (S.fromList $ map dataBoxKey cs) m fs [] m = m fs (x:xs) m = fs xs (f x m) trans :: HitMap -> HitMap trans m = M.map f m where f x = x `mappend` foldMap g x g x = fromMaybe (hit ! x) (M.lookup x m) fixEq :: Eq a => (a -> a) -> a -> a fixEq f = go where go x | x == x' = x' | otherwise = go x' where x' = f x {-# INLINE fixEq #-} #ifndef HLINT -- | inlineable 'unsafePerformIO' inlinePerformIO :: IO a -> a inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r {-# INLINE inlinePerformIO #-} #endif ------------------------------------------------------------------------------- -- Cache ------------------------------------------------------------------------------- data Cache = Cache HitMap (HashMap TypeRep (HashMap TypeRep (Maybe Follower))) cache :: IORef Cache cache = unsafePerformIO $ newIORef $ Cache emptyHitMap M.empty {-# NOINLINE cache #-} readCacheFollower :: DataBox -> TypeRep -> Maybe Follower readCacheFollower b@(DataBox kb _) ka = inlinePerformIO $ readIORef cache >>= \ (Cache hm m) -> case M.lookup kb m >>= M.lookup ka of Just a -> return a Nothing -> E.try (return $! insertHitMap b hm) >>= \r -> case r of Left SomeException{} -> atomicModifyIORef cache $ \(Cache hm' n) -> (Cache hm' (insert2 kb ka Nothing n), Nothing) Right hm' | fol <- Just (follower kb ka hm') -> atomicModifyIORef cache $ \(Cache _ n) -> (Cache hm' (insert2 kb ka fol n), fol) insert2 :: TypeRep -> TypeRep -> a -> HashMap TypeRep (HashMap TypeRep a) -> HashMap TypeRep (HashMap TypeRep a) insert2 x y v = M.insertWith (const $ M.insert y v) x (M.singleton y v) {-# INLINE insert2 #-} {- readCacheHitMap :: DataBox -> Maybe HitMap readCacheHitMap b@(DataBox kb _) = inlinePerformIO $ readIORef cache >>= \ (Cache hm _) -> case M.lookup kb hm of Just _ -> return $ Just hm Nothing -> E.try (return $! insertHitMap b hm) >>= \r -> case r of Left SomeException{} -> return Nothing Right hm' -> atomicModifyIORef cache $ \(Cache _ follow) -> (Cache hm' follow, Just hm') -} ------------------------------------------------------------------------------- -- Answers ------------------------------------------------------------------------------- data Answer b a = b ~ a => Hit a | Follow | Miss ------------------------------------------------------------------------------- -- Oracles ------------------------------------------------------------------------------- newtype Oracle a = Oracle { fromOracle :: forall t. Typeable t => t -> Answer t a } hitTest :: forall a b. (Data a, Typeable b) => a -> b -> Oracle b hitTest a b = Oracle $ \(c :: c) -> case mightBe :: Maybe (Is c b) of Just Data.Data.Lens.Refl -> Hit c Nothing -> case readCacheFollower (dataBox a) (typeOf b) of Just p | not (p (typeOf c)) -> Miss _ -> Follow ------------------------------------------------------------------------------- -- Traversals ------------------------------------------------------------------------------- biplateData :: forall f s a. (Applicative f, Data s) => (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s biplateData o f a0 = go2 a0 where go :: Data d => d -> f d go s = gfoldl (\x y -> x <*> go2 y) pure s go2 :: Data d => d -> f d go2 s = case o s of Hit a -> f a Follow -> go s Miss -> pure s {-# INLINE biplateData #-} uniplateData :: forall f s a. (Applicative f, Data s) => (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s uniplateData o f a0 = go a0 where go :: Data d => d -> f d go s = gfoldl (\x y -> x <*> go2 y) pure s go2 :: Data d => d -> f d go2 s = case o s of Hit a -> f a Follow -> go s Miss -> pure s {-# INLINE uniplateData #-} ------------------------------------------------------------------------------- -- Follower ------------------------------------------------------------------------------- part :: (a -> Bool) -> HashSet a -> (HashSet a, HashSet a) part p s = (S.filter p s, S.filter (not . p) s) {-# INLINE part #-} type Follower = TypeRep -> Bool follower :: TypeRep -> TypeRep -> HitMap -> Follower follower a b m | S.null hit = const False | S.null miss = const True | S.size hit < S.size miss = S.member ?? hit | otherwise = \k -> not (S.member k miss) where (hit, miss) = part (\x -> S.member b (m ! x)) (S.insert a (m ! a)) lens-4.14/src/Data/Dynamic/0000755000000000000000000000000012710476104013617 5ustar0000000000000000lens-4.14/src/Data/Dynamic/Lens.hs0000644000000000000000000000327612710476104015064 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Dynamic.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Data.Dynamic.Lens ( AsDynamic(..) #if __GLASGOW_HASKELL__ >= 710 , pattern Dynamic #endif ) where import Control.Exception import Control.Exception.Lens import Control.Lens import Data.Dynamic -- | Any 'Dynamic' can be thrown as an 'Exception' class AsDynamic t where -- | This 'Prism' allows you to traverse the typed value contained in a -- 'Dynamic' where the type required by your function matches that -- of the contents of the 'Dynamic', or construct a 'Dynamic' value -- out of whole cloth. It can also be used to catch or throw a 'Dynamic' -- value as 'SomeException'. -- -- @ -- '_Dynamic' :: 'Typeable' a => 'Prism'' 'Dynamic' a -- '_Dynamic' :: 'Typeable' a => 'Prism'' 'SomeException' a -- @ _Dynamic :: Typeable a => Prism' t a instance AsDynamic Dynamic where _Dynamic = prism' toDyn fromDynamic {-# INLINE _Dynamic #-} instance AsDynamic SomeException where _Dynamic = exception.prism' toDyn fromDynamic {-# INLINE _Dynamic #-} #if __GLASGOW_HASKELL__ >= 710 pattern Dynamic a <- (preview _Dynamic -> Just a) where Dynamic a = review _Dynamic a #endif lens-4.14/src/Data/HashSet/0000755000000000000000000000000012710476104013572 5ustar0000000000000000lens-4.14/src/Data/HashSet/Lens.hs0000644000000000000000000000353212710476104015032 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.HashSet.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.HashSet.Lens ( setmapped , setOf ) where import Control.Lens.Getter (Getting, views) import Control.Lens.Setter (setting) import Control.Lens.Type import Data.HashSet as HashSet import Data.Hashable -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- | This 'Setter' can be used to change the type of a 'HashSet' by mapping -- the elements to new values. -- -- Sadly, you can't create a valid 'Traversal' for a 'Set', but you can -- manipulate it by reading using 'Control.Lens.Fold.folded' and reindexing it via 'setmapped'. setmapped :: (Eq j, Hashable j) => IndexPreservingSetter (HashSet i) (HashSet j) i j setmapped = setting HashSet.map {-# INLINE setmapped #-} -- | Construct a set from a 'Getter', 'Control.Lens.Fold.Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Lens.Lens' or 'Control.Lens.Iso.Iso'. -- -- @ -- 'setOf' :: 'Hashable' a => 'Getter' s a -> s -> 'HashSet' a -- 'setOf' :: ('Eq' a, 'Hashable' a) => 'Fold' s a -> s -> 'HashSet' a -- 'setOf' :: 'Hashable' a => 'Iso'' s a -> s -> 'HashSet' a -- 'setOf' :: 'Hashable' a => 'Lens'' s a -> s -> 'HashSet' a -- 'setOf' :: ('Eq' a, 'Hashable' a) => 'Traversal'' s a -> s -> 'HashSet' a -- @ setOf :: Hashable a => Getting (HashSet a) s a -> s -> HashSet a setOf l = views l HashSet.singleton {-# INLINE setOf #-} lens-4.14/src/Data/IntSet/0000755000000000000000000000000012710476104013441 5ustar0000000000000000lens-4.14/src/Data/IntSet/Lens.hs0000644000000000000000000000362212710476104014701 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} ----------------------------------------------------------------------------- -- | -- Module : Data.IntSet.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.IntSet.Lens ( members , setmapped , setOf ) where import Control.Lens import Data.IntSet as IntSet -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- | IntSet isn't Foldable, but this 'Fold' can be used to access the members of an 'IntSet'. -- -- >>> sumOf members $ setOf folded [1,2,3,4] -- 10 members :: Fold IntSet Int members = folding IntSet.toAscList {-# INLINE members #-} -- | This 'Setter' can be used to change the contents of an 'IntSet' by mapping -- the elements to new values. -- -- Sadly, you can't create a valid 'Traversal' for a 'Set', because the number of -- elements might change but you can manipulate it by reading using 'folded' and -- reindexing it via 'setmapped'. -- -- >>> over setmapped (+1) (fromList [1,2,3,4]) -- fromList [2,3,4,5] setmapped :: IndexPreservingSetter' IntSet Int setmapped = setting IntSet.map {-# INLINE setmapped #-} -- | Construct an 'IntSet' from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'. -- -- >>> setOf folded [1,2,3,4] -- fromList [1,2,3,4] -- -- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)] -- fromList [1,2,3] -- -- @ -- 'setOf' :: 'Getter' s 'Int' -> s -> 'IntSet' -- 'setOf' :: 'Fold' s 'Int' -> s -> 'IntSet' -- 'setOf' :: 'Iso'' s 'Int' -> s -> 'IntSet' -- 'setOf' :: 'Lens'' s 'Int' -> s -> 'IntSet' -- 'setOf' :: 'Traversal'' s 'Int' -> s -> 'IntSet' -- @ setOf :: Getting IntSet s Int -> s -> IntSet setOf l = views l IntSet.singleton {-# INLINE setOf #-} lens-4.14/src/Data/List/0000755000000000000000000000000012710476104013146 5ustar0000000000000000lens-4.14/src/Data/List/Lens.hs0000644000000000000000000001012212710476104014377 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.List.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- Traversals for manipulating parts of a list. -- -- Additional optics for manipulating lists are present more -- generically in this package. -- -- The 'Control.Lens.At.Ixed' class allows traversing the element at a -- specific list index. -- -- >>> [0..10] ^? ix 4 -- Just 4 -- -- >>> [0..5] & ix 4 .~ 2 -- [0,1,2,3,2,5] -- -- >>> [0..10] ^? ix 14 -- Nothing -- -- >>> [0..5] & ix 14 .~ 2 -- [0,1,2,3,4,5] -- -- The 'Control.Lens.Cons.Cons' and 'Control.Lens.Empty.AsEmpty' -- classes provide 'Control.Lens.Prism.Prism's for list constructors. -- -- >>> [1..10] ^? _Cons -- Just (1,[2,3,4,5,6,7,8,9,10]) -- -- >>> [] ^? _Cons -- Nothing -- -- >>> [] ^? _Empty -- Just () -- -- >>> _Cons # (1, _Empty # ()) :: [Int] -- [1] -- -- Additionally, 'Control.Lens.Cons.Snoc' provides a -- 'Control.Lens.Prism.Prism' for accessing the end of a list. Note -- that this 'Control.Lens.Prism.Prism' always will need to traverse -- the whole list. -- -- >>> [1..5] ^? _Snoc -- Just ([1,2,3,4],5) -- -- >>> _Snoc # ([1,2],5) -- [1,2,5] -- -- An instance of 'Control.Lens.Plated.Plated' allows for finding -- locations in the list where a traversal matches. -- -- >>> [Nothing, Just 7, Just 3, Nothing] & deep (ix 0 . _Just) +~ 10 -- [Nothing,Just 17,Just 3,Nothing] -- -- An instance of 'Control.Lens.Iso.Reversing' provides an -- 'Control.Lens.Iso.Iso' between a list and its reverse. -- -- >>> "live" & reversed %~ ('d':) -- "lived" -- -- Finally, it's possible to traverse, fold over, and map over -- index-value pairs thanks to instances of -- 'Control.Lens.Indexed.TraversableWithIndex', -- 'Control.Lens.Indexed.FoldableWithIndex', and -- 'Control.Lens.Indexed.FunctorWithIndex'. -- -- >>> imap (,) "Hello" -- [(0,'H'),(1,'e'),(2,'l'),(3,'l'),(4,'o')] -- -- >>> ifoldMap replicate "Hello" -- "ellllloooo" -- -- >>> itraverse_ (curry print) "Hello" -- (0,'H') -- (1,'e') -- (2,'l') -- (3,'l') -- (4,'o') -- ---------------------------------------------------------------------------- module Data.List.Lens ( prefixed , suffixed , stripSuffix ) where import Control.Monad (guard) import Control.Lens import Data.List #if !MIN_VERSION_base(4,8,0) import Data.Functor #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g) -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- | A 'Prism' stripping a prefix from a list when used as a 'Traversal', or -- prepending that prefix when run backwards: -- -- >>> "preview" ^? prefixed "pre" -- Just "view" -- -- >>> "review" ^? prefixed "pre" -- Nothing -- -- >>> prefixed "pre" # "amble" -- "preamble" prefixed :: Eq a => [a] -> Prism' [a] [a] prefixed ps = prism' (ps ++) (stripPrefix ps) {-# INLINE prefixed #-} -- | A 'Prism' stripping a suffix from a list when used as a 'Traversal', or -- appending that suffix when run backwards: -- -- >>> "review" ^? suffixed "view" -- Just "re" -- -- >>> "review" ^? suffixed "tire" -- Nothing -- -- >>> suffixed ".o" # "hello" -- "hello.o" suffixed :: Eq a => [a] -> Prism' [a] [a] suffixed qs = prism' (++ qs) (stripSuffix qs) {-# INLINE suffixed #-} ------------------------------------------------------------------------------ -- Util ------------------------------------------------------------------------------ stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] stripSuffix qs xs0 = go xs0 zs where zs = drp qs xs0 drp (_:ps) (_:xs) = drp ps xs drp [] xs = xs drp _ [] = [] go (_:xs) (_:ys) = go xs ys go xs [] = zipWith const xs0 zs <$ guard (xs == qs) go [] _ = Nothing -- impossible {-# INLINE stripSuffix #-} lens-4.14/src/Data/Map/0000755000000000000000000000000012710476104012750 5ustar0000000000000000lens-4.14/src/Data/Map/Lens.hs0000644000000000000000000000443112710476104014207 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Copyright : (C) 2014-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- One of most commonly-asked questions about this package is whether -- it provides lenses for working with 'Data.Map.Map'. It does, but their uses -- are perhaps obscured by their genericity. This module exists to provide -- documentation for them. -- -- 'Data.Map.Map' is an instance of 'Control.Lens.At.At', so we have a lenses -- on values at keys: -- -- >>> Map.fromList [(1, "world")] ^.at 1 -- Just "world" -- -- >>> at 1 .~ Just "world" $ Map.empty -- fromList [(1,"world")] -- -- >>> at 0 ?~ "hello" $ Map.empty -- fromList [(0,"hello")] -- -- We can traverse, fold over, and map over key-value pairs in a -- 'Data.Map.Map', thanks to its 'Control.Lens.Indexed.TraversableWithIndex', -- 'Control.Lens.Indexed.FoldableWithIndex', and -- 'Control.Lens.Indexed.FunctorWithIndex' instances. -- -- >>> imap const $ Map.fromList [(1, "Venus")] -- fromList [(1,1)] -- -- >>> ifoldMap (\i _ -> Sum i) $ Map.fromList [(2, "Earth"), (3, "Mars")] -- Sum {getSum = 5} -- -- >>> itraverse_ (curry print) $ Map.fromList [(4, "Jupiter")] -- (4,"Jupiter") -- -- >>> itoList $ Map.fromList [(5, "Saturn")] -- [(5,"Saturn")] -- -- A related class, 'Control.Lens.At.Ixed', allows us to use -- 'Control.Lens.At.ix' to traverse a value at a particular key. -- -- >>> ix 2 %~ ("New " ++) $ Map.fromList [(2, "Earth")] -- fromList [(2,"New Earth")] -- -- >>> preview (ix 8) $ Map.empty -- Nothing -- -- Additionally, 'Data.Map.Map' has 'Control.Lens.Traversal.TraverseMin' and -- 'Control.Lens.Traversal.TraverseMax' instances, which let us traverse over -- the value at the least and greatest keys, respectively. -- -- >>> preview traverseMin $ Map.fromList [(5, "Saturn"), (6, "Uranus")] -- Just "Saturn" -- -- >>> preview traverseMax $ Map.fromList [(5, "Saturn"), (6, "Uranus")] -- Just "Uranus" -- ----------------------------------------------------------------------------- module Data.Map.Lens () where -- $setup -- >>> import Control.Lens -- >>> import Data.Monoid -- >>> import qualified Data.Map as Map -- >>> :set -XNoOverloadedStrings lens-4.14/src/Data/Sequence/0000755000000000000000000000000012710476104014003 5ustar0000000000000000lens-4.14/src/Data/Sequence/Lens.hs0000644000000000000000000000742512710476104015250 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Sequence.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Data.Sequence.Lens ( viewL, viewR , sliced, slicedTo, slicedFrom , seqOf ) where import Control.Applicative import Control.Lens import Data.Monoid import Data.Sequence as Seq import Prelude -- $setup -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g) -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- * Sequence isomorphisms -- | A 'Seq' is isomorphic to a 'ViewL' -- -- @'viewl' m ≡ m '^.' 'viewL'@ -- -- >>> Seq.fromList [a,b,c] ^. viewL -- a :< fromList [b,c] -- -- >>> Seq.empty ^. viewL -- EmptyL -- -- >>> EmptyL ^. from viewL -- fromList [] -- -- >>> review viewL $ a Seq.:< fromList [b,c] -- fromList [a,b,c] viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b) viewL = iso viewl $ \ xs -> case xs of EmptyL -> mempty a Seq.:< as -> a Seq.<| as {-# INLINE viewL #-} -- | A 'Seq' is isomorphic to a 'ViewR' -- -- @'viewr' m ≡ m '^.' 'viewR'@ -- -- >>> Seq.fromList [a,b,c] ^. viewR -- fromList [a,b] :> c -- -- >>> Seq.empty ^. viewR -- EmptyR -- -- >>> EmptyR ^. from viewR -- fromList [] -- -- >>> review viewR $ fromList [a,b] Seq.:> c -- fromList [a,b,c] viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b) viewR = iso viewr $ \xs -> case xs of EmptyR -> mempty as Seq.:> a -> as Seq.|> a {-# INLINE viewR #-} -- | Traverse the first @n@ elements of a 'Seq' -- -- >>> fromList [a,b,c,d,e] ^.. slicedTo 2 -- [a,b] -- -- >>> fromList [a,b,c,d,e] & slicedTo 2 %~ f -- fromList [f a,f b,c,d,e] -- -- >>> fromList [a,b,c,d,e] & slicedTo 10 .~ x -- fromList [x,x,x,x,x] slicedTo :: Int -> IndexedTraversal' Int (Seq a) a slicedTo n f m = case Seq.splitAt n m of (l,r) -> (>< r) <$> itraverse (indexed f) l {-# INLINE slicedTo #-} -- | Traverse all but the first @n@ elements of a 'Seq' -- -- >>> fromList [a,b,c,d,e] ^.. slicedFrom 2 -- [c,d,e] -- -- >>> fromList [a,b,c,d,e] & slicedFrom 2 %~ f -- fromList [a,b,f c,f d,f e] -- -- >>> fromList [a,b,c,d,e] & slicedFrom 10 .~ x -- fromList [a,b,c,d,e] slicedFrom :: Int -> IndexedTraversal' Int (Seq a) a slicedFrom n f m = case Seq.splitAt n m of (l,r) -> (l ><) <$> itraverse (indexed f . (+n)) r {-# INLINE slicedFrom #-} -- | Traverse all the elements numbered from @i@ to @j@ of a 'Seq' -- -- >>> fromList [a,b,c,d,e] & sliced 1 3 %~ f -- fromList [a,f b,f c,d,e] -- >>> fromList [a,b,c,d,e] ^.. sliced 1 3 -- [f b,f c] -- -- >>> fromList [a,b,c,d,e] & sliced 1 3 .~ x -- fromList [a,x,x,b,e] sliced :: Int -> Int -> IndexedTraversal' Int (Seq a) a sliced i j f s = case Seq.splitAt i s of (l,mr) -> case Seq.splitAt (j-i) mr of (m, r) -> itraverse (indexed f . (+i)) m <&> \n -> l >< n >< r {-# INLINE sliced #-} -- | Construct a 'Seq' from a 'Getter', 'Control.Lens.Fold.Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Lens.Lens' or 'Control.Lens.Iso.Iso'. -- -- >>> seqOf folded ["hello","world"] -- fromList ["hello","world"] -- -- >>> seqOf (folded._2) [("hello",1),("world",2),("!!!",3)] -- fromList [1,2,3] -- -- @ -- 'seqOf' :: 'Getter' s a -> s -> 'Seq' a -- 'seqOf' :: 'Fold' s a -> s -> 'Seq' a -- 'seqOf' :: 'Iso'' s a -> s -> 'Seq' a -- 'seqOf' :: 'Lens'' s a -> s -> 'Seq' a -- 'seqOf' :: 'Traversal'' s a -> s -> 'Seq' a -- @ seqOf :: Getting (Seq a) s a -> s -> Seq a seqOf l = views l Seq.singleton {-# INLINE seqOf #-} lens-4.14/src/Data/Set/0000755000000000000000000000000012710476104012766 5ustar0000000000000000lens-4.14/src/Data/Set/Lens.hs0000644000000000000000000000403012710476104014220 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} #ifndef MIN_VERSION_containers #define MIN_VERSION_containers(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Set.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Set.Lens ( setmapped , setOf ) where import Control.Lens.Getter ( Getting, views ) import Control.Lens.Setter ( setting ) import Control.Lens.Type import Data.Set as Set -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- | This 'Setter' can be used to change the type of a 'Set' by mapping -- the elements to new values. -- -- Sadly, you can't create a valid 'Traversal' for a 'Set', but you can -- manipulate it by reading using 'Control.Lens.Fold.folded' and reindexing it via 'setmapped'. -- -- >>> over setmapped (+1) (fromList [1,2,3,4]) -- fromList [2,3,4,5] #if MIN_VERSION_containers(0,5,2) setmapped :: Ord j => IndexPreservingSetter (Set i) (Set j) i j #else setmapped :: (Ord i, Ord j) => IndexPreservingSetter (Set i) (Set j) i j #endif setmapped = setting Set.map {-# INLINE setmapped #-} -- | Construct a set from a 'Getter', 'Control.Lens.Fold.Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Lens.Lens' or 'Control.Lens.Iso.Iso'. -- -- >>> setOf folded ["hello","world"] -- fromList ["hello","world"] -- -- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)] -- fromList [1,2,3] -- -- @ -- 'setOf' :: 'Getter' s a -> s -> 'Set' a -- 'setOf' :: 'Ord' a => 'Fold' s a -> s -> 'Set' a -- 'setOf' :: 'Iso'' s a -> s -> 'Set' a -- 'setOf' :: 'Lens'' s a -> s -> 'Set' a -- 'setOf' :: 'Ord' a => 'Traversal'' s a -> s -> 'Set' a -- @ setOf :: Getting (Set a) s a -> s -> Set a setOf l = views l Set.singleton {-# INLINE setOf #-} lens-4.14/src/Data/Text/0000755000000000000000000000000012710476104013157 5ustar0000000000000000lens-4.14/src/Data/Text/Lens.hs0000644000000000000000000000616512710476104014424 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Data.Text.Lens ( IsText(..) , unpacked , _Text #if __GLASGOW_HASKELL__ >= 710 , pattern Text #endif ) where import Control.Lens.Type #if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Getter import Control.Lens.Review #endif import Control.Lens.Iso import Control.Lens.Traversal import Data.Text as Strict import qualified Data.Text.Strict.Lens as Strict import Data.Text.Lazy as Lazy import qualified Data.Text.Lazy.Lens as Lazy import Data.Text.Lazy.Builder -- $setup -- >>> import Control.Lens -- | Traversals for strict or lazy 'Text' class IsText t where -- | This isomorphism can be used to 'pack' (or 'unpack') strict or lazy 'Text'. -- -- @ -- 'pack' x ≡ x '^.' 'packed' -- 'unpack' x ≡ x '^.' 'from' 'packed' -- 'packed' ≡ 'from' 'unpacked' -- @ packed :: Iso' String t -- | Convert between strict or lazy 'Text' and a 'Builder'. -- -- @ -- 'fromText' x ≡ x '^.' 'builder' -- @ builder :: Iso' t Builder -- | Traverse the individual characters in strict or lazy 'Text'. -- -- @ -- 'text' = 'unpacked' . 'traversed' -- @ text :: IndexedTraversal' Int t Char text = unpacked . traversed {-# INLINE text #-} instance IsText String where packed = id {-# INLINE packed #-} text = traversed {-# INLINE text #-} builder = Lazy.packed . builder {-# INLINE builder #-} -- | This isomorphism can be used to 'unpack' (or 'pack') both strict or lazy 'Text'. -- -- @ -- 'unpack' x ≡ x '^.' 'unpacked' -- 'pack' x ≡ x '^.' 'from' 'unpacked' -- @ -- -- This 'Iso' is provided for notational convenience rather than out of great need, since -- -- @ -- 'unpacked' ≡ 'from' 'packed' -- @ -- unpacked :: IsText t => Iso' t String unpacked = from packed {-# INLINE unpacked #-} -- | This is an alias for 'unpacked' that makes it clearer how to use it with @('#')@. -- -- @ -- '_Text' = 'from' 'packed' -- @ -- -- >>> _Text # "hello" :: Strict.Text -- "hello" _Text :: IsText t => Iso' t String _Text = from packed {-# INLINE _Text #-} #if __GLASGOW_HASKELL__ >= 710 pattern Text a <- (view _Text -> a) where Text a = review _Text a #endif instance IsText Strict.Text where packed = Strict.packed {-# INLINE packed #-} builder = Strict.builder {-# INLINE builder #-} text = Strict.text {-# INLINE text #-} instance IsText Lazy.Text where packed = Lazy.packed {-# INLINE packed #-} builder = Lazy.builder {-# INLINE builder #-} text = Lazy.text {-# INLINE text #-} lens-4.14/src/Data/Text/Lazy/0000755000000000000000000000000012710476104014076 5ustar0000000000000000lens-4.14/src/Data/Text/Lazy/Lens.hs0000644000000000000000000000775212710476104015346 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Lazy.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Data.Text.Lazy.Lens ( packed, unpacked , _Text , text , builder , utf8 #if __GLASGOW_HASKELL__ >= 710 , pattern Text #endif ) where import Control.Lens.Type import Control.Lens.Getter import Control.Lens.Fold import Control.Lens.Iso import Control.Lens.Prism #if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Review #endif import Control.Lens.Setter import Control.Lens.Traversal import Data.ByteString.Lazy as ByteString import Data.Monoid import Data.Text.Lazy as Text import Data.Text.Lazy.Builder import Data.Text.Lazy.Encoding -- $setup -- >>> :set -XOverloadedStrings -- >>> import Control.Lens -- | This isomorphism can be used to 'pack' (or 'unpack') lazy 'Text'. -- -- >>> "hello"^.packed -- :: Text -- "hello" -- -- @ -- 'pack' x ≡ x '^.' 'packed' -- 'unpack' x ≡ x '^.' 'from' 'packed' -- 'packed' ≡ 'from' 'unpacked' -- @ packed :: Iso' String Text packed = iso Text.pack Text.unpack {-# INLINE packed #-} -- | This isomorphism can be used to 'unpack' (or 'pack') lazy 'Text'. -- -- >>> "hello"^.unpacked -- :: String -- "hello" -- -- @ -- 'pack' x ≡ x '^.' 'from' 'unpacked' -- 'unpack' x ≡ x '^.' 'packed' -- @ -- -- This 'Iso' is provided for notational convenience rather than out of great need, since -- -- @ -- 'unpacked' ≡ 'from' 'packed' -- @ unpacked :: Iso' Text String unpacked = iso Text.unpack Text.pack {-# INLINE unpacked #-} -- | This is an alias for 'unpacked' that makes it clearer how to use it with @('#')@. -- -- @ -- '_Text' = 'from' 'packed' -- @ -- -- >>> _Text # "hello" -- :: Text -- "hello" _Text :: Iso' Text String _Text = from packed {-# INLINE _Text #-} -- | Convert between lazy 'Text' and 'Builder' . -- -- @ -- 'fromLazyText' x ≡ x '^.' 'builder' -- 'toLazyText' x ≡ x '^.' 'from' 'builder' -- @ builder :: Iso' Text Builder builder = iso fromLazyText toLazyText {-# INLINE builder #-} -- | Traverse the individual characters in a 'Text'. -- -- >>> anyOf text (=='c') "chello" -- True -- -- @ -- 'text' = 'unpacked' . 'traversed' -- @ -- -- When the type is unambiguous, you can also use the more general 'each'. -- -- @ -- 'text' ≡ 'each' -- @ -- -- Note that when just using this as a 'Setter', @'setting' 'Data.Text.Lazy.map'@ -- can be more efficient. text :: IndexedTraversal' Int Text Char text = unpacked . traversed {-# INLINE [0] text #-} {-# RULES "lazy text -> map" text = sets Text.map :: ASetter' Text Char; "lazy text -> imap" text = isets imapLazy :: AnIndexedSetter' Int Text Char; "lazy text -> foldr" text = foldring Text.foldr :: Getting (Endo r) Text Char; "lazy text -> ifoldr" text = ifoldring ifoldrLazy :: IndexedGetting Int (Endo r) Text Char; #-} imapLazy :: (Int -> Char -> Char) -> Text -> Text imapLazy f = snd . Text.mapAccumL (\i a -> i `seq` (i + 1, f i a)) 0 {-# INLINE imapLazy #-} ifoldrLazy :: (Int -> Char -> a -> a) -> a -> Text -> a ifoldrLazy f z xs = Text.foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 {-# INLINE ifoldrLazy #-} -- | Encode/Decode a lazy 'Text' to/from lazy 'ByteString', via UTF-8. -- -- Note: This function does not decode lazily, as it must consume the entire -- input before deciding whether or not it fails. -- -- >>> ByteString.unpack (utf8 # "☃") -- [226,152,131] utf8 :: Prism' ByteString Text utf8 = prism' encodeUtf8 (preview _Right . decodeUtf8') {-# INLINE utf8 #-} #if __GLASGOW_HASKELL__ >= 710 pattern Text a <- (view _Text -> a) where Text a = review _Text a #endif lens-4.14/src/Data/Text/Strict/0000755000000000000000000000000012710476104014427 5ustar0000000000000000lens-4.14/src/Data/Text/Strict/Lens.hs0000644000000000000000000000760612710476104015675 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Strict.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Data.Text.Strict.Lens ( packed, unpacked , builder , text , utf8 , _Text #if __GLASGOW_HASKELL__ >= 710 , pattern Text #endif ) where import Control.Lens.Type import Control.Lens.Getter import Control.Lens.Fold import Control.Lens.Iso import Control.Lens.Prism #if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Review #endif import Control.Lens.Setter import Control.Lens.Traversal import Data.ByteString (ByteString) import Data.Monoid import Data.Text as Strict import Data.Text.Encoding import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder -- $setup -- >>> :set -XOverloadedStrings -- >>> import Control.Lens -- | This isomorphism can be used to 'pack' (or 'unpack') strict 'Text'. -- -- -- >>> "hello"^.packed -- :: Text -- "hello" -- -- @ -- 'pack' x ≡ x '^.' 'packed' -- 'unpack' x ≡ x '^.' 'from' 'packed' -- 'packed' ≡ 'from' 'unpacked' -- 'packed' ≡ 'iso' 'pack' 'unpack' -- @ packed :: Iso' String Text packed = iso pack unpack {-# INLINE packed #-} -- | This isomorphism can be used to 'unpack' (or 'pack') lazy 'Text'. -- -- >>> "hello"^.unpacked -- :: String -- "hello" -- -- This 'Iso' is provided for notational convenience rather than out of great need, since -- -- @ -- 'unpacked' ≡ 'from' 'packed' -- @ -- -- @ -- 'pack' x ≡ x '^.' 'from' 'unpacked' -- 'unpack' x ≡ x '^.' 'packed' -- 'unpacked' ≡ 'iso' 'unpack' 'pack' -- @ unpacked :: Iso' Text String unpacked = iso unpack pack {-# INLINE unpacked #-} -- | This is an alias for 'unpacked' that makes it more obvious how to use it with '#' -- -- >> _Text # "hello" -- :: Text -- "hello" _Text :: Iso' Text String _Text = unpacked {-# INLINE _Text #-} -- | Convert between strict 'Text' and 'Builder' . -- -- @ -- 'fromText' x ≡ x '^.' 'builder' -- 'toStrict' ('toLazyText' x) ≡ x '^.' 'from' 'builder' -- @ builder :: Iso' Text Builder builder = iso fromText (toStrict . toLazyText) {-# INLINE builder #-} -- | Traverse the individual characters in strict 'Text'. -- -- >>> anyOf text (=='o') "hello" -- True -- -- When the type is unambiguous, you can also use the more general 'each'. -- -- @ -- 'text' ≡ 'unpacked' . 'traversed' -- 'text' ≡ 'each' -- @ -- -- Note that when just using this as a 'Setter', @'setting' 'Data.Text.map'@ can -- be more efficient. text :: IndexedTraversal' Int Text Char text = unpacked . traversed {-# INLINE [0] text #-} {-# RULES "strict text -> map" text = sets Strict.map :: ASetter' Text Char; "strict text -> imap" text = isets imapStrict :: AnIndexedSetter' Int Text Char; "strict text -> foldr" text = foldring Strict.foldr :: Getting (Endo r) Text Char; "strict text -> ifoldr" text = ifoldring ifoldrStrict :: IndexedGetting Int (Endo r) Text Char; #-} imapStrict :: (Int -> Char -> Char) -> Text -> Text imapStrict f = snd . Strict.mapAccumL (\i a -> i `seq` (i + 1, f i a)) 0 {-# INLINE imapStrict #-} ifoldrStrict :: (Int -> Char -> a -> a) -> a -> Text -> a ifoldrStrict f z xs = Strict.foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 {-# INLINE ifoldrStrict #-} -- | Encode/Decode a strict 'Text' to/from strict 'ByteString', via UTF-8. -- -- >>> utf8 # "☃" -- "\226\152\131" utf8 :: Prism' ByteString Text utf8 = prism' encodeUtf8 (preview _Right . decodeUtf8') {-# INLINE utf8 #-} #if __GLASGOW_HASKELL__ >= 710 pattern Text a <- (view _Text -> a) where Text a = review _Text a #endif lens-4.14/src/Data/Tree/0000755000000000000000000000000012710476104013132 5ustar0000000000000000lens-4.14/src/Data/Tree/Lens.hs0000644000000000000000000000204412710476104014367 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Tree.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : MTPCs -- ---------------------------------------------------------------------------- module Data.Tree.Lens ( root , branches ) where import Control.Lens import Data.Tree #if !MIN_VERSION_base(4,8,0) import Data.Functor #endif -- | A 'Lens' that focuses on the root of a 'Tree'. -- -- >>> view root $ Node 42 [] -- 42 root :: Lens' (Tree a) a root f (Node a as) = (`Node` as) <$> f a {-# INLINE root #-} -- | A 'Lens' returning the direct descendants of the root of a 'Tree' -- -- @'view' 'branches' ≡ 'subForest'@ branches :: Lens' (Tree a) [Tree a] branches f (Node a as) = Node a <$> f as {-# INLINE branches #-} lens-4.14/src/Data/Typeable/0000755000000000000000000000000012710476104014000 5ustar0000000000000000lens-4.14/src/Data/Typeable/Lens.hs0000644000000000000000000000232312710476104015235 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Typeable.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : Rank2Types -- ---------------------------------------------------------------------------- module Data.Typeable.Lens ( _cast , _gcast ) where import Control.Lens import Data.Typeable import Data.Maybe #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -- | A 'Traversal'' for working with a 'cast' of a 'Typeable' value. _cast :: (Typeable s, Typeable a) => Traversal' s a _cast f s = case cast s of Just a -> fromMaybe (error "_cast: recast failed") . cast <$> f a Nothing -> pure s {-# INLINE _cast #-} -- | A 'Traversal'' for working with a 'gcast' of a 'Typeable' value. _gcast :: (Typeable s, Typeable a) => Traversal' (c s) (c a) _gcast f s = case gcast s of Just a -> fromMaybe (error "_gcast: recast failed") . gcast <$> f a Nothing -> pure s {-# INLINE _gcast #-} lens-4.14/src/Data/Vector/0000755000000000000000000000000012710476104013475 5ustar0000000000000000lens-4.14/src/Data/Vector/Lens.hs0000644000000000000000000000557612710476104014747 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Data.Vector.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- -- This module provides lenses and traversals for working with generic -- vectors. ------------------------------------------------------------------------------- module Data.Vector.Lens ( toVectorOf -- * Isomorphisms , vector , forced -- * Lenses , sliced -- * Traversal of individual indices , ordinals ) where import Control.Applicative import Control.Lens import Control.Lens.Internal.List (ordinalNub) import Data.Vector as Vector hiding (zip, filter, indexed) import Prelude hiding ((++), length, null, head, tail, init, last, map, reverse) import Data.Monoid -- | @sliced i n@ provides a 'Lens' that edits the @n@ elements starting -- at index @i@ from a 'Lens'. -- -- This is only a valid 'Lens' if you do not change the length of the -- resulting 'Vector'. -- -- Attempting to return a longer or shorter vector will result in -- violations of the 'Lens' laws. -- -- >>> Vector.fromList [1..10] ^. sliced 2 5 == Vector.fromList [3,4,5,6,7] -- True -- -- >>> (Vector.fromList [1..10] & sliced 2 5 . mapped .~ 0) == Vector.fromList [1,2,0,0,0,0,0,8,9,10] -- True sliced :: Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Lens' (Vector a) (Vector a) sliced i n f v = f (slice i n v) <&> \ v0 -> v // zip [i..i+n-1] (toList v0) {-# INLINE sliced #-} -- | Similar to 'toListOf', but returning a 'Vector'. -- -- >>> toVectorOf both (8,15) == Vector.fromList [8,15] -- True toVectorOf :: Getting (Endo [a]) s a -> s -> Vector a toVectorOf l s = fromList (toListOf l s) {-# INLINE toVectorOf #-} -- | Convert a list to a 'Vector' (or back) -- -- >>> [1,2,3] ^. vector == Vector.fromList [1,2,3] -- True -- -- >>> [1,2,3] ^. vector . from vector -- [1,2,3] -- -- >>> Vector.fromList [0,8,15] ^. from vector . vector == Vector.fromList [0,8,15] -- True vector :: Iso [a] [b] (Vector a) (Vector b) vector = iso fromList toList {-# INLINE vector #-} -- | Convert a 'Vector' to a version that doesn't retain any extra -- memory. forced :: Iso (Vector a) (Vector b) (Vector a) (Vector b) forced = iso force force {-# INLINE forced #-} -- | This 'Traversal' will ignore any duplicates in the supplied list -- of indices. -- -- >>> toListOf (ordinals [1,3,2,5,9,10]) $ Vector.fromList [2,4..40] -- [4,8,6,12,20,22] ordinals :: [Int] -> IndexedTraversal' Int (Vector a) a ordinals is f v = fmap (v //) $ traverse (\i -> (,) i <$> indexed f i (v ! i)) $ ordinalNub (length v) is {-# INLINE ordinals #-} lens-4.14/src/Data/Vector/Generic/0000755000000000000000000000000012710476104015051 5ustar0000000000000000lens-4.14/src/Data/Vector/Generic/Lens.hs0000644000000000000000000001304612710476104016312 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_vector #define MIN_VERSION_vector(x,y,z) 1 #endif ------------------------------------------------------------------------------- -- | -- Module : Data.Vector.Generic.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- -- This module provides lenses and traversals for working with generic -- vectors. ------------------------------------------------------------------------------- module Data.Vector.Generic.Lens ( toVectorOf -- * Isomorphisms , forced , vector , asStream , asStreamR , cloned , converted -- * Lenses , sliced -- * Traversal of individual indices , ordinals , vectorIx , vectorTraverse ) where import Control.Applicative import Control.Lens.Type import Control.Lens.Lens import Control.Lens.Getter import Control.Lens.Fold import Control.Lens.Iso import Control.Lens.Indexed import Control.Lens.Setter import Control.Lens.Traversal import Control.Lens.Internal.List (ordinalNub) import Data.Monoid import Data.Vector.Generic as V hiding (zip, filter, indexed) import Data.Vector.Generic.New (New) import Prelude hiding ((++), length, null, head, tail, init, last, map, reverse) #if MIN_VERSION_vector(0,11,0) import Data.Vector.Fusion.Bundle (Bundle) #else import Data.Vector.Fusion.Stream (Stream) #endif -- $setup -- >>> import Data.Vector as Vector -- | @sliced i n@ provides a 'Lens' that edits the @n@ elements starting -- at index @i@ from a 'Lens'. -- -- This is only a valid 'Lens' if you do not change the length of the -- resulting 'Vector'. -- -- Attempting to return a longer or shorter vector will result in -- violations of the 'Lens' laws. -- -- >>> Vector.fromList [1..10] ^. sliced 2 5 == Vector.fromList [3,4,5,6,7] -- True -- -- >>> (Vector.fromList [1..10] & sliced 2 5 . mapped .~ 0) == Vector.fromList [1,2,0,0,0,0,0,8,9,10] -- True sliced :: Vector v a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Lens' (v a) (v a) sliced i n f v = f (slice i n v) <&> \ v0 -> v // zip [i..i+n-1] (V.toList v0) {-# INLINE sliced #-} -- | Similar to 'toListOf', but returning a 'Vector'. -- -- >>> (toVectorOf both (8,15) :: Vector.Vector Int) == Vector.fromList [8,15] -- True toVectorOf :: Vector v a => Getting (Endo [a]) s a -> s -> v a toVectorOf l s = fromList (toListOf l s) {-# INLINE toVectorOf #-} -- | Convert a list to a 'Vector' (or back.) -- -- >>> ([1,2,3] ^. vector :: Vector.Vector Int) == Vector.fromList [1,2,3] -- True -- -- >>> Vector.fromList [0,8,15] ^. from vector -- [0,8,15] vector :: (Vector v a, Vector v b) => Iso [a] [b] (v a) (v b) vector = iso fromList V.toList {-# INLINE vector #-} #if MIN_VERSION_vector(0,11,0) -- | Convert a 'Vector' to a finite 'Bundle' (or back.) asStream :: (Vector v a, Vector v b) => Iso (v a) (v b) (Bundle v a) (Bundle v b) #else -- | Convert a 'Vector' to a finite 'Stream' (or back.) asStream :: (Vector v a, Vector v b) => Iso (v a) (v b) (Stream a) (Stream b) #endif asStream = iso stream unstream {-# INLINE asStream #-} #if MIN_VERSION_vector(0,11,0) -- | Convert a 'Vector' to a finite 'Bundle' from right to left (or -- back.) asStreamR :: (Vector v a, Vector v b) => Iso (v a) (v b) (Bundle v a) (Bundle v b) #else -- | Convert a 'Vector' to a finite 'Stream' from right to left (or -- back.) asStreamR :: (Vector v a, Vector v b) => Iso (v a) (v b) (Stream a) (Stream b) #endif asStreamR = iso streamR unstreamR {-# INLINE asStreamR #-} -- | Convert a 'Vector' back and forth to an initializer that when run -- produces a copy of the 'Vector'. cloned :: Vector v a => Iso' (v a) (New v a) cloned = iso clone new {-# INLINE cloned #-} -- | Convert a 'Vector' to a version that doesn't retain any extra -- memory. forced :: Vector v a => Iso' (v a) (v a) forced = involuted force {-# INLINE forced #-} -- | This 'Traversal' will ignore any duplicates in the supplied list -- of indices. -- -- >>> toListOf (ordinals [1,3,2,5,9,10]) $ Vector.fromList [2,4..40] -- [4,8,6,12,20,22] ordinals :: Vector v a => [Int] -> IndexedTraversal' Int (v a) a ordinals is f v = fmap (v //) $ traverse (\i -> (,) i <$> indexed f i (v ! i)) $ ordinalNub (length v) is {-# INLINE ordinals #-} -- | Like 'ix' but polymorphic in the vector type. vectorIx :: V.Vector v a => Int -> Traversal' (v a) a vectorIx i f v | 0 <= i && i < V.length v = f (v V.! i) <&> \a -> v V.// [(i, a)] | otherwise = pure v {-# INLINE vectorIx #-} -- | Indexed vector traversal for a generic vector. vectorTraverse :: (V.Vector v a, V.Vector w b) => IndexedTraversal Int (v a) (w b) a b vectorTraverse f v = V.fromListN (V.length v) <$> traversed f (V.toList v) {-# INLINE [0] vectorTraverse #-} {-# RULES "vectorTraverse -> mapped" vectorTraverse = sets V.map :: (V.Vector v a, V.Vector v b) => ASetter (v a) (v b) a b; "vectorTraverse -> imapped" vectorTraverse = isets V.imap :: (V.Vector v a, V.Vector v b) => AnIndexedSetter Int (v a) (v b) a b; "vectorTraverse -> foldr" vectorTraverse = foldring V.foldr :: V.Vector v a => Getting (Endo r) (v a) a; "vectorTraverse -> ifoldr" vectorTraverse = ifoldring V.ifoldr :: V.Vector v a => IndexedGetting Int (Endo r) (v a) a; #-} -- | Different vector implementations are isomorphic to each other. converted :: (Vector v a, Vector w a, Vector v b, Vector w b) => Iso (v a) (v b) (w a) (w b) converted = iso convert convert lens-4.14/src/Generics/0000755000000000000000000000000012710476104013121 5ustar0000000000000000lens-4.14/src/Generics/Deriving/0000755000000000000000000000000012710476104014670 5ustar0000000000000000lens-4.14/src/Generics/Deriving/Lens.hs0000644000000000000000000000722512710476104016133 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 711 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Generics.Deriving.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : GHC -- -- Note: @Generics.Deriving@ exports a number of names that collide with @Control.Lens@. -- -- You can use hiding to mitigate this to an extent, and the following import -- represents a fair compromise for user code: -- -- > import Generics.Deriving hiding (from, to) -- -- You can use 'generic' to replace 'Generics.Deriving.from' and -- 'Generics.Deriving.to' from @Generics.Deriving@. ---------------------------------------------------------------------------- module Generics.Deriving.Lens ( -- * Isomorphisms for @GHC.Generics@ generic , generic1 -- * Generic Traversal , tinplate , GTraversal ) where import Control.Lens import Data.Maybe (fromJust) import Data.Typeable import qualified GHC.Generics as Generic import GHC.Generics hiding (from, to) #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -- $setup -- >>> :set -XNoOverloadedStrings -- | Convert from the data type to its representation (or back) -- -- >>> "hello"^.generic.from generic :: String -- "hello" generic :: Generic a => Iso' a (Generic.Rep a b) generic = iso Generic.from Generic.to {-# INLINE generic #-} -- | Convert from the data type to its representation (or back) generic1 :: Generic1 f => Iso' (f a) (Rep1 f a) generic1 = iso from1 to1 {-# INLINE generic1 #-} -- | A 'GHC.Generics.Generic' 'Traversal' that visits every occurrence -- of something 'Typeable' anywhere in a container. -- -- >>> allOf tinplate (=="Hello") (1::Int,2::Double,(),"Hello",["Hello"]) -- True -- -- >>> mapMOf_ tinplate putStrLn ("hello",[(2 :: Int, "world!")]) -- hello -- world! tinplate :: (Generic a, GTraversal (Generic.Rep a), Typeable b) => Traversal' a b tinplate = generic . tinplated Nothing {-# INLINE tinplate #-} maybeArg1Of :: Maybe c -> (c -> d) -> Maybe c maybeArg1Of = const {-# INLINE maybeArg1Of #-} -- | Used to traverse 'Generic' data by 'uniplate'. class GTraversal f where tinplated :: Typeable b => Maybe TypeRep -> Traversal' (f a) b instance (Generic a, GTraversal (Generic.Rep a), Typeable a) => GTraversal (K1 i a) where tinplated prev f (K1 a) = case cast a `maybeArg1Of` f of Just b -> K1 . fromJust . cast <$> f b Nothing -> case prev of Just rep | rep == typeOf a -> pure (K1 a) _ -> K1 <$> fmap generic (tinplated (Just (typeOf a))) f a {-# INLINE tinplated #-} instance GTraversal U1 where tinplated _ _ U1 = pure U1 {-# INLINE tinplated #-} instance GTraversal V1 where tinplated _ _ v = v `seq` undefined {-# INLINE tinplated #-} instance (GTraversal f, GTraversal g) => GTraversal (f :*: g) where tinplated _ f (x :*: y) = (:*:) <$> tinplated Nothing f x <*> tinplated Nothing f y {-# INLINE tinplated #-} instance (GTraversal f, GTraversal g) => GTraversal (f :+: g) where tinplated _ f (L1 x) = L1 <$> tinplated Nothing f x tinplated _ f (R1 x) = R1 <$> tinplated Nothing f x {-# INLINE tinplated #-} instance GTraversal a => GTraversal (M1 i c a) where tinplated prev f (M1 x) = M1 <$> tinplated prev f x {-# INLINE tinplated #-} lens-4.14/src/GHC/0000755000000000000000000000000012710476104011763 5ustar0000000000000000lens-4.14/src/GHC/Generics/0000755000000000000000000000000012710476104013522 5ustar0000000000000000lens-4.14/src/GHC/Generics/Lens.hs0000644000000000000000000000452112710476104014761 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Generics.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : GHC -- -- Note: @GHC.Generics@ exports a number of names that collide with @Control.Lens@. -- -- You can use hiding or imports to mitigate this to an extent, and the following imports, -- represent a fair compromise for user code: -- -- > import Control.Lens hiding (Rep) -- > import GHC.Generics hiding (from, to) -- -- You can use 'generic' to replace 'GHC.Generics.from' and 'GHC.Generics.to' from @GHC.Generics@, -- and probably won't be explicitly referencing 'Control.Lens.Representable.Rep' from @Control.Lens@ -- in code that uses generics. -- -- This module provides compatibility with older GHC versions by using the -- -- package. ---------------------------------------------------------------------------- module GHC.Generics.Lens ( module Generics.Deriving.Lens , _V1 , _U1 , _Par1 , _Rec1 , _K1 , _M1 , _L1 , _R1 ) where import Control.Lens import Generics.Deriving.Lens import GHC.Generics _V1 :: Over p f (V1 s) (V1 t) a b _V1 _ = absurd where absurd !_a = undefined {-# INLINE _V1 #-} _U1 :: Iso (U1 p) (U1 q) () () _U1 = iso (const ()) (const U1) {-# INLINE _U1 #-} _Par1 :: Iso (Par1 p) (Par1 q) p q _Par1 = iso unPar1 Par1 {-# INLINE _Par1 #-} _Rec1 :: Iso (Rec1 f p) (Rec1 g q) (f p) (g q) _Rec1 = iso unRec1 Rec1 {-# INLINE _Rec1 #-} _K1 :: Iso (K1 i c p) (K1 j d q) c d _K1 = iso unK1 K1 {-# INLINE _K1 #-} _M1 :: Iso (M1 i c f p) (M1 j d g q) (f p) (g q) _M1 = iso unM1 M1 {-# INLINE _M1 #-} _L1 :: Prism' ((f :+: g) a) (f a) _L1 = prism remitter reviewer where remitter = L1 reviewer (L1 l) = Right l reviewer x = Left x {-# INLINE _L1 #-} -- | You can access fields of `data (f :*: g) p` by using it's `Field1` and `Field2` instances _R1 :: Prism' ((f :+: g) a) (g a) _R1 = prism remitter reviewer where remitter = R1 reviewer (R1 l) = Right l reviewer x = Left x {-# INLINE _R1 #-} lens-4.14/src/Language/0000755000000000000000000000000012710476104013105 5ustar0000000000000000lens-4.14/src/Language/Haskell/0000755000000000000000000000000012710476104014470 5ustar0000000000000000lens-4.14/src/Language/Haskell/TH/0000755000000000000000000000000012710476104015003 5ustar0000000000000000lens-4.14/src/Language/Haskell/TH/Lens.hs0000644000000000000000000016176612710476104016261 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Trustworthy #-} #endif {-# LANGUAGE Rank2Types #-} #ifndef MIN_VERSION_template_haskell #define MIN_VERSION_template_haskell(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.TH.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : TemplateHaskell -- -- Lenses, Prisms, and Traversals for working with Template Haskell ---------------------------------------------------------------------------- module Language.Haskell.TH.Lens ( -- * Traversals HasName(..) , HasTypes(..) , HasTypeVars(..) , SubstType(..) , typeVars -- :: HasTypeVars t => Traversal' t Name , substTypeVars -- :: HasTypeVars t => Map Name Name -> t -> t , conFields , conNamedFields -- * Lenses -- ** Loc Lenses , locFileName , locPackage , locModule , locStart , locEnd -- ** FunDep Lenses , funDepInputs , funDepOutputs -- ** Match Lenses , matchPattern , matchBody , matchDeclarations -- ** Fixity Lenses , fixityPrecedence , fixityDirection -- ** Clause Lenses , clausePattern , clauseBody , clauseDecs -- ** FieldExp Lenses , fieldExpName , fieldExpExpression -- ** FieldPat Lenses , fieldPatName , fieldPatPattern #if MIN_VERSION_template_haskell(2,9,0) -- ** TySynEqn Lenses , tySynEqnPatterns , tySynEqnResult #endif #if MIN_VERSION_template_haskell(2,11,0) -- ** InjectivityAnn Lenses , injectivityAnnOutput , injectivityAnnInputs -- ** TypeFamilyHead Lenses , typeFamilyHeadName , typeFamilyHeadTyVarBndrs , typeFamilyHeadResultSig , typeFamilyHeadInjectivityAnn -- ** Bang Prisms , bangSourceUnpackedness , bangSourceStrictness #endif -- * Prisms -- ** Info Prisms , _ClassI , _ClassOpI , _TyConI , _FamilyI , _PrimTyConI , _DataConI , _VarI , _TyVarI -- ** Dec Prisms , _FunD , _ValD , _DataD , _NewtypeD , _TySynD , _ClassD , _InstanceD , _SigD , _ForeignD #if MIN_VERSION_template_haskell(2,8,0) , _InfixD #endif , _PragmaD , _DataInstD , _NewtypeInstD , _TySynInstD #if MIN_VERSION_template_haskell(2,9,0) , _ClosedTypeFamilyD , _RoleAnnotD #endif #if MIN_VERSION_template_haskell(2,10,0) , _StandaloneDerivD , _DefaultSigD #endif #if MIN_VERSION_template_haskell(2,11,0) , _DataFamilyD , _OpenTypeFamilyD #else , _FamilyD #endif -- ** Con Prisms , _NormalC , _RecC , _InfixC , _ForallC #if MIN_VERSION_template_haskell(2,11,0) , _GadtC , _RecGadtC #endif #if MIN_VERSION_template_haskell(2,11,0) -- ** Overlap Prisms ,_Overlappable ,_Overlapping ,_Overlaps ,_Incoherent #endif #if MIN_VERSION_template_haskell(2,11,0) -- ** SourceUnpackedness Prisms , _NoSourceUnpackedness , _SourceNoUnpack , _SourceUnpack -- ** SourceStrictness Prisms , _NoSourceStrictness , _SourceLazy , _SourceStrict -- ** DecidedStrictness Prisms , _DecidedLazy , _DecidedStrict , _DecidedUnpack #else -- ** Strict Prisms , _IsStrict , _NotStrict , _Unpacked #endif -- ** Foreign Prisms , _ImportF , _ExportF -- ** Callconv Prisms , _CCall , _StdCall #if MIN_VERSION_template_haskell(2,10,0) , _CApi , _Prim , _JavaScript #endif -- ** Safety Prisms , _Unsafe , _Safe , _Interruptible -- ** Pragma Prisms , _InlineP , _SpecialiseP #if MIN_VERSION_template_haskell(2,8,0) , _SpecialiseInstP , _RuleP #if MIN_VERSION_template_haskell(2,9,0) , _AnnP #endif #if MIN_VERSION_template_haskell(2,10,0) , _LineP #endif -- ** Inline Prisms , _NoInline , _Inline , _Inlinable -- ** RuleMatch Prisms , _ConLike , _FunLike -- ** Phases Prisms , _AllPhases , _FromPhase , _BeforePhase -- ** RuleBndr Prisms , _RuleVar , _TypedRuleVar #endif #if MIN_VERSION_template_haskell(2,9,0) -- ** AnnTarget Prisms , _ModuleAnnotation , _TypeAnnotation , _ValueAnnotation #endif -- ** FunDep Prisms TODO make a lens , _FunDep -- ** FamFlavour Prisms , _TypeFam , _DataFam -- ** FixityDirection Prisms , _InfixL , _InfixR , _InfixN -- ** Exp Prisms , _VarE , _ConE , _LitE , _AppE , _InfixE , _UInfixE , _ParensE , _LamE #if MIN_VERSION_template_haskell(2,8,0) , _LamCaseE #endif , _TupE , _UnboxedTupE , _CondE #if MIN_VERSION_template_haskell(2,8,0) , _MultiIfE #endif , _LetE , _CaseE , _DoE , _CompE , _ArithSeqE , _ListE , _SigE , _RecConE , _RecUpdE #if MIN_VERSION_template_haskell(2,10,0) , _StaticE #endif #if MIN_VERSION_template_haskell(2,11,0) , _UnboundVarE #endif -- ** Body Prisms , _GuardedB , _NormalB -- ** Guard Prisms , _NormalG , _PatG -- ** Stmt Prisms , _BindS , _LetS , _NoBindS , _ParS -- ** Range Prisms , _FromR , _FromThenR , _FromToR , _FromThenToR -- ** Lit Prisms , _CharL , _StringL , _IntegerL , _RationalL , _IntPrimL , _WordPrimL , _FloatPrimL , _DoublePrimL , _StringPrimL #if MIN_VERSION_template_haskell(2,11,0) , _CharPrimL #endif -- ** Pat Prisms , _LitP , _VarP , _TupP , _UnboxedTupP , _ConP , _InfixP , _UInfixP , _ParensP , _TildeP , _BangP , _AsP , _WildP , _RecP , _ListP , _SigP , _ViewP -- ** Type Prisms , _ForallT , _AppT , _SigT , _VarT , _ConT #if MIN_VERSION_template_haskell(2,8,0) , _PromotedT #endif , _TupleT , _UnboxedTupleT , _ArrowT #if MIN_VERSION_template_haskell(2,10,0) , _EqualityT #endif , _ListT #if MIN_VERSION_template_haskell(2,8,0) , _PromotedTupleT , _PromotedNilT , _PromotedConsT , _StarT , _ConstraintT , _LitT #endif #if MIN_VERSION_template_haskell(2,11,0) , _InfixT , _UInfixT , _ParensT , _WildCardT #endif -- ** TyVarBndr Prisms , _PlainTV , _KindedTV #if MIN_VERSION_template_haskell(2,11,0) -- ** FamilyResultSig Prisms , _NoSig , _KindSig , _TyVarSig #endif #if MIN_VERSION_template_haskell(2,8,0) -- ** TyLit Prisms , _NumTyLit , _StrTyLit #endif #if !MIN_VERSION_template_haskell(2,10,0) -- ** Pred Prisms , _ClassP , _EqualP #endif #if MIN_VERSION_template_haskell(2,9,0) -- ** Role Prisms , _NominalR , _RepresentationalR , _PhantomR , _InferR #endif ) where import Control.Applicative import Control.Lens.At import Control.Lens.Getter import Control.Lens.Setter import Control.Lens.Fold import Control.Lens.Iso (Iso', iso) import Control.Lens.Lens import Control.Lens.Prism import Control.Lens.Tuple import Control.Lens.Traversal import Data.Map as Map hiding (toList,map) import Data.Maybe (fromMaybe) import Data.Monoid import Data.Set as Set hiding (toList,map) import Data.Set.Lens import Language.Haskell.TH import Language.Haskell.TH.Syntax #if MIN_VERSION_template_haskell(2,8,0) import Data.Word #endif import Prelude -- | Has a 'Name' class HasName t where -- | Extract (or modify) the 'Name' of something name :: Lens' t Name instance HasName TyVarBndr where name f (PlainTV n) = PlainTV <$> f n name f (KindedTV n k) = (`KindedTV` k) <$> f n instance HasName Name where name = id -- | On @template-haskell-2.11.0.0@ or later, if a 'GadtC' or 'RecGadtC' has -- multiple 'Name's, the leftmost 'Name' will be chosen. instance HasName Con where name f (NormalC n tys) = (`NormalC` tys) <$> f n name f (RecC n tys) = (`RecC` tys) <$> f n name f (InfixC l n r) = (\n' -> InfixC l n' r) <$> f n name f (ForallC bds ctx con) = ForallC bds ctx <$> name f con #if MIN_VERSION_template_haskell(2,11,0) name f (GadtC ns argTys retTy) = (\n -> GadtC [n] argTys retTy) <$> f (head ns) name f (RecGadtC ns argTys retTy) = (\n -> RecGadtC [n] argTys retTy) <$> f (head ns) #endif instance HasName Foreign where name f (ImportF cc saf str n ty) = (\n' -> ImportF cc saf str n' ty) <$> f n name f (ExportF cc str n ty) = (\n' -> ExportF cc str n' ty) <$> f n #if MIN_VERSION_template_haskell(2,8,0) instance HasName RuleBndr where name f (RuleVar n) = RuleVar <$> f n name f (TypedRuleVar n ty) = (`TypedRuleVar` ty) <$> f n #endif #if MIN_VERSION_template_haskell(2,11,0) instance HasName TypeFamilyHead where name f (TypeFamilyHead n tvbs frs mia) = (\n' -> TypeFamilyHead n' tvbs frs mia) <$> f n instance HasName InjectivityAnn where name f (InjectivityAnn n deps) = (`InjectivityAnn` deps) <$> f n #endif -- | Contains some amount of `Type`s inside class HasTypes t where -- | Traverse all the types types :: Traversal' t Type instance HasTypes Type where types = id instance HasTypes Con where types f (NormalC n t) = NormalC n <$> traverse (_2 (types f)) t types f (RecC n t) = RecC n <$> traverse (_3 (types f)) t types f (InfixC t1 n t2) = InfixC <$> _2 (types f) t1 <*> pure n <*> _2 (types f) t2 types f (ForallC vb ctx con) = ForallC vb ctx <$> types f con #if MIN_VERSION_template_haskell(2,11,0) types f (GadtC ns argTys retTy) = GadtC ns <$> traverse (_2 (types f)) argTys <*> types f retTy types f (RecGadtC ns argTys retTy) = RecGadtC ns <$> traverse (_3 (types f)) argTys <*> types f retTy #endif instance HasTypes Foreign where types f (ImportF cc saf str n t) = ImportF cc saf str n <$> types f t types f (ExportF cc str n t) = ExportF cc str n <$> types f t #if MIN_VERSION_template_haskell(2,9,0) instance HasTypes TySynEqn where types f (TySynEqn lhss rhs) = TySynEqn <$> traverse (types f) lhss <*> types f rhs #endif instance HasTypes t => HasTypes [t] where types = traverse . types -- | Provides for the extraction of free type variables, and alpha renaming. class HasTypeVars t where -- | When performing substitution into this traversal you're not allowed -- to substitute in a name that is bound internally or you'll violate -- the 'Traversal' laws, when in doubt generate your names with 'newName'. typeVarsEx :: Set Name -> Traversal' t Name instance HasTypeVars TyVarBndr where typeVarsEx s f b | s^.contains (b^.name) = pure b | otherwise = name f b instance HasTypeVars Name where typeVarsEx s f n | s^.contains n = pure n | otherwise = f n instance HasTypeVars Type where typeVarsEx s f (VarT n) = VarT <$> typeVarsEx s f n typeVarsEx s f (AppT l r) = AppT <$> typeVarsEx s f l <*> typeVarsEx s f r typeVarsEx s f (SigT t k) = (`SigT` k) <$> typeVarsEx s f t typeVarsEx s f (ForallT bs ctx ty) = ForallT bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f ty where s' = s `Set.union` setOf typeVars bs #if MIN_VERSION_template_haskell(2,11,0) typeVarsEx s f (InfixT t1 n t2) = InfixT <$> typeVarsEx s f t1 <*> pure n <*> typeVarsEx s f t2 typeVarsEx s f (UInfixT t1 n t2) = UInfixT <$> typeVarsEx s f t1 <*> pure n <*> typeVarsEx s f t2 typeVarsEx s f (ParensT t) = ParensT <$> typeVarsEx s f t #endif typeVarsEx _ _ t = pure t #if !MIN_VERSION_template_haskell(2,10,0) instance HasTypeVars Pred where typeVarsEx s f (ClassP n ts) = ClassP n <$> typeVarsEx s f ts typeVarsEx s f (EqualP l r) = EqualP <$> typeVarsEx s f l <*> typeVarsEx s f r #endif instance HasTypeVars Con where typeVarsEx s f (NormalC n ts) = NormalC n <$> traverseOf (traverse . _2) (typeVarsEx s f) ts typeVarsEx s f (RecC n ts) = RecC n <$> traverseOf (traverse . _3) (typeVarsEx s f) ts typeVarsEx s f (InfixC l n r) = InfixC <$> g l <*> pure n <*> g r where g (i, t) = (,) i <$> typeVarsEx s f t typeVarsEx s f (ForallC bs ctx c) = ForallC bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f c where s' = s `Set.union` setOf typeVars bs #if MIN_VERSION_template_haskell(2,11,0) typeVarsEx s f (GadtC ns argTys retTy) = GadtC ns <$> traverseOf (traverse . _2) (typeVarsEx s f) argTys <*> typeVarsEx s f retTy typeVarsEx s f (RecGadtC ns argTys retTy) = RecGadtC ns <$> traverseOf (traverse . _3) (typeVarsEx s f) argTys <*> typeVarsEx s f retTy #endif instance HasTypeVars t => HasTypeVars [t] where typeVarsEx s = traverse . typeVarsEx s instance HasTypeVars t => HasTypeVars (Maybe t) where typeVarsEx s = traverse . typeVarsEx s -- | Traverse /free/ type variables typeVars :: HasTypeVars t => Traversal' t Name typeVars = typeVarsEx mempty -- | Substitute using a map of names in for /free/ type variables substTypeVars :: HasTypeVars t => Map Name Name -> t -> t substTypeVars m = over typeVars $ \n -> fromMaybe n (m^.at n) -- | Provides substitution for types class SubstType t where -- | Perform substitution for types substType :: Map Name Type -> t -> t instance SubstType Type where substType m t@(VarT n) = fromMaybe t (m^.at n) substType m (ForallT bs ctx ty) = ForallT bs (substType m' ctx) (substType m' ty) where m' = foldrOf typeVars Map.delete m bs substType m (SigT t k) = SigT (substType m t) k substType m (AppT l r) = AppT (substType m l) (substType m r) #if MIN_VERSION_template_haskell(2,11,0) substType m (InfixT t1 n t2) = InfixT (substType m t1) n (substType m t2) substType m (UInfixT t1 n t2) = UInfixT (substType m t1) n (substType m t2) substType m (ParensT t) = ParensT (substType m t) #endif substType _ t = t instance SubstType t => SubstType [t] where substType = map . substType #if !MIN_VERSION_template_haskell(2,10,0) instance SubstType Pred where substType m (ClassP n ts) = ClassP n (substType m ts) substType m (EqualP l r) = substType m (EqualP l r) #endif -- | Provides a 'Traversal' of the types of each field of a constructor. conFields :: Traversal' Con #if MIN_VERSION_template_haskell(2,11,0) BangType #else StrictType #endif conFields f (NormalC n fs) = NormalC n <$> traverse f fs conFields f (RecC n fs) = RecC n <$> traverse (sansVar f) fs conFields f (InfixC l n r) = InfixC <$> f l <*> pure n <*> f r conFields f (ForallC bds ctx c) = ForallC bds ctx <$> conFields f c #if MIN_VERSION_template_haskell(2,11,0) conFields f (GadtC ns argTys retTy) = GadtC ns <$> traverse f argTys <*> pure retTy conFields f (RecGadtC ns argTys retTy) = RecGadtC ns <$> traverse (sansVar f) argTys <*> pure retTy #endif #if MIN_VERSION_template_haskell(2,11,0) sansVar :: Traversal' VarBangType BangType #else sansVar :: Traversal' VarStrictType StrictType #endif sansVar f (fn,s,t) = (\(s', t') -> (fn,s',t')) <$> f (s, t) -- | 'Traversal' of the types of the /named/ fields of a constructor. conNamedFields :: Traversal' Con #if MIN_VERSION_template_haskell(2,11,0) VarBangType #else VarStrictType #endif conNamedFields f (RecC n fs) = RecC n <$> traverse f fs conNamedFields f (ForallC a b fs) = ForallC a b <$> conNamedFields f fs #if MIN_VERSION_template_haskell(2,11,0) conNamedFields f (RecGadtC ns argTys retTy) = RecGadtC ns <$> traverse f argTys <*> pure retTy #endif conNamedFields _ c = pure c -- Lenses and Prisms locFileName :: Lens' Loc String locFileName = lens loc_filename $ \loc fn -> loc { loc_filename = fn } locPackage :: Lens' Loc String locPackage = lens loc_package $ \loc fn -> loc { loc_package = fn } locModule :: Lens' Loc String locModule = lens loc_module $ \loc fn -> loc { loc_module = fn } locStart :: Lens' Loc CharPos locStart = lens loc_start $ \loc fn -> loc { loc_start = fn } locEnd :: Lens' Loc CharPos locEnd = lens loc_end $ \loc fn -> loc { loc_end = fn } funDepInputs :: Lens' FunDep [Name] funDepInputs = lens g s where g (FunDep xs _) = xs s (FunDep _ ys) xs = FunDep xs ys funDepOutputs :: Lens' FunDep [Name] funDepOutputs = lens g s where g (FunDep _ xs) = xs s (FunDep ys _) = FunDep ys fieldExpName :: Lens' FieldExp Name fieldExpName = _1 fieldExpExpression :: Lens' FieldExp Exp fieldExpExpression = _2 fieldPatName :: Lens' FieldPat Name fieldPatName = _1 fieldPatPattern :: Lens' FieldPat Pat fieldPatPattern = _2 matchPattern :: Lens' Match Pat matchPattern = lens g s where g (Match p _ _) = p s (Match _ x y) p = Match p x y matchBody :: Lens' Match Body matchBody = lens g s where g (Match _ b _) = b s (Match x _ y) b = Match x b y matchDeclarations :: Lens' Match [Dec] matchDeclarations = lens g s where g (Match _ _ ds) = ds s (Match x y _ ) = Match x y fixityPrecedence :: Lens' Fixity Int fixityPrecedence = lens g s where g (Fixity i _) = i s (Fixity _ x) i = Fixity i x fixityDirection :: Lens' Fixity FixityDirection fixityDirection = lens g s where g (Fixity _ d) = d s (Fixity i _) = Fixity i clausePattern :: Lens' Clause [Pat] clausePattern = lens g s where g (Clause ps _ _) = ps s (Clause _ x y) ps = Clause ps x y clauseBody :: Lens' Clause Body clauseBody = lens g s where g (Clause _ b _) = b s (Clause x _ y) b = Clause x b y clauseDecs :: Lens' Clause [Dec] clauseDecs = lens g s where g (Clause _ _ ds) = ds s (Clause x y _ ) = Clause x y #if MIN_VERSION_template_haskell(2,11,0) injectivityAnnOutput :: Lens' InjectivityAnn Name injectivityAnnOutput = lens g s where g (InjectivityAnn o _) = o s (InjectivityAnn _ i) o = InjectivityAnn o i injectivityAnnInputs :: Lens' InjectivityAnn [Name] injectivityAnnInputs = lens g s where g (InjectivityAnn _ i) = i s (InjectivityAnn o _) = InjectivityAnn o typeFamilyHeadName :: Lens' TypeFamilyHead Name typeFamilyHeadName = lens g s where g (TypeFamilyHead n _ _ _ ) = n s (TypeFamilyHead _ tvbs rs ia) n = TypeFamilyHead n tvbs rs ia typeFamilyHeadTyVarBndrs :: Lens' TypeFamilyHead [TyVarBndr] typeFamilyHeadTyVarBndrs = lens g s where g (TypeFamilyHead _ tvbs _ _ ) = tvbs s (TypeFamilyHead n _ rs ia) tvbs = TypeFamilyHead n tvbs rs ia typeFamilyHeadResultSig :: Lens' TypeFamilyHead FamilyResultSig typeFamilyHeadResultSig = lens g s where g (TypeFamilyHead _ _ rs _ ) = rs s (TypeFamilyHead n tvbs _ ia) rs = TypeFamilyHead n tvbs rs ia typeFamilyHeadInjectivityAnn :: Lens' TypeFamilyHead (Maybe InjectivityAnn) typeFamilyHeadInjectivityAnn = lens g s where g (TypeFamilyHead _ _ _ ia) = ia s (TypeFamilyHead n tvbs rs _ ) = TypeFamilyHead n tvbs rs bangSourceUnpackedness :: Lens' Bang SourceUnpackedness bangSourceUnpackedness = lens g s where g (Bang su _ ) = su s (Bang _ ss) su = Bang su ss bangSourceStrictness :: Lens' Bang SourceStrictness bangSourceStrictness = lens g s where g (Bang _ su) = su s (Bang ss _ ) = Bang ss #endif #if MIN_VERSION_template_haskell(2,8,0) _ClassI :: Prism' Info (Dec, [InstanceDec]) #else _ClassI :: Prism' Info (Dec, [Dec]) #endif _ClassI = prism' reviewer remitter where reviewer (x, y) = ClassI x y remitter (ClassI x y) = Just (x, y) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,11,0) _ClassOpI :: Prism' Info (Name, Type, ParentName) _ClassOpI = prism' reviewer remitter where reviewer (x, y, z) = ClassOpI x y z remitter (ClassOpI x y z) = Just (x, y, z) remitter _ = Nothing #else # if MIN_VERSION_template_haskell(2,8,0) _ClassOpI :: Prism' Info (Name, Type, ParentName, Fixity) # else _ClassOpI :: Prism' Info (Name, Type, Name, Fixity) # endif _ClassOpI = prism' reviewer remitter where reviewer (x, y, z, w) = ClassOpI x y z w remitter (ClassOpI x y z w) = Just (x, y, z, w) remitter _ = Nothing #endif _TyConI :: Prism' Info Dec _TyConI = prism' reviewer remitter where reviewer = TyConI remitter (TyConI x) = Just x remitter _ = Nothing #if MIN_VERSION_template_haskell(2,11,0) _FamilyI :: Prism' Info (Dec, [InstanceDec]) #else _FamilyI :: Prism' Info (Dec, [Dec]) #endif _FamilyI = prism' reviewer remitter where reviewer (x, y) = FamilyI x y remitter (FamilyI x y) = Just (x, y) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,8,0) _PrimTyConI :: Prism' Info (Name, Arity, Unlifted) #else _PrimTyConI :: Prism' Info (Name, Int, Bool) #endif _PrimTyConI = prism' reviewer remitter where reviewer (x, y, z) = PrimTyConI x y z remitter (PrimTyConI x y z) = Just (x, y, z) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,11,0) _DataConI :: Prism' Info (Name, Type, ParentName) _DataConI = prism' reviewer remitter where reviewer (x, y, z) = DataConI x y z remitter (DataConI x y z) = Just (x, y, z) remitter _ = Nothing #else # if MIN_VERSION_template_haskell(2,8,0) _DataConI :: Prism' Info (Name, Type, ParentName, Fixity) # else _DataConI :: Prism' Info (Name, Type, Name, Fixity) # endif _DataConI = prism' reviewer remitter where reviewer (x, y, z, w) = DataConI x y z w remitter (DataConI x y z w) = Just (x, y, z, w) remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,11,0) _VarI :: Prism' Info (Name, Type, Maybe Dec) _VarI = prism' reviewer remitter where reviewer (x, y, z) = VarI x y z remitter (VarI x y z) = Just (x, y, z) remitter _ = Nothing #else _VarI :: Prism' Info (Name, Type, Maybe Dec, Fixity) _VarI = prism' reviewer remitter where reviewer (x, y, z, w) = VarI x y z w remitter (VarI x y z w) = Just (x, y, z, w) remitter _ = Nothing #endif _TyVarI :: Prism' Info (Name, Type) _TyVarI = prism' reviewer remitter where reviewer (x, y) = TyVarI x y remitter (TyVarI x y) = Just (x, y) remitter _ = Nothing _FunD :: Prism' Dec (Name, [Clause]) _FunD = prism' reviewer remitter where reviewer (x, y) = FunD x y remitter (FunD x y) = Just (x,y) remitter _ = Nothing _ValD :: Prism' Dec (Pat, Body, [Dec]) _ValD = prism' reviewer remitter where reviewer (x, y, z) = ValD x y z remitter (ValD x y z) = Just (x, y, z) remitter _ = Nothing _TySynD :: Prism' Dec (Name, [TyVarBndr], Type) _TySynD = prism' reviewer remitter where reviewer (x, y, z) = TySynD x y z remitter (TySynD x y z) = Just (x, y, z) remitter _ = Nothing _ClassD :: Prism' Dec (Cxt, Name, [TyVarBndr], [FunDep], [Dec]) _ClassD = prism' reviewer remitter where reviewer (x, y, z, w, u) = ClassD x y z w u remitter (ClassD x y z w u) = Just (x, y, z, w, u) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,11,0) _InstanceD :: Prism' Dec (Maybe Overlap, Cxt, Type, [Dec]) #else _InstanceD :: Prism' Dec (Cxt, Type, [Dec]) #endif _InstanceD = prism' reviewer remitter where #if MIN_VERSION_template_haskell(2,11,0) reviewer (x, y, z, w) = InstanceD x y z w remitter (InstanceD x y z w) = Just (x, y, z, w) #else reviewer (x, y, z) = InstanceD x y z remitter (InstanceD x y z) = Just ( x, y, z) #endif remitter _ = Nothing #if MIN_VERSION_template_haskell(2,11,0) _Overlappable :: Prism' Overlap () _Overlappable = prism' reviewer remitter where reviewer () = Overlappable remitter Overlappable = Just () remitter _ = Nothing _Overlapping :: Prism' Overlap () _Overlapping = prism' reviewer remitter where reviewer () = Overlapping remitter Overlapping = Just () remitter _ = Nothing _Overlaps :: Prism' Overlap () _Overlaps = prism' reviewer remitter where reviewer () = Overlaps remitter Overlaps = Just () remitter _ = Nothing _Incoherent :: Prism' Overlap () _Incoherent = prism' reviewer remitter where reviewer () = Incoherent remitter Incoherent = Just () remitter _ = Nothing #endif _SigD :: Prism' Dec (Name, Type) _SigD = prism' reviewer remitter where reviewer (x, y) = SigD x y remitter (SigD x y) = Just (x, y) remitter _ = Nothing _ForeignD :: Prism' Dec Foreign _ForeignD = prism' reviewer remitter where reviewer = ForeignD remitter (ForeignD x) = Just x remitter _ = Nothing #if MIN_VERSION_template_haskell(2,8,0) _InfixD :: Prism' Dec (Fixity, Name) _InfixD = prism' reviewer remitter where reviewer (x, y) = InfixD x y remitter (InfixD x y) = Just (x, y) remitter _ = Nothing #endif _PragmaD :: Prism' Dec Pragma _PragmaD = prism' reviewer remitter where reviewer = PragmaD remitter (PragmaD x) = Just x remitter _ = Nothing #if MIN_VERSION_template_haskell(2,9,0) _TySynInstD :: Prism' Dec (Name, TySynEqn) _TySynInstD = prism' reviewer remitter where reviewer (x, y) = TySynInstD x y remitter (TySynInstD x y) = Just (x, y) remitter _ = Nothing _RoleAnnotD :: Prism' Dec (Name, [Role]) _RoleAnnotD = prism' reviewer remitter where reviewer (x, y) = RoleAnnotD x y remitter (RoleAnnotD x y) = Just (x, y) remitter _ = Nothing #else _TySynInstD :: Prism' Dec (Name, [Type], Type) _TySynInstD = prism' reviewer remitter where reviewer (x, y, z) = TySynInstD x y z remitter (TySynInstD x y z) = Just (x, y, z) remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,10,0) _StandaloneDerivD :: Prism' Dec (Cxt, Type) _StandaloneDerivD = prism' reviewer remitter where reviewer (x, y) = StandaloneDerivD x y remitter (StandaloneDerivD x y) = Just (x, y) remitter _ = Nothing _DefaultSigD :: Prism' Dec (Name, Type) _DefaultSigD = prism' reviewer remitter where reviewer (x, y) = DefaultSigD x y remitter (DefaultSigD x y) = Just (x, y) remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,11,0) _ClosedTypeFamilyD :: Prism' Dec (TypeFamilyHead, [TySynEqn]) _ClosedTypeFamilyD = prism' reviewer remitter where reviewer (x, y) = ClosedTypeFamilyD x y remitter (ClosedTypeFamilyD x y) = Just (x, y) remitter _ = Nothing #elif MIN_VERSION_template_haskell(2,9,0) _ClosedTypeFamilyD :: Prism' Dec (Name, [TyVarBndr], Maybe Kind, [TySynEqn]) _ClosedTypeFamilyD = prism' reviewer remitter where reviewer (x, y, z, w) = ClosedTypeFamilyD x y z w remitter (ClosedTypeFamilyD x y z w) = Just (x, y, z, w) remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,11,0) _DataD :: Prism' Dec (Cxt, Name, [TyVarBndr], Maybe Kind, [Con], Cxt) _DataD = prism' reviewer remitter where reviewer (x, y, z, w, u, v) = DataD x y z w u v remitter (DataD x y z w u v) = Just (x, y, z, w, u, v) remitter _ = Nothing _NewtypeD :: Prism' Dec (Cxt, Name, [TyVarBndr], Maybe Kind, Con, Cxt) _NewtypeD = prism' reviewer remitter where reviewer (x, y, z, w, u, v) = NewtypeD x y z w u v remitter (NewtypeD x y z w u v) = Just (x, y, z, w, u, v) remitter _ = Nothing _DataInstD :: Prism' Dec (Cxt, Name, [Type], Maybe Kind, [Con], Cxt) _DataInstD = prism' reviewer remitter where reviewer (x, y, z, w, u, v) = DataInstD x y z w u v remitter (DataInstD x y z w u v) = Just (x, y, z, w, u, v) remitter _ = Nothing _NewtypeInstD :: Prism' Dec (Cxt, Name, [Type], Maybe Kind, Con, Cxt) _NewtypeInstD = prism' reviewer remitter where reviewer (x, y, z, w, u, v) = NewtypeInstD x y z w u v remitter (NewtypeInstD x y z w u v) = Just (x, y, z, w, u, v) remitter _ = Nothing _DataFamilyD :: Prism' Dec (Name, [TyVarBndr], Maybe Kind) _DataFamilyD = prism' reviewer remitter where reviewer (x, y, z) = DataFamilyD x y z remitter (DataFamilyD x y z) = Just (x, y, z) remitter _ = Nothing _OpenTypeFamilyD :: Prism' Dec TypeFamilyHead _OpenTypeFamilyD = prism' reviewer remitter where reviewer = OpenTypeFamilyD remitter (OpenTypeFamilyD x) = Just x remitter _ = Nothing #else _DataD :: Prism' Dec (Cxt, Name, [TyVarBndr], [Con], [Name]) _DataD = prism' reviewer remitter where reviewer (x, y, z, w, u) = DataD x y z w u remitter (DataD x y z w u) = Just (x, y, z, w, u) remitter _ = Nothing _NewtypeD :: Prism' Dec (Cxt, Name, [TyVarBndr], Con, [Name]) _NewtypeD = prism' reviewer remitter where reviewer (x, y, z, w, u) = NewtypeD x y z w u remitter (NewtypeD x y z w u) = Just (x, y, z, w, u) remitter _ = Nothing _DataInstD :: Prism' Dec (Cxt, Name, [Type], [Con], [Name]) _DataInstD = prism' reviewer remitter where reviewer (x, y, z, w, u) = DataInstD x y z w u remitter (DataInstD x y z w u) = Just (x, y, z, w, u) remitter _ = Nothing _NewtypeInstD :: Prism' Dec (Cxt, Name, [Type], Con, [Name]) _NewtypeInstD = prism' reviewer remitter where reviewer (x, y, z, w, u) = NewtypeInstD x y z w u remitter (NewtypeInstD x y z w u) = Just (x, y, z, w, u) remitter _ = Nothing _FamilyD :: Prism' Dec (FamFlavour, Name, [TyVarBndr], Maybe Kind) _FamilyD = prism' reviewer remitter where reviewer (x, y, z, w) = FamilyD x y z w remitter (FamilyD x y z w) = Just (x, y, z, w) remitter _ = Nothing #endif _NormalC :: Prism' Con ( Name #if MIN_VERSION_template_haskell(2,11,0) , [BangType] #else , [StrictType] #endif ) _NormalC = prism' reviewer remitter where reviewer (x, y) = NormalC x y remitter (NormalC x y) = Just (x, y) remitter _ = Nothing _RecC :: Prism' Con ( Name #if MIN_VERSION_template_haskell(2,11,0) , [VarBangType] #else , [VarStrictType] #endif ) _RecC = prism' reviewer remitter where reviewer (x, y) = RecC x y remitter (RecC x y) = Just (x, y) remitter _ = Nothing _InfixC :: Prism' Con #if MIN_VERSION_template_haskell(2,11,0) (BangType, Name, BangType ) #else (StrictType, Name, StrictType) #endif _InfixC = prism' reviewer remitter where reviewer (x, y, z) = InfixC x y z remitter (InfixC x y z) = Just (x, y, z) remitter _ = Nothing _ForallC :: Prism' Con ([TyVarBndr], Cxt, Con) _ForallC = prism' reviewer remitter where reviewer (x, y, z) = ForallC x y z remitter (ForallC x y z) = Just (x, y, z) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,11,0) _GadtC :: Prism' Con ([Name], [BangType], Type) _GadtC = prism' reviewer remitter where reviewer (x, y, z) = GadtC x y z remitter (GadtC x y z) = Just (x, y, z) remitter _ = Nothing _RecGadtC :: Prism' Con ([Name], [VarBangType], Type) _RecGadtC = prism' reviewer remitter where reviewer (x, y, z) = RecGadtC x y z remitter (RecGadtC x y z) = Just (x, y, z) remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,11,0) _NoSourceUnpackedness :: Prism' SourceUnpackedness () _NoSourceUnpackedness = prism' reviewer remitter where reviewer () = NoSourceUnpackedness remitter NoSourceUnpackedness = Just () remitter _ = Nothing _SourceNoUnpack :: Prism' SourceUnpackedness () _SourceNoUnpack = prism' reviewer remitter where reviewer () = SourceNoUnpack remitter SourceNoUnpack = Just () remitter _ = Nothing _SourceUnpack :: Prism' SourceUnpackedness () _SourceUnpack = prism' reviewer remitter where reviewer () = SourceUnpack remitter SourceUnpack = Just () remitter _ = Nothing _NoSourceStrictness :: Prism' SourceStrictness () _NoSourceStrictness = prism' reviewer remitter where reviewer () = NoSourceStrictness remitter NoSourceStrictness = Just () remitter _ = Nothing _SourceLazy :: Prism' SourceStrictness () _SourceLazy = prism' reviewer remitter where reviewer () = SourceLazy remitter SourceLazy = Just () remitter _ = Nothing _SourceStrict :: Prism' SourceStrictness () _SourceStrict = prism' reviewer remitter where reviewer () = SourceStrict remitter SourceStrict = Just () remitter _ = Nothing _DecidedLazy :: Prism' DecidedStrictness () _DecidedLazy = prism' reviewer remitter where reviewer () = DecidedLazy remitter DecidedLazy = Just () remitter _ = Nothing _DecidedStrict :: Prism' DecidedStrictness () _DecidedStrict = prism' reviewer remitter where reviewer () = DecidedStrict remitter DecidedStrict = Just () remitter _ = Nothing _DecidedUnpack :: Prism' DecidedStrictness () _DecidedUnpack = prism' reviewer remitter where reviewer () = DecidedUnpack remitter DecidedUnpack = Just () remitter _ = Nothing #else _IsStrict :: Prism' Strict () _IsStrict = prism' reviewer remitter where reviewer () = IsStrict remitter IsStrict = Just () remitter _ = Nothing _NotStrict :: Prism' Strict () _NotStrict = prism' reviewer remitter where reviewer () = NotStrict remitter NotStrict = Just () remitter _ = Nothing _Unpacked :: Prism' Strict () _Unpacked = prism' reviewer remitter where reviewer () = Unpacked remitter Unpacked = Just () remitter _ = Nothing #endif _ImportF :: Prism' Foreign (Callconv, Safety, String, Name, Type) _ImportF = prism' reviewer remitter where reviewer (x, y, z, w, u) = ImportF x y z w u remitter (ImportF x y z w u) = Just (x,y,z,w,u) remitter _ = Nothing _ExportF :: Prism' Foreign (Callconv, String, Name, Type) _ExportF = prism' reviewer remitter where reviewer (x, y, z, w) = ExportF x y z w remitter (ExportF x y z w) = Just (x, y, z, w) remitter _ = Nothing _CCall :: Prism' Callconv () _CCall = prism' reviewer remitter where reviewer () = CCall remitter CCall = Just () remitter _ = Nothing _StdCall :: Prism' Callconv () _StdCall = prism' reviewer remitter where reviewer () = StdCall remitter StdCall = Just () remitter _ = Nothing #if MIN_VERSION_template_haskell(2,10,0) _CApi :: Prism' Callconv () _CApi = prism' reviewer remitter where reviewer () = CApi remitter CApi = Just () remitter _ = Nothing _Prim :: Prism' Callconv () _Prim = prism' reviewer remitter where reviewer () = Prim remitter Prim = Just () remitter _ = Nothing _JavaScript :: Prism' Callconv () _JavaScript = prism' reviewer remitter where reviewer () = JavaScript remitter JavaScript = Just () remitter _ = Nothing #endif _Unsafe :: Prism' Safety () _Unsafe = prism' reviewer remitter where reviewer () = Unsafe remitter Unsafe = Just () remitter _ = Nothing _Safe :: Prism' Safety () _Safe = prism' reviewer remitter where reviewer () = Safe remitter Safe = Just () remitter _ = Nothing _Interruptible :: Prism' Safety () _Interruptible = prism' reviewer remitter where reviewer () = Interruptible remitter Interruptible = Just () remitter _ = Nothing #if MIN_VERSION_template_haskell(2,8,0) _InlineP :: Prism' Pragma (Name, Inline, RuleMatch, Phases) _InlineP = prism' reviewer remitter where reviewer (x, y, z, w) = InlineP x y z w remitter (InlineP x y z w) = Just (x, y, z, w) remitter _ = Nothing _SpecialiseP :: Prism' Pragma (Name, Type, Maybe Inline, Phases) _SpecialiseP = prism' reviewer remitter where reviewer (x, y, z, w) = SpecialiseP x y z w remitter (SpecialiseP x y z w) = Just (x, y, z, w) remitter _ = Nothing #else _InlineP :: Prism' Pragma (Name, InlineSpec) _InlineP = prism' reviewer remitter where reviewer (x, y) = InlineP x y remitter (InlineP x y) = Just (x, y) remitter _ = Nothing _SpecialiseP :: Prism' Pragma (Name, Type, Maybe InlineSpec) _SpecialiseP = prism' reviewer remitter where reviewer (x, y, z) = SpecialiseP x y z remitter (SpecialiseP x y z) = Just (x, y, z) remitter _ = Nothing -- TODO add lenses for InlineSpec #endif #if MIN_VERSION_template_haskell(2,8,0) _SpecialiseInstP :: Prism' Pragma Type _SpecialiseInstP = prism' reviewer remitter where reviewer = SpecialiseInstP remitter (SpecialiseInstP x) = Just x remitter _ = Nothing _RuleP :: Prism' Pragma (String, [RuleBndr], Exp, Exp, Phases) _RuleP = prism' reviewer remitter where reviewer (x, y, z, w, u) = RuleP x y z w u remitter (RuleP x y z w u) = Just (x, y, z, w, u) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,9,0) _AnnP :: Prism' Pragma (AnnTarget, Exp) _AnnP = prism' reviewer remitter where reviewer (x, y) = AnnP x y remitter (AnnP x y) = Just (x, y) remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,10,0) _LineP :: Prism' Pragma (Int, String) _LineP = prism' reviewer remitter where reviewer (x, y) = LineP x y remitter (LineP x y) = Just (x, y) remitter _ = Nothing #endif _NoInline :: Prism' Inline () _NoInline = prism' reviewer remitter where reviewer () = NoInline remitter NoInline = Just () remitter _ = Nothing _Inline :: Prism' Inline () _Inline = prism' reviewer remitter where reviewer () = Inline remitter Inline = Just () remitter _ = Nothing _Inlinable :: Prism' Inline () _Inlinable = prism' reviewer remitter where reviewer () = Inlinable remitter Inlinable = Just () remitter _ = Nothing _ConLike :: Prism' RuleMatch () _ConLike = prism' reviewer remitter where reviewer () = ConLike remitter ConLike = Just () remitter _ = Nothing _FunLike :: Prism' RuleMatch () _FunLike = prism' reviewer remitter where reviewer () = FunLike remitter FunLike = Just () remitter _ = Nothing _AllPhases :: Prism' Phases () _AllPhases = prism' reviewer remitter where reviewer () = AllPhases remitter AllPhases = Just () remitter _ = Nothing _FromPhase :: Prism' Phases Int _FromPhase = prism' reviewer remitter where reviewer = FromPhase remitter (FromPhase x) = Just x remitter _ = Nothing _BeforePhase :: Prism' Phases Int _BeforePhase = prism' reviewer remitter where reviewer = BeforePhase remitter (BeforePhase x) = Just x remitter _ = Nothing _RuleVar :: Prism' RuleBndr Name _RuleVar = prism' reviewer remitter where reviewer = RuleVar remitter (RuleVar x) = Just x remitter _ = Nothing _TypedRuleVar :: Prism' RuleBndr (Name, Type) _TypedRuleVar = prism' reviewer remitter where reviewer (x, y) = TypedRuleVar x y remitter (TypedRuleVar x y) = Just (x, y) remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,9,0) _ModuleAnnotation :: Prism' AnnTarget () _ModuleAnnotation = prism' reviewer remitter where reviewer () = ModuleAnnotation remitter ModuleAnnotation = Just () remitter _ = Nothing _TypeAnnotation :: Prism' AnnTarget Name _TypeAnnotation = prism' reviewer remitter where reviewer = TypeAnnotation remitter (TypeAnnotation x) = Just x remitter _ = Nothing _ValueAnnotation :: Prism' AnnTarget Name _ValueAnnotation = prism' reviewer remitter where reviewer = ValueAnnotation remitter (ValueAnnotation x) = Just x remitter _ = Nothing #endif _FunDep :: Iso' FunDep ([Name], [Name]) _FunDep = iso remitter reviewer where reviewer (x, y) = FunDep x y remitter (FunDep x y) = (x, y) _TypeFam :: Prism' FamFlavour () _TypeFam = prism' reviewer remitter where reviewer () = TypeFam remitter TypeFam = Just () remitter _ = Nothing _DataFam :: Prism' FamFlavour () _DataFam = prism' reviewer remitter where reviewer () = DataFam remitter DataFam = Just () remitter _ = Nothing #if MIN_VERSION_template_haskell(2,9,0) tySynEqnPatterns :: Lens' TySynEqn [Type] tySynEqnPatterns = lens g s where g (TySynEqn xs _) = xs s (TySynEqn _ y) xs = TySynEqn xs y tySynEqnResult :: Lens' TySynEqn Type tySynEqnResult = lens g s where g (TySynEqn _ x) = x s (TySynEqn xs _) = TySynEqn xs #endif _InfixL :: Prism' FixityDirection () _InfixL = prism' reviewer remitter where reviewer () = InfixL remitter InfixL = Just () remitter _ = Nothing _InfixR :: Prism' FixityDirection () _InfixR = prism' reviewer remitter where reviewer () = InfixR remitter InfixR = Just () remitter _ = Nothing _InfixN :: Prism' FixityDirection () _InfixN = prism' reviewer remitter where reviewer () = InfixN remitter InfixN = Just () remitter _ = Nothing _VarE :: Prism' Exp Name _VarE = prism' reviewer remitter where reviewer = VarE remitter (VarE x) = Just x remitter _ = Nothing _ConE :: Prism' Exp Name _ConE = prism' reviewer remitter where reviewer = ConE remitter (ConE x) = Just x remitter _ = Nothing _LitE :: Prism' Exp Lit _LitE = prism' reviewer remitter where reviewer = LitE remitter (LitE x) = Just x remitter _ = Nothing _AppE :: Prism' Exp (Exp, Exp) _AppE = prism' reviewer remitter where reviewer (x, y) = AppE x y remitter (AppE x y) = Just (x, y) remitter _ = Nothing _InfixE :: Prism' Exp (Maybe Exp, Exp, Maybe Exp) _InfixE = prism' reviewer remitter where reviewer (x, y, z) = InfixE x y z remitter (InfixE x y z) = Just (x, y, z) remitter _ = Nothing _UInfixE :: Prism' Exp (Exp, Exp, Exp) _UInfixE = prism' reviewer remitter where reviewer (x, y, z) = UInfixE x y z remitter (UInfixE x y z) = Just (x, y, z) remitter _ = Nothing _ParensE :: Prism' Exp Exp _ParensE = prism' reviewer remitter where reviewer = ParensE remitter (ParensE x) = Just x remitter _ = Nothing _LamE :: Prism' Exp ([Pat], Exp) _LamE = prism' reviewer remitter where reviewer (x, y) = LamE x y remitter (LamE x y) = Just (x, y) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,8,0) _LamCaseE :: Prism' Exp [Match] _LamCaseE = prism' reviewer remitter where reviewer = LamCaseE remitter (LamCaseE x) = Just x remitter _ = Nothing #endif _TupE :: Prism' Exp [Exp] _TupE = prism' reviewer remitter where reviewer = TupE remitter (TupE x) = Just x remitter _ = Nothing _UnboxedTupE :: Prism' Exp [Exp] _UnboxedTupE = prism' reviewer remitter where reviewer = UnboxedTupE remitter (UnboxedTupE x) = Just x remitter _ = Nothing _CondE :: Prism' Exp (Exp, Exp, Exp) _CondE = prism' reviewer remitter where reviewer (x, y, z) = CondE x y z remitter (CondE x y z) = Just (x, y, z) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,8,0) _MultiIfE :: Prism' Exp [(Guard, Exp)] _MultiIfE = prism' reviewer remitter where reviewer = MultiIfE remitter (MultiIfE x) = Just x remitter _ = Nothing #endif _LetE :: Prism' Exp ([Dec], Exp) _LetE = prism' reviewer remitter where reviewer (x, y) = LetE x y remitter (LetE x y) = Just (x, y) remitter _ = Nothing _CaseE :: Prism' Exp (Exp, [Match]) _CaseE = prism' reviewer remitter where reviewer (x, y) = CaseE x y remitter (CaseE x y) = Just (x, y) remitter _ = Nothing _DoE :: Prism' Exp [Stmt] _DoE = prism' reviewer remitter where reviewer = DoE remitter (DoE x) = Just x remitter _ = Nothing _CompE :: Prism' Exp [Stmt] _CompE = prism' reviewer remitter where reviewer = CompE remitter (CompE x) = Just x remitter _ = Nothing _ArithSeqE :: Prism' Exp Range _ArithSeqE = prism' reviewer remitter where reviewer = ArithSeqE remitter (ArithSeqE x) = Just x remitter _ = Nothing _ListE :: Prism' Exp [Exp] _ListE = prism' reviewer remitter where reviewer = ListE remitter (ListE x) = Just x remitter _ = Nothing _SigE :: Prism' Exp (Exp, Type) _SigE = prism' reviewer remitter where reviewer (x, y) = SigE x y remitter (SigE x y) = Just (x, y) remitter _ = Nothing _RecConE :: Prism' Exp (Name, [FieldExp]) _RecConE = prism' reviewer remitter where reviewer (x, y) = RecConE x y remitter (RecConE x y) = Just (x, y) remitter _ = Nothing _RecUpdE :: Prism' Exp (Exp, [FieldExp]) _RecUpdE = prism' reviewer remitter where reviewer (x, y) = RecUpdE x y remitter (RecUpdE x y) = Just (x, y) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,10,0) _StaticE :: Prism' Exp Exp _StaticE = prism' reviewer remitter where reviewer = StaticE remitter (StaticE x) = Just x remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,11,0) _UnboundVarE :: Prism' Exp Name _UnboundVarE = prism' reviewer remitter where reviewer = UnboundVarE remitter (UnboundVarE x) = Just x remitter _ = Nothing #endif _GuardedB :: Prism' Body [(Guard, Exp)] _GuardedB = prism' reviewer remitter where reviewer = GuardedB remitter (GuardedB x) = Just x remitter _ = Nothing _NormalB :: Prism' Body Exp _NormalB = prism' reviewer remitter where reviewer = NormalB remitter (NormalB x) = Just x remitter _ = Nothing _NormalG :: Prism' Guard Exp _NormalG = prism' reviewer remitter where reviewer = NormalG remitter (NormalG x) = Just x remitter _ = Nothing _PatG :: Prism' Guard [Stmt] _PatG = prism' reviewer remitter where reviewer = PatG remitter (PatG x) = Just x remitter _ = Nothing _BindS :: Prism' Stmt (Pat, Exp) _BindS = prism' reviewer remitter where reviewer (x, y) = BindS x y remitter (BindS x y) = Just (x, y) remitter _ = Nothing _LetS :: Prism' Stmt [Dec] _LetS = prism' reviewer remitter where reviewer = LetS remitter (LetS x) = Just x remitter _ = Nothing _NoBindS :: Prism' Stmt Exp _NoBindS = prism' reviewer remitter where reviewer = NoBindS remitter (NoBindS x) = Just x remitter _ = Nothing _ParS :: Prism' Stmt [[Stmt]] _ParS = prism' reviewer remitter where reviewer = ParS remitter (ParS x) = Just x remitter _ = Nothing _FromR :: Prism' Range Exp _FromR = prism' reviewer remitter where reviewer = FromR remitter (FromR x) = Just x remitter _ = Nothing _FromThenR :: Prism' Range (Exp, Exp) _FromThenR = prism' reviewer remitter where reviewer (x, y) = FromThenR x y remitter (FromThenR x y) = Just (x, y) remitter _ = Nothing _FromToR :: Prism' Range (Exp, Exp) _FromToR = prism' reviewer remitter where reviewer (x, y) = FromToR x y remitter (FromToR x y) = Just (x, y) remitter _ = Nothing _FromThenToR :: Prism' Range (Exp, Exp, Exp) _FromThenToR = prism' reviewer remitter where reviewer (x, y, z) = FromThenToR x y z remitter (FromThenToR x y z) = Just (x, y, z) remitter _ = Nothing _CharL :: Prism' Lit Char _CharL = prism' reviewer remitter where reviewer = CharL remitter (CharL x) = Just x remitter _ = Nothing _StringL :: Prism' Lit String _StringL = prism' reviewer remitter where reviewer = StringL remitter (StringL x) = Just x remitter _ = Nothing _IntegerL :: Prism' Lit Integer _IntegerL = prism' reviewer remitter where reviewer = IntegerL remitter (IntegerL x) = Just x remitter _ = Nothing _RationalL :: Prism' Lit Rational _RationalL = prism' reviewer remitter where reviewer = RationalL remitter (RationalL x) = Just x remitter _ = Nothing _IntPrimL :: Prism' Lit Integer _IntPrimL = prism' reviewer remitter where reviewer = IntPrimL remitter (IntPrimL x) = Just x remitter _ = Nothing _WordPrimL :: Prism' Lit Integer _WordPrimL = prism' reviewer remitter where reviewer = WordPrimL remitter (WordPrimL x) = Just x remitter _ = Nothing _FloatPrimL :: Prism' Lit Rational _FloatPrimL = prism' reviewer remitter where reviewer = FloatPrimL remitter (FloatPrimL x) = Just x remitter _ = Nothing _DoublePrimL :: Prism' Lit Rational _DoublePrimL = prism' reviewer remitter where reviewer = DoublePrimL remitter (DoublePrimL x) = Just x remitter _ = Nothing #if MIN_VERSION_template_haskell(2,8,0) _StringPrimL :: Prism' Lit [Word8] _StringPrimL = prism' reviewer remitter where reviewer = StringPrimL remitter (StringPrimL x) = Just x remitter _ = Nothing #else _StringPrimL :: Prism' Lit String _StringPrimL = prism' reviewer remitter where reviewer = StringPrimL remitter (StringPrimL x) = Just x remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,11,0) _CharPrimL :: Prism' Lit Char _CharPrimL = prism' reviewer remitter where reviewer = CharPrimL remitter (CharPrimL x) = Just x remitter _ = Nothing #endif _LitP :: Prism' Pat Lit _LitP = prism' reviewer remitter where reviewer = LitP remitter (LitP x) = Just x remitter _ = Nothing _VarP :: Prism' Pat Name _VarP = prism' reviewer remitter where reviewer = VarP remitter (VarP x) = Just x remitter _ = Nothing _TupP :: Prism' Pat [Pat] _TupP = prism' reviewer remitter where reviewer = TupP remitter (TupP x) = Just x remitter _ = Nothing _UnboxedTupP :: Prism' Pat [Pat] _UnboxedTupP = prism' reviewer remitter where reviewer = UnboxedTupP remitter (UnboxedTupP x) = Just x remitter _ = Nothing _ConP :: Prism' Pat (Name, [Pat]) _ConP = prism' reviewer remitter where reviewer (x, y) = ConP x y remitter (ConP x y) = Just (x, y) remitter _ = Nothing _InfixP :: Prism' Pat (Pat, Name, Pat) _InfixP = prism' reviewer remitter where reviewer (x, y, z) = InfixP x y z remitter (InfixP x y z) = Just (x, y, z) remitter _ = Nothing _UInfixP :: Prism' Pat (Pat, Name, Pat) _UInfixP = prism' reviewer remitter where reviewer (x, y, z) = UInfixP x y z remitter (UInfixP x y z) = Just (x, y, z) remitter _ = Nothing _ParensP :: Prism' Pat Pat _ParensP = prism' reviewer remitter where reviewer = ParensP remitter (ParensP x) = Just x remitter _ = Nothing _TildeP :: Prism' Pat Pat _TildeP = prism' reviewer remitter where reviewer = TildeP remitter (TildeP x) = Just x remitter _ = Nothing _BangP :: Prism' Pat Pat _BangP = prism' reviewer remitter where reviewer = BangP remitter (BangP x) = Just x remitter _ = Nothing _AsP :: Prism' Pat (Name, Pat) _AsP = prism' reviewer remitter where reviewer (x, y) = AsP x y remitter (AsP x y) = Just (x, y) remitter _ = Nothing _WildP :: Prism' Pat () _WildP = prism' reviewer remitter where reviewer () = WildP remitter WildP = Just () remitter _ = Nothing _RecP :: Prism' Pat (Name, [FieldPat]) _RecP = prism' reviewer remitter where reviewer (x, y) = RecP x y remitter (RecP x y) = Just (x, y) remitter _ = Nothing _ListP :: Prism' Pat [Pat] _ListP = prism' reviewer remitter where reviewer = ListP remitter (ListP x) = Just x remitter _ = Nothing _SigP :: Prism' Pat (Pat, Type) _SigP = prism' reviewer remitter where reviewer (x, y) = SigP x y remitter (SigP x y) = Just (x, y) remitter _ = Nothing _ViewP :: Prism' Pat (Exp, Pat) _ViewP = prism' reviewer remitter where reviewer (x, y) = ViewP x y remitter (ViewP x y) = Just (x, y) remitter _ = Nothing _ForallT :: Prism' Type ([TyVarBndr], Cxt, Type) _ForallT = prism' reviewer remitter where reviewer (x, y, z) = ForallT x y z remitter (ForallT x y z) = Just (x, y, z) remitter _ = Nothing _AppT :: Prism' Type (Type, Type) _AppT = prism' reviewer remitter where reviewer (x, y) = AppT x y remitter (AppT x y) = Just (x, y) remitter _ = Nothing _SigT :: Prism' Type (Type, Kind) _SigT = prism' reviewer remitter where reviewer (x, y) = SigT x y remitter (SigT x y) = Just (x, y) remitter _ = Nothing _VarT :: Prism' Type Name _VarT = prism' reviewer remitter where reviewer = VarT remitter (VarT x) = Just x remitter _ = Nothing _ConT :: Prism' Type Name _ConT = prism' reviewer remitter where reviewer = ConT remitter (ConT x) = Just x remitter _ = Nothing #if MIN_VERSION_template_haskell(2,8,0) _PromotedT :: Prism' Type Name _PromotedT = prism' reviewer remitter where reviewer = PromotedT remitter (PromotedT x) = Just x remitter _ = Nothing #endif _TupleT :: Prism' Type Int _TupleT = prism' reviewer remitter where reviewer = TupleT remitter (TupleT x) = Just x remitter _ = Nothing _UnboxedTupleT :: Prism' Type Int _UnboxedTupleT = prism' reviewer remitter where reviewer = UnboxedTupleT remitter (UnboxedTupleT x) = Just x remitter _ = Nothing _ArrowT :: Prism' Type () _ArrowT = prism' reviewer remitter where reviewer () = ArrowT remitter ArrowT = Just () remitter _ = Nothing #if MIN_VERSION_template_haskell(2,10,0) _EqualityT :: Prism' Type () _EqualityT = prism' reviewer remitter where reviewer () = EqualityT remitter EqualityT = Just () remitter _ = Nothing #endif _ListT :: Prism' Type () _ListT = prism' reviewer remitter where reviewer () = ListT remitter ListT = Just () remitter _ = Nothing #if MIN_VERSION_template_haskell(2,8,0) _PromotedTupleT :: Prism' Type Int _PromotedTupleT = prism' reviewer remitter where reviewer = PromotedTupleT remitter (PromotedTupleT x) = Just x remitter _ = Nothing _PromotedNilT :: Prism' Type () _PromotedNilT = prism' reviewer remitter where reviewer () = PromotedNilT remitter PromotedNilT = Just () remitter _ = Nothing _PromotedConsT :: Prism' Type () _PromotedConsT = prism' reviewer remitter where reviewer () = PromotedConsT remitter PromotedConsT = Just () remitter _ = Nothing _StarT :: Prism' Type () _StarT = prism' reviewer remitter where reviewer () = StarT remitter StarT = Just () remitter _ = Nothing _ConstraintT :: Prism' Type () _ConstraintT = prism' reviewer remitter where reviewer () = ConstraintT remitter ConstraintT = Just () remitter _ = Nothing _LitT :: Prism' Type TyLit _LitT = prism' reviewer remitter where reviewer = LitT remitter (LitT x) = Just x remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,11,0) _InfixT :: Prism' Type (Type, Name, Type) _InfixT = prism' reviewer remitter where reviewer (x, y, z) = InfixT x y z remitter (InfixT x y z) = Just (x, y, z) remitter _ = Nothing _UInfixT :: Prism' Type (Type, Name, Type) _UInfixT = prism' reviewer remitter where reviewer (x, y, z) = UInfixT x y z remitter (UInfixT x y z) = Just (x, y, z) remitter _ = Nothing _ParensT :: Prism' Type Type _ParensT = prism' reviewer remitter where reviewer = ParensT remitter (ParensT x) = Just x remitter _ = Nothing _WildCardT :: Prism' Type () _WildCardT = prism' reviewer remitter where reviewer () = WildCardT remitter WildCardT = Just () remitter _ = Nothing #endif _PlainTV :: Prism' TyVarBndr Name _PlainTV = prism' reviewer remitter where reviewer = PlainTV remitter (PlainTV x) = Just x remitter _ = Nothing _KindedTV :: Prism' TyVarBndr (Name, Kind) _KindedTV = prism' reviewer remitter where reviewer (x, y) = KindedTV x y remitter (KindedTV x y) = Just (x, y) remitter _ = Nothing #if MIN_VERSION_template_haskell(2,11,0) _NoSig :: Prism' FamilyResultSig () _NoSig = prism' reviewer remitter where reviewer () = NoSig remitter NoSig = Just () remitter _ = Nothing _KindSig :: Prism' FamilyResultSig Kind _KindSig = prism' reviewer remitter where reviewer = KindSig remitter (KindSig x) = Just x remitter _ = Nothing _TyVarSig :: Prism' FamilyResultSig TyVarBndr _TyVarSig = prism' reviewer remitter where reviewer = TyVarSig remitter (TyVarSig x) = Just x remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,8,0) _NumTyLit :: Prism' TyLit Integer _NumTyLit = prism' reviewer remitter where reviewer = NumTyLit remitter (NumTyLit x) = Just x remitter _ = Nothing _StrTyLit :: Prism' TyLit String _StrTyLit = prism' reviewer remitter where reviewer = StrTyLit remitter (StrTyLit x) = Just x remitter _ = Nothing #endif #if !MIN_VERSION_template_haskell(2,10,0) _ClassP :: Prism' Pred (Name, [Type]) _ClassP = prism' reviewer remitter where reviewer (x, y) = ClassP x y remitter (ClassP x y) = Just (x, y) remitter _ = Nothing _EqualP :: Prism' Pred (Type, Type) _EqualP = prism' reviewer remitter where reviewer (x, y) = EqualP x y remitter (EqualP x y) = Just (x, y) remitter _ = Nothing #endif #if MIN_VERSION_template_haskell(2,9,0) _NominalR :: Prism' Role () _NominalR = prism' reviewer remitter where reviewer () = NominalR remitter NominalR = Just () remitter _ = Nothing _RepresentationalR :: Prism' Role () _RepresentationalR = prism' reviewer remitter where reviewer () = RepresentationalR remitter RepresentationalR = Just () remitter _ = Nothing _PhantomR :: Prism' Role () _PhantomR = prism' reviewer remitter where reviewer () = PhantomR remitter PhantomR = Just () remitter _ = Nothing _InferR :: Prism' Role () _InferR = prism' reviewer remitter where reviewer () = InferR remitter InferR = Just () remitter _ = Nothing #endif lens-4.14/src/Numeric/0000755000000000000000000000000012710476104012764 5ustar0000000000000000lens-4.14/src/Numeric/Lens.hs0000644000000000000000000001263212710476104014225 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif -------------------------------------------------------------------------------- -- | -- Module : Numeric.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable ------------------------------------------------------------------------------- module Numeric.Lens ( base , integral -- * Predefined bases , binary , octal , decimal , hex -- * Arithmetic lenses , adding , subtracting , multiplying , dividing , exponentiating , negated #if __GLASGOW_HASKELL__ >= 710 , pattern Integral #endif ) where import Control.Lens import Data.Char (chr, ord, isAsciiLower, isAsciiUpper, isDigit) import Data.Maybe (fromMaybe) import Numeric (readInt, showIntAtBase) -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Data.Monoid (Sum(..)) -- | This 'Prism' can be used to model the fact that every 'Integral' -- type is a subset of 'Integer'. -- -- Embedding through the 'Prism' only succeeds if the 'Integer' would pass -- through unmodified when re-extracted. integral :: (Integral a, Integral b) => Prism Integer Integer a b integral = prism toInteger $ \ i -> let a = fromInteger i in if toInteger a == i then Right a else Left i #if __GLASGOW_HASKELL__ >= 710 pattern Integral a <- (preview integral -> Just a) where Integral a = review integral a #endif -- | A prism that shows and reads integers in base-2 through base-36 -- -- Note: This is an improper prism, since leading 0s are stripped when reading. -- -- >>> "100" ^? base 16 -- Just 256 -- -- >>> 1767707668033969 ^. re (base 36) -- "helloworld" base :: Integral a => Int -> Prism' String a base b | b < 2 || b > 36 = error ("base: Invalid base " ++ show b) | otherwise = prism intShow intRead where intShow n = showSigned' (showIntAtBase (toInteger b) intToDigit') (toInteger n) "" intRead s = case readSigned' (readInt (fromIntegral b) (isDigit' b) digitToInt') s of [(n,"")] -> Right n _ -> Left s {-# INLINE base #-} -- | Like 'Data.Char.intToDigit', but handles up to base-36 intToDigit' :: Int -> Char intToDigit' i | i >= 0 && i < 10 = chr (ord '0' + i) | i >= 10 && i < 36 = chr (ord 'a' + i - 10) | otherwise = error ("intToDigit': Invalid int " ++ show i) -- | Like 'Data.Char.digitToInt', but handles up to base-36 digitToInt' :: Char -> Int digitToInt' c = fromMaybe (error ("digitToInt': Invalid digit " ++ show c)) (digitToIntMay c) -- | A safe variant of 'digitToInt'' digitToIntMay :: Char -> Maybe Int digitToIntMay c | isDigit c = Just (ord c - ord '0') | isAsciiLower c = Just (ord c - ord 'a' + 10) | isAsciiUpper c = Just (ord c - ord 'A' + 10) | otherwise = Nothing -- | Select digits that fall into the given base isDigit' :: Int -> Char -> Bool isDigit' b c = case digitToIntMay c of Just i -> i < b _ -> False -- | A simpler variant of 'Numeric.showSigned' that only prepends a dash and -- doesn't know about parentheses showSigned' :: Real a => (a -> ShowS) -> a -> ShowS showSigned' f n | n < 0 = showChar '-' . f (negate n) | otherwise = f n -- | A simpler variant of 'Numeric.readSigned' that supports any base, only -- recognizes an initial dash and doesn't know about parentheses readSigned' :: Real a => ReadS a -> ReadS a readSigned' f ('-':xs) = f xs & mapped . _1 %~ negate readSigned' f xs = f xs -- | @'binary' = 'base' 2@ binary :: Integral a => Prism' String a binary = base 2 -- | @'octal' = 'base' 8@ octal :: Integral a => Prism' String a octal = base 8 -- | @'decimal' = 'base' 10@ decimal :: Integral a => Prism' String a decimal = base 10 -- | @'hex' = 'base' 16@ hex :: Integral a => Prism' String a hex = base 16 -- | @'adding' n = 'iso' (+n) (subtract n)@ -- -- >>> [1..3]^..traverse.adding 1000 -- [1001,1002,1003] adding :: Num a => a -> Iso' a a adding n = iso (+n) (subtract n) -- | @ -- 'subtracting' n = 'iso' (subtract n) ((+n) -- 'subtracting' n = 'from' ('adding' n) -- @ subtracting :: Num a => a -> Iso' a a subtracting n = iso (subtract n) (+n) -- | @'multiplying' n = iso (*n) (/n)@ -- -- Note: This errors for n = 0 -- -- >>> 5 & multiplying 1000 +~ 3 -- 5.003 -- -- >>> let fahrenheit = multiplying (9/5).adding 32 in 230^.from fahrenheit -- 110.0 multiplying :: (Fractional a, Eq a) => a -> Iso' a a multiplying 0 = error "Numeric.Lens.multiplying: factor 0" multiplying n = iso (*n) (/n) -- | @ -- 'dividing' n = 'iso' (/n) (*n) -- 'dividing' n = 'from' ('multiplying' n)@ -- -- Note: This errors for n = 0 dividing :: (Fractional a, Eq a) => a -> Iso' a a dividing 0 = error "Numeric.Lens.dividing: divisor 0" dividing n = iso (/n) (*n) -- | @'exponentiating' n = 'iso' (**n) (**recip n)@ -- -- Note: This errors for n = 0 -- -- >>> au (_Wrapping Sum . from (exponentiating 2)) (foldMapOf each) (3,4) == 5 -- True exponentiating :: (Floating a, Eq a) => a -> Iso' a a exponentiating 0 = error "Numeric.Lens.exponentiating: exponent 0" exponentiating n = iso (**n) (**recip n) -- | @'negated' = 'iso' 'negate' 'negate'@ -- -- >>> au (_Wrapping Sum . negated) (foldMapOf each) (3,4) == 7 -- True -- -- >>> au (_Wrapping Sum) (foldMapOf (each.negated)) (3,4) == -7 -- True negated :: Num a => Iso' a a negated = iso negate negate lens-4.14/src/System/0000755000000000000000000000000012710476104012646 5ustar0000000000000000lens-4.14/src/System/Exit/0000755000000000000000000000000012710476104013557 5ustar0000000000000000lens-4.14/src/System/Exit/Lens.hs0000644000000000000000000000476412710476104015027 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : System.Exit.Lens -- Copyright : (C) 2013-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : Control.Exception -- -- These prisms can be used with the combinators in "Control.Exception.Lens". ---------------------------------------------------------------------------- module System.Exit.Lens ( AsExitCode(..) , _ExitFailure , _ExitSuccess #if __GLASGOW_HASKELL__ >= 710 , pattern ExitFailure_ , pattern ExitSuccess_ #endif ) where import Control.Exception import Control.Exception.Lens import Control.Lens import System.Exit #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -- | Exit codes that a program can return with: class AsExitCode t where _ExitCode :: Prism' t ExitCode instance AsExitCode ExitCode where _ExitCode = id {-# INLINE _ExitCode #-} instance AsExitCode SomeException where _ExitCode = exception {-# INLINE _ExitCode #-} -- | indicates successful termination; -- -- @ -- '_ExitSuccess' :: 'Prism'' 'ExitCode' () -- '_ExitSuccess' :: 'Prism'' 'SomeException' () -- @ _ExitSuccess :: AsExitCode t => Prism' t () _ExitSuccess = _ExitCode . dimap seta (either id id) . right' . rmap (ExitSuccess <$) where seta ExitSuccess = Right () seta t = Left (pure t) {-# INLINE _ExitSuccess #-} -- | indicates program failure with an exit code. The exact interpretation of the code is operating-system dependent. In particular, some values may be prohibited (e.g. 0 on a POSIX-compliant system). -- -- @ -- '_ExitFailure' :: 'Prism'' 'ExitCode' 'Int' -- '_ExitFailure' :: 'Prism'' 'SomeException' 'Int' -- @ _ExitFailure :: AsExitCode t => Prism' t Int _ExitFailure = _ExitCode . dimap seta (either id id) . right' . rmap (fmap ExitFailure) where seta (ExitFailure i) = Right i seta t = Left (pure t) {-# INLINE _ExitFailure #-} #if __GLASGOW_HASKELL__ >= 710 pattern ExitSuccess_ <- (has _ExitSuccess -> True) where ExitSuccess_ = review _ExitSuccess () pattern ExitFailure_ a <- (preview _ExitFailure -> Just a) where ExitFailure_ a = review _ExitFailure a #endif lens-4.14/src/System/FilePath/0000755000000000000000000000000012710476104014342 5ustar0000000000000000lens-4.14/src/System/FilePath/Lens.hs0000644000000000000000000001660312710476104015605 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : System.FilePath.Lens -- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : Rank2Types -- ---------------------------------------------------------------------------- module System.FilePath.Lens ( -- * Operators (~), (<~), (<<~), (<.>~), (<<.>~), (<<<.>~) , (=), (<=), (<<=), (<.>=), (<<.>=), (<<<.>=) -- * Lenses , basename, directory, extension, filename ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad.State as State import System.FilePath ( (), (<.>), splitExtension , takeBaseName, takeDirectory , takeExtension, takeFileName ) import Control.Lens hiding ((<.>)) -- $setup -- >>> :set -XNoOverloadedStrings infixr 4 ~, <~, <<~, <.>~, <<.>~, <<<.>~ infix 4 =, <=, <<=, <.>=, <<.>=, <<<.>= -- | Modify the path by adding another path. -- -- >>> both ~ "bin" $ ("hello","world") -- ("hello/bin","world/bin") -- -- @ -- ('~') :: 'Setter' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a -- ('~') :: 'Iso' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a -- ('~') :: 'Lens' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a -- ('~') :: 'Traversal' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a -- @ (~) :: ASetter s t FilePath FilePath -> FilePath -> s -> t l ~ n = over l ( n) {-# INLINE (~) #-} -- | Modify the target(s) of a 'Lens'', 'Iso'', 'Setter'' or 'Traversal'' by adding a path. -- -- >>> execState (both = "bin") ("hello","world") -- ("hello/bin","world/bin") -- -- @ -- ('=') :: 'MonadState' s m => 'Setter'' s 'FilePath' -> 'FilePath' -> m () -- ('=') :: 'MonadState' s m => 'Iso'' s 'FilePath' -> 'FilePath' -> m () -- ('=') :: 'MonadState' s m => 'Lens'' s 'FilePath' -> 'FilePath' -> m () -- ('=') :: 'MonadState' s m => 'Traversal'' s 'FilePath' -> 'FilePath' -> m () -- @ (=) :: MonadState s m => ASetter' s FilePath -> FilePath -> m () l = b = State.modify (l ~ b) {-# INLINE (=) #-} -- | Add a path onto the end of the target of a 'Lens' and return the result -- -- When you do not need the result of the operation, ('~') is more flexible. (<~) :: LensLike ((,)FilePath) s a FilePath FilePath -> FilePath -> s -> (FilePath, a) l <~ m = l <%~ ( m) {-# INLINE (<~) #-} -- | Add a path onto the end of the target of a 'Lens' into -- your monad's state and return the result. -- -- When you do not need the result of the operation, ('=') is more flexible. (<=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> FilePath -> m FilePath l <= r = l <%= ( r) {-# INLINE (<=) #-} (<<~) :: Optical' (->) q ((,)FilePath) s FilePath -> FilePath -> q s (FilePath, s) l <<~ b = l $ \a -> (a, a b) {-# INLINE (<<~) #-} (<<=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> FilePath -> m FilePath l <<= b = l %%= \a -> (a, a b) {-# INLINE (<<=) #-} -- | Modify the path by adding an extension. -- -- >>> both <.>~ "txt" $ ("hello","world") -- ("hello.txt","world.txt") -- -- @ -- ('<.>~') :: 'Setter' s a 'FilePath' 'FilePath' -> 'String' -> s -> a -- ('<.>~') :: 'Iso' s a 'FilePath' 'FilePath' -> 'String' -> s -> a -- ('<.>~') :: 'Lens' s a 'FilePath' 'FilePath' -> 'String' -> s -> a -- ('<.>~') :: 'Traversal' s a 'FilePath' 'FilePath' -> 'String' -> s -> a -- @ (<.>~) :: ASetter s a FilePath FilePath -> String -> s -> a l <.>~ n = over l (<.> n) {-# INLINE (<.>~) #-} -- | Modify the target(s) of a 'Lens'', 'Iso'', 'Setter'' or 'Traversal'' by adding an extension. -- -- >>> execState (both <.>= "txt") ("hello","world") -- ("hello.txt","world.txt") -- -- @ -- ('<.>=') :: 'MonadState' s m => 'Setter'' s 'FilePath' -> 'String' -> m () -- ('<.>=') :: 'MonadState' s m => 'Iso'' s 'FilePath' -> 'String' -> m () -- ('<.>=') :: 'MonadState' s m => 'Lens'' s 'FilePath' -> 'String' -> m () -- ('<.>=') :: 'MonadState' s m => 'Traversal'' s 'FilePath' -> 'String' -> m () -- @ (<.>=) :: MonadState s m => ASetter' s FilePath -> String -> m () l <.>= b = State.modify (l <.>~ b) {-# INLINE (<.>=) #-} -- | Add an extension onto the end of the target of a 'Lens' and return the result -- -- >>> _1 <<.>~ "txt" $ ("hello","world") -- ("hello.txt",("hello.txt","world")) -- -- When you do not need the result of the operation, ('<.>~') is more flexible. (<<.>~) :: LensLike ((,)FilePath) s a FilePath FilePath -> String -> s -> (FilePath, a) l <<.>~ m = l <%~ (<.> m) {-# INLINE (<<.>~) #-} -- | Add an extension onto the end of the target of a 'Lens' into -- your monad's state and return the result. -- -- >>> evalState (_1 <<.>= "txt") ("hello","world") -- "hello.txt" -- -- When you do not need the result of the operation, ('<.>=') is more flexible. (<<.>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> String -> m FilePath l <<.>= r = l <%= (<.> r) {-# INLINE (<<.>=) #-} -- | Add an extension onto the end of the target of a 'Lens' but -- return the old value -- -- >>> _1 <<<.>~ "txt" $ ("hello","world") -- ("hello",("hello.txt","world")) -- -- When you do not need the old value, ('<.>~') is more flexible. (<<<.>~) :: Optical' (->) q ((,)FilePath) s FilePath -> String -> q s (FilePath, s) l <<<.>~ b = l $ \a -> (a, a <.> b) {-# INLINE (<<<.>~) #-} (<<<.>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> String -> m FilePath l <<<.>= b = l %%= \a -> (a, a <.> b) {-# INLINE (<<<.>=) #-} -- | A 'Lens' for reading and writing to the basename -- -- Note: This is 'not' a legal 'Lens' unless the outer 'FilePath' has both a directory -- and filename component and the generated basenames are not null and contain no directory -- separators. -- -- >>> basename .~ "filename" $ "path/name.png" -- "path/filename.png" basename :: Lens' FilePath FilePath basename f p = (<.> takeExtension p) . (takeDirectory p ) <$> f (takeBaseName p) {-# INLINE basename #-} -- | A 'Lens' for reading and writing to the directory -- -- Note: this is /not/ a legal 'Lens' unless the outer 'FilePath' already has a directory component, -- and generated directories are not null. -- -- >>> "long/path/name.txt" ^. directory -- "long/path" directory :: Lens' FilePath FilePath directory f p = ( takeFileName p) <$> f (takeDirectory p) {-# INLINE directory #-} -- | A 'Lens' for reading and writing to the extension -- -- Note: This is /not/ a legal 'Lens', unless you are careful to ensure that generated -- extension 'FilePath' components are either null or start with 'System.FilePath.extSeparator' -- and do not contain any internal 'System.FilePath.extSeparator's. -- -- >>> extension .~ ".png" $ "path/name.txt" -- "path/name.png" extension :: Lens' FilePath FilePath extension f p = (n <.>) <$> f e where (n, e) = splitExtension p {-# INLINE extension #-} -- | A 'Lens' for reading and writing to the full filename -- -- Note: This is /not/ a legal 'Lens', unless you are careful to ensure that generated -- filename 'FilePath' components are not null and do not contain any -- elements of 'System.FilePath.pathSeparators's. -- -- >>> filename .~ "name.txt" $ "path/name.png" -- "path/name.txt" filename :: Lens' FilePath FilePath filename f p = (takeDirectory p ) <$> f (takeFileName p) {-# INLINE filename #-} lens-4.14/src/System/IO/0000755000000000000000000000000012710476104013155 5ustar0000000000000000lens-4.14/src/System/IO/Error/0000755000000000000000000000000012710476104014246 5ustar0000000000000000lens-4.14/src/System/IO/Error/Lens.hs0000644000000000000000000000647312710476104015515 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : System.IO.Error.Lens -- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : Rank2Types -- ---------------------------------------------------------------------------- module System.IO.Error.Lens where import Control.Lens import GHC.IO.Exception import System.IO import Foreign.C.Types -- * IOException Lenses -- | Where the error happened. location :: Lens' IOException String location f s = f (ioe_location s) <&> \e -> s { ioe_location = e } {-# INLINE location #-} -- | Error type specific information. description :: Lens' IOException String description f s = f (ioe_description s) <&> \e -> s { ioe_description = e } {-# INLINE description #-} -- | The handle used by the action flagging this error. handle :: Lens' IOException (Maybe Handle) handle f s = f (ioe_handle s) <&> \e -> s { ioe_handle = e } {-# INLINE handle #-} -- | 'fileName' the error is related to. -- fileName :: Lens' IOException (Maybe FilePath) fileName f s = f (ioe_filename s) <&> \e -> s { ioe_filename = e } {-# INLINE fileName #-} -- | 'errno' leading to this error, if any. -- errno :: Lens' IOException (Maybe CInt) errno f s = f (ioe_errno s) <&> \e -> s { ioe_errno = e } {-# INLINE errno #-} ------------------------------------------------------------------------------ -- Error Types ------------------------------------------------------------------------------ -- | What type of error it is errorType :: Lens' IOException IOErrorType errorType f s = f (ioe_type s) <&> \e -> s { ioe_type = e } {-# INLINE errorType #-} -- * IOErrorType Prisms -- _AlreadyExists :: Prism' IOErrorType () _AlreadyExists = only AlreadyExists _NoSuchThing :: Prism' IOErrorType () _NoSuchThing = only NoSuchThing _ResourceBusy :: Prism' IOErrorType () _ResourceBusy = only ResourceBusy _ResourceExhausted :: Prism' IOErrorType () _ResourceExhausted = only ResourceExhausted _EOF :: Prism' IOErrorType () _EOF = only EOF _IllegalOperation :: Prism' IOErrorType () _IllegalOperation = only IllegalOperation _PermissionDenied :: Prism' IOErrorType () _PermissionDenied = only PermissionDenied _UserError :: Prism' IOErrorType () _UserError = only UserError _UnsatisfiedConstraints :: Prism' IOErrorType () _UnsatisfiedConstraints = only UnsatisfiedConstraints _SystemError :: Prism' IOErrorType () _SystemError = only SystemError _ProtocolError :: Prism' IOErrorType () _ProtocolError = only ProtocolError _OtherError :: Prism' IOErrorType () _OtherError = only OtherError _InvalidArgument :: Prism' IOErrorType () _InvalidArgument = only InvalidArgument _InappropriateType :: Prism' IOErrorType () _InappropriateType = only InappropriateType _HardwareFault :: Prism' IOErrorType () _HardwareFault = only HardwareFault _UnsupportedOperation :: Prism' IOErrorType () _UnsupportedOperation = only UnsupportedOperation _TimeExpired :: Prism' IOErrorType () _TimeExpired = only TimeExpired _ResourceVanished :: Prism' IOErrorType () _ResourceVanished = only ResourceVanished _Interrupted :: Prism' IOErrorType () _Interrupted = only Interrupted lens-4.14/tests/0000755000000000000000000000000012710476104011735 5ustar0000000000000000lens-4.14/tests/doctests.hsc0000644000000000000000000000464712710476104014277 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : Main (doctests) -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module provides doctests for a project based on the actual versions -- of the packages it was built with. It requires a corresponding Setup.lhs -- to be added to the project ----------------------------------------------------------------------------- module Main where import Build_doctests (autogen_dir, deps) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Monad import Data.List import System.Directory import System.FilePath import Test.DocTest ##if defined(mingw32_HOST_OS) ##if defined(i386_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt ##elif defined(x86_64_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt ##endif ##endif -- | Run in a modified codepage where we can print UTF-8 values on Windows. withUnicode :: IO a -> IO a ##ifdef USE_CP withUnicode m = do cp <- c_GetConsoleCP (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp ##else withUnicode m = m ##endif main :: IO () main = withUnicode $ getSources >>= \sources -> doctest $ "-isrc" : ("-i" ++ autogen_dir) : "-optP-include" : ("-optP" ++ autogen_dir ++ "/cabal_macros.h") : "-hide-all-packages" #ifdef TRUSTWORTHY : "-DTRUSTWORTHY=1" #endif : map ("-package="++) deps ++ 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 lens-4.14/tests/hlint.hs0000644000000000000000000000131612710476104013410 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Main (hlint) -- Copyright : (C) 2013-2014 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module runs HLint on the lens source tree. ----------------------------------------------------------------------------- module Main where import Control.Monad import Language.Haskell.HLint import System.Environment import System.Exit main :: IO () main = do args <- getArgs hints <- hlint $ ["src", "--cpp-define=HLINT", "--cpp-ansi"] ++ args unless (null hints) exitFailure lens-4.14/tests/hunit.hs0000644000000000000000000002215212710476104013422 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE TemplateHaskell #-} ----------------------------------------------------------------------------- -- | -- Module : Main (hunit) -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module provides a simple hunit test suite for lens. -- -- 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. ----------------------------------------------------------------------------- module Main where import Control.Lens import Control.Monad.State import Data.Char import Data.List as List import Data.Monoid import Data.Map as Map import Test.Framework.Providers.HUnit import Test.Framework.TH import Test.Framework import Test.HUnit hiding (test) 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 data Shape = SBox Box | SPolygon Polygon | SCircle Point Int | SVoid makePrisms ''Shape 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 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.ix origin @?= "Origin" case_read_state_map_entry = runState test trig @?= ("Origin", trig) where test = use $ labels.ix origin case_modify_map_entry = (trig & labels.ix 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) @?= Just 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] lens-4.14/tests/properties.hs0000644000000000000000000001223012710476104014463 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE LiberalTypeSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE KindSignatures #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ConstraintKinds #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Main (properties) -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module provides a set of QuickCheck properties that can be run through -- test-framework to validate a number of expected behaviors of the library. ----------------------------------------------------------------------------- module Main where import Control.Applicative import Control.Lens import Test.QuickCheck import Test.QuickCheck.Function import Test.Framework.TH import Test.Framework.Providers.QuickCheck2 import Data.Char (isAlphaNum, isAscii, toUpper) import Data.Text.Strict.Lens import Data.Maybe import Data.List.Lens import Data.Functor.Compose import GHC.Exts (Constraint) import Numeric (showHex, showOct, showSigned) import Numeric.Lens import Control.Lens.Properties (isIso, isLens, isPrism, isSetter, isTraversal) -- an illegal lens bad :: Lens' (Int,Int) Int bad f (a,b) = (,) b <$> f a badIso :: Iso' Int Bool badIso = iso even fromEnum -- Control.Lens.Type prop_1 = isLens (_1 :: Lens' (Int,Double,()) Int) prop_2 = isLens (_2 :: Lens' (Int,Bool) Bool) prop_3 = isLens (_3 :: Lens' (Int,Bool,()) ()) prop_4 = isLens (_4 :: Lens' (Int,Bool,(),Maybe Int) (Maybe Int)) prop_5 = isLens (_5 :: Lens' ((),(),(),(),Int) Int) prop_2_2 = isLens (_2._2 :: 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 :: Setter' [Int] Int) prop_mapped_mapped = isSetter (mapped.mapped :: Setter' [Maybe Int] Int) prop_both = isTraversal (both :: Traversal' (Int,Int) Int) prop_traverseLeft = isTraversal (_Left :: Traversal' (Either Int Bool) Int) prop_traverseRight = isTraversal (_Right :: Traversal' (Either Int Bool) Bool) prop_simple = isIso (simple :: Iso' Int Int) --prop_enum = isIso (enum :: Iso' Int Char) prop__Left = isPrism (_Left :: Prism' (Either Int Bool) Int) prop__Right = isPrism (_Right :: Prism' (Either Int Bool) Bool) prop__Just = isPrism (_Just :: Prism' (Maybe Int) Int) -- Data.List.Lens prop_prefixed s = isPrism (prefixed s :: Prism' String String) -- Data.Text.Lens prop_text s = s^.packed.from packed == s --prop_text = isIso packed -- Numeric.Lens prop_base_show (n :: Integer) = conjoin [ show n == n ^. re (base 10) , showSigned showOct 0 n "" == n ^. re (base 8) , showSigned showHex 0 n "" == n ^. re (base 16) ] prop_base_read (n :: Integer) = conjoin [ show n ^? base 10 == Just n , showSigned showOct 0 n "" ^? base 8 == Just n , showSigned showHex 0 n "" ^? base 16 == Just n , map toUpper (showSigned showHex 0 n "") ^? base 16 == Just n ] prop_base_readFail (s :: String) = forAll (choose (2,36)) $ \b -> not isValid ==> s ^? base b == Nothing where isValid = (not . null) sPos && all isValidChar sPos sPos = case s of { ('-':s') -> s'; _ -> s } isValidChar c = isAscii c && isAlphaNum c -- Things that should typecheck but that we don't need to run #if __GLASGOW_HASKELL__ >= 708 data Foo (a :: Constraint) (b :: Constraint) where Foo :: Foo (Num Int) b sampleExtremePoly :: Equality s t a b -> Foo a (Functor b) -> Foo s (Functor t) sampleExtremePoly f foo = f foo #endif #if __GLASGOW_HASKELL__ >= 706 samplePolyEquality :: Equality Monad Identity Monad Identity samplePolyEquality f = f lessSimplePoly :: forall (s :: k1) (t :: k2) (a :: k1) (b :: k2) . Equality a b a b lessSimplePoly f = f equalityAnEqualityPoly :: forall (s :: k1) (t :: k2) (a :: k1) (b :: k2) . Equality s t a b -> AnEquality s t a b equalityAnEqualityPoly f = f #else lessSimple :: Equality a b a b lessSimple f = f equalityAnEquality :: Equality s t a b -> AnEquality s t a b equalityAnEquality f = f #endif equalityIso :: Equality s t a b -> Iso s t a b equalityIso f = f main :: IO () main = $defaultMainGenerator lens-4.14/tests/templates.hs0000644000000000000000000002542112710476104014273 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Main (templates) -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This test suite validates that we are able to generate usable lenses with -- template haskell. -- -- The commented code summarizes what will be auto-generated below ----------------------------------------------------------------------------- module Main where import Control.Lens -- import Test.QuickCheck (quickCheck) data Bar a b c = Bar { _baz :: (a, b) } makeLenses ''Bar checkBaz :: Iso (Bar a b c) (Bar a' b' c') (a, b) (a', b') checkBaz = baz data Quux a b = Quux { _quaffle :: Int, _quartz :: Double } makeLenses ''Quux checkQuaffle :: Lens (Quux a b) (Quux a' b') Int Int checkQuaffle = quaffle checkQuartz :: Lens (Quux a b) (Quux a' b') Double Double checkQuartz = quartz data Quark a = Qualified { _gaffer :: a } | Unqualified { _gaffer :: a, _tape :: a } makeLenses ''Quark checkGaffer :: Lens' (Quark a) a checkGaffer = gaffer checkTape :: Traversal' (Quark a) a checkTape = tape data Hadron a b = Science { _a1 :: a, _a2 :: a, _c :: b } makeLenses ''Hadron checkA1 :: Lens' (Hadron a b) a checkA1 = a1 checkA2 :: Lens' (Hadron a b) a checkA2 = a2 checkC :: Lens (Hadron a b) (Hadron a b') b b' checkC = c data Perambulation a b = Mountains { _terrain :: a, _altitude :: b } | Beaches { _terrain :: a, _dunes :: a } makeLenses ''Perambulation checkTerrain :: Lens' (Perambulation a b) a checkTerrain = terrain checkAltitude :: Traversal (Perambulation a b) (Perambulation a b') b b' checkAltitude = altitude checkDunes :: Traversal' (Perambulation a b) a checkDunes = dunes makeLensesFor [("_terrain", "allTerrain"), ("_dunes", "allTerrain")] ''Perambulation checkAllTerrain :: Traversal (Perambulation a b) (Perambulation a' b) a a' checkAllTerrain = allTerrain data LensCrafted a = Still { _still :: a } | Works { _still :: a } makeLenses ''LensCrafted checkStill :: Lens (LensCrafted a) (LensCrafted b) a b checkStill = still data Task a = Task { taskOutput :: a -> IO () , taskState :: a , taskStop :: IO () } makeLensesFor [("taskOutput", "outputLens"), ("taskState", "stateLens"), ("taskStop", "stopLens")] ''Task checkOutputLens :: Lens' (Task a) (a -> IO ()) checkOutputLens = outputLens checkStateLens :: Lens' (Task a) a checkStateLens = stateLens checkStopLens :: Lens' (Task a) (IO ()) checkStopLens = stopLens data Mono a = Mono { _monoFoo :: a, _monoBar :: Int } makeClassy ''Mono -- class HasMono t where -- mono :: Simple Lens t Mono -- instance HasMono Mono where -- mono = id checkMono :: HasMono t a => Lens' t (Mono a) checkMono = mono checkMono' :: Lens' (Mono a) (Mono a) checkMono' = mono checkMonoFoo :: HasMono t a => Lens' t a checkMonoFoo = monoFoo checkMonoBar :: HasMono t a => Lens' t Int checkMonoBar = monoBar data Nucleosis = Nucleosis { _nuclear :: Mono Int } makeClassy ''Nucleosis -- class HasNucleosis t where -- nucleosis :: Simple Lens t Nucleosis -- instance HasNucleosis Nucleosis checkNucleosis :: HasNucleosis t => Lens' t Nucleosis checkNucleosis = nucleosis checkNucleosis' :: Lens' Nucleosis Nucleosis checkNucleosis' = nucleosis checkNuclear :: HasNucleosis t => Lens' t (Mono Int) checkNuclear = nuclear instance HasMono Nucleosis Int where mono = nuclear -- Dodek's example data Foo = Foo { _fooX, _fooY :: Int } makeClassy ''Foo checkFoo :: HasFoo t => Lens' t Foo checkFoo = foo checkFoo' :: Lens' Foo Foo checkFoo' = foo checkFooX :: HasFoo t => Lens' t Int checkFooX = fooX checkFooY :: HasFoo t => Lens' t Int checkFooY = fooY data Dude a = Dude { dudeLevel :: Int , dudeAlias :: String , dudeLife :: () , dudeThing :: a } makeFields ''Dude checkLevel :: HasLevel t a => Lens' t a checkLevel = level checkLevel' :: Lens' (Dude a) Int checkLevel' = level checkAlias :: HasAlias t a => Lens' t a checkAlias = alias checkAlias' :: Lens' (Dude a) String checkAlias' = alias checkLife :: HasLife t a => Lens' t a checkLife = life checkLife' :: Lens' (Dude a) () checkLife' = life checkThing :: HasThing t a => Lens' t a checkThing = thing checkThing' :: Lens' (Dude a) a checkThing' = thing data Lebowski a = Lebowski { _lebowskiAlias :: String , _lebowskiLife :: Int , _lebowskiMansion :: String , _lebowskiThing :: Maybe a } makeFields ''Lebowski checkAlias2 :: Lens' (Lebowski a) String checkAlias2 = alias checkLife2 :: Lens' (Lebowski a) Int checkLife2 = life checkMansion :: HasMansion t a => Lens' t a checkMansion = mansion checkMansion' :: Lens' (Lebowski a) String checkMansion' = mansion checkThing2 :: Lens' (Lebowski a) (Maybe a) checkThing2 = thing data AbideConfiguration a = AbideConfiguration { _acLocation :: String , _acDuration :: Int , _acThing :: a } makeLensesWith abbreviatedFields ''AbideConfiguration checkLocation :: HasLocation t a => Lens' t a checkLocation = location checkLocation' :: Lens' (AbideConfiguration a) String checkLocation' = location checkDuration :: HasDuration t a => Lens' t a checkDuration = duration checkDuration' :: Lens' (AbideConfiguration a) Int checkDuration' = duration checkThing3 :: Lens' (AbideConfiguration a) a checkThing3 = thing dudeDrink :: String dudeDrink = (Dude 9 "El Duderino" () "white russian") ^. thing lebowskiCarpet :: Maybe String lebowskiCarpet = (Lebowski "Mr. Lebowski" 0 "" (Just "carpet")) ^. thing abideAnnoyance :: String abideAnnoyance = (AbideConfiguration "the tree" 10 "the wind") ^. thing declareLenses [d| data Quark1 a = Qualified1 { gaffer1 :: a } | Unqualified1 { gaffer1 :: a, tape1 :: a } |] -- data Quark1 a = Qualified1 a | Unqualified1 a a checkGaffer1 :: Lens' (Quark1 a) a checkGaffer1 = gaffer1 checkTape1 :: Traversal' (Quark1 a) a checkTape1 = tape1 declarePrisms [d| data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp } |] -- data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp } checkLit :: Int -> Exp checkLit = Lit checkVar :: String -> Exp checkVar = Var checkLambda :: String -> Exp -> Exp checkLambda = Lambda check_Lit :: Prism' Exp Int check_Lit = _Lit check_Var :: Prism' Exp String check_Var = _Var check_Lambda :: Prism' Exp (String, Exp) check_Lambda = _Lambda declarePrisms [d| data Banana = Banana Int String |] -- data Banana = Banana Int String check_Banana :: Iso' Banana (Int, String) check_Banana = _Banana cavendish :: Banana cavendish = _Banana # (4, "Cavendish") data family Family a b c #if __GLASGOW_HASKELL >= 706 declareLenses [d| data instance Family Int (a, b) a = FamilyInt { fm0 :: (b, a), fm1 :: Int } |] -- data instance Family Int (a, b) a = FamilyInt a b checkFm0 :: Lens (Family Int (a, b) a) (Family Int (a', b') a') (b, a) (b', a') checkFm0 = fm0 checkFm1 :: Lens' (Family Int (a, b) a) Int checkFm1 = fm1 #endif class Class a where data Associated a method :: a -> Int declareLenses [d| instance Class Int where data Associated Int = AssociatedInt { mochi :: Double } method = id |] -- instance Class Int where -- data Associated Int = AssociatedInt Double -- method = id checkMochi :: Iso' (Associated Int) Double checkMochi = mochi #if __GLASGOW_HASKELL__ >= 706 declareFields [d| data DeclaredFields f a = DeclaredField1 { declaredFieldsA0 :: f a , declaredFieldsB0 :: Int } | DeclaredField2 { declaredFieldsC0 :: String , declaredFieldsB0 :: Int } deriving (Show) |] checkA0 :: HasA0 t a => Traversal' t a checkA0 = a0 checkB0 :: HasB0 t a => Lens' t a checkB0 = b0 checkC0 :: HasC0 t a => Traversal' t a checkC0 = c0 checkA0' :: Traversal' (DeclaredFields f a) (f a) checkA0' = a0 checkB0' :: Lens' (DeclaredFields f a) Int checkB0' = b0 checkC0' :: Traversal' (DeclaredFields f a) String checkC0' = c0 #endif data Rank2Tests = C1 { _r2length :: forall a. [a] -> Int , _r2nub :: forall a. Eq a => [a] -> [a] } | C2 { _r2length :: forall a. [a] -> Int } makeLenses ''Rank2Tests checkR2length :: Getter Rank2Tests ([a] -> Int) checkR2length = r2length checkR2nub :: Eq a => Fold Rank2Tests ([a] -> [a]) checkR2nub = r2nub data PureNoFields = PureNoFieldsA | PureNoFieldsB { _pureNoFields :: Int } makeLenses ''PureNoFields data ReviewTest where ReviewTest :: a -> ReviewTest makePrisms ''ReviewTest -- test FieldNamers data CheckUnderscoreNoPrefixNamer = CheckUnderscoreNoPrefixNamer { _fieldUnderscoreNoPrefix :: Int } makeLensesWith (lensRules & lensField .~ underscoreNoPrefixNamer ) ''CheckUnderscoreNoPrefixNamer checkUnderscoreNoPrefixNamer :: Lens' CheckUnderscoreNoPrefixNamer Int checkUnderscoreNoPrefixNamer = fieldUnderscoreNoPrefix -- how can we test NOT generating a lens for some fields? data CheckMappingNamer = CheckMappingNamer { fieldMappingNamer :: String } makeLensesWith (lensRules & lensField .~ (mappingNamer (return . ("hogehoge_" ++)))) ''CheckMappingNamer checkMappingNamer :: Lens' CheckMappingNamer String checkMappingNamer = hogehoge_fieldMappingNamer data CheckLookingupNamer = CheckLookingupNamer { fieldLookingupNamer :: Int } makeLensesWith (lensRules & lensField .~ (lookingupNamer [("fieldLookingupNamer", "foobarFieldLookingupNamer")])) ''CheckLookingupNamer checkLookingupNamer :: Lens' CheckLookingupNamer Int checkLookingupNamer = foobarFieldLookingupNamer data CheckUnderscoreNamer = CheckUnderscoreNamer { _hogeprefix_fieldCheckUnderscoreNamer :: Int } makeLensesWith (defaultFieldRules & lensField .~ underscoreNamer) ''CheckUnderscoreNamer checkUnderscoreNamer :: Lens' CheckUnderscoreNamer Int checkUnderscoreNamer = fieldCheckUnderscoreNamer data CheckCamelCaseNamer = CheckCamelCaseNamer { _checkCamelCaseNamerFieldCamelCaseNamer :: Int } makeLensesWith (defaultFieldRules & lensField .~ camelCaseNamer) ''CheckCamelCaseNamer checkCamelCaseNamer :: Lens' CheckCamelCaseNamer Int checkCamelCaseNamer = fieldCamelCaseNamer data CheckAbbreviatedNamer = CheckAbbreviatedNamer { _hogeprefixFieldAbbreviatedNamer :: Int } makeLensesWith (defaultFieldRules & lensField .~ abbreviatedNamer ) ''CheckAbbreviatedNamer checkAbbreviatedNamer :: Lens' CheckAbbreviatedNamer Int checkAbbreviatedNamer = fieldAbbreviatedNamer main :: IO () main = putStrLn "test/templates.hs: ok" lens-4.14/travis/0000755000000000000000000000000012710476104012103 5ustar0000000000000000lens-4.14/travis/cabal-apt-install0000755000000000000000000000120512710476104015317 0ustar0000000000000000#! /bin/bash set -eu APT="sudo apt-get -q -y" CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall" $APT update $APT install dctrl-tools # Find potential system packages to satisfy cabal dependencies deps() { local M='^\([^ ]\+\)-[0-9.]\+ (.*$' local G=' -o ( -FPackage -X libghc-\L\1\E-dev )' local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \ | sed -ne "s/$M/$G/p" | sort -u)" grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u } $APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special $CABAL_INSTALL_DEPS --constraint='hlint installed' "$@" # Install the rest via Hackage lens-4.14/travis/config0000644000000000000000000000120612710476104013272 0ustar0000000000000000-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix -- -- This is particularly useful for travis-ci to get it to stop complaining -- about a broken build when everything is still correct on our end. -- -- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead -- -- To enable this, uncomment the before_script in .travis.yml remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive remote-repo-cache: ~/.cabal/packages world-file: ~/.cabal/world build-summary: ~/.cabal/logs/build.log remote-build-reporting: anonymous install-dirs user install-dirs global