├── boring ├── cabal.project ├── ChangeLog.md ├── LICENSE ├── boring.cabal └── src │ └── Data │ └── Boring.hs ├── .gitignore ├── cabal.project ├── cabal.haskell-ci ├── README.md ├── .stylish-haskell.yaml ├── CONTRIBUTING.md ├── boring-instances ├── src │ └── Data │ │ └── Boring │ │ └── Instances.hs ├── LICENSE └── boring-instances.cabal └── .github └── workflows └── haskell-ci.yml /boring/cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | dist-newstyle/ 3 | .ghc.environment.* 4 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: boring 2 | -- packages: boring-instances 3 | 4 | package boring 5 | ghc-options: -Wall 6 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | docspec: True 3 | jobs-selection: any 4 | 5 | constraint-set no-tagged 6 | constraints: boring -tagged 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # boring 2 | 3 | `Boring` and `Absurd` types. 4 | 5 | `Boring` types are isomorphic to `()`. 6 | `Absurd` types are isomorphic to `Void`. 7 | 8 | See [What does `()` mean in Haskell -answer by Conor McBride](https://stackoverflow.com/questions/33112439/what-does-mean-in-haskell/33115522#33115522) 9 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | steps: 2 | - imports: 3 | align: group 4 | list_align: after_alias 5 | long_list_align: new_line 6 | empty_list_align: right_after 7 | list_padding: module_name 8 | - language_pragmas: 9 | style: vertical 10 | remove_redundant: true 11 | - trailing_whitespace: {} 12 | columns: 80 13 | language_extensions: 14 | - DataKinds 15 | - EmptyCase 16 | - ExplicitForAll 17 | - FlexibleContexts 18 | - MultiParamTypeClasses 19 | -------------------------------------------------------------------------------- /boring/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for boring 2 | 3 | ## 0.2.2 4 | 5 | - Support GHC-8.6.5...9.10.1 6 | 7 | ## 0.2.1 8 | 9 | - Add instances for `SNat`, `SSymbol`, and `SChar` 10 | (singletons introduced in `base-4.18.0.0`) 11 | 12 | ## 0.2 13 | 14 | - Make `boring` package dependency light. 15 | `fin`, `bin`, `ral`, `vec`, `dec`, `singleton-bool` instances 16 | are migrated to corresponding packages. 17 | Rest are migrated to `boring-instances` for now. 18 | - Data.Boring is `Trustworthy` 19 | - Add Generic derivation. Thanks to David Feuer. 20 | 21 | ## 0.1.3 22 | 23 | - Allow `vec-0.3` 24 | - Add instances for `ral` and `bin` types. 25 | 26 | ## 0.1.2 27 | 28 | - Add instances for 'Boring' instances for 'SBool', 'SNat' and 'LE'. 29 | - Add 'Boring (Dec a)', 'boringYes' and 'boringNo'. 30 | 31 | ## 0.1.1 32 | 33 | - Add `GHC.Generics` instances 34 | - Add `:~~:` and `Coercion` instances 35 | 36 | ## 0.1 37 | 38 | - `streams`, `constraints`, `generics-sop` instances. 39 | - Reversed dependency with `vec`, add `fin` instances. 40 | 41 | ## 0 42 | 43 | - First version. Released on an unsuspecting world. 44 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | Patches welcome! 2 | 3 | - If you are only going to bump bounds: 4 | - If it's really **only bounds**, please simply open an issue (so you'll have a URL to refer to). I have a semi-automated process to make revisions, pull requests only disturb it. 5 | - If patch includes **source code change** (i.e. I'll need to make a release), and it's a patch to support **newer base/GHC version**: 6 | - Amend `tested-with` to include that GHC 7 | - Regenerate `.github/workflows/haskell-ci.yml` with `haskell-ci regenerate` (get the latest from [GitHub haskell-ci/haskell-ci](https://github.com/haskell-ci/haskell-ci)) 8 | 9 | - Don't edit `CHANGELOG.md`, rather include a copyable entry in your pull request description. I often process pull requests in bulk, and everyone editing the `CHANGELOG.md` causes unnecessary conflicts. 10 | - For the same reason, do not edit `version` or `x-revision` 11 | 12 | - I use [`stylish-haskell`](https://github.com/jaspervdj/stylish-haskell) to format imports. I encourage you to use it too, when contributing. 13 | - General code style is 4 spaces, just look around how it looks, it's not so strict. 14 | -------------------------------------------------------------------------------- /boring-instances/src/Data/Boring/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds #-} 2 | {-# LANGUAGE Trustworthy #-} 3 | {-# LANGUAGE UndecidableInstances #-} 4 | module Data.Boring.Instances () where 5 | 6 | import Data.Boring (Absurd (..), Boring (..)) 7 | -- import Data.Constraint (Dict (..)) 8 | -- import Data.Stream.Infinite (Stream (..)) 9 | 10 | import qualified Generics.SOP as SOP 11 | 12 | ------------------------------------------------------------------------------- 13 | -- generics-sop 14 | ------------------------------------------------------------------------------- 15 | 16 | instance Boring a => Boring (SOP.I a) where 17 | boring = SOP.I boring 18 | 19 | instance Boring b => Boring (SOP.K b a) where 20 | boring = SOP.K boring 21 | 22 | instance Absurd a => Absurd (SOP.I a) where 23 | absurd = absurd . SOP.unI 24 | 25 | instance Absurd b => Absurd (SOP.K b a) where 26 | absurd = absurd . SOP.unK 27 | 28 | ------------------------------------------------------------------------------- 29 | -- representable 30 | ------------------------------------------------------------------------------- 31 | 32 | {- 33 | -- | If an index of 'Representable' @f@ is 'Absurd', @f a@ is 'Boring'. 34 | boringRep :: (Representable f, Absurd (Rep f)) => f a 35 | boringRep = tabulate absurd 36 | 37 | -- | If an index of 'Representable' @f@ is 'Boring', @f@ is isomorphic to 'Identity'. 38 | -- 39 | -- See also @Settable@ class in @lens@. 40 | untainted :: (Representable f, Boring (Rep f)) => f a -> a 41 | untainted = flip index boring 42 | -} 43 | -------------------------------------------------------------------------------- /boring/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Oleg Grenrus 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Oleg Grenrus nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /boring-instances/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Oleg Grenrus 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Oleg Grenrus nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /boring-instances/boring-instances.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: boring-instances 3 | version: 0.2 4 | synopsis: Boring and Absurd types: instances 5 | description: 6 | * @Boring@ types are isomorphic to @()@. 7 | . 8 | * @Absurd@ types are isomorphic to @Void@. 9 | . 10 | See [What does () mean in Haskell -answer by Conor McBride](https://stackoverflow.com/questions/33112439/what-does-mean-in-haskell/33115522#33115522) 11 | . 12 | This package contains instances which were previously in @boring@ package itself, 13 | and yet haven't migrated to non-orphan place. 14 | 15 | homepage: https://github.com/phadej/boring 16 | bug-reports: https://github.com/phadej/boring/issues 17 | license: BSD3 18 | license-file: LICENSE 19 | author: Oleg Grenrus 20 | maintainer: Oleg.Grenrus 21 | copyright: (c) 2017-2021 Oleg Grenrus 22 | category: Data 23 | build-type: Simple 24 | tested-with: 25 | GHC ==7.8.4 26 | || ==7.10.3 27 | || ==8.0.2 28 | || ==8.2.2 29 | || ==8.4.4 30 | || ==8.6.5 31 | || ==8.8.4 32 | || ==8.10.4 33 | || ==9.0.1 34 | 35 | source-repository head 36 | type: git 37 | location: https://github.com/phadej/boring.git 38 | subdir: boring-instances 39 | 40 | library 41 | exposed-modules: Data.Boring.Instances 42 | 43 | -- boot libraries 44 | build-depends: base >=4.7 && <4.18 45 | 46 | -- orphans 47 | build-depends: 48 | boring >=0.2 && <0.2.1 49 | , generics-sop >=0.3.2.0 && <0.5.2 50 | 51 | hs-source-dirs: src 52 | default-language: Haskell2010 53 | -------------------------------------------------------------------------------- /boring/boring.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: boring 3 | version: 0.2.2 4 | x-revision: 1 5 | synopsis: Boring and Absurd types 6 | description: 7 | * @Boring@ types are isomorphic to @()@. 8 | . 9 | * @Absurd@ types are isomorphic to @Void@. 10 | . 11 | See [What does () mean in Haskell -answer by Conor McBride](https://stackoverflow.com/questions/33112439/what-does-mean-in-haskell/33115522#33115522) 12 | 13 | homepage: https://github.com/phadej/boring 14 | bug-reports: https://github.com/phadej/boring/issues 15 | license: BSD-3-Clause 16 | license-file: LICENSE 17 | author: Oleg Grenrus 18 | maintainer: Oleg.Grenrus 19 | copyright: (c) 2017-2021 Oleg Grenrus 20 | category: Data 21 | build-type: Simple 22 | extra-source-files: ChangeLog.md 23 | tested-with: 24 | GHC ==8.6.5 25 | || ==8.8.4 26 | || ==8.10.7 27 | || ==9.0.2 28 | || ==9.2.8 29 | || ==9.4.8 30 | || ==9.6.6 31 | || ==9.8.4 32 | || ==9.10.1 33 | || ==9.12.1 34 | 35 | source-repository head 36 | type: git 37 | location: https://github.com/phadej/boring.git 38 | subdir: boring 39 | 40 | flag tagged 41 | description: 42 | You can disable the use of the `tagged` package using `-f-tagged`. 43 | . 44 | Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. 45 | 46 | default: True 47 | manual: True 48 | 49 | library 50 | exposed-modules: Data.Boring 51 | build-depends: 52 | base >=4.12.0.0 && <4.22 53 | , transformers >=0.5.6.2 && <0.7 54 | 55 | if impl(ghc <7.6) 56 | build-depends: ghc-prim 57 | 58 | if flag(tagged) 59 | build-depends: tagged >=0.8.6 && <0.9 60 | 61 | other-extensions: 62 | CPP 63 | DefaultSignatures 64 | FlexibleContexts 65 | GADTs 66 | Trustworthy 67 | TypeOperators 68 | 69 | hs-source-dirs: src 70 | default-language: Haskell2010 71 | -------------------------------------------------------------------------------- /.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.20241223 12 | # 13 | # REGENDATA ("0.19.20241223",["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.1 36 | compilerKind: ghc 37 | compilerVersion: 9.12.1 38 | setup-method: ghcup 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 | fail-fast: false 86 | steps: 87 | - name: apt-get install 88 | run: | 89 | apt-get update 90 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 91 | - name: Install GHCup 92 | run: | 93 | mkdir -p "$HOME/.ghcup/bin" 94 | curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" 95 | chmod a+x "$HOME/.ghcup/bin/ghcup" 96 | - name: Install cabal-install 97 | run: | 98 | "$HOME/.ghcup/bin/ghcup" install cabal 3.14.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 99 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 100 | - name: Install GHC (GHCup) 101 | if: matrix.setup-method == 'ghcup' 102 | run: | 103 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 104 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 105 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 106 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 107 | echo "HC=$HC" >> "$GITHUB_ENV" 108 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 109 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 110 | env: 111 | HCKIND: ${{ matrix.compilerKind }} 112 | HCNAME: ${{ matrix.compiler }} 113 | HCVER: ${{ matrix.compilerVersion }} 114 | - name: Set PATH and environment variables 115 | run: | 116 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 117 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 118 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 119 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 120 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 121 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 122 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 123 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 124 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 125 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 126 | env: 127 | HCKIND: ${{ matrix.compilerKind }} 128 | HCNAME: ${{ matrix.compiler }} 129 | HCVER: ${{ matrix.compilerVersion }} 130 | - name: env 131 | run: | 132 | env 133 | - name: write cabal config 134 | run: | 135 | mkdir -p $CABAL_DIR 136 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 169 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 170 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 171 | rm -f cabal-plan.xz 172 | chmod a+x $HOME/.cabal/bin/cabal-plan 173 | cabal-plan --version 174 | - name: install cabal-docspec 175 | run: | 176 | mkdir -p $HOME/.cabal/bin 177 | curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20240703/cabal-docspec-0.0.0.20240703-x86_64-linux.xz > cabal-docspec.xz 178 | echo '48bf3b7fd2f7f0caa6162afee57a755be8523e7f467b694900eb420f5f9a7b76 cabal-docspec.xz' | sha256sum -c - 179 | xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec 180 | rm -f cabal-docspec.xz 181 | chmod a+x $HOME/.cabal/bin/cabal-docspec 182 | cabal-docspec --version 183 | - name: checkout 184 | uses: actions/checkout@v4 185 | with: 186 | path: source 187 | - name: initial cabal.project for sdist 188 | run: | 189 | touch cabal.project 190 | echo "packages: $GITHUB_WORKSPACE/source/boring" >> cabal.project 191 | cat cabal.project 192 | - name: sdist 193 | run: | 194 | mkdir -p sdist 195 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 196 | - name: unpack 197 | run: | 198 | mkdir -p unpacked 199 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 200 | - name: generate cabal.project 201 | run: | 202 | PKGDIR_boring="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/boring-[0-9.]*')" 203 | echo "PKGDIR_boring=${PKGDIR_boring}" >> "$GITHUB_ENV" 204 | rm -f cabal.project cabal.project.local 205 | touch cabal.project 206 | touch cabal.project.local 207 | echo "packages: ${PKGDIR_boring}" >> cabal.project 208 | echo "package boring" >> cabal.project 209 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 210 | cat >> cabal.project <> cabal.project.local 213 | cat cabal.project 214 | cat cabal.project.local 215 | - name: dump install plan 216 | run: | 217 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 218 | cabal-plan 219 | - name: restore cache 220 | uses: actions/cache/restore@v4 221 | with: 222 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 223 | path: ~/.cabal/store 224 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 225 | - name: install dependencies 226 | run: | 227 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 228 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 229 | - name: build w/o tests 230 | run: | 231 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 232 | - name: build 233 | run: | 234 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 235 | - name: docspec 236 | run: | 237 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all 238 | cabal-docspec $ARG_COMPILER 239 | - name: cabal check 240 | run: | 241 | cd ${PKGDIR_boring} || false 242 | ${CABAL} -vnormal check 243 | - name: haddock 244 | run: | 245 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 246 | - name: unconstrained build 247 | run: | 248 | rm -f cabal.project.local 249 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 250 | - name: prepare for constraint sets 251 | run: | 252 | rm -f cabal.project.local 253 | - name: constraint set no-tagged 254 | run: | 255 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='boring -tagged' all --dry-run 256 | cabal-plan topo | sort 257 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='boring -tagged' --dependencies-only -j2 all 258 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='boring -tagged' all 259 | - name: save cache 260 | if: always() 261 | uses: actions/cache/save@v4 262 | with: 263 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 264 | path: ~/.cabal/store 265 | -------------------------------------------------------------------------------- /boring/src/Data/Boring.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DefaultSignatures #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE Trustworthy #-} 6 | {-# LANGUAGE TypeOperators #-} 7 | {-# LANGUAGE EmptyCase #-} 8 | -- | 'Boring' and 'Absurd' classes. One approach. 9 | -- 10 | -- Different approach would be to have 11 | -- 12 | -- @ 13 | -- -- none-one-tons semiring 14 | -- data NOT = None | One | Tons 15 | -- 16 | -- type family Cardinality (a :: *) :: NOT 17 | -- 18 | -- class Cardinality a ~ None => Absurd a where ... 19 | -- class Cardinality a ~ One => Boring a where ... 20 | -- @ 21 | -- 22 | -- This would make possible to define more instances, e.g. 23 | -- 24 | -- @ 25 | -- instance (Mult (Cardinality a) (Cardinality b) ~ None) => Absurd (a, b) where ... 26 | -- @ 27 | -- 28 | -- === Functions 29 | -- 30 | -- Function is an exponential: 31 | -- 32 | -- @ 33 | -- Cardinality (a -> b) ~ Exponent (Cardinality b) (Cardinality a) 34 | -- @ 35 | -- 36 | -- or shortly @|a -> b| = |b| ^ |a|@. This gives us possible instances: 37 | -- 38 | -- * @|a| = 0 => |a -> b| = m ^ 0 = 1@, i.e. @'Absurd' a => 'Boring' (a -> b)@, or 39 | -- 40 | -- * @|b| = 1 => |a -> b| = 1 ^ n = 1@, i.e. @'Boring' b => 'Boring' (a -> b)@. 41 | -- 42 | -- Both instances are 'Boring', but we chose to define the latter. 43 | -- 44 | -- === Note about adding instances 45 | -- 46 | -- At this moment this module misses a lot of instances, 47 | -- please make a patch to add more. Especially, if the package is already 48 | -- in the transitive dependency closure. 49 | -- 50 | -- E.g. any possibly empty container @f@ has @'Absurd' a => 'Boring' (f a)@ 51 | -- 52 | module Data.Boring ( 53 | -- * Classes 54 | Boring (..), 55 | Absurd (..), 56 | -- ** Generic implementation 57 | GBoring, 58 | GAbsurd, 59 | -- * More interesting stuff 60 | vacuous, 61 | devoid, 62 | united, 63 | ) where 64 | 65 | import Prelude (Either (..), Functor (..), Maybe (..), const, (.)) 66 | 67 | import Control.Applicative (Const (..), (<$)) 68 | import Data.Functor.Compose (Compose (..)) 69 | import Data.Functor.Identity (Identity (..)) 70 | import Data.Functor.Product (Product (..)) 71 | import Data.Functor.Sum (Sum (..)) 72 | import Data.List.NonEmpty (NonEmpty (..)) 73 | import Data.Proxy (Proxy (..)) 74 | import GHC.Generics 75 | (Generic (..), K1 (..), M1 (..), Par1 (..), Rec1 (..), U1 (..), V1, 76 | (:*:) (..), (:+:) (..), (:.:) (..)) 77 | 78 | import qualified Data.Void as V 79 | 80 | import qualified Data.Coerce as Co 81 | import qualified Data.Type.Coercion as Co 82 | 83 | import qualified Data.Type.Equality as Eq 84 | 85 | import qualified Type.Reflection as Typeable 86 | 87 | #if MIN_VERSION_base(4,18,0) 88 | import qualified GHC.TypeLits as TypeLits 89 | import qualified GHC.TypeNats as TypeNats 90 | #endif 91 | 92 | #ifdef MIN_VERSION_tagged 93 | import Data.Tagged (Tagged (..)) 94 | #endif 95 | 96 | -- $setup 97 | -- >>> :set -XDeriveGeneric 98 | -- >>> import GHC.Generics (Generic) 99 | 100 | ------------------------------------------------------------------------------- 101 | -- Boring 102 | ------------------------------------------------------------------------------- 103 | 104 | -- | 'Boring' types which contains one thing, also 105 | -- 'boring'. There is nothing interesting to be gained by 106 | -- comparing one element of the boring type with another, 107 | -- because there is nothing to learn about an element of the 108 | -- boring type by giving it any of your attention. 109 | -- 110 | -- /Boring Law:/ 111 | -- 112 | -- @ 113 | -- 'boring' == x 114 | -- @ 115 | -- 116 | -- /Note:/ This is different class from @Default@. 117 | -- @Default@ gives you /some/ value, 118 | -- @Boring@ gives you an unique value. 119 | -- 120 | -- Also note, that we cannot have instances for e.g. 121 | -- 'Either', as both 122 | -- @('Boring' a, 'Absurd' b) => Either a b@ and 123 | -- @('Absurd' a, 'Boring' b) => Either a b@ would be valid instances. 124 | -- 125 | -- Another useful trick, is that you can rewrite computations with 126 | -- 'Boring' results, for example @foo :: Int -> ()@, __if__ you are sure 127 | -- that @foo@ is __total__. 128 | -- 129 | -- > {-# RULES "less expensive" foo = boring #-} 130 | -- 131 | -- That's particularly useful with equality ':~:' proofs. 132 | -- 133 | class Boring a where 134 | boring :: a 135 | default boring :: (Generic a, GBoring (Rep a)) => a 136 | boring = to gboring 137 | 138 | instance Boring () where 139 | boring = () 140 | 141 | instance Boring b => Boring (a -> b) where 142 | boring = const boring 143 | 144 | instance Boring (Proxy a) where 145 | boring = Proxy 146 | 147 | instance Boring a => Boring (Const a b) where 148 | boring = Const boring 149 | 150 | #ifdef MIN_VERSION_tagged 151 | instance Boring b => Boring (Tagged a b) where 152 | boring = Tagged boring 153 | #endif 154 | 155 | instance Boring a => Boring (Identity a) where 156 | boring = Identity boring 157 | 158 | instance Boring (f (g a)) => Boring (Compose f g a) where 159 | boring = Compose boring 160 | 161 | instance (Boring (f a), Boring (g a)) => Boring (Product f g a) where 162 | boring = Pair boring boring 163 | 164 | instance (Boring a, Boring b) => Boring (a, b) where 165 | boring = (boring, boring) 166 | 167 | instance (Boring a, Boring b, Boring c) => Boring (a, b, c) where 168 | boring = (boring, boring, boring) 169 | 170 | instance (Boring a, Boring b, Boring c, Boring d) => Boring (a, b, c, d) where 171 | boring = (boring, boring, boring, boring) 172 | 173 | instance (Boring a, Boring b, Boring c, Boring d, Boring e) => Boring (a, b, c, d, e) where 174 | boring = (boring, boring, boring, boring, boring) 175 | 176 | -- | Recall regular expressions, kleene star of empty regexp is epsilon! 177 | instance Absurd a => Boring [a] where 178 | boring = [] 179 | 180 | -- | @'Maybe' a = a + 1@, @0 + 1 = 1@. 181 | instance Absurd a => Boring (Maybe a) where 182 | boring = Nothing 183 | 184 | -- | Coercibility is 'Boring' too. 185 | instance Co.Coercible a b => Boring (Co.Coercion a b) where 186 | boring = Co.Coercion 187 | 188 | -- | Homogeneous type equality is 'Boring' too. 189 | instance a ~ b => Boring (a Eq.:~: b) where 190 | boring = Eq.Refl 191 | 192 | -- | Heterogeneous type equality is 'Boring' too. 193 | instance a Eq.~~ b => Boring (a Eq.:~~: b) where 194 | boring = Eq.HRefl 195 | 196 | instance Typeable.Typeable a => Boring (Typeable.TypeRep a) where 197 | boring = Typeable.typeRep 198 | 199 | #if MIN_VERSION_base(4,18,0) 200 | instance TypeLits.KnownChar n => Boring (TypeLits.SChar n) where 201 | boring = TypeLits.charSing 202 | 203 | instance TypeLits.KnownSymbol n => Boring (TypeLits.SSymbol n) where 204 | boring = TypeLits.symbolSing 205 | 206 | instance TypeNats.KnownNat n => Boring (TypeNats.SNat n) where 207 | boring = TypeNats.natSing 208 | #endif 209 | 210 | ------------------------------------------------------------------------------- 211 | -- Generics 212 | ------------------------------------------------------------------------------- 213 | 214 | instance Boring (U1 p) where 215 | boring = U1 216 | 217 | instance Boring c => Boring (K1 i c p) where 218 | boring = K1 boring 219 | 220 | instance Boring (f p) => Boring (M1 i c f p) where 221 | boring = M1 boring 222 | 223 | instance (Boring (f p), Boring (g p)) => Boring ((f :*: g) p) where 224 | boring = boring :*: boring 225 | 226 | instance Boring p => Boring (Par1 p) where 227 | boring = Par1 boring 228 | 229 | instance Boring (f p) => Boring (Rec1 f p) where 230 | boring = Rec1 boring 231 | 232 | instance Boring (f (g p)) => Boring ((f :.: g) p) where 233 | boring = Comp1 boring 234 | 235 | 236 | ------------------------------------------------------------------------------- 237 | -- Absurd 238 | ------------------------------------------------------------------------------- 239 | 240 | -- | The 'Absurd' type is very exciting, because if somebody ever gives you a 241 | -- value belonging to it, you know that you are already dead and in Heaven and 242 | -- that anything you want is yours. 243 | -- 244 | -- Similarly as there are many 'Boring' sums, there are many 'Absurd' products, 245 | -- so we don't have 'Absurd' instances for tuples. 246 | class Absurd a where 247 | absurd :: a -> b 248 | default absurd :: (Generic a, GAbsurd (Rep a)) => a -> b 249 | absurd = gabsurd . from 250 | 251 | instance Absurd V.Void where 252 | absurd = V.absurd 253 | 254 | instance (Absurd a, Absurd b) => Absurd (Either a b) where 255 | absurd (Left a) = absurd a 256 | absurd (Right b) = absurd b 257 | 258 | instance Absurd a => Absurd (NonEmpty a) where 259 | absurd (x :| _) = absurd x 260 | 261 | instance Absurd a => Absurd (Identity a) where 262 | absurd = absurd . runIdentity 263 | 264 | instance Absurd (f (g a)) => Absurd (Compose f g a) where 265 | absurd = absurd . getCompose 266 | 267 | instance (Absurd (f a), Absurd (g a)) => Absurd (Sum f g a) where 268 | absurd (InL fa) = absurd fa 269 | absurd (InR ga) = absurd ga 270 | 271 | instance Absurd b => Absurd (Const b a) where 272 | absurd = absurd . getConst 273 | 274 | #ifdef MIN_VERSION_tagged 275 | instance Absurd a => Absurd (Tagged b a) where 276 | absurd = absurd . unTagged 277 | #endif 278 | 279 | ------------------------------------------------------------------------------- 280 | -- Generics 281 | ------------------------------------------------------------------------------- 282 | 283 | instance Absurd (V1 p) where 284 | absurd v = case v of {} 285 | 286 | instance Absurd c => Absurd (K1 i c p) where 287 | absurd = absurd . unK1 288 | 289 | instance Absurd (f p) => Absurd (M1 i c f p) where 290 | absurd = absurd . unM1 291 | 292 | instance (Absurd (f p), Absurd (g p)) => Absurd ((f :+: g) p) where 293 | absurd (L1 a) = absurd a 294 | absurd (R1 b) = absurd b 295 | 296 | instance Absurd p => Absurd (Par1 p) where 297 | absurd = absurd . unPar1 298 | 299 | instance Absurd (f p) => Absurd (Rec1 f p) where 300 | absurd = absurd . unRec1 301 | 302 | instance Absurd (f (g p)) => Absurd ((f :.: g) p) where 303 | absurd = absurd . unComp1 304 | 305 | ------------------------------------------------------------------------------- 306 | -- More interesting stuff 307 | ------------------------------------------------------------------------------- 308 | 309 | -- | If 'Absurd' is uninhabited then any 'Functor' that holds only 310 | -- values of type 'Absurd' is holding no values. 311 | vacuous :: (Functor f, Absurd a) => f a -> f b 312 | vacuous = fmap absurd 313 | 314 | -- | There is a field for every type in the 'Absurd'. Very zen. 315 | -- 316 | -- @ 317 | -- 'devoid' :: 'Absurd' s => Over p f s s a b 318 | -- @ 319 | -- type Over p f s t a b = p a (f b) -> s -> f t 320 | devoid :: Absurd s => p a (f b) -> s -> f s 321 | devoid _ = absurd 322 | 323 | -- | We can always retrieve a 'Boring' value from any type. 324 | -- 325 | -- @ 326 | -- 'united' :: 'Boring' a => Lens' s a 327 | -- @ 328 | united :: (Boring a, Functor f) => (a -> f a) -> s -> f s 329 | united f v = v <$ f boring 330 | 331 | ------------------------------------------------------------------------------- 332 | -- default implementatiosn 333 | ------------------------------------------------------------------------------- 334 | 335 | -- | A helper class to implement 'Generic' derivation of 'Boring'. 336 | -- 337 | -- Technically we could do (avoiding @QuantifiedConstraints@): 338 | -- 339 | -- @ 340 | -- type GBoring f = (Boring (f V.Void), Functor f) 341 | -- 342 | -- gboring :: forall f x. GBoring f => f x 343 | -- gboring = vacuous (boring :: f V.Void) 344 | -- @ 345 | -- 346 | -- but separate class is cleaner. 347 | -- 348 | -- >>> data B2 = B2 () () deriving (Show, Generic) 349 | -- >>> instance Boring B2 350 | -- >>> boring :: B2 351 | -- B2 () () 352 | -- 353 | class GBoring f where 354 | gboring :: f a 355 | 356 | instance GBoring U1 where 357 | gboring = U1 358 | 359 | instance GBoring f => GBoring (M1 i c f) where 360 | gboring = M1 gboring 361 | 362 | instance (GBoring f, GBoring g) => GBoring (f :*: g) where 363 | gboring = gboring :*: gboring 364 | 365 | -- There are two valid instances for GBoring (f :+: g), so we don't define 366 | -- either of them. 367 | 368 | instance Boring c => GBoring (K1 i c) where 369 | gboring = K1 boring 370 | 371 | -- | A helper class to implement of 'Generic' derivation of 'Absurd'. 372 | -- 373 | -- @ 374 | -- type GAbsurd f = (Absurd (f ()), Functor f) 375 | -- 376 | -- gabsurd :: forall f x y. GAbsurd f => f x -> y 377 | -- gabsurd = absurd . void 378 | -- @ 379 | -- 380 | class GAbsurd f where 381 | gabsurd :: f a -> b 382 | 383 | instance GAbsurd V1 where 384 | gabsurd x = case x of {} 385 | 386 | instance GAbsurd f => GAbsurd (M1 i c f) where 387 | gabsurd (M1 x) = gabsurd x 388 | 389 | instance Absurd c => GAbsurd (K1 i c) where 390 | gabsurd (K1 x) = absurd x 391 | 392 | instance (GAbsurd f, GAbsurd g) => GAbsurd (f :+: g) where 393 | gabsurd (L1 x) = gabsurd x 394 | gabsurd (R1 y) = gabsurd y 395 | 396 | -- There are two reasonable instances for GAbsurd (f :*: g), so we define neither 397 | --------------------------------------------------------------------------------