on master help sign in
45 files changed+578−159
since splitsnapshots
unifiedsplit
.github/FUNDING.yml+12 .travis.yml+132−72 ChangeLog.md+12 LICENSE+1−1 cabal.haskell-ci+5 generic-lens.cabal+7−5 src/Data/GenericLens/Internal.hs+18−1 src/Data/Generics/Internal/Errors.hs+59 src/Data/Generics/Internal/Families.hs+1−1 src/Data/Generics/Internal/Families/Collect.hs+1−1 src/Data/Generics/Internal/Families/Has.hs+1−1 src/Data/Generics/Internal/GenericN.hs+3−2 src/Data/Generics/Internal/Profunctor/Iso.hs+2−1 src/Data/Generics/Internal/Profunctor/Lens.hs+2−1 src/Data/Generics/Internal/Profunctor/Prism.hs+2−1 src/Data/Generics/Internal/VL/Iso.hs+2−1 src/Data/Generics/Internal/VL/Lens.hs+2−1 src/Data/Generics/Internal/VL/Prism.hs+2−1 src/Data/Generics/Internal/VL/Traversal.hs+2−1 src/Data/Generics/Labels.hs+1−1 src/Data/Generics/Product.hs+1−1 src/Data/Generics/Product/Any.hs+2−2 src/Data/Generics/Product/Constraints.hs+1−1 src/Data/Generics/Product/Fields.hs+29−13 src/Data/Generics/Product/HList.hs+1−1 src/Data/Generics/Product/Internal/Constraints.hs+1−1 src/Data/Generics/Product/Internal/GLens.hs+1−1 src/Data/Generics/Product/Internal/HList.hs+1−1 src/Data/Generics/Product/Internal/Positions.hs+1−1 src/Data/Generics/Product/Internal/Subtype.hs+1−1 src/Data/Generics/Product/Param.hs+10−3 src/Data/Generics/Product/Positions.hs+34−10 src/Data/Generics/Product/Subtype.hs+43−3 src/Data/Generics/Product/Typed.hs+23−2 src/Data/Generics/Product/Types.hs+36−6 src/Data/Generics/Sum.hs+1−1 src/Data/Generics/Sum/Any.hs+2−2 src/Data/Generics/Sum/Constructors.hs+31−9 src/Data/Generics/Sum/Internal/Constructors.hs+1−1 src/Data/Generics/Sum/Internal/Subtype.hs+1−1 src/Data/Generics/Sum/Internal/Typed.hs+1−1 src/Data/Generics/Sum/Subtype.hs+38−2 src/Data/Generics/Sum/Typed.hs+33−2 src/Data/Generics/Wrapped.hs+1−1 test/Test71.hs+17
.github/FUNDING.ymlnew file+12
@@ -0,0 +1,12 @@
1+# These are supported funding model platforms
2+
3+github: [kcsongor] # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2]
4+patreon: # Replace with a single Patreon username
5+open_collective: # Replace with a single Open Collective username
6+ko_fi: # Replace with a single Ko-fi username
7+tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel
8+community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry
9+liberapay: # Replace with a single Liberapay username
10+issuehunt: # Replace with a single IssueHunt username
11+otechie: # Replace with a single Otechie username
12+custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2']
.travis.yml+132−72
@@ -1,95 +1,155 @@
11# This Travis job script has been generated by a script via
22#
3−# make_travis_yml_2.hs 'generic-lens.cabal'
3+# haskell-ci '--config=cabal.haskell-ci' 'cabal.project'
44#
5−# For more information, see https://github.com/hvr/multi-ghc-travis
5+# For more information, see https://github.com/haskell-CI/haskell-ci
6+#
7+# version: 0.5.20190908
68#
79language: c
8−sudo: false
9−
10+dist: xenial
1011git:
11− submodules: false # whether to recursively clone submodules
12−
12+ # whether to recursively clone submodules
13+ submodules: false
1314cache:
1415 directories:
1516 - $HOME/.cabal/packages
1617 - $HOME/.cabal/store
17−
1818before_cache:
19− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
19+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
2020 # remove files that are regenerated by 'cabal update'
21− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
22− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
23− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
24− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
25− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
26−
21+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
22+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
23+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
24+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
25+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
26+ - rm -rfv $CABALHOME/packages/head.hackage
2727matrix:
2828 include:
29− - compiler: "ghc-8.0.2"
30− # env: TEST=--disable-tests BENCH=--disable-benchmarks
31− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
32− - compiler: "ghc-8.2.1"
33− # env: TEST=--disable-tests BENCH=--disable-benchmarks
34− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}
35− - compiler: "ghc-8.2.2"
36− # env: TEST=--disable-tests BENCH=--disable-benchmarks
37− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
38− - compiler: "ghc-8.4.1"
39− # env: TEST=--disable-tests BENCH=--disable-benchmarks
40− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}
41−
29+ - compiler: ghc-8.8.1
30+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}
31+ - compiler: ghc-8.6.5
32+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}}
33+ - compiler: ghc-8.4.4
34+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}}
35+ - compiler: ghc-8.4.1
36+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.1","cabal-install-3.0"]}}
37+ - compiler: ghc-8.2.2
38+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}}
39+ - compiler: ghc-8.0.2
40+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}}
4241before_install:
43− - HC=${CC}
44− - HCPKG=${HC/ghc/ghc-pkg}
42+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
43+ - WITHCOMPILER="-w $HC"
44+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
45+ - HCPKG="$HC-pkg"
4546 - unset CC
46− - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
47−
47+ - CABAL=/opt/ghc/bin/cabal
48+ - CABALHOME=$HOME/.cabal
49+ - export PATH="$CABALHOME/bin:$PATH"
50+ - TOP=$(pwd)
51+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
52+ - echo $HCNUMVER
53+ - CABAL="$CABAL -vnormal+nowrap+markoutput"
54+ - set -o pipefail
55+ - |
56+ echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk
57+ echo 'BEGIN { state = "output"; }' >> .colorful.awk
58+ echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk
59+ echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk
60+ echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk
61+ echo ' if (state == "cabal") {' >> .colorful.awk
62+ echo ' print blue($0)' >> .colorful.awk
63+ echo ' } else {' >> .colorful.awk
64+ echo ' print $0' >> .colorful.awk
65+ echo ' }' >> .colorful.awk
66+ echo '}' >> .colorful.awk
67+ - cat .colorful.awk
68+ - |
69+ color_cabal_output () {
70+ awk -f $TOP/.colorful.awk
71+ }
72+ - echo text | color_cabal_output
4873install:
49− - cabal --version
74+ - ${CABAL} --version
5075 - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
51− - BENCH=${BENCH---enable-benchmarks}
52− - TEST=${TEST---enable-tests}
53− - HADDOCK=${HADDOCK-true}
54− - INSTALLED=${INSTALLED-true}
55− - travis_retry cabal update -v
56− - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
57− - rm -fv cabal.project.local
58− - "echo 'packages: .' > cabal.project"
59− - if [ -f "./configure.ac" ]; then
60− (cd "."; autoreconf -i);
61− fi
62− - rm -f cabal.project.freeze
63− - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
64− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
65− - rm -rf "."/.ghc.environment.* "."/dist
66− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
67−
68−# Here starts the actual work to be performed for the package under test;
69−# any command which exits with a non-zero exit code causes the build to fail.
76+ - TEST=--enable-tests
77+ - if [ $HCNUMVER -ge 80600 ] ; then TEST=--disable-tests ; fi
78+ - BENCH=--enable-benchmarks
79+ - if [ $HCNUMVER -ge 80800 ] ; then BENCH=--disable-benchmarks ; fi
80+ - HEADHACKAGE=false
81+ - rm -f $CABALHOME/config
82+ - |
83+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
84+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
85+ echo "write-ghc-environment-files: always" >> $CABALHOME/config
86+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
87+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
88+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
89+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
90+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
91+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
92+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
93+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
94+ echo "install-dirs user" >> $CABALHOME/config
95+ echo " prefix: $CABALHOME" >> $CABALHOME/config
96+ echo "repository hackage.haskell.org" >> $CABALHOME/config
97+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
98+ - |
99+ echo "program-default-options" >> $CABALHOME/config
100+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
101+ - cat $CABALHOME/config
102+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
103+ - travis_retry ${CABAL} v2-update -v
104+ # Generate cabal.project
105+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
106+ - touch cabal.project
107+ - |
108+ echo "packages: ." >> cabal.project
109+ - |
110+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(generic-lens)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
111+ - cat cabal.project || true
112+ - cat cabal.project.local || true
113+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
114+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output
115+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
116+ - rm cabal.project.freeze
117+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output
118+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output
70119script:
71− # test that source-distributions can be generated
72− - (cd "."; cabal sdist)
73− - mv "."/dist/generic-lens-*.tar.gz ${DISTDIR}/
74− - cd ${DISTDIR}
75− - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
76− - "echo 'packages: generic-lens-*/*.cabal' > cabal.project"
77− - "echo 'write-ghc-environment-files: always' >> cabal.project"
120+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
121+ # Packaging...
122+ - ${CABAL} v2-sdist all | color_cabal_output
123+ # Unpacking...
124+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
125+ - cd ${DISTDIR} || false
126+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
127+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
128+ - PKGDIR_generic_lens="$(find . -maxdepth 1 -type d -regex '.*/generic-lens-[0-9.]*')"
129+ # Generate cabal.project
130+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
131+ - touch cabal.project
132+ - |
133+ echo "packages: ${PKGDIR_generic_lens}" >> cabal.project
134+ - |
135+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(generic-lens)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
136+ - cat cabal.project || true
137+ - cat cabal.project.local || true
138+ # Building...
78139 # this builds all libraries and executables (without tests/benchmarks)
79− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
80−
81− # Build with installed constraints for packages in global-db
82− - if $INSTALLED; then
83− echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh;
84− else echo "Not building with installed constraints"; fi
85−
140+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
141+ # Building with tests and benchmarks...
86142 # build & run tests, build benchmarks
87− - cabal new-build -w ${HC} ${TEST} ${BENCH} all
88− - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
89−
90− # haddock
91− - rm -rf ./dist-newstyle
92− - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi
143+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
144+ # Testing...
145+ - if [ $HCNUMVER -lt 80600 ] ; then ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output ; fi
146+ # cabal check...
147+ - (cd ${PKGDIR_generic_lens} && ${CABAL} -vnormal check)
148+ # haddock...
149+ - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output
150+ # Building without installed constraints for packages in global-db...
151+ - rm -f cabal.project.local
152+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
93153
94−# REGENDATA ["generic-lens.cabal"]
154+# REGENDATA ["--config=cabal.haskell-ci","cabal.project"]
95155# EOF
ChangeLog.md+12
@@ -1,3 +1,15 @@
1+## 1.2.0.1
2+- Give HasAny/AsAny the same VTA behavior on 8.6 and 8.8 (Ryan Scott)
3+
4+## 1.2.0.0
5+- Add `HasTypesUsing` and `HasTypesCustom` for custom traversals (Lysxia)
6+- Improve type errors when no Generic instance is defined
7+- `types` now supports Text by default
8+
9+### Breaking API changes
10+- `HasType` now includes a reflexive case so that every type 'contains' itself (Matt Parsons)
11+- `AsSubtype` and `Subtype` now include a reflexive case so that every type is a subtype of itself
12+
113## 1.1.0.0
214- Fix regression in type inference for polymorphic optics
315- Add `HasField0`, `HasPosition0`, `AsConstructor0`, `HasField_`, `HasPositon_`, and `AsConstructor_` (Lysxia)
LICENSE+1−1
@@ -1,4 +1,4 @@
1−Copyright (c) 2018, Csongor Kiss
1+Copyright (c) 2019, Csongor Kiss
22
33All rights reserved.
44
cabal.haskell-cinew file+5
@@ -0,0 +1,5 @@
1+-- inspection tests fail
2+tests: <8.6
3+
4+-- blocked on vector-th-unbox
5+benchmarks: <8.8
generic-lens.cabal+7−5
@@ -1,5 +1,5 @@
11name: generic-lens
2−version: 1.1.0.0
2+version: 1.2.0.1
33synopsis: Generically derive traversals, lenses and prisms.
44description: This library uses GHC.Generics to derive efficient optics (traversals, lenses and prisms) for algebraic data types in a type-directed way, with a focus on good type inference and error messages when possible.
55
@@ -11,7 +11,7 @@ maintainer: kiss.csongor.kiss@gmail.com
1111category: Generics, Records, Lens
1212build-type: Simple
1313cabal-version: >= 1.10
14−Tested-With: GHC == 8.0.2, GHC == 8.2.1, GHC == 8.4.1, GHC == 8.4.3
14+Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1
1515
1616extra-source-files: ChangeLog.md
1717 , examples/StarWars.hs
@@ -56,6 +56,7 @@ library
5656 , Data.Generics.Internal.Families.Changing
5757 , Data.Generics.Internal.Families.Collect
5858 , Data.Generics.Internal.Families.Has
59+ , Data.Generics.Internal.Errors
5960 , Data.Generics.Internal.Void
6061
6162 , Data.Generics.Sum.Internal.Constructors
@@ -69,9 +70,10 @@ library
6970 , Data.Generics.Product.Internal.Constraints
7071 , Data.Generics.Product.Internal.HList
7172
72− build-depends: base >= 4.9 && <= 5.0
73− , profunctors >= 5.0 && <= 6.0
74− , tagged >= 0.8 && <= 0.9
73+ build-depends: base >= 4.9 && < 5
74+ , profunctors >= 5.0 && < 6.0
75+ , tagged >= 0.8 && < 1
76+ , text >= 1.2 && < 1.3
7577
7678 hs-source-dirs: src
7779 default-language: Haskell2010
src/Data/GenericLens/Internal.hs+18−1
@@ -1,7 +1,7 @@
11-----------------------------------------------------------------------------
22-- |
33-- Module : Data.GenericLens.Internal
4−-- Copyright : (C) 2018 Csongor Kiss
4+-- Copyright : (C) 2019 Csongor Kiss
55-- License : BSD3
66-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
77-- Stability : experimental
@@ -18,6 +18,7 @@ module Data.GenericLens.Internal
1818 , module Data.Generics.Internal.Families.Collect
1919 , module Data.Generics.Internal.Families.Has
2020 , module Data.Generics.Internal.Void
21+ , module Data.Generics.Internal.Errors
2122
2223 , module Data.Generics.Sum.Internal.Constructors
2324 , module Data.Generics.Sum.Internal.Typed
@@ -28,6 +29,14 @@ module Data.GenericLens.Internal
2829 , module Data.Generics.Product.Internal.Subtype
2930 , module Data.Generics.Product.Internal.Constraints
3031 , module Data.Generics.Product.Internal.HList
32+
33+ , module Data.Generics.Internal.GenericN
34+
35+ -- * van Laarhoven optics
36+ , module Data.Generics.Internal.VL.Iso
37+ , module Data.Generics.Internal.VL.Lens
38+ , module Data.Generics.Internal.VL.Prism
39+ , module Data.Generics.Internal.VL.Traversal
3140 ) where
3241
3342import Data.Generics.Internal.Families
@@ -35,6 +44,7 @@ import Data.Generics.Internal.Families.Changing
3544import Data.Generics.Internal.Families.Collect
3645import Data.Generics.Internal.Families.Has
3746import Data.Generics.Internal.Void
47+import Data.Generics.Internal.Errors
3848
3949import Data.Generics.Sum.Internal.Constructors
4050import Data.Generics.Sum.Internal.Typed
@@ -45,3 +55,10 @@ import Data.Generics.Product.Internal.GLens
4555import Data.Generics.Product.Internal.Subtype
4656import Data.Generics.Product.Internal.Constraints
4757import Data.Generics.Product.Internal.HList
58+
59+import Data.Generics.Internal.GenericN
60+
61+import Data.Generics.Internal.VL.Iso
62+import Data.Generics.Internal.VL.Lens
63+import Data.Generics.Internal.VL.Prism
64+import Data.Generics.Internal.VL.Traversal
src/Data/Generics/Internal/Errors.hsnew file+59
@@ -0,0 +1,59 @@
1+{-# LANGUAGE UndecidableInstances #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE KindSignatures #-}
4+{-# LANGUAGE PolyKinds #-}
5+{-# LANGUAGE DataKinds #-}
6+{-# LANGUAGE TypeOperators #-}
7+{-# LANGUAGE KindSignatures #-}
8+
9+-------------------------------------------------------------------------------
10+---- |
11+---- Module : Data.Generics.Internal.Errors
12+---- Copyright : (C) 2019 Csongor Kiss
13+---- License : BSD3
14+---- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
15+---- Stability : experimental
16+---- Portability : non-portable
17+----
18+---- Provide more legible type errors as described in
19+---- (https://kcsongor.github.io/report-stuck-families/)[this blog post].
20+-------------------------------------------------------------------------------
21+
22+module Data.Generics.Internal.Errors
23+ ( NoGeneric
24+ , Defined
25+ , Defined_list
26+
27+ , QuoteType
28+ , PrettyError
29+ ) where
30+
31+import GHC.Generics
32+import GHC.TypeLits
33+import Data.Kind
34+
35+type family NoGeneric (a :: Type) (ctxt :: [ErrorMessage]) :: Constraint where
36+ NoGeneric a ctxt = PrettyError ('Text "No instance for " ':<>: QuoteType (Generic a)
37+ ': ctxt)
38+type family PrettyError (ctxt :: [ErrorMessage]) :: k where
39+ PrettyError '[] = TypeError ('Text "")
40+ PrettyError (c ': cs) = TypeError ('Text "| " ':<>: c ':$$: PrettyLines cs)
41+
42+type family PrettyLines (ctxt :: [ErrorMessage]) :: ErrorMessage where
43+ PrettyLines '[] = 'Text ""
44+ PrettyLines (c ': cs) = 'Text "| " ':<>: c ':$$: PrettyLines cs
45+
46+type family Defined (break :: Type -> Type) (err :: Constraint) (a :: k) :: k where
47+ Defined Void1 _ _ = Any
48+ Defined _ _ k = k
49+
50+type family Defined_list (break :: [*]) (err :: Constraint) (a :: k) :: k where
51+ Defined_list '[Void] _ _ = Any
52+ Defined_list _ _ k = k
53+
54+data Void1 a
55+data Void
56+type family Any :: k
57+
58+type family QuoteType (typ :: k) :: ErrorMessage where
59+ QuoteType typ = 'Text "‘" ':<>: 'ShowType typ ':<>: 'Text "’"
src/Data/Generics/Internal/Families.hs+1−1
@@ -9,7 +9,7 @@
99-----------------------------------------------------------------------------
1010-- |
1111-- Module : Data.Generics.Internal.Families
12−-- Copyright : (C) 2018 Csongor Kiss
12+-- Copyright : (C) 2019 Csongor Kiss
1313-- License : BSD3
1414-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1515-- Stability : experimental
src/Data/Generics/Internal/Families/Collect.hs+1−1
@@ -7,7 +7,7 @@
77-----------------------------------------------------------------------------
88-- |
99-- Module : Data.Generics.Internal.Families.Collect
10−-- Copyright : (C) 2018 Csongor Kiss
10+-- Copyright : (C) 2019 Csongor Kiss
1111-- License : BSD3
1212-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1313-- Stability : experimental
src/Data/Generics/Internal/Families/Has.hs+1−1
@@ -7,7 +7,7 @@
77-----------------------------------------------------------------------------
88-- |
99-- Module : Data.Generics.Internal.Families.Has
10−-- Copyright : (C) 2018 Csongor Kiss
10+-- Copyright : (C) 2019 Csongor Kiss
1111-- License : BSD3
1212-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1313-- Stability : experimental
src/Data/Generics/Internal/GenericN.hs+3−2
@@ -1,3 +1,4 @@
1+{-# OPTIONS_HADDOCK hide #-}
12{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE FlexibleInstances #-}
@@ -11,9 +12,9 @@
1112--------------------------------------------------------------------------------
1213-- |
1314-- Module : Data.Generics.Internal.GenericN
14−-- Copyright : (C) 2018 Csongor Kiss
15−-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
15+-- Copyright : (C) 2019 Csongor Kiss
1616-- License : BSD3
17+-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1718-- Stability : experimental
1819-- Portability : non-portable
1920--
src/Data/Generics/Internal/Profunctor/Iso.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_HADDOCK hide #-}
12{-# LANGUAGE TupleSections #-}
23{-# LANGUAGE GADTs #-}
34{-# LANGUAGE NoMonomorphismRestriction #-}
@@ -10,7 +11,7 @@
1011-----------------------------------------------------------------------------
1112-- |
1213-- Module : Data.Generics.Internal.Profunctor.Iso
13−-- Copyright : (C) 2018 Csongor Kiss
14+-- Copyright : (C) 2019 Csongor Kiss
1415-- License : BSD3
1516-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1617-- Stability : experimental
src/Data/Generics/Internal/Profunctor/Lens.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_HADDOCK hide #-}
12{-# LANGUAGE GADTs #-}
23{-# LANGUAGE NoMonomorphismRestriction #-}
34{-# LANGUAGE Rank2Types #-}
@@ -10,7 +11,7 @@
1011-----------------------------------------------------------------------------
1112-- |
1213-- Module : Data.Generics.Internal.Profunctor.Lens
13−-- Copyright : (C) 2018 Csongor Kiss
14+-- Copyright : (C) 2019 Csongor Kiss
1415-- License : BSD3
1516-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1617-- Stability : experimental
src/Data/Generics/Internal/Profunctor/Prism.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_HADDOCK hide #-}
12{-# LANGUAGE GADTs #-}
23{-# LANGUAGE LambdaCase #-}
34{-# LANGUAGE NoMonomorphismRestriction #-}
@@ -10,7 +11,7 @@
1011-----------------------------------------------------------------------------
1112-- |
1213-- Module : Data.Generics.Internal.Profunctor.Prism
13−-- Copyright : (C) 2018 Csongor Kiss
14+-- Copyright : (C) 2019 Csongor Kiss
1415-- License : BSD3
1516-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1617-- Stability : experimental
src/Data/Generics/Internal/VL/Iso.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_HADDOCK hide #-}
12{-# LANGUAGE GADTs #-}
23{-# LANGUAGE NoMonomorphismRestriction #-}
34{-# LANGUAGE Rank2Types #-}
@@ -9,7 +10,7 @@
910-----------------------------------------------------------------------------
1011-- |
1112-- Module : Data.Generics.Internal.VL.Iso
12−-- Copyright : (C) 2018 Csongor Kiss
13+-- Copyright : (C) 2019 Csongor Kiss
1314-- License : BSD3
1415-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1516-- Stability : experimental
src/Data/Generics/Internal/VL/Lens.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_HADDOCK hide #-}
12{-# LANGUAGE GADTs #-}
23{-# LANGUAGE NoMonomorphismRestriction #-}
34{-# LANGUAGE Rank2Types #-}
@@ -10,7 +11,7 @@
1011-----------------------------------------------------------------------------
1112-- |
1213-- Module : Data.Generics.Internal.VL.Lens
13−-- Copyright : (C) 2018 Csongor Kiss
14+-- Copyright : (C) 2019 Csongor Kiss
1415-- License : BSD3
1516-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1617-- Stability : experimental
src/Data/Generics/Internal/VL/Prism.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_HADDOCK hide #-}
12{-# LANGUAGE GADTs #-}
23{-# LANGUAGE NoMonomorphismRestriction #-}
34{-# LANGUAGE Rank2Types #-}
@@ -9,7 +10,7 @@
910-----------------------------------------------------------------------------
1011-- |
1112-- Module : Data.Generics.Internal.VL.Prism
12−-- Copyright : (C) 2018 Csongor Kiss
13+-- Copyright : (C) 2019 Csongor Kiss
1314-- License : BSD3
1415-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1516-- Stability : experimental
src/Data/Generics/Internal/VL/Traversal.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_HADDOCK hide #-}
12{-# LANGUAGE AllowAmbiguousTypes #-}
23{-# LANGUAGE ConstraintKinds #-}
34{-# LANGUAGE GADTs #-}
@@ -11,7 +12,7 @@
1112-----------------------------------------------------------------------------
1213-- |
1314-- Module : Data.Generics.Internal.VL.Traversal
14−-- Copyright : (C) 2018 Csongor Kiss
15+-- Copyright : (C) 2019 Csongor Kiss
1516-- License : BSD3
1617-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1718-- Stability : experimental
src/Data/Generics/Labels.hs+1−1
@@ -16,7 +16,7 @@
1616--------------------------------------------------------------------------------
1717-- |
1818-- Module : Data.Generics.Labels
19−-- Copyright : (C) 2018 Csongor Kiss
19+-- Copyright : (C) 2019 Csongor Kiss
2020-- License : BSD3
2121-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2222-- Stability : experimental
src/Data/Generics/Product.hs+1−1
@@ -1,7 +1,7 @@
11-----------------------------------------------------------------------------
22-- |
33-- Module : Data.Generics.Product
4−-- Copyright : (C) 2018 Csongor Kiss
4+-- Copyright : (C) 2019 Csongor Kiss
55-- License : BSD3
66-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
77-- Stability : experimental
src/Data/Generics/Product/Any.hs+2−2
@@ -12,7 +12,7 @@
1212-----------------------------------------------------------------------------
1313-- |
1414-- Module : Data.Generics.Product.Any
15−-- Copyright : (C) 2018 Csongor Kiss
15+-- Copyright : (C) 2019 Csongor Kiss
1616-- License : BSD3
1717-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1818-- Stability : experimental
@@ -53,7 +53,7 @@ import Data.Generics.Product.Typed
5353-- human = Human "Tunyasz" 50 "London"
5454-- :}
5555
56−class HasAny (sel :: k) s t a b | s sel k -> a where
56+class HasAny sel s t a b | s sel -> a where
5757 -- |A lens that focuses on a part of a product as identified by some
5858 -- selector. Currently supported selectors are field names, positions and
5959 -- unique types. Compatible with the lens package's 'Control.Lens.Lens'
src/Data/Generics/Product/Constraints.hs+1−1
@@ -11,7 +11,7 @@
1111-----------------------------------------------------------------------------
1212-- |
1313-- Module : Data.Generics.Product.Constraints
14−-- Copyright : (C) 2018 Csongor Kiss
14+-- Copyright : (C) 2019 Csongor Kiss
1515-- License : BSD3
1616-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1717-- Stability : experimental
src/Data/Generics/Product/Fields.hs+29−13
@@ -16,7 +16,7 @@
1616-----------------------------------------------------------------------------
1717-- |
1818-- Module : Data.Generics.Product.Fields
19−-- Copyright : (C) 2018 Csongor Kiss
19+-- Copyright : (C) 2019 Csongor Kiss
2020-- License : BSD3
2121-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2222-- Stability : experimental
@@ -47,6 +47,7 @@ import Data.Kind (Constraint, Type)
4747import GHC.Generics
4848import GHC.TypeLits (Symbol, ErrorMessage(..), TypeError)
4949import Data.Generics.Internal.Profunctor.Lens as P
50+import Data.Generics.Internal.Errors
5051
5152-- $setup
5253-- == /Running example:/
@@ -152,39 +153,47 @@ instance
152153 ( Generic s
153154 , ErrorUnless field s (CollectField field (Rep s))
154155 , GLens' (HasTotalFieldPSym field) (Rep s) a
156+ , Defined (Rep s)
157+ (NoGeneric s '[ 'Text "arising from a generic lens focusing on the "
158+ ':<>: QuoteType field ':<>: 'Text " field of type " ':<>: QuoteType a
159+ , 'Text "in " ':<>: QuoteType s])
160+ (() :: Constraint)
155161 ) => HasField' field s a where
156− field' f s = VL.ravel (repLens . glens @(HasTotalFieldPSym field)) f s
162+ field' f s = field0 @field f s
157163
158164class (~~) (a :: k) (b :: k) | a -> b, b -> a
159165instance (a ~ b) => (~~) a b
160166
161167instance -- see Note [Changing type parameters]
162− ( Generic s
163− , Generic t
164− , ErrorUnless field s (CollectField field (Rep s))
165− , HasTotalFieldP field (Rep s) ~~ 'Just a
168+ ( HasTotalFieldP field (Rep s) ~~ 'Just a
166169 , HasTotalFieldP field (Rep t) ~~ 'Just b
167170 , HasTotalFieldP field (Rep (Indexed s)) ~~ 'Just a'
168171 , HasTotalFieldP field (Rep (Indexed t)) ~~ 'Just b'
169172 , t ~~ Infer s a' b
170173 , s ~~ Infer t b' a
171− , GLens (HasTotalFieldPSym field) (Rep s) (Rep t) a b
174+ , HasField0 field s t a b
172175 ) => HasField field s t a b where
173176 field f s = field0 @field f s
174177
175−-- -- See Note [Uncluttering type signatures]
178+-- | See Note [Uncluttering type signatures]
179+#if __GLASGOW_HASKELL__ < 804
180+-- >>> :t field
181+-- field
182+-- :: (HasField field s t a b, Functor f) => (a -> f b) -> s -> f t
183+#else
184+-- >>> :t field
185+-- field
186+-- :: (Functor f, HasField field s t a b) => (a -> f b) -> s -> f t
187+#endif
176188instance {-# OVERLAPPING #-} HasField f (Void1 a) (Void1 b) a b where
177189 field = undefined
178190
179191instance
180− ( Generic s
181− , Generic t
182− , ErrorUnless field s (CollectField field (Rep s))
183− , HasTotalFieldP field (Rep s) ~~ 'Just a
192+ ( HasTotalFieldP field (Rep s) ~~ 'Just a
184193 , HasTotalFieldP field (Rep t) ~~ 'Just b
185194 , UnifyHead s t
186195 , UnifyHead t s
187− , GLens (HasTotalFieldPSym field) (Rep s) (Rep t) a b
196+ , HasField0 field s t a b
188197 ) => HasField_ field s t a b where
189198 field_ f s = field0 @field f s
190199
@@ -195,8 +204,15 @@ instance
195204 ( Generic s
196205 , Generic t
197206 , GLens (HasTotalFieldPSym field) (Rep s) (Rep t) a b
207+ , ErrorUnless field s (CollectField field (Rep s))
208+ , Defined (Rep s)
209+ (NoGeneric s '[ 'Text "arising from a generic lens focusing on the "
210+ ':<>: QuoteType field ':<>: 'Text " field of type " ':<>: QuoteType a
211+ , 'Text "in " ':<>: QuoteType s])
212+ (() :: Constraint)
198213 ) => HasField0 field s t a b where
199214 field0 = VL.ravel (repLens . glens @(HasTotalFieldPSym field))
215+ {-# INLINE field0 #-}
200216
201217type family ErrorUnless (field :: Symbol) (s :: Type) (stat :: TypeStat) :: Constraint where
202218 ErrorUnless field s ('TypeStat _ _ '[])
src/Data/Generics/Product/HList.hs+1−1
@@ -10,7 +10,7 @@
1010-----------------------------------------------------------------------------
1111-- |
1212-- Module : Data.Generics.Product.HList
13−-- Copyright : (C) 2018 Csongor Kiss
13+-- Copyright : (C) 2019 Csongor Kiss
1414-- License : BSD3
1515-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1616-- Stability : experimental
src/Data/Generics/Product/Internal/Constraints.hs+1−1
@@ -15,7 +15,7 @@
1515-----------------------------------------------------------------------------
1616-- |
1717-- Module : Data.Generics.Product.Internal.Constraints
18−-- Copyright : (C) 2018 Csongor Kiss
18+-- Copyright : (C) 2019 Csongor Kiss
1919-- License : BSD3
2020-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2121-- Stability : experimental
src/Data/Generics/Product/Internal/GLens.hs+1−1
@@ -17,7 +17,7 @@
1717-----------------------------------------------------------------------------
1818-- |
1919-- Module : Data.Generics.Product.Internal.GLens
20−-- Copyright : (C) 2018 Csongor Kiss
20+-- Copyright : (C) 2019 Csongor Kiss
2121-- License : BSD3
2222-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2323-- Stability : experimental
src/Data/Generics/Product/Internal/HList.hs+1−1
@@ -20,7 +20,7 @@
2020-----------------------------------------------------------------------------
2121-- |
2222-- Module : Data.Generics.Product.Internal.HList
23−-- Copyright : (C) 2018 Csongor Kiss
23+-- Copyright : (C) 2019 Csongor Kiss
2424-- License : BSD3
2525-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2626-- Stability : experimental
src/Data/Generics/Product/Internal/Positions.hs+1−1
@@ -17,7 +17,7 @@
1717-----------------------------------------------------------------------------
1818-- |
1919-- Module : Data.Generics.Product.Internal.Positions
20−-- Copyright : (C) 2018 Csongor Kiss
20+-- Copyright : (C) 2019 Csongor Kiss
2121-- License : BSD3
2222-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2323-- Stability : experimental
src/Data/Generics/Product/Internal/Subtype.hs+1−1
@@ -16,7 +16,7 @@
1616-----------------------------------------------------------------------------
1717-- |
1818-- Module : Data.Generics.Product.Internal.Subtype
19−-- Copyright : (C) 2018 Csongor Kiss
19+-- Copyright : (C) 2019 Csongor Kiss
2020-- License : BSD3
2121-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2222-- Stability : experimental
src/Data/Generics/Product/Param.hs+10−3
@@ -15,13 +15,13 @@
1515--------------------------------------------------------------------------------
1616-- |
1717-- Module : Data.Generics.Product.Param
18−-- Copyright : (C) 2018 Csongor Kiss
19−-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
18+-- Copyright : (C) 2019 Csongor Kiss
2019-- License : BSD3
20+-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2121-- Stability : experimental
2222-- Portability : non-portable
2323--
24−-- Derive traversal over type parameters
24+-- Derive traversals over type parameters
2525--
2626--------------------------------------------------------------------------------
2727
@@ -39,6 +39,7 @@ import GHC.Generics
3939import Data.Kind
4040import Data.Generics.Internal.VL.Iso
4141import Data.Generics.Internal.GenericN
42+import Data.Generics.Internal.Errors
4243
4344class HasParam (p :: Nat) s t a b | p t a -> s, p s b -> t, p s -> a, p t -> b where
4445 param :: Applicative g => (a -> g b) -> s -> g t
@@ -47,6 +48,12 @@ instance
4748 ( GenericN s
4849 , GenericN t
4950 -- TODO: merge the old 'Changing' code with 'GenericN'
51+ , Defined (Rep s)
52+ (NoGeneric s
53+ '[ 'Text "arising from a generic traversal of the type parameter at position " ':<>: QuoteType n
54+ , 'Text "of type " ':<>: QuoteType a ':<>: 'Text " in " ':<>: QuoteType s
55+ ])
56+ (() :: Constraint)
5057 , s ~ Infer t (P n b 'PTag) a
5158 , t ~ Infer s (P n a 'PTag) b
5259 , Error ((ArgCount s) <=? n) n (ArgCount s) s
src/Data/Generics/Product/Positions.hs+34−10
@@ -19,7 +19,7 @@
1919-----------------------------------------------------------------------------
2020-- |
2121-- Module : Data.Generics.Product.Positions
22−-- Copyright : (C) 2018 Csongor Kiss
22+-- Copyright : (C) 2019 Csongor Kiss
2323-- License : BSD3
2424-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2525-- Stability : experimental
@@ -47,6 +47,7 @@ import Data.Generics.Internal.Void
4747import Data.Generics.Internal.Families
4848import Data.Generics.Product.Internal.Positions
4949import Data.Generics.Product.Internal.GLens
50+import Data.Generics.Internal.Errors
5051
5152import Data.Kind (Constraint, Type)
5253import Data.Type.Bool (type (&&))
@@ -114,9 +115,15 @@ class HasPosition' (i :: Nat) s a | s i -> a where
114115class HasPosition0 (i :: Nat) s t a b where
115116 position0 :: VL.Lens s t a b
116117
118+-- |
119+-- >>> getPosition @2 human
120+-- 50
117121getPosition :: forall i s a. HasPosition' i s a => s -> a
118122getPosition s = s ^. position' @i
119123
124+-- |
125+-- >>> setPosition @2 60 human
126+-- Human {name = "Tunyasz", age = 60, address = "London"}
120127setPosition :: forall i s a. HasPosition' i s a => a -> s -> s
121128setPosition = VL.set (position' @i)
122129
@@ -126,6 +133,12 @@ instance
126133 , cs ~ CRep s
127134 , Coercible (Rep s) cs
128135 , GLens' (HasTotalPositionPSym i) cs a
136+ , Defined (Rep s)
137+ (NoGeneric s '[ 'Text "arising from a generic lens focusing on the field at"
138+ , 'Text "position " ':<>: QuoteType i ':<>: 'Text " of type " ':<>: QuoteType a
139+ ':<>: 'Text " in " ':<>: QuoteType s
140+ ])
141+ (() :: Constraint)
129142 ) => HasPosition' i s a where
130143 position' f s = VL.ravel (repLens . coerced @cs @cs . glens @(HasTotalPositionPSym i)) f s
131144 {-# INLINE position' #-}
@@ -136,10 +149,7 @@ class (~~) (a :: k) (b :: k) | a -> b, b -> a
136149instance (a ~ b) => (~~) a b
137150
138151instance -- see Note [Changing type parameters]
139− ( Generic s
140− , Generic t
141− , ErrorUnless i s (0 <? i && i <=? Size (Rep s))
142− , GLens (HasTotalPositionPSym i) (CRep s) (CRep t) a b
152+ ( ErrorUnless i s (0 <? i && i <=? Size (Rep s))
143153 , HasTotalPositionP i (CRep s) ~~ 'Just a
144154 , HasTotalPositionP i (CRep t) ~~ 'Just b
145155 , HasTotalPositionP i (CRep (Indexed s)) ~~ 'Just a'
@@ -148,6 +158,7 @@ instance -- see Note [Changing type parameters]
148158 , s ~~ Infer t b' a
149159 , Coercible (CRep s) (Rep s)
150160 , Coercible (CRep t) (Rep t)
161+ , HasPosition0 i s t a b
151162 ) => HasPosition i s t a b where
152163
153164 position = position0 @i
@@ -161,19 +172,26 @@ coerced :: forall s t s' t' x a b. (Coercible t t', Coercible s s')
161172coerced = coerce
162173{-# INLINE coerced #-}
163174
164−-- See Note [Uncluttering type signatures]
175+-- | See Note [Uncluttering type signatures]
176+#if __GLASGOW_HASKELL__ < 804
177+-- >>> :t position
178+-- position
179+-- :: (HasPosition i s t a b, Functor f) => (a -> f b) -> s -> f t
180+#else
181+-- >>> :t position
182+-- position
183+-- :: (Functor f, HasPosition i s t a b) => (a -> f b) -> s -> f t
184+#endif
165185instance {-# OVERLAPPING #-} HasPosition f (Void1 a) (Void1 b) a b where
166186 position = undefined
167187
168188instance
169− ( Generic s
170− , Generic t
171− , ErrorUnless i s (0 <? i && i <=? Size (Rep s))
172− , GLens (HasTotalPositionPSym i) (CRep s) (CRep t) a b
189+ ( ErrorUnless i s (0 <? i && i <=? Size (Rep s))
173190 , UnifyHead s t
174191 , UnifyHead t s
175192 , Coercible (CRep s) (Rep s)
176193 , Coercible (CRep t) (Rep t)
194+ , HasPosition0 i s t a b
177195 ) => HasPosition_ i s t a b where
178196
179197 position_ = position0 @i
@@ -188,6 +206,12 @@ instance
188206 , GLens (HasTotalPositionPSym i) (CRep s) (CRep t) a b
189207 , Coercible (CRep s) (Rep s)
190208 , Coercible (CRep t) (Rep t)
209+ , Defined (Rep s)
210+ (NoGeneric s '[ 'Text "arising from a generic lens focusing on the field at"
211+ , 'Text "position " ':<>: QuoteType i ':<>: 'Text " of type " ':<>: QuoteType a
212+ ':<>: 'Text " in " ':<>: QuoteType s
213+ ])
214+ (() :: Constraint)
191215 ) => HasPosition0 i s t a b where
192216 position0 = VL.ravel (repLens . coerced @(CRep s) @(CRep t) . glens @(HasTotalPositionPSym i))
193217 {-# INLINE position0 #-}
src/Data/Generics/Product/Subtype.hs+43−3
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE AllowAmbiguousTypes #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE FlexibleContexts #-}
@@ -15,7 +16,7 @@
1516-----------------------------------------------------------------------------
1617-- |
1718-- Module : Data.Generics.Product.Subtype
18−-- Copyright : (C) 2018 Csongor Kiss
19+-- Copyright : (C) 2019 Csongor Kiss
1920-- License : BSD3
2021-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2122-- Stability : experimental
@@ -41,6 +42,7 @@ import GHC.Generics (Generic (Rep, to, from) )
4142import GHC.TypeLits (Symbol, TypeError, ErrorMessage (..))
4243import Data.Kind (Type, Constraint)
4344import Data.Generics.Internal.Profunctor.Lens hiding (set)
45+import Data.Generics.Internal.Errors
4446
4547-- $setup
4648-- == /Running example:/
@@ -113,14 +115,52 @@ instance
113115 , Generic b
114116 , GSmash (Rep a) (Rep b)
115117 , GUpcast (Rep a) (Rep b)
116− , ErrorUnless b a (CollectFieldsOrdered (Rep b) \\ CollectFieldsOrdered (Rep a))
118+ , CustomError a b
117119 ) => Subtype b a where
118120 smash p b = to $ gsmash (from p) (from b)
119121 upcast = to . gupcast . from
120122
121−-- See Note [Uncluttering type signatures]
123+type family CustomError a b :: Constraint where
124+ CustomError a b =
125+ ( ErrorUnless b a (CollectFieldsOrdered (Rep b) \\ CollectFieldsOrdered (Rep a))
126+ , Defined (Rep a)
127+ (NoGeneric a '[ 'Text "arising from a generic lens focusing on " ':<>: QuoteType b
128+ , 'Text "as a supertype of " ':<>: QuoteType a
129+ ])
130+ (() :: Constraint)
131+ , Defined (Rep b)
132+ (NoGeneric b '[ 'Text "arising from a generic lens focusing on " ':<>: QuoteType b
133+ , 'Text "as a supertype of " ':<>: QuoteType a
134+ ])
135+ (() :: Constraint)
136+ )
137+
138+instance {-# OVERLAPPING #-} Subtype a a where
139+ super = id
140+
141+-- | See Note [Uncluttering type signatures]
142+#if __GLASGOW_HASKELL__ < 804
143+-- >>> :t super
144+-- super
145+-- :: (Subtype sup sub, Functor f) => (sup -> f sup) -> sub -> f sub
146+#else
147+-- >>> :t super
148+-- super
149+-- :: (Functor f, Subtype sup sub) => (sup -> f sup) -> sub -> f sub
150+#endif
122151instance {-# OVERLAPPING #-} Subtype a Void where
123152 super = undefined
153+
154+-- | See Note [Uncluttering type signatures]
155+#if __GLASGOW_HASKELL__ < 804
156+-- >>> :t super @Int
157+-- super @Int
158+-- :: (Subtype Int sub, Functor f) => (Int -> f Int) -> sub -> f sub
159+#else
160+-- >>> :t super @Int
161+-- super @Int
162+-- :: (Functor f, Subtype Int sub) => (Int -> f Int) -> sub -> f sub
163+#endif
124164instance {-# OVERLAPPING #-} Subtype Void a where
125165 super = undefined
126166
src/Data/Generics/Product/Typed.hs+23−2
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE AllowAmbiguousTypes #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE FlexibleContexts #-}
@@ -14,7 +15,7 @@
1415-----------------------------------------------------------------------------
1516-- |
1617-- Module : Data.Generics.Product.Typed
17−-- Copyright : (C) 2018 Csongor Kiss
18+-- Copyright : (C) 2019 Csongor Kiss
1819-- License : BSD3
1920-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2021-- Stability : experimental
@@ -40,6 +41,7 @@ import Data.Kind (Constraint, Type)
4041import GHC.Generics (Generic (Rep))
4142import GHC.TypeLits (TypeError, ErrorMessage (..))
4243import Data.Generics.Internal.Profunctor.Lens
44+import Data.Generics.Internal.Errors
4345
4446-- $setup
4547-- == /Running example:/
@@ -111,12 +113,31 @@ class HasType a s where
111113instance
112114 ( Generic s
113115 , ErrorUnlessOne a s (CollectTotalType a (Rep s))
116+ , Defined (Rep s)
117+ (NoGeneric s '[ 'Text "arising from a generic lens focusing on a field of type " ':<>: QuoteType a])
118+ (() :: Constraint)
114119 , GLens (HasTotalTypePSym a) (Rep s) (Rep s) a a
115120 ) => HasType a s where
116121
117122 typed f s = VL.ravel (repLens . glens @(HasTotalTypePSym a)) f s
118123
119−-- See Note [Uncluttering type signatures]
124+instance {-# OVERLAPPING #-} HasType a a where
125+ getTyped = id
126+ {-# INLINE getTyped #-}
127+
128+ setTyped a _ = a
129+ {-# INLINE setTyped #-}
130+
131+-- | See Note [Uncluttering type signatures]
132+#if __GLASGOW_HASKELL__ < 804
133+-- >>> :t typed
134+-- typed :: (HasType a s, Functor f) => (a -> f a) -> s -> f s
135+#else
136+-- >>> :t typed
137+-- typed :: (Functor f, HasType a s) => (a -> f a) -> s -> f s
138+#endif
139+--
140+-- Note that this might not longer be needed given the above 'HasType a a' instance.
120141instance {-# OVERLAPPING #-} HasType a Void where
121142 typed = undefined
122143
src/Data/Generics/Product/Types.hs+36−6
@@ -16,7 +16,7 @@
1616-----------------------------------------------------------------------------
1717-- |
1818-- Module : Data.Generics.Product.Types
19−-- Copyright : (C) 2018 Csongor Kiss
19+-- Copyright : (C) 2019 Csongor Kiss
2020-- License : BSD3
2121-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2222-- Stability : experimental
@@ -48,9 +48,12 @@ module Data.Generics.Product.Types
4848import Data.Kind
4949import Data.Int (Int8, Int16, Int32, Int64)
5050import Data.Word (Word, Word8, Word16, Word32, Word64)
51+import qualified Data.Text as T
5152
5253import GHC.Generics
54+import GHC.TypeLits
5355import Data.Generics.Internal.VL.Traversal
56+import Data.Generics.Internal.Errors
5457
5558-- $setup
5659-- == /Running example:/
@@ -77,7 +80,7 @@ import Data.Generics.Internal.VL.Traversal
7780
7881-- | Traverse all types in the given structure.
7982--
80−-- For example, to update all 'String's in a @WTree (Maybe Int) Int@, we can write
83+-- For example, to update all 'String's in a @WTree (Maybe String) String@, we can write
8184--
8285-- >>> myTree = WithWeight (Fork (Leaf (Just "hello")) (Leaf Nothing)) "world"
8386-- >>> over (types @String) (++ "!") myTree
@@ -131,7 +134,9 @@ instance {-# OVERLAPPING #-} HasTypesUsing ch s Void where
131134-- >>> myTree = WithWeight (Fork (Leaf (Opaque "foo")) (Leaf (Opaque "bar"))) False
132135-- >>> over (types @String) (++ "!") myTree
133136-- ...
134−-- ... No instance for (HasTypesOpt
137+-- ... | No instance for ‘Generic Opaque’
138+-- ... | arising from a generic traversal.
139+-- ... | Either derive the instance, or define a custom traversal using ‘HasTypesCustom’
135140-- ...
136141--
137142-- In these cases, we can define a custom traversal strategy to override the
@@ -204,6 +209,13 @@ class HasTypesCustom (ch :: Type) s a where
204209instance {-# OVERLAPPABLE #-}
205210 ( GHasTypes ch (Rep s) a
206211 , Generic s
212+ -- if there's no Generic instance here, it means we got through the
213+ -- Children check by a user-defined custom strategy.
214+ -- Therefore, we can ignore the missing Generic instance, and
215+ -- instead report a missing HasTypesCustom instance
216+ , Defined (Rep s)
217+ (PrettyError '[ 'Text "No instance " ':<>: QuoteType (HasTypesCustom ch s a)])
218+ (() :: Constraint)
207219 ) => HasTypesCustom ch s a where
208220 typesCustom f s = to <$> gtypes_ @ch f (from s)
209221 --{-# INLINE types' #-}
@@ -230,7 +242,14 @@ type family ChildrenDefault (a :: Type) :: [Type] where
230242 ChildrenDefault Word16 = '[]
231243 ChildrenDefault Word32 = '[]
232244 ChildrenDefault Word64 = '[]
233− ChildrenDefault a = ChildrenGeneric (Rep a) '[]
245+ ChildrenDefault T.Text = '[]
246+ ChildrenDefault a
247+ = Defined (Rep a)
248+ (NoGeneric a
249+ '[ 'Text "arising from a generic traversal."
250+ , 'Text "Either derive the instance, or define a custom traversal using " ':<>: QuoteType HasTypesCustom
251+ ])
252+ (ChildrenGeneric (Rep a) '[])
234253
235254type family ChildrenGeneric (f :: k -> Type) (cs :: [Type]) :: [Type] where
236255 ChildrenGeneric (M1 _ _ f) cs = ChildrenGeneric f cs
@@ -303,7 +322,16 @@ instance GHasTypes ch V1 a where
303322 {-# INLINE gtypes_ #-}
304323
305324type Interesting (ch :: Type) (a :: Type) (t :: Type)
306− = IsNothing (Interesting' ch a '[t] (Children ch t))
325+ = Defined_list (Children ch t) (NoChildren ch t)
326+ (IsNothing (Interesting' ch a '[t] (Children ch t)))
327+
328+type family NoChildren (ch :: Type) (a :: Type) :: Constraint where
329+ NoChildren ch a = PrettyError
330+ '[ 'Text "No type family instance for " ':<>: QuoteType (Children ch a)
331+ , 'Text "arising from a traversal over " ':<>: QuoteType a
332+ , 'Text "with custom strategy " ':<>: QuoteType ch
333+ ]
334+
307335
308336type family Interesting' (ch :: Type) (a :: Type) (seen :: [Type]) (ts :: [Type]) :: Maybe [Type] where
309337 Interesting' ch _ seen '[] = 'Just seen
@@ -317,7 +345,9 @@ type family InterestingUnless
317345 Maybe [Type] where
318346 InterestingUnless ch a seen a _ = 'Nothing
319347 InterestingUnless ch a seen t 'True = 'Just seen
320− InterestingUnless ch a seen t 'False = Interesting' ch a (t ': seen) (Children ch t)
348+ InterestingUnless ch a seen t 'False
349+ = Defined_list (Children ch t) (NoChildren ch t)
350+ (Interesting' ch a (t ': seen) (Children ch t))
321351
322352-- Short circuit
323353type family InterestingOr
src/Data/Generics/Sum.hs+1−1
@@ -1,7 +1,7 @@
11-----------------------------------------------------------------------------
22-- |
33-- Module : Data.Generics.Sum
4−-- Copyright : (C) 2018 Csongor Kiss
4+-- Copyright : (C) 2019 Csongor Kiss
55-- License : BSD3
66-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
77-- Stability : experimental
src/Data/Generics/Sum/Any.hs+2−2
@@ -11,7 +11,7 @@
1111-----------------------------------------------------------------------------
1212-- |
1313-- Module : Data.Generics.Sum.Any
14−-- Copyright : (C) 2018 Csongor Kiss
14+-- Copyright : (C) 2019 Csongor Kiss
1515-- License : BSD3
1616-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1717-- Stability : experimental
@@ -61,7 +61,7 @@ import Data.Generics.Internal.VL.Prism
6161-- :}
6262
6363-- |Sums that have generic prisms.
64−class AsAny (sel :: k) a s | s sel k -> a where
64+class AsAny sel a s | s sel -> a where
6565 -- |A prism that projects a sum as identified by some selector. Currently
6666 -- supported selectors are constructor names and unique types. Compatible
6767 -- with the lens package's 'Control.Lens.Prism' type.
src/Data/Generics/Sum/Constructors.hs+31−9
@@ -15,7 +15,7 @@
1515-----------------------------------------------------------------------------
1616-- |
1717-- Module : Data.Generics.Sum.Constructors
18−-- Copyright : (C) 2018 Csongor Kiss
18+-- Copyright : (C) 2019 Csongor Kiss
1919-- License : BSD3
2020-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2121-- Stability : experimental
@@ -45,6 +45,7 @@ import GHC.TypeLits (Symbol, TypeError, ErrorMessage (..))
4545import Data.Generics.Internal.VL.Prism
4646import Data.Generics.Internal.Profunctor.Iso
4747import Data.Generics.Internal.Profunctor.Prism (prismPRavel)
48+import Data.Generics.Internal.Errors
4849
4950-- $setup
5051-- == /Running example:/
@@ -70,7 +71,7 @@ import Data.Generics.Internal.Profunctor.Prism (prismPRavel)
7071-- , age :: Age
7172-- , fieldA :: a
7273-- }
73−-- deriving (Generic, Show)
74+-- deriving Show
7475-- type Name = String
7576-- type Age = Int
7677-- dog, cat, duck :: Animal Int
@@ -128,39 +129,55 @@ instance
128129 ( Generic s
129130 , ErrorUnless ctor s (HasCtorP ctor (Rep s))
130131 , GAsConstructor' ctor (Rep s) a
132+ , Defined (Rep s)
133+ (NoGeneric s '[ 'Text "arising from a generic prism focusing on the "
134+ ':<>: QuoteType ctor ':<>: 'Text " constructor of type " ':<>: QuoteType a
135+ , 'Text "in " ':<>: QuoteType s])
136+ (() :: Constraint)
131137 ) => AsConstructor' ctor s a where
132138 _Ctor' eta = prismRavel (prismPRavel (repIso . _GCtor @ctor)) eta
133139 {-# INLINE[2] _Ctor' #-}
134140
135141instance
136− ( Generic s
137− , Generic t
138− , ErrorUnless ctor s (HasCtorP ctor (Rep s))
142+ ( ErrorUnless ctor s (HasCtorP ctor (Rep s))
139143 , GAsConstructor' ctor (Rep s) a -- TODO: add a test similar to #62 for prisms
140144 , GAsConstructor' ctor (Rep (Indexed s)) a'
141145 , GAsConstructor ctor (Rep s) (Rep t) a b
142146 , t ~ Infer s a' b
143147 , GAsConstructor' ctor (Rep (Indexed t)) b'
144148 , s ~ Infer t b' a
149+ , AsConstructor0 ctor s t a b
145150 ) => AsConstructor ctor s t a b where
146151
147152 _Ctor = _Ctor0 @ctor
148153 {-# INLINE[2] _Ctor #-}
149154
150−-- See Note [Uncluttering type signatures]
155+-- | See Note [Uncluttering type signatures]
156+#if __GLASGOW_HASKELL__ < 804
157+-- >>> :t _Ctor
158+-- _Ctor
159+-- :: (Applicative f, Data.Profunctor.Choice.Choice p,
160+-- AsConstructor ctor s t a b) =>
161+-- p a (f b) -> p s (f t)
162+#else
163+-- >>> :t _Ctor
164+-- _Ctor
165+-- :: (AsConstructor ctor s t a b, Data.Profunctor.Choice.Choice p,
166+-- Applicative f) =>
167+-- p a (f b) -> p s (f t)
168+#endif
151169instance {-# OVERLAPPING #-} AsConstructor ctor (Void1 a) (Void1 b) a b where
152170 _Ctor = undefined
153171
154172instance
155− ( Generic s
156− , Generic t
157− , ErrorUnless ctor s (HasCtorP ctor (Rep s))
173+ ( ErrorUnless ctor s (HasCtorP ctor (Rep s))
158174 , GAsConstructor' ctor (Rep s) a -- TODO: add a test similar to #62 for prisms
159175 , GAsConstructor' ctor (Rep (Indexed s)) a'
160176 , GAsConstructor ctor (Rep s) (Rep t) a b
161177 , GAsConstructor' ctor (Rep (Indexed t)) b'
162178 , UnifyHead s t
163179 , UnifyHead t s
180+ , AsConstructor0 ctor s t a b
164181 ) => AsConstructor_ ctor s t a b where
165182
166183 _Ctor_ = _Ctor0 @ctor
@@ -173,6 +190,11 @@ instance
173190 ( Generic s
174191 , Generic t
175192 , GAsConstructor ctor (Rep s) (Rep t) a b
193+ , Defined (Rep s)
194+ (NoGeneric s '[ 'Text "arising from a generic prism focusing on the "
195+ ':<>: QuoteType ctor ':<>: 'Text " constructor of type " ':<>: QuoteType a
196+ , 'Text "in " ':<>: QuoteType s])
197+ (() :: Constraint)
176198 ) => AsConstructor0 ctor s t a b where
177199 _Ctor0 = prismRavel (prismPRavel (repIso . _GCtor @ctor))
178200 {-# INLINE[2] _Ctor0 #-}
src/Data/Generics/Sum/Internal/Constructors.hs+1−1
@@ -14,7 +14,7 @@
1414-----------------------------------------------------------------------------
1515-- |
1616-- Module : Data.Generics.Sum.Internal.Constructors
17−-- Copyright : (C) 2018 Csongor Kiss
17+-- Copyright : (C) 2019 Csongor Kiss
1818-- License : BSD3
1919-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2020-- Stability : experimental
src/Data/Generics/Sum/Internal/Subtype.hs+1−1
@@ -14,7 +14,7 @@
1414-----------------------------------------------------------------------------
1515-- |
1616-- Module : Data.Generics.Sum.Internal.Subtype
17−-- Copyright : (C) 2018 Csongor Kiss
17+-- Copyright : (C) 2019 Csongor Kiss
1818-- License : BSD3
1919-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2020-- Stability : experimental
src/Data/Generics/Sum/Internal/Typed.hs+1−1
@@ -13,7 +13,7 @@
1313-----------------------------------------------------------------------------
1414-- |
1515-- Module : Data.Generics.Sum.Internal.Typed
16−-- Copyright : (C) 2018 Csongor Kiss
16+-- Copyright : (C) 2019 Csongor Kiss
1717-- License : BSD3
1818-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1919-- Stability : experimental
src/Data/Generics/Sum/Subtype.hs+38−2
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE MonoLocalBinds #-}
@@ -11,7 +12,7 @@
1112-----------------------------------------------------------------------------
1213-- |
1314-- Module : Data.Generics.Sum.Subtype
14−-- Copyright : (C) 2018 Csongor Kiss
15+-- Copyright : (C) 2019 Csongor Kiss
1516-- License : BSD3
1617-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1718-- Stability : experimental
@@ -113,10 +114,45 @@ instance
113114 _Sub f = prismRavel (repIso . _GSub . fromIso repIso) f
114115 {-# INLINE[2] _Sub #-}
115116
116−-- See Note [Uncluttering type signatures]
117+-- | Reflexive case
118+-- >>> _Sub # dog :: Animal
119+-- Dog (MkDog {name = "Shep", age = 3})
120+instance {-# OVERLAPPING #-} AsSubtype a a where
121+ _Sub = id
122+ {-# INLINE[2] _Sub #-}
123+
124+-- | See Note [Uncluttering type signatures]
125+#if __GLASGOW_HASKELL__ < 804
126+-- >>> :t _Sub
127+--_Sub
128+-- :: (Applicative f, Data.Profunctor.Choice.Choice p,
129+-- AsSubtype sub sup) =>
130+-- p sub (f sub) -> p sup (f sup)
131+-- >>> :t _Sub
132+#else
133+--_Sub
134+-- :: (AsSubtype sub sup, Data.Profunctor.Choice.Choice p,
135+-- Applicative f) =>
136+-- p sub (f sub) -> p sup (f sup)
137+#endif
117138instance {-# OVERLAPPING #-} AsSubtype a Void where
118139 injectSub = undefined
119140 projectSub = undefined
141+
142+-- | See Note [Uncluttering type signatures]
143+#if __GLASGOW_HASKELL__ < 804
144+-- >>> :t _Sub @Int
145+-- _Sub @Int
146+-- :: (Applicative f, Data.Profunctor.Choice.Choice p,
147+-- AsSubtype Int sup) =>
148+-- p Int (f Int) -> p sup (f sup)
149+#else
150+-- >>> :t _Sub @Int
151+-- _Sub @Int
152+-- :: (AsSubtype Int sup, Data.Profunctor.Choice.Choice p,
153+-- Applicative f) =>
154+-- p Int (f Int) -> p sup (f sup)
155+#endif
120156instance {-# OVERLAPPING #-} AsSubtype Void a where
121157 injectSub = undefined
122158 projectSub = undefined
src/Data/Generics/Sum/Typed.hs+33−2
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE TypeApplications #-}
23{-# LANGUAGE AllowAmbiguousTypes #-}
34{-# LANGUAGE DataKinds #-}
@@ -13,7 +14,7 @@
1314-----------------------------------------------------------------------------
1415-- |
1516-- Module : Data.Generics.Sum.Typed
16−-- Copyright : (C) 2018 Csongor Kiss
17+-- Copyright : (C) 2019 Csongor Kiss
1718-- License : BSD3
1819-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
1920-- Stability : experimental
@@ -34,6 +35,7 @@ import Data.Kind
3435import GHC.Generics
3536import GHC.TypeLits (TypeError, ErrorMessage (..), Symbol)
3637import Data.Generics.Sum.Internal.Typed
38+import Data.Generics.Internal.Errors
3739
3840import Data.Generics.Internal.Families
3941import Data.Generics.Internal.Void
@@ -109,16 +111,45 @@ instance
109111 , as ~ TupleToList a
110112 , ListTuple a as
111113 , GAsType (Rep s) as
114+ , Defined (Rep s)
115+ (NoGeneric s '[ 'Text "arising from a generic prism focusing on a constructor of type " ':<>: QuoteType a])
116+ (() :: Constraint)
112117 ) => AsType a s where
113118
114119 _Typed eta = prismRavel (prismPRavel (repIso . _GTyped @_ @as . tupled)) eta
115120 {-# INLINE[2] _Typed #-}
116121
117−-- See Note [Uncluttering type signatures]
122+-- | See Note [Uncluttering type signatures]
123+#if __GLASGOW_HASKELL__ < 804
124+-- >>> :t _Typed
125+-- _Typed
126+-- :: (Applicative f, Data.Profunctor.Choice.Choice p, AsType a s) =>
127+-- p a (f a) -> p s (f s)
128+#else
129+-- >>> :t _Typed
130+-- _Typed
131+-- :: (AsType a s, Data.Profunctor.Choice.Choice p, Applicative f) =>
132+-- p a (f a) -> p s (f s)
133+#endif
118134instance {-# OVERLAPPING #-} AsType a Void where
119135 _Typed = undefined
120136 injectTyped = undefined
121137 projectTyped = undefined
138+
139+-- | See Note [Uncluttering type signatures]
140+#if __GLASGOW_HASKELL__ < 804
141+-- >>> :t _Typed @Int
142+-- _Typed @Int
143+-- :: (Applicative f, Data.Profunctor.Choice.Choice p,
144+-- AsType Int s) =>
145+-- p Int (f Int) -> p s (f s)
146+#else
147+-- >>> :t _Typed @Int
148+-- _Typed @Int
149+-- :: (AsType Int s, Data.Profunctor.Choice.Choice p,
150+-- Applicative f) =>
151+-- p Int (f Int) -> p s (f s)
152+#endif
122153instance {-# OVERLAPPING #-} AsType Void a where
123154 _Typed = undefined
124155 injectTyped = undefined
src/Data/Generics/Wrapped.hs+1−1
@@ -14,7 +14,7 @@
1414-----------------------------------------------------------------------------
1515-- |
1616-- Module : Data.Generics.Wrapped
17−-- Copyright : (C) 2018 Csongor Kiss
17+-- Copyright : (C) 2019 Csongor Kiss
1818-- License : BSD3
1919-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2020-- Stability : experimental
test/Test71.hsnew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE FlexibleContexts, DeriveGeneric, TypeApplications #-}
2+
3+module Test71 where
4+
5+import GHC.Generics
6+import Control.Lens
7+import Data.Generics.Product
8+
9+data Foobar = Foobar Int Char String
10+ deriving Generic
11+
12+foo :: HasType Foobar ctx => ctx -> Char
13+foo ctx = case view (typed @Foobar) ctx of
14+ Foobar _ c _ -> c
15+
16+bar :: Char
17+bar = foo (Foobar 3 'a' "Hello")