lens 4.15.1 → 4.15.2
raw patch · 38 files changed
+2390/−249 lines, 38 filesdep ~bifunctorsdep ~containersdep ~doctestsetup-changed
Dependency ranges changed: bifunctors, containers, doctest, hlint, template-haskell
Files
- .travis.yml +23/−27
- AUTHORS.markdown +2/−0
- CHANGELOG.markdown +29/−0
- HLint.hs +1/−0
- LICENSE +0/−4
- Setup.lhs +175/−41
- benchmarks/folds.hs +7/−7
- benchmarks/traversals.hs +23/−0
- lens.cabal +18/−9
- src/Control/Exception/Lens.hs +112/−0
- src/Control/Lens/Cons.hs +2/−2
- src/Control/Lens/Empty.hs +2/−2
- src/Control/Lens/Fold.hs +109/−9
- src/Control/Lens/Getter.hs +13/−5
- src/Control/Lens/Indexed.hs +1/−1
- src/Control/Lens/Internal/Context.hs +1/−1
- src/Control/Lens/Internal/Fold.hs +14/−0
- src/Control/Lens/Internal/Indexed.hs +12/−0
- src/Control/Lens/Internal/PrismTH.hs +1/−1
- src/Control/Lens/Internal/TH.hs +4/−0
- src/Control/Lens/Iso.hs +4/−3
- src/Control/Lens/Level.hs +29/−12
- src/Control/Lens/Review.hs +4/−0
- src/Control/Lens/TH.hs +65/−2
- src/Control/Lens/Traversal.hs +19/−9
- src/Control/Lens/Tuple.hs +792/−8
- src/Control/Lens/Wrapped.hs +646/−16
- src/Control/Monad/Error/Lens.hs +13/−1
- src/Data/Bits/Lens.hs +1/−1
- src/Data/ByteString/Strict/Lens.hs +1/−0
- src/Data/Dynamic/Lens.hs +1/−1
- src/Data/Map/Lens.hs +3/−1
- src/Data/Text/Lazy/Lens.hs +1/−1
- src/Data/Text/Strict/Lens.hs +1/−1
- src/Language/Haskell/TH/Lens.hs +231/−6
- tests/doctests.hs +25/−0
- tests/doctests.hsc +0/−78
- tests/properties.hs +5/−0
.travis.yml view
@@ -13,27 +13,30 @@ 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+ - env: CABALVER=1.24 GHCVER=8.2.1+ compiler: ": #GHC 8.2.1"+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.1,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=8.0.2+ compiler: ": #GHC 8.0.2"+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 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+ addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=head GHCVER=7.8.4+ compiler: ": #GHC 7.8.4"+ addons: {apt: {packages: [cabal-install-head,ghc-7.8.4,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=head GHCVER=7.6.3+ compiler: ": #GHC 7.6.3"+ addons: {apt: {packages: [cabal-install-head,ghc-7.6.3,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=head GHCVER=7.4.2+ compiler: ": #GHC 7.4.2"+ addons: {apt: {packages: [cabal-install-head,ghc-7.4.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=head GHCVER=head CABALFLAGS=--allow-newer compiler: ": #GHC head"- addons: {apt: {packages: [cabal-install-1.24,ghc-head,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ addons: {apt: {packages: [cabal-install-head,ghc-head,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} allow_failures:- - env: CABALVER=1.24 GHCVER=head+ - env: CABALVER=head GHCVER=head CABALFLAGS=--allow-newer before_install: - unset CC@@ -42,9 +45,6 @@ - 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 ];@@ -54,7 +54,7 @@ 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+ - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot@@ -68,8 +68,7 @@ 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;+ cabal install --only-dependencies --enable-tests --enable-benchmarks; fi # snapshot package-db on cache miss@@ -81,13 +80,10 @@ 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 configure --enable-tests --enable-benchmarks -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
AUTHORS.markdown view
@@ -37,6 +37,8 @@ * [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)+* [Alex Mason](mailto:axman6@gmail.com) [@Axman6](https://github.com/Axman6)+* [Ryan Scott](mailto:ryan.gl.scott@gmail.com) [@RyanGlScott](https://github.com/RyanGlScott) You can watch them carry on the quest for bragging rights in the [contributors graph](https://github.com/ekmett/lens/graphs/contributors).
CHANGELOG.markdown view
@@ -1,3 +1,32 @@+4.15.2+----+* Build with GHC 8.2+* Expand tuple accessors to support up to 19-tuples+* Add more `Rewrapped` and `Wrapped` instances for data types from the `base`,+ `bifunctors`, `exceptions`, `free`, `profunctors`, and `semigroupoids`+ libraries+* Add a `Generic` default implementation for `Wrapped`+* Add `Wrapped` instances for data types introduced in `Foreign.C.Types` and+ `System.Posix.Types` in `base-4.10.0.0`+* Add prisms for recently introduced data types in `Control.Exception`+* Revamp `Setup.hs` to use `cabal-doctest`. This makes it build+ with `Cabal-1.25`, and makes the `doctest`s work with `cabal new-build` and+ sandboxes.+* Add `makeFieldsNoPrefix`, a variant of `makeFields` which gives the desired+ behavior in the presence of `DuplicateRecordFields`. Also add+ `classUnderscoreNoPrefixFields` and `classUnderscoreNoPrefixNamer`, the+ corresponding `LensRules` and `FieldNamer`, respectively.+* Add `toNonEmptyOf`, `first1Of`, `last1Of`, `minimum1Of`, and `maximum1Of`+ to `Control.Lens.Fold`+* Add `both1` to `Control.Lens.Traversal`+* Generalize the type of `levels` and `ilevels` in `Control.Lens.Level` to work+ on `Fold`s+* Generalize the type of `getting` in `Control.Lens.Getter` to work with any+ `Optical`+* Add `throwing_` to `Control.Monad.Error.Lens` and `Control.Exception.Lens`+* Fix the meta-data in the .cabal file to properly indicate that this project+ has a BSD2 license+ 4.15.1 ---- * Restore the `generic` and `generic1` functions in `GHC.Generics.Lens`
HLint.hs view
@@ -4,6 +4,7 @@ ignore "Redundant lambda" ignore "Use >=>" ignore "Use const"+ignore "Use module export list" -- Used hlint --find src/ in the lens repo to generate this: infixl 9 :>
LICENSE view
@@ -13,10 +13,6 @@ 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
Setup.lhs view
@@ -1,59 +1,193 @@-#!/usr/bin/runhaskell \begin{code}-{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} 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(..) )+#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif++-- haddock stuff+import Distribution.Package ( Package (..), packageName ) 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.Simple.Setup (Flag (..), HaddockFlags, haddockDistPref)+import Distribution.Simple.Utils (copyFiles)+import Distribution.Verbosity (normal) 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- }+#if MIN_VERSION_cabal_doctest(1,0,0)+import Distribution.Extra.Doctest (generateBuildModule )+#else -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)+#ifndef MIN_VERSION_Cabal+#define MIN_VERSION_Cabal(x,y,z) 0+#endif+#ifndef MIN_VERSION_directory+#define MIN_VERSION_directory(x,y,z) 0+#endif+#if MIN_VERSION_Cabal(1,24,0)+#define InstalledPackageId UnitId+#endif -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"+import Control.Monad ( when )+import Data.List ( nub )+import Data.String ( fromString )+import Distribution.Package ( InstalledPackageId )+import Distribution.Package ( PackageId, Package (..), packageVersion )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..))+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag)+import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler )+import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))+import Distribution.Text ( display , simpleParse )++#if MIN_VERSION_Cabal(1,25,0)+import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )+#endif++#if MIN_VERSION_directory(1,2,2)+import System.Directory (makeAbsolute)+#else+import System.Directory (getCurrentDirectory)+import System.FilePath (isAbsolute)++makeAbsolute :: FilePath -> IO FilePath+makeAbsolute p | isAbsolute p = return p+ | otherwise = do+ cwd <- getCurrentDirectory+ return $ cwd </> p+#endif++generateBuildModule :: String -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule testsuiteName flags pkg lbi = do+ let verbosity = fromFlag (buildVerbosity flags)+ let distPref = fromFlag (buildDistPref flags)++ -- Package DBs+ let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]+ let dbFlags = "-hide-all-packages" : packageDbArgs dbStack++ withLibLBI pkg lbi $ \lib libcfg -> do+ let libBI = libBuildInfo lib++ -- modules+ let modules = exposedModules lib ++ otherModules libBI+ -- it seems that doctest is happy to take in module names, not actual files!+ let module_sources = modules++ -- We need the directory with library's cabal_macros.h!+#if MIN_VERSION_Cabal(1,25,0)+ let libAutogenDir = autogenComponentModulesDir lbi libcfg+#else+ let libAutogenDir = autogenModulesDir lbi+#endif++ -- Lib sources and includes+ iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI+ includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI++ -- CPP includes, i.e. include cabal_macros.h+ let cppFlags = map ("-optP"++) $+ [ "-include", libAutogenDir ++ "/cabal_macros.h" ]+ ++ cppOptions libBI++ withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do++ -- get and create autogen dir+#if MIN_VERSION_Cabal(1,25,0)+ let testAutogenDir = autogenComponentModulesDir lbi suitecfg+#else+ let testAutogenDir = autogenModulesDir lbi+#endif+ createDirectoryIfMissingVerbose verbosity True testAutogenDir++ -- write autogen'd file+ rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines+ [ "module Build_doctests where" , ""- , "autogen_dir :: String"- , "autogen_dir = " ++ show dir+ -- -package-id etc. flags+ , "pkgs :: [String]"+ , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg) , ""- , "deps :: [String]"- , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+ , "flags :: [String]"+ , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)+ , ""+ , "module_sources :: [String]"+ , "module_sources = " ++ show (map display module_sources) ] where- formatdeps = map (formatone . snd)- formatone p = case packageName p of- PackageName n -> n ++ "-" ++ showVersion (packageVersion p)+ -- we do this check in Setup, as then doctests don't need to depend on Cabal+ isOldCompiler = maybe False id $ do+ a <- simpleParse $ showCompilerId $ compiler lbi+ b <- simpleParse "7.5"+ return $ packageVersion (a :: PackageId) < b + formatDeps = map formatOne+ formatOne (installedPkgId, pkgId)+ -- The problem is how different cabal executables handle package databases+ -- when doctests depend on the library+ | packageId pkg == pkgId = "-package=" ++ display pkgId+ | otherwise = "-package-id=" ++ display installedPkgId++ -- From Distribution.Simple.Program.GHC+ packageDbArgs :: [PackageDB] -> [String]+ packageDbArgs | isOldCompiler = packageDbArgsConf+ | otherwise = packageDbArgsDb++ -- GHC <7.6 uses '-package-conf' instead of '-package-db'.+ packageDbArgsConf :: [PackageDB] -> [String]+ packageDbArgsConf dbstack = case dbstack of+ (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs+ (GlobalPackageDB:dbs) -> ("-no-user-package-conf")+ : concatMap specific dbs+ _ -> ierror+ where+ specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ]+ specific _ = ierror+ ierror = error $ "internal error: unexpected package db stack: "+ ++ show dbstack++ -- GHC >= 7.6 uses the '-package-db' flag. See+ -- https://ghc.haskell.org/trac/ghc/ticket/5977.+ packageDbArgsDb :: [PackageDB] -> [String]+ -- special cases to make arguments prettier in common scenarios+ packageDbArgsDb dbstack = case dbstack of+ (GlobalPackageDB:UserPackageDB:dbs)+ | all isSpecific dbs -> concatMap single dbs+ (GlobalPackageDB:dbs)+ | all isSpecific dbs -> "-no-user-package-db"+ : concatMap single dbs+ dbs -> "-clear-package-db"+ : concatMap single dbs+ where+ single (SpecificPackageDB db) = [ "-package-db=" ++ db ]+ single GlobalPackageDB = [ "-global-package-db" ]+ single UserPackageDB = [ "-user-package-db" ]+ isSpecific (SpecificPackageDB _) = True+ isSpecific _ = False+ testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++#endif++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)++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+ { buildHook = \pkg lbi hooks flags -> do+ generateBuildModule "doctests" 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+ } \end{code}
benchmarks/folds.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE BangPatterns #-} import qualified Data.ByteString as BS+import qualified Data.Foldable as F import qualified Data.HashMap.Lazy as HM import qualified Data.Map as M import qualified Data.Sequence as S@@ -16,7 +17,6 @@ import Control.Lens import Criterion.Main import Criterion.Types-import Data.Foldable main :: IO () main = defaultMainWith config@@ -43,11 +43,11 @@ ] , bgroup "sequence" [ bgroup "toList"- [ bench "native" $ nf toList s+ [ bench "native" $ nf F.toList s , bench "each" $ nf (toListOf each) s ] , bgroup "itoList"- [ bench "native" $ nf (toList . S.mapWithIndex (,)) s+ [ bench "native" $ nf (F.toList . S.mapWithIndex (,)) s , bench "itraversed" $ nf (itoListOf itraversed) s ] ]@@ -64,7 +64,7 @@ ] , bgroup "list" [ bgroup "toList"- [ bench "native" $ nf toList l+ [ bench "native" $ nf F.toList l , bench "each" $ nf (toListOf each) l ] , bgroup "itoList"@@ -74,11 +74,11 @@ ] , bgroup "map" [ bgroup "toList"- [ bench "native" $ nf toList m+ [ bench "native" $ nf F.toList m , bench "each" $ nf itoList m ] , bgroup "itoList"- [ bench "native" $ nf (zip [(0::Int)..] . toList) m+ [ bench "native" $ nf (zip [(0::Int)..] . F.toList) m , bench "itraversed" $ nf (itoListOf itraversed) m ] ]@@ -93,7 +93,7 @@ , bench "itraversed" $ nf (itoListOf itraversed) h ] , bgroup "sum"- [ bench "native" $ nf (sum . id . toList) h+ [ bench "native" $ nf (sum . id . F.toList) h , bench "each" $ nf (sumOf each) h ] ]
benchmarks/traversals.hs view
@@ -1,7 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} import qualified Data.ByteString as BS import qualified Data.HashMap.Strict as HM@@ -16,6 +18,27 @@ import Control.Lens import Criterion.Main import Criterion.Types++#if !(MIN_VERSION_bytestring(0,10,0))+import Control.DeepSeq (NFData(..))+import qualified Data.ByteString.Internal as BS+#endif++#if !(MIN_VERSION_containers(0,5,0))+import qualified Data.Foldable as F+#endif++#if !(MIN_VERSION_bytestring(0,10,0))+instance NFData BS.ByteString where+ rnf (BS.PS _ _ _) = ()+#endif++#if !(MIN_VERSION_containers(0,5,0))+-- Sadly, containers doesn't export the constructor for Seq on older versions,+-- so we'll have to settle for this inefficient implementation of rnf.+instance NFData a => NFData (S.Seq a) where+ rnf = rnf . F.toList+#endif main :: IO () main = defaultMainWith config
lens.cabal view
@@ -1,7 +1,7 @@ name: lens category: Data, Lenses, Generics-version: 4.15.1-license: BSD3+version: 4.15.2+license: BSD2 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett@@ -12,7 +12,7 @@ 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+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.2 synopsis: Lenses, Folds and Traversals description: This package comes \"Batteries Included\" with many useful lenses for the types@@ -112,6 +112,13 @@ type: git location: https://github.com/ekmett/lens.git +custom-setup+ setup-depends:+ Cabal >= 1.10 && <2.1,+ base >= 4.5 && <5,+ cabal-doctest >= 1 && <1.1,+ filepath+ -- Enable benchmarking against Neil Mitchell's uniplate library for comparative performance analysis. Defaults to being turned off to avoid -- the extra dependency. --@@ -183,8 +190,8 @@ build-depends: array >= 0.3.0.2 && < 0.6, base >= 4.5 && < 5,- base-orphans >= 0.3 && < 1,- bifunctors >= 5 && < 6,+ base-orphans >= 0.5.2 && < 1,+ bifunctors >= 5.1 && < 6, bytestring >= 0.9.1.10 && < 0.11, comonad >= 4 && < 6, contravariant >= 1.3 && < 2,@@ -203,12 +210,12 @@ semigroupoids >= 5 && < 6, semigroups >= 0.8.4 && < 1, tagged >= 0.4.4 && < 1,- template-haskell >= 2.4 && < 2.12,+ template-haskell >= 2.4 && < 2.13, 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,+ vector >= 0.9 && < 0.13, void >= 0.5 && < 1 if impl(ghc < 8.0)@@ -403,7 +410,7 @@ containers, directory >= 1.0, deepseq,- doctest >= 0.9.1,+ doctest >= 0.11.1 && <0.12, filepath, generic-deriving, mtl,@@ -426,7 +433,8 @@ else build-depends: base,- hlint >= 1.9.27+ -- Bounds are in place due to https://github.com/ekmett/lens/issues/723+ hlint >= 1.9.27 && < 2 || >= 2.0.1 -- Basic benchmarks for the uniplate-style combinators benchmark plated@@ -486,6 +494,7 @@ base, criterion, containers,+ deepseq, bytestring, unordered-containers, vector,
src/Control/Exception/Lens.hs view
@@ -53,6 +53,7 @@ , trying, trying_ -- * Throwing , throwing+ , throwing_ , throwingM , throwingTo -- * Mapping@@ -161,6 +162,21 @@ #if __GLASGOW_HASKELL__ >= 710 , pattern ErrorCall_ #endif+#if MIN_VERSION_base(4,8,0)+ -- ** Allocation Limit Exceeded+ , AsAllocationLimitExceeded(..)+ , pattern AllocationLimitExceeded_+#endif+#if MIN_VERSION_base(4,9,0)+ -- ** Type Error+ , AsTypeError(..)+ , pattern TypeError_+#endif+#if MIN_VERSION_base(4,10,0)+ -- ** Compaction Failed+ , AsCompactionFailed(..)+ , pattern CompactionFailed_+#endif -- * Handling Exceptions , AsHandlingException(..) #if __GLASGOW_HASKELL__ >= 710@@ -348,6 +364,18 @@ throwing l = reviews l Exception.throw {-# INLINE throwing #-} +-- | Similar to 'throwing' but specialised for the common case of+-- error constructors with no arguments.+--+-- @+-- data MyError = Foo | Bar+-- makePrisms ''MyError+-- 'throwing_' _Foo :: 'MonadError' MyError m => m a+-- @+throwing_ :: AReview SomeException () -> m x+throwing_ l = throwing l ()+{-# 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'.@@ -1122,6 +1150,90 @@ #if __GLASGOW_HASKELL__ >= 710 pattern ErrorCall_ e <- (preview _ErrorCall -> Just e) where ErrorCall_ e = review _ErrorCall e+#endif++#if MIN_VERSION_base(4,8,0)+----------------------------------------------------------------------------+-- AllocationLimitExceeded+----------------------------------------------------------------------------++-- | This thread has exceeded its allocation limit.+class AsAllocationLimitExceeded t where+ -- | There is no additional information carried in an+ -- 'AllocationLimitExceeded' 'Exception'.+ --+ -- @+ -- '_AllocationLimitExceeded' :: 'Prism'' 'AllocationLimitExceeded' ()+ -- '_AllocationLimitExceeded' :: 'Prism'' 'SomeException' ()+ -- @+ _AllocationLimitExceeded :: Prism' t ()++instance AsAllocationLimitExceeded AllocationLimitExceeded where+ _AllocationLimitExceeded = trivial AllocationLimitExceeded+ {-# INLINE _AllocationLimitExceeded #-}++instance AsAllocationLimitExceeded SomeException where+ _AllocationLimitExceeded = exception.trivial AllocationLimitExceeded+ {-# INLINE _AllocationLimitExceeded #-}++pattern AllocationLimitExceeded_ <- (has _AllocationLimitExceeded -> True) where+ AllocationLimitExceeded_ = review _AllocationLimitExceeded ()+#endif++#if MIN_VERSION_base(4,9,0)+----------------------------------------------------------------------------+-- TypeError+----------------------------------------------------------------------------++-- | An expression that didn't typecheck during compile time was called.+-- This is only possible with @-fdefer-type-errors@.+class AsTypeError t where+ -- | Details about the failed type check.+ --+ -- @+ -- '_TypeError' :: 'Prism'' 'TypeError' ()+ -- '_TypeError' :: 'Prism'' 'SomeException' ()+ -- @+ _TypeError :: Prism' t String++instance AsTypeError TypeError where+ _TypeError = _Wrapping TypeError+ {-# INLINE _TypeError #-}++instance AsTypeError SomeException where+ _TypeError = exception._Wrapping TypeError+ {-# INLINE _TypeError #-}++pattern TypeError_ e <- (preview _TypeError -> Just e) where+ TypeError_ e = review _TypeError e+#endif++#if MIN_VERSION_base(4,10,0)+----------------------------------------------------------------------------+-- CompactionFailed+----------------------------------------------------------------------------++-- | Compaction found an object that cannot be compacted.+-- Functions cannot be compacted, nor can mutable objects or pinned objects.+class AsCompactionFailed t where+ -- | Information about why a compaction failed.+ --+ -- @+ -- '_CompactionFailed' :: 'Prism'' 'CompactionFailed' ()+ -- '_CompactionFailed' :: 'Prism'' 'SomeException' ()+ -- @+ _CompactionFailed :: Prism' t String++instance AsCompactionFailed CompactionFailed where+ _CompactionFailed = _Wrapping CompactionFailed+ {-# INLINE _CompactionFailed #-}++instance AsCompactionFailed SomeException where+ _CompactionFailed = exception._Wrapping CompactionFailed+ {-# INLINE _CompactionFailed #-}++pattern CompactionFailed_ e <- (preview _CompactionFailed -> Just e) where+ CompactionFailed_ e = review _CompactionFailed e #endif ------------------------------------------------------------------------------
src/Control/Lens/Cons.hs view
@@ -30,7 +30,7 @@ , uncons , _head, _tail #if __GLASGOW_HASKELL__ >= 710- , pattern (:>)+ , pattern (:<) #endif -- * Snoc , Snoc(..)@@ -39,7 +39,7 @@ , unsnoc , _init, _last #if __GLASGOW_HASKELL__ >= 710- , pattern (:<)+ , pattern (:>) #endif ) where
src/Control/Lens/Empty.hs view
@@ -45,7 +45,7 @@ import Data.Maybe import Data.Monoid import Data.Profunctor.Unsafe-import Data.Sequence as Seq+import qualified Data.Sequence as Seq import Data.Set as Set import Data.Text as StrictT import Data.Text.Lazy as LazyT@@ -157,7 +157,7 @@ _Empty = nearly Storable.empty Storable.null {-# INLINE _Empty #-} -instance AsEmpty (Seq a) where+instance AsEmpty (Seq.Seq a) where _Empty = nearly Seq.empty Seq.null {-# INLINE _Empty #-}
src/Control/Lens/Fold.hs view
@@ -77,7 +77,7 @@ -- ** Folding , foldMapOf, foldOf , foldrOf, foldlOf- , toListOf+ , toListOf, toNonEmptyOf , anyOf, allOf, noneOf , andOf, orOf , productOf, sumOf@@ -88,8 +88,8 @@ , elemOf, notElemOf , lengthOf , nullOf, notNullOf- , firstOf, lastOf- , maximumOf, minimumOf+ , firstOf, first1Of, lastOf, last1Of+ , maximumOf, maximum1Of, minimumOf, minimum1Of , maximumByOf, minimumByOf , findOf , findMOf@@ -176,6 +176,9 @@ import Data.Traversable import Prelude hiding (foldr) +import qualified Data.Semigroup as Semi+import Data.List.NonEmpty (NonEmpty(..))+ -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens@@ -492,12 +495,14 @@ -- @ -- -- @--- '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' :: 'Getter' s a -> (a -> r) -> s -> r+-- 'foldMapOf' :: 'Monoid' r => 'Fold' s a -> (a -> r) -> s -> r+-- 'foldMapOf' :: 'Semigroup' r => 'Fold1' 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' :: 'Semigroup' r => 'Traversal1'' s a -> (a -> r) -> s -> r+-- 'foldMapOf' :: 'Monoid' r => 'Prism'' s a -> (a -> r) -> s -> r -- @ -- -- @@@ -599,6 +604,22 @@ toListOf l = foldrOf l (:) [] {-# INLINE toListOf #-} +-- | Extract a 'NonEmpty' of the targets of 'Fold1'.+--+-- >>> toNonEmptyOf both1 ("hello", "world")+-- "hello" :| ["world"]+--+-- @+-- 'toNonEmptyOf' :: 'Getter' s a -> s -> NonEmpty a+-- 'toNonEmptyOf' :: 'Fold1' s a -> s -> NonEmpty a+-- 'toNonEmptyOf' :: 'Lens'' s a -> s -> NonEmpty a+-- 'toNonEmptyOf' :: 'Iso'' s a -> s -> NonEmpty a+-- 'toNonEmptyOf' :: 'Traversal1'' s a -> s -> NonEmpty a+-- 'toNonEmptyOf' :: 'Prism'' s a -> s -> NonEmpty a+-- @+toNonEmptyOf :: Getting (NonEmptyDList a) s a -> s -> NonEmpty a+toNonEmptyOf l = flip getNonEmptyDList [] . foldMapOf l (NonEmptyDList #. (:|))+ -- | A convenient infix (flipped) version of 'toListOf'. -- -- >>> [[1,2],[3]]^..id@@ -1203,6 +1224,8 @@ -- and gives you back access to the outermost 'Just' constructor more quickly, but may have worse -- constant factors. --+-- Note: this could been named `headOf`.+-- -- >>> firstOf traverse [1..10] -- Just 1 --@@ -1223,6 +1246,32 @@ firstOf l = getLeftmost . foldMapOf l LLeaf {-# INLINE firstOf #-} +-- | Retrieve the 'Data.Semigroup.First' entry of a 'Fold1' or 'Traversal1' or the result from a 'Getter' or 'Lens'.+--+-- >>> first1Of traverse1 (1 :| [2..10])+-- 1+--+-- >>> first1Of both1 (1,2)+-- 1+--+-- /Note:/ this is different from '^.'.+--+-- >>> first1Of traverse1 ([1,2] :| [[3,4],[5,6]])+-- [1,2]+--+-- >>> ([1,2] :| [[3,4],[5,6]]) ^. traverse1+-- [1,2,3,4,5,6]+--+-- @+-- 'first1Of' :: 'Getter' s a -> s -> a+-- 'first1Of' :: 'Fold1' s a -> s -> a+-- 'first1Of' :: 'Lens'' s a -> s -> a+-- 'first1Of' :: 'Iso'' s a -> s -> a+-- 'first1Of' :: 'Traversal1'' s a -> s -> a+-- @+first1Of :: Getting (Semi.First a) s a -> s -> a+first1Of l = Semi.getFirst . foldMapOf l Semi.First+ -- | Retrieve the 'Last' entry of a 'Fold' or 'Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'. --@@ -1250,6 +1299,25 @@ lastOf l = getRightmost . foldMapOf l RLeaf {-# INLINE lastOf #-} +-- | Retrieve the 'Data.Semigroup.Last' entry of a 'Fold1' or 'Traversal1' or retrieve the result+-- from a 'Getter' or 'Lens'.o+--+-- >>> last1Of traverse1 (1 :| [2..10])+-- 10+--+-- >>> last1Of both1 (1,2)+-- 2+--+-- @+-- 'last1Of' :: 'Getter' s a -> s -> 'Maybe' a+-- 'last1Of' :: 'Fold1' s a -> s -> 'Maybe' a+-- 'last1Of' :: 'Lens'' s a -> s -> 'Maybe' a+-- 'last1Of' :: 'Iso'' s a -> s -> 'Maybe' a+-- 'last1Of' :: 'Traversal1'' s a -> s -> 'Maybe' a+-- @+last1Of :: Getting (Semi.Last a) s a -> s -> a+last1Of l = Semi.getLast . foldMapOf l Semi.Last+ -- | 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'.@@ -1359,6 +1427,22 @@ mf (Just x) y = Just $! max x y {-# INLINE maximumOf #-} +-- | Obtain the maximum element targeted by a 'Fold1' or 'Traversal1'.+--+-- >>> maximum1Of traverse1 (1 :| [2..10])+-- 10+--+-- @+-- 'maximum1Of' :: 'Ord' a => 'Getter' s a -> s -> a+-- 'maximum1Of' :: 'Ord' a => 'Fold1' s a -> s -> a+-- 'maximum1Of' :: 'Ord' a => 'Iso'' s a -> s -> a+-- 'maximum1Of' :: 'Ord' a => 'Lens'' s a -> s -> a+-- 'maximum1Of' :: 'Ord' a => 'Traversal1'' s a -> s -> a+-- @+maximum1Of :: Ord a => Getting (Semi.Max a) s a -> s -> a+maximum1Of l = Semi.getMax . foldMapOf l Semi.Max+{-# INLINE maximum1Of #-}+ -- | 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.@@ -1392,6 +1476,22 @@ mf Nothing y = Just $! y mf (Just x) y = Just $! min x y {-# INLINE minimumOf #-}++-- | Obtain the minimum element targeted by a 'Fold1' or 'Traversal1'.+--+-- >>> minimum1Of traverse1 (1 :| [2..10])+-- 1+--+-- @+-- 'minimum1Of' :: 'Ord' a => 'Getter' s a -> s -> a+-- 'minimum1Of' :: 'Ord' a => 'Fold1' s a -> s -> a+-- 'minimum1Of' :: 'Ord' a => 'Iso'' s a -> s -> a+-- 'minimum1Of' :: 'Ord' a => 'Lens'' s a -> s -> a+-- 'minimum1Of' :: 'Ord' a => 'Traversal1'' s a -> s -> a+-- @+minimum1Of :: Ord a => Getting (Semi.Min a) s a -> s -> a+minimum1Of l = Semi.getMin . foldMapOf l Semi.Min+{-# INLINE minimum1Of #-} -- | Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso', -- or 'Getter' according to a user supplied 'Ordering'.
src/Control/Lens/Getter.hs view
@@ -139,7 +139,7 @@ -- @ -- 'to' :: (s -> a) -> 'IndexPreservingGetter' s a -- @-to :: (Profunctor p, Contravariant f, Functor f) => (s -> a) -> Optic' p f s a+to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a to k = dimap k (contramap k) {-# INLINE to #-} @@ -147,7 +147,7 @@ -- @ -- 'ito' :: (s -> (i, a)) -> 'IndexedGetter' i s a -- @-ito :: (Indexable i p, Contravariant f, Functor f) => (s -> (i, a)) -> Over' p f 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 #-} @@ -502,8 +502,16 @@ s ^@. l = getConst $ l (Indexed $ \i -> Const #. (,) i) s {-# INLINE (^@.) #-} --- | Coerce a 'Getter'-compatible 'LensLike' to a 'LensLike''. This+-- | Coerce a 'Getter'-compatible 'Optical' to an 'Optical''. 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)+--+-- @+-- 'getting' :: 'Traversal' s t a b -> 'Fold' s a+-- 'getting' :: 'Lens' s t a b -> 'Getter' s a+-- 'getting' :: 'IndexedTraversal' i s t a b -> 'IndexedFold' i s a+-- 'getting' :: 'IndexedLens' i s t a b -> 'IndexedGetter' i s a+-- @+getting :: (Profunctor p, Profunctor q, Functor f, Contravariant f)+ => Optical p q f s t a b -> Optical' p q f s a+getting l f = rmap phantom . l $ rmap phantom f
src/Control/Lens/Indexed.hs view
@@ -505,7 +505,7 @@ -- @ 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)+ default itraverse :: (i ~ Int, Applicative f) => (i -> a -> f b) -> t a -> f (t b) itraverse = traversed .# Indexed {-# INLINE itraverse #-} #endif
src/Control/Lens/Internal/Context.hs view
@@ -133,7 +133,7 @@ ------------------------------------------------------------------------------ -- | The indexed store can be used to characterize a 'Control.Lens.Lens.Lens'--- and is used by 'Control.Lens.Lens.clone'.+-- and is used by 'Control.Lens.Lens.cloneLens'. -- -- @'Context' a b t@ is isomorphic to -- @newtype 'Context' a b t = 'Context' { runContext :: forall f. 'Functor' f => (a -> f b) -> f t }@,
src/Control/Lens/Internal/Fold.hs view
@@ -27,6 +27,8 @@ , Leftmost(..), getLeftmost , Rightmost(..), getRightmost , ReifiedMonoid(..)+ -- * Semigroups for folding+ , NonEmptyDList(..) ) where import Control.Applicative@@ -38,6 +40,8 @@ import Data.Reflection import Prelude +import qualified Data.List.NonEmpty as NonEmpty+ #ifdef HLINT {-# ANN module "HLint: ignore Avoid lambda" #-} #endif@@ -150,6 +154,16 @@ getMax NoMax = Nothing getMax (Max a) = Just a {-# INLINE getMax #-}++------------------------------------------------------------------------------+-- NonEmptyDList+------------------------------------------------------------------------------++newtype NonEmptyDList a+ = NonEmptyDList { getNonEmptyDList :: [a] -> NonEmpty.NonEmpty a }++instance Semigroup (NonEmptyDList a) where+ NonEmptyDList f <> NonEmptyDList g = NonEmptyDList (f . NonEmpty.toList . g) ------------------------------------------------------------------------------ -- Leftmost and Rightmost
src/Control/Lens/Internal/Indexed.hs view
@@ -61,6 +61,11 @@ import Control.Lens.Internal.Coerce #endif +-- $setup+-- >>> :set -XNoOverloadedStrings+-- >>> import Control.Lens+-- >>> import Numeric.Lens+-- ------------------------------------------------------------------------------ -- Conjoined ------------------------------------------------------------------------------@@ -347,6 +352,13 @@ -- -- 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.+--+-- >>> [10, 20, 30] ^.. ifolded . withIndex+-- [(0,10),(1,20),(2,30)]+--+-- >>> [10, 20, 30] ^.. ifolded . withIndex . alongside negated (re _Show)+-- [(0,"10"),(-1,"20"),(-2,"30")]+-- 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 #-}
src/Control/Lens/Internal/PrismTH.hs view
@@ -319,7 +319,7 @@ -- (\(x,y,z) -> Con x y z) :: b -> t makeReviewer :: Name -> Int -> ExpQ makeReviewer conName fields =- do xs <- replicateM fields (newName "x")+ do xs <- newNames "x" fields lam1E (toTupleP (map varP xs)) (conE conName `appsE1` map varE xs)
src/Control/Lens/Internal/TH.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} #ifdef TRUSTWORTHY+# if MIN_VERSION_template_haskell(2,12,0)+{-# LANGUAGE Safe #-}+# else {-# LANGUAGE Trustworthy #-}+# endif #endif #ifdef HLINT
src/Control/Lens/Iso.hs view
@@ -604,10 +604,11 @@ -- -- @since 4.13 coerced :: forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b-#if __GLASGOW_HASKELL__ >= 710+# if __GLASGOW_HASKELL__ >= 710 coerced l = rmap (fmap coerce') l .# coerce-#else+# else coerced l = case sym Coercion :: Coercion a s of Coercion -> rmap (fmap coerce') l .# coerce-#endif+# endif+{-# INLINE coerced #-} #endif
src/Control/Lens/Level.hs view
@@ -29,6 +29,7 @@ import Control.Lens.Internal.Indexed import Control.Lens.Internal.Level import Control.Lens.Traversal+import Control.Lens.Type import Data.Profunctor.Unsafe -- $setup@@ -36,20 +37,21 @@ -- >>> import Control.Lens -- >>> import Data.Char -levelIns :: Bazaar (->) a b t -> [Level () a]+levelIns :: BazaarT (->) f 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+levelOuts :: BazaarT (->) f a b t -> [Level j b] -> t+levelOuts bz = runFlows $ runBazaarT 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 provides a breadth-first 'Traversal' or 'Fold' of the individual+-- 'levels' of any other 'Traversal' or 'Fold' 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: --@@ -77,9 +79,16 @@ -- >>> ["dog","cat"]^@..levels (traverse.traverse) <. traverse -- [(2,'d'),(3,'o'),(3,'c'),(4,'g'),(4,'a'),(5,'t')] --+-- @+-- 'levels' :: 'Traversal' s t a b -> 'IndexedTraversal' 'Int' s t ('Level' () a) ('Level' () b)+-- 'levels' :: 'Fold' s a -> 'IndexedFold' 'Int' s ('Level' () a)+-- @+-- -- /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 :: Applicative f+ => Traversing (->) f s t a b+ -> IndexedLensLike Int f s t (Level () a) (Level () b) levels l f s = levelOuts bz <$> traversed f (levelIns bz) where bz = l sell s {-# INLINE levels #-}@@ -90,20 +99,21 @@ rmapConst p = Const #. p {-# INLINE rmapConst #-} -ilevelIns :: Bazaar (Indexed i) a b t -> [Level i a]+ilevelIns :: BazaarT (Indexed i) f 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+ilevelOuts :: BazaarT (Indexed i) f a b t -> [Level j b] -> t+ilevelOuts bz = runFlows $ runBazaarT 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 provides a breadth-first 'Traversal' or 'Fold' of the individual+-- levels of any other 'Traversal' or 'Fold' 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.@@ -116,9 +126,16 @@ -- >>> ["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')] --+-- @+-- 'ilevels' :: 'IndexedTraversal' i s t a b -> 'IndexedTraversal' 'Int' s t ('Level' i a) ('Level' i b)+-- 'ilevels' :: 'IndexedFold' i s a -> 'IndexedFold' 'Int' s ('Level' i a)+-- @+-- -- /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 :: Applicative f+ => Traversing (Indexed i) f s t a b+ -> IndexedLensLike Int f 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 #-}
src/Control/Lens/Review.hs view
@@ -4,6 +4,10 @@ #if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif++#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+#endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Review
src/Control/Lens/TH.hs view
@@ -28,6 +28,7 @@ makeLenses, makeLensesFor , makeClassy, makeClassyFor, makeClassy_ , makeFields+ , makeFieldsNoPrefix -- ** Prisms , makePrisms , makeClassyPrisms@@ -55,6 +56,7 @@ , classyRules_ , defaultFieldRules , camelCaseFields+ , classUnderscoreNoPrefixFields , underscoreFields , abbreviatedFields -- ** LensRules configuration accessors@@ -73,6 +75,7 @@ , lookingupNamer , mappingNamer , camelCaseNamer+ , classUnderscoreNoPrefixNamer , underscoreNamer , abbreviatedNamer ) where@@ -96,7 +99,7 @@ import Control.Lens.Internal.PrismTH import Control.Lens.Wrapped () -- haddocks import Control.Lens.Type () -- haddocks-import Data.Char (toLower, isUpper)+import Data.Char (toLower, toUpper, isUpper) import Data.Foldable hiding (concat, any) import Data.List as List import qualified Data.Map as Map@@ -688,7 +691,25 @@ computeMethod (x:xs) | isUpper x = Just (toLower x : xs) computeMethod _ = Nothing +-- | Field rules for fields in the form @ _fieldname @ (the leading+-- underscore is mandatory).+--+-- __Note__: The primary difference to 'camelCaseFields' is that for+-- @classUnderscoreNoPrefixFields@ the field names are not expected to+-- be prefixed with the type name. This might be the desired behaviour+-- when the @DuplicateRecordFields@ extension is enabled.+classUnderscoreNoPrefixFields :: LensRules+classUnderscoreNoPrefixFields =+ defaultFieldRules & lensField .~ classUnderscoreNoPrefixNamer +-- | A 'FieldNamer' for 'classUnderscoreNoPrefixFields'.+classUnderscoreNoPrefixNamer :: FieldNamer+classUnderscoreNoPrefixNamer _ _ field = maybeToList $ do+ fieldUnprefixed <- stripPrefix "_" (nameBase field)+ let className = "Has" ++ overHead toUpper fieldUnprefixed+ methodName = fieldUnprefixed+ return (MethodName (mkName className) (mkName methodName))+ -- | 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.@@ -725,7 +746,7 @@ -- /e.g/ -- -- @--- data Foo a = Foo { _fooX :: 'Int', _fooY : a }+-- data Foo a = Foo { _fooX :: 'Int', _fooY :: a } -- newtype Bar = Bar { _barX :: 'Char' } -- makeFields ''Foo -- makeFields ''Bar@@ -756,6 +777,48 @@ -- @ makeFields :: Name -> DecsQ makeFields = makeFieldOptics camelCaseFields++-- | Generate overloaded field accessors based on field names which+-- are only prefixed with an underscore (e.g. '_name'), not+-- additionally with the type name (e.g. '_fooName').+--+-- This might be the desired behaviour in case the+-- @DuplicateRecordFields@ language extension is used in order to get+-- rid of the necessity to prefix each field name with the type name.+--+-- As an example:+--+-- @+-- data Foo a = Foo { _x :: 'Int', _y :: a }+-- newtype Bar = Bar { _x :: 'Char' }+-- makeFieldsNoPrefix ''Foo+-- makeFieldsNoPrefix ''Bar+-- @+--+-- will create classes+--+-- @+-- class HasX s a | s -> a where+-- x :: Lens' s a+-- class HasY s a | s -> a where+-- y :: Lens' s a+-- @+--+-- together with instances+--+-- @+-- instance HasX (Foo a) Int+-- instance HasY (Foo a) a where+-- instance HasX Bar Char where+-- @+--+-- For details, see 'classUnderscoreNoPrefixFields'.+--+-- @+-- makeFieldsNoPrefix = 'makeLensesWith' 'classUnderscoreNoPrefixFields'+-- @+makeFieldsNoPrefix :: Name -> DecsQ+makeFieldsNoPrefix = makeFieldOptics classUnderscoreNoPrefixFields defaultFieldRules :: LensRules defaultFieldRules = LensRules
src/Control/Lens/Traversal.hs view
@@ -80,7 +80,7 @@ -- * Common Traversals , Traversable(traverse) , Traversable1(traverse1)- , both+ , both, both1 , beside , taking , dropping@@ -163,6 +163,7 @@ import Data.Profunctor.Unsafe import Data.Reflection import Data.Semigroup.Traversable+import Data.Semigroup.Bitraversable import Data.Tagged import Data.Traversable import Data.Tuple (swap)@@ -271,9 +272,10 @@ -- @ -- -- @--- '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' :: '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' :: 'Apply' f => 'Traversal1' 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@@ -753,6 +755,18 @@ both f = bitraverse f f {-# INLINE both #-} +-- | Traverse both parts of a 'Bitraversable1' container with matching types.+--+-- Usually that type will be a pair.+--+-- @+-- 'both1' :: 'Traversal1' (a, a) (b, b) a b+-- 'both1' :: 'Traversal1' ('Either' a a) ('Either' b b) a b+-- @+both1 :: Bitraversable1 r => Traversal1 (r a a) (r b b) a b+both1 f = bitraverse1 f f+{-# INLINE both1 #-}+ -- | Apply a different 'Traversal' or 'Fold' to each side of a 'Bitraversable' container. -- -- @@@ -1256,11 +1270,7 @@ -- '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+deepOf r l = failing l (r . deepOf r l) -- | "Fuse" a 'Traversal' by reassociating all of the '\<*\>' operations to the -- left and fusing all of the 'fmap' calls into one. This is particularly
src/Control/Lens/Tuple.hs view
@@ -38,19 +38,32 @@ , Field7(..) , Field8(..) , Field9(..)+ , Field10(..)+ , Field11(..)+ , Field12(..)+ , Field13(..)+ , Field14(..)+ , Field15(..)+ , Field16(..)+ , Field17(..)+ , Field18(..)+ , Field19(..) -- * Strict variations , _1', _2', _3', _4', _5', _6', _7', _8', _9'+ , _10', _11', _12', _13', _14', _15', _16'+ , _17', _18', _19' ) 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 (..))+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+import Control.Applicative #endif -- $setup@@ -136,6 +149,46 @@ _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 #-} +instance Field1 (a,b,c,d,e,f,g,h,i,j) (a',b,c,d,e,f,g,h,i,j) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk) (a',b,c,d,e,f,g,h,i,j,kk) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk,l) (a',b,c,d,e,f,g,h,i,j,kk,l) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk,l)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a',b,c,d,e,f,g,h,i,j,kk,l,m) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk,l,m)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a',b,c,d,e,f,g,h,i,j,kk,l,m,n) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk,l,m,n)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r)+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k a <&> \a' -> (a',b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s)+ {-# 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.@@ -202,6 +255,47 @@ _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 #-} +instance Field2 (a,b,c,d,e,f,g,h,i,j) (a,b',c,d,e,f,g,h,i,j) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk) (a,b',c,d,e,f,g,h,i,j,kk) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b',c,d,e,f,g,h,i,j,kk,l) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk,l)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b',c,d,e,f,g,h,i,j,kk,l,m) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk,l,m)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b',c,d,e,f,g,h,i,j,kk,l,m,n) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk,l,m,n)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o,p) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o,p)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r)+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k b <&> \b' -> (a,b',c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s)+ {-# 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.@@ -239,6 +333,46 @@ _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 #-} +instance Field3 (a,b,c,d,e,f,g,h,i,j) (a,b,c',d,e,f,g,h,i,j) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c',d,e,f,g,h,i,j,kk) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c',d,e,f,g,h,i,j,kk,l) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk,l)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c',d,e,f,g,h,i,j,kk,l,m) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk,l,m)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c',d,e,f,g,h,i,j,kk,l,m,n) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk,l,m,n)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o,p) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o,p)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o,p,q) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o,p,q)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r)+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k c <&> \c' -> (a,b,c',d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s)+ {-# 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.@@ -272,6 +406,46 @@ _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 #-} +instance Field4 (a,b,c,d,e,f,g,h,i,j) (a,b,c,d',e,f,g,h,i,j) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c,d',e,f,g,h,i,j,kk) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d',e,f,g,h,i,j,kk,l) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk,l)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d',e,f,g,h,i,j,kk,l,m) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk,l,m)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d',e,f,g,h,i,j,kk,l,m,n) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk,l,m,n)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o,p) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o,p)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o,p,q) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o,p,q)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o,p,q,r) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o,p,q,r)+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k d <&> \d' -> (a,b,c,d',e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s)+ {-# 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.@@ -301,6 +475,46 @@ _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 #-} +instance Field5 (a,b,c,d,e,f,g,h,i,j) (a,b,c,d,e',f,g,h,i,j) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c,d,e',f,g,h,i,j,kk) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d,e',f,g,h,i,j,kk,l) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk,l)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e',f,g,h,i,j,kk,l,m) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk,l,m)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e',f,g,h,i,j,kk,l,m,n) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk,l,m,n)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o,p) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o,p)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o,p,q) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o,p,q)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o,p,q,r) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o,p,q,r)+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o,p,q,r,s) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k e <&> \e' -> (a,b,c,d,e',f,g,h,i,j,kk,l,m,n,o,p,q,r,s)+ {-# 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.@@ -326,6 +540,46 @@ _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 #-} +instance Field6 (a,b,c,d,e,f,g,h,i,j) (a,b,c,d,e,f',g,h,i,j) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c,d,e,f',g,h,i,j,kk) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d,e,f',g,h,i,j,kk,l) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk,l)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e,f',g,h,i,j,kk,l,m) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk,l,m)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f',g,h,i,j,kk,l,m,n) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk,l,m,n)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o,p) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o,p)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o,p,q) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o,p,q)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o,p,q,r) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o,p,q,r)+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o,p,q,r,s) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k f <&> \f' -> (a,b,c,d,e,f',g,h,i,j,kk,l,m,n,o,p,q,r,s)+ {-# 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.@@ -347,6 +601,46 @@ _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 #-} +instance Field7 (a,b,c,d,e,f,g,h,i,j) (a,b,c,d,e,f,g',h,i,j) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c,d,e,f,g',h,i,j,kk) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d,e,f,g',h,i,j,kk,l) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk,l)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e,f,g',h,i,j,kk,l,m) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk,l,m)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f,g',h,i,j,kk,l,m,n) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk,l,m,n)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o,p) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o,p)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o,p,q) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o,p,q)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o,p,q,r) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o,p,q,r)+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o,p,q,r,s) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k g <&> \g' -> (a,b,c,d,e,f,g',h,i,j,kk,l,m,n,o,p,q,r,s)+ {-# 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.@@ -364,6 +658,46 @@ _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 #-} +instance Field8 (a,b,c,d,e,f,g,h,i,j) (a,b,c,d,e,f,g,h',i,j) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c,d,e,f,g,h',i,j,kk) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d,e,f,g,h',i,j,kk,l) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk,l)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e,f,g,h',i,j,kk,l,m) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk,l,m)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f,g,h',i,j,kk,l,m,n) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk,l,m,n)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o,p) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o,p)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o,p,q) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o,p,q)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o,p,q,r) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o,p,q,r)+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o,p,q,r,s) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k h <&> \h' -> (a,b,c,d,e,f,g,h',i,j,kk,l,m,n,o,p,q,r,s)+ {-# 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.@@ -377,8 +711,358 @@ _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+instance Field9 (a,b,c,d,e,f,g,h,i,j) (a,b,c,d,e,f,g,h,i',j) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j)+ {-# INLINE _9 #-} +instance Field9 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c,d,e,f,g,h,i',j,kk) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk)+ {-# INLINE _9 #-}++instance Field9 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d,e,f,g,h,i',j,kk,l) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk,l)+ {-# INLINE _9 #-}++instance Field9 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e,f,g,h,i',j,kk,l,m) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk,l,m)+ {-# INLINE _9 #-}++instance Field9 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f,g,h,i',j,kk,l,m,n) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk,l,m,n)+ {-# INLINE _9 #-}++instance Field9 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o)+ {-# INLINE _9 #-}++instance Field9 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o,p) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o,p)+ {-# INLINE _9 #-}++instance Field9 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o,p,q) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o,p,q)+ {-# INLINE _9 #-}++instance Field9 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o,p,q,r) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o,p,q,r)+ {-# INLINE _9 #-}++instance Field9 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o,p,q,r,s) i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k i <&> \i' -> (a,b,c,d,e,f,g,h,i',j,kk,l,m,n,o,p,q,r,s)+ {-# INLINE _9 #-}++-- | Provides access to the 10th field of a tuple.+class Field10 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 10th field of a tuple.+ _10 :: Lens s t a b+ default _10 :: (Generic s, Generic t, GIxed N9 (Rep s) (Rep t) a b)+ => Lens s t a b+ _10 = ix proxyN9+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j) (a,b,c,d,e,f,g,h,i,j') j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j')+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c,d,e,f,g,h,i,j',kk) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk)+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d,e,f,g,h,i,j',kk,l) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk,l)+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e,f,g,h,i,j',kk,l,m) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk,l,m)+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f,g,h,i,j',kk,l,m,n) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk,l,m,n)+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o)+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o,p) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o,p)+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o,p,q) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o,p,q)+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o,p,q,r) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o,p,q,r)+ {-# INLINE _10 #-}++instance Field10 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o,p,q,r,s) j j' where+ _10 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k j <&> \j' -> (a,b,c,d,e,f,g,h,i,j',kk,l,m,n,o,p,q,r,s)+ {-# INLINE _10 #-}++-- | Provides access to the 11th field of a tuple.+class Field11 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 11th field of a tuple.+ _11 :: Lens s t a b+ default _11 :: (Generic s, Generic t, GIxed N10 (Rep s) (Rep t) a b)+ => Lens s t a b+ _11 = ix proxyN10+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk) (a,b,c,d,e,f,g,h,i,j,kk') kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk')+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d,e,f,g,h,i,j,kk',l) kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk',l)+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e,f,g,h,i,j,kk',l,m) kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk',l,m)+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f,g,h,i,j,kk',l,m,n) kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk',l,m,n)+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o) kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o)+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o,p) kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o,p)+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o,p,q) kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o,p,q)+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o,p,q,r) kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o,p,q,r)+ {-# INLINE _11 #-}++instance Field11 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o,p,q,r,s) kk kk' where+ _11 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k kk <&> \kk' -> (a,b,c,d,e,f,g,h,i,j,kk',l,m,n,o,p,q,r,s)+ {-# INLINE _11 #-}++-- | Provides access to the 12th field of a tuple.+class Field12 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 12th field of a tuple.+ _12 :: Lens s t a b+ default _12 :: (Generic s, Generic t, GIxed N11 (Rep s) (Rep t) a b)+ => Lens s t a b+ _12 = ix proxyN11+ {-# INLINE _12 #-}++instance Field12 (a,b,c,d,e,f,g,h,i,j,kk,l) (a,b,c,d,e,f,g,h,i,j,kk,l') l l' where+ _12 k ~(a,b,c,d,e,f,g,h,i,j,kk,l) = k l <&> \l' -> (a,b,c,d,e,f,g,h,i,j,kk,l')+ {-# INLINE _12 #-}++instance Field12 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e,f,g,h,i,j,kk,l',m) l l' where+ _12 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k l <&> \l' -> (a,b,c,d,e,f,g,h,i,j,kk,l',m)+ {-# INLINE _12 #-}++instance Field12 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f,g,h,i,j,kk,l',m,n) l l' where+ _12 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k l <&> \l' -> (a,b,c,d,e,f,g,h,i,j,kk,l',m,n)+ {-# INLINE _12 #-}++instance Field12 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o) l l' where+ _12 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k l <&> \l' -> (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o)+ {-# INLINE _12 #-}++instance Field12 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o,p) l l' where+ _12 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k l <&> \l' -> (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o,p)+ {-# INLINE _12 #-}++instance Field12 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o,p,q) l l' where+ _12 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k l <&> \l' -> (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o,p,q)+ {-# INLINE _12 #-}++instance Field12 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o,p,q,r) l l' where+ _12 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k l <&> \l' -> (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o,p,q,r)+ {-# INLINE _12 #-}++instance Field12 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o,p,q,r,s) l l' where+ _12 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k l <&> \l' -> (a,b,c,d,e,f,g,h,i,j,kk,l',m,n,o,p,q,r,s)+ {-# INLINE _12 #-}++-- | Provides access to the 13th field of a tuple.+class Field13 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 13th field of a tuple.+ _13 :: Lens s t a b+ default _13 :: (Generic s, Generic t, GIxed N12 (Rep s) (Rep t) a b)+ => Lens s t a b+ _13 = ix proxyN12+ {-# INLINE _13 #-}++instance Field13 (a,b,c,d,e,f,g,h,i,j,kk,l,m) (a,b,c,d,e,f,g,h,i,j,kk,l,m') m m' where+ _13 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m) = k m <&> \m' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m')+ {-# INLINE _13 #-}++instance Field13 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f,g,h,i,j,kk,l,m',n) m m' where+ _13 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k m <&> \m' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m',n)+ {-# INLINE _13 #-}++instance Field13 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o) m m' where+ _13 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k m <&> \m' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o)+ {-# INLINE _13 #-}++instance Field13 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o,p) m m' where+ _13 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k m <&> \m' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o,p)+ {-# INLINE _13 #-}++instance Field13 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o,p,q) m m' where+ _13 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k m <&> \m' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o,p,q)+ {-# INLINE _13 #-}++instance Field13 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o,p,q,r) m m' where+ _13 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k m <&> \m' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o,p,q,r)+ {-# INLINE _13 #-}++instance Field13 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o,p,q,r,s) m m' where+ _13 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k m <&> \m' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m',n,o,p,q,r,s)+ {-# INLINE _13 #-}++-- | Provides access to the 14th field of a tuple.+class Field14 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 14th field of a tuple.+ _14 :: Lens s t a b+ default _14 :: (Generic s, Generic t, GIxed N13 (Rep s) (Rep t) a b)+ => Lens s t a b+ _14 = ix proxyN13+ {-# INLINE _14 #-}++instance Field14 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n') n n' where+ _14 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n) = k n <&> \n' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n')+ {-# INLINE _14 #-}++instance Field14 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o) n n' where+ _14 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k n <&> \n' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o)+ {-# INLINE _14 #-}++instance Field14 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o,p) n n' where+ _14 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k n <&> \n' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o,p)+ {-# INLINE _14 #-}++instance Field14 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o,p,q) n n' where+ _14 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k n <&> \n' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o,p,q)+ {-# INLINE _14 #-}++instance Field14 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o,p,q,r) n n' where+ _14 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k n <&> \n' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o,p,q,r)+ {-# INLINE _14 #-}++instance Field14 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o,p,q,r,s) n n' where+ _14 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k n <&> \n' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n',o,p,q,r,s)+ {-# INLINE _14 #-}++-- | Provides access to the 15th field of a tuple.+class Field15 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 15th field of a tuple.+ _15 :: Lens s t a b+ default _15 :: (Generic s, Generic t, GIxed N14 (Rep s) (Rep t) a b)+ => Lens s t a b+ _15 = ix proxyN14+ {-# INLINE _15 #-}++instance Field15 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o') o o' where+ _15 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o) = k o <&> \o' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o')+ {-# INLINE _15 #-}++instance Field15 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o',p) o o' where+ _15 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k o <&> \o' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o',p)+ {-# INLINE _15 #-}++instance Field15 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o',p,q) o o' where+ _15 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k o <&> \o' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o',p,q)+ {-# INLINE _15 #-}++instance Field15 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o',p,q,r) o o' where+ _15 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k o <&> \o' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o',p,q,r)+ {-# INLINE _15 #-}++instance Field15 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o',p,q,r,s) o o' where+ _15 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k o <&> \o' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o',p,q,r,s)+ {-# INLINE _15 #-}++-- | Provides access to the 16th field of a tuple.+class Field16 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 16th field of a tuple.+ _16 :: Lens s t a b+ default _16 :: (Generic s, Generic t, GIxed N15 (Rep s) (Rep t) a b)+ => Lens s t a b+ _16 = ix proxyN15+ {-# INLINE _16 #-}++instance Field16 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p') p p' where+ _16 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p) = k p <&> \p' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p')+ {-# INLINE _16 #-}++instance Field16 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p',q) p p' where+ _16 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k p <&> \p' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p',q)+ {-# INLINE _16 #-}++instance Field16 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p',q,r) p p' where+ _16 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k p <&> \p' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p',q,r)+ {-# INLINE _16 #-}++instance Field16 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p',q,r,s) p p' where+ _16 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k p <&> \p' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p',q,r,s)+ {-# INLINE _16 #-}++-- | Provides access to the 17th field of a tuple.+class Field17 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 17th field of a tuple.+ _17 :: Lens s t a b+ default _17 :: (Generic s, Generic t, GIxed N16 (Rep s) (Rep t) a b)+ => Lens s t a b+ _17 = ix proxyN16+ {-# INLINE _17 #-}++instance Field17 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q') q q' where+ _17 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q) = k q <&> \q' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q')+ {-# INLINE _17 #-}++instance Field17 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q',r) q q' where+ _17 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k q <&> \q' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q',r)+ {-# INLINE _17 #-}++instance Field17 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q',r,s) q q' where+ _17 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k q <&> \q' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q',r,s)+ {-# INLINE _17 #-}++-- | Provides access to the 18th field of a tuple.+class Field18 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 18th field of a tuple.+ _18 :: Lens s t a b+ default _18 :: (Generic s, Generic t, GIxed N17 (Rep s) (Rep t) a b)+ => Lens s t a b+ _18 = ix proxyN17+ {-# INLINE _18 #-}++instance Field18 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r') r r' where+ _18 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r) = k r <&> \r' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r')+ {-# INLINE _18 #-}++instance Field18 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r',s) r r' where+ _18 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k r <&> \r' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r',s)+ {-# INLINE _18 #-}++-- | Provides access to the 19th field of a tuple.+class Field19 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ -- | Access the 19th field of a tuple.+ _19 :: Lens s t a b+ default _19 :: (Generic s, Generic t, GIxed N18 (Rep s) (Rep t) a b)+ => Lens s t a b+ _19 = ix proxyN18+ {-# INLINE _19 #-}++instance Field19 (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s') s s' where+ _19 k ~(a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s) = k s <&> \s' -> (a,b,c,d,e,f,g,h,i,j,kk,l,m,n,o,p,q,r,s')+ {-# INLINE _19 #-}++-- Strict versions of the _1 .. _19 operations+ -- | Strict version of '_1' _1' :: Field1 s t a b => Lens s t a b _1' = \f !x -> _1 f x@@ -424,7 +1108,57 @@ _9' = \f !x -> _9 f x {-# INLINE _9' #-} +-- | Strict version of '_10'+_10' :: Field10 s t a b => Lens s t a b+_10' = \f !x -> _10 f x+{-# INLINE _10' #-} +-- | Strict version of '_11'+_11' :: Field11 s t a b => Lens s t a b+_11' = \f !x -> _11 f x+{-# INLINE _11' #-}++-- | Strict version of '_12'+_12' :: Field12 s t a b => Lens s t a b+_12' = \f !x -> _12 f x+{-# INLINE _12' #-}++-- | Strict version of '_13'+_13' :: Field13 s t a b => Lens s t a b+_13' = \f !x -> _13 f x+{-# INLINE _13' #-}++-- | Strict version of '_14'+_14' :: Field14 s t a b => Lens s t a b+_14' = \f !x -> _14 f x+{-# INLINE _14' #-}++-- | Strict version of '_15'+_15' :: Field15 s t a b => Lens s t a b+_15' = \f !x -> _15 f x+{-# INLINE _15' #-}++-- | Strict version of '_16'+_16' :: Field16 s t a b => Lens s t a b+_16' = \f !x -> _16 f x+{-# INLINE _16' #-}++-- | Strict version of '_17'+_17' :: Field17 s t a b => Lens s t a b+_17' = \f !x -> _17 f x+{-# INLINE _17' #-}++-- | Strict version of '_18'+_18' :: Field18 s t a b => Lens s t a b+_18' = \f !x -> _18 f x+{-# INLINE _18' #-}++-- | Strict version of '_19'+_19' :: Field19 s t a b => Lens s t a b+_19' = \f !x -> _19 f x+{-# INLINE _19' #-}++ 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 #-}@@ -512,6 +1246,16 @@ type N6 = S N5 type N7 = S N6 type N8 = S N7+type N9 = S N8+type N10 = S N9+type N11 = S N10+type N12 = S N11+type N13 = S N12+type N14 = S N13+type N15 = S N14+type N16 = S N15+type N17 = S N16+type N18 = S N17 proxyN0 :: Proxy N0 proxyN0 = Proxy@@ -548,3 +1292,43 @@ proxyN8 :: Proxy N8 proxyN8 = Proxy {-# INLINE proxyN8 #-}++proxyN9 :: Proxy N9+proxyN9 = Proxy+{-# INLINE proxyN9 #-}++proxyN10 :: Proxy N10+proxyN10 = Proxy+{-# INLINE proxyN10 #-}++proxyN11 :: Proxy N11+proxyN11 = Proxy+{-# INLINE proxyN11 #-}++proxyN12 :: Proxy N12+proxyN12 = Proxy+{-# INLINE proxyN12 #-}++proxyN13 :: Proxy N13+proxyN13 = Proxy+{-# INLINE proxyN13 #-}++proxyN14 :: Proxy N14+proxyN14 = Proxy+{-# INLINE proxyN14 #-}++proxyN15 :: Proxy N15+proxyN15 = Proxy+{-# INLINE proxyN15 #-}++proxyN16 :: Proxy N16+proxyN16 = Proxy+{-# INLINE proxyN16 #-}++proxyN17 :: Proxy N17+proxyN17 = Proxy+{-# INLINE proxyN17 #-}++proxyN18 :: Proxy N18+proxyN18 = Proxy+{-# INLINE proxyN18 #-}
src/Control/Lens/Wrapped.hs view
@@ -1,7 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -75,12 +78,20 @@ , pattern Wrapped , pattern Unwrapped #endif+ -- * Generics+ , _GWrapped' ) where +#include "HsBaseConfig.h" -import Control.Applicative+import qualified Control.Alternative.Free as Free+import qualified Control.Applicative as Applicative+import Control.Applicative hiding (WrappedArrow(..))+import Control.Applicative.Trans.Free import Control.Arrow import Control.Applicative.Backwards+import Control.Comonad.Trans.Cofree+import Control.Comonad.Trans.Coiter import Control.Comonad.Trans.Traced import Control.Exception import Control.Lens.Getter@@ -88,10 +99,13 @@ #if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Review #endif+import Control.Monad.Catch.Pure import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Except+import Control.Monad.Trans.Free import Control.Monad.Trans.Identity+import Control.Monad.Trans.Iter import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader@@ -101,7 +115,16 @@ 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.Bifunctor.Biff+import Data.Bifunctor.Clown+import Data.Bifunctor.Fix+import Data.Bifunctor.Flip+import Data.Bifunctor.Join+import Data.Bifunctor.Joker+import Data.Bifunctor.Tannen+import Data.Bifunctor.Wrapped import Data.Foldable as Foldable+import Data.Functor.Bind import Data.Functor.Compose import Data.Functor.Contravariant import qualified Data.Functor.Contravariant.Compose as Contravariant@@ -109,6 +132,7 @@ import Data.Functor.Identity import Data.Functor.Reverse import Data.Hashable+import Data.Int import Data.IntSet as IntSet import Data.IntMap as IntMap import Data.HashSet as HashSet@@ -116,7 +140,13 @@ import Data.List.NonEmpty import Data.Map as Map import Data.Monoid+import qualified Data.Profunctor as Profunctor+import Data.Profunctor hiding (WrappedArrow(..))+import Data.Profunctor.Cayley import qualified Data.Semigroup as S+import Data.Semigroupoid+import qualified Data.Semigroupoid.Dual as Semigroupoid+import Data.Semigroupoid.Static import Data.Sequence as Seq hiding (length) import Data.Set as Set import Data.Tagged@@ -124,6 +154,12 @@ import Data.Vector.Primitive as Prim import Data.Vector.Unboxed as Unboxed import Data.Vector.Storable as Storable+import Data.Word+import Foreign.C.Error+import Foreign.C.Types+import qualified GHC.Generics as Generic+import GHC.Generics hiding (from, to)+import System.Posix.Types #if MIN_VERSION_base(4,6,0) import Data.Ord (Down(Down))@@ -131,6 +167,14 @@ import GHC.Exts (Down(Down)) #endif +#if MIN_VERSION_base(4,8,0)+import qualified Data.Monoid as Monoid+#endif++#if MIN_VERSION_base(4,10,0) && defined(HTYPE_TIMER_T)+import GHC.Exts (HTYPE_TIMER_T)+#endif+ #ifdef HLINT {-# ANN module "HLint: ignore Use uncurry" #-} #endif@@ -143,9 +187,30 @@ -- data types with one constructor. class Wrapped s where type Unwrapped s :: *+ type Unwrapped s = GUnwrapped (Rep s)+ -- | An isomorphism between @s@ and @a@.+ --+ -- If your type has a 'Generic' instance, '_Wrapped'' will default to '_GWrapped'',+ -- and you can choose to not override it with your own definition. _Wrapped' :: Iso' s (Unwrapped s)+ default _Wrapped' :: (Generic s, D1 d (C1 c (S1 s' (Rec0 a))) ~ Rep s, Unwrapped s ~ GUnwrapped (Rep s))+ => Iso' s (Unwrapped s)+ _Wrapped' = _GWrapped'+ {-# INLINE _Wrapped' #-} +-- | Implement the '_Wrapped' operation for a type using its 'Generic' instance.+_GWrapped' :: (Generic s, D1 d (C1 c (S1 s' (Rec0 a))) ~ Rep s, Unwrapped s ~ GUnwrapped (Rep s))+ => Iso' s (Unwrapped s)+_GWrapped' = iso Generic.from Generic.to . iso remitter reviewer+ where+ remitter (M1 (M1 (M1 (K1 x)))) = x+ reviewer x = M1 (M1 (M1 (K1 x)))+{-# INLINE _GWrapped' #-}++type family GUnwrapped (rep :: * -> *) :: *+type instance GUnwrapped (D1 d (C1 c (S1 s (Rec0 a)))) = a+ #if __GLASGOW_HASKELL__ >= 710 pattern Wrapped a <- (view _Wrapped -> a) where@@ -221,10 +286,10 @@ _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+instance (t ~ Applicative.WrappedArrow a' b' c') => Rewrapped (Applicative.WrappedArrow a b c) t+instance Wrapped (Applicative.WrappedArrow a b c) where+ type Unwrapped (Applicative.WrappedArrow a b c) = a b c+ _Wrapped' = iso Applicative.unwrapArrow Applicative.WrapArrow {-# INLINE _Wrapped' #-} instance (t ~ ZipList b) => Rewrapped (ZipList a) t@@ -251,7 +316,7 @@ _Wrapped' = iso getDual Dual {-# INLINE _Wrapped' #-} -instance (t ~ Endo b) => Rewrapped (Endo b) t+instance (t ~ Endo b) => Rewrapped (Endo a) t instance Wrapped (Endo a) where type Unwrapped (Endo a) = a -> a _Wrapped' = iso appEndo Endo@@ -270,10 +335,10 @@ {-# 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+instance (t ~ Monoid.Alt g b) => Rewrapped (Monoid.Alt f a) t+instance Wrapped (Monoid.Alt f a) where+ type Unwrapped (Monoid.Alt f a) = f a+ _Wrapped' = iso Monoid.getAlt Monoid.Alt {-# INLINE _Wrapped' #-} #endif @@ -283,11 +348,22 @@ _Wrapped' = iso getArrowMonad ArrowMonad {-# INLINE _Wrapped' #-} -instance t ~ Down a => Rewrapped (Down a) t+instance t ~ Down b => Rewrapped (Down a) t instance Wrapped (Down a) where type Unwrapped (Down a) = a _Wrapped' = iso (\(Down a) -> a) Down+ {-# INLINE _Wrapped' #-} +instance Rewrapped Errno t+instance Wrapped Errno where+ type Unwrapped Errno = CInt+ _Wrapped' = iso (\(Errno x) -> x) Errno+ {-# INLINE _Wrapped' #-}++getArrowMonad :: ArrowMonad m a -> m () a+getArrowMonad (ArrowMonad x) = x+{-# INLINE getArrowMonad #-}+ -- * transformers instance (t ~ Backwards g b) => Rewrapped (Backwards f a) t@@ -346,7 +422,7 @@ _Wrapped' = iso runMaybeT MaybeT {-# INLINE _Wrapped' #-} -instance (t ~ ReaderT r n b) => Rewrapped (ReaderT r m a) t+instance (t ~ ReaderT s 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@@ -394,14 +470,110 @@ _Wrapped' = iso Strict.runWriterT Strict.WriterT {-# INLINE _Wrapped' #-} --- * comonad-transformers+-- * bifunctors +instance (t ~ Biff p' f' g' a' b') => Rewrapped (Biff p f g a b) t+instance Wrapped (Biff p f g a b) where+ type Unwrapped (Biff p f g a b) = p (f a) (g b)+ _Wrapped' = iso runBiff Biff+ {-# INLINE _Wrapped' #-}++instance (t ~ Clown f' a' b') => Rewrapped (Clown f a b) t+instance Wrapped (Clown f a b) where+ type Unwrapped (Clown f a b) = f a+ _Wrapped' = iso runClown Clown+ {-# INLINE _Wrapped' #-}++instance (t ~ Fix p' a') => Rewrapped (Fix p a) t+instance Wrapped (Fix p a) where+ type Unwrapped (Fix p a) = p (Fix p a) a+ _Wrapped' = iso out In+ {-# INLINE _Wrapped' #-}++instance (t ~ Flip p' a' b') => Rewrapped (Flip p a b) t+instance Wrapped (Flip p a b) where+ type Unwrapped (Flip p a b) = p b a+ _Wrapped' = iso runFlip Flip+ {-# INLINE _Wrapped' #-}++instance (t ~ Join p' a') => Rewrapped (Join p a) t+instance Wrapped (Join p a) where+ type Unwrapped (Join p a) = p a a+ _Wrapped' = iso runJoin Join+ {-# INLINE _Wrapped' #-}++instance (t ~ Joker g' a' b') => Rewrapped (Joker g a b) t+instance Wrapped (Joker g a b) where+ type Unwrapped (Joker g a b) = g b+ _Wrapped' = iso runJoker Joker+ {-# INLINE _Wrapped' #-}++instance (t ~ Tannen f' p' a' b') => Rewrapped (Tannen f p a b) t+instance Wrapped (Tannen f p a b) where+ type Unwrapped (Tannen f p a b) = f (p a b)+ _Wrapped' = iso runTannen Tannen+ {-# INLINE _Wrapped' #-}++instance (t ~ WrappedBifunctor p' a' b') => Rewrapped (WrappedBifunctor p a b) t+instance Wrapped (WrappedBifunctor p a b) where+ type Unwrapped (WrappedBifunctor p a b) = p a b+ _Wrapped' = iso unwrapBifunctor WrapBifunctor+ {-# INLINE _Wrapped' #-}++-- * comonad+ 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' #-} +-- * exceptions++instance (t ~ CatchT m' a') => Rewrapped (CatchT m a) t+instance Wrapped (CatchT m a) where+ type Unwrapped (CatchT m a) = m (Either SomeException a)+ _Wrapped' = iso runCatchT CatchT+ {-# INLINE _Wrapped' #-}++-- * free++instance (t ~ Free.Alt f' a') => Rewrapped (Free.Alt f a) t+instance Wrapped (Free.Alt f a) where+ type Unwrapped (Free.Alt f a) = [Free.AltF f a]+ _Wrapped' = iso Free.alternatives Free.Alt+ {-# INLINE _Wrapped' #-}++instance (t ~ ApT f' g' a') => Rewrapped (ApT f g a) t+instance Wrapped (ApT f g a) where+ type Unwrapped (ApT f g a) = g (ApF f g a)+ _Wrapped' = iso getApT ApT+ {-# INLINE _Wrapped' #-}++instance (t ~ CofreeT f' w' a') => Rewrapped (CofreeT f w a) t+instance Wrapped (CofreeT f w a) where+ type Unwrapped (CofreeT f w a) = w (CofreeF f a (CofreeT f w a))+ _Wrapped' = iso runCofreeT CofreeT+ {-# INLINE _Wrapped' #-}++instance (t ~ CoiterT w' a') => Rewrapped (CoiterT w a) t+instance Wrapped (CoiterT w a) where+ type Unwrapped (CoiterT w a) = w (a, CoiterT w a)+ _Wrapped' = iso runCoiterT CoiterT+ {-# INLINE _Wrapped' #-}++instance (t ~ FreeT f' m' a') => Rewrapped (FreeT f m a) t+instance Wrapped (FreeT f m a) where+ type Unwrapped (FreeT f m a) = m (FreeF f a (FreeT f m a))+ _Wrapped' = iso runFreeT FreeT+ {-# INLINE _Wrapped' #-}++instance (t ~ IterT m' a') => Rewrapped (IterT m a) t+instance Wrapped (IterT m a) where+ type Unwrapped (IterT m a) = m (Either a (IterT m a))+ _Wrapped' = iso runIterT IterT+ {-# INLINE _Wrapped' #-}+ -- * unordered-containers -- | Use @'wrapping' 'HashMap.fromList'@. Unwrapping returns some permutation of the list.@@ -454,6 +626,38 @@ _Wrapped' = iso Foldable.toList Seq.fromList {-# INLINE _Wrapped' #-} +-- * profunctors++instance (t ~ Star f' d' c') => Rewrapped (Star f d c) t+instance Wrapped (Star f d c) where+ type Unwrapped (Star f d c) = d -> f c+ _Wrapped' = iso runStar Star+ {-# INLINE _Wrapped' #-}++instance (t ~ Costar f' d' c') => Rewrapped (Costar f d c) t+instance Wrapped (Costar f d c) where+ type Unwrapped (Costar f d c) = f d -> c+ _Wrapped' = iso runCostar Costar+ {-# INLINE _Wrapped' #-}++instance (t ~ Profunctor.WrappedArrow p' a' b') => Rewrapped (Profunctor.WrappedArrow p a b) t+instance Wrapped (Profunctor.WrappedArrow p a b) where+ type Unwrapped (Profunctor.WrappedArrow p a b) = p a b+ _Wrapped' = iso Profunctor.unwrapArrow Profunctor.WrapArrow+ {-# INLINE _Wrapped' #-}++instance (t ~ Forget r' a' b') => Rewrapped (Forget r a b) t+instance Wrapped (Forget r a b) where+ type Unwrapped (Forget r a b) = a -> r+ _Wrapped' = iso runForget Forget+ {-# INLINE _Wrapped' #-}++instance (t ~ Cayley f' p' a' b') => Rewrapped (Cayley f p a b) t+instance Wrapped (Cayley f p a b) where+ type Unwrapped (Cayley f p a b) = f (p a b)+ _Wrapped' = iso runCayley Cayley+ {-# INLINE _Wrapped' #-}+ -- * vector instance (t ~ Vector.Vector a') => Rewrapped (Vector.Vector a) t@@ -480,6 +684,44 @@ _Wrapped' = iso Storable.toList Storable.fromList {-# INLINE _Wrapped' #-} +-- * semigroupoids++instance (t ~ WrappedApplicative f' a') => Rewrapped (WrappedApplicative f a) t+instance Wrapped (WrappedApplicative f a) where+ type Unwrapped (WrappedApplicative f a) = f a+ _Wrapped' = iso unwrapApplicative WrapApplicative+ {-# INLINE _Wrapped' #-}++instance (t ~ MaybeApply f' a') => Rewrapped (MaybeApply f a) t+instance Wrapped (MaybeApply f a) where+ type Unwrapped (MaybeApply f a) = Either (f a) a+ _Wrapped' = iso runMaybeApply MaybeApply+ {-# INLINE _Wrapped' #-}++instance (t ~ WrappedCategory k' a' b') => Rewrapped (WrappedCategory k a b) t+instance Wrapped (WrappedCategory k a b) where+ type Unwrapped (WrappedCategory k a b) = k a b+ _Wrapped' = iso unwrapCategory WrapCategory+ {-# INLINE _Wrapped' #-}++instance (t ~ Semi m' a' b') => Rewrapped (Semi m a b) t+instance Wrapped (Semi m a b) where+ type Unwrapped (Semi m a b) = m+ _Wrapped' = iso getSemi Semi+ {-# INLINE _Wrapped' #-}++instance (t ~ Semigroupoid.Dual k' a' b') => Rewrapped (Semigroupoid.Dual k a b) t+instance Wrapped (Semigroupoid.Dual k a b) where+ type Unwrapped (Semigroupoid.Dual k a b) = k b a+ _Wrapped' = iso Semigroupoid.getDual Semigroupoid.Dual+ {-# INLINE _Wrapped' #-}++instance (t ~ Static f' a' b') => Rewrapped (Static f a b) t+instance Wrapped (Static f a b) where+ type Unwrapped (Static f a b) = f (a -> b)+ _Wrapped' = iso runStatic Static+ {-# INLINE _Wrapped' #-}+ -- * semigroups instance (t ~ S.Min b) => Rewrapped (S.Min a) t@@ -614,6 +856,30 @@ _Wrapped' = iso getErrorCall ErrorCall {-# INLINE _Wrapped' #-} +#if MIN_VERSION_base(4,9,0)+instance (t ~ TypeError) => Rewrapped TypeError t+instance Wrapped TypeError where+ type Unwrapped TypeError = String+ _Wrapped' = iso getTypeError TypeError+ {-# INLINE _Wrapped' #-}++getTypeError :: TypeError -> String+getTypeError (TypeError x) = x+{-# INLINE getTypeError #-}+#endif++#if MIN_VERSION_base(4,10,0)+instance (t ~ CompactionFailed) => Rewrapped CompactionFailed t+instance Wrapped CompactionFailed where+ type Unwrapped CompactionFailed = String+ _Wrapped' = iso getCompactionFailed CompactionFailed+ {-# INLINE _Wrapped' #-}++getCompactionFailed :: CompactionFailed -> String+getCompactionFailed (CompactionFailed x) = x+{-# INLINE getCompactionFailed #-}+#endif+ getErrorCall :: ErrorCall -> String #if __GLASGOW_HASKELL__ < 800 getErrorCall (ErrorCall x) = x@@ -646,9 +912,373 @@ failedAssertion (AssertionFailed x) = x {-# INLINE failedAssertion #-} -getArrowMonad :: ArrowMonad m a -> m () a-getArrowMonad (ArrowMonad x) = x-{-# INLINE getArrowMonad #-}+-- * Foreign.C.Types++instance Rewrapped CChar t+instance Wrapped CChar where+ type Unwrapped CChar = HTYPE_CHAR+ _Wrapped' = iso (\(CChar x) -> x) CChar+ {-# INLINE _Wrapped' #-}++instance Rewrapped CSChar t+instance Wrapped CSChar where+ type Unwrapped CSChar = HTYPE_SIGNED_CHAR+ _Wrapped' = iso (\(CSChar x) -> x) CSChar+ {-# INLINE _Wrapped' #-}++instance Rewrapped CUChar t+instance Wrapped CUChar where+ type Unwrapped CUChar = HTYPE_UNSIGNED_CHAR+ _Wrapped' = iso (\(CUChar x) -> x) CUChar+ {-# INLINE _Wrapped' #-}++instance Rewrapped CShort t+instance Wrapped CShort where+ type Unwrapped CShort = HTYPE_SHORT+ _Wrapped' = iso (\(CShort x) -> x) CShort+ {-# INLINE _Wrapped' #-}++instance Rewrapped CUShort t+instance Wrapped CUShort where+ type Unwrapped CUShort = HTYPE_UNSIGNED_SHORT+ _Wrapped' = iso (\(CUShort x) -> x) CUShort+ {-# INLINE _Wrapped' #-}++instance Rewrapped CInt t+instance Wrapped CInt where+ type Unwrapped CInt = HTYPE_INT+ _Wrapped' = iso (\(CInt x) -> x) CInt+ {-# INLINE _Wrapped' #-}++instance Rewrapped CUInt t+instance Wrapped CUInt where+ type Unwrapped CUInt = HTYPE_UNSIGNED_INT+ _Wrapped' = iso (\(CUInt x) -> x) CUInt+ {-# INLINE _Wrapped' #-}++instance Rewrapped CLong t+instance Wrapped CLong where+ type Unwrapped CLong = HTYPE_LONG+ _Wrapped' = iso (\(CLong x) -> x) CLong+ {-# INLINE _Wrapped' #-}++instance Rewrapped CULong t+instance Wrapped CULong where+ type Unwrapped CULong = HTYPE_UNSIGNED_LONG+ _Wrapped' = iso (\(CULong x) -> x) CULong+ {-# INLINE _Wrapped' #-}++instance Rewrapped CLLong t+instance Wrapped CLLong where+ type Unwrapped CLLong = HTYPE_LONG_LONG+ _Wrapped' = iso (\(CLLong x) -> x) CLLong+ {-# INLINE _Wrapped' #-}++instance Rewrapped CULLong t+instance Wrapped CULLong where+ type Unwrapped CULLong = HTYPE_UNSIGNED_LONG_LONG+ _Wrapped' = iso (\(CULLong x) -> x) CULLong+ {-# INLINE _Wrapped' #-}++instance Rewrapped CFloat t+instance Wrapped CFloat where+ type Unwrapped CFloat = HTYPE_FLOAT+ _Wrapped' = iso (\(CFloat x) -> x) CFloat+ {-# INLINE _Wrapped' #-}++instance Rewrapped CDouble t+instance Wrapped CDouble where+ type Unwrapped CDouble = HTYPE_DOUBLE+ _Wrapped' = iso (\(CDouble x) -> x) CDouble+ {-# INLINE _Wrapped' #-}++instance Rewrapped CPtrdiff t+instance Wrapped CPtrdiff where+ type Unwrapped CPtrdiff = HTYPE_PTRDIFF_T+ _Wrapped' = iso (\(CPtrdiff x) -> x) CPtrdiff+ {-# INLINE _Wrapped' #-}++instance Rewrapped CSize t+instance Wrapped CSize where+ type Unwrapped CSize = HTYPE_SIZE_T+ _Wrapped' = iso (\(CSize x) -> x) CSize+ {-# INLINE _Wrapped' #-}++instance Rewrapped CWchar t+instance Wrapped CWchar where+ type Unwrapped CWchar = HTYPE_WCHAR_T+ _Wrapped' = iso (\(CWchar x) -> x) CWchar+ {-# INLINE _Wrapped' #-}++instance Rewrapped CSigAtomic t+instance Wrapped CSigAtomic where+ type Unwrapped CSigAtomic = HTYPE_SIG_ATOMIC_T+ _Wrapped' = iso (\(CSigAtomic x) -> x) CSigAtomic+ {-# INLINE _Wrapped' #-}++instance Rewrapped CClock t+instance Wrapped CClock where+ type Unwrapped CClock = HTYPE_CLOCK_T+ _Wrapped' = iso (\(CClock x) -> x) CClock+ {-# INLINE _Wrapped' #-}++instance Rewrapped CTime t+instance Wrapped CTime where+ type Unwrapped CTime = HTYPE_TIME_T+ _Wrapped' = iso (\(CTime x) -> x) CTime+ {-# INLINE _Wrapped' #-}++instance Rewrapped CUSeconds t+instance Wrapped CUSeconds where+ type Unwrapped CUSeconds = HTYPE_USECONDS_T+ _Wrapped' = iso (\(CUSeconds x) -> x) CUSeconds+ {-# INLINE _Wrapped' #-}++instance Rewrapped CSUSeconds t+instance Wrapped CSUSeconds where+ type Unwrapped CSUSeconds = HTYPE_SUSECONDS_T+ _Wrapped' = iso (\(CSUSeconds x) -> x) CSUSeconds+ {-# INLINE _Wrapped' #-}++instance Rewrapped CIntPtr t+instance Wrapped CIntPtr where+ type Unwrapped CIntPtr = HTYPE_INTPTR_T+ _Wrapped' = iso (\(CIntPtr x) -> x) CIntPtr+ {-# INLINE _Wrapped' #-}++instance Rewrapped CUIntPtr t+instance Wrapped CUIntPtr where+ type Unwrapped CUIntPtr = HTYPE_UINTPTR_T+ _Wrapped' = iso (\(CUIntPtr x) -> x) CUIntPtr+ {-# INLINE _Wrapped' #-}++instance Rewrapped CIntMax t+instance Wrapped CIntMax where+ type Unwrapped CIntMax = HTYPE_INTMAX_T+ _Wrapped' = iso (\(CIntMax x) -> x) CIntMax+ {-# INLINE _Wrapped' #-}++instance Rewrapped CUIntMax t+instance Wrapped CUIntMax where+ type Unwrapped CUIntMax = HTYPE_UINTMAX_T+ _Wrapped' = iso (\(CUIntMax x) -> x) CUIntMax+ {-# INLINE _Wrapped' #-}++-- * GHC.Generics++instance (t ~ Par1 p') => Rewrapped (Par1 p) t+instance Wrapped (Par1 p) where+ type Unwrapped (Par1 p) = p+ _Wrapped' = iso unPar1 Par1+ {-# INLINE _Wrapped' #-}++instance (t ~ Rec1 f' p') => Rewrapped (Rec1 f p) t+instance Wrapped (Rec1 f p) where+ type Unwrapped (Rec1 f p) = f p+ _Wrapped' = iso unRec1 Rec1+ {-# INLINE _Wrapped' #-}++instance (t ~ K1 i' c' p') => Rewrapped (K1 i c p) t+instance Wrapped (K1 i c p) where+ type Unwrapped (K1 i c p) = c+ _Wrapped' = iso unK1 K1+ {-# INLINE _Wrapped' #-}++instance (t ~ M1 i' c' f' p') => Rewrapped (M1 i c f p) t+instance Wrapped (M1 i c f p) where+ type Unwrapped (M1 i c f p) = f p+ _Wrapped' = iso unM1 M1+ {-# INLINE _Wrapped' #-}++instance (t ~ (f' :.: g') p') => Rewrapped ((f :.: g) p) t+instance Wrapped ((f :.: g) p) where+ type Unwrapped ((f :.: g) p) = f (g p)+ _Wrapped' = iso unComp1 Comp1+ {-# INLINE _Wrapped' #-}++-- * System.Posix.Types++#if defined(HTYPE_DEV_T)+instance Rewrapped CDev t+instance Wrapped CDev where+ type Unwrapped CDev = HTYPE_DEV_T+ _Wrapped' = iso (\(CDev x) -> x) CDev+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_INO_T)+instance Rewrapped CIno t+instance Wrapped CIno where+ type Unwrapped CIno = HTYPE_INO_T+ _Wrapped' = iso (\(CIno x) -> x) CIno+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_MODE_T)+instance Rewrapped CMode t+instance Wrapped CMode where+ type Unwrapped CMode = HTYPE_MODE_T+ _Wrapped' = iso (\(CMode x) -> x) CMode+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_OFF_T)+instance Rewrapped COff t+instance Wrapped COff where+ type Unwrapped COff = HTYPE_OFF_T+ _Wrapped' = iso (\(COff x) -> x) COff+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_PID_T)+instance Rewrapped CPid t+instance Wrapped CPid where+ type Unwrapped CPid = HTYPE_PID_T+ _Wrapped' = iso (\(CPid x) -> x) CPid+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_SSIZE_T)+instance Rewrapped CSsize t+instance Wrapped CSsize where+ type Unwrapped CSsize = HTYPE_SSIZE_T+ _Wrapped' = iso (\(CSsize x) -> x) CSsize+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_GID_T)+instance Rewrapped CGid t+instance Wrapped CGid where+ type Unwrapped CGid = HTYPE_GID_T+ _Wrapped' = iso (\(CGid x) -> x) CGid+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_NLINK_T)+instance Rewrapped CNlink t+instance Wrapped CNlink where+ type Unwrapped CNlink = HTYPE_NLINK_T+ _Wrapped' = iso (\(CNlink x) -> x) CNlink+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_UID_T)+instance Rewrapped CUid t+instance Wrapped CUid where+ type Unwrapped CUid = HTYPE_UID_T+ _Wrapped' = iso (\(CUid x) -> x) CUid+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_CC_T)+instance Rewrapped CCc t+instance Wrapped CCc where+ type Unwrapped CCc = HTYPE_CC_T+ _Wrapped' = iso (\(CCc x) -> x) CCc+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_SPEED_T)+instance Rewrapped CSpeed t+instance Wrapped CSpeed where+ type Unwrapped CSpeed = HTYPE_SPEED_T+ _Wrapped' = iso (\(CSpeed x) -> x) CSpeed+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_TCFLAG_T)+instance Rewrapped CTcflag t+instance Wrapped CTcflag where+ type Unwrapped CTcflag = HTYPE_TCFLAG_T+ _Wrapped' = iso (\(CTcflag x) -> x) CTcflag+ {-# INLINE _Wrapped' #-}+#endif++#if defined(HTYPE_RLIM_T)+instance Rewrapped CRLim t+instance Wrapped CRLim where+ type Unwrapped CRLim = HTYPE_RLIM_T+ _Wrapped' = iso (\(CRLim x) -> x) CRLim+ {-# INLINE _Wrapped' #-}+#endif++instance Rewrapped Fd t+instance Wrapped Fd where+ type Unwrapped Fd = CInt+ _Wrapped' = iso (\(Fd x) -> x) Fd+ {-# INLINE _Wrapped' #-}++#if MIN_VERSION_base(4,10,0)+instance Rewrapped CBool t+instance Wrapped CBool where+ type Unwrapped CBool = HTYPE_BOOL+ _Wrapped' = iso (\(CBool x) -> x) CBool+ {-# INLINE _Wrapped' #-}++# if defined(HTYPE_BLKSIZE_T)+instance Rewrapped CBlkSize t+instance Wrapped CBlkSize where+ type Unwrapped CBlkSize = HTYPE_BLKSIZE_T+ _Wrapped' = iso (\(CBlkSize x) -> x) CBlkSize+ {-# INLINE _Wrapped' #-}+# endif++# if defined(HTYPE_BLKCNT_T)+instance Rewrapped CBlkCnt t+instance Wrapped CBlkCnt where+ type Unwrapped CBlkCnt = HTYPE_BLKCNT_T+ _Wrapped' = iso (\(CBlkCnt x) -> x) CBlkCnt+ {-# INLINE _Wrapped' #-}+# endif++# if defined(HTYPE_CLOCKID_T)+instance Rewrapped CClockId t+instance Wrapped CClockId where+ type Unwrapped CClockId = HTYPE_CLOCKID_T+ _Wrapped' = iso (\(CClockId x) -> x) CClockId+ {-# INLINE _Wrapped' #-}+# endif++# if defined(HTYPE_FSBLKCNT_T)+instance Rewrapped CFsBlkCnt t+instance Wrapped CFsBlkCnt where+ type Unwrapped CFsBlkCnt = HTYPE_FSBLKCNT_T+ _Wrapped' = iso (\(CFsBlkCnt x) -> x) CFsBlkCnt+ {-# INLINE _Wrapped' #-}+# endif++# if defined(HTYPE_FSFILCNT_T)+instance Rewrapped CFsFilCnt t+instance Wrapped CFsFilCnt where+ type Unwrapped CFsFilCnt = HTYPE_FSFILCNT_T+ _Wrapped' = iso (\(CFsFilCnt x) -> x) CFsFilCnt+ {-# INLINE _Wrapped' #-}+# endif++# if defined(HTYPE_ID_T)+instance Rewrapped CId t+instance Wrapped CId where+ type Unwrapped CId = HTYPE_ID_T+ _Wrapped' = iso (\(CId x) -> x) CId+ {-# INLINE _Wrapped' #-}+# endif++# if defined(HTYPE_KEY_T)+instance Rewrapped CKey t+instance Wrapped CKey where+ type Unwrapped CKey = HTYPE_KEY_T+ _Wrapped' = iso (\(CKey x) -> x) CKey+ {-# INLINE _Wrapped' #-}+# endif++# if defined(HTYPE_TIMER_T)+instance Rewrapped CTimer t+instance Wrapped CTimer where+ type Unwrapped CTimer = HTYPE_TIMER_T+ _Wrapped' = iso (\(CTimer x) -> x) CTimer+ {-# INLINE _Wrapped' #-}+# endif+#endif -- | Given the constructor for a 'Wrapped' type, return a -- deconstructor that is its inverse.
src/Control/Monad/Error/Lens.hs view
@@ -25,7 +25,7 @@ , Handler(..) , Handleable(..) -- * Throwing- , throwing+ , throwing, throwing_ ) where import Control.Applicative@@ -228,3 +228,15 @@ Nothing -> throwError e Just x -> k x {-# INLINE catchJust #-}++-- | Similar to 'throwing' but specialised for the common case of+-- error constructors with no arguments.+--+-- @+-- data MyError = Foo | Bar+-- makePrisms ''MyError+-- 'throwing_' _Foo :: 'MonadError' MyError m => m a+-- @+throwing_ :: MonadError e m => AReview e () -> m x+throwing_ l = throwing l ()+{-# INLINE throwing_ #-}
src/Data/Bits/Lens.hs view
@@ -244,7 +244,7 @@ -- 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+-- Why isn't 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
src/Data/ByteString/Strict/Lens.hs view
@@ -31,6 +31,7 @@ import Data.Word -- $setup+-- >>> :set -XOverloadedStrings -- >>> import Control.Lens -- >>> import Numeric.Lens
src/Data/Dynamic/Lens.hs view
@@ -19,7 +19,7 @@ module Data.Dynamic.Lens ( AsDynamic(..) #if __GLASGOW_HASKELL__ >= 710- , pattern Dynamic+ , pattern Data.Dynamic.Lens.Dynamic #endif ) where
src/Data/Map/Lens.hs view
@@ -65,7 +65,6 @@ ) where import Control.Lens.Getter ( IndexedGetting, iviews )-import Control.Lens.Type import qualified Data.Map as Map -- $setup@@ -80,6 +79,9 @@ -- -- >>> toMapOf folded ["hello", "world"] -- fromList [(0,"hello"),(1,"world")]+--+-- >>> toMapOf (folded . ifolded) [('a',"alpha"),('b', "beta")]+-- fromList [('a',"alpha"),('b',"beta")] -- -- >>> toMapOf (folded <.> folded) ["foo", "bar"] -- fromList [((0,0),'f'),((0,1),'o'),((0,2),'o'),((1,0),'b'),((1,1),'a'),((1,2),'r')]
src/Data/Text/Lazy/Lens.hs view
@@ -137,7 +137,7 @@ 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.+-- | 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.
src/Data/Text/Strict/Lens.hs view
@@ -133,7 +133,7 @@ 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.+-- | Encode\/Decode a strict 'Text' to\/from strict 'ByteString', via UTF-8. -- -- >>> utf8 # "☃" -- "\226\152\131"
src/Language/Haskell/TH/Lens.hs view
@@ -70,10 +70,15 @@ , typeFamilyHeadTyVarBndrs , typeFamilyHeadResultSig , typeFamilyHeadInjectivityAnn- -- ** Bang Prisms+ -- ** Bang Lenses , bangSourceUnpackedness , bangSourceStrictness #endif+#if MIN_VERSION_template_haskell(2,12,0)+ -- ** DerivClause Lenses+ , derivClauseStrategy+ , derivClauseCxt+#endif -- * Prisms -- ** Info Prisms , _ClassI@@ -84,6 +89,9 @@ , _DataConI , _VarI , _TyVarI+#if MIN_VERSION_template_haskell(2,12,0)+ , _PatSynI+#endif -- ** Dec Prisms , _FunD , _ValD@@ -115,6 +123,20 @@ #else , _FamilyD #endif+#if MIN_VERSION_template_haskell(2,12,0)+ , _PatSynD+ , _PatSynSigD+#endif+#if MIN_VERSION_template_haskell(2,12,0)+ -- ** PatSynDir Prisms+ , _Unidir+ , _ImplBidir+ , _ExplBidir+ -- ** PatSynArgs Prisms+ , _PrefixPatSyn+ , _InfixPatSyn+ , _RecordPatSyn+#endif -- ** Con Prisms , _NormalC , _RecC@@ -177,6 +199,9 @@ #if MIN_VERSION_template_haskell(2,10,0) , _LineP #endif+#if MIN_VERSION_template_haskell(2,12,0)+ , _CompleteP+#endif -- ** Inline Prisms , _NoInline , _Inline@@ -212,6 +237,9 @@ , _ConE , _LitE , _AppE+#if MIN_VERSION_template_haskell(2,12,0)+ , _AppTypeE+#endif , _InfixE , _UInfixE , _ParensE@@ -221,6 +249,9 @@ #endif , _TupE , _UnboxedTupE+#if MIN_VERSION_template_haskell(2,12,0)+ , _UnboxedSumE+#endif , _CondE #if MIN_VERSION_template_haskell(2,8,0) , _MultiIfE@@ -274,6 +305,9 @@ , _VarP , _TupP , _UnboxedTupP+#if MIN_VERSION_template_haskell(2,12,0)+ , _UnboxedSumP+#endif , _ConP , _InfixP , _UInfixP@@ -297,6 +331,9 @@ #endif , _TupleT , _UnboxedTupleT+#if MIN_VERSION_template_haskell(2,12,0)+ , _UnboxedSumT+#endif , _ArrowT #if MIN_VERSION_template_haskell(2,10,0) , _EqualityT@@ -342,6 +379,12 @@ , _PhantomR , _InferR #endif+#if MIN_VERSION_template_haskell(2,12,0)+ -- ** DerivStrategy Prisms+ , _StockStrategy+ , _AnyclassStrategy+ , _NewtypeStrategy+#endif ) where import Control.Applicative@@ -709,6 +752,18 @@ s (Bang ss _ ) = Bang ss #endif +#if MIN_VERSION_template_haskell(2,12,0)+derivClauseStrategy :: Lens' DerivClause (Maybe DerivStrategy)+derivClauseStrategy = lens g s where+ g (DerivClause mds _) = mds+ s (DerivClause _ c) mds = DerivClause mds c++derivClauseCxt :: Lens' DerivClause Cxt+derivClauseCxt = lens g s where+ g (DerivClause _ c) = c+ s (DerivClause mds _) = DerivClause mds+#endif+ #if MIN_VERSION_template_haskell(2,8,0) _ClassI :: Prism' Info (Dec, [InstanceDec]) #else@@ -823,6 +878,16 @@ remitter (TyVarI x y) = Just (x, y) remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,12,0)+_PatSynI :: Prism' Info (Name, PatSynType)+_PatSynI+ = prism' reviewer remitter+ where+ reviewer (x, y) = PatSynI x y+ remitter (PatSynI x y) = Just (x, y)+ remitter _ = Nothing+#endif+ _FunD :: Prism' Dec (Name, [Clause]) _FunD = prism' reviewer remitter@@ -963,7 +1028,15 @@ remitter _ = Nothing #endif -#if MIN_VERSION_template_haskell(2,10,0)+#if MIN_VERSION_template_haskell(2,12,0)+_StandaloneDerivD :: Prism' Dec (Maybe DerivStrategy, Cxt, Type)+_StandaloneDerivD+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = StandaloneDerivD x y z+ remitter (StandaloneDerivD x y z) = Just (x, y, z)+ remitter _ = Nothing+#elif MIN_VERSION_template_haskell(2,10,0) _StandaloneDerivD :: Prism' Dec (Cxt, Type) _StandaloneDerivD = prism' reviewer remitter@@ -971,7 +1044,9 @@ reviewer (x, y) = StandaloneDerivD x y remitter (StandaloneDerivD x y) = Just (x, y) remitter _ = Nothing+#endif +#if MIN_VERSION_template_haskell(2,10,0) _DefaultSigD :: Prism' Dec (Name, Type) _DefaultSigD = prism' reviewer remitter@@ -1000,7 +1075,13 @@ #endif #if MIN_VERSION_template_haskell(2,11,0)-_DataD :: Prism' Dec (Cxt, Name, [TyVarBndr], Maybe Kind, [Con], Cxt)+# if MIN_VERSION_template_haskell(2,12,0)+type DataPrism' tys cons = Prism' Dec (Cxt, Name, tys, Maybe Kind, cons, [DerivClause])+# else+type DataPrism' tys cons = Prism' Dec (Cxt, Name, tys, Maybe Kind, cons, Cxt)+# endif++_DataD :: DataPrism' [TyVarBndr] [Con] _DataD = prism' reviewer remitter where@@ -1008,7 +1089,7 @@ 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 :: DataPrism' [TyVarBndr] Con _NewtypeD = prism' reviewer remitter where@@ -1016,7 +1097,7 @@ 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 :: DataPrism' [Type] [Con] _DataInstD = prism' reviewer remitter where@@ -1024,7 +1105,7 @@ 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 :: DataPrism' [Type] Con _NewtypeInstD = prism' reviewer remitter where@@ -1089,6 +1170,74 @@ remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,12,0)+_PatSynD :: Prism' Dec (Name, PatSynArgs, PatSynDir, Pat)+_PatSynD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w) = PatSynD x y z w+ remitter (PatSynD x y z w) = Just (x, y, z, w)+ remitter _ = Nothing++_PatSynSigD :: Prism' Dec (Name, PatSynType)+_PatSynSigD+ = prism' reviewer remitter+ where+ reviewer (x, y) = PatSynSigD x y+ remitter (PatSynSigD x y) = Just (x, y)+ remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,12,0)+_Unidir :: Prism' PatSynDir ()+_Unidir+ = prism' reviewer remitter+ where+ reviewer () = Unidir+ remitter Unidir = Just ()+ remitter _ = Nothing++_ImplBidir :: Prism' PatSynDir ()+_ImplBidir+ = prism' reviewer remitter+ where+ reviewer () = ImplBidir+ remitter ImplBidir = Just ()+ remitter _ = Nothing++_ExplBidir :: Prism' PatSynDir [Clause]+_ExplBidir+ = prism' reviewer remitter+ where+ reviewer = ExplBidir+ remitter (ExplBidir x) = Just x+ remitter _ = Nothing++_PrefixPatSyn :: Prism' PatSynArgs [Name]+_PrefixPatSyn+ = prism' reviewer remitter+ where+ reviewer = PrefixPatSyn+ remitter (PrefixPatSyn x) = Just x+ remitter _ = Nothing++_InfixPatSyn :: Prism' PatSynArgs (Name, Name)+_InfixPatSyn+ = prism' reviewer remitter+ where+ reviewer (x, y) = InfixPatSyn x y+ remitter (InfixPatSyn x y) = Just (x, y)+ remitter _ = Nothing++_RecordPatSyn :: Prism' PatSynArgs [Name]+_RecordPatSyn+ = prism' reviewer remitter+ where+ reviewer = RecordPatSyn+ remitter (RecordPatSyn x) = Just x+ remitter _ = Nothing+#endif+ _NormalC :: Prism' Con ( Name #if MIN_VERSION_template_haskell(2,11,0)@@ -1412,6 +1561,16 @@ remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,12,0)+_CompleteP :: Prism' Pragma ([Name], Maybe Name)+_CompleteP+ = prism' reviewer remitter+ where+ reviewer (x, y) = CompleteP x y+ remitter (CompleteP x y) = Just (x, y)+ remitter _ = Nothing+#endif+ _NoInline :: Prism' Inline () _NoInline = prism' reviewer remitter@@ -1610,6 +1769,16 @@ remitter (AppE x y) = Just (x, y) remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,12,0)+_AppTypeE :: Prism' Exp (Exp, Type)+_AppTypeE+ = prism' reviewer remitter+ where+ reviewer (x, y) = AppTypeE x y+ remitter (AppTypeE x y) = Just (x, y)+ remitter _ = Nothing+#endif+ _InfixE :: Prism' Exp (Maybe Exp, Exp, Maybe Exp) _InfixE = prism' reviewer remitter@@ -1668,6 +1837,16 @@ remitter (UnboxedTupE x) = Just x remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,12,0)+_UnboxedSumE :: Prism' Exp (Exp, SumAlt, SumArity)+_UnboxedSumE+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = UnboxedSumE x y z+ remitter (UnboxedSumE x y z) = Just (x, y, z)+ remitter _ = Nothing+#endif+ _CondE :: Prism' Exp (Exp, Exp, Exp) _CondE = prism' reviewer remitter@@ -1998,6 +2177,16 @@ remitter (UnboxedTupP x) = Just x remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,12,0)+_UnboxedSumP :: Prism' Pat (Pat, SumAlt, SumArity)+_UnboxedSumP+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = UnboxedSumP x y z+ remitter (UnboxedSumP x y z) = Just (x, y, z)+ remitter _ = Nothing+#endif+ _ConP :: Prism' Pat (Name, [Pat]) _ConP = prism' reviewer remitter@@ -2160,6 +2349,16 @@ remitter (UnboxedTupleT x) = Just x remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,12,0)+_UnboxedSumT :: Prism' Type SumArity+_UnboxedSumT+ = prism' reviewer remitter+ where+ reviewer = UnboxedSumT+ remitter (UnboxedSumT x) = Just x+ remitter _ = Nothing+#endif+ _ArrowT :: Prism' Type () _ArrowT = prism' reviewer remitter@@ -2379,5 +2578,31 @@ where reviewer () = InferR remitter InferR = Just ()+ remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,12,0)+_StockStrategy :: Prism' DerivStrategy ()+_StockStrategy+ = prism' reviewer remitter+ where+ reviewer () = StockStrategy+ remitter StockStrategy = Just ()+ remitter _ = Nothing++_AnyclassStrategy :: Prism' DerivStrategy ()+_AnyclassStrategy+ = prism' reviewer remitter+ where+ reviewer () = AnyclassStrategy+ remitter AnyclassStrategy = Just ()+ remitter _ = Nothing++_NewtypeStrategy :: Prism' DerivStrategy ()+_NewtypeStrategy+ = prism' reviewer remitter+ where+ reviewer () = NewtypeStrategy+ remitter NewtypeStrategy = Just () remitter _ = Nothing #endif
+ tests/doctests.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module : Main (doctests)+-- Copyright : (C) 2012-14 Edward Kmett+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- 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 (flags, pkgs, module_sources)+import Data.Foldable (traverse_)+import Test.DocTest++main :: IO ()+main = do+ traverse_ putStrLn args+ doctest args+ where+ args = flags ++ pkgs ++ module_sources
− tests/doctests.hsc
@@ -1,78 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-}--------------------------------------------------------------------------------- |--- Module : Main (doctests)--- Copyright : (C) 2012-14 Edward Kmett--- License : BSD-style (see the file LICENSE)--- Maintainer : Edward Kmett <ekmett@gmail.com>--- 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
tests/properties.hs view
@@ -55,6 +55,11 @@ 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_6 = isLens (_6 :: Lens' ((),(),(),(),Int,Bool) Bool)+prop_7 = isLens (_7 :: Lens' ((),(),(),(),(),Int,Bool) Bool)+prop_8 = isLens (_8 :: Lens' ((),(),(),(),(),(),Int,Bool) Bool)+prop_9 = isLens (_9 :: Lens' ((),(),(),(),(),(),(),Int,Bool) Bool)+prop_10 = isLens (_10 :: Lens' ((),(),(),(),(),(),(),(),Int,Bool) Bool) prop_2_2 = isLens (_2._2 :: Lens' (Int,(Int,Bool),Double) Bool)