dualizer 0.1.0.1 → 0.2.0.0

raw patch · 12 files changed

+1024/−404 lines, 12 filesdep +doctestdep +dualizerdep −bifunctorsdep −comonaddep ~basedep ~containersdep ~lensbuild-type:Customsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: doctest, dualizer

Dependencies removed: bifunctors, comonad

Dependency ranges changed: base, containers, lens, template-haskell, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−0
• LICENSE +5/−5
• README.md +101/−6
• Setup.hs +17/−0
• docs/license-report.md +68/−0
• dualizer.cabal +185/−44
• src/Categorical/Dual.hs +414/−283
• src/Categorical/Dual/Base.hs +29/−7
• src/Categorical/Dual/Example.hs +112/−54
• src/Categorical/Dual/Lens.hs +8/−4
• src/Categorical/Dual/Prelude.hs +51/−1
• tests/doctests.hs +12/−0

@@ -0,0 +1,22 @@+# Changelog++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog 1.1](https://keepachangelog.com/en/1.1.0/),+and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).++## [0.2.0.0] - 2025-04-07++### Added++- support for GHC 9.10++## [0.1.0.1] - 2019-01-05++## [0.1.0.0] - 2019-01-04++### Added++- initial release of this package++[0.1.0.0]: https://github.com/sellout/dualizer/releases/tag/v0..1.0.0

@@ -1,7 +1,7 @@                     GNU AFFERO GENERAL PUBLIC LICENSE                        Version 3, 19 November 2007 - Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>  Everyone is permitted to copy and distribute verbatim copies  of this license document, but changing it is not allowed. @@ -633,8 +633,8 @@     Copyright (C) <year>  <name of author>      This program is free software: you can redistribute it and/or modify-    it under the terms of the GNU Affero General Public License as published-    by the Free Software Foundation, either version 3 of the License, or+    it under the terms of the GNU Affero General Public License as published by+    the Free Software Foundation, either version 3 of the License, or     (at your option) any later version.      This program is distributed in the hope that it will be useful,@@ -643,7 +643,7 @@     GNU Affero General Public License for more details.      You should have received a copy of the GNU Affero General Public License-    along with this program.  If not, see <http://www.gnu.org/licenses/>.+    along with this program.  If not, see <https://www.gnu.org/licenses/>.  Also add information on how to contact you by electronic and paper mail. @@ -658,4 +658,4 @@   You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU AGPL, see-<http://www.gnu.org/licenses/>.+<https://www.gnu.org/licenses/>.

@@ -1,8 +1,12 @@ # → dualizer ← +[![Packaging status](https://repology.org/badge/tiny-repos/haskell:dualizer.svg)](https://repology.org/project/haskell:dualizer/versions)+[![latest packaged versions](https://repology.org/badge/latest-versions/haskell:dualizer.svg)](https://repology.org/project/haskell:dualizer/versions)+[![Join the chat at https://gitter.im/dualizer/Lobby](https://badges.gitter.im/dualizer/Lobby.svg)](https://gitter.im/dualizer/Lobby)+ **Delete half (minus ε) of your Haskell code!** -[![Join the chat at https://gitter.im/dualizer/Lobby](https://badges.gitter.im/dualizer/Lobby.svg)](https://gitter.im/dualizer/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)+## usage  Dualizer allows you to eliminate the dual of all your code. Rather than implementing, say, `Comonad` directly, you can define it in terms of its dual – `Monad`: @@ -25,7 +29,7 @@  See [`Categorical.Dual.Example`](src/Categorical/Dual/Example.hs) for a bit more. -## The Template Haskell You Need to Know+### The Template Haskell You Need to Know  This library is written using Template Haskell, and while it tries to minimize the familiarity needed to use it (and accepting suggestions/PRs for reducing it further), some still leaks through. Here’s what you need to know. @@ -33,7 +37,7 @@  To allow code to be reified into an AST that Template Haskell can work with, it uses a special “quasiquotation” syntax, opening with `[d|` and closing with `|]` that looks like `[d|your :: Code -> Here|]` when used. There are variants of this that use something other than `d` in the opening, but we don’t need them in this library. -## Defining Duals+### Defining Duals  There are three approaches here to defining duals, and they are listed in order of preference. @@ -45,7 +49,7 @@  You can, however, still label existing values as duals of each other. -## Defining Duals Simultaneously+#### Defining Duals Simultaneously  ```haskell makeDualDec@@ -57,6 +61,7 @@ ```  This form can also be nested, allowing the definition of duals for type classes, etc. (NB: This can’t actually work this way).+ ```haskell makeDualDec [d|   class Functor f => Applicative f where@@ -70,7 +75,7 @@ |] "Comonad" ``` -## Defining the Dual of an Existing Thing+#### Defining the Dual of an Existing Thing  If one side of the construct already exists, then you can assign the duals like @@ -84,7 +89,7 @@ makeDualClass ''Monad "Comonad" [('(>>=) , "=>>")] ``` -## Labeling Existing Duals+#### Labeling Existing Duals  Labeling is especially useful when things are duals of themselves. @@ -109,3 +114,93 @@ -- will be converted to `pure` on any return trip. labelSemiDual 'return 'extract ```++## versioning++This project largely follows the [Haskell Package Versioning Policy](https://pvp.haskell.org/) (PVP), but is more strict in some ways.++The version always has four components, `A.B.C.D`. The first three correspond to those required by PVP, while the fourth matches the “patch” component from [Semantic Versioning](https://semver.org/).++Here is a breakdown of some of the constraints:++### sensitivity to additions to the API++PVP recommends that clients follow [these import guidelines](https://wiki.haskell.org/Import_modules_properly) in order that they may be considered insensitive to additions to the API. However, this isn’t sufficient. We expect clients to follow these additional recommendations for API insensitivity++If you don’t follow these recommendations (in addition to the ones made by PVP), you should ensure your dependencies don’t allow a range of `C` values. That is, your dependencies should look like++```cabal+yaya >=1.2.3 && <1.2.4+```++rather than++```cabal+yaya >=1.2.3 && <1.3+```++#### use package-qualified imports everywhere++If your imports are [package-qualified](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/package_qualified_imports.html?highlight=packageimports#extension-PackageImports), then a dependency adding new modules can’t cause a conflict with modules you already import.++#### avoid orphans++Because of the transitivity of instances, orphans make you sensitive to your dependencies’ instances. If you have an orphan instance, you are sensitive to the APIs of the packages that define the class and the types of the instance.++One way to minimize this sensitivity is to have a separate package (or packages) dedicated to any orphans you have. Those packages can be sensitive to their dependencies’ APIs, while the primary package remains insensitive, relying on the tighter ranges of the orphan packages to constrain the solver.++### transitively breaking changes (increments `A`)++#### removing a type class instance++Type class instances are imported transitively, and thus changing them can impact packages that only have your package as a transitive dependency.++#### widening a dependency range with new major versions++This is a consequence of instances being transitively imported. A new major version of a dependency can remove instances, and that can break downstream clients that unwittingly depended on those instances.++A library _may_ declare that it always bumps the `A` component when it removes an instance (as this policy dictates). In that case, only `A` widenings need to induce `A` bumps. `B` widenings can be `D` bumps like other widenings, Alternatively, one may compare the APIs when widening a dependency range, and if no instances have been removed, make it a `D` bump.++### breaking changes (increments `B`)++#### restricting an existing dependency’s version range in any way++Consumers have to contend not only with our version bounds, but also with those of other libraries. It’s possible that some dependency overlapped in a very narrow way, and even just restricting a particular patch version of a dependency could make it impossible to find a dependency solution.++#### restricting the license in any way++Making a license more restrictive may prevent clients from being able to continue using the package.++#### adding a dependency++A new dependency may make it impossible to find a solution in the face of other packages dependency ranges.++### non-breaking changes (increments `C`)++#### adding a module++This is also what PVP recommends. However, unlike in PVP, this is because we recommend that package-qualified imports be used on all imports.++### other changes (increments `D`)++#### widening a dependency range for non-major versions++This is fairly uncommon, in the face of `^>=`-style ranges, but it can happen in a few situations.++#### deprecation++**NB**: This case is _weaker_ than PVP, which indicates that packages should bump their major version when adding `deprecation` pragmas.++We disagree with this because packages shouldn’t be _publishing_ with `-Werror`. The intent of deprecation is to indicate that some API _will_ change. To make that signal a major change itself defeats the purpose. You want people to start seeing that warning as soon as possible. The major change occurs when you actually remove the old API.++Yes, in development, `-Werror` is often (and should be) used. However, that just helps developers be aware of deprecations more immediately. They can always add `-Wwarn=deprecation` in some scope if they need to avoid updating it for the time being.++## licensing++This package is licensed under [The GNU AGPL 3.0 or later](./LICENSE). If you need a license for usage that isn’t covered under the AGPL, please contact [Greg Pfeil](mailto:greg@technomadic.org?subject=licensing%20dualizer).++You should review the [license report](docs/license-report.md) for details about dependency licenses.++## comparisons++Other projects similar to this one, and how they differ.

@@ -0,0 +1,17 @@+-- __NB__: `custom-setup` doesn’t have any way to specify extensions or options,+--         so any we want need to be specified here.+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE Unsafe #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Weverything #-}+-- Warns even when `Unsafe` is explicit, not inferred. See+-- https://gitlab.haskell.org/ghc/ghc/-/issues/16689+{-# OPTIONS_GHC -Wno-unsafe #-}++module Main (main) where++import safe "base" System.IO (IO)+import "cabal-doctest" Distribution.Extra.Doctest (defaultMainWithDoctests)++main :: IO ()+main = defaultMainWithDoctests "doctests"

@@ -0,0 +1,68 @@+**NB**: This captures the licenses associated with a particular set of dependency versions. If your own build solves differently, it’s possible that the licenses may have changed, or even that the set of dependencies itself is different. Please make sure you run [`cabal-plan license-report`](https://hackage.haskell.org/package/cabal-plan) on your own components rather than assuming this is authoritative.++# Dependency License Report++Bold-faced **`package-name`**s denote standard libraries bundled with `ghc-9.10.1`.++## Direct dependencies of `dualizer:lib:dualizer`++| Name | Version | [SPDX](https://spdx.org/licenses/) License Id | Description | Also depended upon by |+| --- | --- | --- | --- | --- |+| **`base`** | [`4.20.0.0`](http://hackage.haskell.org/package/base-4.20.0.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/base-4.20.0.0/src/LICENSE) | Core data structures and operations | *(core library)* |+| **`containers`** | [`0.7`](http://hackage.haskell.org/package/containers-0.7) | [`BSD-3-Clause`](http://hackage.haskell.org/package/containers-0.7/src/LICENSE) | Assorted concrete container types | `adjunctions`, `bifunctors`, `binary`, `comonad`, `free`, `hashable`, `indexed-traversable`, `invariant`, `kan-extensions`, `lens`, `parallel`, `semigroupoids`, `th-abstraction` |+| `lens` | [`5.3.4`](http://hackage.haskell.org/package/lens-5.3.4) | [`BSD-2-Clause`](http://hackage.haskell.org/package/lens-5.3.4/src/LICENSE) | Lenses, Folds and Traversals |  |+| **`template-haskell`** | [`2.22.0.0`](http://hackage.haskell.org/package/template-haskell-2.22.0.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/template-haskell-2.22.0.0/src/LICENSE) | Support library for Template Haskell | `OneTuple`, `bifunctors`, `bytestring`, `containers`, `exceptions`, `filepath`, `free`, `invariant`, `lens`, `os-string`, `primitive`, `reflection`, `semigroupoids`, `tagged`, `text`, `th-abstraction`, `unordered-containers` |+| **`transformers`** | [`0.6.1.1`](http://hackage.haskell.org/package/transformers-0.6.1.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/transformers-0.6.1.1/src/LICENSE) | Concrete functor and monad transformers | `StateVar`, `adjunctions`, `bifunctors`, `comonad`, `contravariant`, `distributive`, `exceptions`, `free`, `indexed-traversable`, `invariant`, `kan-extensions`, `lens`, `mtl`, `primitive`, `profunctors`, `semigroupoids`, `strict`, `tagged`, `transformers-base`, `transformers-compat` |++## Indirect transitive dependencies++| Name | Version | [SPDX](https://spdx.org/licenses/) License Id | Description | Depended upon by |+| --- | --- | --- | --- | --- |+| `OneTuple` | [`0.4.2`](http://hackage.haskell.org/package/OneTuple-0.4.2) | [`BSD-3-Clause`](http://hackage.haskell.org/package/OneTuple-0.4.2/src/LICENSE) | Singleton Tuple | `indexed-traversable-instances` |+| `StateVar` | [`1.2.2`](http://hackage.haskell.org/package/StateVar-1.2.2) | [`BSD-3-Clause`](http://hackage.haskell.org/package/StateVar-1.2.2/src/LICENSE) | State variables | `contravariant`, `invariant` |+| `adjunctions` | [`4.4.3`](http://hackage.haskell.org/package/adjunctions-4.4.3) | [`BSD-2-Clause`](http://hackage.haskell.org/package/adjunctions-4.4.3/src/LICENSE) | Adjunctions and representable functors | `kan-extensions` |+| **`array`** | [`0.5.7.0`](http://hackage.haskell.org/package/array-0.5.7.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/array-0.5.7.0/src/LICENSE) | Mutable and immutable arrays | `adjunctions`, `binary`, `containers`, `deepseq`, `indexed-traversable`, `invariant`, `kan-extensions`, `lens`, `parallel`, `stm`, `text` |+| `assoc` | [`1.1.1`](http://hackage.haskell.org/package/assoc-1.1.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/assoc-1.1.1/src/LICENSE) | swap and assoc: Symmetric and Semigroupy Bifunctors | `bifunctors`, `lens`, `strict`, `these` |+| `base-orphans` | [`0.9.3`](http://hackage.haskell.org/package/base-orphans-0.9.3) | [`MIT`](http://hackage.haskell.org/package/base-orphans-0.9.3/src/LICENSE) | Backwards-compatible orphan instances for base | `distributive`, `lens`, `profunctors`, `semigroupoids`, `transformers-base` |+| `bifunctors` | [`5.6.2`](http://hackage.haskell.org/package/bifunctors-5.6.2) | [`BSD-3-Clause`](http://hackage.haskell.org/package/bifunctors-5.6.2/src/LICENSE) | Bifunctors | `invariant`, `lens`, `profunctors`, `semigroupoids` |+| **`binary`** | [`0.8.9.2`](http://hackage.haskell.org/package/binary-0.8.9.2) | [`BSD-3-Clause`](http://hackage.haskell.org/package/binary-0.8.9.2/src/LICENSE) | Binary serialisation for Haskell values using lazy ByteStrings | `strict`, `text`, `these` |+| **`bytestring`** | [`0.12.1.0`](http://hackage.haskell.org/package/bytestring-0.12.1.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/bytestring-0.12.1.0/src/LICENSE) | Fast, compact, strict and lazy byte strings with a list interface | `binary`, `filepath`, `hashable`, `lens`, `os-string`, `strict`, `text` |+| `call-stack` | [`0.4.0`](http://hackage.haskell.org/package/call-stack-0.4.0) | [`MIT`](http://hackage.haskell.org/package/call-stack-0.4.0/src/LICENSE) | Use GHC call-stacks in a backward compatible way | `lens` |+| `comonad` | [`5.0.9`](http://hackage.haskell.org/package/comonad-5.0.9) | [`BSD-3-Clause`](http://hackage.haskell.org/package/comonad-5.0.9/src/LICENSE) | Comonads | `adjunctions`, `bifunctors`, `free`, `invariant`, `kan-extensions`, `lens`, `profunctors`, `semigroupoids` |+| `contravariant` | [`1.5.5`](http://hackage.haskell.org/package/contravariant-1.5.5) | [`BSD-3-Clause`](http://hackage.haskell.org/package/contravariant-1.5.5/src/LICENSE) | Contravariant functors | `adjunctions`, `invariant`, `kan-extensions`, `lens`, `profunctors`, `semigroupoids` |+| **`deepseq`** | [`1.5.0.0`](http://hackage.haskell.org/package/deepseq-1.5.0.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/deepseq-1.5.0.0/src/LICENSE) | Deep evaluation of data structures | `bytestring`, `containers`, `filepath`, `hashable`, `os-string`, `parallel`, `pretty`, `primitive`, `strict`, `tagged`, `text`, `these`, `unordered-containers`, `vector` |+| `distributive` | [`0.6.2.1`](http://hackage.haskell.org/package/distributive-0.6.2.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/distributive-0.6.2.1/src/LICENSE) | Distributive functors -- Dual to Traversable | `adjunctions`, `comonad`, `free`, `kan-extensions`, `lens`, `profunctors`, `semigroupoids` |+| **`exceptions`** | [`0.10.7`](http://hackage.haskell.org/package/exceptions-0.10.7) | [`BSD-3-Clause`](http://hackage.haskell.org/package/exceptions-0.10.7/src/LICENSE) | Extensible optionally-pure exceptions | `filepath`, `free`, `lens`, `os-string` |+| **`filepath`** | [`1.5.2.0`](http://hackage.haskell.org/package/filepath-1.5.2.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/filepath-1.5.2.0/src/LICENSE) | Library for manipulating FilePaths in a cross platform way. | `hashable`, `lens` |+| `free` | [`5.2`](http://hackage.haskell.org/package/free-5.2) | [`BSD-3-Clause`](http://hackage.haskell.org/package/free-5.2/src/LICENSE) | Monads for free | `adjunctions`, `kan-extensions`, `lens` |+| **`ghc-bignum`** | [`1.3`](http://hackage.haskell.org/package/ghc-bignum-1.3) | [`BSD-3-Clause`](http://hackage.haskell.org/package/ghc-bignum-1.3/src/LICENSE) | GHC BigNum library | `ghc-internal`, `hashable` |+| **`ghc-boot-th`** | [`9.10.1`](http://hackage.haskell.org/package/ghc-boot-th-9.10.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/ghc-boot-th-9.10.1/src/LICENSE) | Shared functionality between GHC and the @template-haskell@ library | `template-haskell` |+| **`ghc-internal`** | [`9.1001.0`](http://hackage.haskell.org/package/ghc-internal-9.1001.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/ghc-internal-9.1001.0/src/LICENSE) | Basic libraries | `base` |+| **`ghc-prim`** | [`0.11.0`](http://hackage.haskell.org/package/ghc-prim-0.11.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/ghc-prim-0.11.0/src/LICENSE) | GHC primitives | *(core library)* |+| `hashable` | [`1.5.0.0`](http://hackage.haskell.org/package/hashable-1.5.0.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/hashable-1.5.0.0/src/LICENSE) | A class for types that can be converted to a hash value | `lens`, `semigroupoids`, `strict`, `these`, `unordered-containers` |+| `indexed-traversable` | [`0.1.4`](http://hackage.haskell.org/package/indexed-traversable-0.1.4) | [`BSD-2-Clause`](http://hackage.haskell.org/package/indexed-traversable-0.1.4/src/LICENSE) | FunctorWithIndex, FoldableWithIndex, TraversableWithIndex | `comonad`, `free`, `indexed-traversable-instances`, `lens` |+| `indexed-traversable-instances` | [`0.1.2`](http://hackage.haskell.org/package/indexed-traversable-instances-0.1.2) | [`BSD-2-Clause`](http://hackage.haskell.org/package/indexed-traversable-instances-0.1.2/src/LICENSE) | More instances of FunctorWithIndex, FoldableWithIndex, TraversableWithIndex | `lens` |+| `invariant` | [`0.6.4`](http://hackage.haskell.org/package/invariant-0.6.4) | [`BSD-2-Clause`](http://hackage.haskell.org/package/invariant-0.6.4/src/LICENSE) | Haskell98 invariant functors | `kan-extensions` |+| `kan-extensions` | [`5.2.6`](http://hackage.haskell.org/package/kan-extensions-5.2.6) | [`BSD-3-Clause`](http://hackage.haskell.org/package/kan-extensions-5.2.6/src/LICENSE) | Kan extensions, Kan lifts, the Yoneda lemma, and (co)density (co)monads | `lens` |+| **`mtl`** | [`2.3.1`](http://hackage.haskell.org/package/mtl-2.3.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/mtl-2.3.1/src/LICENSE) | Monad classes for transformers, using functional dependencies | `adjunctions`, `exceptions`, `free`, `kan-extensions`, `lens` |+| **`os-string`** | [`2.0.2`](http://hackage.haskell.org/package/os-string-2.0.2) | [`BSD-3-Clause`](http://hackage.haskell.org/package/os-string-2.0.2/src/LICENSE) | Library for manipulating Operating system strings. | `filepath`, `hashable` |+| `parallel` | [`3.2.2.0`](http://hackage.haskell.org/package/parallel-3.2.2.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/parallel-3.2.2.0/src/LICENSE) | Parallel programming library | `lens` |+| **`pretty`** | [`1.1.3.6`](http://hackage.haskell.org/package/pretty-1.1.3.6) | [`BSD-3-Clause`](http://hackage.haskell.org/package/pretty-1.1.3.6/src/LICENSE) | Pretty-printing library | `template-haskell` |+| `primitive` | [`0.9.1.0`](http://hackage.haskell.org/package/primitive-0.9.1.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/primitive-0.9.1.0/src/LICENSE) | Primitive memory-related operations | `vector` |+| `profunctors` | [`5.6.2`](http://hackage.haskell.org/package/profunctors-5.6.2) | [`BSD-3-Clause`](http://hackage.haskell.org/package/profunctors-5.6.2/src/LICENSE) | Profunctors | `adjunctions`, `free`, `invariant`, `kan-extensions`, `lens` |+| `reflection` | [`2.1.9`](http://hackage.haskell.org/package/reflection-2.1.9) | [`BSD-3-Clause`](http://hackage.haskell.org/package/reflection-2.1.9/src/LICENSE) | Reifies arbitrary terms into types that can be reflected back into terms | `lens` |+| `semigroupoids` | [`6.0.1`](http://hackage.haskell.org/package/semigroupoids-6.0.1) | [`BSD-2-Clause`](http://hackage.haskell.org/package/semigroupoids-6.0.1/src/LICENSE) | Semigroupoids: Category sans id | `adjunctions`, `free`, `kan-extensions`, `lens` |+| `semigroups` | [`0.20`](http://hackage.haskell.org/package/semigroups-0.20) | [`BSD-3-Clause`](http://hackage.haskell.org/package/semigroups-0.20/src/LICENSE) | Anything that associates | `adjunctions` |+| **`stm`** | [`2.5.3.1`](http://hackage.haskell.org/package/stm-2.5.3.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/stm-2.5.3.1/src/LICENSE) | Software Transactional Memory | `StateVar`, `exceptions`, `invariant`, `transformers-base` |+| `strict` | [`0.5.1`](http://hackage.haskell.org/package/strict-0.5.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/strict-0.5.1/src/LICENSE) | Strict data types and String IO. | `lens` |+| `tagged` | [`0.8.9`](http://hackage.haskell.org/package/tagged-0.8.9) | [`BSD-3-Clause`](http://hackage.haskell.org/package/tagged-0.8.9/src/LICENSE) | Haskell 98 phantom types to avoid unsafely passing dummy arguments | `adjunctions`, `bifunctors`, `comonad`, `distributive`, `indexed-traversable-instances`, `invariant`, `kan-extensions`, `lens`, `profunctors`, `semigroupoids` |+| **`text`** | [`2.1.1`](http://hackage.haskell.org/package/text-2.1.1) | [`BSD-2-Clause`](http://hackage.haskell.org/package/text-2.1.1/src/LICENSE) | An efficient packed Unicode text type. | `hashable`, `lens`, `strict` |+| `th-abstraction` | [`0.7.1.0`](http://hackage.haskell.org/package/th-abstraction-0.7.1.0) | [`ISC`](http://hackage.haskell.org/package/th-abstraction-0.7.1.0/src/LICENSE) | Nicer interface for reified information about data types | `bifunctors`, `free`, `invariant`, `lens` |+| `these` | [`1.2.1`](http://hackage.haskell.org/package/these-1.2.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/these-1.2.1/src/LICENSE) | An either-or-both data type. | `lens`, `strict` |+| `transformers-base` | [`0.4.6`](http://hackage.haskell.org/package/transformers-base-0.4.6) | [`BSD-3-Clause`](http://hackage.haskell.org/package/transformers-base-0.4.6/src/LICENSE) | Lift computations from the bottom of a transformer stack | `free` |+| `transformers-compat` | [`0.7.2`](http://hackage.haskell.org/package/transformers-compat-0.7.2) | [`BSD-3-Clause`](http://hackage.haskell.org/package/transformers-compat-0.7.2/src/LICENSE) | A small compatibility shim for the transformers library | `adjunctions`, `comonad`, `invariant`, `lens`, `semigroupoids`, `transformers-base` |+| `unordered-containers` | [`0.2.20`](http://hackage.haskell.org/package/unordered-containers-0.2.20) | [`BSD-3-Clause`](http://hackage.haskell.org/package/unordered-containers-0.2.20/src/LICENSE) | Efficient hashing-based container types | `indexed-traversable-instances`, `invariant`, `lens`, `semigroupoids` |+| `vector` | [`0.13.2.0`](http://hackage.haskell.org/package/vector-0.13.2.0) | [`BSD-3-Clause`](http://hackage.haskell.org/package/vector-0.13.2.0/src/LICENSE) | Efficient Arrays | `indexed-traversable-instances`, `lens` |+| `vector-stream` | [`0.1.0.1`](http://hackage.haskell.org/package/vector-stream-0.1.0.1) | [`BSD-3-Clause`](http://hackage.haskell.org/package/vector-stream-0.1.0.1/src/LICENSE) | Efficient Streams | `vector` |+| `void` | [`0.7.3`](http://hackage.haskell.org/package/void-0.7.3) | [`BSD-3-Clause`](http://hackage.haskell.org/package/void-0.7.3/src/LICENSE) | A Haskell 98 logically uninhabited data type | `adjunctions` |+

@@ -1,48 +1,189 @@-name:               dualizer-version:            0.1.0.1-synopsis:           Automatically generate dual constructions.-description:        A library for defining duals automatically, as well as-                    labeling duals in existing packages.-homepage:           https://github.com/sellout/dualizer#readme-author:             Greg Pfeil-maintainer:         greg@technomadic.org-copyright:          2017 Greg Pfeil-license:            AGPL-license-file:       LICENSE-category:           Categories-build-type:         Simple-extra-source-files: README.md-cabal-version:      >=1.10+cabal-version: 3.0 -library-  hs-source-dirs:     src-  exposed-modules:    Categorical.Dual-                    , Categorical.Dual.Base-                    , Categorical.Dual.Example-                    , Categorical.Dual.Lens-                    , Categorical.Dual.Prelude-  build-depends:      base >= 4.7 && < 5-                    , bifunctors-                    , comonad-                    , containers-                    , lens-                    , template-haskell-                    , transformers-  default-extensions: ConstraintKinds-                    , DeriveFoldable-                    , DeriveFunctor-                    , DeriveTraversable-                    , FlexibleContexts-                    , FlexibleInstances-                    , FunctionalDependencies-                    , LambdaCase-                    , MultiParamTypeClasses-                    , RankNTypes-                    , ScopedTypeVariables-                    , TupleSections-                    , TypeOperators-  default-language:   Haskell2010+name: dualizer+version: 0.2.0.0+synopsis: Automatically generate dual constructions+description: A library for defining duals automatically, as well as labeling duals in existing packages.+author: Greg Pfeil <greg@technomadic.org>+maintainer: Greg Pfeil <greg@technomadic.org>+copyright: 2017-2024 Greg Pfeil+homepage: https://github.com/sellout/dualizer#readme+bug-reports: https://github.com/sellout/dualizer/issues+category: Categories+build-type: Custom+license: AGPL-3.0-or-later+license-files:+  LICENSE+extra-doc-files:+  CHANGELOG.md+  README.md+  docs/*.md+tested-with:+  GHC == {+    8.10.1, 8.10.7,+    9.0.1, 9.0.2,+    9.2.1, 9.2.5,+    9.4.1, 9.4.5,+    9.6.1, 9.6.3, 9.6.6,+    9.8.1,+    9.10.1+  }  source-repository head-  type:     git+  type: git   location: https://github.com/sellout/dualizer++-- This mimics the GHC2024 extension+-- (https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/control.html?highlight=doandifthenelse#extension-GHC2024),+-- but supporting compilers back to GHC 7.10. If the oldest supported compiler+-- is GHC 9.10, then this stanza can be removed and `import: GHC2024` can be+-- replaced by `default-language: GHC2024`. If the oldest supported compiler is+-- GHC 9.2, then this can be simplified by setting `default-language: GHC2021`+-- and only including the extensions added by GHC2024.+common GHC2024+  default-language: Haskell2010+  default-extensions:+    BangPatterns+    BinaryLiterals+    ConstraintKinds+    DataKinds+    DeriveDataTypeable+    DeriveGeneric+    DeriveLift+    DeriveTraversable+    DerivingStrategies+    DisambiguateRecordFields+    DoAndIfThenElse+    EmptyCase+    ExistentialQuantification+    FlexibleContexts+    FlexibleInstances+    GADTs+    GeneralizedNewtypeDeriving+    HexFloatLiterals+    ImportQualifiedPost+    InstanceSigs+    LambdaCase+    MagicHash+    MonadComprehensions+    MonomorphismRestriction+    MultiParamTypeClasses+    NamedFieldPuns+    NamedWildCards+    NumericUnderscores+    PolyKinds+    PostfixOperators+    RankNTypes+    RoleAnnotations+    ScopedTypeVariables+    StandaloneDeriving+    StandaloneKindSignatures+    TupleSections+    TypeApplications+    TypeOperators+    UnicodeSyntax++flag noisy-deprecations+  description:+    Prior to GHC 9.10, the `DEPRECATED` pragma can’t distinguish between terms+    and types. Consenquently, you can get spurious warnings when there’s a name+    collision and the name in the other namespace is deprecated. Or you can+    choose to not get those warnings, at the risk of not being warned when+    there’s a name collision and the namespace you’re referencing is the one+    that’s deprecated.++common defaults+  import: GHC2024+  build-depends:+    base ^>= {4.14.0, 4.15.0, 4.16.0, 4.17.0, 4.18.0, 4.19.0, 4.20.0},+  ghc-options:+    -Weverything+    -- This one just reports unfixable things, AFAICT.+    -Wno-all-missed-specialisations+    -- Type inference good.+    -Wno-missing-local-signatures+    -- Warns even when `Unsafe` is explicit, not inferred. See+    -- https://gitlab.haskell.org/ghc/ghc/-/issues/16689+    -Wno-unsafe+  -- remove if the oldest supported version is GHC 9.2.1++  if impl(ghc >= 9.2.1)+    ghc-options:+      -Wno-missing-kind-signatures+  if impl(ghc >= 9.8.1)+    ghc-options:+      -- remove if the oldest supported version is GHC 9.2.1++      -Wno-missing-poly-kind-signatures+      -- Inference good.+      -Wno-missing-role-annotations+  default-extensions:+    BlockArguments+    DefaultSignatures+    ExplicitNamespaces+    FunctionalDependencies+    LiberalTypeSynonyms+    -- replace with `LexicalNegation` if the oldest supported version is GHC 9.0.1++    NegativeLiterals+    PackageImports+    ParallelListComp+    -- QualifiedDo - uncomment if the oldest supported version is GHC 9.0.1++    RecursiveDo+    -- RequiredTypeArguments - uncomment if the oldest supported version is GHC 9.10.1++    StrictData+    TemplateHaskellQuotes+    TransformListComp+    NoGeneralizedNewtypeDeriving+    NoImplicitPrelude+    NoMonomorphismRestriction+    NoPatternGuards+    NoStarIsType+    NoTypeApplications+  if flag(noisy-deprecations)+    cpp-options: -DSELLOUT_NOISY_DEPRECATIONS++custom-setup+  setup-depends:+    -- TODO: Remove `Cabal` dep once haskell/cabal#3751 is fixed.+    Cabal ^>= {3.0.0, 3.2.0, 3.4.0, 3.6.0, 3.8.0, 3.10.0, 3.12.0},+    base ^>= {4.8.2, 4.9.0, 4.10.0, 4.11.0, 4.12.0, 4.13.0, 4.14.0, 4.15.0, 4.16.0, 4.17.0, 4.18.0, 4.19.0, 4.20.0},+    cabal-doctest ^>= {1.0.0},++library+  import: defaults+  hs-source-dirs: src+  build-depends:+    containers ^>= {0.6.2, 0.7},+    lens ^>= {4.19, 5, 5.1, 5.2, 5.3},+    template-haskell ^>= {2.16.0, 2.17.0, 2.18.0, 2.19.0, 2.20.0, 2.21.0, 2.22.0},+    transformers ^>= {0.5.6, 0.6.1},+  exposed-modules:+    Categorical.Dual+    Categorical.Dual.Base+    Categorical.Dual.Example+    Categorical.Dual.Lens+    Categorical.Dual.Prelude++test-suite doctests+  import: defaults+  type: exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is: doctests.hs+  build-depends:+    doctest ^>= {0.16.3, 0.18.1, 0.20.1, 0.21.1, 0.22.2},+    dualizer,+  -- TODO: The sections below here are necessary because we don’t have control+  --       over the generated `Build_doctests.hs` file. So we have to silence+  --       all of its warnings one way or another.+  ghc-options:+    -Wno-missing-deriving-strategies+    -Wno-missing-export-lists+    -Wno-missing-import-lists+    -Wno-safe+    -- `doctest` requires the package containing the doctests as a dependency+    -- to ensure it gets built before this test-suite, even though the package+    -- appears to be unused.+    -Wno-unused-packages+  default-extensions:+    -- Since we can’t add `{-# LANGUAGE Safe -#}` to the generated+    -- “Build_doctests.hs”, we set it here, and that means it has to match+    -- doctests.hs, which is `Unsafe`.+    Unsafe

@@ -1,50 +1,80 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Unsafe #-}  -- | Operations to connect dual constructions. module Categorical.Dual-  ( importDuals-  , exportDuals-  , emptyDuals -- shouldn’t export this--  , dualType-  , dualExp--  , makeDualClass-  , makeDualDec--  , labelDual-  , labelSelfDual-  , labelSemiDual-  ) where+  ( importDuals,+    exportDuals,+    emptyDuals, -- shouldn’t export this+    shareDuals,+    dualType,+    dualExp,+    makeDualClass,+    makeDualDec,+    makeDualExp,+    labelDual,+    labelSelfDual,+    labelSemiDual,+  )+where -import           Control.Arrow-import           Control.Comonad-import           Control.Lens-import           Control.Monad-import           Control.Monad.Trans.Class-import           Control.Monad.Trans.Except-import           Data.Bitraversable-import           Data.Data-import qualified Data.Map as Map-import           Data.Map (Map)-import           Data.Maybe-import           Data.Monoid-import           Data.Semigroup-import           Data.Tuple-import           Data.Void-import           Language.Haskell.TH-import           Language.Haskell.TH.Quote-import           Language.Haskell.TH.Syntax hiding (lift)+import safe Control.Applicative (pure, (<*>))+import safe Control.Arrow ((***))+import safe Control.Category (id, (.))+import safe Control.Lens (makeLenses, (%~), (&))+import safe Control.Monad (Monad, fail, join, (<=<), (=<<))+import safe Control.Monad.Trans.Class (lift)+import safe Control.Monad.Trans.Except+  ( ExceptT (ExceptT),+    runExceptT,+    throwE,+    withExceptT,+  )+import safe Data.Bitraversable (bisequence)+import safe Data.Data (Data)+import safe Data.Either (Either (Left, Right), either)+import safe Data.Eq (Eq)+import safe Data.Function (const, flip, ($))+import safe Data.Functor (fmap, (<$), (<$>))+import safe Data.List (nub)+import safe Data.Map (Map)+import safe Data.Map qualified as Map+import safe Data.Maybe (maybe)+import safe Data.Monoid (Monoid, mappend, mempty)+import safe Data.Semigroup (Semigroup, (<>))+import safe Data.String (String)+import safe Data.Traversable (sequenceA, traverse)+import safe Data.Tuple (swap, uncurry)+import safe Data.Void (Void)+import safe Language.Haskell.TH qualified as TH+import safe Language.Haskell.TH.Syntax+  ( Body (GuardedB, NormalB),+    Clause (Clause),+    Con (ForallC, GadtC, InfixC, NormalC, RecC, RecGadtC),+    Guard (NormalG, PatG),+    Match (Match),+    Name,+    Q,+    TySynEqn (TySynEqn),+    TypeFamilyHead (TypeFamilyHead),+    getQ,+    liftData,+    mkName,+    putQ,+    recover,+    reify,+  )+import safe Text.Show (Show, show)+import safe Prelude (undefined) -data DualMappings = DualMappings {-  _dualTypes :: Map Name Type,-  _dualValues :: Map Name Exp-} deriving (Data, Eq)+data DualMappings = DualMappings+  { _dualTypes :: Map Name TH.Type,+    _dualValues :: Map Name TH.Exp+  }+  deriving stock (Data, Eq)  makeLenses ''DualMappings @@ -52,398 +82,499 @@   DualMappings t v <> DualMappings t' v' =     -- NB: I reversed the order here, because I _think_ this is supposed to be     --     right-biased?-    DualMappings (Map.union t' t) (Map.union v' v)+    DualMappings (t' `Map.union` t) (v' `Map.union` v)  instance Monoid DualMappings where-  mempty = DualMappings mempty mempty-  mappend = (Data.Semigroup.<>)+  mappend = (<>)+  mempty = DualMappings Map.empty Map.empty  -- | The empty set of duals, should only be used to initalize the duals for --   `Prelude`. emptyDuals :: Q DualMappings emptyDuals = pure $ DualMappings Map.empty Map.empty -reifyDuals :: DualMappings -> Q Exp+reifyDuals :: DualMappings -> Q TH.Exp reifyDuals duals =-  [e|maybe $(liftData duals) (mappend $(liftData duals)) <$> getQ|]+  [e|maybe $(liftData duals) ($(liftData duals) <>) <$> getQ|] -shareDuals :: DualMappings -> Q Exp+shareDuals :: DualMappings -> Q TH.Exp shareDuals duals =-  [e|pure []-     <* (putQ . maybe $(liftData duals) (mappend $(liftData duals)) =<< getQ)|]+  [e|[] <$ (putQ . maybe $(liftData duals) ($(liftData duals) <>) =<< getQ)|]  -- TODO: Move this somewhere better-data AndMaybe a b = Only a | Indeed a b deriving (Eq, Show)+data AndMaybe a b = Only a | Indeed a b deriving stock (Eq, Show)  andMaybe :: (a -> c) -> (a -> b -> c) -> a `AndMaybe` b -> c andMaybe f g = \case-  Only a     -> f a+  Only a -> f a   Indeed a b -> g a b -fromName :: Name -> Q (Type `AndMaybe` Exp)-fromName =-  (\case-      ClassI (ClassD _ n _ _ _) _ -> pure . Only $ ConT n-      ClassI d _ -> fail $ "unknown dec to extract name from: " ++ show d-      ClassOpI n t _ -> pure . Indeed t $ VarE n-      TyConI (DataD _ n _ _ _ _) -> pure . Only $ ConT n-      TyConI (TySynD n _ _) -> pure . Only $ ConT n-      TyConI (NewtypeD _ n _ _ _ _) -> pure . Only $ ConT n-      TyConI d -> fail $ "unknown dec to extract name from: " ++ show d-      FamilyI d _ -> fail "not yet getting type families" -- FIXME-      PrimTyConI n _ _ -> pure . Only $ ConT n-      DataConI n t _ -> pure . Indeed t $ ConE n-      -- PatSynI _ _ -> fail "pattern synonym is not a type"-      VarI n t _ -> pure . Indeed t $ VarE n-      TyVarI _ t -> pure $ Only t)-  <=< reify+fromInfo :: TH.Info -> Q (TH.Type `AndMaybe` TH.Exp)+fromInfo = \case+  TH.ClassI (TH.ClassD _ n _ _ _) _ -> pure . Only $ TH.ConT n+  TH.ClassI d _ -> fail $ "unknown dec to extract name from: " <> show d+  TH.ClassOpI n t _ -> pure . Indeed t $ TH.VarE n+  TH.TyConI (TH.DataD _ n _ _ _ _) -> pure . Only $ TH.ConT n+  TH.TyConI (TH.TySynD n _ _) -> pure . Only $ TH.ConT n+  TH.TyConI (TH.NewtypeD _ n _ _ _ _) -> pure . Only $ TH.ConT n+  TH.TyConI d -> fail $ "unknown dec to extract name from: " <> show d+  TH.FamilyI d _ -> fail $ "not yet getting type families – " <> show d -- FIXME+  TH.PrimTyConI n _ _ -> pure . Only $ TH.ConT n+  TH.DataConI n t _ -> pure . Indeed t $ TH.ConE n+  TH.PatSynI _ _ -> fail "pattern synonym is not a type"+  TH.VarI n t _ -> pure . Indeed t $ TH.VarE n+  TH.TyVarI _ t -> pure $ Only t +fromName :: Name -> Q (TH.Type `AndMaybe` TH.Exp)+fromName = fromInfo <=< reify -typeFromName :: Name -> Q Type+typeFromName :: Name -> Q TH.Type typeFromName = fmap (andMaybe id const) . fromName -expFromName :: Name -> Q Exp+expFromName :: Name -> Q TH.Exp expFromName =-  andMaybe (\t -> fail $ show t ++ " is not a value") (\_ e -> pure e)-  <=< fromName+  andMaybe (\t -> fail $ show t <> " is not a value") (\_ e -> pure e)+    <=< fromName --- | Returns a Type that is the dual of the named type.-dualTypeName :: Map Name Type -> Name -> ExceptT Type Q Type+-- | Returns a `TH.Type` that is the dual of the named type.+dualTypeName :: Map Name TH.Type -> Name -> ExceptT TH.Type Q TH.Type dualTypeName db name =   maybe (dualType' db <=< lift $ typeFromName name) pure $ Map.lookup name db -dualExpName :: DualMappings -> Name -> ExceptT (Either Type Exp) Q Exp+dualExpName :: DualMappings -> Name -> ExceptT (Either TH.Type TH.Exp) Q TH.Exp dualExpName db name =-  maybe (dualExp' db <=< lift $ expFromName name) pure-  $ Map.lookup name (_dualValues db)+  maybe (dualExp' db <=< lift $ expFromName name) pure $+    Map.lookup name (_dualValues db)  retrieveDuals :: Q DualMappings retrieveDuals = maybe (fail "no duals imported") pure =<< getQ  -- FIXME: This can get into an infinite loop in the case of missing duals.-dualType' :: Map Name Type -> Type -> ExceptT Type Q Type+dualType' :: Map Name TH.Type -> TH.Type -> ExceptT TH.Type Q TH.Type dualType' db = \case-  ForallT vs c t       ->-    ForallT vs <$> traverse (dualType' db) c <*> dualType' db t-  AppT (AppT ArrowT t) inner@(AppT (AppT ArrowT _) _) -> do+  TH.ForallT vs c t ->+    TH.ForallT vs <$> traverse (dualType' db) c <*> dualType' db t+  TH.ForallVisT vs t -> TH.ForallVisT vs <$> dualType' db t+  TH.AppT (TH.AppT TH.ArrowT t) inner@(TH.AppT (TH.AppT TH.ArrowT _) _) -> do     t' <- dualType' db t-    AppT (AppT ArrowT t') <$> dualType' db inner-  AppT (AppT ArrowT t) t' -> AppT <$> (AppT ArrowT <$> dualType' db t') <*> dualType' db t-  AppT t t'            -> AppT <$> dualType' db t <*> dualType' db t'-  SigT t k             -> flip SigT k <$> (dualType' db t)-  VarT n               -> pure $ VarT n-  ConT n               -> dualTypeName db n-  PromotedT n          -> pure $ PromotedT n-  InfixT t n t'        -> dualTypeName db n -- t t'-  UInfixT t n t'       -> dualTypeName db n -- t t'-  (ParensT t)          -> pure $ ParensT t-  (TupleT 0)           -> pure $ ConT ''Void-  (TupleT 1)           -> pure $ TupleT 1-  (TupleT 2)           -> pure $ ConT ''Either-  f@(TupleT _)         -> throwE f-  f@(UnboxedTupleT i)  -> throwE f -- pure $ UnboxedSumT i-  -- UnboxedSumT a        -> pure $ UnboxedTupleT a-  ArrowT               -> pure ArrowT-  EqualityT            -> pure EqualityT-  ListT                -> pure ListT-  PromotedTupleT 0     -> pure $ ConT ''Void-  PromotedTupleT 1     -> pure $ PromotedTupleT 1-  PromotedTupleT 2     -> pure $ ConT ''Either-  f@(PromotedTupleT _) -> throwE f-  PromotedNilT         -> pure PromotedNilT-  PromotedConsT        -> pure PromotedConsT-  StarT                -> pure StarT-  ConstraintT          -> pure ConstraintT-  LitT l               -> pure $ LitT l-  WildCardT            -> pure WildCardT+    TH.AppT (TH.AppT TH.ArrowT t') <$> dualType' db inner+  TH.AppT (TH.AppT TH.ArrowT t) t' ->+    TH.AppT <$> (TH.AppT TH.ArrowT <$> dualType' db t') <*> dualType' db t+  TH.AppT t t' -> TH.AppT <$> dualType' db t <*> dualType' db t'+  TH.AppKindT t k -> TH.AppKindT <$> dualType' db t <*> pure k+  TH.SigT t k -> flip TH.SigT k <$> dualType' db t+  TH.VarT n -> pure $ TH.VarT n+  TH.ConT n -> dualTypeName db n+  TH.PromotedT n -> pure $ TH.PromotedT n+  TH.InfixT _t n _t' -> dualTypeName db n -- t t'+  TH.UInfixT _t n _t' -> dualTypeName db n -- t t'+  TH.ParensT t -> pure $ TH.ParensT t+  TH.TupleT 0 -> pure $ TH.ConT ''Void+  TH.TupleT 1 -> pure $ TH.TupleT 1+  TH.TupleT 2 -> pure $ TH.ConT ''Either+  f@(TH.TupleT _) -> throwE f+  TH.UnboxedTupleT i -> pure $ TH.UnboxedSumT i+  TH.UnboxedSumT a -> pure $ TH.UnboxedTupleT a+  TH.ArrowT -> pure TH.ArrowT+  TH.EqualityT -> pure TH.EqualityT+  TH.ListT -> pure TH.ListT+  TH.PromotedTupleT 0 -> pure $ TH.ConT ''Void+  TH.PromotedTupleT 1 -> pure $ TH.PromotedTupleT 1+  TH.PromotedTupleT 2 -> pure $ TH.ConT ''Either+  f@(TH.PromotedTupleT _) -> throwE f+  TH.PromotedNilT -> pure TH.PromotedNilT+  TH.PromotedConsT -> pure TH.PromotedConsT+  TH.StarT -> pure TH.StarT+  TH.ConstraintT -> pure TH.ConstraintT+  TH.LitT l -> pure $ TH.LitT l+  TH.WildCardT -> pure TH.WildCardT+  TH.ImplicitParamT n t -> TH.ImplicitParamT n <$> dualType' db t+#if MIN_VERSION_template_haskell(2, 19, 0)+  TH.PromotedInfixT _t n _t' -> dualTypeName db n -- t t'+  TH.PromotedUInfixT _t n _t' -> dualTypeName db n -- t t'+#endif+#if MIN_VERSION_template_haskell(2, 17, 0)+  TH.MulArrowT -> pure TH.MulArrowT+#endif +exceptT :: (Monad m) => (t1 -> m c) -> (t2 -> m c) -> ExceptT t1 m t2 -> m c exceptT f g =-  (\case-      Left a  -> f a-      Right a ->  g a)-  <=< runExceptT+  ( \case+      Left a -> f a+      Right a -> g a+  )+    <=< runExceptT  -- | Returns a type that is the dual of the input type.-dualType :: Type -> Q Type+dualType :: TH.Type -> Q TH.Type dualType type' = do   duals <- _dualTypes <$> retrieveDuals-  exceptT (\t -> fail $ "no dual for type " ++ show t) pure-    $ dualType' duals type'+  exceptT (\t -> fail $ "no dual for type " <> show t) pure $+    dualType' duals type' -dualGuard' :: DualMappings -> Guard -> ExceptT (Either Type Exp) Q Guard+dualGuard' :: DualMappings -> Guard -> ExceptT (Either TH.Type TH.Exp) Q Guard dualGuard' db = \case   NormalG e -> NormalG <$> dualExp' db e-  PatG ss   -> PatG <$> traverse (dualStmt' db) ss+  PatG ss -> PatG <$> traverse (dualStmt' db) ss -dualDec' :: DualMappings -> Dec -> ExceptT (Either Type Exp) Q Dec-dualDec' db = pure+dualDec' :: DualMappings -> TH.Dec -> ExceptT (Either TH.Type TH.Exp) Q TH.Dec+dualDec' _db = pure -dualPat' :: DualMappings -> Pat -> ExceptT (Either Type Exp) Q Pat+dualPat' :: DualMappings -> TH.Pat -> ExceptT (Either TH.Type TH.Exp) Q TH.Pat dualPat' db = \case-  LitP l -> pure $ LitP l-  VarP n -> pure $ VarP n-  TupP ps -> TupP <$> traverse (dualPat' db) ps -- FIXME: should also Either?-  -- UnboxedTupP [Pat]-  -- UnboxedSumP Pat SumAlt SumArity-  x -> lift . fail $ "unhandled pattern " ++ show x-  -- ConP Name [Pat]-  -- InfixP Pat Name Pat-  -- UInfixP Pat Name Pat-  -- ParensP Pat-  -- TildeP Pat-  -- BangP Pat-  -- AsP Name Pat-  -- WildP-  -- RecP Name [FieldPat]-  -- ListP [Pat]-  -- SigP Pat Type-  -- ViewP Exp Pat+  TH.LitP l -> pure $ TH.LitP l+  TH.VarP n -> pure $ TH.VarP n+  TH.TupP ps -> TH.TupP <$> traverse (dualPat' db) ps -- FIXME: should also Either?+  p@(TH.UnboxedTupP _ps) -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.UnboxedSumP _p _a _a') -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.InfixP _p _n _p') -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.UInfixP _p _n _p') -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.ParensP _p) -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.TildeP _p) -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.BangP _p) -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.AsP _n _p) -> lift . fail $ "unhandled pattern " <> show p+  p@TH.WildP -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.RecP _n _fps) -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.ListP _ps) -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.SigP _p _t) -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.ViewP _e _p) -> lift . fail $ "unhandled pattern " <> show p+#if MIN_VERSION_template_haskell(2, 22, 0)+  p@(TH.TypeP _t) -> lift . fail $ "unhandled pattern " <> show p+  p@(TH.InvisP _t) -> lift . fail $ "unhandled pattern " <> show p+#endif+#if MIN_VERSION_template_haskell(2, 18, 0)+  p@(TH.ConP _n _ts _ps) -> lift . fail $ "unhandled pattern " <> show p+#else+  p@(TH.ConP _n _ps) -> lift . fail $ "unhandled pattern " <> show p+#endif -dualBody' :: DualMappings -> Body -> ExceptT (Either Type Exp) Q Body+dualBody' :: DualMappings -> Body -> ExceptT (Either TH.Type TH.Exp) Q Body dualBody' db = \case   GuardedB xs ->     GuardedB <$> traverse (bisequence . (dualGuard' db *** dualExp' db)) xs   NormalB e -> NormalB <$> dualExp' db e -dualMatch' :: DualMappings -> Match -> ExceptT (Either Type Exp) Q Match+dualMatch' :: DualMappings -> Match -> ExceptT (Either TH.Type TH.Exp) Q Match dualMatch' db (Match p b ds) =   Match <$> dualPat' db p <*> dualBody' db b <*> traverse (dualDec' db) ds -dualExp' :: DualMappings -> Exp -> ExceptT (Either Type Exp) Q Exp+dualExp' :: DualMappings -> TH.Exp -> ExceptT (Either TH.Type TH.Exp) Q TH.Exp dualExp' db = \case-  v@(VarE n) ->+  v@(TH.VarE n) ->     ExceptT . recover (pure $ pure v) . runExceptT $ dualExpName db n-  ConE n -> dualExpName db n-  l@(LitE _) -> pure l-  AppE a b -> AppE <$> dualExp' db a <*> dualExp' db b-  -- AppTypeE e t -> AppTypeE <$> dualExp' db e <*> dualType' (_dualTypes db) t-  InfixE a o b ->-    InfixE-    <$> traverse (dualExp' db) a-    <*> dualExp' db o-    <*> traverse (dualExp' db) b-  UInfixE a o b -> UInfixE <$> dualExp' db a <*> dualExp' db o <*> dualExp' db b-  ParensE e -> ParensE <$> dualExp' db e-  LamE p e -> LamE p <$> dualExp' db e-  LamCaseE matches -> LamCaseE <$> traverse (dualMatch' db) matches-  TupE es -> TupE <$> traverse (dualExp' db) es -- FIXME: Doesn’t seem right.-  UnboxedTupE es -> UnboxedTupE <$> traverse (dualExp' db) es-  -- UnboxedSumE e alt ar ->-  --   UnboxedTupE <$> traverse (dualExp' db) es <*> pure alt <*> pure ar-  CondE t c a -> CondE <$> dualExp' db t <*> dualExp' db c <*> dualExp' db a-  MultiIfE cases ->-    MultiIfE <$> traverse (bisequence . (dualGuard' db *** dualExp' db)) cases-  LetE ds e -> LetE <$> traverse (dualDec' db) ds <*> dualExp' db e-  CaseE e ms -> CaseE <$> dualExp' db e <*> traverse (dualMatch' db) ms-  DoE ss -> DoE <$> traverse (dualStmt' db) ss-  CompE ss -> CompE <$> traverse (dualStmt' db) ss-  ArithSeqE r -> pure $ ArithSeqE r-  ListE es -> ListE <$> traverse (dualExp' db) es-  SigE e t -> SigE <$> dualExp' db e <*> withExceptT Left (dualType' (_dualTypes db) t)-  e@(RecConE _ _) -> throwE $ Right e-  e@(RecUpdE _ _) -> throwE $ Right e-  StaticE e -> StaticE <$> dualExp' db e-  UnboundVarE n -> pure $ UnboundVarE n+  TH.ConE n -> dualExpName db n+  l@(TH.LitE _) -> pure l+  TH.AppE a b -> TH.AppE <$> dualExp' db a <*> dualExp' db b+  TH.AppTypeE e t ->+    TH.AppTypeE+      <$> dualExp' db e+      <*> withExceptT Left (dualType' (_dualTypes db) t)+  TH.InfixE a o b ->+    TH.InfixE+      <$> traverse (dualExp' db) a+      <*> dualExp' db o+      <*> traverse (dualExp' db) b+  TH.UInfixE a o b ->+    TH.UInfixE <$> dualExp' db a <*> dualExp' db o <*> dualExp' db b+  TH.ParensE e -> TH.ParensE <$> dualExp' db e+  TH.LamE p e -> TH.LamE p <$> dualExp' db e+  TH.LamCaseE matches -> TH.LamCaseE <$> traverse (dualMatch' db) matches+  TH.TupE es -> TH.TupE <$> traverse (traverse $ dualExp' db) es -- FIXME: Doesn’t seem right.+  TH.UnboxedTupE es -> TH.UnboxedTupE <$> traverse (traverse $ dualExp' db) es+  TH.UnboxedSumE e alt ar ->+    TH.UnboxedSumE <$> dualExp' db e <*> pure alt <*> pure ar+  TH.CondE t c a ->+    TH.CondE <$> dualExp' db t <*> dualExp' db c <*> dualExp' db a+  TH.MultiIfE cases ->+    TH.MultiIfE+      <$> traverse (bisequence . (dualGuard' db *** dualExp' db)) cases+  TH.LetE ds e -> TH.LetE <$> traverse (dualDec' db) ds <*> dualExp' db e+  TH.CaseE e ms -> TH.CaseE <$> dualExp' db e <*> traverse (dualMatch' db) ms+  TH.CompE ss -> TH.CompE <$> traverse (dualStmt' db) ss+  TH.ArithSeqE r -> pure $ TH.ArithSeqE r+  TH.ListE es -> TH.ListE <$> traverse (dualExp' db) es+  TH.SigE e t ->+    TH.SigE <$> dualExp' db e <*> withExceptT Left (dualType' (_dualTypes db) t)+  e@(TH.RecConE _ _) -> throwE $ Right e+  e@(TH.RecUpdE _ _) -> throwE $ Right e+  TH.StaticE e -> TH.StaticE <$> dualExp' db e+  TH.UnboundVarE n -> pure $ TH.UnboundVarE n+  TH.LabelE l -> pure $ TH.LabelE l+  TH.ImplicitParamVarE n -> pure $ TH.ImplicitParamVarE n+#if MIN_VERSION_template_haskell(2, 22, 0)+  e@(TH.TypeE _) -> throwE $ Right e+#endif+#if MIN_VERSION_template_haskell(2, 21, 0)+  e@(TH.TypedBracketE _) -> throwE $ Right e+  e@(TH.TypedSpliceE _) -> throwE $ Right e+#endif+#if MIN_VERSION_template_haskell(2, 19, 0)+  TH.LamCasesE cs -> TH.LamCasesE <$> traverse (dualClause' db) cs+#endif+#if MIN_VERSION_template_haskell(2, 18, 0)+  TH.GetFieldE e f -> TH.GetFieldE <$> dualExp' db e <*> pure f+  TH.ProjectionE fs -> pure $ TH.ProjectionE fs+#endif+#if MIN_VERSION_template_haskell(2, 17, 0)+  TH.DoE m ss -> TH.DoE m <$> traverse (dualStmt' db) ss+  TH.MDoE m ss -> TH.MDoE m <$> traverse (dualStmt' db) ss+#else+  TH.DoE ss -> TH.DoE <$> traverse (dualStmt' db) ss+  TH.MDoE ss -> TH.MDoE <$> traverse (dualStmt' db) ss+#endif -dualClause' :: DualMappings -> Clause -> ExceptT (Either Type Exp) Q Clause+dualClause' :: DualMappings -> Clause -> ExceptT (Either TH.Type TH.Exp) Q Clause dualClause' db (Clause ps b ds) =   Clause-  <$> traverse (dualPat' db) ps-  <*> dualBody' db b-  <*> traverse (dualDec' db) ds+    <$> traverse (dualPat' db) ps+    <*> dualBody' db b+    <*> traverse (dualDec' db) ds -dualStmt' :: DualMappings -> Stmt -> ExceptT (Either Type Exp) Q Stmt+dualStmt' :: DualMappings -> TH.Stmt -> ExceptT (Either TH.Type TH.Exp) Q TH.Stmt dualStmt' db = \case-  BindS p e -> BindS <$> dualPat' db p <*> dualExp' db e-  LetS ds -> LetS <$> traverse (dualDec' db) ds-  NoBindS e -> NoBindS <$> dualExp' db e-  ParS sss -> ParS <$> traverse (traverse (dualStmt' db)) sss+  TH.BindS p e -> TH.BindS <$> dualPat' db p <*> dualExp' db e+  TH.LetS ds -> TH.LetS <$> traverse (dualDec' db) ds+  TH.NoBindS e -> TH.NoBindS <$> dualExp' db e+  TH.ParS sss -> TH.ParS <$> traverse (traverse (dualStmt' db)) sss+  TH.RecS ss -> TH.RecS <$> traverse (dualStmt' db) ss -handleMissingDual :: ExceptT (Either Type Exp) Q a -> Q a+handleMissingDual :: ExceptT (Either TH.Type TH.Exp) Q a -> Q a handleMissingDual =-  exceptT (\t -> fail $ "no dual for " ++ either (\t -> "type " ++ show t) (\e -> "expression " ++ show e) t)-          pure+  exceptT+    ( fail+        . ("no dual for " <>)+        . either (("type " <>) . show) (("expression " <>) . show)+    )+    pure  -- | Convert an expression to its dual (i.e., an implementation for the dual --   of the input expression’s type)-dualExp :: Exp -> Q Exp+dualExp :: TH.Exp -> Q TH.Exp dualExp exp = do   duals <- retrieveDuals   handleMissingDual $ dualExp' duals exp  -- | Indicates that some name represents the dual of itself (e.g., `Functor`).-labelSelfDual :: Name -> Q [Dec]+labelSelfDual :: Name -> Q [a] labelSelfDual name = do   duals <- retrieveDuals   a <- fromName name-  putQ-    $ andMaybe (\t -> duals & dualTypes %~ Map.insert name t)-               (\_ e -> duals & dualValues %~ Map.insert name e)-               a-  pure []+  []+    <$ putQ+      ( andMaybe+          (\t -> duals & dualTypes %~ Map.insert name t)+          (\_ e -> duals & dualValues %~ Map.insert name e)+          a+      )  -- | This provides a mapping one way, but not the other. Useful for aliased --   functions (`return`) and overconstrained versions (e.g., mapping --  `traverse ↔ distribute` but also `mapM → distribute`).-labelSemiDual :: Name -> Name -> Q [Dec]+labelSemiDual :: Name -> Name -> Q [a] labelSemiDual name coname = do   duals <- retrieveDuals   a <- fromName name   b <- fromName coname-  case (a, b) of-    (Only _,     Only t)     -> putQ $ duals & dualTypes %~ Map.insert name t+  [] <$ case (a, b) of+    (Only _, Only t) -> putQ $ duals & dualTypes %~ Map.insert name t     (Indeed _ _, Indeed _ e) -> putQ $ duals & dualValues %~ Map.insert name e-    (_,          _)          -> fail $ show name ++ " and " ++ show coname ++ "are not in the same namespace: " ++ show a ++ " " ++ show b-  pure []+    (_, _) ->+      fail $+        show name+          <> " and "+          <> show coname+          <> "are not in the same namespace: "+          <> show a+          <> " "+          <> show b -labelDualDataT :: Name -> Name -> Type -> Type -> Q [Dec]+labelDualDataT :: Name -> Name -> TH.Type -> TH.Type -> Q [a] labelDualDataT name coname type' cotype' = do   duals <- retrieveDuals-  pure [] <* (putQ $ duals & dualTypes %~ (Map.insert coname type' . Map.insert name cotype'))+  [] <$ putQ (duals & dualTypes %~ (Map.insert coname type' . Map.insert name cotype')) -addDualExp :: Name -> Name -> Exp -> Exp -> Q DualMappings+addDualExp :: Name -> Name -> TH.Exp -> TH.Exp -> Q DualMappings addDualExp name coname exp' coexp' = do   duals <- retrieveDuals   pure $ duals & dualValues %~ (Map.insert coname exp' . Map.insert name coexp') -labelDualExpT :: Name -> Name -> Exp -> Exp -> Q [Dec]+labelDualExpT :: Name -> Name -> TH.Exp -> TH.Exp -> Q [a] labelDualExpT name coname exp' coexp' = do   duals <- retrieveDuals-  pure [] <* (putQ $ duals & dualValues %~ (Map.insert coname exp' . Map.insert name coexp'))+  [] <$ putQ (duals & dualValues %~ (Map.insert coname exp' . Map.insert name coexp'))  -- | Indicate that two names are duals of each other.-labelDual :: Name -> Name -> Q [Dec]+labelDual :: Name -> Name -> Q [TH.Dec] labelDual name coname = do   a <- fromName name   b <- fromName coname   case (a, b) of-    (Only a,     Only b)     -> labelDualDataT name coname a b-    (Indeed _ a, Indeed _ b) -> labelDualExpT name coname a b-    (_,          _)          -> fail $ show name ++ " and " ++ show coname ++ "are not in the same namespace: " ++ show a ++ " " ++ show b+    (Only a', Only b') -> labelDualDataT name coname a' b'+    (Indeed _ a', Indeed _ b') -> labelDualExpT name coname a' b'+    (_, _) ->+      fail $+        show name+          <> " and "+          <> show coname+          <> "are not in the same namespace: "+          <> show a+          <> " "+          <> show b -stripForall :: Type -> Type-stripForall (ForallT _ _ t) = t-stripForall t               = t+stripForall :: TH.Type -> TH.Type+stripForall (TH.ForallT _ _ t) = t+stripForall t = t  -- | Given a class, creates a new class that represents its dual, with the list --   containing name mappings of methods to their duals.-makeDualClass :: Name -> String -> [(Name, String)] -> Q [Dec]+makeDualClass :: Name -> String -> [(Name, String)] -> Q [TH.Dec] makeDualClass name co methods = do   let coname = mkName co   info <- reify name   type' <- typeFromName name   case info of-    ClassI (ClassD ctx _ tVars fds _) _ -> do-      ctx' <- traverse dualType ctx-      meths' <- traverse (sequenceA . (mkName *** ((dualType . stripForall) <=< typeFromName)) . swap) methods-      labelDualDataT name coname type' (ConT coname)-      pure [ClassD ctx' coname tVars fds (fmap (uncurry SigD) meths')]+    TH.ClassI (TH.ClassD ctx _ tVars fds _) _ -> do+      ctx' <- nub <$> traverse dualType ctx+      meths' <-+        traverse+          ( sequenceA+              . (mkName *** ((dualType . stripForall) <=< typeFromName))+              . swap+          )+          methods+      (TH.ClassD ctx' coname tVars fds (fmap (uncurry TH.SigD) meths') :)+        <$> labelDualDataT name coname type' (TH.ConT coname)     _ -> fail "not a type class" -makeDualExp :: String -> Q Type -> Q Exp -> String -> Q [Dec]+makeDualExp :: String -> Q TH.Type -> Q TH.Exp -> String -> Q [TH.Dec] makeDualExp str type' exp' costr = do   let name = mkName str       coname = mkName costr -  sequence [ SigD name <$> type'-           , ValD (VarP name) <$> (NormalB <$> exp') <*> pure []-           , SigD coname <$> (dualType =<< type')-           , ValD (VarP coname) <$> (NormalB <$> (dualExp =<< exp')) <*> pure []]+  sequenceA+    [ TH.SigD name <$> type',+      TH.ValD (TH.VarP name) <$> (NormalB <$> exp') <*> pure [],+      TH.SigD coname <$> (dualType =<< type'),+      TH.ValD (TH.VarP coname) <$> (NormalB <$> (dualExp =<< exp')) <*> pure []+    ]  -- | Creates a value that can be referenced in other modules to load the duals --   defined in this module. Should be used at the bottom of any module that --   uses this module.-exportDuals :: String -> Q [Dec]+exportDuals :: String -> Q [TH.Dec] exportDuals name = do+  typ <- [t|Q DualMappings|]   exp <- reifyDuals =<< retrieveDuals-  pure [ValD (VarP $ mkName name) (NormalB exp) []]+  let name' = mkName name+  pure+    [ TH.SigD name' typ,+      TH.ValD (TH.VarP name') (NormalB exp) []+    ]  -- | Imports duals from other modules via the var created by `exportDuals` in --   that other module.-importDuals :: Q DualMappings -> Q [Dec]+importDuals :: Q DualMappings -> Q [a] importDuals duals = do   oldDuals <- getQ   newDuals <- duals-  putQ $ maybe newDuals (mappend newDuals) oldDuals-  pure []--errorNewName :: Name -> Q a-errorNewName n = fail $ "declaration introduces a new name: " ++ show n+  [] <$ putQ (maybe newDuals (newDuals <>) oldDuals)  errorMultipleNewNames :: Name -> Q a errorMultipleNewNames n =-  fail $ "declaration introduces multiple new names: " ++ show n+  fail $ "declaration introduces multiple new names: " <> show n  errorNoNewName :: Q a errorNoNewName = fail "declaration doesn’t introduce a new name" -dualCon' :: Map Name Type -> Name -> Con -> ExceptT Type Q Con+dualCon' :: Map Name TH.Type -> Name -> Con -> ExceptT TH.Type Q Con dualCon' db coname = \case   NormalC _ bts -> NormalC coname <$> traverse (traverse $ dualType' db) bts   -- TODO: Probably want to dualize field names, too.-  RecC _ vbts -> RecC coname <$> traverse (\(a, b, c) -> fmap (a, b, ) $ dualType' db c) vbts+  RecC _ vbts -> RecC coname <$> traverse (\(a, b, c) -> fmap (a,b,) $ dualType' db c) vbts   InfixC bt _ bt' ->     InfixC-    <$> traverse (dualType' db) bt-    <*> pure coname-    <*> traverse (dualType' db) bt'+      <$> traverse (dualType' db) bt+      <*> pure coname+      <*> traverse (dualType' db) bt'   ForallC tvbs cx cn ->     ForallC tvbs <$> traverse (dualType' db) cx <*> dualCon' db coname cn-  GadtC ns bts t -> undefined -- how do we handle the multiple names here-  RecGadtC ns vbts t -> undefined -- and here?--dualTySynEqn' :: Map Name Type -> TySynEqn -> ExceptT Type Q TySynEqn-dualTySynEqn' db (TySynEqn ts t) =-  TySynEqn <$> traverse (dualType' db) ts <*> dualType' db t+  GadtC _ns _bts _t -> undefined -- how do we handle the multiple names here+  RecGadtC _ns _vbts _t -> undefined -- and here? +dualTySynEqn' :: Map Name TH.Type -> TySynEqn -> ExceptT TH.Type Q TySynEqn+dualTySynEqn' db (TySynEqn bs t t') =+  TySynEqn bs <$> dualType' db t <*> dualType' db t' -dualizeDec :: DualMappings -> Name -> Dec -> Q [Dec]+dualizeDec :: DualMappings -> Name -> TH.Dec -> Q [TH.Dec] dualizeDec db coname d =-  handleMissingDual-  $ (\c -> [d, c])-  <$> case d of-        FunD n cs -> do-          newMap <- lift $ addDualExp n coname (VarE n) (VarE coname)-          FunD coname <$> traverse (dualClause' newMap) cs-        -- TODO: Handle other vals-        ValD (VarP n) b ds -> do-          newMap <- lift $ addDualExp n coname (VarE n) (VarE coname)-          ValD (VarP coname)-            <$> dualBody' newMap b-            <*> traverse (dualDec' newMap) ds-        DataD cx n tvbs k [cn] dcs ->-          withExceptT Left-          $ DataD-          <$> traverse (dualType' (_dualTypes db)) cx-          <*> pure coname-          <*> pure tvbs-          <*> pure k-          <*> ((: []) <$> dualCon' (_dualTypes db) coname cn)-          <*> pure dcs -- Should actually dualize this-        DataD _ n _ _ _ _ -> lift $ errorMultipleNewNames n-        NewtypeD cx n tvbs k cn dcs ->-          withExceptT Left-          $ NewtypeD-          <$> traverse (dualType' (_dualTypes db)) cx-          <*> pure coname-          <*> pure tvbs-          <*> pure k-          <*> dualCon' (_dualTypes db) coname cn-          <*> pure dcs -- Should actually dualize this-        TySynD _ tvbs t ->-          TySynD coname tvbs <$> withExceptT Left (dualType' (_dualTypes db) t)-        SigD _ t -> SigD coname <$> withExceptT Left (dualType' (_dualTypes db) t)-        DataFamilyD _ tvbs k -> pure $ DataFamilyD coname tvbs k-        OpenTypeFamilyD (TypeFamilyHead n tvbs frs ia) ->-          pure . OpenTypeFamilyD $ TypeFamilyHead coname tvbs frs ia-        ClosedTypeFamilyD (TypeFamilyHead n tvbs frs ia) tses ->-          ClosedTypeFamilyD (TypeFamilyHead coname tvbs frs ia)-          <$> withExceptT Left (traverse (dualTySynEqn' $ _dualTypes db) tses)-        _ -> lift $ errorNoNewName+  handleMissingDual $ (d :) . pure <$> dualizeDec' db coname d +dualizeDec' ::+  DualMappings -> Name -> TH.Dec -> ExceptT (Either TH.Type TH.Exp) Q TH.Dec+dualizeDec' db coname = \case+  TH.FunD n cs -> do+    newMap <- lift $ addDualExp n coname (TH.VarE n) (TH.VarE coname)+    TH.FunD coname <$> traverse (dualClause' newMap) cs+  -- TODO: Handle other vals+  TH.ValD (TH.VarP n) b ds -> do+    newMap <- lift $ addDualExp n coname (TH.VarE n) (TH.VarE coname)+    TH.ValD (TH.VarP coname)+      <$> dualBody' newMap b+      <*> traverse (dualDec' newMap) ds+  TH.ValD {} -> lift errorNoNewName+  TH.DataD cx _n tvbs k [cn] dcs ->+    withExceptT Left $+      TH.DataD+        <$> traverse (dualType' (_dualTypes db)) cx+        <*> pure coname+        <*> pure tvbs+        <*> pure k+        <*> ((: []) <$> dualCon' (_dualTypes db) coname cn)+        <*> pure dcs -- Should actually dualize this+  TH.DataD _ n _ _ _ _ -> lift $ errorMultipleNewNames n+  TH.NewtypeD cx _n tvbs k cn dcs ->+    withExceptT Left $+      TH.NewtypeD+        <$> traverse (dualType' (_dualTypes db)) cx+        <*> pure coname+        <*> pure tvbs+        <*> pure k+        <*> dualCon' (_dualTypes db) coname cn+        <*> pure dcs -- Should actually dualize this+  TH.TySynD _ tvbs t ->+    TH.TySynD coname tvbs <$> withExceptT Left (dualType' (_dualTypes db) t)+  TH.ClassD {} -> lift errorNoNewName+  TH.InstanceD {} -> lift errorNoNewName+  TH.SigD _ t -> TH.SigD coname <$> withExceptT Left (dualType' (_dualTypes db) t)+  TH.KiSigD {} -> lift errorNoNewName+  TH.ForeignD {} -> lift errorNoNewName+  TH.InfixD {} -> lift errorNoNewName+  TH.PragmaD {} -> lift errorNoNewName+  TH.DataFamilyD _ tvbs k -> pure $ TH.DataFamilyD coname tvbs k+  TH.DataInstD {} -> lift errorNoNewName+  TH.NewtypeInstD {} -> lift errorNoNewName+  TH.TySynInstD {} -> lift errorNoNewName+  TH.OpenTypeFamilyD (TypeFamilyHead _n tvbs frs ia) ->+    pure . TH.OpenTypeFamilyD $ TypeFamilyHead coname tvbs frs ia+  TH.ClosedTypeFamilyD (TypeFamilyHead _n tvbs frs ia) tses ->+    TH.ClosedTypeFamilyD (TypeFamilyHead coname tvbs frs ia)+      <$> withExceptT Left (traverse (dualTySynEqn' $ _dualTypes db) tses)+  TH.RoleAnnotD {} -> lift errorNoNewName+  TH.StandaloneDerivD {} -> lift errorNoNewName+  TH.DefaultSigD {} -> lift errorNoNewName+  TH.PatSynD {} -> lift errorNoNewName+  TH.PatSynSigD {} -> lift errorNoNewName+  TH.ImplicitParamBindD {} -> lift errorNoNewName+#if MIN_VERSION_template_haskell(2, 20, 0)+  TH.TypeDataD {} -> lift errorNoNewName+#endif+#if MIN_VERSION_template_haskell(2, 19, 0)+  TH.DefaultD {} -> lift errorNoNewName+#endif+ -- | Creates both the original declaration and its dual. Should only work for --   declarations that introduce exactly one top-level name.-makeDualDec :: Q [Dec] -> String -> Q [Dec]+makeDualDec :: Q [TH.Dec] -> String -> Q [TH.Dec] makeDualDec decs co = do   let coname = mkName co   db <- retrieveDuals

@@ -1,13 +1,34 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE Unsafe #-}  -- | Dual mappings for types in 'base'.-module Categorical.Dual.Base where+module Categorical.Dual.Base+  ( baseDuals,+  )+where -import Prelude hiding (id) import Categorical.Dual-import Categorical.Dual.Prelude-import Control.Arrow-import Control.Category+  ( exportDuals,+    importDuals,+    labelDual,+    labelSelfDual,+    labelSemiDual,+  )+import Categorical.Dual.Prelude (preludeDuals)+import safe Control.Arrow+  ( Arrow,+    arr,+    returnA,+    (&&&),+    (***),+    (+++),+    (<<<),+    (>>>),+    (|||),+  )+import safe Control.Category (Category)+import safe Control.Category qualified as Category+import safe Prelude qualified  importDuals preludeDuals @@ -18,9 +39,10 @@ labelSelfDual 'returnA  labelSelfDual ''Category-labelSelfDual 'id+labelSelfDual 'Prelude.id+labelSelfDual 'Category.id labelSemiDual '(Prelude..) '(>>>)-labelSemiDual '(Control.Category..) '(>>>)+labelSemiDual '(Category..) '(>>>) labelDual '(<<<) '(>>>)  -- | Duals for 'base'.

@@ -1,44 +1,89 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE UndecidableSuperClasses #-}+{-# LANGUAGE Unsafe #-}+-- to allow hlint annotations+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{- ORMOLU_DISABLE -}+{- because it can’t handle CPP within a declaration -} -- | This should be tests, but if you look for the source of this module, --   you’ll see how to use the package. module Categorical.Dual.Example-  -- explicit exports to hide some things that break Haddock-  ( Coapplicative (..)-  , Comonad (..)-  , Distributive (..)-  , consume-  , Algebra, Coalgebra-  , GAlgebra, GCoalgebra-  , ElgotAlgebra, ElgotCoalgebra-  , NewEither (..), NewTuple (..)-  , NewEither' (..), NewTuple' (..)-  , TestA, DualA-  , TestB, DualB-  , TestC, DualC-  , (>^>), (<^<)-  , Mu (..), Nu (..)-  , Fix (..)-  , cata, ana-  , exampleDuals) where+  ( Coapplicative (..),+    Comonad (..),+    Distributive (..),+    consume,+    Algebra,+    Coalgebra,+    GAlgebra,+    GCoalgebra,+    ElgotAlgebra,+    ElgotCoalgebra,+    NewEither (..),+    NewTuple (..),+    NewEither' (..),+    NewTuple' (..),+    TestA,+    DualA,+    TestB,+    DualB,+    (>^>),+    (<^<),+    Mu (..),+    Nu (..),+    Fix (..),+    cata,+    ana,+    exampleDuals,+    testF,+    testT,+    testV,+    testV',+    testQ,+  )+where+{- ORMOLU_ENABLE -}  import Categorical.Dual-import Categorical.Dual.Base-import Categorical.Dual.Lens-import Control.Arrow-import Data.Char-import Data.Void+  ( dualType,+    exportDuals,+    importDuals,+    labelDual,+    labelSelfDual,+    labelSemiDual,+    makeDualClass,+    makeDualDec,+  )+import Categorical.Dual.Base (baseDuals)+import Categorical.Dual.Lens (lensDuals)+import safe Control.Applicative (Applicative, pure)+import safe Control.Arrow ((>>>))+import safe Control.Category ((.))+import safe Control.Monad (Monad, (=<<), (>>=))+import safe Data.Bool (Bool)+import safe Data.Char (Char, ord)+import safe Data.Either (Either (Right))+import safe Data.Foldable (Foldable)+import safe Data.Function (($))+import safe Data.Functor (Functor, fmap)+import safe Data.Int (Int)+import safe Data.Traversable (Traversable)+import safe Data.Traversable qualified as T+import safe Data.Void (Void)+import safe Prelude (undefined) +-- hlint sees some $() splices as redundant brackets+{-# HLINT ignore "Redundant bracket" #-}+ importDuals baseDuals importDuals lensDuals  -- TODO: this is much uglier than type families testF :: $(dualType =<< [t|Int -> Char|])-testF = Data.Char.ord+testF = ord  testT :: $(dualType =<< [t|Either Int Char|]) testT = (7, 'a')@@ -54,21 +99,20 @@  -- These are done as separate dual mappings (rather than something like `labelDualClass`) to ease a lot of the issues with not-quite dual constructions. -- labelDual ''Monad ''Comonad -- `fail` has no dual, so it’ll fail to convert if-                            -- that method is hit, but not otherwise.+-- that method is hit, but not otherwise. -- labelDual 'pure   'extract -- these operations exist in different classes -- labelSemiDual 'return 'extract -- only maps one way, hopefully using some other-                               -- mapping for the other direction, good for-                               -- aliases, especially overconstrained ones.+-- mapping for the other direction, good for+-- aliases, especially overconstrained ones. -- labelDual '(>>=) '(=>>) -- labelDual 'join 'duplicate -- the latter is a class method, but the former is a-                           -- function+-- function  -- | This should get mapped to the newly created class … right? makeDualClass ''Applicative "Coapplicative" [('pure, "extract")]  -- | This should get mapped to the newly created class … right?-makeDualClass ''Monad "Comonad" [('(>>=) , "=>>")]-+makeDualClass ''Monad "Comonad" [('(>>=), "=>>")]  -- FIXME: These semi-duals can be dangerous. It’s fine for overconstrained --        mappings (like `mapM` -> `traverse`), but in cases like `Foldable` and@@ -77,16 +121,16 @@ --        be too weak. labelSemiDual ''Foldable ''Functor ---- | Because `Foldable` is semi-dual to `Functor` (which isn’t safe), we end---   up with a duplicate `Functor` constraint here.-makeDualClass ''Traversable "Distributive"-  [ ('traverse, "cotraverse")-  , ('sequenceA, "distribute")]+makeDualClass+  ''Traversable+  "Distributive"+  [ ('T.traverse, "cotraverse"),+    ('T.sequenceA, "distribute")+  ]  -- TODO: Doesn’t really belong here, but is the dual to `collect`. consume :: (Traversable g, Applicative f) => (g b -> a) -> g (f b) -> f a-consume f = fmap f . sequenceA+consume f = fmap f . T.sequenceA  -- labelSemiDual 'return 'extract @@ -96,42 +140,54 @@ -- makeDualValue '(<=<) '(=<=)  -- | Sometimes the doc is mapped to the original.-makeDualDec [d|type Algebra f a = f a -> a|]            "Coalgebra"+makeDualDec [d|type Algebra f a = f a -> a|] "Coalgebra"+ -- | Other times, to the dual.-makeDualDec [d|type GAlgebra w f a = f (w a) -> a|]     "GCoalgebra"+makeDualDec [d|type GAlgebra w f a = f (w a) -> a|] "GCoalgebra"+ -- | I’m not sure why one or the other happens. makeDualDec [d|type ElgotAlgebra w f a = w (f a) -> a|] "ElgotCoalgebra"  makeDualDec [d|newtype NewEither a b = NewEither (Either a b)|] "NewTuple" makeDualDec [d|data NewEither' a b = NewEither' (Either a b)|] "NewTuple'"+ -- FIXME: doesn’t terminate -- makeDualDec [d|data Mu f = Mu (forall a. Algebra f a -> a)|] "NotNu"  -- | I wonder if-makeDualDec [d|data family TestA a|] "DualA"+makeDualDec [d|data family TestA a |] "DualA"+ -- | This always-makeDualDec [d|type family TestB a|] "DualB"--- | Happens.-makeDualDec-  [d| type family TestC a where-        TestC (Either b c) = b-        TestC Int = Char |]-  "DualC"+makeDualDec [d|type family TestB a |] "DualB" +-- FIXME: Complains “‘TestC_0’ is not in scope at a reify”+-- -- | Happens.+-- makeDualDec+--   [d| type family TestC a where+--         TestC (Either b _c) = b+--         TestC Int = Char |]+--   "DualC"+ -- | These docs are going to end up on `<^<`, which is not what I’d expect. makeDualDec-  [d| (>^>) :: (a -> b) -> (b -> c) -> a -> c-      (>^>) = (>>>) |]+  [d|+    (>^>) :: (a -> b) -> (b -> c) -> a -> c+    (>^>) = (>>>)+    |]   "<^<"+ -- withDual [d| { infix 3 >^> } |]  labelSelfDual '($) -data Mu f = Mu (forall a. Algebra f a -> a)+newtype Mu f = Mu (forall a. Algebra f a -> a)+ data Nu f where Nu :: Coalgebra f a -> a -> Nu f+ labelDual ''Mu ''Nu -data Fix f = Fix { unfix :: f (Fix f) }+newtype Fix f = Fix {unfix :: f (Fix f)}+ labelSelfDual ''Fix -- not really labelDual 'Fix 'unfix @@ -139,8 +195,10 @@ --   added to the dual, not the explicitly-defined name. I don’t know why this --   behaves differently than the other cases. makeDualDec-  [d| cata :: Functor f => (f a -> a) -> Fix f -> a-      cata f = f . fmap (cata f) . unfix |]+  [d|+    cata :: (Functor f) => (f a -> a) -> Fix f -> a+    cata f = f . fmap (cata f) . unfix+    |]   "ana"  -- | Duals for this module.

@@ -1,11 +1,15 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE Unsafe #-}  -- | Dual mappings for types in 'lens'.-module Categorical.Dual.Lens where+module Categorical.Dual.Lens+  ( lensDuals,+  )+where -import Categorical.Dual-import Categorical.Dual.Prelude-import Control.Lens+import Categorical.Dual (exportDuals, importDuals, labelDual, labelSelfDual)+import Categorical.Dual.Prelude (preludeDuals)+import safe Control.Lens (Equality, Iso, Lens, Prism, alongside, without)  importDuals preludeDuals 

@@ -1,9 +1,58 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE Unsafe #-}  -- | Dual mappings for types in the 'Prelude'.-module Categorical.Dual.Prelude where+module Categorical.Dual.Prelude+  ( preludeDuals,+  )+where  import Categorical.Dual+  ( emptyDuals,+    exportDuals,+    importDuals,+    labelDual,+    labelSelfDual,+  )+import safe Data.Bool (Bool, not, (&&), (||))+import safe Data.Char (Char)+import safe Data.Either (Either (Left, Right))+import safe Data.Eq (Eq, (/=), (==))+import safe Data.Function (const, id)+import safe Data.Functor (Functor, fmap, (<$), (<$>))+import safe Data.Int (Int)+import safe Data.List (map)+import safe Data.Ord (Ord, Ordering, max, min, (<), (<=), (>), (>=))+import safe Data.Ratio (Rational)+import safe Data.String (String)+import safe Data.Tuple (fst, snd)+import safe Data.Word (Word)+import safe System.IO+  ( IO,+    getChar,+    getLine,+    putChar,+    putStrLn,+    readFile,+    writeFile,+  )+import safe Text.Read (Read, read)+import safe Text.Show (Show, show)+import safe Prelude+  ( Bounded,+    Double,+    Enum,+    Float,+    Floating,+    Fractional,+    Integer,+    Integral,+    Num,+    Real,+    RealFrac,+    maxBound,+    minBound,+  )  importDuals emptyDuals @@ -73,6 +122,7 @@  labelSelfDual 'id labelSelfDual 'const+ -- labelSelfDual 'undefined  labelSelfDual 'map

@@ -0,0 +1,12 @@+{-# LANGUAGE Unsafe #-}++module Main (main) where++import safe "base" Data.Function (($))+import safe "base" Data.Semigroup (Semigroup ((<>)))+import safe "base" System.IO (IO)+import "doctest" Test.DocTest (doctest)+import "this" Build_doctests (flags, module_sources, pkgs)++main :: IO ()+main = doctest $ flags <> pkgs <> module_sources