├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── CONTRIBUTING.md ├── README.md ├── bump-version.py ├── cabal.haskell-ci ├── cabal.project ├── microlens-contra ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── microlens-contra.cabal └── src │ └── Lens │ └── Micro │ └── Contra.hs ├── microlens-ghc ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── microlens-ghc.cabal └── src │ └── Lens │ └── Micro │ ├── GHC.hs │ └── GHC │ └── Internal.hs ├── microlens-mtl ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── microlens-mtl.cabal └── src │ └── Lens │ └── Micro │ ├── Mtl.hs │ └── Mtl │ └── Internal.hs ├── microlens-platform ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── microlens-platform.cabal └── src │ └── Lens │ └── Micro │ ├── Platform.hs │ └── Platform │ └── Internal.hs ├── microlens-pro ├── CHANGELOG.md ├── LICENSE ├── microlens-pro.cabal └── src │ └── Lens │ └── Micro │ ├── Pro.hs │ └── Pro │ ├── Internal.hs │ ├── TH.hs │ └── Type.hs ├── microlens-th ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── microlens-th.cabal ├── src │ └── Lens │ │ └── Micro │ │ ├── TH.hs │ │ └── TH │ │ └── Internal.hs └── test │ ├── T799.hs │ ├── T917.hs │ ├── T972.hs │ └── templates.hs ├── microlens ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── microlens.cabal └── src │ └── Lens │ ├── Micro.hs │ └── Micro │ ├── Extras.hs │ ├── Internal.hs │ └── Type.hs └── stack.yaml /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'cabal.project' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.19.20241202 12 | # 13 | # REGENDATA ("0.19.20241202",["github","cabal.project"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | push: 18 | branches: 19 | - master 20 | pull_request: 21 | branches: 22 | - master 23 | jobs: 24 | linux: 25 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 26 | runs-on: ubuntu-20.04 27 | timeout-minutes: 28 | 60 29 | container: 30 | image: buildpack-deps:jammy 31 | continue-on-error: ${{ matrix.allow-failure }} 32 | strategy: 33 | matrix: 34 | include: 35 | - compiler: ghc-9.12.0.20241128 36 | compilerKind: ghc 37 | compilerVersion: 9.12.0.20241128 38 | setup-method: ghcup-prerelease 39 | allow-failure: false 40 | - compiler: ghc-9.10.1 41 | compilerKind: ghc 42 | compilerVersion: 9.10.1 43 | setup-method: ghcup 44 | allow-failure: false 45 | - compiler: ghc-9.8.4 46 | compilerKind: ghc 47 | compilerVersion: 9.8.4 48 | setup-method: ghcup 49 | allow-failure: false 50 | - compiler: ghc-9.6.6 51 | compilerKind: ghc 52 | compilerVersion: 9.6.6 53 | setup-method: ghcup 54 | allow-failure: false 55 | - compiler: ghc-9.4.8 56 | compilerKind: ghc 57 | compilerVersion: 9.4.8 58 | setup-method: ghcup 59 | allow-failure: false 60 | - compiler: ghc-9.2.8 61 | compilerKind: ghc 62 | compilerVersion: 9.2.8 63 | setup-method: ghcup 64 | allow-failure: false 65 | - compiler: ghc-9.0.2 66 | compilerKind: ghc 67 | compilerVersion: 9.0.2 68 | setup-method: ghcup 69 | allow-failure: false 70 | - compiler: ghc-8.10.7 71 | compilerKind: ghc 72 | compilerVersion: 8.10.7 73 | setup-method: ghcup 74 | allow-failure: false 75 | - compiler: ghc-8.8.4 76 | compilerKind: ghc 77 | compilerVersion: 8.8.4 78 | setup-method: ghcup 79 | allow-failure: false 80 | - compiler: ghc-8.6.5 81 | compilerKind: ghc 82 | compilerVersion: 8.6.5 83 | setup-method: ghcup 84 | allow-failure: false 85 | - compiler: ghc-8.4.4 86 | compilerKind: ghc 87 | compilerVersion: 8.4.4 88 | setup-method: ghcup 89 | allow-failure: false 90 | - compiler: ghc-8.2.2 91 | compilerKind: ghc 92 | compilerVersion: 8.2.2 93 | setup-method: ghcup 94 | allow-failure: false 95 | - compiler: ghc-8.0.2 96 | compilerKind: ghc 97 | compilerVersion: 8.0.2 98 | setup-method: ghcup 99 | allow-failure: false 100 | fail-fast: false 101 | steps: 102 | - name: apt-get install 103 | run: | 104 | apt-get update 105 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev 106 | - name: Install GHCup 107 | run: | 108 | mkdir -p "$HOME/.ghcup/bin" 109 | curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" 110 | chmod a+x "$HOME/.ghcup/bin/ghcup" 111 | - name: Install cabal-install 112 | run: | 113 | "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 114 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 115 | - name: Install GHC (GHCup) 116 | if: matrix.setup-method == 'ghcup' 117 | run: | 118 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 119 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 120 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 121 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 122 | echo "HC=$HC" >> "$GITHUB_ENV" 123 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 124 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 125 | env: 126 | HCKIND: ${{ matrix.compilerKind }} 127 | HCNAME: ${{ matrix.compiler }} 128 | HCVER: ${{ matrix.compilerVersion }} 129 | - name: Install GHC (GHCup prerelease) 130 | if: matrix.setup-method == 'ghcup-prerelease' 131 | run: | 132 | "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; 133 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 134 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 135 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 136 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 137 | echo "HC=$HC" >> "$GITHUB_ENV" 138 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 139 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 140 | env: 141 | HCKIND: ${{ matrix.compilerKind }} 142 | HCNAME: ${{ matrix.compiler }} 143 | HCVER: ${{ matrix.compilerVersion }} 144 | - name: Set PATH and environment variables 145 | run: | 146 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 147 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 148 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 149 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 150 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 151 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 152 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 153 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 154 | if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi 155 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 156 | env: 157 | HCKIND: ${{ matrix.compilerKind }} 158 | HCNAME: ${{ matrix.compiler }} 159 | HCVER: ${{ matrix.compilerVersion }} 160 | - name: env 161 | run: | 162 | env 163 | - name: write cabal config 164 | run: | 165 | mkdir -p $CABAL_DIR 166 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 211 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 212 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 213 | rm -f cabal-plan.xz 214 | chmod a+x $HOME/.cabal/bin/cabal-plan 215 | cabal-plan --version 216 | - name: checkout 217 | uses: actions/checkout@v4 218 | with: 219 | path: source 220 | - name: initial cabal.project for sdist 221 | run: | 222 | touch cabal.project 223 | echo "packages: $GITHUB_WORKSPACE/source/microlens" >> cabal.project 224 | echo "packages: $GITHUB_WORKSPACE/source/microlens-contra" >> cabal.project 225 | echo "packages: $GITHUB_WORKSPACE/source/microlens-ghc" >> cabal.project 226 | echo "packages: $GITHUB_WORKSPACE/source/microlens-mtl" >> cabal.project 227 | echo "packages: $GITHUB_WORKSPACE/source/microlens-platform" >> cabal.project 228 | echo "packages: $GITHUB_WORKSPACE/source/microlens-th" >> cabal.project 229 | echo "packages: $GITHUB_WORKSPACE/source/microlens-pro" >> cabal.project 230 | cat cabal.project 231 | - name: sdist 232 | run: | 233 | mkdir -p sdist 234 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 235 | - name: unpack 236 | run: | 237 | mkdir -p unpacked 238 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 239 | - name: generate cabal.project 240 | run: | 241 | PKGDIR_microlens="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/microlens-[0-9.]*')" 242 | echo "PKGDIR_microlens=${PKGDIR_microlens}" >> "$GITHUB_ENV" 243 | PKGDIR_microlens_contra="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/microlens-contra-[0-9.]*')" 244 | echo "PKGDIR_microlens_contra=${PKGDIR_microlens_contra}" >> "$GITHUB_ENV" 245 | PKGDIR_microlens_ghc="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/microlens-ghc-[0-9.]*')" 246 | echo "PKGDIR_microlens_ghc=${PKGDIR_microlens_ghc}" >> "$GITHUB_ENV" 247 | PKGDIR_microlens_mtl="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/microlens-mtl-[0-9.]*')" 248 | echo "PKGDIR_microlens_mtl=${PKGDIR_microlens_mtl}" >> "$GITHUB_ENV" 249 | PKGDIR_microlens_platform="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/microlens-platform-[0-9.]*')" 250 | echo "PKGDIR_microlens_platform=${PKGDIR_microlens_platform}" >> "$GITHUB_ENV" 251 | PKGDIR_microlens_th="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/microlens-th-[0-9.]*')" 252 | echo "PKGDIR_microlens_th=${PKGDIR_microlens_th}" >> "$GITHUB_ENV" 253 | PKGDIR_microlens_pro="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/microlens-pro-[0-9.]*')" 254 | echo "PKGDIR_microlens_pro=${PKGDIR_microlens_pro}" >> "$GITHUB_ENV" 255 | rm -f cabal.project cabal.project.local 256 | touch cabal.project 257 | touch cabal.project.local 258 | echo "packages: ${PKGDIR_microlens}" >> cabal.project 259 | echo "packages: ${PKGDIR_microlens_contra}" >> cabal.project 260 | echo "packages: ${PKGDIR_microlens_ghc}" >> cabal.project 261 | echo "packages: ${PKGDIR_microlens_mtl}" >> cabal.project 262 | echo "packages: ${PKGDIR_microlens_platform}" >> cabal.project 263 | echo "packages: ${PKGDIR_microlens_th}" >> cabal.project 264 | echo "packages: ${PKGDIR_microlens_pro}" >> cabal.project 265 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package microlens" >> cabal.project ; fi 266 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 267 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package microlens-contra" >> cabal.project ; fi 268 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 269 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package microlens-ghc" >> cabal.project ; fi 270 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 271 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package microlens-mtl" >> cabal.project ; fi 272 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 273 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package microlens-platform" >> cabal.project ; fi 274 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 275 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package microlens-th" >> cabal.project ; fi 276 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 277 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package microlens-pro" >> cabal.project ; fi 278 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 279 | cat >> cabal.project <> cabal.project 283 | fi 284 | $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(microlens|microlens-contra|microlens-ghc|microlens-mtl|microlens-platform|microlens-pro|microlens-th)$/; }' >> cabal.project.local 285 | cat cabal.project 286 | cat cabal.project.local 287 | - name: dump install plan 288 | run: | 289 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 290 | cabal-plan 291 | - name: restore cache 292 | uses: actions/cache/restore@v4 293 | with: 294 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 295 | path: ~/.cabal/store 296 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 297 | - name: install dependencies 298 | run: | 299 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 300 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 301 | - name: build w/o tests 302 | run: | 303 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 304 | - name: build 305 | run: | 306 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 307 | - name: tests 308 | run: | 309 | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct 310 | - name: cabal check 311 | run: | 312 | cd ${PKGDIR_microlens} || false 313 | ${CABAL} -vnormal check 314 | cd ${PKGDIR_microlens_contra} || false 315 | ${CABAL} -vnormal check 316 | cd ${PKGDIR_microlens_ghc} || false 317 | ${CABAL} -vnormal check 318 | cd ${PKGDIR_microlens_mtl} || false 319 | ${CABAL} -vnormal check 320 | cd ${PKGDIR_microlens_platform} || false 321 | ${CABAL} -vnormal check 322 | cd ${PKGDIR_microlens_th} || false 323 | ${CABAL} -vnormal check 324 | cd ${PKGDIR_microlens_pro} || false 325 | ${CABAL} -vnormal check 326 | - name: haddock 327 | run: | 328 | if [ $((HCNUMVER < 80200 || HCNUMVER >= 80400)) -ne 0 ] ; then $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi 329 | - name: unconstrained build 330 | run: | 331 | rm -f cabal.project.local 332 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 333 | - name: save cache 334 | if: always() 335 | uses: actions/cache/save@v4 336 | with: 337 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 338 | path: ~/.cabal/store 339 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | dist-newstyle/ 3 | .stack-work/ 4 | .ghc.environment.* 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | .virtualenv 10 | .hsenv 11 | .cabal-sandbox/ 12 | cabal.sandbox.config 13 | cabal.config 14 | cabal-dev 15 | stack*.yaml.lock 16 | TAGS 17 | .DS_Store 18 | *~ 19 | *# 20 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | ## Current goals regarding dependencies 4 | 5 | `microlens` should have no dependencies. `microlens-ghc` should only depend on packages shipped with GHC. `microlens-platform` should only depend on packages shipped with the Haskell Platform. 6 | 7 | ## Current goals regarding GHC versions 8 | 9 | `microlens` tries to support GHC versions as far into the past as possible, unless it becomes too annoying. 10 | 11 | ## Current goals regarding `lens` feature parity 12 | 13 | Any code using `microlens` should also compile and behave the same with `lens`. This implies that `microlens` should never implement any functions or instances, even if useful, unless they also appear in `lens`. This is so that `microlens` users are never locked into `microlens` and can "break out" and switch to `lens` if they feel that they don't care about dependencies anymore. 14 | 15 | It is possible that sometimes code working with `lens` will not compile with `microlens`. It's okay, but should be documented in the haddocks. 16 | 17 | There is no goal to have as many functions and operators from `lens` available in `microlens`. The build time of `microlens` packages should remain small. When people propose adding new functions/operators, use your best judgment. 18 | 19 | ## Hackage revisions vs patch versions 20 | 21 | _So far the policy has been "prefer publishing a new version over making a Hackage revision", because revisions are a bit of an annoyance with Nix, but maybe it's not an issue anymore. — @neongreen, 11 May 2022_ 22 | 23 | ## Adding a new package 24 | 25 | * Add the new package to [README.md](README.md) 26 | * Add build times to [README.md](README.md) (this is perhaps optional) 27 | * Mention the new package in [microlens.cabal](microlens/microlens.cabal) 28 | * Mention the new package in `Lens.Micro` 29 | * [Create a Stackage pull request](https://github.com/fpco/stackage/edit/master/build-constraints.yaml) 30 | * Update this file 31 | 32 | ## Releasing a new version of any package 33 | 34 | The versioning is `0...`. 35 | 36 | Some packages, like `microlens-platform`, are supposed to pin versions of other `microlens` packages. So if a new version of `microlens` is released, a new version of `microlens-platform` also has to be released. 37 | 38 | Specifically, the rules are as follows. 39 | 40 | When a new **patch** version of any package is released, there is no need to bump anything. 41 | 42 | When a new **minor** version of a specific package is released, bump the following: 43 | 44 | * New **`microlens`** → bump `microlens-ghc`, `microlens-platform` 45 | * New **`microlens-ghc`** → bump `microlens-platform` 46 | * New **`microlens-th`** → bump `microlens-platform` 47 | * New **`microlens-mtl`** → bump `microlens-platform` 48 | * New **`microlens-platform`** → \ 49 | * New **`microlens-contra`** → \ 50 | 51 | When a new **major** version is released, bump the following: 52 | 53 | * **microlens** → microlens-ghc, microlens-th, microlens-mtl, microlens-platform, microlens-contra 54 | * **microlens-ghc** → microlens-platform 55 | * **microlens-th** → microlens-platform 56 | * **microlens-mtl** → microlens-platform 57 | * **microlens-platform** → \ 58 | * **microlens-contra** → \ 59 | 60 | Lastly, add “New minor/major release” to the changelogs of: 61 | 62 | * **microlens** → microlens-ghc, microlens-platform (don't forget that microlens-platform will have microlens-ghc bumped as well) 63 | * **microlens-ghc** → microlens-platform 64 | * **microlens-th** → microlens-platform 65 | * **microlens-mtl** → microlens-platform 66 | * **microlens-platform** → \ 67 | * **microlens-contra** → \ 68 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # microlens 2 | 3 | [![Hackage version](https://img.shields.io/hackage/v/microlens.svg?label=Hackage&color=informational)](http://hackage.haskell.org/package/microlens) 4 | [![microlens on Stackage Nightly](https://stackage.org/package/microlens/badge/nightly)](https://stackage.org/nightly/package/microlens) 5 | [![Stackage LTS version](https://www.stackage.org/package/microlens/badge/lts?label=Stackage)](https://www.stackage.org/package/microlens) 6 | [![Cabal build](https://github.com/stevenfontanella/microlens/workflows/Haskell-CI/badge.svg)](https://github.com/stevenfontanella/microlens/actions) 7 | ![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg) 8 | 9 | *A tiny part of the lens library with no dependencies.* 10 | 11 | [lens]: http://hackage.haskell.org/package/lens 12 | 13 | ## If you're completely new to this whole lenses thing 14 | 15 | Read [this tutorial][lens-tutorial]. It's for [lens][], but it applies to 16 | microlens just as well (except for module names). 17 | 18 | [lens-tutorial]: http://hackage.haskell.org/package/lens-tutorial/docs/Control-Lens-Tutorial.html 19 | 20 | ## What is microlens? 21 | 22 | microlens is a lens library, just like [lens][], but smaller. It provides 23 | essential lenses and traversals (like `_1` and `_Just`), as well as ones 24 | which are simply nice to have (like `each`, `at`, and `ix`), and some 25 | combinators (like `failing` and `singular`), but everything else is 26 | stripped. As the result, microlens has no dependencies. However, there are 27 | also separate packages ([microlens-ghc][] and [microlens-platform][]) which 28 | provide additional instances and let you use `each` and friends with various 29 | container types. 30 | 31 | **If you're writing an app, you should probably use [microlens-platform][] 32 | and not microlens.** You'll get additional functions, instances, 33 | `makeLenses`, and other useful things. microlens is mostly for library 34 | writers and for toying with lenses. See [Which microlens library should I use?](#which-microlens-library-should-i-use) for more. 35 | 36 | Here are the build times for all libraries in the family: 37 | 38 | | Package | Build time with dependencies | Pure build time | 39 | | ------------------ | ----------------------------:| ---------------:| 40 | | microlens | 3.5s | 3.5s | 41 | | microlens-th | 7.2s | 4.5s | 42 | | microlens-ghc | 5.7s | 3.3s | 43 | | microlens-mtl | 8.8s | 3.7s | 44 | | microlens-platform | 1m47s | 4.9s | 45 | | microlens-contra | 1m12s | 2.1s | 46 | | microlens-aeson | 3m47s | 9.2s | 47 | | microlens-process | 9.8s | 3.8s | 48 | | **lens** | **4m10s** | **1m12s** | 49 | 50 | Other features: 51 | 52 | * Nicer documentation. 53 | 54 | * Compatibility with lens. If you want to define a `Lens` or a `Traversal` 55 | in your package, you can depend on this package without fear. 56 | 57 | * No awkward renamed functions or any of such nonsense. You can at any 58 | moment replace `Lens.Micro` with `Control.Lens` and get the full power 59 | of lens. There are also no unique to microlens functions which you would 60 | have to rewrite when switching to lens (even though I was tempted to add 61 | some). 62 | 63 | * No Template Haskell dependency. There is a separate package for 64 | generating (lens-compatible) record lenses, which is called 65 | [microlens-th][]. 66 | 67 | * All `INLINE` pragmas sprinkled through lens were preserved. Performance 68 | shouldn't suffer; if it does, it's a bug. 69 | 70 | [microlens]: http://hackage.haskell.org/package/microlens 71 | [microlens-mtl]: http://hackage.haskell.org/package/microlens-mtl 72 | [microlens-th]: http://hackage.haskell.org/package/microlens-th 73 | [microlens-ghc]: http://hackage.haskell.org/package/microlens-ghc 74 | [microlens-platform]: http://hackage.haskell.org/package/microlens-platform 75 | [microlens-pro]: http://hackage.haskell.org/package/microlens-pro 76 | [microlens-contra]: http://hackage.haskell.org/package/microlens-contra 77 | [microlens-aeson]: http://hackage.haskell.org/package/microlens-aeson 78 | [microlens-process]: http://hackage.haskell.org/package/microlens-process 79 | 80 | The reason microlens exists is that lens is a huge library with lots of 81 | dependencies, but lenses are very useful and it's not nice to limit them to 82 | applications and bigger packages. (I'm not talking about exporting lenses, 83 | I'm talking about using lenses to write code.) microlens attempts to be a 84 | library that would be a nearly *unquestionable* win for some people. 85 | 86 | ## Which microlens library should I use? 87 | 88 | If you don't know where to start, start with [microlens-platform][] and change later if necessary. 89 | If you need [`Prism`](https://hackage.haskell.org/package/microlens-pro/docs/Lens-Micro-Pro.html#t:Prism)s or [`Iso`](https://hackage.haskell.org/package/microlens-pro/docs/Lens-Micro-Pro.html#t:Iso)s, use [microlens-pro][] instead. 90 | If you're a library author or otherwise want a low dependency footprint, start with [microlens][] and only add others when needed (likely you will want [microlens-th][] to conveniently generate lenses for your datatypes). 91 | 92 | ## Migrate from [lens][] 93 | 94 | [ilist]: https://github.com/aelve/ilist 95 | 96 | * If you use `ALens`, indexed traversals, or 97 | `Wrapped`, you won't be able to migrate (although some indexed functions 98 | are available elsewhere – containers and vector provide them, and 99 | [ilist][] provides indexed functions for lists). 100 | 101 | * If you have your own instances of `Each`, `At`, `Ix`, `Zoomed`, or 102 | `Field*`, and you don't export them, it's okay. Otherwise you should 103 | keep using lens, since those classes are incompatible with classes 104 | defined in lens. Similarly, if you export any functions with 105 | `At`/`Zoom`/etc constraints, don't migrate. 106 | 107 | * If you export `Getter`s or `Fold`s, you would have to use 108 | [microlens-contra][] for full compatibility, and it has more heavy 109 | dependencies (but still much less heavy than lens). “Full compatibility” 110 | here means that some lens functions (such as `takingWhile`) don't work 111 | with `SimpleGetter` and `SimpleFold` available from the main microlens 112 | package. 113 | 114 | * In the very rare case of using `makeLensesWith` and having 115 | `generateUpdateableOptics` disabled, you'd have to apply 116 | `fromSimpleFold` and `fromSimpleGetter` to folds/getters you export. 117 | Same with fields that have a `forall.` in them. 118 | 119 | Otherwise, everything should work just fine without any code changes – the 120 | microlens API mirrors the lens API. The license is the same, too. 121 | 122 | (The list might look big, but in reality it isn't and in the majority of 123 | cases you'll be able to migrate just fine. “If it compiles and you didn't 124 | have to change any type signatures, it works.”) 125 | 126 | If you're unsure, just open an issue in your project, mention me 127 | (@neongreen), and I'll look at your code and tell you whether it'll work or 128 | not. 129 | 130 | ## All packages in the family 131 | 132 | * [microlens][] – all basic functionality, plus `each`/`at`/`ix` 133 | * [microlens-mtl][] – `+=` and friends, `use`, `zoom`/`magnify` 134 | * [microlens-th][] – `makeLenses` and `makeFields` 135 | * [microlens-ghc][] – everything in microlens + instances to make 136 | `each`/`at`/`ix` usable with arrays, `ByteString`, and containers 137 | * [microlens-platform][] – microlens-ghc + microlens-mtl + microlens-th + 138 | instances for `Text`, `Vector`, and `HashMap` 139 | * [microlens-pro][] – [`Prism`](https://hackage.haskell.org/package/microlens-pro/docs/Lens-Micro-Pro.html#t:Prism)s and [`Iso`](https://hackage.haskell.org/package/microlens-pro/docs/Lens-Micro-Pro.html#t:Iso)s along with related definitions (e.g. `only`, `non`, `review`, etc.) 140 | * [microlens-contra][] – `Fold` and `Getter` that are copies of types in 141 | lens (the reason they're in a separate library is that those types 142 | depend on [contravariant][]) 143 | 144 | [contravariant]: http://hackage.haskell.org/package/contravariant 145 | 146 | Unofficial: 147 | 148 | * [microlens-aeson][] – a port of [lens-aeson][] 149 | * [microlens-process][] - a port of [lens-process][] 150 | 151 | [lens-aeson]: http://hackage.haskell.org/package/lens-aeson 152 | [lens-process]: http://hackage.haskell.org/package/lens-process 153 | 154 | If you're writing a library, use [microlens][] and other packages as needed; 155 | if you're writing an application, perhaps use [microlens-platform][]. 156 | 157 | Versions of microlens-ghc and microlens-platform are incremented whenever 158 | versions of their dependencies are incremented, so if you're using these 159 | packages it's always enough to specify just their versions and nothing else. 160 | In other words, there's no risk of the following happening: 161 | 162 | * a new version of microlens is released, with several functions removed 163 | * version of microlens-platform stays the same 164 | * your code silently stops compiling as the result 165 | 166 | ## Competitors 167 | 168 | * [basic-lens][] – the smallest library ever, containing only `Lens`, 169 | `view`, `set`, and `over` (and no lenses whatsoever). Uses only 1 170 | extension – `RankNTypes` – and thus can be used with e.g. JHC and really 171 | old GHCs. 172 | 173 | * [reasonable-lens][] – a bigger library which has `Lens`, some utilities 174 | (like `view`, `use`, `+=`), `makeLenses` even, but little else – no 175 | lenses (except for `_1` ... `_4`), no `Traversal`, no documentation. 176 | Overall it looks like something slapped together in a hurry by someone 177 | who simply needed to get rid of a lens dependency in one of nir 178 | projects. 179 | 180 | * [lens-simple][] – a single module reexporting parts of [lens-family][]. 181 | It's the most feature-complete library on this list, with both `Lens` 182 | and `Traversal` available, as well as a number of lenses, traversals, 183 | and utilities. However, it has some annoyances – no `each`, `_1` and 184 | `_2` work only on pairs, `ix` doesn't work on lists or arrays and is 185 | thus useless, `at` only works on `Map`, etc. I don't think these will 186 | ever be fixed, as they require defining some ad-hoc typeclasses, and the 187 | current absence of any such typeclasses in lens-family seems to suggest 188 | that the authors consider it a bad idea. 189 | 190 | * [data-lens-light][] – a library which uses a different formulation of 191 | lenses and is thus incompatible with lens (it uses different names, 192 | too). Doesn't actually provide any lenses. 193 | 194 | [basic-lens]: http://hackage.haskell.org/package/basic-lens 195 | [reasonable-lens]: http://hackage.haskell.org/package/reasonable-lens 196 | [lens-simple]: http://hackage.haskell.org/package/lens-simple 197 | [lens-family]: http://hackage.haskell.org/package/lens-family 198 | [data-lens-light]: http://hackage.haskell.org/package/data-lens-light 199 | 200 | So, I recommend: 201 | 202 | * [lens-simple][] if you specifically want a library with a clean, 203 | understandable implementation, even if it's sometimes more cumbersome to 204 | use and can be a bit slower. 205 | 206 | * [lens-family][] if you like [lens-simple][] but don't want the Template 207 | Haskell dependency. 208 | 209 | * [lens][] if you use anything that's not included in [microlens][]. 210 | 211 | * [microlens][] otherwise. 212 | 213 | ## What's bad about this package 214 | 215 | I hate it when people advertise things without also describing their 216 | disadvantages, so I'll list the ones I can think of here. 217 | 218 | * No indexed traversals. 219 | 220 | * This package doesn't actually let you write everything full lens-style 221 | (for instance, there are few operators, myriads of functions generalised 222 | for lenses by adding the `Of` suffix aren't included, etc). On the other 223 | hand, I guess some would actually consider it an advantage. Anyway, if 224 | you want to use lens as a *language* instead of as a tool, you probably 225 | can afford depending on the full package. 226 | 227 | * There are orphan instances, e.g. in the [microlens-ghc][] package. 228 | (However, the only way someone can actually break things is by using 229 | `Lens.Micro.Internal` and ignoring the warnings there, so I think it's 230 | not a huge danger.) 231 | 232 | * There are `set` and `over` in the basic module (i.e. `Lens.Micro`), but 233 | `view` lives in `Lens.Micro.Extras` and it doesn't work in `MonadReader` 234 | (and the version that does is in [microlens-mtl][]). 235 | 236 | * `makeLenses` can generate `SimpleFold` and `SimpleGetter` which are 237 | sli-ightly less general that `Fold` and `Getter` in [lens][]. (If you're 238 | a lens user, you still can convert from those versions to fully general 239 | versions, so you're not doomed or anything – it's just a minor nuisance 240 | / opportunity for confusion. Also, [microlens-contra][] provides true 241 | `Fold` and `Getter`.) 242 | 243 | * The implementation is as cryptic/complicated as [lens][]'s (performance 244 | has its costs). 245 | 246 | ## Design decisions 247 | 248 | microlens doesn't include anything lens doesn't include, even though 249 | sometimes I'm very tempted to improve something in microlens just because I 250 | have control over it. 251 | 252 | I [don't mind][add-example] adding new functions from lens to the package, 253 | even when done in an inconsistent way (e.g. I added `mapAccumLOf` just 254 | because someone needed it, but I haven't added `mapAccumROf` even though 255 | that would've been more consistent). However, I am only able to add 256 | functions as long as microlens stays small, so if you plan to adopt 257 | microlens first and make dozens of requests for function additions later, 258 | this package is not for you. 259 | 260 | [add-example]: https://github.com/stevenfontanella/microlens/issues/79#issuecomment-231720804 261 | 262 | ----------------------------------------------------------------------------- 263 | 264 | Most `*Of` functions aren't included. If you don't know, those are `sumOf`, 265 | `lengthOf`, `setOf`, etc., and they are roughly equivalent to following: 266 | 267 | ~~~ haskell 268 | sumOf l s = sum (s ^.. l) 269 | lengthOf l s = length (s ^.. l) 270 | setOf l s = Set.fromList (s ^.. l) 271 | ~~~ 272 | 273 | (Where `^..` takes something which extracts several targets, and returns a 274 | list of those targets. E.g. `(1, 2) ^.. both` is `[1, 2]`). 275 | 276 | I guess the reason for including them all into `lens` (and there's an awful 277 | lot of them) is somewhere between 278 | 279 | * “they are faster than going through intermediate lists” 280 | * “there are some rare cases when you can use a SomeSpecialisedMonoid but 281 | can't use `Endo [a]`” 282 | * “it's nice to be able to say `sumOf (each._1) [(1,"x"),(2,"y")]` instead 283 | of clumsy `sum . (^.. each._1) $ [(1,"x"),(2,"y")]`” 284 | 285 | I suspect that the last reason is the most important one. The last reason is 286 | also the one I dislike most. 287 | 288 | There are lots of functions which work on lists; lists are something like 289 | “the basic collection/stream type” in Haskell. GHC tries a lot to optimise 290 | code which produces and consumes lists; admittedly, it doesn't always 291 | succeed. `lens` seems to be trying to sidestep this whole list machinery. 292 | 293 | * With lists: one function traverses something and extracts a list of 294 | results, another function does something to those results. 295 | 296 | * With lenses: one function traverses something and takes another function 297 | as a parameter (to know what to do with results). Note that here 298 | `each._1` is the traversing function; it seems like `sumOf` takes it as 299 | a parameter, but in reality `sumOf` merely gives “summation” as the 300 | parameter to the traversing function. 301 | 302 | The latter way is theoretically nicer, but *not* when you've got the rest of 303 | huge ecosystem using lists as the preferred way of information flow, 304 | otherwise you're bound to keep rewriting all functions and adding `Of` to 305 | them. `lens` is good for creating functions which extract data, and for 306 | creating functions which update structures (nested records, etc.), but it's 307 | probably not good enough to make the whole world want to switch to writing 308 | lens-compatible *consumers* of data. 309 | 310 | ----------------------------------------------------------------------------- 311 | 312 | Nothing indexed is included since it's impossible to 313 | get `Conjoined` without adding a pile of dependencies: 314 | 315 | ~~~ 316 | class ( Choice p, Corepresentable p 317 | , Comonad (Corep p), Traversable (Corep p) 318 | , Strong p, Representable p 319 | , Monad (Rep p), MonadFix (Rep p) 320 | , Distributive (Rep p) 321 | , ArrowLoop p, ArrowApply p, ArrowChoice p 322 | ) 323 | => Conjoined p 324 | 325 | class Conjoined p => Indexable i p 326 | ~~~ 327 | 328 | ----------------------------------------------------------------------------- 329 | 330 | Instances of `Ixed`, `Each`, `At`, etc are all split off into separate 331 | packages, which is understandable, because otherwise we'd have to have 332 | [vector][] as a dependency (the alternative is having orphan instances, 333 | which I'm not particularly afraid of). However, even instances for libraries 334 | shipped with GHC (such as [array][]) are in [their own 335 | package][microlens-ghc]. There are 2 reasons for this: 336 | 337 | * I *really* want to be able to say “this library has no dependencies”. 338 | * All those instances actually take quite some time to build (for the same 339 | reason not all instances for tuples are included in the main package). 340 | 341 | [vector]: http://hackage.haskell.org/package/vector 342 | [array]: http://hackage.haskell.org/package/array 343 | 344 | ## What about lens-family? 345 | 346 | [lens-family][] is another small lenses library which is mostly compatible 347 | with lens (unless I decide to nitpick and say that its `makeLensesBy` and 348 | `intAt` aren't present in lens at all), which has few dependencies, and 349 | which provides Template Haskell in a separate package as well. 350 | 351 | [lens-family]: http://hackage.haskell.org/package/lens-family 352 | 353 | It looks like lens-family values cleanness and simplicity, which 354 | unfortunately means that it might've been hard for me (if possible at all) 355 | to convince its maintainer to make changes which would bring it closer to 356 | lens (`INLINE` pragmas, using unsafe `#.` operator, adding `each`, etc). I 357 | actually like cleanness and dislike excessive optimisation (especially of 358 | the kind that is used in lens) too, but making a library *I* would like 359 | wasn't my goal. The goal was to push people who aren't using a lens library 360 | towards using one. 361 | -------------------------------------------------------------------------------- /bump-version.py: -------------------------------------------------------------------------------- 1 | import argparse 2 | import pathlib 3 | import re 4 | from itertools import * 5 | 6 | def get_curr_version(cabal_contents, file_name): 7 | match = re.search(r"version:\s*([\d.]+)", cabal_contents) 8 | if match is None: 9 | raise ValueError(f"No version found in {file_name}") 10 | return match.group(1) 11 | 12 | def increment_version(version, type): 13 | zero, major, minor, *patch = version.split(".") 14 | 15 | if zero != "0": 16 | raise ValueError(f"Version should start with 0, but got {version}") 17 | if len(patch) > 1: 18 | raise ValueError(f"Expected at most one patch version, got {patch}") 19 | 20 | if type == 'major': 21 | major = str(int(major) + 1) 22 | minor = 0 23 | patch = ["0"] 24 | elif type == 'minor': 25 | minor = str(int(minor) + 1) 26 | patch = ["0"] 27 | elif type == 'patch': 28 | if not patch: 29 | patch = ["1"] 30 | else: 31 | patch = [str(int(patch[0]) + 1)] 32 | 33 | return ".".join(["0", major, minor] + patch) 34 | 35 | def prepend_changelog(library, new_version): 36 | changelog = library / "CHANGELOG.md" 37 | if not changelog.is_file(): 38 | raise ValueError(f"No changelog found at {changelog}") 39 | 40 | with changelog.open() as f: 41 | contents = f.read() 42 | 43 | new_contents = "\n".join([f"# {new_version}", "", "* TODO", "", contents]) 44 | 45 | with changelog.open("w") as f: 46 | f.write(new_contents) 47 | 48 | def bump_version(library, type): 49 | cabal_file = library / (library.name + ".cabal") 50 | if not cabal_file.is_file(): 51 | raise ValueError(f"No cabal file found at {cabal_file}") 52 | 53 | with cabal_file.open() as f: 54 | contents = f.read() 55 | 56 | curr_version = get_curr_version(contents, cabal_file) 57 | new_version = increment_version(curr_version, type) 58 | new_contents = re.sub(curr_version, new_version, contents) 59 | 60 | with cabal_file.open("w") as f: 61 | f.write(new_contents) 62 | 63 | prepend_changelog(library, new_version) 64 | print(f"{library.name:<19} {curr_version:<9} -> {new_version:<9}") 65 | 66 | def dependencies_to_update(library, type): 67 | # https://github.com/stevenfontanella/microlens/blob/master/CONTRIBUTING.md#releasing-a-new-version-of-any-package 68 | to_update = [library.name] 69 | if type == 'major': 70 | if library.name == 'microlens': 71 | to_update += ["microlens-ghc", "microlens-th", "microlens-mtl", "microlens-platform", "microlens-contra"] 72 | elif library.name in ['microlens-ghc', 'microlens-th', 'microlens-mtl']: 73 | to_update += ["microlens-platform"] 74 | elif type == 'minor': 75 | if library.name == 'microlens': 76 | to_update += ["microlens-ghc", "microlens-platform"] 77 | elif library.name in ['microlens-ghc', 'microlens-th', 'microlens-mtl']: 78 | to_update += ["microlens-platform"] 79 | return to_update 80 | 81 | def main(libraries, type): 82 | for lib in map(pathlib.Path, set(chain.from_iterable(map(lambda library: dependencies_to_update(library, type), libraries)))): 83 | bump_version(lib, type) 84 | 85 | if __name__ == "__main__": 86 | parser = argparse.ArgumentParser() 87 | parser.add_argument("type", choices=["major", "minor", "patch"]) 88 | parser.add_argument("library", nargs='+', type=pathlib.Path) 89 | args = parser.parse_args() 90 | 91 | main(args.library, args.type) 92 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | jobs-selection: any 3 | 4 | haddock: <8.1 || >8.3 5 | 6 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: microlens/ 2 | microlens-contra/ 3 | microlens-ghc/ 4 | microlens-mtl/ 5 | microlens-platform/ 6 | microlens-th/ 7 | microlens-pro/ 8 | 9 | tests: True 10 | test-show-details: direct 11 | 12 | if impl (ghc >= 9.12) 13 | allow-newer: 14 | , assoc:base 15 | , hashable:base 16 | , bytestring:template-haskell 17 | , indexed-traversable:base 18 | , unordered-containers:template-haskell 19 | , splitmix:base 20 | -------------------------------------------------------------------------------- /microlens-contra/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.1.0.3 2 | 3 | * [#161](https://github.com/stevenfontanella/microlens/pull/161) Fix GHC 9.4 warnings for using `~` without TypeOperators 4 | 5 | # 0.1.0.2 6 | 7 | * Removed the contravariant dependency for GHC 8.6 and later. 8 | 9 | # 0.1.0.1 10 | 11 | * Added forgotten copyright/authorship information. 12 | 13 | # 0.1.0.0 14 | 15 | Initial release. 16 | -------------------------------------------------------------------------------- /microlens-contra/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2016 Edward Kmett, 2 | 2015-2016 Artyom Kazak, 3 | 2018 Monadfix 4 | 5 | All rights reserved. 6 | 7 | Redistribution and use in source and binary forms, with or without 8 | modification, are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright 11 | notice, this list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above 14 | copyright notice, this list of conditions and the following 15 | disclaimer in the documentation and/or other materials provided 16 | with the distribution. 17 | 18 | * Neither the name of Monadfix nor the names of other 19 | contributors may be used to endorse or promote products derived 20 | from this software without specific prior written permission. 21 | 22 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 25 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 26 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 27 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 28 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 29 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 30 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 31 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 32 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 | -------------------------------------------------------------------------------- /microlens-contra/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /microlens-contra/microlens-contra.cabal: -------------------------------------------------------------------------------- 1 | name: microlens-contra 2 | version: 0.1.0.3 3 | synopsis: True folds and getters for microlens 4 | description: 5 | This package provides @Fold@ and @Getter@ that are fully compatible with lens; the downside is that this package depends on contravariant, which in its turn depends on a lot of other packages (but still less than lens). 6 | . 7 | The difference between @Fold@ and @SimpleFold@ is that you can use e.g. @takingWhile@\/@droppingWhile@ and @backwards@ on the former but not on the latter. Most functions from lens that work with @Fold@ would work with @SimpleFold@ as well, though. 8 | . 9 | Starting from GHC 8.6, this package doesn't depend on contravariant anymore. 10 | . 11 | This package is a part of the family; see the readme . 12 | license: BSD3 13 | license-file: LICENSE 14 | author: Edward Kmett, Artyom Kazak 15 | maintainer: Steven Fontanella 16 | homepage: http://github.com/stevenfontanella/microlens 17 | bug-reports: http://github.com/stevenfontanella/microlens/issues 18 | category: Data, Lenses 19 | build-type: Simple 20 | extra-source-files: 21 | CHANGELOG.md 22 | cabal-version: >=1.10 23 | tested-with: 24 | GHC==9.12.1 25 | GHC==9.10.1 26 | GHC==9.8.4 27 | GHC==9.6.6 28 | GHC==9.4.8 29 | GHC==9.2.8 30 | GHC==9.0.2 31 | GHC==8.10.7 32 | GHC==8.8.4 33 | GHC==8.6.5 34 | GHC==8.4.4 35 | GHC==8.2.2 36 | GHC==8.0.2 37 | 38 | source-repository head 39 | type: git 40 | location: https://github.com/stevenfontanella/microlens.git 41 | 42 | library 43 | exposed-modules: Lens.Micro.Contra 44 | -- other-modules: 45 | -- other-extensions: 46 | build-depends: base >=4.5 && <5 47 | , microlens >=0.4 && <0.5 48 | if impl(ghc < 8.6) 49 | build-depends: contravariant >=1.3 && <2 50 | 51 | ghc-options: 52 | -Wall -fwarn-tabs 53 | -O2 -fdicts-cheap -funbox-strict-fields 54 | -fmax-simplifier-iterations=10 55 | 56 | hs-source-dirs: src 57 | default-language: Haskell2010 58 | default-extensions: TypeOperators 59 | -------------------------------------------------------------------------------- /microlens-contra/src/Lens/Micro/Contra.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | 6 | {- | 7 | Module : Lens.Micro.Contra 8 | Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 9 | License : BSD-style (see the file LICENSE) 10 | 11 | This module provides types and functions that require 'Contravariant'; they aren't included in the main microlens package because has a lot of dependencies. 12 | -} 13 | module Lens.Micro.Contra 14 | ( 15 | -- * Getter 16 | Getter, 17 | fromSimpleGetter, 18 | 19 | -- * Fold 20 | Fold, 21 | fromSimpleFold, 22 | ) 23 | where 24 | 25 | 26 | import Lens.Micro 27 | import Lens.Micro.Extras (view) 28 | 29 | import Data.Foldable (traverse_) 30 | import Data.Functor.Contravariant (phantom, Contravariant) 31 | 32 | #if __GLASGOW_HASKELL__ < 710 33 | import Control.Applicative 34 | #endif 35 | 36 | 37 | {- | 38 | This is the same thing as 'SimpleGetter' but more generalised (so that it would fully match the type used in lens). 39 | -} 40 | type Getter s a = 41 | forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s 42 | 43 | {- | 44 | Turn a 'SimpleGetter' into a true 'Getter'. 45 | -} 46 | fromSimpleGetter :: SimpleGetter s a -> Getter s a 47 | fromSimpleGetter g f = phantom . f . view g 48 | {-# INLINE fromSimpleGetter #-} 49 | 50 | {- | 51 | This is the same thing as 'SimpleFold' but more generalised (so that it would fully match the type used in lens). See documentation of 'SimpleFold' for the list of functions that work on 'Fold' but don't work on 'SimpleFold'. 52 | -} 53 | type Fold s a = 54 | forall f. (Contravariant f, Applicative f) => (a -> f a) -> s -> f s 55 | 56 | {- | 57 | Turn a 'SimpleFold' into a true 'Fold'. 58 | -} 59 | fromSimpleFold :: SimpleFold s a -> Fold s a 60 | fromSimpleFold g f = phantom . traverse_ f . toListOf g 61 | {-# INLINE fromSimpleFold #-} 62 | -------------------------------------------------------------------------------- /microlens-ghc/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.4.15.1 2 | 3 | * Allow building with containers 0.8. 4 | 5 | # 0.4.15.0 6 | 7 | * New minor release (microlens-0.4.14.0). 8 | 9 | # 0.4.14.3 10 | 11 | * [#180](https://github.com/stevenfontanella/microlens/pull/180) [#181](https://github.com/stevenfontanella/microlens/pull/181) Support GHC 9.10. 12 | 13 | # 0.4.14.2 14 | 15 | * [#171](https://github.com/stevenfontanella/microlens/pull/171) Support bytestring 0.12. 16 | 17 | # 0.4.14.1 18 | 19 | * [#161](https://github.com/stevenfontanella/microlens/pull/161) Fix GHC 9.4 warning for using `~` without TypeOperators. 20 | 21 | # 0.4.14 22 | 23 | * New minor release (microlens-0.4.13.0). 24 | 25 | # 0.4.13.1 26 | 27 | * New patch release (GHC 9.2.1). 28 | 29 | # 0.4.13 30 | 31 | * New minor release (microlens-0.4.12.0). 32 | 33 | # 0.4.12 34 | 35 | * Added `At` and `Ixed` instances for `Set` and `IntSet` (thanks to @wygulmage). 36 | 37 | # 0.4.11.1 38 | 39 | * No more conditional `Safe` (see [#122](https://github.com/monadfix/microlens/issues/122)). 40 | 41 | # 0.4.11 42 | 43 | * New minor release (microlens-0.4.11). 44 | * Marked `Lens.Micro.GHC.Internal` as `Trustworthy`. 45 | 46 | # 0.4.10 47 | 48 | * New minor release (microlens-0.4.10). 49 | 50 | # 0.4.9.1 51 | 52 | * Bumped containers version. 53 | 54 | # 0.4.9 55 | 56 | * New minor release (microlens-0.4.9). 57 | 58 | # 0.4.8.0 59 | 60 | * New minor release (microlens-0.4.8). 61 | 62 | # 0.4.7.0 63 | 64 | * New minor release (microlens-0.4.7). 65 | 66 | # 0.4.6.0 67 | 68 | * New minor release (microlens-0.4.6). 69 | 70 | # 0.4.5.0 71 | 72 | * New minor release (microlens-0.4.5). 73 | 74 | # 0.4.4.0 75 | 76 | * New minor release (microlens-0.4.4). 77 | 78 | # 0.4.3.0 79 | 80 | * New minor release (microlens-0.4.3). 81 | 82 | # 0.4.2.1 83 | 84 | * Added forgotten copyright/authorship information. 85 | 86 | # 0.4.2.0 87 | 88 | * New minor release (microlens-0.4.2). 89 | 90 | # 0.4.1.0 91 | 92 | * Added `chars`, `packedBytes`, `packedChars`, `unpackedBytes`, `unpackedChars`. 93 | * Added instances for `Strict`. 94 | * New minor release (microlens-0.4.1). 95 | 96 | # 0.4.0.0 97 | 98 | * New major release (microlens-0.4). 99 | 100 | # 0.3.1.0 101 | 102 | * New minor release (microlens-0.3.5). 103 | 104 | # 0.3.0.0 105 | 106 | * Made `Lens.Micro.GHC` export `Lens.Micro` (so, now microlens-ghc works like microlens-platform). 107 | 108 | # 0.2.1.0 109 | 110 | * Added Safe Haskell pragmas. 111 | 112 | # 0.2.0.0 113 | 114 | * Added instances for `Cons` and `Snoc`. 115 | 116 | # 0.1.0.1 117 | 118 | * Bumped microlens version. 119 | 120 | # 0.1.0.0 121 | 122 | Initial release. 123 | -------------------------------------------------------------------------------- /microlens-ghc/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2016 Edward Kmett, 2 | 2015-2016 Artyom Kazak, 3 | 2018 Monadfix 4 | 5 | All rights reserved. 6 | 7 | Redistribution and use in source and binary forms, with or without 8 | modification, are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright 11 | notice, this list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above 14 | copyright notice, this list of conditions and the following 15 | disclaimer in the documentation and/or other materials provided 16 | with the distribution. 17 | 18 | * Neither the name of Monadfix nor the names of other 19 | contributors may be used to endorse or promote products derived 20 | from this software without specific prior written permission. 21 | 22 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 25 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 26 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 27 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 28 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 29 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 30 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 31 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 32 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 | -------------------------------------------------------------------------------- /microlens-ghc/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /microlens-ghc/microlens-ghc.cabal: -------------------------------------------------------------------------------- 1 | name: microlens-ghc 2 | version: 0.4.15.1 3 | synopsis: microlens + array, bytestring, containers, transformers 4 | description: 5 | Use this package instead of if you don't mind depending on all dependencies here – @Lens.Micro.GHC@ reexports everything from @Lens.Micro@ and additionally provides orphan instances of microlens classes for packages coming with GHC (, , , ). 6 | . 7 | The minor and major versions of microlens-ghc are incremented whenever the minor and major versions of microlens are incremented, so you can depend on the exact version of microlens-ghc without specifying the version of microlens you need. 8 | . 9 | This package is a part of the family; see the readme . 10 | license: BSD3 11 | license-file: LICENSE 12 | author: Edward Kmett, Artyom Kazak 13 | maintainer: Steven Fontanella 14 | homepage: http://github.com/stevenfontanella/microlens 15 | bug-reports: http://github.com/stevenfontanella/microlens/issues 16 | category: Data, Lenses 17 | build-type: Simple 18 | extra-source-files: 19 | CHANGELOG.md 20 | cabal-version: >=1.10 21 | tested-with: 22 | GHC==9.12.1 23 | GHC==9.10.1 24 | GHC==9.8.4 25 | GHC==9.6.6 26 | GHC==9.4.8 27 | GHC==9.2.8 28 | GHC==9.0.2 29 | GHC==8.10.7 30 | GHC==8.8.4 31 | GHC==8.6.5 32 | GHC==8.4.4 33 | GHC==8.2.2 34 | GHC==8.0.2 35 | 36 | source-repository head 37 | type: git 38 | location: https://github.com/stevenfontanella/microlens.git 39 | 40 | library 41 | exposed-modules: Lens.Micro.GHC 42 | Lens.Micro.GHC.Internal 43 | -- other-modules: 44 | -- other-extensions: 45 | build-depends: array >=0.3.0.2 && <0.6 46 | , base >=4.5 && <5 47 | , bytestring >=0.9.2.1 && <0.13 48 | , containers >=0.4.0 && <0.9 49 | , microlens ==0.4.14.* 50 | , transformers >=0.2 && <0.7 51 | 52 | ghc-options: 53 | -Wall -fwarn-tabs 54 | -O2 -fdicts-cheap -funbox-strict-fields 55 | -fmax-simplifier-iterations=10 56 | 57 | hs-source-dirs: src 58 | default-language: Haskell2010 59 | default-extensions: TypeOperators 60 | -------------------------------------------------------------------------------- /microlens-ghc/src/Lens/Micro/GHC.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE UndecidableInstances #-} 7 | {-# LANGUAGE Trustworthy #-} 8 | 9 | #ifndef MIN_VERSION_base 10 | #define MIN_VERSION_base(x,y,z) 1 11 | #endif 12 | 13 | {-# OPTIONS_GHC -fno-warn-orphans #-} 14 | 15 | 16 | {- | 17 | Module : Lens.Micro.GHC 18 | Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 19 | License : BSD-style (see the file LICENSE) 20 | 21 | By importing this module you get all functions and types from , as well as the following instances: 22 | 23 | * 'at' for 'Map', 'Set', 'IntMap' and 'IntSet' 24 | 25 | * 'ix' for 26 | 27 | * 'Map', 'Set', 'IntMap' and 'IntSet' 28 | * 'Array' and 'UArray' 29 | * 'Seq' 30 | * strict 'B.ByteString' and lazy 'BL.ByteString' 31 | * 'Tree' 32 | 33 | * 'each' for the same as above, excluding 'Set' and 'IntSet' 34 | 35 | * '_head', '_tail', '_init', '_last' for 36 | 37 | * 'Seq' 38 | * strict and lazy bytestrings 39 | 40 | * 'strict' and 'lazy' for 41 | 42 | * bytestrings 43 | * @StateT@, @WriterT@, @RWST@ 44 | -} 45 | module Lens.Micro.GHC 46 | ( 47 | module Lens.Micro, 48 | packedBytes, unpackedBytes, 49 | packedChars, unpackedChars, 50 | chars, 51 | ) 52 | where 53 | 54 | 55 | import Lens.Micro 56 | import Lens.Micro.Internal 57 | import Lens.Micro.GHC.Internal 58 | 59 | import qualified Data.Map as Map 60 | import Data.Map (Map) 61 | import qualified Data.IntMap as IntMap 62 | import Data.IntMap (IntMap) 63 | import qualified Data.Sequence as Seq 64 | import Data.Sequence (Seq) 65 | import qualified Data.Set as Set 66 | import Data.Set (Set) 67 | import qualified Data.IntSet as IntSet 68 | import Data.IntSet (IntSet) 69 | 70 | import qualified Data.ByteString as B 71 | import qualified Data.ByteString.Lazy as BL 72 | 73 | import Control.Monad.Trans.State.Lazy as Lazy 74 | import Control.Monad.Trans.State.Strict as Strict 75 | import Control.Monad.Trans.Writer.Lazy as Lazy 76 | import Control.Monad.Trans.Writer.Strict as Strict 77 | import Control.Monad.Trans.RWS.Lazy as Lazy 78 | import Control.Monad.Trans.RWS.Strict as Strict 79 | 80 | import Data.Tree 81 | import Data.Array.IArray as Array 82 | import Data.Array.Unboxed 83 | 84 | import Data.Int 85 | import Data.Word 86 | 87 | #if !MIN_VERSION_base(4,8,0) 88 | import Control.Applicative 89 | import Data.Traversable 90 | #endif 91 | 92 | 93 | type instance Index (Map k a) = k 94 | type instance IxValue (Map k a) = a 95 | type instance Index (IntMap a) = Int 96 | type instance IxValue (IntMap a) = a 97 | type instance Index (Set a) = a 98 | type instance IxValue (Set a) = () 99 | type instance Index IntSet = Int 100 | type instance IxValue IntSet = () 101 | type instance Index (Seq a) = Int 102 | type instance IxValue (Seq a) = a 103 | type instance Index (Tree a) = [Int] 104 | type instance IxValue (Tree a) = a 105 | type instance Index (Array.Array i e) = i 106 | type instance IxValue (Array.Array i e) = e 107 | type instance Index (UArray i e) = i 108 | type instance IxValue (UArray i e) = e 109 | type instance Index B.ByteString = Int 110 | type instance IxValue B.ByteString = Word8 111 | type instance Index BL.ByteString = Int64 112 | type instance IxValue BL.ByteString = Word8 113 | 114 | instance Ord k => Ixed (Map k a) where 115 | ix k f m = case Map.lookup k m of 116 | Just v -> f v <&> \v' -> Map.insert k v' m 117 | Nothing -> pure m 118 | {-# INLINE ix #-} 119 | 120 | instance Ixed (IntMap a) where 121 | ix k f m = case IntMap.lookup k m of 122 | Just v -> f v <&> \v' -> IntMap.insert k v' m 123 | Nothing -> pure m 124 | {-# INLINE ix #-} 125 | 126 | instance Ixed (Seq a) where 127 | ix i f m 128 | | 0 <= i && i < Seq.length m = f (Seq.index m i) <&> \a -> Seq.update i a m 129 | | otherwise = pure m 130 | {-# INLINE ix #-} 131 | 132 | instance Ord k => Ixed (Set k) where 133 | ix k f m = if Set.member k m 134 | then f () <&> \() -> Set.insert k m 135 | else pure m 136 | {-# INLINE ix #-} 137 | 138 | instance Ixed IntSet where 139 | ix k f m = if IntSet.member k m 140 | then f () <&> \() -> IntSet.insert k m 141 | else pure m 142 | {-# INLINE ix #-} 143 | 144 | instance Ixed (Tree a) where 145 | ix xs0 f = go xs0 where 146 | go [] (Node a as) = f a <&> \a' -> Node a' as 147 | go (i:is) t@(Node a as) 148 | | i < 0 = pure t 149 | | otherwise = Node a <$> ix i (go is) as 150 | {-# INLINE ix #-} 151 | 152 | instance Ix i => Ixed (Array.Array i e) where 153 | ix i f arr 154 | | inRange (bounds arr) i = f (arr Array.! i) <&> \e -> arr Array.// [(i,e)] 155 | | otherwise = pure arr 156 | {-# INLINE ix #-} 157 | 158 | instance (IArray UArray e, Ix i) => Ixed (UArray i e) where 159 | ix i f arr 160 | | inRange (bounds arr) i = f (arr Array.! i) <&> \e -> arr Array.// [(i,e)] 161 | | otherwise = pure arr 162 | {-# INLINE ix #-} 163 | 164 | instance Ixed B.ByteString where 165 | ix e f s = case B.splitAt e s of 166 | (l, mr) -> case B.uncons mr of 167 | Nothing -> pure s 168 | Just (c, xs) -> f c <&> \d -> B.concat [l, B.singleton d, xs] 169 | {-# INLINE ix #-} 170 | 171 | instance Ixed BL.ByteString where 172 | -- TODO: we could be lazier, returning each chunk as it is passed 173 | ix e f s = case BL.splitAt e s of 174 | (l, mr) -> case BL.uncons mr of 175 | Nothing -> pure s 176 | Just (c, xs) -> f c <&> \d -> BL.append l (BL.cons d xs) 177 | {-# INLINE ix #-} 178 | 179 | instance At (IntMap a) where 180 | #if MIN_VERSION_containers(0,5,8) 181 | at k f = IntMap.alterF f k 182 | #else 183 | at k f m = f mv <&> \r -> case r of 184 | Nothing -> maybe m (const (IntMap.delete k m)) mv 185 | Just v' -> IntMap.insert k v' m 186 | where mv = IntMap.lookup k m 187 | #endif 188 | {-# INLINE at #-} 189 | 190 | instance Ord k => At (Map k a) where 191 | #if MIN_VERSION_containers(0,5,8) 192 | at k f = Map.alterF f k 193 | #else 194 | at k f m = f mv <&> \r -> case r of 195 | Nothing -> maybe m (const (Map.delete k m)) mv 196 | Just v' -> Map.insert k v' m 197 | where mv = Map.lookup k m 198 | #endif 199 | {-# INLINE at #-} 200 | 201 | instance At IntSet where 202 | at k f m = f mv <&> \r -> case r of 203 | Nothing -> maybe m (const (IntSet.delete k m)) mv 204 | Just () -> IntSet.insert k m 205 | where mv = if IntSet.member k m then Just () else Nothing 206 | {-# INLINE at #-} 207 | 208 | instance Ord k => At (Set k) where 209 | at k f m = f mv <&> \r -> case r of 210 | Nothing -> maybe m (const (Set.delete k m)) mv 211 | Just () -> Set.insert k m 212 | where mv = if Set.member k m then Just () else Nothing 213 | {-# INLINE at #-} 214 | 215 | instance (c ~ d) => Each (Map c a) (Map d b) a b where 216 | each = traversed 217 | {-# INLINE each #-} 218 | 219 | instance Each (IntMap a) (IntMap b) a b where 220 | each = traversed 221 | {-# INLINE each #-} 222 | 223 | instance Each (Seq a) (Seq b) a b where 224 | each = traversed 225 | {-# INLINE each #-} 226 | 227 | instance Each (Tree a) (Tree b) a b where 228 | each = traversed 229 | {-# INLINE each #-} 230 | 231 | instance (Ix i, i ~ j) => Each (Array i a) (Array j b) a b where 232 | each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f a) (Array.assocs arr) 233 | {-# INLINE each #-} 234 | 235 | instance (Ix i, IArray UArray a, IArray UArray b, i ~ j) => Each (UArray i a) (UArray j b) a b where 236 | each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f a) (Array.assocs arr) 237 | {-# INLINE each #-} 238 | 239 | instance (a ~ Word8, b ~ Word8) => Each B.ByteString B.ByteString a b where 240 | each = traversedStrictTree 241 | {-# INLINE each #-} 242 | 243 | instance (a ~ Word8, b ~ Word8) => Each BL.ByteString BL.ByteString a b where 244 | each = traversedLazy 245 | {-# INLINE each #-} 246 | 247 | instance Cons (Seq a) (Seq b) a b where 248 | _Cons f s = case Seq.viewl s of 249 | x Seq.:< xs -> uncurry (Seq.<|) <$> f (x, xs) 250 | Seq.EmptyL -> pure Seq.empty 251 | {-# INLINE _Cons #-} 252 | 253 | instance Snoc (Seq a) (Seq b) a b where 254 | _Snoc f s = case Seq.viewr s of 255 | xs Seq.:> x -> uncurry (Seq.|>) <$> f (xs, x) 256 | Seq.EmptyR -> pure Seq.empty 257 | {-# INLINE _Snoc #-} 258 | 259 | instance Cons B.ByteString B.ByteString Word8 Word8 where 260 | _Cons f s = case B.uncons s of 261 | Just x -> uncurry B.cons <$> f x 262 | Nothing -> pure B.empty 263 | {-# INLINE _Cons #-} 264 | 265 | instance Cons BL.ByteString BL.ByteString Word8 Word8 where 266 | _Cons f s = case BL.uncons s of 267 | Just x -> uncurry BL.cons <$> f x 268 | Nothing -> pure BL.empty 269 | {-# INLINE _Cons #-} 270 | 271 | instance Snoc B.ByteString B.ByteString Word8 Word8 where 272 | _Snoc f s = if B.null s 273 | then pure B.empty 274 | else uncurry B.snoc <$> f (B.init s, B.last s) 275 | {-# INLINE _Snoc #-} 276 | 277 | instance Snoc BL.ByteString BL.ByteString Word8 Word8 where 278 | _Snoc f s = if BL.null s 279 | then pure BL.empty 280 | else uncurry BL.snoc <$> f (BL.init s, BL.last s) 281 | {-# INLINE _Snoc #-} 282 | 283 | instance Strict BL.ByteString B.ByteString where 284 | strict f s = fromStrict <$> f (toStrict s) 285 | {-# INLINE strict #-} 286 | lazy f s = toStrict <$> f (fromStrict s) 287 | {-# INLINE lazy #-} 288 | 289 | instance Strict (Lazy.StateT s m a) (Strict.StateT s m a) where 290 | strict f s = Lazy.StateT . Strict.runStateT <$> 291 | f (Strict.StateT (Lazy.runStateT s)) 292 | {-# INLINE strict #-} 293 | lazy f s = Strict.StateT . Lazy.runStateT <$> 294 | f (Lazy.StateT (Strict.runStateT s)) 295 | {-# INLINE lazy #-} 296 | 297 | instance Strict (Lazy.WriterT w m a) (Strict.WriterT w m a) where 298 | strict f s = Lazy.WriterT . Strict.runWriterT <$> 299 | f (Strict.WriterT (Lazy.runWriterT s)) 300 | {-# INLINE strict #-} 301 | lazy f s = Strict.WriterT . Lazy.runWriterT <$> 302 | f (Lazy.WriterT (Strict.runWriterT s)) 303 | {-# INLINE lazy #-} 304 | 305 | instance Strict (Lazy.RWST r w s m a) (Strict.RWST r w s m a) where 306 | strict f s = Lazy.RWST . Strict.runRWST <$> 307 | f (Strict.RWST (Lazy.runRWST s)) 308 | {-# INLINE strict #-} 309 | lazy f s = Strict.RWST . Lazy.runRWST <$> 310 | f (Lazy.RWST (Strict.runRWST s)) 311 | {-# INLINE lazy #-} 312 | -------------------------------------------------------------------------------- /microlens-ghc/src/Lens/Micro/GHC/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE BangPatterns #-} 3 | {-# LANGUAGE Trustworthy #-} 4 | 5 | 6 | {- | 7 | Module : Lens.Micro.GHC.Internal 8 | Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 9 | License : BSD-style (see the file LICENSE) 10 | -} 11 | module Lens.Micro.GHC.Internal 12 | ( 13 | IsByteString(..), 14 | -- * Unpacking bytestrings 15 | unpackStrict, 16 | unpackStrict8, 17 | unpackLazy, 18 | unpackLazy8, 19 | -- * Converting bytestrings between strict and lazy 20 | fromStrict, 21 | toStrict, 22 | -- * Traversing bytestrings 23 | traversedStrictTree, 24 | traversedStrictTree8, 25 | traversedLazy, 26 | traversedLazy8, 27 | ) 28 | where 29 | 30 | 31 | import Lens.Micro 32 | import Lens.Micro.Internal 33 | 34 | import qualified Data.ByteString as B 35 | import qualified Data.ByteString.Lazy as BL 36 | import qualified Data.ByteString.Char8 as B8 37 | import qualified Data.ByteString.Lazy.Char8 as BL8 38 | import qualified Data.ByteString.Internal as BI 39 | import qualified Data.ByteString.Unsafe as BU 40 | 41 | import Data.Int 42 | import Data.Word 43 | import Data.Char 44 | import Data.Monoid 45 | import Foreign.Storable 46 | import Foreign.Ptr 47 | import Data.Bits 48 | #if MIN_VERSION_base(4,8,0) 49 | import Foreign.ForeignPtr 50 | #else 51 | import Foreign.ForeignPtr.Safe 52 | #endif 53 | import GHC.ForeignPtr (mallocPlainForeignPtrBytes) 54 | #if !MIN_VERSION_bytestring(0,10,4) 55 | import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) 56 | #endif 57 | import GHC.IO (unsafeDupablePerformIO) 58 | import GHC.Base (unsafeChr) 59 | 60 | #if !MIN_VERSION_base(4,8,0) 61 | import Control.Applicative 62 | #endif 63 | 64 | 65 | class IsByteString t where 66 | {- | 67 | Treat a list of bytes as a strict or lazy @ByteString@. 68 | -} 69 | packedBytes :: Lens' [Word8] t 70 | {- | 71 | Treat a strict or lazy @ByteString@ as a list of bytes. 72 | -} 73 | unpackedBytes :: Lens' t [Word8] 74 | {- | 75 | Treat a 'String' as a strict or lazy @ByteString@. (Note that it will garble characters above 0xFF, same as 'B8.pack' does.) 76 | -} 77 | packedChars :: Lens' String t 78 | {- | 79 | Treat a strict or lazy @ByteString@ as a 'String'. (Just as 'packedChars', it will garble characters above 0xFF.) 80 | -} 81 | unpackedChars :: Lens' t String 82 | {- | 83 | Traverse characters in a strict or lazy @ByteString@ (to traverse bytes instead of characters, use 'each'). 84 | -} 85 | chars :: Traversal' t Char 86 | 87 | -- When writing back to the 'ByteString' it is assumed that every 'Char' 88 | -- lies between @'\x00'@ and @'\xff'@. 89 | 90 | instance IsByteString B.ByteString where 91 | packedBytes f s = unpackStrict <$> f (B.pack s) 92 | {-# INLINE packedBytes #-} 93 | unpackedBytes f s = B.pack <$> f (unpackStrict s) 94 | {-# INLINE unpackedBytes #-} 95 | packedChars f s = unpackStrict8 <$> f (B8.pack s) 96 | {-# INLINE packedChars #-} 97 | unpackedChars f s = B8.pack <$> f (unpackStrict8 s) 98 | {-# INLINE unpackedChars #-} 99 | chars = traversedStrictTree8 100 | {-# INLINE chars #-} 101 | 102 | instance IsByteString BL.ByteString where 103 | packedBytes f s = unpackLazy <$> f (BL.pack s) 104 | {-# INLINE packedBytes #-} 105 | unpackedBytes f s = BL.pack <$> f (unpackLazy s) 106 | {-# INLINE unpackedBytes #-} 107 | packedChars f s = unpackLazy8 <$> f (BL8.pack s) 108 | {-# INLINE packedChars #-} 109 | unpackedChars f s = BL8.pack <$> f (unpackLazy8 s) 110 | {-# INLINE unpackedChars #-} 111 | chars = traversedLazy8 112 | {-# INLINE chars #-} 113 | 114 | -- unpacking 115 | 116 | unpackStrict :: B.ByteString -> [Word8] 117 | #if MIN_VERSION_bytestring(0,10,4) 118 | unpackStrict = B.unpack 119 | #else 120 | unpackStrict (BI.PS fp off len) = 121 | let p = unsafeForeignPtrToPtr fp 122 | in go (p `plusPtr` off) (p `plusPtr` (off+len)) 123 | where 124 | go !p !q | p == q = [] 125 | | otherwise = let !x = BI.inlinePerformIO $ do 126 | x' <- peek p 127 | touchForeignPtr fp 128 | return x' 129 | in x : go (p `plusPtr` 1) q 130 | #endif 131 | {-# INLINE unpackStrict #-} 132 | 133 | unpackStrict8 :: B.ByteString -> String 134 | #if MIN_VERSION_bytestring(0,10,4) 135 | unpackStrict8 = B8.unpack 136 | #else 137 | unpackStrict8 (BI.PS fp off len) = 138 | let p = unsafeForeignPtrToPtr fp 139 | in go (p `plusPtr` off) (p `plusPtr` (off+len)) 140 | where 141 | go !p !q | p == q = [] 142 | | otherwise = let !x = BI.inlinePerformIO $ do 143 | x' <- peek p 144 | touchForeignPtr fp 145 | return x' 146 | in w2c x : go (p `plusPtr` 1) q 147 | #endif 148 | {-# INLINE unpackStrict8 #-} 149 | 150 | unpackLazy :: BL.ByteString -> [Word8] 151 | unpackLazy = BL.unpack 152 | {-# INLINE unpackLazy #-} 153 | 154 | unpackLazy8 :: BL.ByteString -> String 155 | unpackLazy8 = BL8.unpack 156 | {-# INLINE unpackLazy8 #-} 157 | 158 | -- converting between strict and lazy 159 | 160 | fromStrict :: B.ByteString -> BL.ByteString 161 | #if MIN_VERSION_bytestring(0,10,0) 162 | fromStrict = BL.fromStrict 163 | #else 164 | fromStrict = \x -> BL.fromChunks [x] 165 | #endif 166 | {-# INLINE fromStrict #-} 167 | 168 | toStrict :: BL.ByteString -> B.ByteString 169 | #if MIN_VERSION_bytestring(0,10,0) 170 | toStrict = BL.toStrict 171 | #else 172 | toStrict = B.concat . BL.toChunks 173 | #endif 174 | {-# INLINE toStrict #-} 175 | 176 | -- traversing 177 | 178 | grain :: Int 179 | grain = 32 180 | {-# INLINE grain #-} 181 | 182 | traversedStrictTree :: Traversal' B.ByteString Word8 183 | traversedStrictTree afb bs = unsafeCreate len <$> go 0 len 184 | where 185 | len = B.length bs 186 | go !i !j 187 | | i + grain < j, k <- i + shiftR (j - i) 1 = (\l r q -> l q >> r q) <$> go i k <*> go k j 188 | | otherwise = run i j 189 | run !i !j 190 | | i == j = pure (\_ -> return ()) 191 | | otherwise = let !x = BU.unsafeIndex bs i 192 | in (\y ys q -> pokeByteOff q i y >> ys q) <$> afb x <*> run (i + 1) j 193 | {-# INLINE [0] traversedStrictTree #-} 194 | 195 | {-# RULES 196 | "bytes -> map" 197 | traversedStrictTree = sets B.map :: ASetter' B.ByteString Word8; 198 | "bytes -> foldr" 199 | traversedStrictTree = foldring B.foldr :: Getting (Endo r) B.ByteString Word8; 200 | #-} 201 | 202 | traversedStrictTree8 :: Traversal' B.ByteString Char 203 | traversedStrictTree8 pafb bs = unsafeCreate len <$> go 0 len 204 | where 205 | len = B.length bs 206 | go !i !j 207 | | i + grain < j = let k = i + shiftR (j - i) 1 208 | in (\l r q -> l q >> r q) <$> go i k <*> go k j 209 | | otherwise = run i j 210 | run !i !j 211 | | i == j = pure (\_ -> return ()) 212 | | otherwise = let !x = BU.unsafeIndex bs i 213 | in (\y ys q -> pokeByteOff q i (c2w y) >> ys q) 214 | <$> pafb (w2c x) 215 | <*> run (i + 1) j 216 | {-# INLINE [0] traversedStrictTree8 #-} 217 | 218 | {-# RULES 219 | "chars -> map" 220 | traversedStrictTree8 = sets B8.map :: ASetter' B.ByteString Char; 221 | "chars -> foldr" 222 | traversedStrictTree8 = foldring B8.foldr :: Getting (Endo r) B.ByteString Char; 223 | #-} 224 | 225 | traversedLazy :: Traversal' BL.ByteString Word8 226 | traversedLazy pafb = \lbs -> foldrChunks go (\_ -> pure BL.empty) lbs 0 227 | where 228 | go c fcs acc = BL.append . fromStrict 229 | <$> traversedStrictTree pafb c 230 | <*> fcs acc' 231 | where 232 | acc' :: Int64 233 | !acc' = acc + fromIntegral (B.length c) 234 | {-# INLINE [1] traversedLazy #-} 235 | 236 | {-# RULES 237 | "sets lazy bytestring" 238 | traversedLazy = sets BL.map :: ASetter' BL.ByteString Word8; 239 | "gets lazy bytestring" 240 | traversedLazy = foldring BL.foldr :: Getting (Endo r) BL.ByteString Word8; 241 | #-} 242 | 243 | traversedLazy8 :: Traversal' BL.ByteString Char 244 | traversedLazy8 pafb = \lbs -> foldrChunks go (\_ -> pure BL.empty) lbs 0 245 | where 246 | go c fcs acc = BL.append . fromStrict 247 | <$> traversedStrictTree8 pafb c 248 | <*> fcs acc' 249 | where 250 | acc' :: Int64 251 | !acc' = acc + fromIntegral (B.length c) 252 | {-# INLINE [1] traversedLazy8 #-} 253 | 254 | {-# RULES 255 | "sets lazy bytestring" 256 | traversedLazy8 = sets BL8.map :: ASetter' BL8.ByteString Char; 257 | "gets lazy bytestring" 258 | traversedLazy8 = foldring BL8.foldr :: Getting (Endo r) BL8.ByteString Char; 259 | #-} 260 | 261 | -- A way of creating ByteStrings outside the IO monad. The @Int@ 262 | -- argument gives the final size of the ByteString. Unlike 263 | -- 'createAndTrim' the ByteString is not reallocated if the final size 264 | -- is less than the estimated size. 265 | unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> B.ByteString 266 | unsafeCreate l f = unsafeDupablePerformIO (create l f) 267 | {-# INLINE unsafeCreate #-} 268 | 269 | -- Create ByteString of size @l@ and use action @f@ to fill its contents. 270 | create :: Int -> (Ptr Word8 -> IO ()) -> IO B.ByteString 271 | create l f = do 272 | fp <- mallocPlainForeignPtrBytes l 273 | withForeignPtr fp $ \p -> f p 274 | return $! BI.PS fp 0 l 275 | {-# INLINE create #-} 276 | 277 | foldrChunks :: (B.ByteString -> r -> r) -> r -> BL.ByteString -> r 278 | #if MIN_VERSION_bytestring(0,10,0) 279 | foldrChunks = BL.foldrChunks 280 | #else 281 | foldrChunks f z b = foldr f z (BL.toChunks b) 282 | #endif 283 | {-# INLINE foldrChunks #-} 284 | 285 | w2c :: Word8 -> Char 286 | w2c = unsafeChr . fromIntegral 287 | {-# INLINE w2c #-} 288 | 289 | c2w :: Char -> Word8 290 | c2w = fromIntegral . ord 291 | {-# INLINE c2w #-} 292 | -------------------------------------------------------------------------------- /microlens-mtl/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.2.1.0 2 | 3 | * Export `Zoomed` type family. 4 | 5 | # 0.2.0.3 6 | 7 | * [#161](https://github.com/stevenfontanella/microlens/pull/161) Fix GHC 9.4 warning for using `~` without TypeOperators 8 | * [#162](https://github.com/stevenfontanella/microlens/pull/162) Fix GHC warning for depending on StarIsType 9 | 10 | # 0.2.0.2 11 | 12 | * Added support for mtl 2.3 and transformers 0.6 per [#152](https://github.com/stevenfontanella/microlens/issues/152). 13 | 14 | # 0.2.0.1 15 | 16 | * No more conditional `Safe` (see [#122](https://github.com/monadfix/microlens/issues/122)). 17 | 18 | # 0.2.0 19 | 20 | * Removed of equality constraints on `Zoom` and `Magnify`, as was done in `lens` earlier. This allows instances of `Zoom` and `Magnify` for `FreeT`. (Thanks to @treeowl.) 21 | 22 | # 0.1.11.1 23 | 24 | * Fixed compilation on GHC 8.4. 25 | 26 | # 0.1.11.0 27 | 28 | * Exported `Focusing`, etc. from `Lens.Micro.Mtl.Internal`. 29 | * Added `&~`. 30 | 31 | # 0.1.10.0 32 | 33 | * Added ` family; see the readme . 8 | license: BSD3 9 | license-file: LICENSE 10 | author: Edward Kmett, Artyom Kazak 11 | maintainer: Steven Fontanella 12 | homepage: http://github.com/stevenfontanella/microlens 13 | bug-reports: http://github.com/stevenfontanella/microlens/issues 14 | -- copyright: 15 | category: Data, Lenses 16 | build-type: Simple 17 | extra-source-files: 18 | CHANGELOG.md 19 | cabal-version: >=1.10 20 | tested-with: 21 | GHC==9.12.1 22 | GHC==9.10.1 23 | GHC==9.8.4 24 | GHC==9.6.6 25 | GHC==9.4.8 26 | GHC==9.2.8 27 | GHC==9.0.2 28 | GHC==8.10.7 29 | GHC==8.8.4 30 | GHC==8.6.5 31 | GHC==8.4.4 32 | GHC==8.2.2 33 | GHC==8.0.2 34 | 35 | source-repository head 36 | type: git 37 | location: https://github.com/stevenfontanella/microlens.git 38 | 39 | library 40 | exposed-modules: Lens.Micro.Mtl 41 | Lens.Micro.Mtl.Internal 42 | -- other-extensions: 43 | build-depends: base >=4.5 && <5 44 | , microlens >=0.4 && <0.5 45 | , mtl >=2.0.1 && <2.4 46 | , transformers >=0.2 && <0.7 47 | , transformers-compat >=0.4 && <1 48 | 49 | ghc-options: 50 | -Wall -fwarn-tabs 51 | -O2 -fdicts-cheap -funbox-strict-fields 52 | -fmax-simplifier-iterations=10 53 | 54 | hs-source-dirs: src 55 | default-language: Haskell2010 56 | default-extensions: TypeOperators 57 | -------------------------------------------------------------------------------- /microlens-mtl/src/Lens/Micro/Mtl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE FunctionalDependencies #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | {-# LANGUAGE Trustworthy #-} 8 | 9 | -- This is needed because ErrorT is deprecated. 10 | {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 11 | 12 | 13 | {- | 14 | Module : Lens.Micro.Mtl 15 | Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 16 | License : BSD-style (see the file LICENSE) 17 | -} 18 | module Lens.Micro.Mtl 19 | ( 20 | -- * Getting 21 | view, preview, 22 | use, preuse, 23 | 24 | -- * Setting 25 | (%=), modifying, 26 | (.=), assign, 27 | (?=), 28 | (<~), 29 | 30 | -- * Convenience 31 | (&~), 32 | 33 | -- * Specialised modifying operators 34 | -- $arith-note 35 | (+=), (-=), (*=), (//=), 36 | 37 | -- * Setting with passthrough 38 | (<%=), (<.=), (>> view _1 (1, 2) 65 | 1 66 | 67 | When you're using 'Reader.Reader' for config and your config type has lenses generated for it, most of the time you'll be using 'view' instead of 'Reader.asks': 68 | 69 | @ 70 | doSomething :: ('MonadReader' Config m) => m Int 71 | doSomething = do 72 | thingy <- 'view' setting1 -- same as “'Reader.asks' ('^.' setting1)” 73 | anotherThingy <- 'view' setting2 74 | ... 75 | @ 76 | -} 77 | view :: MonadReader s m => Getting a s a -> m a 78 | view l = Reader.asks (getConst #. l Const) 79 | {-# INLINE view #-} 80 | 81 | {- | 82 | 'preview' is a synonym for ('^?'), generalised for 'MonadReader' (just like 'view', which is a synonym for ('^.')). 83 | 84 | >>> preview each [1..5] 85 | Just 1 86 | -} 87 | preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a) 88 | preview l = Reader.asks (getFirst #. foldMapOf l (First #. Just)) 89 | {-# INLINE preview #-} 90 | 91 | {- | 92 | 'use' is ('^.') (or 'view') which implicitly operates on the state; for instance, if your state is a record containing a field @foo@, you can write 93 | 94 | @ 95 | x \<- 'use' foo 96 | @ 97 | 98 | to extract @foo@ from the state. In other words, 'use' is the same as 'State.gets', but for getters instead of functions. 99 | 100 | The implementation of 'use' is straightforward: 101 | 102 | @ 103 | 'use' l = 'State.gets' ('view' l) 104 | @ 105 | 106 | If you need to extract something with a fold or traversal, you need 'preuse'. 107 | -} 108 | use :: MonadState s m => Getting a s a -> m a 109 | use l = State.gets (view l) 110 | {-# INLINE use #-} 111 | 112 | {- | 113 | 'preuse' is ('^?') (or 'preview') which implicitly operates on the state – it takes the state and applies a traversal (or fold) to it to extract the 1st element the traversal points at. 114 | 115 | @ 116 | 'preuse' l = 'State.gets' ('preview' l) 117 | @ 118 | -} 119 | preuse :: MonadState s m => Getting (First a) s a -> m (Maybe a) 120 | preuse l = State.gets (preview l) 121 | {-# INLINE preuse #-} 122 | 123 | {- | 124 | This can be used to chain lens operations using @op=@ syntax 125 | rather than @op~@ syntax for simple non-type-changing cases. 126 | >>> (10,20) & _1 .~ 30 & _2 .~ 40 127 | (30,40) 128 | 129 | >>> (10,20) &~ do _1 .= 30; _2 .= 40 130 | (30,40) 131 | 132 | This does not support type-changing assignment, /e.g./ 133 | 134 | >>> (10,20) & _1 .~ "hello" 135 | ("hello",20) 136 | -} 137 | (&~) :: s -> State s a -> s 138 | s &~ l = execState l s 139 | {-# INLINE (&~) #-} 140 | 141 | infixl 1 &~ 142 | 143 | {- | 144 | Modify state by “assigning” a value to a part of the state. 145 | 146 | This is merely ('.~') which works in 'MonadState': 147 | 148 | @ 149 | l '.=' x = 'State.modify' (l '.~' x) 150 | @ 151 | 152 | If you also want to know the value that was replaced by ('.='), use ('<<.='). 153 | -} 154 | (.=) :: MonadState s m => ASetter s s a b -> b -> m () 155 | l .= x = State.modify (l .~ x) 156 | {-# INLINE (.=) #-} 157 | 158 | infix 4 .= 159 | 160 | {- | 161 | A synonym for ('.='). 162 | -} 163 | assign :: MonadState s m => ASetter s s a b -> b -> m () 164 | assign l x = l .= x 165 | {-# INLINE assign #-} 166 | 167 | {- | 168 | ('?=') is a version of ('.=') that wraps the value into 'Just' before setting. 169 | 170 | @ 171 | l '?=' b = l '.=' Just b 172 | @ 173 | 174 | It can be useful in combination with 'at'. 175 | -} 176 | (?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m () 177 | l ?= b = l .= Just b 178 | {-# INLINE (?=) #-} 179 | 180 | infix 4 ?= 181 | 182 | {- | 183 | ('<~') is a version of ('.=') that takes a monadic value (and then executes it and assigns the result to the lens). 184 | 185 | @ 186 | l '<~' mb = do 187 | b <- mb 188 | l '.=' b 189 | @ 190 | -} 191 | (<~) :: MonadState s m => ASetter s s a b -> m b -> m () 192 | l <~ mb = mb >>= (l .=) 193 | {-# INLINE (<~) #-} 194 | 195 | infixr 2 <~ 196 | 197 | {- | 198 | Modify state by applying a function to a part of the state. An example: 199 | 200 | >>> execState (do _1 %= (+1); _2 %= reverse) (1,"hello") 201 | (2,"olleh") 202 | 203 | Implementation: 204 | 205 | @ 206 | l '%=' f = 'State.modify' (l '%~' f) 207 | @ 208 | 209 | If you also want to get the value before\/after the modification, use ('<<%=')\/('<%='). 210 | 211 | There are a few specialised versions of ('%=') which mimic C operators: 212 | 213 | * ('+=') for addition 214 | * ('-=') for substraction 215 | * ('*=') for multiplication 216 | * ('//=') for division 217 | -} 218 | (%=) :: (MonadState s m) => ASetter s s a b -> (a -> b) -> m () 219 | l %= f = State.modify (l %~ f) 220 | {-# INLINE (%=) #-} 221 | 222 | infix 4 %= 223 | 224 | {- | 225 | A synonym for ('%='). 226 | -} 227 | modifying :: (MonadState s m) => ASetter s s a b -> (a -> b) -> m () 228 | modifying l f = l %= f 229 | {-# INLINE modifying #-} 230 | 231 | {- $arith-note 232 | 233 | The following operators mimic well-known C operators ('+=', '-=', etc). ('//=') stands for division. 234 | 235 | They're implemented like this: 236 | 237 | @ 238 | l '+=' x = l '%=' (+x) 239 | l '-=' x = l '%=' ('subtract' x) 240 | ... 241 | @ 242 | -} 243 | 244 | (+=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m () 245 | l += x = l %= (+x) 246 | {-# INLINE (+=) #-} 247 | 248 | infix 4 += 249 | 250 | (-=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m () 251 | l -= x = l %= (subtract x) 252 | {-# INLINE (-=) #-} 253 | 254 | infix 4 -= 255 | 256 | (*=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m () 257 | l *= x = l %= (*x) 258 | {-# INLINE (*=) #-} 259 | 260 | infix 4 *= 261 | 262 | (//=) :: (MonadState s m, Fractional a) => ASetter s s a a -> a -> m () 263 | l //= x = l %= (/x) 264 | {-# INLINE (//=) #-} 265 | 266 | infix 4 //= 267 | 268 | {- | 269 | Modify state and return the modified (new) value. 270 | 271 | @ 272 | l '<%=' f = do 273 | l '%=' f 274 | 'use' l 275 | @ 276 | -} 277 | (<%=) :: MonadState s m => LensLike ((,) b) s s a b -> (a -> b) -> m b 278 | l <%= f = l %%= (\a -> (a, a)) . f 279 | {-# INLINE (<%=) #-} 280 | 281 | infix 4 <%= 282 | 283 | {- | 284 | Modify state and return the old value (i.e. as it was before the modificaton). 285 | 286 | @ 287 | l '<<%=' f = do 288 | old <- 'use' l 289 | l '%=' f 290 | return old 291 | @ 292 | -} 293 | (<<%=) :: MonadState s m => LensLike ((,) a) s s a b -> (a -> b) -> m a 294 | l <<%= f = l %%= (\a -> (a, f a)) 295 | {-# INLINE (<<%=) #-} 296 | 297 | infix 4 <<%= 298 | 299 | {- | 300 | Set state and return the old value. 301 | 302 | @ 303 | l '<<.=' b = do 304 | old <- 'use' l 305 | l '.=' b 306 | return old 307 | @ 308 | -} 309 | (<<.=) :: MonadState s m => LensLike ((,) a) s s a b -> b -> m a 310 | l <<.= b = l %%= (\a -> (a, b)) 311 | {-# INLINE (<<.=) #-} 312 | 313 | infix 4 <<.= 314 | 315 | {- | 316 | Set state and return new value. 317 | 318 | @ 319 | l '<.=' b = do 320 | l '.=' b 321 | return b 322 | @ 323 | -} 324 | (<.=) :: MonadState s m => LensLike ((,) b) s s a b -> b -> m b 325 | l <.= b = l <%= const b 326 | {-# INLINE (<.=) #-} 327 | 328 | infix 4 <.= 329 | 330 | {- | 331 | (' LensLike ((,) b) s s a (Maybe b) -> b -> m b 342 | l LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r 348 | #if MIN_VERSION_mtl(2,1,1) 349 | l %%= f = State.state (l f) 350 | #else 351 | l %%= f = do 352 | (r, s) <- State.gets (l f) 353 | State.put s 354 | return r 355 | #endif 356 | {-# INLINE (%%=) #-} 357 | 358 | infix 4 %%= 359 | -------------------------------------------------------------------------------- /microlens-platform/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.4.4.0 2 | 3 | * New minor release (microlens-0.4.14.0, microlens-mtl-0.2.1.0). 4 | 5 | # 0.4.3.6 6 | 7 | * [#182](https://github.com/stevenfontanella/microlens/pull/182) Support GHC 9.12. 8 | 9 | # 0.4.3.5 10 | 11 | * [#131](https://github.com/stevenfontanella/microlens/issues/131) Add `At` and `Ixed` instance for `HashSet`. 12 | 13 | # 0.4.3.4 14 | 15 | * [#171](https://github.com/stevenfontanella/microlens/pull/171) Support text 2.1. 16 | 17 | # 0.4.3.3 18 | 19 | * [#161](https://github.com/stevenfontanella/microlens/pull/161) Fix GHC 9.4 warning for using `~` without TypeOperators. 20 | 21 | # 0.4.3.2 22 | 23 | * [#156](https://github.com/stevenfontanella/microlens/pull/156) Add a missing upper bound for text dependency. 24 | 25 | # 0.4.3.1 26 | 27 | * Bumped `text` upper bound to support 2.0. 28 | 29 | # 0.4.3 30 | 31 | * New minor release (microlens-0.4.13.0, microlens-ghc-0.4.14). 32 | 33 | # 0.4.2.1 34 | 35 | * Bumped `hashable` upper bound. 36 | 37 | # 0.4.2 38 | 39 | * New minor release (microlens-0.4.12.0, microlens-ghc-0.4.13). 40 | 41 | # 0.4.1 42 | 43 | * New minor release (microlens-ghc-0.4.12). 44 | 45 | # 0.4.0 46 | 47 | * New major release (microlens-0.4.11, microlens-ghc-0.4.11, microlens-th-0.4.3, microlens-mtl-0.2.0). 48 | 49 | # 0.3.11 50 | 51 | * New minor release (microlens-0.4.10, microlens-ghc-0.4.10). 52 | 53 | # 0.3.10 54 | 55 | * New minor release (microlens-0.4.9, microlens-ghc-0.4.9, microlens-th-0.4.2). 56 | 57 | # 0.3.9.0 58 | 59 | * New minor release (microlens-mtl-0.1.11). 60 | 61 | # 0.3.8.0 62 | 63 | * New minor release (microlens-0.4.8, microlens-ghc-0.4.8). 64 | 65 | # 0.3.7.1 66 | 67 | * Bumped `vector` upper bound. 68 | 69 | # 0.3.7.0 70 | 71 | * New minor release (microlens-th-0.4.1). 72 | 73 | # 0.3.6.0 74 | 75 | * New minor release (microlens-0.4.7, microlens-ghc-0.4.7). 76 | 77 | # 0.3.5.0 78 | 79 | * New minor release (microlens-mtl-0.1.10). 80 | 81 | # 0.3.4.0 82 | 83 | * New minor release (microlens-0.4.6, microlens-ghc-0.4.6). 84 | 85 | # 0.3.3.0 86 | 87 | * New minor release (microlens-mtl-0.1.9). 88 | 89 | # 0.3.2.0 90 | 91 | * New minor release (microlens-0.4.5, microlens-ghc-0.4.5, microlens-th-0.1.8). 92 | 93 | # 0.3.1.1 94 | 95 | * Reexport `Lens.Micro` explicitly to make it clearer that it's exported. 96 | 97 | # 0.3.1.0 98 | 99 | * New minor release (microlens-0.4.4, microlens-ghc-0.4.4). 100 | 101 | # 0.3.0.0 102 | 103 | * New major release (microlens-0.4.3, microlens-ghc-0.4.3, microlens-th-0.4). 104 | 105 | # 0.2.3.1 106 | 107 | * Added forgotten copyright/authorship information. 108 | 109 | # 0.2.3.0 110 | 111 | * New minor release (microlens-0.4.2, microlens-ghc-0.4.2). 112 | 113 | # 0.2.2.0 114 | 115 | * New minor release (microlens-mtl-0.1.7). 116 | 117 | # 0.2.1.0 118 | 119 | * Added `packed` and `unpacked`. 120 | * Added instances for `Strict`. 121 | * New minor release (microlens-0.4.1, microlens-ghc-0.4.1). 122 | 123 | # 0.2.0.0 124 | 125 | * New major release (microlens-0.4, microlens-th-0.3, microlens-ghc-0.4). 126 | 127 | # 0.1.7.0 128 | 129 | * New minor release (microlens-0.3.5, microlens-th-0.2.2, microlens-ghc-0.3.1). 130 | 131 | # 0.1.6.0 132 | 133 | * A missing instance of `At` for `HashMap` has been added. 134 | 135 | # 0.1.5.0 136 | 137 | * New minor release (microlens-mtl-0.1.6). 138 | 139 | # 0.1.4.0 140 | 141 | * New minor release (microlens-0.3.4). 142 | 143 | # 0.1.3.0 144 | 145 | * Added Safe Haskell pragmas. 146 | * New minor release (microlens-0.3.3). 147 | 148 | # 0.1.2.0 149 | 150 | * New minor release (microlens-0.3.2). 151 | 152 | # 0.1.1.0 153 | 154 | * New minor release (microlens-0.3.1). 155 | 156 | # 0.1.0.0 157 | 158 | Initial release. 159 | -------------------------------------------------------------------------------- /microlens-platform/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012-2016 Edward Kmett, 2 | 2015-2016 Artyom Kazak, 3 | 2018 Monadfix 4 | 5 | All rights reserved. 6 | 7 | Redistribution and use in source and binary forms, with or without 8 | modification, are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright 11 | notice, this list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above 14 | copyright notice, this list of conditions and the following 15 | disclaimer in the documentation and/or other materials provided 16 | with the distribution. 17 | 18 | * Neither the name of Monadfix nor the names of other 19 | contributors may be used to endorse or promote products derived 20 | from this software without specific prior written permission. 21 | 22 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 25 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 26 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 27 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 28 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 29 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 30 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 31 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 32 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 | -------------------------------------------------------------------------------- /microlens-platform/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /microlens-platform/microlens-platform.cabal: -------------------------------------------------------------------------------- 1 | name: microlens-platform 2 | version: 0.4.4.1 3 | synopsis: microlens + all batteries included (best for apps) 4 | description: 5 | This package exports a module which is the recommended starting point for using if you aren't trying to keep your dependencies minimal. By importing @Lens.Micro.Platform@ you get all functions and instances from , , , , as well as instances for @Vector@, @Text@, and @HashMap@. 6 | . 7 | The minor and major versions of microlens-platform are incremented whenever the minor and major versions of any other microlens package are incremented, so you can depend on the exact version of microlens-platform without specifying the version of microlens (microlens-mtl, etc) you need. 8 | . 9 | This package is a part of the family; see the readme . 10 | license: BSD3 11 | license-file: LICENSE 12 | author: Edward Kmett, Artyom Kazak 13 | maintainer: Steven Fontanella 14 | homepage: http://github.com/stevenfontanella/microlens 15 | bug-reports: http://github.com/stevenfontanella/microlens/issues 16 | category: Data, Lenses 17 | build-type: Simple 18 | extra-source-files: 19 | CHANGELOG.md 20 | cabal-version: >=1.10 21 | tested-with: 22 | GHC==9.12.1 23 | GHC==9.10.1 24 | GHC==9.8.4 25 | GHC==9.6.6 26 | GHC==9.4.8 27 | GHC==9.2.8 28 | GHC==9.0.2 29 | GHC==8.10.7 30 | GHC==8.8.4 31 | GHC==8.6.5 32 | GHC==8.4.4 33 | GHC==8.2.2 34 | GHC==8.0.2 35 | 36 | source-repository head 37 | type: git 38 | location: https://github.com/stevenfontanella/microlens.git 39 | 40 | library 41 | exposed-modules: Lens.Micro.Platform 42 | Lens.Micro.Platform.Internal 43 | -- other-modules: 44 | -- other-extensions: 45 | build-depends: base >=4.5 && <5 46 | , hashable >=1.1.2.3 && <1.6 47 | , microlens ==0.4.14.* 48 | , microlens-ghc ==0.4.15.* 49 | , microlens-mtl ==0.2.1.* 50 | , microlens-th ==0.4.3.* 51 | , text >=0.11 && <1.3 || >=2.0 && <2.2 52 | , unordered-containers >=0.2.4 && <0.3 53 | , vector >=0.9 && <0.14 54 | 55 | ghc-options: 56 | -Wall -fwarn-tabs 57 | -O2 -fdicts-cheap -funbox-strict-fields 58 | -fmax-simplifier-iterations=10 59 | 60 | hs-source-dirs: src 61 | default-language: Haskell2010 62 | default-extensions: TypeOperators 63 | -------------------------------------------------------------------------------- /microlens-platform/src/Lens/Micro/Platform.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | {-# LANGUAGE Trustworthy #-} 7 | 8 | {-# OPTIONS_GHC -fno-warn-orphans #-} 9 | 10 | #ifndef MIN_VERSION_base 11 | #define MIN_VERSION_base(x,y,z) 1 12 | #endif 13 | 14 | 15 | {- | 16 | Module : Lens.Micro.Platform 17 | Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 18 | License : BSD-style (see the file LICENSE) 19 | 20 | This module is an approximation for @@ from ; by importing it you get all functions and instances from , , , as well as the following instances: 21 | 22 | * 'at' for 'HashMap' 23 | 24 | * 'each' and 'ix' for 25 | 26 | * 'HashMap' 27 | * 'Vector.Vector' and variants (unboxed vectors, etc) 28 | * strict 'T.Text' and lazy 'TL.Text' 29 | 30 | * '_head', '_tail', '_init', '_last' for 31 | 32 | * 'Vector.Vector' and variants 33 | * strict and lazy @Text@ 34 | 35 | * 'strict' and 'lazy' for @Text@ 36 | -} 37 | module Lens.Micro.Platform 38 | ( 39 | module Lens.Micro, 40 | module Lens.Micro.GHC, 41 | module Lens.Micro.Mtl, 42 | module Lens.Micro.TH, 43 | packed, unpacked, 44 | ) 45 | where 46 | 47 | 48 | import Lens.Micro.Internal 49 | import Lens.Micro 50 | import Lens.Micro.GHC 51 | import Lens.Micro.Mtl 52 | import Lens.Micro.TH 53 | import Lens.Micro.Platform.Internal 54 | 55 | import Data.Hashable 56 | import Data.Int 57 | import Data.Monoid 58 | import Data.Functor (($>)) 59 | 60 | import Data.HashMap.Lazy as HashMap 61 | import Data.HashSet as HashSet 62 | import Data.Vector as Vector 63 | import Data.Vector.Primitive as Prim 64 | import Data.Vector.Storable as Storable 65 | import Data.Vector.Unboxed as Unboxed 66 | import Data.Vector.Generic as Generic 67 | 68 | import qualified Data.Text as T 69 | import qualified Data.Text.Lazy as TL 70 | 71 | #if !MIN_VERSION_base(4,8,0) 72 | import Control.Applicative 73 | #endif 74 | 75 | 76 | type instance Index (HashMap k a) = k 77 | type instance IxValue (HashMap k a) = a 78 | type instance Index (HashSet a) = a 79 | type instance IxValue (HashSet a) = () 80 | type instance IxValue (HashMap k a) = a 81 | type instance Index (Vector.Vector a) = Int 82 | type instance IxValue (Vector.Vector a) = a 83 | type instance Index (Prim.Vector a) = Int 84 | type instance IxValue (Prim.Vector a) = a 85 | type instance Index (Storable.Vector a) = Int 86 | type instance IxValue (Storable.Vector a) = a 87 | type instance Index (Unboxed.Vector a) = Int 88 | type instance IxValue (Unboxed.Vector a) = a 89 | type instance Index T.Text = Int 90 | type instance IxValue T.Text = Char 91 | type instance Index TL.Text = Int64 92 | type instance IxValue TL.Text = Char 93 | 94 | instance (Eq k, Hashable k) => Ixed (HashMap k a) where 95 | ix k f m = case HashMap.lookup k m of 96 | Just v -> f v <&> \v' -> HashMap.insert k v' m 97 | Nothing -> pure m 98 | {-# INLINE ix #-} 99 | 100 | instance (Eq k, Hashable k) => At (HashMap k a) where 101 | at k f m = f mv <&> \r -> case r of 102 | Nothing -> maybe m (const (HashMap.delete k m)) mv 103 | Just v' -> HashMap.insert k v' m 104 | where mv = HashMap.lookup k m 105 | {-# INLINE at #-} 106 | 107 | instance (Eq k, Hashable k) => Ixed (HashSet k) where 108 | ix k f m = if HashSet.member k m 109 | then f () $> m 110 | else pure m 111 | {-# INLINE ix #-} 112 | 113 | instance (Eq k, Hashable k) => At (HashSet k) where 114 | at k f s = HashSet.fromMap <$> HashMap.alterF f k (HashSet.toMap s) 115 | {-# INLINE at #-} 116 | 117 | instance Ixed (Vector.Vector a) where 118 | ix i f v 119 | | 0 <= i && i < Vector.length v = f (v Vector.! i) <&> \a -> v Vector.// [(i, a)] 120 | | otherwise = pure v 121 | {-# INLINE ix #-} 122 | 123 | instance Prim a => Ixed (Prim.Vector a) where 124 | ix i f v 125 | | 0 <= i && i < Prim.length v = f (v Prim.! i) <&> \a -> v Prim.// [(i, a)] 126 | | otherwise = pure v 127 | {-# INLINE ix #-} 128 | 129 | instance Storable a => Ixed (Storable.Vector a) where 130 | ix i f v 131 | | 0 <= i && i < Storable.length v = f (v Storable.! i) <&> \a -> v Storable.// [(i, a)] 132 | | otherwise = pure v 133 | {-# INLINE ix #-} 134 | 135 | instance Unbox a => Ixed (Unboxed.Vector a) where 136 | ix i f v 137 | | 0 <= i && i < Unboxed.length v = f (v Unboxed.! i) <&> \a -> v Unboxed.// [(i, a)] 138 | | otherwise = pure v 139 | {-# INLINE ix #-} 140 | 141 | instance Ixed T.Text where 142 | ix e f s = case T.splitAt e s of 143 | (l, mr) -> case T.uncons mr of 144 | Nothing -> pure s 145 | Just (c, xs) -> f c <&> \d -> T.concat [l, T.singleton d, xs] 146 | {-# INLINE ix #-} 147 | 148 | instance Ixed TL.Text where 149 | ix e f s = case TL.splitAt e s of 150 | (l, mr) -> case TL.uncons mr of 151 | Nothing -> pure s 152 | Just (c, xs) -> f c <&> \d -> TL.append l (TL.cons d xs) 153 | {-# INLINE ix #-} 154 | 155 | instance Cons T.Text T.Text Char Char where 156 | _Cons f s = case T.uncons s of 157 | Just x -> uncurry T.cons <$> f x 158 | Nothing -> pure T.empty 159 | {-# INLINE _Cons #-} 160 | 161 | instance Cons TL.Text TL.Text Char Char where 162 | _Cons f s = case TL.uncons s of 163 | Just x -> uncurry TL.cons <$> f x 164 | Nothing -> pure TL.empty 165 | {-# INLINE _Cons #-} 166 | 167 | instance Snoc T.Text T.Text Char Char where 168 | _Snoc f s = if T.null s 169 | then pure T.empty 170 | else uncurry T.snoc <$> f (T.init s, T.last s) 171 | {-# INLINE _Snoc #-} 172 | 173 | instance Snoc TL.Text TL.Text Char Char where 174 | _Snoc f s = if TL.null s 175 | then pure TL.empty 176 | else uncurry TL.snoc <$> f (TL.init s, TL.last s) 177 | {-# INLINE _Snoc #-} 178 | 179 | instance Cons (Vector.Vector a) (Vector.Vector b) a b where 180 | _Cons f s = if Vector.null s 181 | then pure Vector.empty 182 | else uncurry Vector.cons <$> f (Vector.unsafeHead s, Vector.unsafeTail s) 183 | {-# INLINE _Cons #-} 184 | 185 | instance (Prim a, Prim b) => Cons (Prim.Vector a) (Prim.Vector b) a b where 186 | _Cons f s = if Prim.null s 187 | then pure Prim.empty 188 | else uncurry Prim.cons <$> f (Prim.unsafeHead s, Prim.unsafeTail s) 189 | {-# INLINE _Cons #-} 190 | 191 | instance (Storable a, Storable b) => Cons (Storable.Vector a) (Storable.Vector b) a b where 192 | _Cons f s = if Storable.null s 193 | then pure Storable.empty 194 | else uncurry Storable.cons <$> f (Storable.unsafeHead s, Storable.unsafeTail s) 195 | {-# INLINE _Cons #-} 196 | 197 | instance (Unbox a, Unbox b) => Cons (Unboxed.Vector a) (Unboxed.Vector b) a b where 198 | _Cons f s = if Unboxed.null s 199 | then pure Unboxed.empty 200 | else uncurry Unboxed.cons <$> f (Unboxed.unsafeHead s, Unboxed.unsafeTail s) 201 | {-# INLINE _Cons #-} 202 | 203 | instance Snoc (Vector.Vector a) (Vector.Vector b) a b where 204 | _Snoc f s = if Vector.null s 205 | then pure Vector.empty 206 | else uncurry Vector.snoc <$> f (Vector.unsafeInit s, Vector.unsafeLast s) 207 | {-# INLINE _Snoc #-} 208 | 209 | instance (Prim a, Prim b) => Snoc (Prim.Vector a) (Prim.Vector b) a b where 210 | _Snoc f s = if Prim.null s 211 | then pure Prim.empty 212 | else uncurry Prim.snoc <$> f (Prim.unsafeInit s, Prim.unsafeLast s) 213 | {-# INLINE _Snoc #-} 214 | 215 | instance (Storable a, Storable b) => Snoc (Storable.Vector a) (Storable.Vector b) a b where 216 | _Snoc f s = if Storable.null s 217 | then pure Storable.empty 218 | else uncurry Storable.snoc <$> f (Storable.unsafeInit s, Storable.unsafeLast s) 219 | {-# INLINE _Snoc #-} 220 | 221 | instance (Unbox a, Unbox b) => Snoc (Unboxed.Vector a) (Unboxed.Vector b) a b where 222 | _Snoc f s = if Unboxed.null s 223 | then pure Unboxed.empty 224 | else uncurry Unboxed.snoc <$> f (Unboxed.unsafeInit s, Unboxed.unsafeLast s) 225 | {-# INLINE _Snoc #-} 226 | 227 | instance Each (Vector.Vector a) (Vector.Vector b) a b where 228 | each = vectorTraverse 229 | {-# INLINE each #-} 230 | 231 | instance (Prim a, Prim b) => Each (Prim.Vector a) (Prim.Vector b) a b where 232 | each = vectorTraverse 233 | {-# INLINE each #-} 234 | 235 | instance (Storable a, Storable b) => Each (Storable.Vector a) (Storable.Vector b) a b where 236 | each = vectorTraverse 237 | {-# INLINE each #-} 238 | 239 | instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b where 240 | each = vectorTraverse 241 | {-# INLINE each #-} 242 | 243 | instance (c ~ d) => Each (HashMap c a) (HashMap d b) a b where 244 | each = traversed 245 | {-# INLINE each #-} 246 | 247 | instance (a ~ Char, b ~ Char) => Each T.Text T.Text a b where 248 | each = strictText 249 | {-# INLINE each #-} 250 | 251 | instance (a ~ Char, b ~ Char) => Each TL.Text TL.Text a b where 252 | each = lazyText 253 | {-# INLINE each #-} 254 | 255 | strictUnpacked :: Lens' T.Text String 256 | strictUnpacked f t = T.pack <$> f (T.unpack t) 257 | {-# INLINE strictUnpacked #-} 258 | 259 | strictText :: Traversal' T.Text Char 260 | strictText = strictUnpacked . traversed 261 | {-# INLINE [0] strictText #-} 262 | 263 | {-# RULES 264 | "strict text -> map" strictText = sets T.map :: ASetter' T.Text Char; 265 | "strict text -> foldr" strictText = foldring T.foldr :: Getting (Endo r) T.Text Char; 266 | #-} 267 | 268 | lazyUnpacked :: Lens' TL.Text String 269 | lazyUnpacked f t = TL.pack <$> f (TL.unpack t) 270 | {-# INLINE lazyUnpacked #-} 271 | 272 | lazyText :: Traversal' TL.Text Char 273 | lazyText = lazyUnpacked . traversed 274 | {-# INLINE [0] lazyText #-} 275 | 276 | {-# RULES 277 | "lazy text -> map" lazyText = sets TL.map :: ASetter' TL.Text Char; 278 | "lazy text -> foldr" lazyText = foldring TL.foldr :: Getting (Endo r) TL.Text Char; 279 | #-} 280 | 281 | vectorTraverse :: (Generic.Vector v a, Generic.Vector w b) => Traversal (v a) (w b) a b 282 | vectorTraverse f v = Generic.fromListN (Generic.length v) <$> traversed f (Generic.toList v) 283 | {-# INLINE [0] vectorTraverse #-} 284 | 285 | {-# RULES 286 | "vectorTraverse -> mapped" vectorTraverse = sets Generic.map :: (Generic.Vector v a, Generic.Vector v b) => ASetter (v a) (v b) a b; 287 | "vectorTraverse -> foldr" vectorTraverse = foldring Generic.foldr :: Generic.Vector v a => Getting (Endo r) (v a) a; 288 | #-} 289 | 290 | instance Strict TL.Text T.Text where 291 | strict f s = TL.fromStrict <$> f (TL.toStrict s) 292 | {-# INLINE strict #-} 293 | lazy f s = TL.toStrict <$> f (TL.fromStrict s) 294 | {-# INLINE lazy #-} 295 | -------------------------------------------------------------------------------- /microlens-platform/src/Lens/Micro/Platform/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | 6 | {- | 7 | Module : Lens.Micro.Platform.Internal 8 | Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 9 | License : BSD-style (see the file LICENSE) 10 | -} 11 | module Lens.Micro.Platform.Internal 12 | ( 13 | IsText(..), 14 | ) 15 | where 16 | 17 | 18 | import Lens.Micro 19 | 20 | import qualified Data.Text as T 21 | import qualified Data.Text.Lazy as TL 22 | 23 | #if !MIN_VERSION_base(4,8,0) 24 | import Control.Applicative 25 | #endif 26 | 27 | 28 | class IsText t where 29 | {- | 30 | 'packed' lets you convert between 'String' and @Text@ (strict or lazy). It can be used as a replacement for @pack@ or as a way to modify some 'String' if you have a function like @Text -> Text@. 31 | -} 32 | packed :: Lens' String t 33 | 34 | {- | 35 | 'unpacked' is like 'packed' but works in the opposite direction. 36 | -} 37 | unpacked :: Lens' t String 38 | 39 | instance IsText String where 40 | packed = id 41 | {-# INLINE packed #-} 42 | unpacked = id 43 | {-# INLINE unpacked #-} 44 | 45 | instance IsText T.Text where 46 | packed f s = T.unpack <$> f (T.pack s) 47 | {-# INLINE packed #-} 48 | unpacked f s = T.pack <$> f (T.unpack s) 49 | {-# INLINE unpacked #-} 50 | 51 | instance IsText TL.Text where 52 | packed f s = TL.unpack <$> f (TL.pack s) 53 | {-# INLINE packed #-} 54 | unpacked f s = TL.pack <$> f (TL.unpack s) 55 | {-# INLINE unpacked #-} 56 | -------------------------------------------------------------------------------- /microlens-pro/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.2.0.4 2 | 3 | * Allow building with containers 0.8. 4 | 5 | # 0.2.0.3 6 | 7 | * [#186](https://github.com/stevenfontanella/microlens/issues/186) Export [`AsEmpty`](https://hackage.haskell.org/package/microlens-pro/docs/Lens-Micro-Pro.html#t:AsEmpty) typeclass. 8 | 9 | # 0.2.0.2 10 | 11 | * [#182](https://github.com/stevenfontanella/microlens/pull/182) Support GHC 9.12. 12 | 13 | # 0.2.0.1 14 | 15 | * [#180](https://github.com/stevenfontanella/microlens/pull/180) [#181](https://github.com/stevenfontanella/microlens/pull/181) Support GHC 9.10. 16 | 17 | # 0.2.0 18 | 19 | * New major release. 20 | * [#177](https://github.com/stevenfontanella/microlens/issues/177) Moves `Lens.Micro.ProCompat` into `Lens.Micro.Pro`. 21 | 22 | # 0.1.0 23 | 24 | * [#105](https://github.com/stevenfontanella/microlens/issues/105) microlens-pro initial release, with `Prism`s and `Iso`s. 25 | -------------------------------------------------------------------------------- /microlens-pro/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2016 Edward Kmett, 2 | 2015-2016 Artyom Kazak, 3 | 2018 Monadfix 4 | 5 | All rights reserved. 6 | 7 | Redistribution and use in source and binary forms, with or without 8 | modification, are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright 11 | notice, this list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above 14 | copyright notice, this list of conditions and the following 15 | disclaimer in the documentation and/or other materials provided 16 | with the distribution. 17 | 18 | * Neither the name of Monadfix nor the names of other 19 | contributors may be used to endorse or promote products derived 20 | from this software without specific prior written permission. 21 | 22 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 25 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 26 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 27 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 28 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 29 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 30 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 31 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 32 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 | -------------------------------------------------------------------------------- /microlens-pro/microlens-pro.cabal: -------------------------------------------------------------------------------- 1 | name: microlens-pro 2 | version: 0.2.0.4 3 | synopsis: Prisms and isomorphisms for microlens 4 | description: 5 | This package provides lens-compatible 'Prism' and 'Iso'. Consequently, it 6 | depends on the rather heavy @profunctors@. 7 | . 8 | Thank you to the contributors 9 | for the original code and some docs, 10 | Emily Pillmore () and 11 | Mario Román () for 12 | 13 | which inspired documentation, and Wikibooks contributors for 14 | . 15 | . 16 | This package is a part of the 17 | family; see the 18 | readme . 19 | license: BSD3 20 | license-file: LICENSE 21 | author: Edward Kmett, Artyom Kazak, crumbtoo 22 | maintainer: Steven Fontanella 23 | homepage: http://github.com/stevenfontanella/microlens 24 | bug-reports: http://github.com/stevenfontanella/microlens/issues 25 | category: Data, Lenses 26 | build-type: Simple 27 | extra-source-files: CHANGELOG.md 28 | cabal-version: >=1.10 29 | 30 | tested-with: 31 | GHC==9.12.1 32 | GHC==9.10.1 33 | GHC==9.8.4 34 | GHC==9.6.6 35 | GHC==9.4.8 36 | GHC==9.2.8 37 | GHC==9.0.2 38 | GHC==8.10.7 39 | GHC==8.8.4 40 | GHC==8.6.5 41 | GHC==8.4.4 42 | GHC==8.2.2 43 | GHC==8.0.2 44 | 45 | source-repository head 46 | type: git 47 | location: git://github.com/stevenfontanella/microlens.git 48 | 49 | library 50 | exposed-modules: Lens.Micro.Pro 51 | Lens.Micro.Pro.TH 52 | Lens.Micro.Pro.Internal 53 | Lens.Micro.Pro.Type 54 | 55 | -- other-modules: 56 | -- other-extensions: 57 | build-depends: base >=4.5 && <5 58 | , containers >=0.4.0 && <0.9 59 | , unordered-containers >=0.2.4 && <0.3 60 | , microlens >=0.4.11.3 && <0.5 61 | , microlens-th >=0.4.3.3 && <0.5 62 | , microlens-contra >=0.1.0 && <0.2 63 | , microlens-platform >=0.4.3 && <0.5 64 | , profunctors >=5.2.1 && <6 65 | , tagged >=0.4.4 && <1 66 | , template-haskell >=2.7 && <2.24 67 | , th-abstraction >=0.6.0 && <0.8 68 | , mtl >=2.2.2 && <2.4 69 | , text >=1.2 && <2.2 70 | , vector >=0.12.0 && <0.14 71 | default-extensions: 72 | RankNTypes 73 | PolyKinds 74 | KindSignatures 75 | FlexibleInstances 76 | 77 | if impl(ghc <= 8.6.5) 78 | build-depends: contravariant >=0.1.0 && <1.5.6 79 | 80 | ghc-options: 81 | -Wall -fwarn-tabs 82 | -O2 -fdicts-cheap -funbox-strict-fields 83 | -fmax-simplifier-iterations=10 84 | if impl(ghc >= 8.6.5) 85 | ghc-options: 86 | -Wno-orphans 87 | 88 | hs-source-dirs: src 89 | default-language: Haskell2010 90 | -------------------------------------------------------------------------------- /microlens-pro/src/Lens/Micro/Pro/Internal.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Lens.Micro.Pro.Internal 3 | Copyright : (C) 2013-2016 Edward Kmett, 2018 Monadfix 4 | License : BSD-style (see the file LICENSE) 5 | 6 | Definitions used internally by microlens. If you're going to use these, only 7 | define instances for your own types, and don't export an API using these! 8 | -} 9 | {-# LANGUAGE FunctionalDependencies #-} 10 | module Lens.Micro.Pro.Internal 11 | ( Strict(strict, lazy) 12 | 13 | , IsText(packed, unpacked) 14 | 15 | , Exchange(..), Exchange' 16 | , Market(..), Market' 17 | 18 | , Iso, Iso' 19 | , Prism, Prism' 20 | ) 21 | where 22 | -------------------------------------------------------------------------------- 23 | import Lens.Micro.Pro.Type 24 | import Data.Coerce 25 | import Data.Profunctor 26 | import Data.Profunctor.Unsafe 27 | -------------------------------------------------------------------------------- 28 | 29 | class Strict lazy strict | lazy -> strict, strict -> lazy where 30 | strict :: Iso' lazy strict 31 | lazy :: Iso' strict lazy 32 | 33 | {- | This type is used internally to provide efficient access 34 | to the two inverse functions behind an 'Iso'. 35 | -} 36 | 37 | data Exchange a b s t = Exchange (s -> a) (b -> t) 38 | 39 | type Exchange' a s = Exchange a a s s 40 | 41 | instance Functor (Exchange a b s) where 42 | fmap f (Exchange sa bt) = Exchange sa (f . bt) 43 | {-# INLINE fmap #-} 44 | 45 | instance Profunctor (Exchange a b) where 46 | dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt) 47 | lmap f (Exchange sa bt) = Exchange (sa . f) bt 48 | rmap f (Exchange sa bt) = Exchange sa (f . bt) 49 | 50 | {-# INLINE dimap #-} 51 | {-# INLINE lmap #-} 52 | {-# INLINE rmap #-} 53 | 54 | (#.) _ = coerce 55 | (.#) p _ = coerce p 56 | 57 | {-# INLINE (#.) #-} 58 | {-# INLINE (.#) #-} 59 | 60 | {- | This type is used internally by the Prism code to provide efficient access 61 | to the two parts of a Prism, i.e. a constructor and a selector — see: 62 | 'Lens.Micro.Pro.prism'. 63 | -} 64 | data Market a b s t = Market (b -> t) (s -> Either t a) 65 | 66 | instance Functor (Market a b s) where 67 | fmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta) 68 | {-# INLINE fmap #-} 69 | 70 | instance Profunctor (Market a b) where 71 | dimap f g (Market bt seta) = 72 | Market (g . bt) (either (Left . g) Right . seta . f) 73 | 74 | lmap f (Market bt seta) = Market bt (seta . f) 75 | rmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta) 76 | 77 | {-# INLINE rmap #-} 78 | {-# INLINE lmap #-} 79 | {-# INLINE dimap #-} 80 | 81 | (#.) _ = coerce 82 | (.#) p _ = coerce p 83 | 84 | {-# INLINE (#.) #-} 85 | {-# INLINE (.#) #-} 86 | 87 | instance Choice (Market a b) where 88 | left' (Market bt seta) = Market (Left . bt) $ \sc -> case sc of 89 | Left s -> case seta s of 90 | Left t -> Left (Left t) 91 | Right a -> Right a 92 | Right c -> Left (Right c) 93 | 94 | right' (Market bt seta) = Market (Right . bt) $ \cs -> case cs of 95 | Left c -> Left (Left c) 96 | Right s -> case seta s of 97 | Left t -> Left (Right t) 98 | Right a -> Right a 99 | 100 | {-# INLINE right' #-} 101 | {-# INLINE left' #-} 102 | 103 | type Market' a s = Market a a s s 104 | 105 | class IsText t where 106 | 107 | -- | 'packed' lets you convert between 'String' and @Text@ (strict or lazy). 108 | -- It can be used as a replacement for @pack@ or as a way to modify some 109 | -- 'String' if you have a function like @Text -> Text@. 110 | 111 | packed :: Iso' String t 112 | 113 | -- | 'unpacked' is like 'packed' but works in the opposite direction. 114 | 115 | unpacked :: Iso' t String 116 | 117 | -------------------------------------------------------------------------------- /microlens-pro/src/Lens/Micro/Pro/TH.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE Trustworthy #-} 3 | 4 | #if __GLASGOW_HASKELL__ >= 800 5 | {-# OPTIONS_GHC -Wno-trustworthy-safe #-} 6 | #endif 7 | 8 | #if __GLASGOW_HASKELL__ >= 800 9 | {-# LANGUAGE TemplateHaskellQuotes #-} 10 | #else 11 | {-# LANGUAGE TemplateHaskell #-} 12 | #endif 13 | 14 | {- | 15 | Module : Lens.Micro.Pro.TH 16 | Copyright : (C) 2014-2016 Eric Mertens, Edward Kmett; 2018 Monadfix 17 | License : BSD-style (see the file LICENSE) 18 | 19 | Template Haskell functions to automatically define prisms. 20 | -} 21 | module Lens.Micro.Pro.TH 22 | ( 23 | makePrisms, 24 | makeClassyPrisms, 25 | ) 26 | where 27 | 28 | import Lens.Micro.Pro 29 | import Lens.Micro.TH.Internal 30 | (HasTypeVars(..), typeVars, substTypeVars, newNames, conAppsT, inlinePragma) 31 | 32 | import Data.Char (isUpper) 33 | import Data.List 34 | import Data.Monoid 35 | import qualified Data.Set as Set 36 | import Data.Set (Set) 37 | import Data.Traversable 38 | import Language.Haskell.TH 39 | import Language.Haskell.TH.Datatype.TyVarBndr 40 | import qualified Language.Haskell.TH.Datatype as D 41 | import qualified Data.Map as Map 42 | 43 | -- | Generate a 'Prism' for each constructor of a data type. 44 | -- Isos generated when possible. 45 | -- Reviews are created for constructors with existentially 46 | -- quantified constructors and GADTs. 47 | -- 48 | -- /e.g./ 49 | -- 50 | -- @ 51 | -- data FooBarBaz a 52 | -- = Foo Int 53 | -- | Bar a 54 | -- | Baz Int Char 55 | -- makePrisms ''FooBarBaz 56 | -- @ 57 | -- 58 | -- will create 59 | -- 60 | -- @ 61 | -- _Foo :: Prism' (FooBarBaz a) Int 62 | -- _Bar :: Prism (FooBarBaz a) (FooBarBaz b) a b 63 | -- _Baz :: Prism' (FooBarBaz a) (Int, Char) 64 | -- @ 65 | makePrisms :: Name {- ^ Type constructor name -} -> DecsQ 66 | makePrisms = makePrisms' True 67 | 68 | -- | Generate a 'Prism' for each constructor of a data type 69 | -- and combine them into a single class. No Isos are created. 70 | -- Reviews are created for constructors with existentially 71 | -- quantified constructors and GADTs. 72 | -- 73 | -- /e.g./ 74 | -- 75 | -- @ 76 | -- data FooBarBaz a 77 | -- = Foo Int 78 | -- | Bar a 79 | -- | Baz Int Char 80 | -- makeClassyPrisms ''FooBarBaz 81 | -- @ 82 | -- 83 | -- will create 84 | -- 85 | -- @ 86 | -- class AsFooBarBaz s a | s -> a where 87 | -- _FooBarBaz :: Prism' s (FooBarBaz a) 88 | -- _Foo :: Prism' s Int 89 | -- _Bar :: Prism' s a 90 | -- _Baz :: Prism' s (Int,Char) 91 | -- 92 | -- _Foo = _FooBarBaz . _Foo 93 | -- _Bar = _FooBarBaz . _Bar 94 | -- _Baz = _FooBarBaz . _Baz 95 | -- 96 | -- instance AsFooBarBaz (FooBarBaz a) a 97 | -- @ 98 | -- 99 | -- Generate an "As" class of prisms. Names are selected by prefixing the constructor 100 | -- name with an underscore. Constructors with multiple fields will 101 | -- construct Prisms to tuples of those fields. 102 | -- 103 | -- In the event that the name of a data type is also the name of one of its 104 | -- constructors, the name of the 'Prism' generated for the data type will be 105 | -- prefixed with an extra @_@ (if the data type name is prefix) or @.@ (if the 106 | -- name is infix) to disambiguate it from the 'Prism' for the corresponding 107 | -- constructor. For example, this code: 108 | -- 109 | -- @ 110 | -- data Quux = Quux Int | Fred Bool 111 | -- makeClassyPrisms ''Quux 112 | -- @ 113 | -- 114 | -- will create: 115 | -- 116 | -- @ 117 | -- class AsQuux s where 118 | -- __Quux :: Prism' s Quux -- Data type prism 119 | -- _Quux :: Prism' s Int -- Constructor prism 120 | -- _Fred :: Prism' s Bool 121 | -- 122 | -- _Quux = __Quux . _Quux 123 | -- _Fred = __Quux . _Fred 124 | -- 125 | -- instance AsQuux Quux 126 | -- @ 127 | makeClassyPrisms :: Name {- ^ Type constructor name -} -> DecsQ 128 | makeClassyPrisms = makePrisms' False 129 | 130 | -- | Main entry point into Prism generation for a given type constructor name. 131 | makePrisms' :: Bool -> Name -> DecsQ 132 | makePrisms' normal typeName = 133 | do info <- D.reifyDatatype typeName 134 | let cls | normal = Nothing 135 | | otherwise = Just (D.datatypeName info) 136 | cons = D.datatypeCons info 137 | makeConsPrisms (D.datatypeType info) (map normalizeCon cons) cls 138 | 139 | 140 | -- | Generate prisms for the given type, normalized constructors, and 141 | -- an optional name to be used for generating a prism class. 142 | -- This function dispatches between Iso generation, normal top-level 143 | -- prisms, and classy prisms. 144 | makeConsPrisms :: Type -> [NCon] -> Maybe Name -> DecsQ 145 | 146 | -- special case: single constructor, not classy -> make iso 147 | makeConsPrisms t [con@(NCon _ [] [] _)] Nothing = makeConIso t con 148 | 149 | -- top-level definitions 150 | makeConsPrisms t cons Nothing = 151 | fmap concat $ for cons $ \con -> 152 | do let conName = view nconName con 153 | stab <- computeOpticType t cons con 154 | let n = prismName conName 155 | sequenceA 156 | ( [ sigD n (close (stabToType stab)) 157 | , valD (varP n) (normalB (makeConOpticExp stab cons con)) [] 158 | ] 159 | ++ inlinePragma n 160 | ) 161 | 162 | 163 | -- classy prism class and instance 164 | makeConsPrisms t cons (Just typeName) = 165 | sequenceA 166 | [ makeClassyPrismClass t className methodName cons 167 | , makeClassyPrismInstance t className methodName cons 168 | ] 169 | where 170 | typeNameBase = nameBase typeName 171 | className = mkName ("As" ++ typeNameBase) 172 | sameNameAsCon = any (\con -> nameBase (view nconName con) == typeNameBase) cons 173 | methodName = prismName' sameNameAsCon typeName 174 | 175 | 176 | data OpticType = PrismType | ReviewType 177 | data Stab = Stab Cxt OpticType Type Type Type Type 178 | 179 | simplifyStab :: Stab -> Stab 180 | simplifyStab (Stab cx ty _ t _ b) = Stab cx ty t t b b 181 | -- simplification uses t and b because those types 182 | -- are interesting in the Review case 183 | 184 | stabSimple :: Stab -> Bool 185 | stabSimple (Stab _ _ s t a b) = s == t && a == b 186 | 187 | stabToType :: Stab -> Type 188 | stabToType stab@(Stab cx ty s t a b) = ForallT vs cx $ 189 | case ty of 190 | PrismType | stabSimple stab -> ''Prism' `conAppsT` [t,b] 191 | | otherwise -> ''Prism `conAppsT` [s,t,a,b] 192 | ReviewType -> ''AReview `conAppsT` [t,b] 193 | 194 | where 195 | vs = map plainTVInferred 196 | $ nub -- stable order 197 | $ toListOf typeVars cx 198 | 199 | stabType :: Stab -> OpticType 200 | stabType (Stab _ o _ _ _ _) = o 201 | 202 | computeOpticType :: Type -> [NCon] -> NCon -> Q Stab 203 | computeOpticType t cons con = 204 | do let cons' = delete con cons 205 | if null (_nconVars con) 206 | then computePrismType t (view nconCxt con) cons' con 207 | else computeReviewType t (view nconCxt con) (view nconTypes con) 208 | 209 | 210 | computeReviewType :: Type -> Cxt -> [Type] -> Q Stab 211 | computeReviewType s' cx tys = 212 | do let t = s' 213 | s <- fmap VarT (newName "s") 214 | a <- fmap VarT (newName "a") 215 | b <- toTupleT (map return tys) 216 | return (Stab cx ReviewType s t a b) 217 | 218 | 219 | -- | Compute the full type-changing Prism type given an outer type, 220 | -- list of constructors, and target constructor name. Additionally 221 | -- return 'True' if the resulting type is a "simple" prism. 222 | computePrismType :: Type -> Cxt -> [NCon] -> NCon -> Q Stab 223 | computePrismType t cx cons con = 224 | do let ts = view nconTypes con 225 | unbound = setOf typeVars t Set.\\ setOf typeVars cons 226 | sub <- sequenceA (fromSet (newName . nameBase) unbound) 227 | b <- toTupleT (map return ts) 228 | a <- toTupleT (map return (substTypeVars sub ts)) 229 | let s = substTypeVars sub t 230 | return (Stab cx PrismType s t a b) 231 | 232 | 233 | computeIsoType :: Type -> [Type] -> TypeQ 234 | computeIsoType t' fields = 235 | do sub <- sequenceA (fromSet (newName . nameBase) (setOf typeVars t')) 236 | let t = return t' 237 | s = return (substTypeVars sub t') 238 | b = toTupleT (map return fields) 239 | a = toTupleT (map return (substTypeVars sub fields)) 240 | ty | Map.null sub = appsT (conT ''Iso') [t,b] 241 | | otherwise = appsT (conT ''Iso) [s,t,a,b] 242 | 243 | close =<< ty 244 | 245 | 246 | 247 | -- | Construct either a Review or Prism as appropriate 248 | makeConOpticExp :: Stab -> [NCon] -> NCon -> ExpQ 249 | makeConOpticExp stab cons con = 250 | case stabType stab of 251 | PrismType -> makeConPrismExp stab cons con 252 | ReviewType -> makeConReviewExp con 253 | 254 | 255 | -- | Construct an iso declaration 256 | makeConIso :: Type -> NCon -> DecsQ 257 | makeConIso s con = 258 | do let ty = computeIsoType s (view nconTypes con) 259 | defName = prismName (view nconName con) 260 | sequenceA 261 | ( [ sigD defName ty 262 | , valD (varP defName) (normalB (makeConIsoExp con)) [] 263 | ] ++ 264 | inlinePragma defName 265 | ) 266 | 267 | 268 | -- | Construct prism expression 269 | -- 270 | -- prism <> <> 271 | makeConPrismExp :: 272 | Stab -> 273 | [NCon] {- ^ constructors -} -> 274 | NCon {- ^ target constructor -} -> 275 | ExpQ 276 | makeConPrismExp stab cons con = appsE [varE 'prism, reviewer, remitter] 277 | where 278 | ts = view nconTypes con 279 | fields = length ts 280 | conName = view nconName con 281 | 282 | reviewer = makeReviewer conName fields 283 | remitter | stabSimple stab = makeSimpleRemitter conName fields 284 | | otherwise = makeFullRemitter cons conName 285 | 286 | 287 | -- | Construct an Iso expression 288 | -- 289 | -- iso <> <> 290 | makeConIsoExp :: NCon -> ExpQ 291 | makeConIsoExp con = appsE [varE 'iso, remitter, reviewer] 292 | where 293 | conName = view nconName con 294 | fields = length (view nconTypes con) 295 | 296 | reviewer = makeReviewer conName fields 297 | remitter = makeIsoRemitter conName fields 298 | 299 | 300 | -- | Construct a Review expression 301 | -- 302 | -- unto (\(x,y,z) -> Con x y z) 303 | makeConReviewExp :: NCon -> ExpQ 304 | makeConReviewExp con = appE (varE 'unto) reviewer 305 | where 306 | conName = view nconName con 307 | fields = length (view nconTypes con) 308 | 309 | reviewer = makeReviewer conName fields 310 | 311 | 312 | ------------------------------------------------------------------------ 313 | -- Prism and Iso component builders 314 | ------------------------------------------------------------------------ 315 | 316 | 317 | -- | Construct the review portion of a prism. 318 | -- 319 | -- (\(x,y,z) -> Con x y z) :: b -> t 320 | makeReviewer :: Name -> Int -> ExpQ 321 | makeReviewer conName fields = 322 | do xs <- newNames "x" fields 323 | lam1E (toTupleP (map varP xs)) 324 | (conE conName `appsE1` map varE xs) 325 | 326 | 327 | -- | Construct the remit portion of a prism. 328 | -- Pattern match only target constructor, no type changing 329 | -- 330 | -- (\x -> case s of 331 | -- Con x y z -> Right (x,y,z) 332 | -- _ -> Left x 333 | -- ) :: s -> Either s a 334 | makeSimpleRemitter :: Name -> Int -> ExpQ 335 | makeSimpleRemitter conName fields = 336 | do x <- newName "x" 337 | xs <- newNames "y" fields 338 | let matches = 339 | [ match (conP conName (map varP xs)) 340 | (normalB (appE (conE 'Right) (toTupleE (map varE xs)))) 341 | [] 342 | , match wildP (normalB (appE (conE 'Left) (varE x))) [] 343 | ] 344 | lam1E (varP x) (caseE (varE x) matches) 345 | 346 | 347 | -- | Pattern match all constructors to enable type-changing 348 | -- 349 | -- (\x -> case s of 350 | -- Con x y z -> Right (x,y,z) 351 | -- Other_n w -> Left (Other_n w) 352 | -- ) :: s -> Either t a 353 | makeFullRemitter :: [NCon] -> Name -> ExpQ 354 | makeFullRemitter cons target = 355 | do x <- newName "x" 356 | lam1E (varP x) (caseE (varE x) (map mkMatch cons)) 357 | where 358 | mkMatch (NCon conName _ _ n) = 359 | do xs <- newNames "y" (length n) 360 | match (conP conName (map varP xs)) 361 | (normalB 362 | (if conName == target 363 | then appE (conE 'Right) (toTupleE (map varE xs)) 364 | else appE (conE 'Left) (conE conName `appsE1` map varE xs))) 365 | [] 366 | 367 | 368 | -- | Construct the remitter suitable for use in an 'Iso' 369 | -- 370 | -- (\(Con x y z) -> (x,y,z)) :: s -> a 371 | makeIsoRemitter :: Name -> Int -> ExpQ 372 | makeIsoRemitter conName fields = 373 | do xs <- newNames "x" fields 374 | lam1E (conP conName (map varP xs)) 375 | (toTupleE (map varE xs)) 376 | 377 | 378 | ------------------------------------------------------------------------ 379 | -- Classy prisms 380 | ------------------------------------------------------------------------ 381 | 382 | 383 | -- | Construct the classy prisms class for a given type and constructors. 384 | -- 385 | -- class ClassName r <> | r -> <> where 386 | -- topMethodName :: Prism' r Type 387 | -- conMethodName_n :: Prism' r conTypes_n 388 | -- conMethodName_n = topMethodName . conMethodName_n 389 | makeClassyPrismClass :: 390 | Type {- Outer type -} -> 391 | Name {- Class name -} -> 392 | Name {- Top method name -} -> 393 | [NCon] {- Constructors -} -> 394 | DecQ 395 | makeClassyPrismClass t className methodName cons = 396 | do r <- newName "r" 397 | let methodType = appsT (conT ''Prism') [varT r,return t] 398 | methodss <- traverse (mkMethod (VarT r)) cons' 399 | classD (cxt[]) className (map plainTV (r : vs)) (fds r) 400 | ( sigD methodName methodType 401 | : map return (concat methodss) 402 | ) 403 | 404 | where 405 | mkMethod r con = 406 | do Stab cx o _ _ _ b <- computeOpticType t cons con 407 | let stab' = Stab cx o r r b b 408 | defName = view nconName con 409 | body = appsE [varE '(.), varE methodName, varE defName] 410 | sequenceA 411 | [ sigD defName (return (stabToType stab')) 412 | , valD (varP defName) (normalB body) [] 413 | ] 414 | 415 | cons' = map (over nconName prismName) cons 416 | vs = Set.toList (setOf typeVars t) 417 | fds r 418 | | null vs = [] 419 | | otherwise = [FunDep [r] vs] 420 | 421 | 422 | 423 | -- | Construct the classy prisms instance for a given type and constructors. 424 | -- 425 | -- instance Classname OuterType where 426 | -- topMethodName = id 427 | -- conMethodName_n = <> 428 | makeClassyPrismInstance :: 429 | Type -> 430 | Name {- Class name -} -> 431 | Name {- Top method name -} -> 432 | [NCon] {- Constructors -} -> 433 | DecQ 434 | makeClassyPrismInstance s className methodName cons = 435 | do let vs = Set.toList (setOf typeVars s) 436 | cls = className `conAppsT` (s : map VarT vs) 437 | 438 | instanceD (cxt[]) (return cls) 439 | ( valD (varP methodName) 440 | (normalB (varE 'id)) [] 441 | : [ do stab <- computeOpticType s cons con 442 | let stab' = simplifyStab stab 443 | valD (varP (prismName conName)) 444 | (normalB (makeConOpticExp stab' cons con)) [] 445 | | con <- cons 446 | , let conName = view nconName con 447 | ] 448 | ) 449 | 450 | 451 | ------------------------------------------------------------------------ 452 | -- Utilities 453 | ------------------------------------------------------------------------ 454 | 455 | 456 | -- | Normalized constructor 457 | data NCon = NCon 458 | { _nconName :: Name 459 | , _nconVars :: [Name] 460 | , _nconCxt :: Cxt 461 | , _nconTypes :: [Type] 462 | } 463 | deriving (Eq) 464 | 465 | nconName :: Lens' NCon Name 466 | nconName f x = fmap (\y -> x {_nconName = y}) (f (_nconName x)) 467 | 468 | nconCxt :: Lens' NCon Cxt 469 | nconCxt f x = fmap (\y -> x {_nconCxt = y}) (f (_nconCxt x)) 470 | 471 | nconTypes :: Lens' NCon [Type] 472 | nconTypes f x = fmap (\y -> x {_nconTypes = y}) (f (_nconTypes x)) 473 | 474 | instance HasTypeVars NCon where 475 | typeVarsEx s f (NCon x vars y z) = NCon x vars <$> typeVarsEx s' f y <*> typeVarsEx s' f z 476 | where s' = foldl' (flip Set.insert) s vars 477 | 478 | -- | Normalize a single 'Con' to its constructor name and field types. 479 | normalizeCon :: D.ConstructorInfo -> NCon 480 | normalizeCon info = NCon (D.constructorName info) 481 | (D.tvName <$> D.constructorVars info) 482 | (D.constructorContext info) 483 | (D.constructorFields info) 484 | 485 | 486 | -- | Compute a prism's name by prefixing an underscore for normal 487 | -- constructors and period for operators. 488 | prismName :: Name -> Name 489 | prismName = prismName' False 490 | 491 | prismName' :: Bool -- ^ This is 'True' in the event that: 492 | -- 493 | -- 1. We are generating the name of a classy prism for a 494 | -- data type, and 495 | -- 2. The data type shares a name with one of its 496 | -- constructors (e.g., @data A = A@). 497 | -- 498 | -- In such a scenario, we take care not to generate the same 499 | -- prism name that the constructor receives (e.g., @_A@). 500 | -- For prefix names, we accomplish this by adding an extra 501 | -- underscore; for infix names, an extra dot. 502 | -> Name -> Name 503 | prismName' sameNameAsCon n = 504 | case nameBase n of 505 | [] -> error "prismName: empty name base?" 506 | nb@(x:_) | isUpper x -> mkName (prefix '_' nb) 507 | | otherwise -> mkName (prefix '.' nb) -- operator 508 | where 509 | prefix :: Char -> String -> String 510 | prefix char str | sameNameAsCon = char:char:str 511 | | otherwise = char:str 512 | 513 | 514 | -- | Quantify all the free variables in a type. 515 | close :: Type -> TypeQ 516 | close t = forallT (map plainTVInferred (Set.toList vs)) (cxt[]) (return t) 517 | where 518 | vs = setOf typeVars t 519 | 520 | setOf :: Ord a => Getting (Endo [a]) s a -> s -> Set a 521 | setOf l s = Set.fromList (s ^.. l) 522 | 523 | -- @fromSet@ wasn't always there, and we need compatibility with 524 | -- containers-0.4 to compile on GHC 7.4. 525 | fromSet :: (k -> v) -> Set.Set k -> Map.Map k v 526 | #if MIN_VERSION_containers(0,5,0) 527 | fromSet = Map.fromSet 528 | #else 529 | fromSet f x = Map.fromDistinctAscList [ (k,f k) | k <- Set.toAscList x ] 530 | #endif 531 | 532 | -- | Apply arguments to a type constructor 533 | appsT :: TypeQ -> [TypeQ] -> TypeQ 534 | appsT = foldl appT 535 | 536 | -- | Apply arguments to a function 537 | appsE1 :: ExpQ -> [ExpQ] -> ExpQ 538 | appsE1 = foldl appE 539 | 540 | -- | Construct a tuple type given a list of types. 541 | toTupleT :: [TypeQ] -> TypeQ 542 | toTupleT [x] = x 543 | toTupleT xs = appsT (tupleT (length xs)) xs 544 | 545 | -- | Construct a tuple value given a list of expressions. 546 | toTupleE :: [ExpQ] -> ExpQ 547 | toTupleE [x] = x 548 | toTupleE xs = tupE xs 549 | 550 | -- | Construct a tuple pattern given a list of patterns. 551 | toTupleP :: [PatQ] -> PatQ 552 | toTupleP [x] = x 553 | toTupleP xs = tupP xs 554 | 555 | -------------------------------------------------------------------------------- /microlens-pro/src/Lens/Micro/Pro/Type.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Lens.Micro.Pro.Type 3 | Copyright : (C) 2013-2016 Edward Kmett, 2018 Monadfix 4 | License : BSD-style (see the file LICENSE) 5 | 6 | This module defines just the 'Iso' and 'Prism' types, in order to break a 7 | dependency cycle. You'll find the interesting stuff in 'Lens.Micro.Pro' and 8 | 'Lens.Micro.Pro.Internal'. 9 | -} 10 | module Lens.Micro.Pro.Type 11 | ( Iso, Iso' 12 | , Prism, Prism' 13 | ) 14 | where 15 | -------------------------------------------------------------------------------- 16 | import Data.Profunctor 17 | -------------------------------------------------------------------------------- 18 | 19 | {- | 20 | The type signature of 'Lens.Micro.Pro.iso' provides a nice interpretation of 21 | 'Iso'. If you want to apply a function @a -> b@ to a type @s@, you'd have to 22 | convert with @s -> a@, apply your function @a -> b@, and convert back with 23 | @b -> t@. 24 | 25 | @ 26 | 'Lens.Micro.Pro.iso' :: (s -> a) -> (b -> t) -> Iso s t a b 27 | -- or, put monomorphically 28 | 'Lens.Micro.Pro.iso' :: (s -> a) -> (a -> s) -> Iso' s a 29 | @ 30 | -} 31 | 32 | type Iso s t a b = forall p f. (Profunctor p, Functor f) 33 | => p a (f b) -> p s (f t) 34 | 35 | {- | 36 | The type of monomorphic isomorphisms, i.e. isos that change neither the outer type 37 | @s@ nor the inner type @a@. 38 | -} 39 | 40 | type Iso' s a = Iso s s a a 41 | 42 | {- | 43 | * @s@ is the type of the whole structure 44 | * @t@ is the type of the reconstructed structure 45 | * @a@ is the type of the target 46 | * @b@ is the type of the value used for reconstruction 47 | -} 48 | type Prism s t a b = forall p f. (Choice p, Applicative f) 49 | => p a (f b) -> p s (f t) 50 | 51 | {- | 52 | The type of monomorphic prisms, i.e. prisms that change neither the outer type 53 | @s@ nor the inner type @a@. 54 | -} 55 | 56 | type Prism' s a = Prism s s a a 57 | 58 | -------------------------------------------------------------------------------- /microlens-th/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.4.3.17 2 | 3 | * Allow building with containers 0.8. 4 | 5 | # 0.4.3.16 6 | 7 | * [#182](https://github.com/stevenfontanella/microlens/pull/182) Support GHC 9.12. 8 | 9 | # 0.4.3.15 10 | 11 | * [#180](https://github.com/stevenfontanella/microlens/pull/180) [#181](https://github.com/stevenfontanella/microlens/pull/181) Support GHC 9.10. 12 | 13 | # 0.4.3.14 14 | 15 | * [#170](https://github.com/stevenfontanella/microlens/issues/170), [#171](https://github.com/stevenfontanella/microlens/pull/171) Support GHC 9.8. 16 | 17 | # 0.4.3.13 18 | 19 | * [#167](https://github.com/stevenfontanella/microlens/issues/167) Support th-abstraction 0.5. 20 | 21 | # 0.4.3.12 22 | 23 | * [#164](https://github.com/stevenfontanella/microlens/pull/164), [#165](https://github.com/stevenfontanella/microlens/issues/165) Support template-haskell 2.19 (and GHC 9.6 by extension). 24 | 25 | # 0.4.3.11 26 | 27 | * [#161](https://github.com/stevenfontanella/microlens/pull/161) Fix GHC 9.4 warning for using `~` without TypeOperators. 28 | 29 | # 0.4.3.10 30 | 31 | * Port lens commit [fae336e1](https://github.com/ekmett/lens/commit/fae336e191748782cff023540bd25e3582ca93fb), "Close over kind variables when computing fixed type variables", fixing lens issue [#972](https://github.com/ekmett/lens/issues/972). 32 | 33 | * Allow building with template-haskell-2.18. 34 | 35 | # 0.4.3.9 36 | 37 | * Port lens commit [66e199ee](https://github.com/ekmett/lens/commit/66e199ee07f1aaf589faa2a8c661f6a722679959), fixing lens issue [#945](https://github.com/ekmett/lens/pull/945) — "Make the TH machinery handle PolyKinds more robustly". 38 | 39 | # 0.4.3.8 40 | 41 | * Fixup. 42 | 43 | # 0.4.3.7 44 | 45 | * Changes needed for template-haskell-2.17. 46 | 47 | # 0.4.3.6 48 | 49 | * Bumped th-abstraction. 50 | 51 | # 0.4.3.5 52 | 53 | * Changes needed for template-haskell-2.16. 54 | 55 | # 0.4.3.4 56 | 57 | * Backported changes needed for template-haskell-2.15. 58 | 59 | # 0.4.3.3 60 | 61 | * Exported internal utilities from `Lens.Micro.TH.Internal`. 62 | 63 | # 0.4.3.2 64 | 65 | * Bumped template-haskell version. 66 | 67 | # 0.4.3.1 68 | 69 | * No more conditional `Safe` (see [#122](https://github.com/monadfix/microlens/issues/122)). 70 | 71 | # 0.4.3 72 | 73 | * Bumped th-abstraction version. 74 | * `Lens.Micro.TH` is now properly marked as `Safe` or `Trustworthy`. 75 | * The `-f-inlining` flag is not supported anymore. 76 | 77 | # 0.4.2.3 78 | 79 | * Bumped template-haskell version. 80 | 81 | # 0.4.2.2 82 | 83 | * Bumped containers version. 84 | 85 | # 0.4.2.1 86 | 87 | * Fixed [lens bug #799](https://github.com/ekmett/lens/issues/799) (`makeFields` instances violate coverage condition). 88 | 89 | # 0.4.2 90 | 91 | * We now depend on `th-abstraction` (like `lens` itself). 92 | * Associated types are now supported. 93 | 94 | # 0.4.1.3 95 | 96 | * Bumped the upper bound of template-haskell again. 97 | 98 | # 0.4.1.2 99 | 100 | Skipped (the tarball got corrupted). 101 | 102 | # 0.4.1.1 103 | 104 | * Bumped the upper bound of template-haskell, as requested by @ocharles. 105 | 106 | # 0.4.1.0 107 | 108 | * Added `abbreviatedFields`. 109 | 110 | # 0.4.0.1 111 | 112 | * Ported a lens commit that (probably) makes lens generation deterministic. See [issue #83](https://github.com/monadfix/microlens/issues/83). 113 | 114 | # 0.4.0.0 115 | 116 | * Added `makeClassy` (and `createClass`). 117 | 118 | # 0.3.0.2 119 | 120 | * Added forgotten copyright/authorship information. 121 | 122 | # 0.3.0.1 123 | 124 | * The library is now compatible with GHC 8. 125 | 126 | # 0.3.0.0 127 | 128 | * `SimpleGetter` and `SimpleFold` are no longer reexported. 129 | 130 | # 0.2.2.0 131 | 132 | * Moved `Getter` and `Fold` from this package to microlens (they're in `Lens.Micro.Extras`). 133 | 134 | # 0.2.1.3 135 | 136 | * Bumped template-haskell (so that the package would compile with GHC HEAD). 137 | 138 | # 0.2.1.2 139 | 140 | * Bumped microlens version to be able to use `phantom`. 141 | 142 | # 0.2.1.1 143 | 144 | * Bumped microlens version again. 145 | 146 | # 0.2.1.0 147 | 148 | * Bumped base version. 149 | * Bumped microlens version. 150 | 151 | # 0.2.0.0 152 | 153 | * `createClass` was removed because it doesn't seem to be useful without `lensClass`. 154 | * `defaultFieldRules` isn't exported anymore – use `camelCaseFields`. 155 | 156 | # 0.1.2.0 157 | 158 | * Package now compiles with `-O2` and other optimisations by default. 159 | 160 | # 0.1.1.0 161 | 162 | * Added `makeLensesFor` (and `lensRulesFor`). 163 | 164 | # 0.1.0.1 165 | 166 | * Wrote a bit of documentation. 167 | 168 | # 0.1.0.0 169 | 170 | Initial release. 171 | -------------------------------------------------------------------------------- /microlens-th/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2016 Eric Mertens, Edward Kmett, Artyom Kazak 2 | 2018 Monadfix 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Monadfix nor the names of other 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /microlens-th/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /microlens-th/microlens-th.cabal: -------------------------------------------------------------------------------- 1 | name: microlens-th 2 | version: 0.4.3.17 3 | synopsis: Automatic generation of record lenses for microlens 4 | description: 5 | This package lets you automatically generate lenses for data types; code was extracted from the lens package, and therefore generated lenses are fully compatible with ones generated by lens (and can be used both from lens and microlens). 6 | . 7 | This package is a part of the family; see the readme . 8 | license: BSD3 9 | license-file: LICENSE 10 | author: Eric Mertens, Edward Kmett, Artyom Kazak 11 | maintainer: Steven Fontanella 12 | homepage: http://github.com/stevenfontanella/microlens 13 | bug-reports: http://github.com/stevenfontanella/microlens/issues 14 | category: Data, Lenses 15 | build-type: Simple 16 | extra-source-files: 17 | CHANGELOG.md 18 | cabal-version: >=1.10 19 | tested-with: 20 | GHC==9.12.1 21 | GHC==9.10.1 22 | GHC==9.8.4 23 | GHC==9.6.6 24 | GHC==9.4.8 25 | GHC==9.2.8 26 | GHC==9.0.2 27 | GHC==8.10.7 28 | GHC==8.8.4 29 | GHC==8.6.5 30 | GHC==8.4.4 31 | GHC==8.2.2 32 | GHC==8.0.2 33 | 34 | source-repository head 35 | type: git 36 | location: https://github.com/stevenfontanella/microlens.git 37 | 38 | library 39 | exposed-modules: Lens.Micro.TH 40 | Lens.Micro.TH.Internal 41 | -- other-modules: 42 | -- other-extensions: 43 | build-depends: base >=4.5 && <5 44 | , microlens >=0.4.0 && <0.5 45 | , containers >=0.5 && <0.9 46 | , transformers 47 | , template-haskell >=2.8 && <2.24 48 | , th-abstraction >=0.4.1 && <0.8 49 | 50 | ghc-options: 51 | -Wall -fwarn-tabs 52 | -O2 -fdicts-cheap -funbox-strict-fields 53 | -fmax-simplifier-iterations=10 54 | 55 | hs-source-dirs: src 56 | default-language: Haskell2010 57 | default-extensions: TypeOperators 58 | 59 | test-suite templates 60 | type: exitcode-stdio-1.0 61 | main-is: templates.hs 62 | other-modules: T799 T917 T972 63 | ghc-options: -Wall -threaded 64 | hs-source-dirs: test 65 | 66 | build-depends: base, microlens, microlens-th, tagged 67 | 68 | default-language: Haskell2010 69 | default-extensions: TypeOperators 70 | -------------------------------------------------------------------------------- /microlens-th/src/Lens/Micro/TH/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE TypeSynonymInstances #-} 4 | 5 | #ifndef MIN_VERSION_template_haskell 6 | #define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706) 7 | #endif 8 | 9 | -- Language.Haskell.TH was not marked as Safe before template-haskell-2.12.0 10 | #if MIN_VERSION_template_haskell(2,12,0) 11 | {-# LANGUAGE Safe #-} 12 | #else 13 | {-# LANGUAGE Trustworthy #-} 14 | #endif 15 | 16 | {- | 17 | Module : Lens.Micro.TH.Internal 18 | Copyright : (C) 2013-2016 Eric Mertens, Edward Kmett; 2018 Monadfix 19 | License : BSD-style (see the file LICENSE) 20 | 21 | Functions used by "Lens.Micro.TH". This is an internal module and it may go 22 | away or change at any time; do not depend on it. 23 | -} 24 | module Lens.Micro.TH.Internal 25 | ( 26 | -- * Name utilities 27 | HasName(..), 28 | newNames, 29 | 30 | -- * Type variable utilities 31 | HasTypeVars(..), 32 | typeVars, 33 | substTypeVars, 34 | 35 | -- * Miscellaneous utilities 36 | datatypeTypeKinded, 37 | inlinePragma, 38 | conAppsT, 39 | quantifyType, quantifyType', 40 | tvbToType, 41 | unSigT, 42 | 43 | -- * Lens functions 44 | elemOf, 45 | lengthOf, 46 | setOf, 47 | _ForallT, 48 | ) 49 | where 50 | 51 | import Data.Monoid 52 | import qualified Data.Map as Map 53 | import Data.Map (Map) 54 | import qualified Data.Set as Set 55 | import Data.Set (Set) 56 | import Data.Maybe 57 | import Lens.Micro 58 | import Language.Haskell.TH 59 | import Language.Haskell.TH.Datatype.TyVarBndr 60 | import qualified Language.Haskell.TH.Datatype as D 61 | import qualified Language.Haskell.TH.Datatype.TyVarBndr as D 62 | 63 | #if __GLASGOW_HASKELL__ < 710 64 | import Control.Applicative 65 | import Data.Traversable (traverse) 66 | #endif 67 | 68 | -- | Has a 'Name' 69 | class HasName t where 70 | -- | Extract (or modify) the 'Name' of something 71 | name :: Lens' t Name 72 | 73 | instance HasName (TyVarBndr_ flag) where 74 | name = traverseTVName 75 | 76 | instance HasName Name where 77 | name = id 78 | 79 | -- | On @template-haskell-2.11.0.0@ or later, if a 'GadtC' or 'RecGadtC' has 80 | -- multiple 'Name's, the leftmost 'Name' will be chosen. 81 | instance HasName Con where 82 | name f (NormalC n tys) = (`NormalC` tys) <$> f n 83 | name f (RecC n tys) = (`RecC` tys) <$> f n 84 | name f (InfixC l n r) = (\n' -> InfixC l n' r) <$> f n 85 | name f (ForallC bds ctx con) = ForallC bds ctx <$> name f con 86 | #if MIN_VERSION_template_haskell(2,11,0) 87 | name f (GadtC ns argTys retTy) = 88 | (\n -> GadtC [n] argTys retTy) <$> f (head ns) 89 | name f (RecGadtC ns argTys retTy) = 90 | (\n -> RecGadtC [n] argTys retTy) <$> f (head ns) 91 | #endif 92 | 93 | -- | Generate many new names from a given base name. 94 | newNames :: String {- ^ base name -} -> Int {- ^ count -} -> Q [Name] 95 | newNames base n = sequence [ newName (base++show i) | i <- [1..n] ] 96 | 97 | -- | Provides for the extraction of free type variables, and alpha renaming. 98 | class HasTypeVars t where 99 | -- When performing substitution into this traversal you're not allowed 100 | -- to substitute in a name that is bound internally or you'll violate 101 | -- the 'Traversal' laws, when in doubt generate your names with 'newName'. 102 | typeVarsEx :: Set Name -> Traversal' t Name 103 | 104 | instance HasTypeVars (TyVarBndr_ flag) where 105 | typeVarsEx s f b 106 | | Set.member (b^.name) s = pure b 107 | | otherwise = name f b 108 | 109 | instance HasTypeVars Name where 110 | typeVarsEx s f n 111 | | Set.member n s = pure n 112 | | otherwise = f n 113 | 114 | instance HasTypeVars Type where 115 | typeVarsEx s f (VarT n) = VarT <$> typeVarsEx s f n 116 | typeVarsEx s f (AppT l r) = AppT <$> typeVarsEx s f l <*> typeVarsEx s f r 117 | typeVarsEx s f (ForallT bs ctx ty) = ForallT bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f ty 118 | where s' = s `Set.union` setOf typeVars bs 119 | typeVarsEx _ _ t@ConT{} = pure t 120 | typeVarsEx _ _ t@TupleT{} = pure t 121 | typeVarsEx _ _ t@ListT{} = pure t 122 | typeVarsEx _ _ t@ArrowT{} = pure t 123 | typeVarsEx _ _ t@UnboxedTupleT{} = pure t 124 | #if MIN_VERSION_template_haskell(2,8,0) 125 | typeVarsEx s f (SigT t k) = SigT <$> typeVarsEx s f t 126 | <*> typeVarsEx s f k 127 | #else 128 | typeVarsEx s f (SigT t k) = (`SigT` k) <$> typeVarsEx s f t 129 | #endif 130 | #if MIN_VERSION_template_haskell(2,8,0) 131 | typeVarsEx _ _ t@PromotedT{} = pure t 132 | typeVarsEx _ _ t@PromotedTupleT{} = pure t 133 | typeVarsEx _ _ t@PromotedNilT{} = pure t 134 | typeVarsEx _ _ t@PromotedConsT{} = pure t 135 | typeVarsEx _ _ t@StarT{} = pure t 136 | typeVarsEx _ _ t@ConstraintT{} = pure t 137 | typeVarsEx _ _ t@LitT{} = pure t 138 | #endif 139 | #if MIN_VERSION_template_haskell(2,10,0) 140 | typeVarsEx _ _ t@EqualityT{} = pure t 141 | #endif 142 | #if MIN_VERSION_template_haskell(2,11,0) 143 | typeVarsEx s f (InfixT t1 n t2) = InfixT <$> typeVarsEx s f t1 144 | <*> pure n 145 | <*> typeVarsEx s f t2 146 | typeVarsEx s f (UInfixT t1 n t2) = UInfixT <$> typeVarsEx s f t1 147 | <*> pure n 148 | <*> typeVarsEx s f t2 149 | typeVarsEx s f (ParensT t) = ParensT <$> typeVarsEx s f t 150 | typeVarsEx _ _ t@WildCardT{} = pure t 151 | #endif 152 | #if MIN_VERSION_template_haskell(2,12,0) 153 | typeVarsEx _ _ t@UnboxedSumT{} = pure t 154 | #endif 155 | #if MIN_VERSION_template_haskell(2,15,0) 156 | typeVarsEx s f (AppKindT t k) = AppKindT <$> typeVarsEx s f t 157 | <*> typeVarsEx s f k 158 | typeVarsEx s f (ImplicitParamT n t) = ImplicitParamT n <$> typeVarsEx s f t 159 | #endif 160 | #if MIN_VERSION_template_haskell(2,16,0) 161 | typeVarsEx s f (ForallVisT bs ty) = ForallVisT bs <$> typeVarsEx s' f ty 162 | where s' = s `Set.union` setOf typeVars bs 163 | #endif 164 | #if MIN_VERSION_template_haskell(2,17,0) 165 | typeVarsEx _ _ t@MulArrowT{} = pure t 166 | #endif 167 | 168 | #if !MIN_VERSION_template_haskell(2,10,0) 169 | instance HasTypeVars Pred where 170 | typeVarsEx s f (ClassP n ts) = ClassP n <$> typeVarsEx s f ts 171 | typeVarsEx s f (EqualP l r) = EqualP <$> typeVarsEx s f l <*> typeVarsEx s f r 172 | #endif 173 | #if MIN_VERSION_template_haskell(2,19,0) 174 | typeVarsEx s f (PromotedInfixT t1 n t2) = PromotedInfixT <$> typeVarsEx s f t1 175 | <*> pure n 176 | <*> typeVarsEx s f t2 177 | typeVarsEx s f (PromotedUInfixT t1 n t2) = PromotedUInfixT <$> typeVarsEx s f t1 178 | <*> pure n 179 | <*> typeVarsEx s f t2 180 | #endif 181 | 182 | instance HasTypeVars Con where 183 | typeVarsEx s f (NormalC n ts) = NormalC n <$> (traverse . _2) (typeVarsEx s f) ts 184 | typeVarsEx s f (RecC n ts) = RecC n <$> (traverse . _3) (typeVarsEx s f) ts 185 | typeVarsEx s f (InfixC l n r) = InfixC <$> g l <*> pure n <*> g r 186 | where g (i, t) = (,) i <$> typeVarsEx s f t 187 | typeVarsEx s f (ForallC bs ctx c) = ForallC bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f c 188 | where s' = s `Set.union` Set.fromList (bs ^.. typeVars) 189 | #if MIN_VERSION_template_haskell(2,11,0) 190 | typeVarsEx s f (GadtC ns argTys retTy) = 191 | GadtC ns <$> (traverse . _2) (typeVarsEx s f) argTys 192 | <*> typeVarsEx s f retTy 193 | typeVarsEx s f (RecGadtC ns argTys retTy) = 194 | RecGadtC ns <$> (traverse . _3) (typeVarsEx s f) argTys 195 | <*> typeVarsEx s f retTy 196 | #endif 197 | 198 | instance HasTypeVars t => HasTypeVars [t] where 199 | typeVarsEx s = traverse . typeVarsEx s 200 | 201 | instance HasTypeVars t => HasTypeVars (Maybe t) where 202 | typeVarsEx s = traverse . typeVarsEx s 203 | 204 | -- Traverse /free/ type variables 205 | typeVars :: HasTypeVars t => Traversal' t Name 206 | typeVars = typeVarsEx mempty 207 | 208 | -- Substitute using a map of names in for /free/ type variables 209 | substTypeVars :: HasTypeVars t => Map Name Name -> t -> t 210 | substTypeVars m = over typeVars $ \n -> fromMaybe n (Map.lookup n m) 211 | 212 | -- | Generate an INLINE pragma. 213 | inlinePragma :: Name -> [DecQ] 214 | #if MIN_VERSION_template_haskell(2,8,0) 215 | inlinePragma methodName = [pragInlD methodName Inline FunLike AllPhases] 216 | #else 217 | inlinePragma methodName = [pragInlD methodName (inlineSpecNoPhase True False)] 218 | #endif 219 | 220 | -- | Apply arguments to a type constructor. 221 | conAppsT :: Name -> [Type] -> Type 222 | conAppsT conName = foldl AppT (ConT conName) 223 | 224 | -- Construct a 'Type' using the datatype's type constructor and type 225 | -- parameters. Unlike 'D.datatypeType', kind signatures are preserved to 226 | -- some extent. (See the comments for 'dropSigsIfNonDataFam' below for more 227 | -- details on this.) 228 | datatypeTypeKinded :: D.DatatypeInfo -> Type 229 | datatypeTypeKinded di 230 | = foldl AppT (ConT (D.datatypeName di)) 231 | $ dropSigsIfNonDataFam 232 | $ D.datatypeInstTypes di 233 | where 234 | {- 235 | In an effort to prevent users from having to enable KindSignatures every 236 | time that they use lens' TH functionality, we strip off reified kind 237 | annotations from when: 238 | 239 | 1. The kind of a type does not contain any kind variables. If it *does* 240 | contain kind variables, we want to preserve them so that we can generate 241 | type signatures that preserve the dependency order of kind and type 242 | variables. (The data types in test/T917.hs contain examples where this 243 | is important.) This will require enabling `PolyKinds`, but since 244 | `PolyKinds` implies `KindSignatures`, we can at least accomplish two 245 | things at once. 246 | 2. The data type is not an instance of a data family. We make an exception 247 | for data family instances, since the presence or absence of a kind 248 | annotation can be the difference between typechecking or not. 249 | (See T917DataFam in tests/T917.hs for an example.) Moreover, the 250 | `TypeFamilies` extension implies `KindSignatures`. 251 | -} 252 | dropSigsIfNonDataFam :: [Type] -> [Type] 253 | dropSigsIfNonDataFam 254 | | isDataFamily (D.datatypeVariant di) = id 255 | | otherwise = map dropSig 256 | 257 | dropSig :: Type -> Type 258 | dropSig (SigT t k) | null (D.freeVariables k) = t 259 | dropSig t = t 260 | 261 | -- | Template Haskell wants type variables declared in a forall, so 262 | -- we find all free type variables in a given type and declare them. 263 | quantifyType :: Cxt -> Type -> Type 264 | quantifyType = quantifyType' Set.empty 265 | 266 | -- | This function works like 'quantifyType' except that it takes 267 | -- a list of variables to exclude from quantification. 268 | quantifyType' :: Set Name -> Cxt -> Type -> Type 269 | quantifyType' exclude c t = ForallT vs c t 270 | where 271 | vs = filter (\tvb -> D.tvName tvb `Set.notMember` exclude) 272 | $ D.changeTVFlags D.SpecifiedSpec 273 | $ D.freeVariablesWellScoped (t:concatMap predTypes c) -- stable order 274 | 275 | predTypes :: Pred -> [Type] 276 | #if MIN_VERSION_template_haskell(2,10,0) 277 | predTypes p = [p] 278 | #else 279 | predTypes (ClassP _ ts) = ts 280 | predTypes (EqualP t1 t2) = [t1, t2] 281 | #endif 282 | 283 | -- | Convert a 'TyVarBndr' into its corresponding 'Type'. 284 | tvbToType :: D.TyVarBndr_ flag -> Type 285 | tvbToType = D.elimTV VarT (SigT . VarT) 286 | 287 | -- | Peel off a kind signature from a Type (if it has one). 288 | unSigT :: Type -> Type 289 | unSigT (SigT t _) = t 290 | unSigT t = t 291 | 292 | isDataFamily :: D.DatatypeVariant -> Bool 293 | isDataFamily D.Datatype = False 294 | isDataFamily D.Newtype = False 295 | isDataFamily D.DataInstance = True 296 | isDataFamily D.NewtypeInstance = True 297 | #if MIN_VERSION_th_abstraction(0,5,0) 298 | isDataFamily D.TypeData = False 299 | #endif 300 | 301 | ---------------------------------------------------------------------------- 302 | -- Lens functions which would've been in Lens.Micro if it wasn't “micro” 303 | ---------------------------------------------------------------------------- 304 | 305 | elemOf :: Eq a => Getting (Endo [a]) s a -> a -> s -> Bool 306 | elemOf l x s = elem x (s ^.. l) 307 | 308 | lengthOf :: Getting (Endo [a]) s a -> s -> Int 309 | lengthOf l s = length (s ^.. l) 310 | 311 | setOf :: Ord a => Getting (Endo [a]) s a -> s -> Set a 312 | setOf l s = Set.fromList (s ^.. l) 313 | 314 | _ForallT :: Traversal' Type ([TyVarBndrSpec], Cxt, Type) 315 | _ForallT f (ForallT a b c) = (\(x, y, z) -> ForallT x y z) <$> f (a, b, c) 316 | _ForallT _ other = pure other 317 | -------------------------------------------------------------------------------- /microlens-th/test/T799.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | -- | Test 'makeFields' on a field whose type has a data family. Unlike for 7 | -- type families, for data families we do not generate type equality 8 | -- constraints, as they are not needed to avoid the issue in #754. 9 | -- 10 | -- This tests that the fix for #799 is valid by putting this in a module in 11 | -- which UndecidableInstances is not enabled. 12 | module T799 where 13 | 14 | import Lens.Micro 15 | import Lens.Micro.TH 16 | 17 | data family DF a 18 | newtype instance DF Int = FooInt Int 19 | 20 | data Bar = Bar { _barFoo :: DF Int } 21 | makeFields ''Bar 22 | 23 | checkBarFoo :: Lens' Bar (DF Int) 24 | checkBarFoo = foo 25 | -------------------------------------------------------------------------------- /microlens-th/test/T917.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE FunctionalDependencies #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE PolyKinds #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | 9 | #if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806 10 | {-# LANGUAGE TypeInType #-} 11 | #endif 12 | module T917 where 13 | 14 | import Lens.Micro.TH 15 | import Data.Proxy 16 | 17 | #if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806 18 | import Data.Kind 19 | #endif 20 | 21 | -- Like Data.Functor.Const, but redefined to ensure that it is poly-kinded 22 | -- across all versions of GHC, not just 8.0+ 23 | newtype Constant a (b :: k) = Constant a 24 | 25 | data family T917DataFam (a :: k) 26 | data instance T917DataFam (a :: *) = MkT917DataFam { _unT917DataFam :: Proxy a } 27 | $(makeLenses 'MkT917DataFam) 28 | 29 | {- 30 | data T917OneA (a :: k -> *) (b :: k -> *) = MkT917OneA 31 | data T917OneB a b = MkT917OneB (T917OneA a (Const b)) 32 | $(makePrisms ''T917OneB) 33 | 34 | data T917TwoA (a :: k -> *) (b :: k -> *) = MkT917TwoA 35 | data T917TwoB a b = MkT917TwoB (T917TwoA a (Const b)) 36 | $(makeClassyPrisms ''T917TwoB) 37 | -} 38 | 39 | #if __GLASGOW_HASKELL__ >= 800 40 | {- 41 | data T917GadtOne (a :: k) where 42 | MkT917GadtOne :: T917GadtOne (a :: *) 43 | $(makePrisms ''T917GadtOne) 44 | 45 | data T917GadtTwo (a :: k) where 46 | MkT917GadtTwo :: T917GadtTwo (a :: *) 47 | $(makePrisms ''T917GadtTwo) 48 | -} 49 | #endif 50 | -------------------------------------------------------------------------------- /microlens-th/test/T972.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE PolyKinds #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | 5 | #if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806 6 | {-# LANGUAGE TypeInType #-} 7 | #endif 8 | module T972 where 9 | 10 | import Lens.Micro.TH 11 | #if __GLASGOW_HASKELL__ >= 800 12 | import Data.Proxy 13 | #endif 14 | 15 | newtype Arc s = Arc { _unArc :: Int } 16 | 17 | data Direction = Negative | Positive 18 | data Dart s = Dart { _arc :: Arc s, _direction :: Direction } 19 | $(makeLenses ''Dart) 20 | 21 | #if __GLASGOW_HASKELL__ >= 800 22 | data Fancy k (a :: k) = MkFancy { _unFancy1 :: k, _unFancy2 :: Proxy a } 23 | $(makeLenses ''Fancy) 24 | #endif 25 | -------------------------------------------------------------------------------- /microlens-th/test/templates.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | {-# LANGUAGE Rank2Types #-} 8 | {-# LANGUAGE GADTs #-} 9 | {-# LANGUAGE UndecidableInstances #-} 10 | {-# LANGUAGE CPP #-} 11 | ----------------------------------------------------------------------------- 12 | -- | 13 | -- Module : Main (templates) 14 | -- Copyright : (C) 2012-14 Edward Kmett 15 | -- License : BSD-style (see the file LICENSE) 16 | -- Maintainer : Edward Kmett 17 | -- Stability : experimental 18 | -- Portability : non-portable 19 | -- 20 | -- This test suite validates that we are able to generate usable lenses with 21 | -- template haskell. 22 | -- 23 | -- The commented code summarizes what will be auto-generated below 24 | ----------------------------------------------------------------------------- 25 | module Main where 26 | 27 | import Lens.Micro 28 | import Lens.Micro.TH 29 | import T799 () 30 | import T917 () 31 | import T972 () 32 | 33 | data Bar a b c = Bar { _baz :: (a, b) } 34 | makeLenses ''Bar 35 | 36 | -- should actually be Iso 37 | checkBaz :: Lens (Bar a b c) (Bar a' b' c') (a, b) (a', b') 38 | checkBaz = baz 39 | 40 | data Quux a b = Quux { _quaffle :: Int, _quartz :: Double } 41 | makeLenses ''Quux 42 | 43 | checkQuaffle :: Lens (Quux a b) (Quux a' b') Int Int 44 | checkQuaffle = quaffle 45 | 46 | checkQuartz :: Lens (Quux a b) (Quux a' b') Double Double 47 | checkQuartz = quartz 48 | 49 | data Quark a = Qualified { _gaffer :: a } 50 | | Unqualified { _gaffer :: a, _tape :: a } 51 | makeLenses ''Quark 52 | 53 | checkGaffer :: Lens' (Quark a) a 54 | checkGaffer = gaffer 55 | 56 | checkTape :: Traversal' (Quark a) a 57 | checkTape = tape 58 | 59 | data Hadron a b = Science { _a1 :: a, _a2 :: a, _c :: b } 60 | makeLenses ''Hadron 61 | 62 | checkA1 :: Lens' (Hadron a b) a 63 | checkA1 = a1 64 | 65 | checkA2 :: Lens' (Hadron a b) a 66 | checkA2 = a2 67 | 68 | checkC :: Lens (Hadron a b) (Hadron a b') b b' 69 | checkC = c 70 | 71 | data Perambulation a b 72 | = Mountains { _terrain :: a, _altitude :: b } 73 | | Beaches { _terrain :: a, _dunes :: a } 74 | makeLenses ''Perambulation 75 | 76 | checkTerrain :: Lens' (Perambulation a b) a 77 | checkTerrain = terrain 78 | 79 | checkAltitude :: Traversal (Perambulation a b) (Perambulation a b') b b' 80 | checkAltitude = altitude 81 | 82 | checkDunes :: Traversal' (Perambulation a b) a 83 | checkDunes = dunes 84 | 85 | makeLensesFor [("_terrain", "allTerrain"), ("_dunes", "allTerrain")] ''Perambulation 86 | 87 | checkAllTerrain :: Traversal (Perambulation a b) (Perambulation a' b) a a' 88 | checkAllTerrain = allTerrain 89 | 90 | data LensCrafted a = Still { _still :: a } 91 | | Works { _still :: a } 92 | makeLenses ''LensCrafted 93 | 94 | checkStill :: Lens (LensCrafted a) (LensCrafted b) a b 95 | checkStill = still 96 | 97 | data Task a = Task 98 | { taskOutput :: a -> IO () 99 | , taskState :: a 100 | , taskStop :: IO () 101 | } 102 | 103 | makeLensesFor [("taskOutput", "outputLens"), ("taskState", "stateLens"), ("taskStop", "stopLens")] ''Task 104 | 105 | checkOutputLens :: Lens' (Task a) (a -> IO ()) 106 | checkOutputLens = outputLens 107 | 108 | checkStateLens :: Lens' (Task a) a 109 | checkStateLens = stateLens 110 | 111 | checkStopLens :: Lens' (Task a) (IO ()) 112 | checkStopLens = stopLens 113 | 114 | data Mono a = Mono { _monoFoo :: a, _monoBar :: Int } 115 | makeClassy ''Mono 116 | -- class HasMono t where 117 | -- mono :: Simple Lens t Mono 118 | -- instance HasMono Mono where 119 | -- mono = id 120 | 121 | checkMono :: HasMono t a => Lens' t (Mono a) 122 | checkMono = mono 123 | 124 | checkMono' :: Lens' (Mono a) (Mono a) 125 | checkMono' = mono 126 | 127 | checkMonoFoo :: HasMono t a => Lens' t a 128 | checkMonoFoo = monoFoo 129 | 130 | checkMonoBar :: HasMono t a => Lens' t Int 131 | checkMonoBar = monoBar 132 | 133 | data Nucleosis = Nucleosis { _nuclear :: Mono Int } 134 | makeClassy ''Nucleosis 135 | -- class HasNucleosis t where 136 | -- nucleosis :: Simple Lens t Nucleosis 137 | -- instance HasNucleosis Nucleosis 138 | 139 | checkNucleosis :: HasNucleosis t => Lens' t Nucleosis 140 | checkNucleosis = nucleosis 141 | 142 | checkNucleosis' :: Lens' Nucleosis Nucleosis 143 | checkNucleosis' = nucleosis 144 | 145 | checkNuclear :: HasNucleosis t => Lens' t (Mono Int) 146 | checkNuclear = nuclear 147 | 148 | instance HasMono Nucleosis Int where 149 | mono = nuclear 150 | 151 | -- Dodek's example 152 | data Foo = Foo { _fooX, _fooY :: Int } 153 | makeClassy ''Foo 154 | 155 | checkFoo :: HasFoo t => Lens' t Foo 156 | checkFoo = foo 157 | 158 | checkFoo' :: Lens' Foo Foo 159 | checkFoo' = foo 160 | 161 | checkFooX :: HasFoo t => Lens' t Int 162 | checkFooX = fooX 163 | 164 | checkFooY :: HasFoo t => Lens' t Int 165 | checkFooY = fooY 166 | 167 | data Dude a = Dude 168 | { dudeLevel :: Int 169 | , dudeAlias :: String 170 | , dudeLife :: () 171 | , dudeThing :: a 172 | } 173 | makeFields ''Dude 174 | 175 | checkLevel :: HasLevel t a => Lens' t a 176 | checkLevel = level 177 | 178 | checkLevel' :: Lens' (Dude a) Int 179 | checkLevel' = level 180 | 181 | checkAlias :: HasAlias t a => Lens' t a 182 | checkAlias = alias 183 | 184 | checkAlias' :: Lens' (Dude a) String 185 | checkAlias' = alias 186 | 187 | checkLife :: HasLife t a => Lens' t a 188 | checkLife = life 189 | 190 | checkLife' :: Lens' (Dude a) () 191 | checkLife' = life 192 | 193 | checkThing :: HasThing t a => Lens' t a 194 | checkThing = thing 195 | 196 | checkThing' :: Lens' (Dude a) a 197 | checkThing' = thing 198 | 199 | data Lebowski a = Lebowski 200 | { _lebowskiAlias :: String 201 | , _lebowskiLife :: Int 202 | , _lebowskiMansion :: String 203 | , _lebowskiThing :: Maybe a 204 | } 205 | makeFields ''Lebowski 206 | 207 | checkAlias2 :: Lens' (Lebowski a) String 208 | checkAlias2 = alias 209 | 210 | checkLife2 :: Lens' (Lebowski a) Int 211 | checkLife2 = life 212 | 213 | checkMansion :: HasMansion t a => Lens' t a 214 | checkMansion = mansion 215 | 216 | checkMansion' :: Lens' (Lebowski a) String 217 | checkMansion' = mansion 218 | 219 | checkThing2 :: Lens' (Lebowski a) (Maybe a) 220 | checkThing2 = thing 221 | 222 | type family Fam a 223 | type instance Fam Int = String 224 | 225 | data FamRec a = FamRec 226 | { _famRecThing :: Fam a 227 | , _famRecUniqueToFamRec :: Fam a 228 | } 229 | makeFields ''FamRec 230 | 231 | checkFamRecThing :: Lens' (FamRec a) (Fam a) 232 | checkFamRecThing = thing 233 | 234 | checkFamRecUniqueToFamRec :: Lens' (FamRec a) (Fam a) 235 | checkFamRecUniqueToFamRec = uniqueToFamRec 236 | 237 | checkFamRecView :: FamRec Int -> String 238 | checkFamRecView = (^. thing) 239 | 240 | data AbideConfiguration a = AbideConfiguration 241 | { _acLocation :: String 242 | , _acDuration :: Int 243 | , _acThing :: a 244 | } 245 | makeLensesWith abbreviatedFields ''AbideConfiguration 246 | 247 | checkLocation :: HasLocation t a => Lens' t a 248 | checkLocation = location 249 | 250 | checkLocation' :: Lens' (AbideConfiguration a) String 251 | checkLocation' = location 252 | 253 | checkDuration :: HasDuration t a => Lens' t a 254 | checkDuration = duration 255 | 256 | checkDuration' :: Lens' (AbideConfiguration a) Int 257 | checkDuration' = duration 258 | 259 | checkThing3 :: Lens' (AbideConfiguration a) a 260 | checkThing3 = thing 261 | 262 | dudeDrink :: String 263 | dudeDrink = (Dude 9 "El Duderino" () "white russian") ^. thing 264 | lebowskiCarpet :: Maybe String 265 | lebowskiCarpet = (Lebowski "Mr. Lebowski" 0 "" (Just "carpet")) ^. thing 266 | abideAnnoyance :: String 267 | abideAnnoyance = (AbideConfiguration "the tree" 10 "the wind") ^. thing 268 | 269 | {- we don't provide declareX 270 | ~~~~~~~~~~~~~ 271 | 272 | declareLenses [d| 273 | data Quark1 a = Qualified1 { gaffer1 :: a } 274 | | Unqualified1 { gaffer1 :: a, tape1 :: a } 275 | |] 276 | -- data Quark1 a = Qualified1 a | Unqualified1 a a 277 | 278 | checkGaffer1 :: Lens' (Quark1 a) a 279 | checkGaffer1 = gaffer1 280 | 281 | checkTape1 :: Traversal' (Quark1 a) a 282 | checkTape1 = tape1 283 | 284 | declarePrisms [d| 285 | data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp } 286 | |] 287 | -- data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp } 288 | 289 | checkLit :: Int -> Exp 290 | checkLit = Lit 291 | 292 | checkVar :: String -> Exp 293 | checkVar = Var 294 | 295 | checkLambda :: String -> Exp -> Exp 296 | checkLambda = Lambda 297 | 298 | check_Lit :: Prism' Exp Int 299 | check_Lit = _Lit 300 | 301 | check_Var :: Prism' Exp String 302 | check_Var = _Var 303 | 304 | check_Lambda :: Prism' Exp (String, Exp) 305 | check_Lambda = _Lambda 306 | 307 | 308 | declarePrisms [d| 309 | data Banana = Banana Int String 310 | |] 311 | -- data Banana = Banana Int String 312 | 313 | check_Banana :: Iso' Banana (Int, String) 314 | check_Banana = _Banana 315 | 316 | cavendish :: Banana 317 | cavendish = _Banana # (4, "Cavendish") 318 | 319 | data family Family a b c 320 | 321 | #if __GLASGOW_HASKELL >= 706 322 | declareLenses [d| 323 | data instance Family Int (a, b) a = FamilyInt { fm0 :: (b, a), fm1 :: Int } 324 | |] 325 | -- data instance Family Int (a, b) a = FamilyInt a b 326 | checkFm0 :: Lens (Family Int (a, b) a) (Family Int (a', b') a') (b, a) (b', a') 327 | checkFm0 = fm0 328 | 329 | checkFm1 :: Lens' (Family Int (a, b) a) Int 330 | checkFm1 = fm1 331 | 332 | #endif 333 | 334 | class Class a where 335 | data Associated a 336 | method :: a -> Int 337 | 338 | declareLenses [d| 339 | instance Class Int where 340 | data Associated Int = AssociatedInt { mochi :: Double } 341 | method = id 342 | |] 343 | 344 | -- instance Class Int where 345 | -- data Associated Int = AssociatedInt Double 346 | -- method = id 347 | 348 | checkMochi :: Iso' (Associated Int) Double 349 | checkMochi = mochi 350 | 351 | #if __GLASGOW_HASKELL__ >= 706 352 | declareFields [d| 353 | data DeclaredFields f a 354 | = DeclaredField1 { declaredFieldsA0 :: f a , declaredFieldsB0 :: Int } 355 | | DeclaredField2 { declaredFieldsC0 :: String , declaredFieldsB0 :: Int } 356 | deriving (Show) 357 | |] 358 | 359 | checkA0 :: HasA0 t a => Traversal' t a 360 | checkA0 = a0 361 | 362 | checkB0 :: HasB0 t a => Lens' t a 363 | checkB0 = b0 364 | 365 | checkC0 :: HasC0 t a => Traversal' t a 366 | checkC0 = c0 367 | 368 | checkA0' :: Traversal' (DeclaredFields f a) (f a) 369 | checkA0' = a0 370 | 371 | checkB0' :: Lens' (DeclaredFields f a) Int 372 | checkB0' = b0 373 | 374 | checkC0' :: Traversal' (DeclaredFields f a) String 375 | checkC0' = c0 376 | #endif 377 | 378 | declareFields [d| 379 | data Aardvark = Aardvark { aardvarkAlbatross :: Int } 380 | data Baboon = Baboon { baboonAlbatross :: Int } 381 | |] 382 | 383 | checkAardvark :: Lens' Aardvark Int 384 | checkAardvark = albatross 385 | 386 | checkBaboon :: Lens' Baboon Int 387 | checkBaboon = albatross 388 | 389 | -} 390 | 391 | data Rank2Tests 392 | = C1 { _r2length :: forall a. [a] -> Int 393 | , _r2nub :: forall a. Eq a => [a] -> [a] 394 | } 395 | | C2 { _r2length :: forall a. [a] -> Int } 396 | 397 | makeLenses ''Rank2Tests 398 | 399 | checkR2length :: SimpleGetter Rank2Tests ([a] -> Int) 400 | checkR2length = r2length 401 | 402 | checkR2nub :: Eq a => SimpleFold Rank2Tests ([a] -> [a]) 403 | checkR2nub = r2nub 404 | 405 | data PureNoFields = PureNoFieldsA | PureNoFieldsB { _pureNoFields :: Int } 406 | makeLenses ''PureNoFields 407 | 408 | {- we do not provide makePrisms 409 | ~~~~~~~~~~~~~~~~ 410 | 411 | data ReviewTest where ReviewTest :: a -> ReviewTest 412 | makePrisms ''ReviewTest 413 | 414 | -} 415 | 416 | -- test FieldNamers 417 | 418 | {- we do not provide namers 419 | ~~~~~~~~~~~~~~~~ 420 | 421 | data CheckUnderscoreNoPrefixNamer = CheckUnderscoreNoPrefixNamer 422 | { _fieldUnderscoreNoPrefix :: Int } 423 | makeLensesWith (lensRules & lensField .~ underscoreNoPrefixNamer ) ''CheckUnderscoreNoPrefixNamer 424 | checkUnderscoreNoPrefixNamer :: Lens' CheckUnderscoreNoPrefixNamer Int 425 | checkUnderscoreNoPrefixNamer = fieldUnderscoreNoPrefix 426 | 427 | 428 | -- how can we test NOT generating a lens for some fields? 429 | 430 | data CheckMappingNamer = CheckMappingNamer 431 | { fieldMappingNamer :: String } 432 | makeLensesWith (lensRules & lensField .~ (mappingNamer (return . ("hogehoge_" ++)))) ''CheckMappingNamer 433 | checkMappingNamer :: Lens' CheckMappingNamer String 434 | checkMappingNamer = hogehoge_fieldMappingNamer 435 | 436 | data CheckLookingupNamer = CheckLookingupNamer 437 | { fieldLookingupNamer :: Int } 438 | makeLensesWith (lensRules & lensField .~ (lookingupNamer [("fieldLookingupNamer", "foobarFieldLookingupNamer")])) ''CheckLookingupNamer 439 | checkLookingupNamer :: Lens' CheckLookingupNamer Int 440 | checkLookingupNamer = foobarFieldLookingupNamer 441 | 442 | data CheckUnderscoreNamer = CheckUnderscoreNamer 443 | { _hogeprefix_fieldCheckUnderscoreNamer :: Int } 444 | makeLensesWith (defaultFieldRules & lensField .~ underscoreNamer) ''CheckUnderscoreNamer 445 | checkUnderscoreNamer :: Lens' CheckUnderscoreNamer Int 446 | checkUnderscoreNamer = fieldCheckUnderscoreNamer 447 | 448 | data CheckCamelCaseNamer = CheckCamelCaseNamer 449 | { _checkCamelCaseNamerFieldCamelCaseNamer :: Int } 450 | makeLensesWith (defaultFieldRules & lensField .~ camelCaseNamer) ''CheckCamelCaseNamer 451 | checkCamelCaseNamer :: Lens' CheckCamelCaseNamer Int 452 | checkCamelCaseNamer = fieldCamelCaseNamer 453 | 454 | data CheckAbbreviatedNamer = CheckAbbreviatedNamer 455 | { _hogeprefixFieldAbbreviatedNamer :: Int } 456 | makeLensesWith (defaultFieldRules & lensField .~ abbreviatedNamer ) ''CheckAbbreviatedNamer 457 | checkAbbreviatedNamer :: Lens' CheckAbbreviatedNamer Int 458 | checkAbbreviatedNamer = fieldAbbreviatedNamer 459 | 460 | -} 461 | 462 | -- test for associated types (#93) 463 | 464 | data UserTable = UserTable 465 | data OtherTable = OtherTable 466 | 467 | class CRUDTable a where 468 | data TableRow a :: * 469 | 470 | instance CRUDTable UserTable where 471 | data TableRow UserTable = 472 | UserRow {_username :: String, _email :: String} | 473 | UserRow2 {_username :: String, _email :: String} 474 | -- Other things here 475 | 476 | instance CRUDTable OtherTable where 477 | data TableRow OtherTable = 478 | OtherRow {_foo :: Maybe Int, _bar :: Maybe Int} 479 | 480 | makeLenses 'UserRow 481 | 482 | checkUserName :: Lens' (TableRow UserTable) String 483 | checkUserName = username 484 | 485 | main :: IO () 486 | main = putStrLn "\ntest/templates.hs: ok" 487 | -------------------------------------------------------------------------------- /microlens/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.4.14.0 2 | 3 | * Add optics `mapMOf`, `rewriteMOf`, `transformMOf`, `anyOf`, `allOf`, `noneOf`, `foldMapOf`, and `cosmosOf`. 4 | 5 | # 0.4.13.1 6 | 7 | * [#161](https://github.com/stevenfontanella/microlens/pull/161) Fix GHC 9.4 warning for using `~` without TypeOperators 8 | * [#162](https://github.com/stevenfontanella/microlens/pull/162) Fix GHC warning for depending on StarIsType 9 | 10 | # 0.4.13.0 11 | 12 | * Added `_Show`, `worded`, and `lined`. 13 | 14 | # 0.4.12.0 15 | 16 | * Added instance `Ixed (NonEmpty a)` for GHC >= 8. 17 | 18 | # 0.4.11.3 19 | 20 | * Exported a `coerce` compatibility shim from `Lens.Micro.Internal`. 21 | 22 | # 0.4.11.2 23 | 24 | * Fixed compilation on GHC 8.8 (thanks to @vmchale). 25 | 26 | # 0.4.11.1 27 | 28 | * Reverted marking `Lens.Micro.Internal` as `Trustworthy`, see [#122](https://github.com/monadfix/microlens/issues/122). 29 | 30 | # 0.4.11 31 | 32 | * Added fixity declarations for `+~` and `-~` (thanks to Francesco Ariis). 33 | * Added `rewriteOf` and `transformOf` (thanks to @quasicomputational). 34 | * Added an instance `Each (Either a a) (Either b b) a b`, following `lens`'s suit. 35 | * Marked `Lens.Micro.Internal` as `Trustworthy` starting from GHC 7.8. 36 | 37 | # 0.4.10 38 | 39 | * Added `+~` and `-~`. 40 | * Marked `#.` and `.#` with `INLINE`. 41 | 42 | # 0.4.9.1 43 | 44 | * Reexported `<&>` from `Data.Functor` (on recent versions of `base`). 45 | 46 | # 0.4.9 47 | 48 | * Added `<>~`. 49 | * Added fixities for `<%~`, `<<%~`, `<<.~`. 50 | 51 | # 0.4.8.3 52 | 53 | * Fixed compilation on GHC 8.4. 54 | 55 | # 0.4.8.2 56 | 57 | Skipped (the tarball got corrupted). 58 | 59 | # 0.4.8.1 60 | 61 | * Added `HasCallStack` for some partial functions. 62 | 63 | # 0.4.8.0 64 | 65 | * Added `forOf_` and `forOf`. 66 | * Added an instance for `Each (NonEmpty a)` (available starting from GHC 8). 67 | 68 | # 0.4.7.0 69 | 70 | * Fixed the [Haddock crash on GHC 8](https://github.com/monadfix/microlens/issues/72) by removing default method implementations (`each = traverse` and `ix = ixAt`). If you had custom instances of `Ixed` or `Each` which relied on default methods, they'd stop working. 71 | 72 | # 0.4.6.0 73 | 74 | * Added `traverseOf` and `traverseOf_`. 75 | * Changed fixities of `#.` and `.#` to the ones in the profunctors package. Those operators are only available from `Lens.Micro.Internal`, so this shouldn't affect most users. 76 | 77 | # 0.4.5.0 78 | 79 | * Added `<&>` (which makes lens creation easier). 80 | 81 | # 0.4.4.3 82 | 83 | * Fixed markup in the .cabal file. 84 | * Added descriptions of other packages to `Lens.Micro`. 85 | 86 | # 0.4.4.2 87 | 88 | * More changes to make microlens-platform more prominent. 89 | 90 | # 0.4.4.1 91 | 92 | * Pointed to microlens-platform in the synopsis. 93 | 94 | # 0.4.4.0 95 | 96 | * Added `mapAccumLOf`. 97 | 98 | # 0.4.3.0 99 | 100 | * Added `?~`. 101 | 102 | # 0.4.2.1 103 | 104 | * Added forgotten copyright/authorship information. 105 | 106 | # 0.4.2.0 107 | 108 | * Added `singular`. 109 | 110 | # 0.4.1.0 111 | 112 | * Added `strict` and `lazy`. 113 | 114 | # 0.4.0.1 115 | 116 | * Fixed a bug that wasn't letting the package compile with GHC 8.0 (see issue #63). 117 | 118 | # 0.4.0.0 119 | 120 | * Added `folding`. 121 | * Renamed `Getter` and `Fold` to `SimpleGetter` and `SimpleFold` and put them into `Lens.Micro`. Genuine `Getter` and `Fold` are available in microlens-contra. 122 | * Replaced `Applicative (Const r)` constraints with `Monoid r` because it's the same thing but easier to understand. 123 | 124 | # 0.3.5.1 125 | 126 | * Backported the fix for the bug that wasn't letting the package compile with GHC 8.0 (see issue #63). 127 | 128 | # 0.3.5.0 129 | 130 | * Added `Lens.Micro.Extras` with `view`, `preview`, `Getter`, and `Fold`. Now you no longer need microlens-mtl if the only thing you need from it is `view`. 131 | 132 | # 0.3.4.1 133 | 134 | * Changed the description of the package from “A tiny part of the lens library which you can depend upon” to “A tiny part of the lens library with no dependencies” because the previous one was ambiguous (I admit I kinda liked that ambiguity, though). 135 | 136 | # 0.3.4.0 137 | 138 | * Added `non`. 139 | 140 | # 0.3.3.0 141 | 142 | * Added `filtered`. 143 | * Added Safe Haskell pragmas. 144 | 145 | # 0.3.2.0 146 | 147 | * Added `toListOf` back. 148 | * Added `to`. 149 | 150 | # 0.3.1.0 151 | 152 | * Added `LensLike` and `LensLike'`. 153 | * Added `failing`. 154 | 155 | # 0.3.0.0 156 | 157 | * Moved `Lens.Micro.Classes` into `Lens.Micro.Internal`. 158 | * Added `<%~`, `<<%~`, `<<.~`. 159 | * Added `_head`, `_tail`, `_init`, `_last`. 160 | 161 | # 0.2.0.0 162 | 163 | * Removed `toListOf`. 164 | * Removed `+~`, `-~`, `*~`, `//~` and the `Lens.Micro.Extras` module. 165 | 166 | # 0.1.5.0 167 | 168 | * Added `ix` and `at`. 169 | * Added `traversed`. 170 | * Moved some things into `Lens.Micro.Internal`. 171 | * Bumped base version. 172 | 173 | # 0.1.3.0 174 | 175 | * Moved some things into `Lens.Micro.Type` and `Lens.Micro.Classes`. 176 | * `Each` and `Field*` aren't exported by `Lens.Micro` now. 177 | 178 | # 0.1.2.0 179 | 180 | * Added `each`. 181 | 182 | # 0.1.1.0 183 | 184 | * Added `ASetter'`, which is useful because we can't provide real `Setter` and `Setter'`. 185 | 186 | # 0.1.0.0 187 | 188 | First release. 189 | -------------------------------------------------------------------------------- /microlens/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2016 Edward Kmett, 2 | 2015-2016 Artyom Kazak, 3 | 2018 Monadfix 4 | 5 | All rights reserved. 6 | 7 | Redistribution and use in source and binary forms, with or without 8 | modification, are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright 11 | notice, this list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above 14 | copyright notice, this list of conditions and the following 15 | disclaimer in the documentation and/or other materials provided 16 | with the distribution. 17 | 18 | * Neither the name of Monadfix nor the names of other 19 | contributors may be used to endorse or promote products derived 20 | from this software without specific prior written permission. 21 | 22 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 25 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 26 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 27 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 28 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 29 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 30 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 31 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 32 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 | -------------------------------------------------------------------------------- /microlens/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /microlens/microlens.cabal: -------------------------------------------------------------------------------- 1 | name: microlens 2 | version: 0.4.14.0 3 | synopsis: A tiny lens library with no dependencies 4 | description: 5 | NOTE: If you're writing an app, you probably want – it has the most features. is intended more for library writers who want a tiny lens library (after all, lenses are pretty useful for everything, not just for updating records!). 6 | . 7 | This library is an extract from (with no dependencies). It's not a toy lenses library, unsuitable for “real world”, but merely a small one. It is compatible with lens, and should have same performance. It also has better documentation. 8 | . 9 | There's a longer readme . It has a migration guide for lens users, a description of other packages in the family, a discussion of other lens libraries you could use instead, and so on. 10 | . 11 | Here are some usecases for this library: 12 | . 13 | * You want to define lenses or traversals in your own library, but don't want to depend on lens. Having lenses available often make working with a library more pleasant. 14 | . 15 | * You just want to be able to use lenses to transform data (or even just use @over _1@ to change the first element of a tuple). 16 | . 17 | * You are new to lenses and want a small library to play with. 18 | . 19 | However, don't use this library if: 20 | . 21 | * You need @Iso@s, @Prism@s, indexed traversals, or actually anything else which isn't defined here (though some indexed functions are available elsewhere – containers and vector provide them for their types, and provides indexed functions for lists). 22 | . 23 | * You want a library with a clean, understandable implementation (in which case you're looking for ). 24 | . 25 | As already mentioned, if you're writing an application which uses lenses more extensively, look at – it combines features of most other microlens packages (, , ). 26 | . 27 | If you want to export getters or folds and don't mind the dependency, please consider using . 28 | . 29 | If you haven't ever used lenses before, read . (It's for lens, but it applies to microlens just as well.) 30 | . 31 | Note that microlens has no dependencies starting from GHC 7.10 (base-4.8). Prior to that, it depends on transformers-0.2 or above. 32 | license: BSD3 33 | license-file: LICENSE 34 | author: Edward Kmett, Artyom Kazak 35 | maintainer: Steven Fontanella 36 | homepage: http://github.com/stevenfontanella/microlens 37 | bug-reports: http://github.com/stevenfontanella/microlens/issues 38 | -- copyright: 39 | category: Data, Lenses 40 | build-type: Simple 41 | extra-source-files: 42 | CHANGELOG.md 43 | cabal-version: >=1.10 44 | tested-with: 45 | GHC==9.12.1 46 | GHC==9.10.1 47 | GHC==9.8.4 48 | GHC==9.6.6 49 | GHC==9.4.8 50 | GHC==9.2.8 51 | GHC==9.0.2 52 | GHC==8.10.7 53 | GHC==8.8.4 54 | GHC==8.6.5 55 | GHC==8.4.4 56 | GHC==8.2.2 57 | GHC==8.0.2 58 | 59 | source-repository head 60 | type: git 61 | location: https://github.com/stevenfontanella/microlens.git 62 | 63 | library 64 | exposed-modules: Lens.Micro 65 | Lens.Micro.Extras 66 | Lens.Micro.Internal 67 | Lens.Micro.Type 68 | -- other-modules: 69 | -- other-extensions: 70 | 71 | -- Since base-4.8 we get the Identity functor in base, so we can avoid a 72 | -- transformers dependency. 73 | if impl(ghc>=7.9) 74 | build-depends: base >=4.8 && <5 75 | if !impl(ghc>=7.9) 76 | build-depends: base >=4.5 && <5 77 | , transformers >=0.2 78 | 79 | ghc-options: 80 | -Wall -fwarn-tabs 81 | -O2 -fdicts-cheap -funbox-strict-fields 82 | -fmax-simplifier-iterations=10 83 | 84 | hs-source-dirs: src 85 | default-language: Haskell2010 86 | default-extensions: TypeOperators 87 | -------------------------------------------------------------------------------- /microlens/src/Lens/Micro/Extras.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Trustworthy #-} 2 | 3 | 4 | {- | 5 | Module : Lens.Micro.Extras 6 | Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 7 | License : BSD-style (see the file LICENSE) 8 | -} 9 | module Lens.Micro.Extras 10 | ( 11 | view, 12 | preview, 13 | ) 14 | where 15 | 16 | 17 | import Lens.Micro 18 | import Lens.Micro.Internal 19 | 20 | import Control.Applicative 21 | import Data.Monoid 22 | 23 | 24 | {- | 25 | 'view' is a synonym for ('^.'): 26 | 27 | >>> view _1 (1, 2) 28 | 1 29 | 30 | The reason it's not in "Lens.Micro" is that @view@ in lens has a more general signature: 31 | 32 | @ 33 | view :: MonadReader s m => Getting a s a -> m a 34 | @ 35 | 36 | So, you would be able to use this 'view' with functions, but not in various reader monads. For most people this shouldn't be an issue; if it is for you, use @view@ from . 37 | -} 38 | view :: Getting a s a -> s -> a 39 | view l = getConst #. l Const 40 | {-# INLINE view #-} 41 | 42 | {- | 43 | 'preview' is a synonym for ('^?'): 44 | 45 | >>> preview _head [1,2,3] 46 | Just 1 47 | 48 | The reason it's not in "Lens.Micro" is that @preview@ in lens has a more general signature: 49 | 50 | @ 51 | preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a) 52 | @ 53 | 54 | Just like with 'view', you would be able to use this 'preview' with functions, but not in reader monads; if this is an issue for you, use @preview@ from . 55 | -} 56 | preview :: Getting (First a) s a -> s -> Maybe a 57 | preview l = getFirst #. foldMapOf l (First #. Just) 58 | {-# INLINE preview #-} 59 | -------------------------------------------------------------------------------- /microlens/src/Lens/Micro/Type.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | 6 | {- | 7 | Module : Lens.Micro.Type 8 | Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 9 | License : BSD-style (see the file LICENSE) 10 | 11 | This module provides just the types ('Lens', 'Traversal', etc). It's needed to break the dependency cycle – "Lens.Micro" depends on "Lens.Micro.Internal", but "Lens.Micro.Internal" needs types like 'Lens', so 'Lens' can't be defined in "Lens.Micro". 12 | -} 13 | module Lens.Micro.Type 14 | ( 15 | ASetter, ASetter', 16 | SimpleGetter, Getting, 17 | SimpleFold, 18 | Lens, Lens', 19 | Traversal, Traversal', 20 | LensLike, LensLike', 21 | ) 22 | where 23 | 24 | 25 | import Control.Applicative 26 | import Data.Functor.Identity 27 | 28 | #if __GLASGOW_HASKELL__ < 710 29 | import Data.Monoid 30 | #endif 31 | 32 | 33 | {- | 34 | @ASetter s t a b@ is something that turns a function modifying a value into a function modifying a /structure/. If you ignore 'Identity' (as @Identity a@ is the same thing as @a@), the type is: 35 | 36 | @ 37 | type ASetter s t a b = (a -> b) -> s -> t 38 | @ 39 | 40 | The reason 'Identity' is used here is for 'ASetter' to be composable with other types, such as 'Lens'. 41 | 42 | Technically, if you're writing a library, you shouldn't use this type for setters you are exporting from your library; the right type to use is @@, but it is not provided by this package (because then it'd have to depend on ). It's completely alright, however, to export functions which take an 'ASetter' as an argument. 43 | -} 44 | type ASetter s t a b = (a -> Identity b) -> s -> Identity t 45 | 46 | {- | 47 | This is a type alias for monomorphic setters which don't change the type of the container (or of the value inside). It's useful more often than the same type in lens, because we can't provide real setters and so it does the job of both @@ and @@. 48 | -} 49 | type ASetter' s a = ASetter s s a a 50 | 51 | {- | 52 | A @SimpleGetter s a@ extracts @a@ from @s@; so, it's the same thing as @(s -> a)@, but you can use it in lens chains because its type looks like this: 53 | 54 | @ 55 | type SimpleGetter s a = 56 | forall r. (a -> Const r a) -> s -> Const r s 57 | @ 58 | 59 | Since @Const r@ is a functor, 'SimpleGetter' has the same shape as other lens types and can be composed with them. To get @(s -> a)@ out of a 'SimpleGetter', choose @r ~ a@ and feed @Const :: a -> Const a a@ to the getter: 60 | 61 | @ 62 | -- the actual signature is more permissive: 63 | -- 'Lens.Micro.Extras.view' :: 'Getting' a s a -> s -> a 64 | 'Lens.Micro.Extras.view' :: 'SimpleGetter' s a -> s -> a 65 | 'Lens.Micro.Extras.view' getter = 'getConst' . getter 'Const' 66 | @ 67 | 68 | The actual @@ from lens is more general: 69 | 70 | @ 71 | type Getter s a = 72 | forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s 73 | @ 74 | 75 | I'm not currently aware of any functions that take lens's @Getter@ but won't accept 'SimpleGetter', but you should try to avoid exporting 'SimpleGetter's anyway to minimise confusion. Alternatively, look at , which provides a fully lens-compatible @Getter@. 76 | 77 | Lens users: you can convert a 'SimpleGetter' to @Getter@ by applying @to . view@ to it. 78 | -} 79 | type SimpleGetter s a = forall r. Getting r s a 80 | 81 | {- | 82 | Functions that operate on getters and folds – such as ('Lens.Micro.^.'), ('Lens.Micro.^..'), ('Lens.Micro.^?') – use @Getter r s a@ (with different values of @r@) to describe what kind of result they need. For instance, ('Lens.Micro.^.') needs the getter to be able to return a single value, and so it accepts a getter of type @Getting a s a@. ('Lens.Micro.^..') wants the getter to gather values together, so it uses @Getting (Endo [a]) s a@ (it could've used @Getting [a] s a@ instead, but it's faster with 'Data.Monoid.Endo'). The choice of @r@ depends on what you want to do with elements you're extracting from @s@. 83 | -} 84 | type Getting r s a = (a -> Const r a) -> s -> Const r s 85 | 86 | {- | 87 | A @SimpleFold s a@ extracts several @a@s from @s@; so, it's pretty much the same thing as @(s -> [a])@, but you can use it with lens operators. 88 | 89 | The actual @Fold@ from lens is more general: 90 | 91 | @ 92 | type Fold s a = 93 | forall f. (Contravariant f, Applicative f) => (a -> f a) -> s -> f s 94 | @ 95 | 96 | There are several functions in lens that accept lens's @Fold@ but won't accept 'SimpleFold'; I'm aware of 97 | @@, 98 | @@, 99 | @@, 100 | @@, 101 | @@. 102 | For this reason, try not to export 'SimpleFold's if at all possible. provides a fully lens-compatible @Fold@. 103 | 104 | Lens users: you can convert a 'SimpleFold' to @Fold@ by applying @folded . toListOf@ to it. 105 | -} 106 | type SimpleFold s a = forall r. Monoid r => Getting r s a 107 | 108 | {- | 109 | @Lens s t a b@ is the lowest common denominator of a setter and a getter, something that has the power of both; it has a 'Functor' constraint, and since both 'Const' and 'Identity' are functors, it can be used whenever a getter or a setter is needed. 110 | 111 | * @a@ is the type of the value inside of structure 112 | * @b@ is the type of the replaced value 113 | * @s@ is the type of the whole structure 114 | * @t@ is the type of the structure after replacing @a@ in it with @b@ 115 | -} 116 | type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t 117 | 118 | {- | 119 | This is a type alias for monomorphic lenses which don't change the type of the container (or of the value inside). 120 | -} 121 | type Lens' s a = Lens s s a a 122 | 123 | {- | 124 | @Traversal s t a b@ is a generalisation of 'Lens' which allows many targets (possibly 0). It's achieved by changing the constraint to 'Applicative' instead of 'Functor' – indeed, the point of 'Applicative' is that you can combine effects, which is just what we need to have many targets. 125 | 126 | Ultimately, traversals should follow 2 laws: 127 | 128 | @ 129 | t pure ≡ pure 130 | fmap (t f) . t g ≡ getCompose . t (Compose . fmap f . g) 131 | @ 132 | 133 | The 1st law states that you can't change the shape of the structure or do anything funny with elements (traverse elements which aren't in the structure, create new elements out of thin air, etc.). The 2nd law states that you should be able to fuse 2 identical traversals into one. For a more detailed explanation of the laws, see (if you prefer rambling blog posts), or (if you prefer papers). 134 | 135 | Traversing any value twice is a violation of traversal laws. You can, however, traverse values in any order. 136 | -} 137 | type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t 138 | 139 | {- | 140 | This is a type alias for monomorphic traversals which don't change the type of the container (or of the values inside). 141 | -} 142 | type Traversal' s a = Traversal s s a a 143 | 144 | {- | 145 | 'LensLike' is a type that is often used to make combinators as general as possible. For instance, take ('Lens.Micro.<<%~'), which only requires the passed lens to be able to work with the @(,) a@ functor (lenses and traversals can do that). The fully expanded type is as follows: 146 | 147 | @ 148 | ('Lens.Micro.<<%~') :: ((a -> (a, b)) -> s -> (a, t)) -> (a -> b) -> s -> (a, t) 149 | @ 150 | 151 | With 'LensLike', the intent to use the @(,) a@ functor can be made a bit clearer: 152 | 153 | @ 154 | ('Lens.Micro.<<%~') :: LensLike ((,) a) s t a b -> (a -> b) -> s -> (a, t) 155 | @ 156 | -} 157 | type LensLike f s t a b = (a -> f b) -> s -> f t 158 | 159 | {- | 160 | A type alias for monomorphic 'LensLike's. 161 | -} 162 | type LensLike' f s a = LensLike f s s a a 163 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-20.3 2 | 3 | packages: 4 | - microlens 5 | - microlens-contra 6 | - microlens-ghc 7 | - microlens-mtl 8 | - microlens-th 9 | - microlens-platform 10 | 11 | compiler: ghc-9.2.5 12 | --------------------------------------------------------------------------------