diff --git a/.hlint.yaml b/.hlint.yaml --- a/.hlint.yaml +++ b/.hlint.yaml @@ -13,6 +13,7 @@ - ignore: {name: Eta reduce, within: [Control.Lens.Zoom]} # Breaks code - ignore: {name: Use camelCase, within: [Control.Lens.Internal.TH]} - ignore: {name: Use list comprehension, within: [Control.Lens.Internal.FieldTH]} +- ignore: {name: Use fmap, within: [Control.Exception.Lens]} # Needed to support pre-AMP GHCs - fixity: "infixl 9 :>" - fixity: "infixr 9 <.>, <., .>, ..." diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -4,9 +4,11 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.3.20190814.1 +# version: 0.9.20200125 # +version: ~> 1.0 language: c +os: linux dist: xenial git: # whether to recursively clone submodules @@ -22,6 +24,7 @@ directories: - $HOME/.cabal/packages - $HOME/.cabal/store + - $HOME/.hlint before_cache: - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' @@ -31,34 +34,48 @@ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx - rm -rfv $CABALHOME/packages/head.hackage -matrix: +jobs: include: - - compiler: ghc-8.8.1 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0","freeglut3-dev"]}} + - compiler: ghc-8.10.1 + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2","freeglut3-dev"]}} + os: linux + - compiler: ghc-8.8.2 + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.2","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-8.6.5 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-8.4.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-8.2.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-8.0.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-7.10.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-7.8.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-7.6.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-2.4","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.6.3","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-7.4.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-2.4","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.4.2","cabal-install-3.0","freeglut3-dev"]}} + os: linux - compiler: ghc-head - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-head","cabal-install-head","freeglut3-dev"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-head","cabal-install-head","freeglut3-dev"]}} + os: linux allow_failures: - compiler: ghc-head - - compiler: ghc-8.8.1 + - compiler: ghc-8.10.1 before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - WITHCOMPILER="-w $HC" + - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') - HCPKG="$HC-pkg" - unset CC - CABAL=/opt/ghc/bin/cabal @@ -67,33 +84,12 @@ - TOP=$(pwd) - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - echo $HCNUMVER - - CABAL="$CABAL -vnormal+nowrap+markoutput" + - CABAL="$CABAL -vnormal+nowrap" - set -o pipefail - - | - echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk - echo 'BEGIN { state = "output"; }' >> .colorful.awk - echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk - echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk - echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk - echo ' if (state == "cabal") {' >> .colorful.awk - echo ' print blue($0)' >> .colorful.awk - echo ' } else {' >> .colorful.awk - echo ' print $0' >> .colorful.awk - echo ' }' >> .colorful.awk - echo '}' >> .colorful.awk - - cat .colorful.awk - - | - color_cabal_output () { - awk -f $TOP/.colorful.awk - } - - echo text | color_cabal_output -install: - - ${CABAL} --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - TEST=--enable-tests - BENCH=--enable-benchmarks - HEADHACKAGE=false - - if [ $HCNUMVER -ge 80800 ] ; then HEADHACKAGE=true ; fi + - if [ $HCNUMVER -ge 81000 ] ; then HEADHACKAGE=true ; fi - rm -f $CABALHOME/config - | echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config @@ -122,10 +118,19 @@ echo " f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89" >> $CABALHOME/config echo " key-threshold: 3" >> $CABALHOME/config fi +install: + - ${CABAL} --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - | + echo "program-default-options" >> $CABALHOME/config + echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v - - if [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] ; then ${CABAL} v2-install $WITHCOMPILER -j2 hlint --constraint='hlint ==2.1.*' | color_cabal_output ; fi + - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 81000 ] ; then HLINTVER=$(cd /tmp && (${CABAL} v2-install -v $WITHCOMPILER --dry-run hlint --constraint='hlint ==2.2.*' | perl -ne 'if (/\bhlint-(\d+(\.\d+)*)\b/) { print "$1"; last; }')); echo "HLint version $HLINTVER" ; fi + - "if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 81000 ] ; then if [ ! -e $HOME/.hlint/hlint-$HLINTVER/hlint ]; then echo \"Downloading HLint version $HLINTVER\"; mkdir -p $HOME/.hlint; curl --write-out 'Status Code: %{http_code} Redirects: %{num_redirects} Total time: %{time_total} Total Dsize: %{size_download}\\n' --silent --location --output $HOME/.hlint/hlint-$HLINTVER.tar.gz \"https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz\"; tar -xzv -f $HOME/.hlint/hlint-$HLINTVER.tar.gz -C $HOME/.hlint; fi ; fi" + - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 81000 ] ; then mkdir -p $CABALHOME/bin && ln -sf "$HOME/.hlint/hlint-$HLINTVER/hlint" $CABALHOME/bin/hlint ; fi + - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 81000 ] ; then hlint --version ; fi # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project @@ -140,14 +145,14 @@ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - if [ -f "./examples/configure.ac" ]; then (cd "./examples" && autoreconf -i); fi - if [ -f "./lens-properties/configure.ac" ]; then (cd "./lens-properties" && autoreconf -i); fi - - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output + - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - rm cabal.project.freeze - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging... - - ${CABAL} v2-sdist all | color_cabal_output + - ${CABAL} v2-sdist all # Unpacking... - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false @@ -169,19 +174,19 @@ - cat cabal.project.local || true # Building with tests and benchmarks... # build & run tests, build benchmarks - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all # Testing... - - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all # HLint.. - - if [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] ; then (cd ${PKGDIR_lens} && hlint src) ; fi - - if [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] ; then (cd ${PKGDIR_lens_examples} && hlint .) ; fi - - if [ $HCNUMVER -ge 80600 ] && [ $HCNUMVER -lt 80800 ] ; then (cd ${PKGDIR_lens_properties} && hlint src) ; fi + - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 81000 ] ; then (cd ${PKGDIR_lens} && hlint src) ; fi + - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 81000 ] ; then (cd ${PKGDIR_lens_examples} && hlint .) ; fi + - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 81000 ] ; then (cd ${PKGDIR_lens_properties} && hlint src) ; fi # cabal check... - (cd ${PKGDIR_lens} && ${CABAL} -vnormal check) - (cd ${PKGDIR_lens_examples} && ${CABAL} -vnormal check) - (cd ${PKGDIR_lens_properties} && ${CABAL} -vnormal check) # haddock... - - ${CABAL} v2-haddock $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + - if [ $HCNUMVER -lt 70600 ] || [ $HCNUMVER -ge 70800 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi -# REGENDATA ["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"] +# REGENDATA ("0.9.20200125",["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"]) # EOF diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,16 @@ +4.19 [2020.02.03] +----------------- +* Support building with GHC 8.10. +* The types of `_TupE` and `_UnboxedTupE` are now `Prism' Exp [Maybe Exp]` + when built against `template-haskell-2.16` or later to reflect the new + types of `TupE` and `UnboxedTupE`. +* Add `_ForallVisT` and `_BytesPrimL` prisms when building against + `template-haskell-2.16` or later. +* Make `<>~` and `<>=` and their ` 700) +#endif + +#ifndef MIN_VERSION_reflection +#define MIN_VERSION_reflection(x,y,z) 1 +#endif + +#ifndef MIN_VERSION_template_haskell +#define MIN_VERSION_template_haskell(x,y,z) 1 +#endif + +#ifndef MIN_VERSION_vector +#define MIN_VERSION_vector(x,y,z) 1 +#endif + #endif diff --git a/lens-properties/lens-properties.cabal b/lens-properties/lens-properties.cabal --- a/lens-properties/lens-properties.cabal +++ b/lens-properties/lens-properties.cabal @@ -21,7 +21,8 @@ , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 - , GHC == 8.8.1 + , GHC == 8.8.2 + , GHC == 8.10.1 extra-source-files: .hlint.yaml diff --git a/lens.cabal b/lens.cabal --- a/lens.cabal +++ b/lens.cabal @@ -1,6 +1,6 @@ name: lens category: Data, Lenses, Generics -version: 4.18.1 +version: 4.19 license: BSD2 cabal-version: 1.18 license-file: LICENSE @@ -20,7 +20,8 @@ , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 - , GHC == 8.8.1 + , GHC == 8.8.2 + , GHC == 8.10.1 synopsis: Lenses, Folds and Traversals description: This package comes \"Batteries Included\" with many useful lenses for the types @@ -128,7 +129,7 @@ custom-setup setup-depends: - Cabal >= 1.10 && <3.1, + Cabal >= 1.10 && <3.3, base >= 4.5 && <5, cabal-doctest >= 1 && <1.1, filepath @@ -219,25 +220,28 @@ reflection >= 2.1 && < 3, semigroupoids >= 5 && < 6, tagged >= 0.4.4 && < 1, - template-haskell >= 2.4 && < 2.16, + template-haskell >= 2.4 && < 2.17, th-abstraction >= 0.3 && < 0.4, text >= 0.11 && < 1.3, transformers >= 0.2 && < 0.6, transformers-compat >= 0.4 && < 1, - type-equality >= 1 && < 2, unordered-containers >= 0.2.4 && < 0.3, vector >= 0.9 && < 0.13 - if impl(ghc < 8.0) + if !impl(ghc >= 8.0) build-depends: generic-deriving >= 1.10 && < 2, semigroups >= 0.8.4 && < 1 - if impl(ghc < 7.9) + if !impl(ghc >= 7.10) build-depends: nats >= 0.1 && < 1.2, void >= 0.5 && < 1 + if !impl(ghc >= 7.8) + build-depends: + type-equality >= 1 && < 2 + exposed-modules: Control.Exception.Lens Control.Lens @@ -324,6 +328,7 @@ Numeric.Natural.Lens other-modules: + Control.Lens.Internal.Prelude Paths_lens if flag(safe) @@ -342,9 +347,12 @@ if impl(ghc<7.4) ghc-options: -fno-spec-constr-count - -- hack around the buggy unused matches check for class associated types in ghc 8 rc1 + if impl(ghc >= 7.10) + ghc-options: -fno-warn-trustworthy-safe + if impl(ghc >= 8) - ghc-options: -Wno-missing-pattern-synonym-signatures -Wno-unused-matches + ghc-options: -Wno-missing-pattern-synonym-signatures + ghc-options: -Wno-redundant-constraints if flag(j) && impl(ghc>=7.8) ghc-options: -j4 @@ -462,6 +470,7 @@ default-language: Haskell2010 build-depends: base, + base-compat >=0.11.0 && <0.12, comonad, criterion, deepseq, diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs --- a/src/Control/Exception/Lens.hs +++ b/src/Control/Exception/Lens.hs @@ -14,17 +14,12 @@ {-# LANGUAGE ViewPatterns #-} #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - -#ifndef MIN_VERSION_exceptions -#define MIN_VERSION_exceptions 1 -#endif +#include "lens-common.h" #if !(MIN_VERSION_exceptions(0,4,0)) #define MonadThrow MonadCatch #endif + ----------------------------------------------------------------------------- -- | -- Module : Control.Exception.Lens @@ -268,7 +263,7 @@ {-# INLINE catching #-} -- | Catch exceptions that match a given 'Prism' (or any 'Getter'), discarding --- the information about the match. This is particuarly useful when you have +-- the information about the match. This is particularly useful when you have -- a @'Prism'' e ()@ where the result of the 'Prism' or 'Fold' isn't -- particularly valuable, just the fact that it matches. -- diff --git a/src/Control/Lens/At.hs b/src/Control/Lens/At.hs --- a/src/Control/Lens/At.hs +++ b/src/Control/Lens/At.hs @@ -14,17 +14,8 @@ {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 711 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -#endif - -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" -#ifndef MIN_VERSION_containers -#define MIN_VERSION_containers(x,y,z) 1 -#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.At @@ -52,7 +43,10 @@ , icontains ) where +import Prelude () + import Control.Lens.Each +import Control.Lens.Internal.Prelude import Control.Lens.Traversal import Control.Lens.Lens import Control.Lens.Setter @@ -69,7 +63,6 @@ import Data.Int import Data.IntMap as IntMap import Data.IntSet as IntSet -import Data.List.NonEmpty as NonEmpty import Data.Map as Map import Data.Set as Set import Data.Sequence as Seq @@ -81,10 +74,6 @@ import Data.Vector.Storable as Storable import Data.Vector.Unboxed as Unboxed hiding (indexed) import Data.Word - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif type family Index (s :: *) :: * type instance Index (e -> a) = e diff --git a/src/Control/Lens/Each.hs b/src/Control/Lens/Each.hs --- a/src/Control/Lens/Each.hs +++ b/src/Control/Lens/Each.hs @@ -10,9 +10,8 @@ {-# LANGUAGE Trustworthy #-} #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" + ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Each @@ -29,17 +28,18 @@ Each(..) ) where +import Prelude () + import Control.Lens.Traversal import Control.Lens.Internal.ByteString +import Control.Lens.Internal.Prelude import Data.Array.Unboxed as Unboxed import Data.Array.IArray as IArray import Data.ByteString as StrictB import Data.ByteString.Lazy as LazyB import Data.Complex -import Data.Functor.Identity import Data.HashMap.Lazy as HashMap import Data.IntMap as IntMap -import Data.List.NonEmpty import Data.Map as Map import Data.Sequence as Seq import Data.Text.Lens (text) @@ -55,10 +55,6 @@ import qualified Data.Vector.Unboxed as Unboxed import Data.Vector.Unboxed (Unbox) import Data.Word - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif -- $setup -- >>> :set -XNoOverloadedStrings diff --git a/src/Control/Lens/Empty.hs b/src/Control/Lens/Empty.hs --- a/src/Control/Lens/Empty.hs +++ b/src/Control/Lens/Empty.hs @@ -28,12 +28,14 @@ #endif ) where +import Prelude () + import Control.Lens.Iso #if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Fold #endif -import Control.Applicative (ZipList(..)) import Control.Lens.Prism +import Control.Lens.Internal.Prelude as Prelude import Control.Lens.Review import Data.ByteString as StrictB import Data.ByteString.Lazy as LazyB @@ -41,10 +43,9 @@ import Data.HashSet as HashSet import Data.IntMap as IntMap import Data.IntSet as IntSet +import Data.Monoid import Data.Map as Map import Data.Maybe -import Data.Monoid -import Data.Profunctor.Unsafe import qualified Data.Sequence as Seq import Data.Set as Set import Data.Text as StrictT diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs --- a/src/Control/Lens/Fold.hs +++ b/src/Control/Lens/Fold.hs @@ -4,16 +4,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ConstraintKinds #-} - -#ifndef MIN_VERSION_reflection -#define MIN_VERSION_reflection(x,y,z) 1 -#endif - {-# LANGUAGE Trustworthy #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif +#include "lens-common.h" {-# OPTIONS_GHC -fno-warn-orphans #-} ---------------------------------------------------------------------------- -- | @@ -150,7 +143,8 @@ , foldMapByOf ) where -import Control.Applicative as Applicative +import Prelude () + import Control.Applicative.Backwards import Control.Comonad import Control.Lens.Getter @@ -158,31 +152,22 @@ import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Control.Lens.Internal.Magma +import Control.Lens.Internal.Prelude import Control.Lens.Type import Control.Monad as Monad import Control.Monad.Reader import Control.Monad.State import Data.CallStack -import Data.Foldable import Data.Functor.Apply hiding ((<.)) -import Data.Functor.Compose -import Data.Functor.Contravariant import Data.Int (Int64) import Data.List (intercalate) -import Data.Maybe -import Data.Monoid -import Data.Profunctor -import Data.Profunctor.Rep -import Data.Profunctor.Sieve -import Data.Profunctor.Unsafe +import Data.Maybe (fromMaybe) +import Data.Monoid (First (..), All (..), Any (..)) #if MIN_VERSION_reflection(2,1,0) import Data.Reflection #endif -import Data.Traversable -import Prelude hiding (foldr) import qualified Data.Semigroup as Semi -import Data.List.NonEmpty (NonEmpty(..)) -- $setup -- >>> :set -XNoOverloadedStrings @@ -195,6 +180,7 @@ -- >>> import Control.DeepSeq (NFData (..), force) -- >>> import Control.Exception (evaluate) -- >>> import Data.Maybe (fromMaybe) +-- >>> import Data.Monoid (Sum (..)) -- >>> import System.Timeout (timeout) -- >>> import qualified Data.Map as Map -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f @@ -1102,7 +1088,7 @@ -- 'asumOf' :: 'Alternative' f => 'Prism'' s (f a) -> s -> f a -- @ asumOf :: Alternative f => Getting (Endo (f a)) s (f a) -> s -> f a -asumOf l = foldrOf l (<|>) Applicative.empty +asumOf l = foldrOf l (<|>) empty {-# INLINE asumOf #-} -- | The sum of a collection of actions, generalizing 'concatOf'. diff --git a/src/Control/Lens/Getter.hs b/src/Control/Lens/Getter.hs --- a/src/Control/Lens/Getter.hs +++ b/src/Control/Lens/Getter.hs @@ -16,9 +16,6 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Getter @@ -54,10 +51,9 @@ -- A common question is whether you can combine multiple 'Getter's to -- retrieve multiple values. Recall that all 'Getter's are 'Fold's and that -- we have a @'Monoid' m => 'Applicative' ('Const' m)@ instance to play --- with. Knowing this, we can use @'Data.Monoid.<>'@ to glue 'Fold's +-- with. Knowing this, we can use @'Data.Semigroup.<>'@ to glue 'Fold's -- together: -- --- >>> import Data.Monoid -- >>> (1, 2, 3, 4, 5) ^.. (_2 <> _3 <> _5) -- [2,3,5] -- @@ -90,15 +86,14 @@ , Const(..) ) where -import Control.Applicative +import Prelude () + import Control.Lens.Internal.Indexed +import Control.Lens.Internal.Prelude import Control.Lens.Type import Control.Monad.Reader.Class as Reader import Control.Monad.State as State -import Control.Monad.Writer as Writer -import Data.Functor.Contravariant -import Data.Profunctor -import Data.Profunctor.Unsafe +import Control.Monad.Writer (MonadWriter (..)) -- $setup -- >>> :set -XNoOverloadedStrings diff --git a/src/Control/Lens/Indexed.hs b/src/Control/Lens/Indexed.hs --- a/src/Control/Lens/Indexed.hs +++ b/src/Control/Lens/Indexed.hs @@ -12,13 +12,8 @@ {-# LANGUAGE Trustworthy #-} -- vector, hashable #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" -#ifndef MIN_VERSION_containers -#define MIN_VERSION_containers(x,y,z) 1 -#endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Indexed @@ -81,7 +76,8 @@ , itraverseByOf ) where -import Control.Applicative +import Prelude () + import Control.Applicative.Backwards import Control.Comonad.Cofree import Control.Comonad.Trans.Traced @@ -94,6 +90,7 @@ import Control.Lens.Getter import Control.Lens.Internal.Fold import Control.Lens.Internal.Indexed +import Control.Lens.Internal.Prelude import Control.Lens.Internal.Level import Control.Lens.Internal.Magma import Control.Lens.Setter @@ -102,34 +99,23 @@ import Data.Array (Array) import qualified Data.Array as Array import Data.Foldable -import Data.Functor.Compose -import Data.Functor.Contravariant +import Data.Functor.Constant (Constant (..)) import Data.Functor.Product import Data.Functor.Reverse import Data.Functor.Sum import Data.HashMap.Lazy as HashMap import Data.IntMap as IntMap import Data.Ix (Ix) -import Data.List.NonEmpty as NonEmpty import Data.Map as Map import Data.Monoid hiding (Sum, Product) -import Data.Profunctor.Unsafe -import Data.Proxy import Data.Reflection import Data.Sequence hiding ((:<), index) -import Data.Tagged import Data.Tree import Data.Tuple (swap) import Data.Vector (Vector) -import Data.Void import qualified Data.Vector as V import GHC.Generics -import Prelude -#if !(MIN_VERSION_base(4,8,0)) -import Data.Traversable (sequenceA) -#endif - #ifdef HLINT {-# ANN module "HLint: ignore Use fmap" #-} #endif @@ -609,6 +595,30 @@ instance TraversableWithIndex () Identity where itraverse f (Identity a) = Identity <$> f () a + {-# INLINE itraverse #-} + +instance FunctorWithIndex Void (Const e) where + imap _ (Const a) = Const a + {-# INLINE imap #-} + +instance FoldableWithIndex Void (Const e) where + ifoldMap _ _ = mempty + {-# INLINE ifoldMap #-} + +instance TraversableWithIndex Void (Const e) where + itraverse _ (Const a) = pure (Const a) + {-# INLINE itraverse #-} + +instance FunctorWithIndex Void (Constant e) where + imap _ (Constant a) = Constant a + {-# INLINE imap #-} + +instance FoldableWithIndex Void (Constant e) where + ifoldMap _ _ = mempty + {-# INLINE ifoldMap #-} + +instance TraversableWithIndex Void (Constant e) where + itraverse _ (Constant a) = pure (Constant a) {-# INLINE itraverse #-} instance FunctorWithIndex k ((,) k) where diff --git a/src/Control/Lens/Internal/Bazaar.hs b/src/Control/Lens/Internal/Bazaar.hs --- a/src/Control/Lens/Internal/Bazaar.hs +++ b/src/Control/Lens/Internal/Bazaar.hs @@ -29,22 +29,16 @@ , BazaarT1(..), BazaarT1' ) where -import Control.Applicative +import Prelude () + import Control.Arrow as Arrow -import Control.Category +import qualified Control.Category as C import Control.Comonad +import Control.Lens.Internal.Prelude import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed import Data.Functor.Apply -import Data.Functor.Compose -import Data.Functor.Contravariant -import Data.Functor.Identity -import Data.Semigroup -import Data.Profunctor import Data.Profunctor.Rep -import Data.Profunctor.Sieve -import Data.Profunctor.Unsafe -import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- Bizarre @@ -91,7 +85,7 @@ instance Conjoined p => IndexedComonad (Bazaar p) where iextract (Bazaar m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} - iduplicate (Bazaar m) = getCompose $ m (Compose #. distrib sell . sell) + iduplicate (Bazaar m) = getCompose $ m (Compose #. distrib sell C.. sell) {-# INLINE iduplicate #-} instance Corepresentable p => Sellable p (Bazaar p) where @@ -172,7 +166,7 @@ instance Conjoined p => IndexedComonad (BazaarT p g) where iextract (BazaarT m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} - iduplicate (BazaarT m) = getCompose $ m (Compose #. distrib sell . sell) + iduplicate (BazaarT m) = getCompose $ m (Compose #. distrib sell C.. sell) {-# INLINE iduplicate #-} instance Corepresentable p => Sellable p (BazaarT p g) where @@ -283,7 +277,7 @@ instance Conjoined p => IndexedComonad (Bazaar1 p) where iextract (Bazaar1 m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} - iduplicate (Bazaar1 m) = getCompose $ m (Compose #. distrib sell . sell) + iduplicate (Bazaar1 m) = getCompose $ m (Compose #. distrib sell C.. sell) {-# INLINE iduplicate #-} instance Corepresentable p => Sellable p (Bazaar1 p) where @@ -350,7 +344,7 @@ instance Conjoined p => IndexedComonad (BazaarT1 p g) where iextract (BazaarT1 m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} - iduplicate (BazaarT1 m) = getCompose $ m (Compose #. distrib sell . sell) + iduplicate (BazaarT1 m) = getCompose $ m (Compose #. distrib sell C.. sell) {-# INLINE iduplicate #-} instance Corepresentable p => Sellable p (BazaarT1 p g) where diff --git a/src/Control/Lens/Internal/ByteString.hs b/src/Control/Lens/Internal/ByteString.hs --- a/src/Control/Lens/Internal/ByteString.hs +++ b/src/Control/Lens/Internal/ByteString.hs @@ -7,13 +7,7 @@ {-# LANGUAGE Trustworthy #-} #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - -#ifndef MIN_VERSION_bytestring -#define MIN_VERSION_bytestring(x,y,z) 1 -#endif +#include "lens-common.h" ----------------------------------------------------------------------------- -- | @@ -35,14 +29,13 @@ , unpackLazy8, traversedLazy8 ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif +import Prelude () import Control.Lens.Type import Control.Lens.Getter import Control.Lens.Fold import Control.Lens.Indexed +import Control.Lens.Internal.Prelude import Control.Lens.Setter import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 @@ -54,7 +47,6 @@ import Data.Char import Data.Int (Int64) import Data.Word (Word8) -import Data.Monoid import Foreign.Ptr import Foreign.Storable #if MIN_VERSION_base(4,8,0) diff --git a/src/Control/Lens/Internal/Context.hs b/src/Control/Lens/Internal/Context.hs --- a/src/Control/Lens/Internal/Context.hs +++ b/src/Control/Lens/Internal/Context.hs @@ -28,19 +28,15 @@ , PretextT(..), PretextT' ) where -import Control.Applicative +import Prelude () + import Control.Arrow -import Control.Category +import qualified Control.Category as C import Control.Comonad import Control.Comonad.Store.Class import Control.Lens.Internal.Indexed -import Data.Functor.Compose -import Data.Functor.Contravariant -import Data.Functor.Identity -import Data.Profunctor +import Control.Lens.Internal.Prelude import Data.Profunctor.Rep -import Data.Profunctor.Sieve -import Data.Profunctor.Unsafe import Prelude hiding ((.),id) ------------------------------------------------------------------------------ @@ -229,7 +225,7 @@ instance Conjoined p => IndexedComonad (Pretext p) where iextract (Pretext m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} - iduplicate (Pretext m) = getCompose $ m (Compose #. distrib sell . sell) + iduplicate (Pretext m) = getCompose $ m (Compose #. distrib sell C.. sell) {-# INLINE iduplicate #-} instance (a ~ b, Conjoined p) => Comonad (Pretext p a b) where @@ -309,7 +305,7 @@ instance Conjoined p => IndexedComonad (PretextT p g) where iextract (PretextT m) = runIdentity $ m (arr Identity) {-# INLINE iextract #-} - iduplicate (PretextT m) = getCompose $ m (Compose #. distrib sell . sell) + iduplicate (PretextT m) = getCompose $ m (Compose #. distrib sell C.. sell) {-# INLINE iduplicate #-} instance (a ~ b, Conjoined p) => Comonad (PretextT p g a b) where diff --git a/src/Control/Lens/Internal/Deque.hs b/src/Control/Lens/Internal/Deque.hs --- a/src/Control/Lens/Internal/Deque.hs +++ b/src/Control/Lens/Internal/Deque.hs @@ -3,10 +3,8 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Deque @@ -26,28 +24,21 @@ , singleton ) where -import Control.Applicative +import Prelude () + import Control.Lens.Cons import Control.Lens.Fold import Control.Lens.Indexed hiding ((<.>)) +import Control.Lens.Internal.Prelude hiding (null) import Control.Lens.Iso import Control.Lens.Lens import Control.Lens.Prism import Control.Monad -#if MIN_VERSION_base(4,8,0) -import Data.Foldable hiding (null) -import qualified Data.Foldable as Foldable -#else -import Data.Foldable as Foldable -#endif +import Data.Foldable (toList) import Data.Function import Data.Functor.Bind import Data.Functor.Plus import Data.Functor.Reverse -import Data.Traversable as Traversable -import Data.Semigroup -import Data.Profunctor.Unsafe -import Prelude hiding (null) -- | A Banker's deque based on Chris Okasaki's \"Purely Functional Data Structures\" data Deque a = BD !Int [a] !Int [a] @@ -85,7 +76,7 @@ -- >>> fromList [1,2] -- BD 1 [1] 1 [2] fromList :: [a] -> Deque a -fromList = Prelude.foldr cons empty +fromList = foldr cons empty {-# INLINE fromList #-} instance Eq a => Eq (Deque a) where @@ -116,8 +107,8 @@ instance Alt Deque where xs ys - | size xs < size ys = Foldable.foldr cons ys xs - | otherwise = Foldable.foldl snoc xs ys + | size xs < size ys = foldr cons ys xs + | otherwise = foldl snoc xs ys {-# INLINE () #-} instance Plus Deque where @@ -128,8 +119,8 @@ empty = BD 0 [] 0 [] {-# INLINE empty #-} xs <|> ys - | size xs < size ys = Foldable.foldr cons ys xs - | otherwise = Foldable.foldl snoc xs ys + | size xs < size ys = foldr cons ys xs + | otherwise = foldl snoc xs ys {-# INLINE (<|>) #-} instance Reversing (Deque a) where @@ -172,16 +163,16 @@ instance Semigroup (Deque a) where xs <> ys - | size xs < size ys = Foldable.foldr cons ys xs - | otherwise = Foldable.foldl snoc xs ys + | size xs < size ys = foldr cons ys xs + | otherwise = foldl snoc xs ys {-# INLINE (<>) #-} instance Monoid (Deque a) where mempty = BD 0 [] 0 [] {-# INLINE mempty #-} mappend xs ys - | size xs < size ys = Foldable.foldr cons ys xs - | otherwise = Foldable.foldl snoc xs ys + | size xs < size ys = foldr cons ys xs + | otherwise = foldl snoc xs ys {-# INLINE mappend #-} -- | Check that a 'Deque' satisfies the balance invariants and rebalance if not. diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs --- a/src/Control/Lens/Internal/Exception.hs +++ b/src/Control/Lens/Internal/Exception.hs @@ -12,9 +12,8 @@ {-# LANGUAGE RoleAnnotations #-} #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" + ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Exception diff --git a/src/Control/Lens/Internal/FieldTH.hs b/src/Control/Lens/Internal/FieldTH.hs --- a/src/Control/Lens/Internal/FieldTH.hs +++ b/src/Control/Lens/Internal/FieldTH.hs @@ -30,9 +30,12 @@ , HasFieldClasses ) where +import Prelude () + import Control.Lens.At import Control.Lens.Fold import Control.Lens.Internal.TH +import Control.Lens.Internal.Prelude import Control.Lens.Lens import Control.Lens.Plated import Control.Lens.Prism @@ -40,7 +43,6 @@ import Control.Lens.Getter import Control.Lens.Tuple import Control.Lens.Traversal -import Control.Applicative import Control.Monad import Control.Monad.State import Language.Haskell.TH.Lens @@ -49,14 +51,13 @@ import Data.Maybe (isJust,maybeToList) import Data.List (nub, findIndices) import Data.Either (partitionEithers) -import Data.Semigroup +import Data.Semigroup (Any (..)) import Data.Set.Lens import Data.Map ( Map ) import Data.Set ( Set ) import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.Traversable as T -import Prelude ------------------------------------------------------------------------ -- Field generation entry point @@ -608,7 +609,7 @@ -- | Name to give to generated field optics. data DefName - = TopName Name -- ^ Simple top-level definiton name + = TopName Name -- ^ Simple top-level definition name | MethodName Name Name -- ^ makeFields-style class name and method name deriving (Show, Eq, Ord) diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs --- a/src/Control/Lens/Internal/Fold.hs +++ b/src/Control/Lens/Internal/Fold.hs @@ -32,14 +32,13 @@ , NonEmptyDList(..) ) where -import Control.Applicative +import Prelude () + import Control.Lens.Internal.Getter +import Control.Lens.Internal.Prelude import Data.Functor.Bind -import Data.Functor.Contravariant -import Data.Maybe -import Data.Semigroup hiding (Min, getMin, Max, getMax) +import Data.Maybe (fromMaybe) import Data.Reflection -import Prelude import qualified Data.List.NonEmpty as NonEmpty diff --git a/src/Control/Lens/Internal/Getter.hs b/src/Control/Lens/Internal/Getter.hs --- a/src/Control/Lens/Internal/Getter.hs +++ b/src/Control/Lens/Internal/Getter.hs @@ -18,16 +18,14 @@ , AlongsideRight(..) ) where -import Control.Applicative +import Prelude () + +import Control.Lens.Internal.Prelude import Data.Bifoldable import Data.Bifunctor import Data.Bitraversable -import Data.Foldable -import Data.Functor.Contravariant import Data.Semigroup.Foldable import Data.Semigroup.Traversable -import Data.Traversable -import Prelude -- | The 'mempty' equivalent for a 'Contravariant' 'Applicative' 'Functor'. noEffect :: (Contravariant f, Applicative f) => f a diff --git a/src/Control/Lens/Internal/Indexed.hs b/src/Control/Lens/Internal/Indexed.hs --- a/src/Control/Lens/Internal/Indexed.hs +++ b/src/Control/Lens/Internal/Indexed.hs @@ -39,27 +39,20 @@ , asIndex ) where -import Control.Applicative +import Prelude () + import Control.Arrow as Arrow -import Control.Category +import qualified Control.Category as C import Control.Comonad +import Control.Lens.Internal.Prelude import Control.Lens.Internal.Instances () -import Control.Monad import Control.Monad.Fix import Data.Distributive import Data.Functor.Bind -import Data.Functor.Contravariant import Data.Int -import Data.Monoid import Data.Profunctor.Closed -import Data.Profunctor import Data.Profunctor.Rep -import Data.Profunctor.Sieve -import qualified Data.Semigroup as Semi -import Data.Traversable -import Prelude hiding ((.),id) #ifndef SAFE -import Data.Profunctor.Unsafe import Control.Lens.Internal.Coerce #endif @@ -202,7 +195,7 @@ second' = second {-# INLINE second' #-} -instance Category (Indexed i) where +instance C.Category (Indexed i) where id = Indexed (const id) {-# INLINE id #-} Indexed f . Indexed g = Indexed $ \i -> f i . g i @@ -278,10 +271,10 @@ (j, ff) -> (j, contramap f ff) {-# INLINE contramap #-} -instance Semi.Semigroup (f a) => Semi.Semigroup (Indexing f a) where +instance Semigroup (f a) => Semigroup (Indexing f a) where Indexing mx <> Indexing my = Indexing $ \i -> case mx i of (j, x) -> case my j of - ~(k, y) -> (k, x Semi.<> y) + ~(k, y) -> (k, x <> y) {-# INLINE (<>) #-} -- | diff --git a/src/Control/Lens/Internal/Level.hs b/src/Control/Lens/Internal/Level.hs --- a/src/Control/Lens/Internal/Level.hs +++ b/src/Control/Lens/Internal/Level.hs @@ -26,16 +26,10 @@ , Flows(..) ) where -import Control.Applicative -import Control.Category -import Control.Comonad -import Data.Foldable +import Prelude () + +import Control.Lens.Internal.Prelude import Data.Functor.Apply -import Data.Int -import Data.Semigroup -import Data.Traversable -import Data.Word -import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- Levels diff --git a/src/Control/Lens/Internal/Magma.hs b/src/Control/Lens/Internal/Magma.hs --- a/src/Control/Lens/Internal/Magma.hs +++ b/src/Control/Lens/Internal/Magma.hs @@ -34,21 +34,14 @@ , runTakingWhile ) where -import Control.Applicative -import Control.Category +import Prelude () + import Control.Comonad import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed -import Data.Foldable +import Control.Lens.Internal.Prelude import Data.Functor.Apply -import Data.Functor.Contravariant -import Data.Monoid -import Data.Profunctor.Rep -import Data.Profunctor.Sieve -import Data.Profunctor.Unsafe -import Data.Traversable -import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- Magma diff --git a/src/Control/Lens/Internal/Prelude.hs b/src/Control/Lens/Internal/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/Control/Lens/Internal/Prelude.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} +#include "lens-common.h" +-- | Module which does most common imports (and related CPP) +-- needed across the lens library. +-- +-- This module is intended to stay in other-modules of lens, +-- perfectly we'd just use @base-compat-batteries@ +-- and not reinvent the wheel. +-- That's a reason why this module is different from +-- other .Internal modules, which are exposed-modules. +-- +-- Also this is a "fat" Prelude, re-exporting commonly used, +-- non conflicting symbols. +-- +module Control.Lens.Internal.Prelude + ( module Prelude + , Semigroup (..) + , Monoid (..) + , Foldable, foldMap, foldr, foldl, foldl', elem, null, length, traverse_ + , Traversable (..) + , Applicative (..) + , (&), (<&>), (<$>), (<$) + -- * Data types + , ZipList (..) + , NonEmpty (..) + -- * Functors + , Identity (..) + , Compose (..) + , Const (..) + -- * Control.Applicative + , Alternative (..), WrappedMonad (..) +#if !MIN_VERSION_base(4,10,0) + , liftA2 +#endif + -- * Data.Contravariant + , Contravariant (..), phantom + -- * Data.Monoid + , Endo (..), Dual (..) + -- * Data.Profunctor + , Profunctor (..) + , Choice (..), Cochoice (..) + , Strong (..), Costrong (..) + , Corepresentable (..) + , Sieve (..), Cosieve (..) + -- * Data.Proxy + , Proxy (..) + -- * Data.Tagged + , Tagged (..) + -- * Data.Void + , Void, absurd + -- * Data.Word + , Word + ) where + +import Prelude hiding + ( userError -- hiding something always helps with CPP +#if MIN_VERSION_base(4,8,0) + , Applicative (..) + , Foldable (..) + , Traversable (..) + , Monoid (..) + , (<$>), (<$) +#else + , foldr, foldl, length, elem, null + , mapM, sequence +#endif +#if MIN_VERSION_base(4,13,0) + , Semigroup (..) +#endif +#if MIN_VERSION_base(4,8,0) + , Word +#endif + ) + +-- Prelude +import Control.Applicative (Applicative (..), (<$>), (<$)) -- N.B. liftA2 +import Data.Foldable (Foldable, foldMap, elem, foldr, foldl, foldl', traverse_) -- N.B. we don't define Foldable instances, so this way is makes less CPP +import Data.Monoid (Monoid (..)) +import Data.Semigroup (Semigroup (..)) +import Data.Traversable (Traversable (..)) +import Data.Word (Word) + +-- Extras +#if MIN_VERSION_base(4,8,0) +import Data.Function ((&)) +import Data.Foldable (length, null) +#endif + +#if !MIN_VERSION_base(4,10,0) +import Control.Applicative (liftA2) +#endif + +#if MIN_VERSION_base(4,11,0) +import Data.Functor ((<&>)) +#endif + +import Control.Applicative (Alternative (..), Const (..), WrappedMonad (..), ZipList (..)) +import Data.Functor.Compose (Compose (..)) +import Data.Functor.Contravariant (Contravariant (..), phantom) +import Data.Functor.Identity (Identity (..)) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Monoid (Endo (..), Dual (..)) +import Data.Profunctor (Strong (..), Choice (..), Cochoice (..), Costrong (..)) +import Data.Profunctor.Rep (Corepresentable (..)) -- N.B. no Representable +import Data.Profunctor.Sieve (Sieve (..), Cosieve (..)) +import Data.Profunctor.Unsafe (Profunctor (..)) +import Data.Proxy (Proxy (..)) +import Data.Tagged (Tagged (..)) +import Data.Void (Void, absurd) + +-- $setup +-- >>> import Control.Lens +-- >>> import Control.Monad.State +-- >>> import Debug.SimpleReflect.Expr +-- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g,h) +-- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f +-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g +-- >>> let h :: Expr -> Expr -> Expr; h = Debug.SimpleReflect.Vars.h + +#if !(MIN_VERSION_base(4,8,0)) +-- | Passes the result of the left side to the function on the right side (forward pipe operator). +-- +-- This is the flipped version of ('$'), which is more common in languages like F# as (@|>@) where it is needed +-- for inference. Here it is supplied for notational convenience and given a precedence that allows it +-- to be nested inside uses of ('$'). +-- +-- >>> a & f +-- f a +-- +-- >>> "hello" & length & succ +-- 6 +-- +-- This combinator is commonly used when applying multiple 'Lens' operations in sequence. +-- +-- >>> ("hello","world") & _1.element 0 .~ 'j' & _1.element 4 .~ 'y' +-- ("jelly","world") +-- +-- This reads somewhat similar to: +-- +-- >>> flip execState ("hello","world") $ do _1.element 0 .= 'j'; _1.element 4 .= 'y' +-- ("jelly","world") +(&) :: a -> (a -> b) -> b +a & f = f a +{-# INLINE (&) #-} +infixl 1 & + +null :: Foldable t => t a -> Bool +null = foldr (\_ _ -> False) True + +length :: Foldable t => t a -> Int +length = foldl' (\c _ -> c+1) 0 +#endif + +#if !(MIN_VERSION_base(4,11,0)) +-- | Infix flipped 'fmap'. +-- +-- @ +-- ('<&>') = 'flip' 'fmap' +-- @ +(<&>) :: Functor f => f a -> (a -> b) -> f b +as <&> f = f <$> as +{-# INLINE (<&>) #-} +infixl 1 <&> +#endif diff --git a/src/Control/Lens/Internal/Prism.hs b/src/Control/Lens/Internal/Prism.hs --- a/src/Control/Lens/Internal/Prism.hs +++ b/src/Control/Lens/Internal/Prism.hs @@ -14,9 +14,11 @@ , Market' ) where -import Data.Profunctor +import Prelude () + +import Control.Lens.Internal.Prelude + #ifndef SAFE -import Data.Profunctor.Unsafe import Control.Lens.Internal.Coerce #endif diff --git a/src/Control/Lens/Internal/PrismTH.hs b/src/Control/Lens/Internal/PrismTH.hs --- a/src/Control/Lens/Internal/PrismTH.hs +++ b/src/Control/Lens/Internal/PrismTH.hs @@ -3,13 +3,8 @@ {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif +#include "lens-common.h" -#ifndef MIN_VERSION_template_haskell -#define MIN_VERSION_template_haskell(x,y,z) 1 -#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.PrismTH diff --git a/src/Control/Lens/Internal/Setter.hs b/src/Control/Lens/Internal/Setter.hs --- a/src/Control/Lens/Internal/Setter.hs +++ b/src/Control/Lens/Internal/Setter.hs @@ -20,15 +20,11 @@ Settable(..) ) where -import Control.Applicative +import Prelude () + import Control.Applicative.Backwards +import Control.Lens.Internal.Prelude import Data.Distributive -import Data.Functor.Compose -import Data.Functor.Identity -import Data.Profunctor -import Data.Profunctor.Unsafe -import Data.Traversable -import Prelude ----------------------------------------------------------------------------- -- Settable diff --git a/src/Control/Lens/Internal/TH.hs b/src/Control/Lens/Internal/TH.hs --- a/src/Control/Lens/Internal/TH.hs +++ b/src/Control/Lens/Internal/TH.hs @@ -7,17 +7,8 @@ # endif #endif -#ifndef MIN_VERSION_template_haskell -#define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706) -#endif - -#ifndef MIN_VERSION_containers -#define MIN_VERSION_containers(x,y,z) 1 -#endif +#include "lens-common.h" -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.TH diff --git a/src/Control/Lens/Internal/Zoom.hs b/src/Control/Lens/Internal/Zoom.hs --- a/src/Control/Lens/Internal/Zoom.hs +++ b/src/Control/Lens/Internal/Zoom.hs @@ -4,10 +4,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE Trustworthy #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif - {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | @@ -34,15 +30,12 @@ , EffectRWS(..) ) where -import Control.Applicative -import Control.Category -import Control.Comonad +import Prelude () + +import Control.Lens.Internal.Prelude import Control.Monad.Reader as Reader import Control.Monad.Trans.Free import Data.Functor.Bind -import Data.Functor.Contravariant -import Data.Semigroup -import Prelude hiding ((.),id) ------------------------------------------------------------------------------ -- Focusing diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs --- a/src/Control/Lens/Iso.hs +++ b/src/Control/Lens/Iso.hs @@ -14,9 +14,7 @@ {-# LANGUAGE TypeInType #-} #endif -#ifndef MIN_VERSION_bytestring -#define MIN_VERSION_bytestring(x,y,z) 1 -#endif +#include "lens-common.h" ----------------------------------------------------------------------------- -- | diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs --- a/src/Control/Lens/Lens.hs +++ b/src/Control/Lens/Lens.hs @@ -10,13 +10,7 @@ {-# LANGUAGE TypeInType #-} #endif -#ifndef MIN_VERSION_mtl -#define MIN_VERSION_mtl(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif +#include "lens-common.h" ------------------------------------------------------------------------------- -- | @@ -132,10 +126,12 @@ , fusing ) where -import Control.Applicative +import Prelude () + import Control.Arrow import Control.Comonad import Control.Lens.Internal.Context +import Control.Lens.Internal.Prelude import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Control.Lens.Type @@ -143,20 +139,7 @@ import Data.Functor.Apply import Data.Functor.Reverse import Data.Functor.Yoneda -import Data.Monoid -import Data.Profunctor -import Data.Profunctor.Rep -import Data.Profunctor.Sieve -import Data.Profunctor.Unsafe import Data.Semigroup.Traversable -import Data.Void -import Prelude -#if MIN_VERSION_base(4,8,0) -import Data.Function ((&)) -#endif -#if MIN_VERSION_base(4,11,0) -import Data.Functor ((<&>)) -#endif #if __GLASGOW_HASKELL__ >= 800 import GHC.Exts (TYPE) #endif @@ -171,6 +154,7 @@ -- >>> import Control.Monad.State -- >>> import Data.Char (chr) -- >>> import Data.List.NonEmpty (NonEmpty ((:|))) +-- >>> import Data.Monoid (Sum (..)) -- >>> import Data.Tree (Tree (Node)) -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g,h) @@ -352,47 +336,6 @@ -- General Purpose Combinators ------------------------------------------------------------------------------- - -#if !(MIN_VERSION_base(4,8,0)) --- | Passes the result of the left side to the function on the right side (forward pipe operator). --- --- This is the flipped version of ('$'), which is more common in languages like F# as (@|>@) where it is needed --- for inference. Here it is supplied for notational convenience and given a precedence that allows it --- to be nested inside uses of ('$'). --- --- >>> a & f --- f a --- --- >>> "hello" & length & succ --- 6 --- --- This combinator is commonly used when applying multiple 'Lens' operations in sequence. --- --- >>> ("hello","world") & _1.element 0 .~ 'j' & _1.element 4 .~ 'y' --- ("jelly","world") --- --- This reads somewhat similar to: --- --- >>> flip execState ("hello","world") $ do _1.element 0 .= 'j'; _1.element 4 .= 'y' --- ("jelly","world") -(&) :: a -> (a -> b) -> b -a & f = f a -{-# INLINE (&) #-} -infixl 1 & -#endif - -#if !(MIN_VERSION_base(4,11,0)) --- | Infix flipped 'fmap'. --- --- @ --- ('<&>') = 'flip' 'fmap' --- @ -(<&>) :: Functor f => f a -> (a -> b) -> f b -as <&> f = f <$> as -{-# INLINE (<&>) #-} -infixl 1 <&> -#endif - -- | This is convenient to 'flip' argument order of composite functions defined as: -- -- @ @@ -887,7 +830,7 @@ l <<&&~ b = l $ \a -> (a, b && a) {-# INLINE (<<&&~) #-} --- | Modify the target of a monoidally valued 'Lens' by 'mappend'ing a new value and return the old value. +-- | Modify the target of a monoidally valued 'Lens' by using ('<>') a new value and return the old value. -- -- When you do not need the old value, ('Control.Lens.Setter.<>~') is more flexible. -- @@ -898,11 +841,11 @@ -- ("Bond",("James","Bond, 007")) -- -- @ --- ('<<<>~') :: 'Monoid' r => 'Lens'' s r -> r -> s -> (r, s) --- ('<<<>~') :: 'Monoid' r => 'Iso'' s r -> r -> s -> (r, s) +-- ('<<<>~') :: 'Semigroup' r => 'Lens'' s r -> r -> s -> (r, s) +-- ('<<<>~') :: 'Semigroup' r => 'Iso'' s r -> r -> s -> (r, s) -- @ -(<<<>~) :: Monoid r => LensLike' ((,) r) s r -> r -> s -> (r, s) -l <<<>~ b = l $ \a -> (a, a `mappend` b) +(<<<>~) :: Semigroup r => LensLike' ((,) r) s r -> r -> s -> (r, s) +l <<<>~ b = l $ \a -> (a, a <> b) {-# INLINE (<<<>~) #-} ------------------------------------------------------------------------------- @@ -1217,17 +1160,17 @@ l <<&&= b = l %%= \a -> (a, a && b) {-# INLINE (<<&&=) #-} --- | Modify the target of a 'Lens' into your 'Monad''s state by 'mappend'ing a value +-- | Modify the target of a 'Lens' into your 'Monad''s state by using ('<>') -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>=') is more flexible. -- -- @ --- ('<<<>=') :: ('MonadState' s m, 'Monoid' r) => 'Lens'' s r -> r -> m r --- ('<<<>=') :: ('MonadState' s m, 'Monoid' r) => 'Iso'' s r -> r -> m r +-- ('<<<>=') :: ('MonadState' s m, 'Semigroup' r) => 'Lens'' s r -> r -> m r +-- ('<<<>=') :: ('MonadState' s m, 'Semigroup' r) => 'Iso'' s r -> r -> m r -- @ -(<<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,) r) s r -> r -> m r -l <<<>= b = l %%= \a -> (a, a `mappend` b) +(<<<>=) :: (MonadState s m, Semigroup r) => LensLike' ((,) r) s r -> r -> m r +l <<<>= b = l %%= \a -> (a, a <> b) {-# INLINE (<<<>=) #-} -- | Run a monadic action, and set the target of 'Lens' to its result. @@ -1246,20 +1189,20 @@ return b {-# INLINE (<<~) #-} --- | 'mappend' a monoidal value onto the end of the target of a 'Lens' and +-- | ('<>') a 'Semigroup' value onto the end of the target of a 'Lens' and -- return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>~') is more flexible. -(<<>~) :: Monoid m => LensLike ((,)m) s t m m -> m -> s -> (m, t) -l <<>~ m = l <%~ (`mappend` m) +(<<>~) :: Semigroup m => LensLike ((,)m) s t m m -> m -> s -> (m, t) +l <<>~ m = l <%~ (<> m) {-# INLINE (<<>~) #-} --- | 'mappend' a monoidal value onto the end of the target of a 'Lens' into +-- | ('<>') a 'Semigroup' value onto the end of the target of a 'Lens' into -- your 'Monad''s state and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>=') is more flexible. -(<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,)r) s r -> r -> m r -l <<>= r = l <%= (`mappend` r) +(<<>=) :: (MonadState s m, Semigroup r) => LensLike' ((,)r) s r -> r -> m r +l <<>= r = l <%= (<> r) {-# INLINE (<<>=) #-} ------------------------------------------------------------------------------ diff --git a/src/Control/Lens/Plated.hs b/src/Control/Lens/Plated.hs --- a/src/Control/Lens/Plated.hs +++ b/src/Control/Lens/Plated.hs @@ -10,6 +10,10 @@ {-# LANGUAGE PolyKinds #-} -- gplate1 #endif +#ifdef TRUSTWORTHY +{-# LANGUAGE Trustworthy #-} -- template-haskell +#endif + #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-} #define OVERLAPPING_PRAGMA @@ -17,25 +21,8 @@ #define OVERLAPPING_PRAGMA {-# OVERLAPPING #-} #endif -#ifdef TRUSTWORTHY -{-# LANGUAGE Trustworthy #-} -- template-haskell -#endif - -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif - -#ifndef MIN_VERSION_template_haskell -#define MIN_VERSION_template_haskell(x,y,z) 1 -#endif - -#ifndef MIN_VERSION_free -#define MIN_VERSION_free(x,y,z) 1 -#endif +#include "lens-common.h" -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Plated @@ -110,13 +97,15 @@ ) where -import Control.Applicative +import Prelude () + import Control.Comonad.Cofree import qualified Control.Comonad.Trans.Cofree as CoTrans import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Indexed import Control.Lens.Internal.Context +import Control.Lens.Internal.Prelude import Control.Lens.Type import Control.Lens.Setter import Control.Lens.Traversal @@ -129,7 +118,6 @@ import qualified Language.Haskell.TH as TH import Data.Data import Data.Data.Lens -import Data.Monoid import Data.Tree import GHC.Generics diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs --- a/src/Control/Lens/Prism.hs +++ b/src/Control/Lens/Prism.hs @@ -5,9 +5,7 @@ {-# LANGUAGE Trustworthy #-} #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" ------------------------------------------------------------------------------- -- | diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs --- a/src/Control/Lens/Setter.hs +++ b/src/Control/Lens/Setter.hs @@ -5,9 +5,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Trustworthy #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Setter @@ -79,9 +76,11 @@ , mapOf ) where -import Control.Applicative +import Prelude () + import Control.Arrow import Control.Comonad +import Control.Lens.Internal.Prelude import Control.Lens.Internal.Indexed import Control.Lens.Internal.Setter import Control.Lens.Type @@ -89,14 +88,6 @@ import Control.Monad.Reader.Class as Reader import Control.Monad.State.Class as State import Control.Monad.Writer.Class as Writer -import Data.Functor.Contravariant -import Data.Functor.Identity -import Data.Monoid -import Data.Profunctor -import Data.Profunctor.Rep -import Data.Profunctor.Sieve -import Data.Profunctor.Unsafe -import Prelude #ifdef HLINT {-# ANN module "HLint: ignore Avoid lambda" #-} @@ -107,7 +98,9 @@ -- >>> import Control.Lens -- >>> import Control.Monad.State -- >>> import Data.Char +-- >>> import Data.Functor.Contravariant (Predicate (..), Op (..)) -- >>> import Data.Map as Map +-- >>> import Data.Semigroup (Sum (..), Product (..)) -- >>> import Debug.SimpleReflect.Expr as Expr -- >>> import Debug.SimpleReflect.Vars as Vars -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f @@ -1043,7 +1036,7 @@ return b {-# INLINE (')@. -- -- >>> (Sum a,b) & _1 <>~ Sum c -- (Sum {getSum = a + c},b) @@ -1055,16 +1048,16 @@ -- ("hello!!!","world!!!") -- -- @ --- ('<>~') :: 'Monoid' a => 'Setter' s t a a -> a -> s -> t --- ('<>~') :: 'Monoid' a => 'Iso' s t a a -> a -> s -> t --- ('<>~') :: 'Monoid' a => 'Lens' s t a a -> a -> s -> t --- ('<>~') :: 'Monoid' a => 'Traversal' s t a a -> a -> s -> t +-- ('<>~') :: 'Semigroup' a => 'Setter' s t a a -> a -> s -> t +-- ('<>~') :: 'Semigroup' a => 'Iso' s t a a -> a -> s -> t +-- ('<>~') :: 'Semigroup' a => 'Lens' s t a a -> a -> s -> t +-- ('<>~') :: 'Semigroup' a => 'Traversal' s t a a -> a -> s -> t -- @ -(<>~) :: Monoid a => ASetter s t a a -> a -> s -> t -l <>~ n = over l (`mappend` n) +(<>~) :: Semigroup a => ASetter s t a a -> a -> s -> t +l <>~ n = over l (<> n) {-# INLINE (<>~) #-} --- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by 'mappend'ing a value. +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<>')@. -- -- >>> execState (do _1 <>= Sum c; _2 <>= Product d) (Sum a,Product b) -- (Sum {getSum = a + c},Product {getProduct = b * d}) @@ -1073,12 +1066,12 @@ -- ("hello!!!","world!!!") -- -- @ --- ('<>=') :: ('MonadState' s m, 'Monoid' a) => 'Setter'' s a -> a -> m () --- ('<>=') :: ('MonadState' s m, 'Monoid' a) => 'Iso'' s a -> a -> m () --- ('<>=') :: ('MonadState' s m, 'Monoid' a) => 'Lens'' s a -> a -> m () --- ('<>=') :: ('MonadState' s m, 'Monoid' a) => 'Traversal'' s a -> a -> m () +-- ('<>=') :: ('MonadState' s m, 'Semigroup' a) => 'Setter'' s a -> a -> m () +-- ('<>=') :: ('MonadState' s m, 'Semigroup' a) => 'Iso'' s a -> a -> m () +-- ('<>=') :: ('MonadState' s m, 'Semigroup' a) => 'Lens'' s a -> a -> m () +-- ('<>=') :: ('MonadState' s m, 'Semigroup' a) => 'Traversal'' s a -> a -> m () -- @ -(<>=) :: (MonadState s m, Monoid a) => ASetter' s a -> a -> m () +(<>=) :: (MonadState s m, Semigroup a) => ASetter' s a -> a -> m () l <>= a = State.modify (l <>~ a) {-# INLINE (<>=) #-} diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs --- a/src/Control/Lens/TH.hs +++ b/src/Control/Lens/TH.hs @@ -8,13 +8,8 @@ # endif #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" -#ifndef MIN_VERSION_template_haskell -#define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706) -#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.TH @@ -84,9 +79,8 @@ , abbreviatedNamer ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif +import Prelude () + #if !(MIN_VERSION_template_haskell(2,7,0)) import Control.Monad (ap) #endif @@ -99,6 +93,7 @@ import Control.Lens.Setter import Control.Lens.Tuple import Control.Lens.Traversal +import Control.Lens.Internal.Prelude as Prelude import Control.Lens.Internal.TH import Control.Lens.Internal.FieldTH import Control.Lens.Internal.PrismTH @@ -106,11 +101,10 @@ import Control.Lens.Type () -- haddocks import Data.Char (toLower, toUpper, isUpper) import Data.Foldable hiding (concat, any) -import Data.List as List +import qualified Data.List as List import qualified Data.Map as Map import Data.Map (Map) import Data.Maybe (maybeToList) -import Data.Monoid import qualified Data.Set as Set import Data.Set (Set) import Data.Set.Lens @@ -682,7 +676,7 @@ camelCaseNamer :: FieldNamer camelCaseNamer tyName fields field = maybeToList $ do - fieldPart <- stripPrefix expectedPrefix (nameBase field) + fieldPart <- List.stripPrefix expectedPrefix (nameBase field) method <- computeMethod fieldPart let cls = "Has" ++ fieldPart return (MethodName (mkName cls) (mkName method)) @@ -690,7 +684,7 @@ where expectedPrefix = optUnderscore ++ overHead toLower (nameBase tyName) - optUnderscore = ['_' | any (isPrefixOf "_" . nameBase) fields ] + optUnderscore = ['_' | any (List.isPrefixOf "_" . nameBase) fields ] computeMethod (x:xs) | isUpper x = Just (toLower x : xs) computeMethod _ = Nothing @@ -709,7 +703,7 @@ -- | A 'FieldNamer' for 'classUnderscoreNoPrefixFields'. classUnderscoreNoPrefixNamer :: FieldNamer classUnderscoreNoPrefixNamer _ _ field = maybeToList $ do - fieldUnprefixed <- stripPrefix "_" (nameBase field) + fieldUnprefixed <- List.stripPrefix "_" (nameBase field) let className = "Has" ++ overHead toUpper fieldUnprefixed methodName = fieldUnprefixed return (MethodName (mkName className) (mkName methodName)) @@ -735,11 +729,11 @@ return (MethodName (mkName cls) (mkName method)) where - stripMaxLc f = do x <- stripPrefix optUnderscore f + stripMaxLc f = do x <- List.stripPrefix optUnderscore f case break isUpper x of (p,s) | List.null p || List.null s -> Nothing | otherwise -> Just s - optUnderscore = ['_' | any (isPrefixOf "_" . nameBase) fields ] + optUnderscore = ['_' | any (List.isPrefixOf "_" . nameBase) fields ] computeMethod (x:xs) | isUpper x = Just (toLower x : xs) computeMethod _ = Nothing diff --git a/src/Control/Lens/Traversal.hs b/src/Control/Lens/Traversal.hs --- a/src/Control/Lens/Traversal.hs +++ b/src/Control/Lens/Traversal.hs @@ -8,9 +8,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE ConstraintKinds #-} -#ifndef MIN_VERSION_containers -#define MIN_VERSION_containers(x,y,z) 1 -#endif +#include "lens-common.h" + ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Traversal @@ -129,56 +128,41 @@ , confusing ) where -import Control.Applicative as Applicative +import Prelude () + import Control.Applicative.Backwards -import Control.Category +import qualified Control.Category as C import Control.Comonad import Control.Lens.Fold import Control.Lens.Getter (Getting, IndexedGetting, getting) import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context -import Control.Lens.Internal.Indexed import Control.Lens.Internal.Fold +import Control.Lens.Internal.Indexed +import Control.Lens.Internal.Prelude import Control.Lens.Lens import Control.Lens.Setter (ASetter, AnIndexedSetter, isets, sets) import Control.Lens.Type -import Control.Monad import Control.Monad.Trans.State.Lazy import Data.Bitraversable import Data.CallStack import Data.Functor.Apply -import Data.Functor.Compose import Data.Functor.Day.Curried import Data.Functor.Yoneda import Data.Int -import Data.IntMap as IntMap -import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.IntMap as IntMap import qualified Data.Map as Map import Data.Map (Map) +import Data.Monoid (Any (..)) import Data.Sequence (Seq, mapWithIndex) import Data.Vector as Vector (Vector, imap) -import Data.Monoid (Any (..), Endo (..)) -import Data.Profunctor -import Data.Profunctor.Rep -import Data.Profunctor.Sieve -import Data.Profunctor.Unsafe +import Data.Profunctor.Rep (Representable (..)) import Data.Reflection import Data.Semigroup.Traversable import Data.Semigroup.Bitraversable -import Data.Traversable import Data.Tuple (swap) import GHC.Magic (inline) -import Prelude hiding ((.),id) -#if !(MIN_VERSION_base(4,8,0)) -import Data.Foldable (Foldable) -import Data.Monoid (Monoid (..)) -#endif - -#if !(MIN_VERSION_base(4,11,0)) -import Data.Semigroup (Semigroup (..)) -#endif - -- $setup -- >>> :set -XNoOverloadedStrings -XFlexibleContexts -- >>> import Data.Char (toUpper) @@ -645,7 +629,7 @@ (w:ws) -> unsafeOuts b . (:ws) <$> afb w [] -> unsafeOuts b . return <$> afb (error "singular: empty traversal")) (\pafb s -> let b = l sell s in case pins b of - (w:ws) -> unsafeOuts b . (:Prelude.map extract ws) <$> cosieve pafb w + (w:ws) -> unsafeOuts b . (:map extract ws) <$> cosieve pafb w [] -> unsafeOuts b . return <$> cosieve pafb (error "singular: empty traversal")) {-# INLINE singular #-} @@ -693,11 +677,11 @@ pins = getConst #. bazaar (cotabulate $ \ra -> Const [ra]) {-# INLINE pins #-} -parr :: (Profunctor p, Category p) => (a -> b) -> p a b -parr f = lmap f id +parr :: (Profunctor p, C.Category p) => (a -> b) -> p a b +parr f = lmap f C.id {-# INLINE parr #-} -outs :: (Bizarre p w, Category p) => w a a t -> [a] -> t +outs :: (Bizarre p w, C.Category p) => w a a t -> [a] -> t outs = evalState `rmap` bazaar (parr (state . unconsWithDefault)) {-# INLINE outs #-} @@ -773,11 +757,11 @@ runHoles (runBazaar1 (f sell xs) (cotabulate holeInOne1)) id {-# INLINE holes1Of #-} -holeInOne1 :: forall p a t. (Corepresentable p, Category p) +holeInOne1 :: forall p a t. (Corepresentable p, C.Category p) => Corep p a -> Holes t (NonEmptyDList (Pretext p a a t)) a holeInOne1 x = Holes $ \xt -> ( NonEmptyDList (fmap xt (cosieve sell x) :|) - , cosieve (id :: p a a) x) + , cosieve (C.id :: p a a) x) -- We are very careful to share as much structure as possible among -- the results (in the common case where the traversal allows for such). @@ -1175,7 +1159,7 @@ -- | 'IndexedTraversal' of the element with the smallest index. traverseMin :: IndexedTraversal' k (m v) v -instance TraverseMin Int IntMap where +instance TraverseMin Int IntMap.IntMap where traverseMin f m = case IntMap.minViewWithKey m of #if MIN_VERSION_containers(0,5,0) Just ((k,a), _) -> indexed f k a <&> \v -> IntMap.updateMin (const (Just v)) m @@ -1196,7 +1180,7 @@ -- | 'IndexedTraversal' of the element at the largest index. traverseMax :: IndexedTraversal' k (m v) v -instance TraverseMax Int IntMap where +instance TraverseMax Int IntMap.IntMap where traverseMax f m = case IntMap.maxViewWithKey m of #if MIN_VERSION_containers(0,5,0) Just ((k,a), _) -> indexed f k a <&> \v -> IntMap.updateMax (const (Just v)) m @@ -1286,7 +1270,7 @@ failover :: Alternative m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t failover l afb s = case l ((,) (Any True) . afb) s of (Any True, t) -> pure t - (Any False, _) -> Applicative.empty + (Any False, _) -> empty {-# INLINE failover #-} -- | Try to map a function which uses the index over this 'IndexedTraversal', failing if the 'IndexedTraversal' has no targets. @@ -1297,7 +1281,7 @@ ifailover :: Alternative m => Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t ifailover l iafb s = case l ((,) (Any True) `rmap` Indexed iafb) s of (Any True, t) -> pure t - (Any False, _) -> Applicative.empty + (Any False, _) -> empty {-# INLINE ifailover #-} -- | Try the first 'Traversal' (or 'Fold'), falling back on the second 'Traversal' (or 'Fold') if it returns no entries. diff --git a/src/Control/Lens/Tuple.hs b/src/Control/Lens/Tuple.hs --- a/src/Control/Lens/Tuple.hs +++ b/src/Control/Lens/Tuple.hs @@ -14,9 +14,7 @@ {-# LANGUAGE PolyKinds #-} #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" ------------------------------------------------------------------------------- -- | @@ -56,17 +54,12 @@ , _17', _18', _19' ) where +import Prelude () import Control.Lens.Lens -import Data.Functor.Identity -import Data.Functor.Product -import Data.Profunctor (dimap) -import Data.Proxy (Proxy (Proxy)) +import Control.Lens.Internal.Prelude +import Data.Functor.Product (Product (..)) import GHC.Generics ((:*:) (..), Generic (..), K1 (..), M1 (..), U1 (..)) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif -- $setup -- >>> :set -XNoOverloadedStrings diff --git a/src/Control/Lens/Type.hs b/src/Control/Lens/Type.hs --- a/src/Control/Lens/Type.hs +++ b/src/Control/Lens/Type.hs @@ -13,9 +13,6 @@ {-# LANGUAGE TypeInType #-} #endif {-# LANGUAGE Trustworthy #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Type @@ -66,26 +63,22 @@ , Optic, Optic' ) where -import Control.Applicative +import Prelude () + +import Control.Lens.Internal.Prelude import Control.Lens.Internal.Setter import Control.Lens.Internal.Indexed import Data.Bifunctor -import Data.Functor.Identity -import Data.Functor.Contravariant import Data.Functor.Apply #if __GLASGOW_HASKELL__ >= 800 import Data.Kind #endif -import Data.Profunctor -import Data.Tagged -import Prelude () -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g,h) --- >>> import Prelude -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- >>> let h :: Expr -> Expr -> Expr; h = Debug.SimpleReflect.Vars.h diff --git a/src/Control/Lens/Unsound.hs b/src/Control/Lens/Unsound.hs --- a/src/Control/Lens/Unsound.hs +++ b/src/Control/Lens/Unsound.hs @@ -5,10 +5,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -#ifndef MIN_VERSION_mtl -#define MIN_VERSION_mtl(x,y,z) 1 -#endif - #if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif @@ -37,9 +33,9 @@ , adjoin ) where -import Control.Applicative import Control.Lens -import Prelude +import Control.Lens.Internal.Prelude +import Prelude () -- | A lens product. There is no law-abiding way to do this in general. -- Result is only a valid 'Lens' if the input lenses project disjoint parts of diff --git a/src/Control/Lens/Wrapped.hs b/src/Control/Lens/Wrapped.hs --- a/src/Control/Lens/Wrapped.hs +++ b/src/Control/Lens/Wrapped.hs @@ -23,9 +23,7 @@ {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +#include "lens-common.h" ----------------------------------------------------------------------------- -- | diff --git a/src/Control/Lens/Zoom.hs b/src/Control/Lens/Zoom.hs --- a/src/Control/Lens/Zoom.hs +++ b/src/Control/Lens/Zoom.hs @@ -7,14 +7,12 @@ {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -#ifndef MIN_VERSION_mtl -#define MIN_VERSION_mtl(x,y,z) 1 -#endif - #if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif +#include "lens-common.h" + ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Zoom @@ -32,8 +30,11 @@ , Zoomed ) where +import Prelude () + import Control.Lens.Getter import Control.Lens.Internal.Coerce +import Control.Lens.Internal.Prelude import Control.Lens.Internal.Zoom import Control.Lens.Type import Control.Monad @@ -51,9 +52,6 @@ import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Control.Monad.Trans.Free -import Data.Monoid -import Data.Profunctor.Unsafe -import Prelude #ifdef HLINT {-# ANN module "HLint: ignore Use fmap" #-} diff --git a/src/Control/Monad/Error/Lens.hs b/src/Control/Monad/Error/Lens.hs --- a/src/Control/Monad/Error/Lens.hs +++ b/src/Control/Monad/Error/Lens.hs @@ -63,7 +63,7 @@ {-# INLINE catching #-} -- | Catch exceptions that match a given 'Prism' (or any 'Getter'), discarding --- the information about the match. This is particuarly useful when you have +-- the information about the match. This is particularly useful when you have -- a @'Prism'' e ()@ where the result of the 'Prism' or 'Fold' isn't -- particularly valuable, just the fact that it matches. -- diff --git a/src/Control/Parallel/Strategies/Lens.hs b/src/Control/Parallel/Strategies/Lens.hs --- a/src/Control/Parallel/Strategies/Lens.hs +++ b/src/Control/Parallel/Strategies/Lens.hs @@ -2,9 +2,9 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif -#ifndef MIN_VERSION_parallel -#define MIN_VERSION_parallel(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL > 700) -#endif + +#include "lens-common.h" + ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.Strategies.Lens diff --git a/src/Data/Bits/Lens.hs b/src/Data/Bits/Lens.hs --- a/src/Data/Bits/Lens.hs +++ b/src/Data/Bits/Lens.hs @@ -1,11 +1,6 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - ----------------------------------------------------------------------------- -- | -- Module : Data.Bits.Lens @@ -25,14 +20,14 @@ , bytewise ) where +import Prelude () + import Control.Lens +import Control.Lens.Internal.Prelude import Control.Monad.State import Data.Bits import Data.Word -#if !MIN_VERSION_base(4,8,0) -import Data.Functor -#endif -- $setup -- >>> :set -XNoOverloadedStrings @@ -278,9 +273,9 @@ -- If you supply this an 'Integer', the result will be an infinite 'Traversal', which -- can be productively consumed, but not reassembled. bits :: (Num b, Bits b) => IndexedTraversal' Int b Bool -bits f b = Prelude.foldr step 0 <$> traverse g bs where +bits f b = foldr step 0 <$> traverse g bs where g n = (,) n <$> indexed f n (testBit b n) - bs = Prelude.takeWhile hasBit [0..] + bs = takeWhile hasBit [0..] hasBit n = complementBit b n /= b -- test to make sure that complementing this bit actually changes the value step (n,True) r = setBit r n step _ r = r @@ -299,9 +294,9 @@ -- 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 +bytewise f b = foldr step 0 <$> traverse g bs where g n = (,) n <$> indexed f n (fromIntegral $ b `shiftR` (n*8)) - bs = Prelude.takeWhile hasByte [0..] + bs = takeWhile hasByte [0..] hasByte n = complementBit b (n*8) /= b step (n,x) r = r .|. (fromIntegral x `shiftL` (n*8)) {-# INLINE bytewise #-} diff --git a/src/Data/Complex/Lens.hs b/src/Data/Complex/Lens.hs --- a/src/Data/Complex/Lens.hs +++ b/src/Data/Complex/Lens.hs @@ -5,10 +5,6 @@ {-# LANGUAGE PatternSynonyms #-} #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - ----------------------------------------------------------------------------- -- | -- Module : Data.Complex.Lens @@ -37,12 +33,11 @@ #endif ) where +import Prelude () + import Control.Lens +import Control.Lens.Internal.Prelude import Data.Complex - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif -- $setup -- >>> import Debug.SimpleReflect diff --git a/src/Data/Data/Lens.hs b/src/Data/Data/Lens.hs --- a/src/Data/Data/Lens.hs +++ b/src/Data/Data/Lens.hs @@ -15,6 +15,12 @@ {-# LANGUAGE Trustworthy #-} #endif {-# OPTIONS_GHC -fno-full-laziness #-} +#if __GLASGOW_HASKELL__ >= 810 +-- Use -fbyte-code explicitly to ensure that -fobject-code isn't automatically +-- implied on GHCi 8.10+ by the use of UnboxedTuples, as this breaks the +-- doctests. See #874 for more details. +{-# OPTIONS_GHC -fbyte-code #-} +#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Data.Lens diff --git a/src/Data/List/Lens.hs b/src/Data/List/Lens.hs --- a/src/Data/List/Lens.hs +++ b/src/Data/List/Lens.hs @@ -1,11 +1,6 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - ----------------------------------------------------------------------------- -- | -- Module : Data.List.Lens @@ -99,13 +94,12 @@ , stripSuffix ) where +import Prelude () + import Control.Monad (guard) +import Control.Lens.Internal.Prelude import Control.Lens import Data.List - -#if !MIN_VERSION_base(4,8,0) -import Data.Functor -#endif -- $setup -- >>> :set -XNoOverloadedStrings diff --git a/src/Data/Map/Lens.hs b/src/Data/Map/Lens.hs --- a/src/Data/Map/Lens.hs +++ b/src/Data/Map/Lens.hs @@ -75,7 +75,7 @@ -- | Construct a map from a 'IndexedGetter', 'Control.Lens.Fold.IndexedFold', 'Control.Lens.Traversal.IndexedTraversal' or 'Control.Lens.Lens.IndexedLens' -- -- The construction is left-biased (see 'Data.Map.Lazy.union'), i.e. the first --- occurences of keys in the fold or traversal order are preferred. +-- occurrences of keys in the fold or traversal order are preferred. -- -- >>> toMapOf folded ["hello", "world"] -- fromList [(0,"hello"),(1,"world")] diff --git a/src/Data/Set/Lens.hs b/src/Data/Set/Lens.hs --- a/src/Data/Set/Lens.hs +++ b/src/Data/Set/Lens.hs @@ -1,14 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} -#ifndef MIN_VERSION_containers -#define MIN_VERSION_containers(x,y,z) 1 -#endif - {-# LANGUAGE Trustworthy #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif + +#include "lens-common.h" ----------------------------------------------------------------------------- -- | diff --git a/src/Data/Tree/Lens.hs b/src/Data/Tree/Lens.hs --- a/src/Data/Tree/Lens.hs +++ b/src/Data/Tree/Lens.hs @@ -1,9 +1,5 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif ----------------------------------------------------------------------------- -- | @@ -21,12 +17,11 @@ , branches ) where +import Prelude () + +import Control.Lens.Internal.Prelude import Control.Lens import Data.Tree - -#if !MIN_VERSION_base(4,8,0) -import Data.Functor -#endif -- | A 'Lens' that focuses on the root of a 'Tree'. -- diff --git a/src/Data/Typeable/Lens.hs b/src/Data/Typeable/Lens.hs --- a/src/Data/Typeable/Lens.hs +++ b/src/Data/Typeable/Lens.hs @@ -1,10 +1,5 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - ----------------------------------------------------------------------------- -- | -- Module : Data.Typeable.Lens @@ -20,13 +15,12 @@ , _gcast ) where +import Prelude () + import Control.Lens +import Control.Lens.Internal.Prelude +import Data.Maybe (fromMaybe) import Data.Typeable -import Data.Maybe - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif -- | A 'Traversal'' for working with a 'cast' of a 'Typeable' value. _cast :: (Typeable s, Typeable a) => Traversal' s a diff --git a/src/Data/Vector/Generic/Lens.hs b/src/Data/Vector/Generic/Lens.hs --- a/src/Data/Vector/Generic/Lens.hs +++ b/src/Data/Vector/Generic/Lens.hs @@ -5,9 +5,8 @@ {-# LANGUAGE Trustworthy #-} #endif -#ifndef MIN_VERSION_vector -#define MIN_VERSION_vector(x,y,z) 1 -#endif +#include "lens-common.h" + ------------------------------------------------------------------------------- -- | -- Module : Data.Vector.Generic.Lens diff --git a/src/Language/Haskell/TH/Lens.hs b/src/Language/Haskell/TH/Lens.hs --- a/src/Language/Haskell/TH/Lens.hs +++ b/src/Language/Haskell/TH/Lens.hs @@ -4,13 +4,8 @@ #endif {-# LANGUAGE Rank2Types #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-trustworthy-safe #-} -#endif +#include "lens-common.h" -#ifndef MIN_VERSION_template_haskell -#define MIN_VERSION_template_haskell(x,y,z) 1 -#endif ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.TH.Lens @@ -328,6 +323,9 @@ #if MIN_VERSION_template_haskell(2,11,0) , _CharPrimL #endif +#if MIN_VERSION_template_haskell(2,16,0) + , _BytesPrimL +#endif -- ** Pat Prisms , _LitP , _VarP @@ -385,6 +383,9 @@ , _AppKindT , _ImplicitParamT #endif +#if MIN_VERSION_template_haskell(2,16,0) + , _ForallVisT +#endif -- ** TyVarBndr Prisms , _PlainTV , _KindedTV @@ -555,14 +556,31 @@ instance HasTypeVars Type where typeVarsEx s f (VarT n) = VarT <$> typeVarsEx s f n typeVarsEx s f (AppT l r) = AppT <$> typeVarsEx s f l <*> typeVarsEx s f r + typeVarsEx s f (ForallT bs ctx ty) = ForallT bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f ty + where s' = s `Set.union` setOf typeVars bs + typeVarsEx _ _ t@ConT{} = pure t + typeVarsEx _ _ t@TupleT{} = pure t + typeVarsEx _ _ t@ListT{} = pure t + typeVarsEx _ _ t@ArrowT{} = pure t + typeVarsEx _ _ t@UnboxedTupleT{} = pure t #if MIN_VERSION_template_haskell(2,8,0) typeVarsEx s f (SigT t k) = SigT <$> typeVarsEx s f t <*> typeVarsEx s f k #else typeVarsEx s f (SigT t k) = (`SigT` k) <$> typeVarsEx s f t #endif - typeVarsEx s f (ForallT bs ctx ty) = ForallT bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f ty - where s' = s `Set.union` setOf typeVars bs +#if MIN_VERSION_template_haskell(2,8,0) + typeVarsEx _ _ t@PromotedT{} = pure t + typeVarsEx _ _ t@PromotedTupleT{} = pure t + typeVarsEx _ _ t@PromotedNilT{} = pure t + typeVarsEx _ _ t@PromotedConsT{} = pure t + typeVarsEx _ _ t@StarT{} = pure t + typeVarsEx _ _ t@ConstraintT{} = pure t + typeVarsEx _ _ t@LitT{} = pure t +#endif +#if MIN_VERSION_template_haskell(2,10,0) + typeVarsEx _ _ t@EqualityT{} = pure t +#endif #if MIN_VERSION_template_haskell(2,11,0) typeVarsEx s f (InfixT t1 n t2) = InfixT <$> typeVarsEx s f t1 <*> pure n @@ -571,13 +589,20 @@ <*> pure n <*> typeVarsEx s f t2 typeVarsEx s f (ParensT t) = ParensT <$> typeVarsEx s f t + typeVarsEx _ _ t@WildCardT{} = pure t #endif +#if MIN_VERSION_template_haskell(2,12,0) + typeVarsEx _ _ t@UnboxedSumT{} = pure t +#endif #if MIN_VERSION_template_haskell(2,15,0) typeVarsEx s f (AppKindT t k) = AppKindT <$> typeVarsEx s f t <*> typeVarsEx s f k typeVarsEx s f (ImplicitParamT n t) = ImplicitParamT n <$> typeVarsEx s f t #endif - typeVarsEx _ _ t = pure t +#if MIN_VERSION_template_haskell(2,16,0) + typeVarsEx s f (ForallVisT bs ty) = ForallVisT bs <$> typeVarsEx s' f ty + where s' = s `Set.union` setOf typeVars bs +#endif #if !MIN_VERSION_template_haskell(2,10,0) instance HasTypeVars Pred where @@ -624,22 +649,47 @@ substType m t@(VarT n) = fromMaybe t (m^.at n) substType m (ForallT bs ctx ty) = ForallT bs (substType m' ctx) (substType m' ty) where m' = foldrOf typeVars Map.delete m bs + substType _ t@ConT{} = t + substType _ t@TupleT{} = t + substType _ t@ListT{} = t + substType _ t@ArrowT{} = t + substType _ t@UnboxedTupleT{} = t + substType m (AppT l r) = AppT (substType m l) (substType m r) + substType m (SigT t k) = SigT (substType m t) #if MIN_VERSION_template_haskell(2,8,0) - substType m (SigT t k) = SigT (substType m t) (substType m k) + (substType m k) #else - substType m (SigT t k) = SigT (substType m t) k + k #endif - substType m (AppT l r) = AppT (substType m l) (substType m r) +#if MIN_VERSION_template_haskell(2,8,0) + substType _ t@PromotedT{} = t + substType _ t@PromotedTupleT{} = t + substType _ t@PromotedNilT{} = t + substType _ t@PromotedConsT{} = t + substType _ t@StarT{} = t + substType _ t@ConstraintT{} = t + substType _ t@LitT{} = t +#endif +#if MIN_VERSION_template_haskell(2,10,0) + substType _ t@EqualityT{} = t +#endif #if MIN_VERSION_template_haskell(2,11,0) substType m (InfixT t1 n t2) = InfixT (substType m t1) n (substType m t2) substType m (UInfixT t1 n t2) = UInfixT (substType m t1) n (substType m t2) substType m (ParensT t) = ParensT (substType m t) + substType _ t@WildCardT{} = t #endif +#if MIN_VERSION_template_haskell(2,12,0) + substType _ t@UnboxedSumT{} = t +#endif #if MIN_VERSION_template_haskell(2,15,0) substType m (AppKindT t k) = AppKindT (substType m t) (substType m k) substType m (ImplicitParamT n t) = ImplicitParamT n (substType m t) #endif - substType _ t = t +#if MIN_VERSION_template_haskell(2,16,0) + substType m (ForallVisT bs ty) = ForallVisT bs (substType m' ty) + where m' = foldrOf typeVars Map.delete m bs +#endif instance SubstType t => SubstType [t] where substType = map . substType @@ -697,13 +747,15 @@ #else VarStrictType #endif -conNamedFields f (RecC n fs) = RecC n <$> traverse f fs +conNamedFields _ c@NormalC{} = pure c +conNamedFields _ c@InfixC{} = pure c +conNamedFields f (RecC n fs) = RecC n <$> traverse f fs conNamedFields f (ForallC a b fs) = ForallC a b <$> conNamedFields f fs #if MIN_VERSION_template_haskell(2,11,0) +conNamedFields _ c@GadtC{} = pure c conNamedFields f (RecGadtC ns argTys retTy) = RecGadtC ns <$> traverse f argTys <*> pure retTy #endif -conNamedFields _ c = pure c -- Lenses and Prisms locFileName :: Lens' Loc String @@ -2062,15 +2114,32 @@ remitter _ = Nothing #endif +-- | +-- @ +-- _TupE :: 'Prism'' 'Exp' ['Maybe' 'Exp'] -- template-haskell-2.16+ +-- _TupE :: 'Prism'' 'Exp' ['Exp'] -- Earlier versions +-- @ +#if MIN_VERSION_template_haskell(2,16,0) +_TupE :: Prism' Exp [Maybe Exp] +#else _TupE :: Prism' Exp [Exp] +#endif _TupE = prism' reviewer remitter where reviewer = TupE - remitter (TupE x) = Just x remitter _ = Nothing +-- | +-- @ +-- _UnboxedTupE :: 'Prism'' 'Exp' ['Maybe' 'Exp'] -- template-haskell-2.16+ +-- _UnboxedTupE :: 'Prism'' 'Exp' ['Exp'] -- Earlier versions +-- @ +#if MIN_VERSION_template_haskell(2,16,0) +_UnboxedTupE :: Prism' Exp [Maybe Exp] +#else _UnboxedTupE :: Prism' Exp [Exp] +#endif _UnboxedTupE = prism' reviewer remitter where @@ -2424,6 +2493,16 @@ remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,16,0) +_BytesPrimL :: Prism' Lit Bytes +_BytesPrimL + = prism' reviewer remitter + where + reviewer = BytesPrimL + remitter (BytesPrimL x) = Just x + remitter _ = Nothing +#endif + _LitP :: Prism' Pat Lit _LitP = prism' reviewer remitter @@ -2763,6 +2842,16 @@ where reviewer (x, y) = ImplicitParamT x y remitter (ImplicitParamT x y) = Just (x, y) + remitter _ = Nothing +#endif + +#if MIN_VERSION_template_haskell(2,16,0) +_ForallVisT :: Prism' Type ([TyVarBndr], Type) +_ForallVisT + = prism' reviewer remitter + where + reviewer (x, y) = ForallVisT x y + remitter (ForallVisT x y) = Just (x, y) remitter _ = Nothing #endif diff --git a/src/System/Exit/Lens.hs b/src/System/Exit/Lens.hs --- a/src/System/Exit/Lens.hs +++ b/src/System/Exit/Lens.hs @@ -7,10 +7,6 @@ {-# LANGUAGE ViewPatterns #-} #endif -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - ----------------------------------------------------------------------------- -- | -- Module : System.Exit.Lens @@ -32,14 +28,13 @@ #endif ) where +import Prelude () + import Control.Exception import Control.Exception.Lens import Control.Lens +import Control.Lens.Internal.Prelude import System.Exit - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif -- | Exit codes that a program can return with: class AsExitCode t where diff --git a/src/System/FilePath/Lens.hs b/src/System/FilePath/Lens.hs --- a/src/System/FilePath/Lens.hs +++ b/src/System/FilePath/Lens.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE CPP #-} - -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - ----------------------------------------------------------------------------- -- | -- Module : System.FilePath.Lens @@ -23,9 +17,7 @@ , basename, directory, extension, filename ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif +import Prelude () import Control.Monad.State as State import System.FilePath @@ -34,6 +26,7 @@ , takeExtension, takeFileName ) +import Control.Lens.Internal.Prelude import Control.Lens hiding ((<.>)) -- $setup