generic-functor 0.2.0.0 → 1.0.0.0

raw patch · 10 files changed

+1371/−1311 lines, 10 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +23/−19
• LICENSE +19/−19
• README.md +209/−209
• Setup.hs +2/−2
• generic-functor.cabal +45/−44
• src/Generic/Functor.hs +47/−63
• src/Generic/Functor/Internal.hs +511/−511
• src/Generic/Functor/Internal/Implicit.hs +224/−224
• src/Generic/Functor/Multimap.hs +70/−0
• test/test.hs +221/−220

@@ -1,19 +1,23 @@-## 0.2.0.0
-
-- Add `gfoldMap`, `gtraverse`, `gbifoldMap`, `gbitraverse` `GFoldable`, `GFoldMap`, `GTraversable`, `GTraverse`, `GBiFoldable`, `GBifoldMap`, `GBitraversable`, `GBitraverse`
-- Rename `GBifunctor` to `GBimap`, and add new `GBifunctor` (class synonym for `GBimap`, `GFirst`, and `GSecond`)
-- Rename `DeriveFunctor` to `GenericFunctor`, and rename `DeriveBifunctor` to `GenericBifunctor`
-- Add instances for deriving-via `Foldable` and `Bifoldable`
-
-## 0.1.0.0
-
-- Add `gmultimap`, `multimap`, `(:+)`
-- Add `DeriveBifunctor`, `gbimap`, `gfirst`, `gsecond`
-
-## 0.0.1.1
-
-* Include README
-
-## 0.0.1.0
-
-* Create generic-functor
+## 1.0.0.0++- Split `Generic.Functor`, moving `gsolomap`, `solomap`, `gmultimap`, `multimap` to `Generic.Functor.Multimap`++## 0.2.0.0++- Add `gfoldMap`, `gtraverse`, `gbifoldMap`, `gbitraverse` `GFoldable`, `GFoldMap`, `GTraversable`, `GTraverse`, `GBiFoldable`, `GBifoldMap`, `GBitraversable`, `GBitraverse`+- Rename `GBifunctor` to `GBimap`, and add new `GBifunctor` (class synonym for `GBimap`, `GFirst`, and `GSecond`)+- Rename `DeriveFunctor` to `GenericFunctor`, and rename `DeriveBifunctor` to `GenericBifunctor`+- Add instances for deriving-via `Foldable` and `Bifoldable`++## 0.1.0.0++- Add `gmultimap`, `multimap`, `(:+)`+- Add `DeriveBifunctor`, `gbimap`, `gfirst`, `gsecond`++## 0.0.1.1++* Include README++## 0.0.1.0++* Create generic-functor

@@ -1,19 +1,19 @@-Copyright Li-yao Xia (c) 2020
-
-Permission is hereby granted, free of charge, to any person obtaining a copy of
-this software and associated documentation files (the “Software”), to deal in
-the Software without restriction, including without limitation the rights to
-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
-of the Software, and to permit persons to whom the Software is furnished to do
-so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.
+Copyright Li-yao Xia (c) 2020++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the “Software”), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -1,209 +1,209 @@-# Generic functors [![Hackage](https://img.shields.io/hackage/v/generic-functor.svg)](https://hackage.haskell.org/package/generic-functor) [![pipeline status](https://gitlab.com/lysxia/generic-functor/badges/main/pipeline.svg)](https://gitlab.com/lysxia/generic-functor/-/commits/main)
-
-
-Implementation of `Functor` instances and other functor-like structures
-using `GHC.Generics`.
-
-## Functors not over the last type parameter
-
-The standard `Functor` class only applies to types that are functors over their
-last type parameter. For example, in `Either e r`, `fmap` maps only `r`.
-
-Using this library, `fmap`-like functions can be derived over any type
-parameter of a `Generic` data type, all from the same definition `gsolomap`.
-
-```haskell
-{-# LANGUAGE DeriveGeneric #-}
-
-import GHC.Generics (Generic)
-import Generic.Functor (gsolomap)
-
-data Result a r = Error a | Ok r   -- Another name for Either
-  deriving Generic
-
-mapError :: (a -> b) -> Result a r -> Result b r
-mapError = gsolomap
-
--- This one is fmap
-mapOk :: (a -> b) -> Result e a -> Result e b
-mapOk = gsolomap
-
-mapBoth :: (a -> b) -> Result a a -> Result b b
-mapBoth = gsolomap
-```
-
-`gsolomap` is **unsafe**. Misuse will break your program.
-Read on for specifics.
-
-### Usage
-
-`gsolomap` should only be used to define **polymorphic** "`fmap`-like functions"
-for `Generic` types.
-
-The signature of `gsolomap` is:
-
-```haskell
-gsolomap :: (Generic x, Generic y, GSolomap a b x y) => (a -> b) -> (x -> y)
-```
-
-The types `x` and `y` must be specializations of the same user-defined `data`
-type which is an instance of `Generic`, with some type parameters equal to `a`
-or `b` respectively. At use sites of `gsolomap`, `a` and `b` must also be two
-distinct universally quantified type variables, with no equality constraint
-relating them with each other or any other type.
-
-The guarantee is that `gsolomap` satisfies `gsolomap id = id`. Under the
-condition that `a` and `b` are abstract, that equation uniquely determines the
-implementation. (That uniqueness claim may be broken with GADTs and other
-explicit uses of type equality constraints.)
-
-In particular, `gsolomap` *must not* be specialized with types `a` and `b` that
-are equal. A function defined using `gsolomap` is safe to specialize once
-the `GSolomap` constraint has been discharged.
-
-For instance the three functions above, `mapError`, `mapOk`, `mapBoth` are
-sufficiently polymorphic.
-They are each uniquely determined by their types and the equation `mapX id = id`.
-(Without that equation, `mapBoth` has four implementations of the same type.)
-
-## Compositions of functors
-
-How many `fmap` do you need to map a function `a -> b` over
-`(t, Maybe [Either Bool a])`?
-
-You only need one `solomap`:
-
-```haskell
-type F t a = (t, Maybe [Either Bool a])
-
-maps :: (a -> b) -> F t a -> F t b
-maps = solomap
-```
-
-`solomap` can also see through bifunctors and there may be more than
-one occurrence of the type parameter `a`.
-
-```haskell
-type F a = ([a], Either a ())
-
-maps2 :: (a -> b) -> F a -> F b
-maps2 = solomap
-```
-
-`solomap` is **unsafe**, subject to the same restrictions as `gsolomap`:
-where `solomap` is used, the type of its first argument `(a -> b)` must refer
-to two distinct universally quantified variables `a` and `b`.
-Functions are safe to specialize only once the `Solomap` constraint is out of
-their contexts.
-
-```haskell
-solomap :: Solomap a b x y => (a -> b) -> (x -> y)
-```
-
-## Functors of multiple parameters
-
-You can also map with more than one function simultaneously.
-For example with `a -> b` and `c -> d` over `(Maybe a, [(c, a)])`:
-
-```haskell
-type F a c = (Maybe a, [(c, a)])
-
-bimaps :: (a -> b) -> (c -> d) -> F a c -> F b d
-bimaps f g = multimap (f :+ g :+ ())
-```
-
-`multimap` takes a list of functions separated by `(:+)` and terminated by `()`.
-
-There is also a `gmultimap`, generalizing `gsolomap`.
-
-`gmultimap` and `multimap` are **unsafe**, similarly to `gsolomap` and `solomap`.
-
-## Deriving `Functor`
-
-This library enables `DerivingVia` for the `Functor` class.
-
-```haskell
-{-# LANGUAGE DeriveGeneric, DerivingVia #-}
-
-import GHC.Generics (Generic)
-import Generic.Functor (GenericFunctor(..))
-
-data Twice a = Twice (Either a a)
-  deriving Generic
-  deriving Functor via (GenericFunctor Twice)
-```
-
-Note that there is already built-in support for deriving `Functor` in GHC with the
-`DeriveFunctor` extension instead. If that extension ever chokes on a type, this
-library might have a chance at handling it. (Open an issue if it does not!)
-
-The `Twice` example just above is not handled by the `DeriveFunctor` extension:
-
-```haskell
-{-# LANGUAGE DeriveFunctor #-}
-
-data Twice a = Twice (Either a a) deriving Functor
-
-{-
-  error:
-    • Can't make a derived instance of ‘Functor Twice’:
-        Constructor ‘Twice’ must use the type variable only as the last argument of a data type
--}
-```
-
-The [*generic-data*][generic-data] library also includes a generic implementation of `Functor`,
-but only for instances of `Generic1`, which applies to much more restricted shapes
-of `data` than `Generic`.
-
-## Deriving `Bifunctor`
-
-Similarly, we can use `DerivingVia` for the `Bifunctor` class
-(from *base*, module `Data.Bifunctor`).
-
-```haskell
-{-# LANGUAGE DeriveGeneric, DerivingVia #-}
-
-import GHC.Generics (Generic)
-import Generic.Functor (GenericFunctor(..), GenericBifunctor(..))
-
-data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b
-  deriving Generic
-  deriving Functor via (GenericFunctor (Tree a))
-  deriving Bifunctor via (GenericBifunctor Tree)
-```
-
-In summary, the newtype `GenericFunctor` can be used for `DerivingVia`
-of the classes `Functor` and `Foldable`, and the newtype `GenericBifunctor`
-for the classes `Bifunctor` and `Bifoldable`.
-
-Default implementations for the above classes are also available as standalone
-functions (`gfmap`, `gfoldMap`, `gbimap`, `gbifoldMap`) and also for
-`Traversable` and `Bitraversable` (`gtraverse`, `gbitraverse`).
-
----
-
-## Internal module policy
-
-The public API is `Generic.Functor`. Don't use `Generic.Functor.Internal`.
-
-## Future work
-
-- Functors in arbitrary categories.
-
-## Related links
-
-- [*generic-data*][generic-data]: utilities for `GHC.Generics` and deriving for
-  other standard classes.
-
-- [*generic-lens*][generic-lens]: the `params` traversal uses a very similar implementation.
-
-- [*one-liner*][one-liner]. [*product-profunctors*][pp]
-
-- [*Deriving Bifunctors with Generics*](https://kcsongor.github.io/generic-deriving-bifunctor/),
-  blogpost by Csongor Kiss,
-  describing the main idea for the implementation (using incoherent instances).
-
-[generic-data]: https://hackage.haskell.org/package/generic-data
-[generic-lens]: https://hackage.haskell.org/package/generic-lens
-[one-liner]: https://hackage.haskell.org/package/one-liner
-[pp]: https://hackage.haskell.org/package/product-profunctors
+# Generic functors [![Hackage](https://img.shields.io/hackage/v/generic-functor.svg)](https://hackage.haskell.org/package/generic-functor) [![pipeline status](https://gitlab.com/lysxia/generic-functor/badges/main/pipeline.svg)](https://gitlab.com/lysxia/generic-functor/-/commits/main)+++Implementation of `Functor` instances and other functor-like structures+using `GHC.Generics`.++## Functors not over the last type parameter++The standard `Functor` class only applies to types that are functors over their+last type parameter. For example, in `Either e r`, `fmap` maps only `r`.++Using this library, `fmap`-like functions can be derived over any type+parameter of a `Generic` data type, all from the same definition `gsolomap`.++```haskell+{-# LANGUAGE DeriveGeneric #-}++import GHC.Generics (Generic)+import Generic.Functor (gsolomap)++data Result a r = Error a | Ok r   -- Another name for Either+  deriving Generic++mapError :: (a -> b) -> Result a r -> Result b r+mapError = gsolomap++-- This one is fmap+mapOk :: (a -> b) -> Result e a -> Result e b+mapOk = gsolomap++mapBoth :: (a -> b) -> Result a a -> Result b b+mapBoth = gsolomap+```++`gsolomap` is **unsafe**. Misuse will break your program.+Read on for specifics.++### Usage++`gsolomap` should only be used to define **polymorphic** "`fmap`-like functions"+for `Generic` types.++The signature of `gsolomap` is:++```haskell+gsolomap :: (Generic x, Generic y, GSolomap a b x y) => (a -> b) -> (x -> y)+```++The types `x` and `y` must be specializations of the same user-defined `data`+type which is an instance of `Generic`, with some type parameters equal to `a`+or `b` respectively. At use sites of `gsolomap`, `a` and `b` must also be two+distinct universally quantified type variables, with no equality constraint+relating them with each other or any other type.++The guarantee is that `gsolomap` satisfies `gsolomap id = id`. Under the+condition that `a` and `b` are abstract, that equation uniquely determines the+implementation. (That uniqueness claim may be broken with GADTs and other+explicit uses of type equality constraints.)++In particular, `gsolomap` *must not* be specialized with types `a` and `b` that+are equal. A function defined using `gsolomap` is safe to specialize once+the `GSolomap` constraint has been discharged.++For instance the three functions above, `mapError`, `mapOk`, `mapBoth` are+sufficiently polymorphic.+They are each uniquely determined by their types and the equation `mapX id = id`.+(Without that equation, `mapBoth` has four implementations of the same type.)++## Compositions of functors++How many `fmap` do you need to map a function `a -> b` over+`(t, Maybe [Either Bool a])`?++You only need one `solomap`:++```haskell+type F t a = (t, Maybe [Either Bool a])++maps :: (a -> b) -> F t a -> F t b+maps = solomap+```++`solomap` can also see through bifunctors and there may be more than+one occurrence of the type parameter `a`.++```haskell+type F a = ([a], Either a ())++maps2 :: (a -> b) -> F a -> F b+maps2 = solomap+```++`solomap` is **unsafe**, subject to the same restrictions as `gsolomap`:+where `solomap` is used, the type of its first argument `(a -> b)` must refer+to two distinct universally quantified variables `a` and `b`.+Functions are safe to specialize only once the `Solomap` constraint is out of+their contexts.++```haskell+solomap :: Solomap a b x y => (a -> b) -> (x -> y)+```++## Functors of multiple parameters++You can also map with more than one function simultaneously.+For example with `a -> b` and `c -> d` over `(Maybe a, [(c, a)])`:++```haskell+type F a c = (Maybe a, [(c, a)])++bimaps :: (a -> b) -> (c -> d) -> F a c -> F b d+bimaps f g = multimap (f :+ g :+ ())+```++`multimap` takes a list of functions separated by `(:+)` and terminated by `()`.++There is also a `gmultimap`, generalizing `gsolomap`.++`gmultimap` and `multimap` are **unsafe**, similarly to `gsolomap` and `solomap`.++## Deriving `Functor`++This library enables `DerivingVia` for the `Functor` class.++```haskell+{-# LANGUAGE DeriveGeneric, DerivingVia #-}++import GHC.Generics (Generic)+import Generic.Functor (GenericFunctor(..))++data Twice a = Twice (Either a a)+  deriving Generic+  deriving Functor via (GenericFunctor Twice)+```++Note that there is already built-in support for deriving `Functor` in GHC with the+`DeriveFunctor` extension instead. If that extension ever chokes on a type, this+library might have a chance at handling it. (Open an issue if it does not!)++The `Twice` example just above is not handled by the `DeriveFunctor` extension:++```haskell+{-# LANGUAGE DeriveFunctor #-}++data Twice a = Twice (Either a a) deriving Functor++{-+  error:+    • Can't make a derived instance of ‘Functor Twice’:+        Constructor ‘Twice’ must use the type variable only as the last argument of a data type+-}+```++The [*generic-data*][generic-data] library also includes a generic implementation of `Functor`,+but only for instances of `Generic1`, which applies to much more restricted shapes+of `data` than `Generic`.++## Deriving `Bifunctor`++Similarly, we can use `DerivingVia` for the `Bifunctor` class+(from *base*, module `Data.Bifunctor`).++```haskell+{-# LANGUAGE DeriveGeneric, DerivingVia #-}++import GHC.Generics (Generic)+import Generic.Functor (GenericFunctor(..), GenericBifunctor(..))++data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b+  deriving Generic+  deriving Functor via (GenericFunctor (Tree a))+  deriving Bifunctor via (GenericBifunctor Tree)+```++In summary, the newtype `GenericFunctor` can be used for `DerivingVia`+of the classes `Functor` and `Foldable`, and the newtype `GenericBifunctor`+for the classes `Bifunctor` and `Bifoldable`.++Default implementations for the above classes are also available as standalone+functions (`gfmap`, `gfoldMap`, `gbimap`, `gbifoldMap`) and also for+`Traversable` and `Bitraversable` (`gtraverse`, `gbitraverse`).++---++## Internal module policy++The public API is `Generic.Functor`. Don't use `Generic.Functor.Internal`.++## Future work++- Functors in arbitrary categories.++## Related links++- [*generic-data*][generic-data]: utilities for `GHC.Generics` and deriving for+  other standard classes.++- [*generic-lens*][generic-lens]: the `params` traversal uses a very similar implementation.++- [*one-liner*][one-liner]. [*product-profunctors*][pp]++- [*Deriving Bifunctors with Generics*](https://kcsongor.github.io/generic-deriving-bifunctor/),+  blogpost by Csongor Kiss,+  describing the main idea for the implementation (using incoherent instances).++[generic-data]: https://hackage.haskell.org/package/generic-data+[generic-lens]: https://hackage.haskell.org/package/generic-lens+[one-liner]: https://hackage.haskell.org/package/one-liner+[pp]: https://hackage.haskell.org/package/product-profunctors

@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain

@@ -1,44 +1,45 @@-cabal-version:       >=1.10
-name:                generic-functor
-version:             0.2.0.0
-synopsis: Deriving generalized functors with GHC.Generics
-description:
-  Derive @fmap@, and other @fmap@-like functions where the
-  parameter of the functor could occur anywhere.
-  .
-  See the README for details.
-homepage:            https://gitlab.com/lysxia/generic-functor
-bug-reports:         https://gitlab.com/lysxia/generic-functor/-/issues
-license:             MIT
-license-file:        LICENSE
-author:              Li-yao Xia
-maintainer:          lysxia@gmail.com
-copyright:           Li-yao Xia 2020
-category:            Generics
-build-type:          Simple
-extra-source-files:  CHANGELOG.md, README.md
-
-library
-  hs-source-dirs: src
-  exposed-modules:
-    Generic.Functor
-    Generic.Functor.Internal
-    Generic.Functor.Internal.Implicit
-  build-depends:
-    ap-normalize,
-    base >=4.12 && <4.15
-  default-language:    Haskell2010
-
-test-suite examples
-  hs-source-dirs: test
-  main-is: test.hs
-  build-depends:
-    generic-functor,
-    transformers,
-    base
-  type: exitcode-stdio-1.0
-  default-language:    Haskell2010
-
-source-repository head
-  type:     git
-  location: https://gitlab.com/lysxia/generic-functor
+cabal-version:       >=1.10+name:                generic-functor+version:             1.0.0.0+synopsis: Deriving generalized functors with GHC.Generics+description:+  Derive @fmap@, and other @fmap@-like functions where the+  parameter of the functor could occur anywhere.+  .+  See the README for details.+homepage:            https://gitlab.com/lysxia/generic-functor+bug-reports:         https://gitlab.com/lysxia/generic-functor/-/issues+license:             MIT+license-file:        LICENSE+author:              Li-yao Xia+maintainer:          lysxia@gmail.com+copyright:           Li-yao Xia 2020+category:            Generics+build-type:          Simple+extra-source-files:  CHANGELOG.md, README.md++library+  hs-source-dirs: src+  exposed-modules:+    Generic.Functor+    Generic.Functor.Multimap+    Generic.Functor.Internal+    Generic.Functor.Internal.Implicit+  build-depends:+    ap-normalize,+    base >=4.12 && <5+  default-language:    Haskell2010++test-suite examples+  hs-source-dirs: test+  main-is: test.hs+  build-depends:+    generic-functor,+    transformers,+    base+  type: exitcode-stdio-1.0+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://gitlab.com/lysxia/generic-functor

@@ -1,63 +1,47 @@--- | Generic and generalized functors.
-
-module Generic.Functor
-  ( -- * Derive functors
-
-    -- ** Unary functors
-    gsolomap
-  , solomap
-
-    -- ** N-ary functors
-  , gmultimap
-  , multimap
-  , (:+)(..)
-
-    -- ** Derive Functor, Bifunctor, Foldable, Traversable
-
-    -- *** DerivingVia
-    -- | The type synonyms 'GenericFunctor' and 'GenericBifunctor' can be
-    -- used with the @DerivingVia@ extension to derive 'Functor', 'Bifunctor', and 'Foldable'.
-    -- Sadly, 'Traversable' cannot be derived-via.
-  , GenericFunctor(..)
-  , GenericBifunctor(..)
-
-    -- *** Generic method definitions
-  , gfmap
-  , gfoldMap
-  , gtraverse
-
-    -- **** Bifunctors
-  , gbimap
-  , gfirst
-  , gsecond
-  , gbifoldMap
-  , gbitraverse
-
-    -- * Auxiliary classes
-
-    -- ** Related to standard classes
-  , GFunctor()
-  , GFoldable()
-  , GFoldMap()
-  , GTraversable()
-  , GTraverse()
-
-    -- *** Bifunctors
-  , GBifunctor()
-  , GBimap()
-  , GFirst()
-  , GSecond()
-  , GBifoldable()
-  , GBifoldMap()
-  , GBitraversable()
-  , GBitraverse()
-
-    -- ** Generalized functors
-  , GSolomap()
-  , Solomap()
-  , GMultimap()
-  , Multimap()
-  ) where
-
-import Generic.Functor.Internal
-import Generic.Functor.Internal.Implicit
+-- | Generic functors, foldables, and traversables.++module Generic.Functor+  ( -- * Derive functors++    -- ** Derive Functor, Bifunctor, Foldable, Traversable++    -- *** DerivingVia+    -- | The type synonyms 'GenericFunctor' and 'GenericBifunctor' can be+    -- used with the @DerivingVia@ extension to derive 'Functor', 'Bifunctor', and 'Foldable'.+    -- Sadly, 'Traversable' cannot be derived-via.+    GenericFunctor(..)+  , GenericBifunctor(..)++    -- *** Generic method definitions+  , gfmap+  , gfoldMap+  , gtraverse++    -- **** Bifunctors+  , gbimap+  , gfirst+  , gsecond+  , gbifoldMap+  , gbitraverse++    -- * Auxiliary classes++    -- ** Related to standard classes+  , GFunctor()+  , GFoldable()+  , GFoldMap()+  , GTraversable()+  , GTraverse()++    -- *** Bifunctors+  , GBifunctor()+  , GBimap()+  , GFirst()+  , GSecond()+  , GBifoldable()+  , GBifoldMap()+  , GBitraversable()+  , GBitraverse()+  ) where++import Generic.Functor.Internal

@@ -1,511 +1,511 @@-{-# LANGUAGE
-  AllowAmbiguousTypes,
-  ConstraintKinds,
-  EmptyCase,
-  FlexibleContexts,
-  FlexibleInstances,
-  MultiParamTypeClasses,
-  QuantifiedConstraints,
-  RankNTypes,
-  ScopedTypeVariables,
-  TypeApplications,
-  TypeOperators,
-  UndecidableInstances #-}
-
-{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
-
--- | This is an internal module. Look, don't touch.
---
--- "Generic.Functor" is the public API.
-
-module Generic.Functor.Internal where
-
-import ApNormalize
-import Control.Applicative (liftA2)
-import Data.Bifoldable (Bifoldable(..))
-import Data.Bifunctor (Bifunctor(..))
-import Data.Coerce (coerce, Coercible)
-import Data.Functor.Identity (Identity(..))
-import Data.Functor.Const (Const(..))
-import Data.Monoid (Endo(..))
-import GHC.Generics hiding (S)
-
-import Generic.Functor.Internal.Implicit
-
--- | Generic implementation of 'fmap'. See also 'GenericFunctor' for @DerivingVia@,
--- using 'gfmap' under the hood.
---
--- === Example
---
--- @
--- {-\# LANGUAGE DeriveGeneric \#-}
---
--- import "GHC.Generics" ('Generic')
--- import "Generic.Functor" ('gfmap')
---
--- data Twice a = Twice (Either a a)
---   deriving 'Generic'
---
--- instance 'Functor' Twice where
---   'fmap' = 'gfmap'
--- @
---
--- Unlike 'gsolomap', 'gfmap' is safe to use in all contexts.
-gfmap :: forall f a b. GFunctor f => (a -> b) -> (f a -> f b)
-gfmap f = with @(GFunctorRep a b f) (to . gmapRep (defaultIncoherent f) . from)
-
--- | Generalized generic functor.
---
--- 'gsolomap' is a generalization of 'gfmap' (generic 'fmap'),
--- where the type parameter to be \"mapped\" does not have to be the last one.
---
--- 'gsolomap' is __unsafe__: misuse will break your programs.
--- Read the <#gsolomapusage Usage> section below for details.
---
--- === Example
---
--- @
--- {-\# LANGUAGE DeriveGeneric \#-}
---
--- import "GHC.Generics" ('Generic')
--- import "Generic.Functor" ('gsolomap')
---
--- data Result a r = Error a | Ok r  -- Another name for Either
---   deriving 'Generic'
---
--- mapError :: (a -> b) -> Result a r -> Result b r
--- mapError = 'gsolomap'
---
--- mapOk :: (r -> s) -> Result a r -> Result a s
--- mapOk = 'gsolomap'
---
--- mapBoth :: (a -> b) -> Result a a -> Result b b
--- mapBoth = 'gsolomap'
--- @
---
--- === Usage #gsolomapusage#
---
--- (This also applies to 'solomap', 'gmultimap', and 'multimap'.)
---
--- 'gsolomap' should only be used to define __polymorphic__ "@fmap@-like functions".
--- It works only in contexts where @a@ and @b@ are two distinct, non-unifiable
--- type variables. This is usually the case when they are bound by universal
--- quantification (@forall a b. ...@), with no equality constraints on @a@ and
--- @b@.
---
--- The one guarantee of 'gsolomap' is that @'gsolomap' 'id' = 'id'@.
--- Under the above conditions, that law and the types should uniquely determine
--- the implementation, which 'gsolomap' seeks automatically.
---
--- The unsafety is due to the use of incoherent instances as part of the
--- definition of 'GSolomap'. Functions are safe to specialize after 'GSolomap'
--- (and 'Solomap') constraints have been discharged.
---
--- Note also that the type parameters of 'gsolomap' must all be determined by
--- the context. For instance, composing two 'gsolomap', as in
--- @'gsolomap' f . 'gsolomap' g@, is a type error because the type in the middle
--- cannot be inferred.
-gsolomap :: forall a b x y. (Generic x, Generic y, GSolomap a b x y) => (a -> b) -> (x -> y)
-gsolomap f = to . gmapRep (defaultIncoherent f) . from
-
--- | Generalized implicit functor.
---
--- Use this when @x@ and @y@ are applications of existing functors
--- ('Functor', 'Bifunctor').
---
--- This is a different use case from 'gfmap' and 'gsolomap', which make
--- functors out of freshly declared @data@ types.
---
--- 'solomap' is __unsafe__: misuse will break your programs.
---
--- See the <#gsolomapusage Usage> section of 'gsolomap' for details.
---
--- === Example
---
--- @
--- map1 :: (a -> b) -> Either e (Maybe [IO a]) -> Either e (Maybe [IO b])
--- map1 = 'solomap'
--- -- equivalent to:   fmap . fmap . fmap . fmap
---
--- map2 :: (a -> b) -> (e -> Either [a] r) -> (e -> Either [b] r)
--- map2 = 'solomap'
--- -- equivalent to:   \\f -> fmap (bimap (fmap f) id)
--- @
-solomap :: forall a b x y. Solomap a b x y => (a -> b) -> (x -> y)
-solomap f = multimap f
-
--- | Generic n-ary functor.
---
--- A generalization of 'gsolomap' to map over multiple parameters simultaneously.
--- 'gmultimap' takes a list of functions separated by @(':+')@ and terminated by @()@.
---
--- 'gmultimap' is __unsafe__: misuse will break your programs.
--- The type of every function in the list must be some @(a -> b)@
--- where @a@ and @b@ are distinct type variables.
---
--- See the <#gsolomapusage Usage> section of 'gsolomap' for details.
---
--- === Example
---
--- @
--- {-\# LANGUAGE DeriveGeneric \#-}
---
--- import "GHC.Generics" ('Generic')
--- import "Generic.Functor" ('gmultimap')
---
--- data Three a b c = One a | Two b | Three c
---   deriving 'Generic'
---
--- mapThree :: (a -> a') -> (b -> b') -> (c -> c') -> Three a b c -> Three a' b' c'
--- mapThree f g h = 'gmultimap' (f ':+' g ':+' h ':+' ())
--- @
-gmultimap :: forall arr x y. (Generic x, Generic y, GMultimap arr x y) => arr -> (x -> y)
-gmultimap f = to . gmapRep (defaultIncoherent f) . from
-
--- | Implicit n-ary functor.
---
--- A generalization of 'solomap' to map over multiple parameters simultaneously.
--- 'multimap' takes a list of functions separated by @(':+')@ and terminated by @()@.
---
--- 'multimap' is __unsafe__: misuse will break your programs.
--- The type of every function in the list must be some @(a -> b)@
--- where @a@ and @b@ are distinct type variables.
---
--- See the <#gsolomapusage Usage> section of 'gsolomap' for details.
---
--- === Example
---
--- @
--- type F a b c = Either a (b, c)
---
--- map3 :: (a -> a') -> (b -> b') -> (c -> c') -> F a b c -> F a' b' c'
--- map3 f g h = 'multimap' (f ':+' g ':+' h ':+' ())
--- -- equivalent to:  \\f g h -> bimap f (bimap g h)
--- @
-multimap :: forall arr x y. Multimap arr x y => arr -> (x -> y)
-multimap f = multimapI (defaultIncoherent f)
-
--- | Generic implementation of 'bimap' from 'Bifunctor'. See also 'GenericBifunctor'.
-gbimap :: forall f a b c d. GBimap f => (a -> b) -> (c -> d) -> f a c -> f b d
-gbimap f g = with @(GBimapRep a b c d f) (to . gmapRep (defaultIncoherent (f :+ g)) . from)
-
--- | Generic implementation of 'first' from 'Bifunctor'. See also 'GenericBifunctor'.
-gfirst :: forall f a b c. GFirst f => (a -> b) -> f a c -> f b c
-gfirst f = with @(GFirstRep a b c f) (to . gmapRep (defaultIncoherent f) . from)
-
--- | Generic implementation of 'second' from 'Bifunctor'. See also 'GenericBifunctor'.
-gsecond :: forall f a c d. GSecond f => (c -> d) -> f a c -> f a d
-gsecond = gfmap
-
--- *** Fold
-
--- | Generic implementation of 'foldMap' from 'Foldable'.
-gfoldMap :: forall t m a. (GFoldMap m t, Monoid m) => (a -> m) -> t a -> m
-gfoldMap f =
-  with @(GFoldMapRep a a m t) (gfoldMapRep (defaultIncoherent (Fold @m @a @a f)) . from)
-
--- | Generic implementation of 'bifoldMap' from 'Bifoldable'.
-gbifoldMap :: forall t m a b. (GBifoldMap m t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m
-gbifoldMap f g =
-  with @(GBifoldMapRep a a b b m t) (gfoldMapRep (defaultIncoherent (Fold @m @a @a f :+ Fold @m @b @b g)) . from)
-
--- *** Traverse
-
--- | Generic implementation of 'traverse' from 'Traversable'.
-gtraverse :: forall t f a b. (GTraverse f t, Applicative f) => (a -> f b) -> t a -> f (t b)
-gtraverse f = with @(GTraverseRep a b f t) (lowerAps . fmap to . gtraverseRep (defaultIncoherent f) . from)
-
--- | Generic implementation of 'bitraverse' from 'Bitraversable'.
-gbitraverse :: forall t f a b c d. (GBitraverse f t, Applicative f) => (a -> f b) -> (c -> f d) -> t a c -> f (t b d)
-gbitraverse f g =
-  with @(GBitraverseRep a b c d f t) (lowerAps . fmap to . gtraverseRep (defaultIncoherent (f :+ g)) . from)
-
-
--- | Explicitly require a constraint, to force the instantiation of a quantified constraint.
-with :: forall c r. (c => r) -> (c => r)
-with x = x
-
--- ** Top-level constraints
-
--- *** @gfmap@
-
--- | Generic 'Functor'. Constraint for 'gfmap'.
-class    (forall a. Generic (f a), forall a b. GFunctorRep a b f) => GFunctor f
-instance (forall a. Generic (f a), forall a b. GFunctorRep a b f) => GFunctor f
-
--- | Internal component of 'GFunctor'.
---
--- This is an example of the \"quantified constraints trick\" to encode
--- @forall a b. GMap1 a b (Rep (f a)) (Rep (f b))@ which doesn't actually
--- work as-is.
-class    GMap1 (Default Incoherent (a -> b)) (Rep (f a)) (Rep (f b)) => GFunctorRep a b f
-instance GMap1 (Default Incoherent (a -> b)) (Rep (f a)) (Rep (f b)) => GFunctorRep a b f
-
--- *** @gbimap@
-
--- | Constraint for 'gbimap'.
-class    (forall a c. Generic (f a c), forall a b c d. GBimapRep a b c d f) => GBimap f
-instance (forall a c. Generic (f a c), forall a b c d. GBimapRep a b c d f) => GBimap f
-
--- | Internal component of 'GBifunctor'.
-class    GMap1 (Default Incoherent ((a -> b) :+ (c -> d))) (Rep (f a c)) (Rep (f b d)) => GBimapRep a b c d f
-instance GMap1 (Default Incoherent ((a -> b) :+ (c -> d))) (Rep (f a c)) (Rep (f b d)) => GBimapRep a b c d f
-
--- *** @gfirst@
-
--- | Constraint for 'gfirst'.
-class    (forall a c. Generic (f a c), forall a b c. GFirstRep a b c f) => GFirst f
-instance (forall a c. Generic (f a c), forall a b c. GFirstRep a b c f) => GFirst f
-
--- | Internal component of 'GFirst'.
-class    GMap1 (Default Incoherent (a -> b)) (Rep (f a c)) (Rep (f b c)) => GFirstRep a b c f
-instance GMap1 (Default Incoherent (a -> b)) (Rep (f a c)) (Rep (f b c)) => GFirstRep a b c f
-
--- *** @gsecond@
-
--- | Constraint for 'gsecond'.
-class    (forall a c. Generic (f a c), forall a c d. GFunctorRep c d (f a)) => GSecond f
-instance (forall a c. Generic (f a c), forall a c d. GFunctorRep c d (f a)) => GSecond f
-
--- | Generic 'Bifunctor'.
-class    (GBimap f, GFirst f, GSecond f) => GBifunctor f
-instance (GBimap f, GFirst f, GSecond f) => GBifunctor f
-
--- *** @gtraverse@
-
--- | Constraint for 'gtraverse'.
-class    (forall a. Generic (t a), forall a b. GTraverseRep a b f t) => GTraverse f t
-instance (forall a. Generic (t a), forall a b. GTraverseRep a b f t) => GTraverse f t
-
-class    GTraverse1 f (Default Incoherent (a -> f b)) (Rep (t a)) (Rep (t b)) => GTraverseRep a b f t
-instance GTraverse1 f (Default Incoherent (a -> f b)) (Rep (t a)) (Rep (t b)) => GTraverseRep a b f t
-
--- | Generic 'Traversable'.
-class    (forall f. Applicative f => GBitraverse f t) => GTraversable t
-instance (forall f. Applicative f => GBitraverse f t) => GTraversable t
-
--- | Constraint for 'gtraverse'.
-class    (forall a b. Generic (t a b), forall a b c d. GBitraverseRep a b c d f t) => GBitraverse f t
-instance (forall a b. Generic (t a b), forall a b c d. GBitraverseRep a b c d f t) => GBitraverse f t
-
-class    GTraverse1 f (Default Incoherent ((a -> f b) :+ (c -> f d))) (Rep (t a c)) (Rep (t b d)) => GBitraverseRep a b c d f t
-instance GTraverse1 f (Default Incoherent ((a -> f b) :+ (c -> f d))) (Rep (t a c)) (Rep (t b d)) => GBitraverseRep a b c d f t
-
--- | Generic 'Bitraversable'.
-class    (forall f. Applicative f => GBitraverse f t) => GBitraversable t
-instance (forall f. Applicative f => GBitraverse f t) => GBitraversable t
-
--- *** @foldMap@
-
--- | Constraint for 'gfoldMap'.
-class    (forall a. Generic (t a), forall a b. GFoldMapRep a b m t) => GFoldMap m t
-instance (forall a. Generic (t a), forall a b. GFoldMapRep a b m t) => GFoldMap m t
-
-class    GFoldMap1 m (Default Incoherent (Fold m a b)) (Rep (t a)) (Rep (t b)) => GFoldMapRep a b m t
-instance GFoldMap1 m (Default Incoherent (Fold m a b)) (Rep (t a)) (Rep (t b)) => GFoldMapRep a b m t
-
--- | Generic 'Foldable'. Constraint for 'GenericFunctor' (deriving-via 'Foldable').
-class    (forall m. Monoid m => GFoldMap m t) => GFoldable t
-instance (forall m. Monoid m => GFoldMap m t) => GFoldable t
-
--- | Constraint for 'gbifoldMap'.
-class    (forall a b. Generic (t a b), forall a b c d. GBifoldMapRep a b c d m t) => GBifoldMap m t
-instance (forall a b. Generic (t a b), forall a b c d. GBifoldMapRep a b c d m t) => GBifoldMap m t
-
-class    GFoldMap1 m (Default Incoherent (Fold m a b :+ Fold m c d)) (Rep (t a c)) (Rep (t b d)) => GBifoldMapRep a b c d m t
-instance GFoldMap1 m (Default Incoherent (Fold m a b :+ Fold m c d)) (Rep (t a c)) (Rep (t b d)) => GBifoldMapRep a b c d m t
-
--- | Generic 'Foldable'. Constraint for 'GenericFunctor' (deriving-via 'Foldable').
-class    (forall m. Monoid m => GBifoldMap m t) => GBifoldable t
-instance (forall m. Monoid m => GBifoldMap m t) => GBifoldable t
-
--- *** Others
-
--- | Constraint for 'gsolomap'.
-class    GMultimap (a -> b) x y => GSolomap a b x y
-instance GMultimap (a -> b) x y => GSolomap a b x y
-
--- | Constraint for 'solomap'.
-class    Multimap (a -> b) x y => Solomap a b x y
-instance Multimap (a -> b) x y => Solomap a b x y
-
--- | Constraint for 'gmultimap'.
-class    GMap1 (Default Incoherent arr) (Rep x) (Rep y) => GMultimap arr x y
-instance GMap1 (Default Incoherent arr) (Rep x) (Rep y) => GMultimap arr x y
-
--- | Constraint for 'multimap'.
-class    MultimapI (Default Incoherent arr) x y => Multimap arr x y
-instance MultimapI (Default Incoherent arr) x y => Multimap arr x y
-
--- * Deriving Via
-
--- ** Functor
-
--- | @newtype@ for @DerivingVia@ of 'Functor' and 'Foldable' instances.
---
--- Note: the GHC extensions @DeriveFunctor@, @DeriveFoldable@, and @DeriveTraversable@
--- (which implies all three) already works out-of-the-box in most cases.
--- There are exceptions, such as the following example.
---
--- === Example
---
--- @
--- {-\# LANGUAGE DeriveGeneric, DerivingVia \#-}
---
--- import "GHC.Generics" ('Generic')
--- import "Generic.Functor" ('GenericFunctor'(..))
---
--- data Twice a = Twice (Either a a)
---   deriving 'Generic'
---   deriving ('Functor', 'Foldable') via ('GenericFunctor' Twice)
--- @
-newtype GenericFunctor f a = GenericFunctor (f a)
-
-instance GFunctor f => Functor (GenericFunctor f) where
-  fmap = coerce1 (gfmap @f)
-
-instance GFoldable f => Foldable (GenericFunctor f) where
-  foldMap = coerceFoldMap (gfoldMap @f)
-
--- ** Bifunctor
-
--- | @newtype@ for @DerivingVia@ of 'Bifunctor' and 'Bifoldable' instances.
---
--- Note: deriving 'Bifunctor' for a generic type often requires 'Functor'
--- instances for types mentioned in the fields.
---
--- === Example
---
--- @
--- {-\# LANGUAGE DeriveGeneric, DerivingVia \#-}
---
--- import "Data.Bifoldable" ('Bifoldable')
--- import "Data.Bifunctor" ('Bifunctor')
--- import "GHC.Generics" ('Generic')
--- import "Generic.Functor" ('GenericFunctor'(..), 'GenericBifunctor'(..))
---
--- data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b
---   deriving 'Generic'
---   deriving ('Functor', 'Foldable') via ('GenericFunctor' (Tree a))
---   deriving ('Bifunctor', 'Bifoldable') via ('GenericBifunctor' Tree)
---
--- data CofreeF f a b = a :< f b
---   deriving 'Generic'
---   deriving ('Bifunctor', 'Bifoldable') via ('GenericBifunctor' (CofreeF f))
--- @
-newtype GenericBifunctor f a b = GenericBifunctor (f a b)
-
-instance GBifunctor f => Bifunctor (GenericBifunctor f) where
-  bimap = coerce2 (gbimap @f)
-  first = coerce3 (gfirst @f)
-  second = coerce3 (gsecond @f)
-
-instance GBifoldable f => Bifoldable (GenericBifunctor f) where
-  bifoldMap = coerceBifoldMap (gbifoldMap @f)
-
--- ** Internal coercions
-
-coerce1 :: Coercible s t => (r -> s) -> (r -> t)
-coerce1 = coerce
-
-coerce2 :: Coercible t u => (r -> s -> t) -> (r -> s -> u)
-coerce2 = coerce
-
-coerce3 :: (Coercible w v, Coercible (f b d) (g b d)) => (r -> w -> f b d) -> (r -> v -> g b d)
-coerce3 = coerce
-
-coerceFoldMap :: Coercible t u => (am -> t -> m) -> (am -> u -> m)
-coerceFoldMap = coerce
-
-coerceBifoldMap :: Coercible t u => (am -> bm -> t -> m) -> (am -> bm -> u -> m)
-coerceBifoldMap = coerce
-
--- ** @GMultimapK@
-
--- | We use the same class to implement all of 'fmap', 'foldMap', 'traverse',
--- instantiating @m@ as 'Identity', 'Const (EndoM mm)' and 'Aps n' respectively.
--- Those three cases differ in their instances for 'K1'.
---
--- (the K stands for @Kleisli@, because the result is @Kleisli m (f ()) (g ())@
-class GMultimapK m arr f g where
-  gmultimapK :: arr -> f () -> m (g ())
-
--- *** Instance for @fmap@
-
-instance MultimapI arr x y => GMultimapK Identity arr (K1 i x) (K1 i' y) where
-  gmultimapK = coerce (multimapI @arr @x @y)
-
-class    GMultimapK Identity arr f g => GMap1 arr f g
-instance GMultimapK Identity arr f g => GMap1 arr f g
-
-gmapRep :: GMap1 arr f g => arr -> f () -> g ()
-gmapRep f x = runIdentity (gmultimapK f x)
-
--- *** Instance for @foldMap@
-
-instance (Multifold_ m arr x y, Monoid m) => GMultimapK (Const (EndoM m)) arr (K1 i x) (K1 i' y) where
-  gmultimapK f (K1 x) = K1 <$> foldToConst (multifold_ f) x
-
--- Spooky instance. It makes sense only because @GMultimapK (Const (EndoM m))@
--- occurs exclusively under a quantified constraint (in the definition of GFoldMap).
-instance {-# INCOHERENT #-} GMultimapK (Const (EndoM m)) arr (K1 i x) (K1 i x) where
-  gmultimapK _ (K1 _) = Const (Endo id)
-
--- An extra wrapper to simplify away @(mempty <> _)@ and @(_ <> mempty)@.
-type EndoM m = Endo (Maybe m)
-
-unEndoM :: Monoid m => EndoM m -> m
-unEndoM (Endo f) = case f Nothing of
-  Nothing -> mempty
-  Just y -> y
-
-liftEndoM :: Monoid m => m -> EndoM m
-liftEndoM y = Endo (Just . app)
-  where
-    app Nothing = y
-    app (Just y') = y `mappend` y'
-
-foldToConst :: Monoid m => Fold m x y -> x -> Const (EndoM m) y
-foldToConst (Fold f) x = Const (liftEndoM (f x))
-
-class    GMultimapK (Const (EndoM m)) arr f g => GFoldMap1 m arr f g
-instance GMultimapK (Const (EndoM m)) arr f g => GFoldMap1 m arr f g
-
--- | Danger! @GFoldMap1 m arr f f@ MUST come from a quantified constraint (see use in 'gfoldMap').
-gfoldMapRep :: forall m arr f. (GFoldMap1 m arr f f, Monoid m) => arr -> f () -> m
-gfoldMapRep f x = unEndoM (getConst (gmultimapK f x :: Const (EndoM m) (f ())))
-
--- *** Instance for @traverse@
-
-instance (Multitraverse m arr x y) => GMultimapK (Aps m) arr (K1 i x) (K1 i' y) where
-  gmultimapK f (K1 x) = K1 <$>^ multitraverse f x
-
-class    GMultimapK (Aps m) arr f g => GTraverse1 m arr f g
-instance GMultimapK (Aps m) arr f g => GTraverse1 m arr f g
-
-gtraverseRep :: GTraverse1 m arr f g => arr -> f () -> Aps m (g ())
-gtraverseRep = gmultimapK
-
--- *** Common instances
-
-instance (GMultimapK m arr f g, Functor m) => GMultimapK m arr (M1 i c f) (M1 i' c' g) where
-  gmultimapK f (M1 x) = M1 <$> gmultimapK f x
-
-instance
-  (GMultimapK m arr f1 g1, GMultimapK m arr f2 g2, Applicative m) =>
-  GMultimapK m arr (f1 :+: f2) (g1 :+: g2)
-  where
-  gmultimapK f (L1 x) = L1 <$> gmultimapK f x
-  gmultimapK f (R1 y) = R1 <$> gmultimapK f y
-
-instance
-  (GMultimapK m arr f1 g1, GMultimapK m arr f2 g2, Applicative m) =>
-  GMultimapK m arr (f1 :*: f2) (g1 :*: g2)
-  where
-  gmultimapK f (x :*: y) = liftA2 (:*:) (gmultimapK f x) (gmultimapK f y)
-
-instance Applicative m => GMultimapK m arr U1 U1 where
-  gmultimapK _ U1 = pure U1
-
-instance GMultimapK m arr V1 V1 where
-  gmultimapK _ v = case v of
+{-# LANGUAGE+  AllowAmbiguousTypes,+  ConstraintKinds,+  EmptyCase,+  FlexibleContexts,+  FlexibleInstances,+  MultiParamTypeClasses,+  QuantifiedConstraints,+  RankNTypes,+  ScopedTypeVariables,+  TypeApplications,+  TypeOperators,+  UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++-- | This is an internal module. Look, don't touch.+--+-- "Generic.Functor" is the public API.++module Generic.Functor.Internal where++import ApNormalize+import Control.Applicative (liftA2)+import Data.Bifoldable (Bifoldable(..))+import Data.Bifunctor (Bifunctor(..))+import Data.Coerce (coerce, Coercible)+import Data.Functor.Identity (Identity(..))+import Data.Functor.Const (Const(..))+import Data.Monoid (Endo(..))+import GHC.Generics hiding (S)++import Generic.Functor.Internal.Implicit++-- | Generic implementation of 'fmap'. See also 'GenericFunctor' for @DerivingVia@,+-- using 'gfmap' under the hood.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('gfmap')+--+-- data Twice a = Twice (Either a a)+--   deriving 'Generic'+--+-- instance 'Functor' Twice where+--   'fmap' = 'gfmap'+-- @+--+-- Unlike 'gsolomap', 'gfmap' is safe to use in all contexts.+gfmap :: forall f a b. GFunctor f => (a -> b) -> (f a -> f b)+gfmap f = with @(GFunctorRep a b f) (to . gmapRep (defaultIncoherent f) . from)++-- | Generalized generic functor.+--+-- 'gsolomap' is a generalization of 'gfmap' (generic 'fmap'),+-- where the type parameter to be \"mapped\" does not have to be the last one.+--+-- 'gsolomap' is __unsafe__: misuse will break your programs.+-- Read the <#gsolomapusage Usage> section below for details.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('gsolomap')+--+-- data Result a r = Error a | Ok r  -- Another name for Either+--   deriving 'Generic'+--+-- mapError :: (a -> b) -> Result a r -> Result b r+-- mapError = 'gsolomap'+--+-- mapOk :: (r -> s) -> Result a r -> Result a s+-- mapOk = 'gsolomap'+--+-- mapBoth :: (a -> b) -> Result a a -> Result b b+-- mapBoth = 'gsolomap'+-- @+--+-- === Usage #gsolomapusage#+--+-- (This also applies to 'solomap', 'gmultimap', and 'multimap'.)+--+-- 'gsolomap' should only be used to define __polymorphic__ "@fmap@-like functions".+-- It works only in contexts where @a@ and @b@ are two distinct, non-unifiable+-- type variables. This is usually the case when they are bound by universal+-- quantification (@forall a b. ...@), with no equality constraints on @a@ and+-- @b@.+--+-- The one guarantee of 'gsolomap' is that @'gsolomap' 'id' = 'id'@.+-- Under the above conditions, that law and the types should uniquely determine+-- the implementation, which 'gsolomap' seeks automatically.+--+-- The unsafety is due to the use of incoherent instances as part of the+-- definition of 'GSolomap'. Functions are safe to specialize after 'GSolomap'+-- (and 'Solomap') constraints have been discharged.+--+-- Note also that the type parameters of 'gsolomap' must all be determined by+-- the context. For instance, composing two 'gsolomap', as in+-- @'gsolomap' f . 'gsolomap' g@, is a type error because the type in the middle+-- cannot be inferred.+gsolomap :: forall a b x y. (Generic x, Generic y, GSolomap a b x y) => (a -> b) -> (x -> y)+gsolomap f = to . gmapRep (defaultIncoherent f) . from++-- | Generalized implicit functor.+--+-- Use this when @x@ and @y@ are applications of existing functors+-- ('Functor', 'Bifunctor').+--+-- This is a different use case from 'Generic.Functor.gfmap' and 'gsolomap', which make+-- functors out of freshly declared @data@ types.+--+-- 'solomap' is __unsafe__: misuse will break your programs.+--+-- See the <#gsolomapusage Usage> section of 'gsolomap' for details.+--+-- === Example+--+-- @+-- map1 :: (a -> b) -> Either e (Maybe [IO a]) -> Either e (Maybe [IO b])+-- map1 = 'solomap'+-- -- equivalent to:   fmap . fmap . fmap . fmap+--+-- map2 :: (a -> b) -> (e -> Either [a] r) -> (e -> Either [b] r)+-- map2 = 'solomap'+-- -- equivalent to:   \\f -> fmap (bimap (fmap f) id)+-- @+solomap :: forall a b x y. Solomap a b x y => (a -> b) -> (x -> y)+solomap f = multimap f++-- | Generic n-ary functor.+--+-- A generalization of 'gsolomap' to map over multiple parameters simultaneously.+-- 'gmultimap' takes a list of functions separated by @(':+')@ and terminated by @()@.+--+-- 'gmultimap' is __unsafe__: misuse will break your programs.+-- The type of every function in the list must be some @(a -> b)@+-- where @a@ and @b@ are distinct type variables.+--+-- See the <#gsolomapusage Usage> section of 'gsolomap' for details.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('gmultimap')+--+-- data Three a b c = One a | Two b | Three c+--   deriving 'Generic'+--+-- mapThree :: (a -> a') -> (b -> b') -> (c -> c') -> Three a b c -> Three a' b' c'+-- mapThree f g h = 'gmultimap' (f ':+' g ':+' h ':+' ())+-- @+gmultimap :: forall arr x y. (Generic x, Generic y, GMultimap arr x y) => arr -> (x -> y)+gmultimap f = to . gmapRep (defaultIncoherent f) . from++-- | Implicit n-ary functor.+--+-- A generalization of 'solomap' to map over multiple parameters simultaneously.+-- 'multimap' takes a list of functions separated by @(':+')@ and terminated by @()@.+--+-- 'multimap' is __unsafe__: misuse will break your programs.+-- The type of every function in the list must be some @(a -> b)@+-- where @a@ and @b@ are distinct type variables.+--+-- See the <#gsolomapusage Usage> section of 'gsolomap' for details.+--+-- === Example+--+-- @+-- type F a b c = Either a (b, c)+--+-- map3 :: (a -> a') -> (b -> b') -> (c -> c') -> F a b c -> F a' b' c'+-- map3 f g h = 'multimap' (f ':+' g ':+' h ':+' ())+-- -- equivalent to:  \\f g h -> bimap f (bimap g h)+-- @+multimap :: forall arr x y. Multimap arr x y => arr -> (x -> y)+multimap f = multimapI (defaultIncoherent f)++-- | Generic implementation of 'bimap' from 'Bifunctor'. See also 'GenericBifunctor'.+gbimap :: forall f a b c d. GBimap f => (a -> b) -> (c -> d) -> f a c -> f b d+gbimap f g = with @(GBimapRep a b c d f) (to . gmapRep (defaultIncoherent (f :+ g)) . from)++-- | Generic implementation of 'first' from 'Bifunctor'. See also 'GenericBifunctor'.+gfirst :: forall f a b c. GFirst f => (a -> b) -> f a c -> f b c+gfirst f = with @(GFirstRep a b c f) (to . gmapRep (defaultIncoherent f) . from)++-- | Generic implementation of 'second' from 'Bifunctor'. See also 'GenericBifunctor'.+gsecond :: forall f a c d. GSecond f => (c -> d) -> f a c -> f a d+gsecond = gfmap++-- *** Fold++-- | Generic implementation of 'foldMap' from 'Foldable'.+gfoldMap :: forall t m a. (GFoldMap m t, Monoid m) => (a -> m) -> t a -> m+gfoldMap f =+  with @(GFoldMapRep a a m t) (gfoldMapRep (defaultIncoherent (Fold @m @a @a f)) . from)++-- | Generic implementation of 'bifoldMap' from 'Bifoldable'.+gbifoldMap :: forall t m a b. (GBifoldMap m t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m+gbifoldMap f g =+  with @(GBifoldMapRep a a b b m t) (gfoldMapRep (defaultIncoherent (Fold @m @a @a f :+ Fold @m @b @b g)) . from)++-- *** Traverse++-- | Generic implementation of 'traverse' from 'Traversable'.+gtraverse :: forall t f a b. (GTraverse f t, Applicative f) => (a -> f b) -> t a -> f (t b)+gtraverse f = with @(GTraverseRep a b f t) (lowerAps . fmap to . gtraverseRep (defaultIncoherent f) . from)++-- | Generic implementation of 'bitraverse' from 'Bitraversable'.+gbitraverse :: forall t f a b c d. (GBitraverse f t, Applicative f) => (a -> f b) -> (c -> f d) -> t a c -> f (t b d)+gbitraverse f g =+  with @(GBitraverseRep a b c d f t) (lowerAps . fmap to . gtraverseRep (defaultIncoherent (f :+ g)) . from)+++-- | Explicitly require a constraint, to force the instantiation of a quantified constraint.+with :: forall c r. (c => r) -> (c => r)+with x = x++-- ** Top-level constraints++-- *** @gfmap@++-- | Generic 'Functor'. Constraint for 'gfmap'.+class    (forall a. Generic (f a), forall a b. GFunctorRep a b f) => GFunctor f+instance (forall a. Generic (f a), forall a b. GFunctorRep a b f) => GFunctor f++-- | Internal component of 'GFunctor'.+--+-- This is an example of the \"quantified constraints trick\" to encode+-- @forall a b. GMap1 a b (Rep (f a)) (Rep (f b))@ which doesn't actually+-- work as-is.+class    GMap1 (Default Incoherent (a -> b)) (Rep (f a)) (Rep (f b)) => GFunctorRep a b f+instance GMap1 (Default Incoherent (a -> b)) (Rep (f a)) (Rep (f b)) => GFunctorRep a b f++-- *** @gbimap@++-- | Constraint for 'gbimap'.+class    (forall a c. Generic (f a c), forall a b c d. GBimapRep a b c d f) => GBimap f+instance (forall a c. Generic (f a c), forall a b c d. GBimapRep a b c d f) => GBimap f++-- | Internal component of 'GBifunctor'.+class    GMap1 (Default Incoherent ((a -> b) :+ (c -> d))) (Rep (f a c)) (Rep (f b d)) => GBimapRep a b c d f+instance GMap1 (Default Incoherent ((a -> b) :+ (c -> d))) (Rep (f a c)) (Rep (f b d)) => GBimapRep a b c d f++-- *** @gfirst@++-- | Constraint for 'gfirst'.+class    (forall a c. Generic (f a c), forall a b c. GFirstRep a b c f) => GFirst f+instance (forall a c. Generic (f a c), forall a b c. GFirstRep a b c f) => GFirst f++-- | Internal component of 'GFirst'.+class    GMap1 (Default Incoherent (a -> b)) (Rep (f a c)) (Rep (f b c)) => GFirstRep a b c f+instance GMap1 (Default Incoherent (a -> b)) (Rep (f a c)) (Rep (f b c)) => GFirstRep a b c f++-- *** @gsecond@++-- | Constraint for 'gsecond'.+class    (forall a c. Generic (f a c), forall a c d. GFunctorRep c d (f a)) => GSecond f+instance (forall a c. Generic (f a c), forall a c d. GFunctorRep c d (f a)) => GSecond f++-- | Generic 'Bifunctor'.+class    (GBimap f, GFirst f, GSecond f) => GBifunctor f+instance (GBimap f, GFirst f, GSecond f) => GBifunctor f++-- *** @gtraverse@++-- | Constraint for 'gtraverse'.+class    (forall a. Generic (t a), forall a b. GTraverseRep a b f t) => GTraverse f t+instance (forall a. Generic (t a), forall a b. GTraverseRep a b f t) => GTraverse f t++class    GTraverse1 f (Default Incoherent (a -> f b)) (Rep (t a)) (Rep (t b)) => GTraverseRep a b f t+instance GTraverse1 f (Default Incoherent (a -> f b)) (Rep (t a)) (Rep (t b)) => GTraverseRep a b f t++-- | Generic 'Traversable'.+class    (forall f. Applicative f => GBitraverse f t) => GTraversable t+instance (forall f. Applicative f => GBitraverse f t) => GTraversable t++-- | Constraint for 'gtraverse'.+class    (forall a b. Generic (t a b), forall a b c d. GBitraverseRep a b c d f t) => GBitraverse f t+instance (forall a b. Generic (t a b), forall a b c d. GBitraverseRep a b c d f t) => GBitraverse f t++class    GTraverse1 f (Default Incoherent ((a -> f b) :+ (c -> f d))) (Rep (t a c)) (Rep (t b d)) => GBitraverseRep a b c d f t+instance GTraverse1 f (Default Incoherent ((a -> f b) :+ (c -> f d))) (Rep (t a c)) (Rep (t b d)) => GBitraverseRep a b c d f t++-- | Generic 'Bitraversable'.+class    (forall f. Applicative f => GBitraverse f t) => GBitraversable t+instance (forall f. Applicative f => GBitraverse f t) => GBitraversable t++-- *** @foldMap@++-- | Constraint for 'gfoldMap'.+class    (forall a. Generic (t a), forall a b. GFoldMapRep a b m t) => GFoldMap m t+instance (forall a. Generic (t a), forall a b. GFoldMapRep a b m t) => GFoldMap m t++class    GFoldMap1 m (Default Incoherent (Fold m a b)) (Rep (t a)) (Rep (t b)) => GFoldMapRep a b m t+instance GFoldMap1 m (Default Incoherent (Fold m a b)) (Rep (t a)) (Rep (t b)) => GFoldMapRep a b m t++-- | Generic 'Foldable'. Constraint for 'GenericFunctor' (deriving-via 'Foldable').+class    (forall m. Monoid m => GFoldMap m t) => GFoldable t+instance (forall m. Monoid m => GFoldMap m t) => GFoldable t++-- | Constraint for 'gbifoldMap'.+class    (forall a b. Generic (t a b), forall a b c d. GBifoldMapRep a b c d m t) => GBifoldMap m t+instance (forall a b. Generic (t a b), forall a b c d. GBifoldMapRep a b c d m t) => GBifoldMap m t++class    GFoldMap1 m (Default Incoherent (Fold m a b :+ Fold m c d)) (Rep (t a c)) (Rep (t b d)) => GBifoldMapRep a b c d m t+instance GFoldMap1 m (Default Incoherent (Fold m a b :+ Fold m c d)) (Rep (t a c)) (Rep (t b d)) => GBifoldMapRep a b c d m t++-- | Generic 'Foldable'. Constraint for 'GenericFunctor' (deriving-via 'Foldable').+class    (forall m. Monoid m => GBifoldMap m t) => GBifoldable t+instance (forall m. Monoid m => GBifoldMap m t) => GBifoldable t++-- *** Others++-- | Constraint for 'gsolomap'.+class    GMultimap (a -> b) x y => GSolomap a b x y+instance GMultimap (a -> b) x y => GSolomap a b x y++-- | Constraint for 'solomap'.+class    Multimap (a -> b) x y => Solomap a b x y+instance Multimap (a -> b) x y => Solomap a b x y++-- | Constraint for 'gmultimap'.+class    GMap1 (Default Incoherent arr) (Rep x) (Rep y) => GMultimap arr x y+instance GMap1 (Default Incoherent arr) (Rep x) (Rep y) => GMultimap arr x y++-- | Constraint for 'multimap'.+class    MultimapI (Default Incoherent arr) x y => Multimap arr x y+instance MultimapI (Default Incoherent arr) x y => Multimap arr x y++-- * Deriving Via++-- ** Functor++-- | @newtype@ for @DerivingVia@ of 'Functor' and 'Foldable' instances.+--+-- Note: the GHC extensions @DeriveFunctor@, @DeriveFoldable@, and @DeriveTraversable@+-- (which implies all three) already works out-of-the-box in most cases.+-- There are exceptions, such as the following example.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric, DerivingVia \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('GenericFunctor'(..))+--+-- data Twice a = Twice (Either a a)+--   deriving 'Generic'+--   deriving ('Functor', 'Foldable') via ('GenericFunctor' Twice)+-- @+newtype GenericFunctor f a = GenericFunctor (f a)++instance GFunctor f => Functor (GenericFunctor f) where+  fmap = coerce1 (gfmap @f)++instance GFoldable f => Foldable (GenericFunctor f) where+  foldMap = coerceFoldMap (gfoldMap @f)++-- ** Bifunctor++-- | @newtype@ for @DerivingVia@ of 'Bifunctor' and 'Bifoldable' instances.+--+-- Note: deriving 'Bifunctor' for a generic type often requires 'Functor'+-- instances for types mentioned in the fields.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric, DerivingVia \#-}+--+-- import "Data.Bifoldable" ('Bifoldable')+-- import "Data.Bifunctor" ('Bifunctor')+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('GenericFunctor'(..), 'GenericBifunctor'(..))+--+-- data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b+--   deriving 'Generic'+--   deriving ('Functor', 'Foldable') via ('GenericFunctor' (Tree a))+--   deriving ('Bifunctor', 'Bifoldable') via ('GenericBifunctor' Tree)+--+-- data CofreeF f a b = a :< f b+--   deriving 'Generic'+--   deriving ('Bifunctor', 'Bifoldable') via ('GenericBifunctor' (CofreeF f))+-- @+newtype GenericBifunctor f a b = GenericBifunctor (f a b)++instance GBifunctor f => Bifunctor (GenericBifunctor f) where+  bimap = coerce2 (gbimap @f)+  first = coerce3 (gfirst @f)+  second = coerce3 (gsecond @f)++instance GBifoldable f => Bifoldable (GenericBifunctor f) where+  bifoldMap = coerceBifoldMap (gbifoldMap @f)++-- ** Internal coercions++coerce1 :: Coercible s t => (r -> s) -> (r -> t)+coerce1 = coerce++coerce2 :: Coercible t u => (r -> s -> t) -> (r -> s -> u)+coerce2 = coerce++coerce3 :: (Coercible w v, Coercible (f b d) (g b d)) => (r -> w -> f b d) -> (r -> v -> g b d)+coerce3 = coerce++coerceFoldMap :: Coercible t u => (am -> t -> m) -> (am -> u -> m)+coerceFoldMap = coerce++coerceBifoldMap :: Coercible t u => (am -> bm -> t -> m) -> (am -> bm -> u -> m)+coerceBifoldMap = coerce++-- ** @GMultimapK@++-- | We use the same class to implement all of 'fmap', 'foldMap', 'traverse',+-- instantiating @m@ as 'Identity', 'Const (EndoM mm)' and 'Aps n' respectively.+-- Those three cases differ in their instances for 'K1'.+--+-- (the K stands for @Kleisli@, because the result is @Kleisli m (f ()) (g ())@+class GMultimapK m arr f g where+  gmultimapK :: arr -> f () -> m (g ())++-- *** Instance for @fmap@++instance MultimapI arr x y => GMultimapK Identity arr (K1 i x) (K1 i' y) where+  gmultimapK = coerce (multimapI @arr @x @y)++class    GMultimapK Identity arr f g => GMap1 arr f g+instance GMultimapK Identity arr f g => GMap1 arr f g++gmapRep :: GMap1 arr f g => arr -> f () -> g ()+gmapRep f x = runIdentity (gmultimapK f x)++-- *** Instance for @foldMap@++instance (Multifold_ m arr x y, Monoid m) => GMultimapK (Const (EndoM m)) arr (K1 i x) (K1 i' y) where+  gmultimapK f (K1 x) = K1 <$> foldToConst (multifold_ f) x++-- Spooky instance. It makes sense only because @GMultimapK (Const (EndoM m))@+-- occurs exclusively under a quantified constraint (in the definition of GFoldMap).+instance {-# INCOHERENT #-} GMultimapK (Const (EndoM m)) arr (K1 i x) (K1 i x) where+  gmultimapK _ (K1 _) = Const (Endo id)++-- An extra wrapper to simplify away @(mempty <> _)@ and @(_ <> mempty)@.+type EndoM m = Endo (Maybe m)++unEndoM :: Monoid m => EndoM m -> m+unEndoM (Endo f) = case f Nothing of+  Nothing -> mempty+  Just y -> y++liftEndoM :: Monoid m => m -> EndoM m+liftEndoM y = Endo (Just . app)+  where+    app Nothing = y+    app (Just y') = y `mappend` y'++foldToConst :: Monoid m => Fold m x y -> x -> Const (EndoM m) y+foldToConst (Fold f) x = Const (liftEndoM (f x))++class    GMultimapK (Const (EndoM m)) arr f g => GFoldMap1 m arr f g+instance GMultimapK (Const (EndoM m)) arr f g => GFoldMap1 m arr f g++-- | Danger! @GFoldMap1 m arr f f@ MUST come from a quantified constraint (see use in 'gfoldMap').+gfoldMapRep :: forall m arr f. (GFoldMap1 m arr f f, Monoid m) => arr -> f () -> m+gfoldMapRep f x = unEndoM (getConst (gmultimapK f x :: Const (EndoM m) (f ())))++-- *** Instance for @traverse@++instance (Multitraverse m arr x y) => GMultimapK (Aps m) arr (K1 i x) (K1 i' y) where+  gmultimapK f (K1 x) = K1 <$>^ multitraverse f x++class    GMultimapK (Aps m) arr f g => GTraverse1 m arr f g+instance GMultimapK (Aps m) arr f g => GTraverse1 m arr f g++gtraverseRep :: GTraverse1 m arr f g => arr -> f () -> Aps m (g ())+gtraverseRep = gmultimapK++-- *** Common instances++instance (GMultimapK m arr f g, Functor m) => GMultimapK m arr (M1 i c f) (M1 i' c' g) where+  gmultimapK f (M1 x) = M1 <$> gmultimapK f x++instance+  (GMultimapK m arr f1 g1, GMultimapK m arr f2 g2, Applicative m) =>+  GMultimapK m arr (f1 :+: f2) (g1 :+: g2)+  where+  gmultimapK f (L1 x) = L1 <$> gmultimapK f x+  gmultimapK f (R1 y) = R1 <$> gmultimapK f y++instance+  (GMultimapK m arr f1 g1, GMultimapK m arr f2 g2, Applicative m) =>+  GMultimapK m arr (f1 :*: f2) (g1 :*: g2)+  where+  gmultimapK f (x :*: y) = liftA2 (:*:) (gmultimapK f x) (gmultimapK f y)++instance Applicative m => GMultimapK m arr U1 U1 where+  gmultimapK _ U1 = pure U1++instance GMultimapK m arr V1 V1 where+  gmultimapK _ v = case v of

@@ -1,225 +1,225 @@-{-# LANGUAGE
-  ConstraintKinds,
-  FlexibleContexts,
-  FlexibleInstances,
-  InstanceSigs,
-  MultiParamTypeClasses,
-  RankNTypes,
-  ScopedTypeVariables,
-  TypeApplications,
-  TypeFamilies,
-  TypeOperators,
-  UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
-
-module Generic.Functor.Internal.Implicit where
-
-import Control.Arrow (Kleisli (..))
-import Data.Bifunctor (Bifunctor (..))
-import Data.Bifoldable (Bifoldable (..))
-import Data.Bitraversable (Bitraversable (..))
-import Data.Coerce (Coercible, coerce)
-import Data.Kind (Type)
-
--- | Core of 'multimap'
-multimapI :: forall arr x y. MultimapI arr x y => arr -> (x -> y)
-multimapI = multimapOf
-
-multitraverse :: forall f arr x y. Multitraverse f arr x y => arr -> (x -> f y)
-multitraverse f = runKleisli (multimapOf (coerce f :: WrapKleisli f arr))
-
--- | This is kept internal because of the 'Fold' wrapping.
-multifold_ :: forall m arr x y. Multifold_ m arr x y => arr -> Fold m x y
-multifold_ = multimapOf
-
-multimapOf :: forall cat arr x y. MultimapOf cat arr x y => arr -> cat x y
-multimapOf f = multimap_ (s2 f)
-
--- | Core of 'multimap'.
-class    MultimapOf (->) arr x y => MultimapI arr x y
-instance MultimapOf (->) arr x y => MultimapI arr x y
-
--- | Constraint for 'multifold_'.
-class    MultimapOf (Fold m) arr x y => Multifold_ m arr x y
-instance MultimapOf (Fold m) arr x y => Multifold_ m arr x y
-
--- | Constraint for 'multitraverse'.
-class    Multitraverse_ f arr x y => Multitraverse f arr x y
-instance Multitraverse_ f arr x y => Multitraverse f arr x y
-
--- | Internal definition of 'Multitraverse'
-type Multitraverse_ f arr x y =
-  ( MultimapOf (Kleisli f) (WrapKleisli f arr) x y,
-    CoercibleKleisli f (WrapKleisli f arr) arr
-  )
-
-type family WrapKleisli (f :: Type -> Type) (arr :: Type)
-type instance WrapKleisli _f NilArr = NilArr
-type instance WrapKleisli _f (Rule rule mode)= Rule rule mode
-type instance WrapKleisli f (a :+ arr) = WrapKleisli f a :+ WrapKleisli f arr
-type instance WrapKleisli f (a -> f b) = Kleisli f a b
-
--- | Auxiliary constraint for 'Multitraverse'
-class Coercible warr arr => CoercibleKleisli (f :: Type -> Type) warr arr
-instance (d ~ NilArr) => CoercibleKleisli f d NilArr
-instance (d ~ Rule rule mode) => CoercibleKleisli f d (Rule rule mode)
-instance (CoercibleKleisli f a b, CoercibleKleisli f arr arr') => CoercibleKleisli f (a :+ arr) (b :+ arr')
-instance (b2 ~ f c, a ~ Kleisli f b1 c) => CoercibleKleisli f a (b1 -> b2)
-
-class    Multimap_ cat (S2 arr) x y => MultimapOf cat arr x y
-instance Multimap_ cat (S2 arr) x y => MultimapOf cat arr x y
-
--- | @Fold m@ is like @Kleisli (Const m)@, but it has a different @FunctorOf@ instance,
--- with 'Foldable' instead of 'Traversable'.
-newtype Fold m x y = Fold { unFold :: x -> m }
-
-instance Monoid m => CatLike (Fold m) where
-  catid = Fold (\_ -> mempty)
-
-instance (Foldable t, Monoid m) => FunctorOf (Fold m) t where
-  catmap (Fold f) = Fold (foldMap f)
-
-instance (Bifoldable t, Monoid m) => BifunctorOf (Fold m) t where
-  catbimap (Fold f) (Fold g) = Fold (bifoldMap f g)
-
--- * Internal
-
-class CatLike cat where
-  catid :: cat x x
-
-instance CatLike (->) where
-  catid = id
-
-instance Applicative f => CatLike (Kleisli f) where
-  catid = Kleisli pure
-
-class FunctorOf cat t where
-  catmap :: cat a b -> cat (t a) (t b)
-
-instance Functor t => FunctorOf (->) t where
-  catmap = fmap
-
-instance (Applicative f, Traversable t) => FunctorOf (Kleisli f) t where
-  catmap :: forall a b. Kleisli f a b -> Kleisli f (t a) (t b)
-  catmap = coerce (traverse @t @f @a @b)
-
-class BifunctorOf cat t where
-  catbimap :: cat a b -> cat c d -> cat (t a c) (t b d)
-
-instance Bifunctor t => BifunctorOf (->) t where
-  catbimap = bimap
-
-instance (Applicative f, Bitraversable t) => BifunctorOf (Kleisli f) t where
-  catbimap :: forall a b c d. Kleisli f a b -> Kleisli f c d -> Kleisli f (t a c) (t b d)
-  catbimap = coerce (bitraverse @t @f @a @b @c @d)
-
--- | Internal implementation of 'MultimapOf'.
-class Multimap_ cat arr x y where
-  multimap_ :: arr -> cat x y
-
--- | Heterogeneous lists of arrows are constructed as lists separated by
--- @(':+')@ and terminated by @()@.
---
--- === Example
---
--- Given @f :: a -> a'@ and @g :: b -> b'@,
--- @(f ':+' g ':+' ())@ is a list with the two elements @f@ and @g@.
---
--- @
--- if
---   f :: a -> a'
---   g :: b -> b'
---
--- then
---   f ':+' g ':+' ()  ::  (a -> a') ':+' (b -> b') ':+' ()
--- @
---
--- Those lists are used by 'gmultimap' and 'multimap'.
---
--- @
--- bimap_ :: (a -> a') -> (b -> b') -> (Maybe a, [Either b a]) -> (Maybe a', [Either b' a'])
--- bimap_ f g = 'multimap' (f ':+' g ':+' ())
--- @
-data a :+ b = a :+ b
-
-infixr 1 :+
-
--- Special arrows
-
-data Rule rule mode = Rule rule mode
-data AnyId = AnyId
-data AnyFunctor = AnyFunctor
-data AnyBifunctor = AnyBifunctor
-data NilArr = NilArr
-
-data Incoherent = Incoherent
-
-type Default mode arr = arr :+ Rule AnyId mode :+ Rule AnyFunctor mode :+ Rule AnyBifunctor mode :+ NilArr
-
-defaultIncoherent :: arr -> Default Incoherent arr
-defaultIncoherent = def Incoherent
-
-def :: mode -> arr -> Default mode arr
-def mode arr = arr :+ Rule AnyId mode :+ Rule AnyFunctor mode :+ Rule AnyBifunctor mode :+ NilArr
-
--- | @arr@ is the list of arrows provided by the user. It is constant.
--- When testing whether any arrow matches, @arr'@ is the remaining list of
--- arrows to be tested.
-data S arr arr' = S arr arr'
-
-type S2 arr = S arr arr
-
-s2 :: arr -> S2 arr
-s2 f = S f f
-
--- The head doesn't match anything, go to the next thing.
-instance {-# OVERLAPPABLE #-} Multimap_ cat (S arr arr') x y => Multimap_ cat (S arr (arr0 :+ arr')) x y where
-  multimap_ (S f (_ :+ g')) = multimap_ (S f g')
-
--- Reassociate to even handle tree-shaped parameters.
-instance Multimap_ cat (S arr (arr0 :+ arr1 :+ arr2)) x y => Multimap_ cat (S arr ((arr0 :+ arr1) :+ arr2)) x y where
-  multimap_ (S f ((f0 :+ f1) :+ f2)) = multimap_ (S f (f0 :+ f1 :+ f2))
-
-instance Multimap_ cat (S arr arr') x y => Multimap_ cat (S arr (NilArr :+ arr')) x y where
-  multimap_ (S f (NilArr :+ f')) = multimap_ (S f f')
-
-instance Multimap_ cat (S arr arr') x y => Multimap_ cat (S arr (() :+ arr')) x y where
-  multimap_ (S f (() :+ f')) = multimap_ (S f f')
-
-instance {-# INCOHERENT #-} Multimap_ cat (S arr (cat a b :+ arr')) a b where
-  multimap_ (S _ (f :+ _)) = f
-
--- "id" instance
-instance {-# INCOHERENT #-} CatLike cat => Multimap_ cat (S arr (Rule AnyId Incoherent :+ arr')) x x where
-  multimap_ _ = catid
-
--- "Functor" instance
--- Note: if x ~ y, then @AnyId Incoherent@ should already have matched earlier
--- (if you remembered to put it in the list),
--- so we don't need another overlapping instance here.
-instance
-  {-# INCOHERENT #-}
-  (FunctorOf cat f, MultimapOf cat arr x y) =>
-  Multimap_ cat (S arr (Rule AnyFunctor Incoherent :+ arr')) (f x) (f y)
-  where
-  multimap_ (S f (Rule AnyFunctor Incoherent :+ _)) = catmap (multimapOf f)
-
--- "Bifunctor" instance.
--- Note: the overlap with AnyId (where x1 ~ y1, x2 ~ y2) and AnyFunctor (where x1 ~ x2)
--- is handled by putting those rules before AnyBifunctor in the list.
-instance
-  {-# INCOHERENT #-}
-  (BifunctorOf cat f, MultimapOf cat arr x1 y1, MultimapOf cat arr x2 y2) =>
-  Multimap_ cat (S arr (Rule AnyBifunctor Incoherent :+ arr')) (f x1 x2) (f y1 y2)
-  where
-  multimap_ (S f (Rule AnyBifunctor Incoherent :+ _)) = catbimap (multimapOf f) (multimapOf f)
-
--- Hardcoded special case for (->)
--- We know how to "Multimap_ (->)" over (->),
--- not "Multimap_ (Kleisli f)".
-instance
-  {-# INCOHERENT #-}
-  (MultimapOf (->) arr y1 x1, MultimapOf (->) arr x2 y2) =>
-  Multimap_ (->) (S arr (Rule AnyBifunctor Incoherent :+ arr')) (x1 -> x2) (y1 -> y2)
-  where
+{-# LANGUAGE+  ConstraintKinds,+  FlexibleContexts,+  FlexibleInstances,+  InstanceSigs,+  MultiParamTypeClasses,+  RankNTypes,+  ScopedTypeVariables,+  TypeApplications,+  TypeFamilies,+  TypeOperators,+  UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++module Generic.Functor.Internal.Implicit where++import Control.Arrow (Kleisli (..))+import Data.Bifunctor (Bifunctor (..))+import Data.Bifoldable (Bifoldable (..))+import Data.Bitraversable (Bitraversable (..))+import Data.Coerce (Coercible, coerce)+import Data.Kind (Type)++-- | Core of 'multimap'+multimapI :: forall arr x y. MultimapI arr x y => arr -> (x -> y)+multimapI = multimapOf++multitraverse :: forall f arr x y. Multitraverse f arr x y => arr -> (x -> f y)+multitraverse f = runKleisli (multimapOf (coerce f :: WrapKleisli f arr))++-- | This is kept internal because of the 'Fold' wrapping.+multifold_ :: forall m arr x y. Multifold_ m arr x y => arr -> Fold m x y+multifold_ = multimapOf++multimapOf :: forall cat arr x y. MultimapOf cat arr x y => arr -> cat x y+multimapOf f = multimap_ (s2 f)++-- | Core of 'multimap'.+class    MultimapOf (->) arr x y => MultimapI arr x y+instance MultimapOf (->) arr x y => MultimapI arr x y++-- | Constraint for 'multifold_'.+class    MultimapOf (Fold m) arr x y => Multifold_ m arr x y+instance MultimapOf (Fold m) arr x y => Multifold_ m arr x y++-- | Constraint for 'multitraverse'.+class    Multitraverse_ f arr x y => Multitraverse f arr x y+instance Multitraverse_ f arr x y => Multitraverse f arr x y++-- | Internal definition of 'Multitraverse'+type Multitraverse_ f arr x y =+  ( MultimapOf (Kleisli f) (WrapKleisli f arr) x y,+    CoercibleKleisli f (WrapKleisli f arr) arr+  )++type family WrapKleisli (f :: Type -> Type) (arr :: Type)+type instance WrapKleisli _f NilArr = NilArr+type instance WrapKleisli _f (Rule rule mode)= Rule rule mode+type instance WrapKleisli f (a :+ arr) = WrapKleisli f a :+ WrapKleisli f arr+type instance WrapKleisli f (a -> f b) = Kleisli f a b++-- | Auxiliary constraint for 'Multitraverse'+class Coercible warr arr => CoercibleKleisli (f :: Type -> Type) warr arr+instance (d ~ NilArr) => CoercibleKleisli f d NilArr+instance (d ~ Rule rule mode) => CoercibleKleisli f d (Rule rule mode)+instance (CoercibleKleisli f a b, CoercibleKleisli f arr arr') => CoercibleKleisli f (a :+ arr) (b :+ arr')+instance (b2 ~ f c, a ~ Kleisli f b1 c) => CoercibleKleisli f a (b1 -> b2)++class    Multimap_ cat (S2 arr) x y => MultimapOf cat arr x y+instance Multimap_ cat (S2 arr) x y => MultimapOf cat arr x y++-- | @Fold m@ is like @Kleisli (Const m)@, but it has a different @FunctorOf@ instance,+-- with 'Foldable' instead of 'Traversable'.+newtype Fold m x y = Fold { unFold :: x -> m }++instance Monoid m => CatLike (Fold m) where+  catid = Fold (\_ -> mempty)++instance (Foldable t, Monoid m) => FunctorOf (Fold m) t where+  catmap (Fold f) = Fold (foldMap f)++instance (Bifoldable t, Monoid m) => BifunctorOf (Fold m) t where+  catbimap (Fold f) (Fold g) = Fold (bifoldMap f g)++-- * Internal++class CatLike cat where+  catid :: cat x x++instance CatLike (->) where+  catid = id++instance Applicative f => CatLike (Kleisli f) where+  catid = Kleisli pure++class FunctorOf cat t where+  catmap :: cat a b -> cat (t a) (t b)++instance Functor t => FunctorOf (->) t where+  catmap = fmap++instance (Applicative f, Traversable t) => FunctorOf (Kleisli f) t where+  catmap :: forall a b. Kleisli f a b -> Kleisli f (t a) (t b)+  catmap = coerce (traverse @t @f @a @b)++class BifunctorOf cat t where+  catbimap :: cat a b -> cat c d -> cat (t a c) (t b d)++instance Bifunctor t => BifunctorOf (->) t where+  catbimap = bimap++instance (Applicative f, Bitraversable t) => BifunctorOf (Kleisli f) t where+  catbimap :: forall a b c d. Kleisli f a b -> Kleisli f c d -> Kleisli f (t a c) (t b d)+  catbimap = coerce (bitraverse @t @f @a @b @c @d)++-- | Internal implementation of 'MultimapOf'.+class Multimap_ cat arr x y where+  multimap_ :: arr -> cat x y++-- | Heterogeneous lists of arrows are constructed as lists separated by+-- @(':+')@ and terminated by @()@.+--+-- === Example+--+-- Given @f :: a -> a'@ and @g :: b -> b'@,+-- @(f ':+' g ':+' ())@ is a list with the two elements @f@ and @g@.+--+-- @+-- if+--   f :: a -> a'+--   g :: b -> b'+--+-- then+--   f ':+' g ':+' ()  ::  (a -> a') ':+' (b -> b') ':+' ()+-- @+--+-- Those lists are used by 'gmultimap' and 'multimap'.+--+-- @+-- bimap_ :: (a -> a') -> (b -> b') -> (Maybe a, [Either b a]) -> (Maybe a', [Either b' a'])+-- bimap_ f g = 'multimap' (f ':+' g ':+' ())+-- @+data a :+ b = a :+ b++infixr 1 :+++-- Special arrows++data Rule rule mode = Rule rule mode+data AnyId = AnyId+data AnyFunctor = AnyFunctor+data AnyBifunctor = AnyBifunctor+data NilArr = NilArr++data Incoherent = Incoherent++type Default mode arr = arr :+ Rule AnyId mode :+ Rule AnyFunctor mode :+ Rule AnyBifunctor mode :+ NilArr++defaultIncoherent :: arr -> Default Incoherent arr+defaultIncoherent = def Incoherent++def :: mode -> arr -> Default mode arr+def mode arr = arr :+ Rule AnyId mode :+ Rule AnyFunctor mode :+ Rule AnyBifunctor mode :+ NilArr++-- | @arr@ is the list of arrows provided by the user. It is constant.+-- When testing whether any arrow matches, @arr'@ is the remaining list of+-- arrows to be tested.+data S arr arr' = S arr arr'++type S2 arr = S arr arr++s2 :: arr -> S2 arr+s2 f = S f f++-- The head doesn't match anything, go to the next thing.+instance {-# OVERLAPPABLE #-} Multimap_ cat (S arr arr') x y => Multimap_ cat (S arr (arr0 :+ arr')) x y where+  multimap_ (S f (_ :+ g')) = multimap_ (S f g')++-- Reassociate to even handle tree-shaped parameters.+instance Multimap_ cat (S arr (arr0 :+ arr1 :+ arr2)) x y => Multimap_ cat (S arr ((arr0 :+ arr1) :+ arr2)) x y where+  multimap_ (S f ((f0 :+ f1) :+ f2)) = multimap_ (S f (f0 :+ f1 :+ f2))++instance Multimap_ cat (S arr arr') x y => Multimap_ cat (S arr (NilArr :+ arr')) x y where+  multimap_ (S f (NilArr :+ f')) = multimap_ (S f f')++instance Multimap_ cat (S arr arr') x y => Multimap_ cat (S arr (() :+ arr')) x y where+  multimap_ (S f (() :+ f')) = multimap_ (S f f')++instance {-# INCOHERENT #-} Multimap_ cat (S arr (cat a b :+ arr')) a b where+  multimap_ (S _ (f :+ _)) = f++-- "id" instance+instance {-# INCOHERENT #-} CatLike cat => Multimap_ cat (S arr (Rule AnyId Incoherent :+ arr')) x x where+  multimap_ _ = catid++-- "Functor" instance+-- Note: if x ~ y, then @AnyId Incoherent@ should already have matched earlier+-- (if you remembered to put it in the list),+-- so we don't need another overlapping instance here.+instance+  {-# INCOHERENT #-}+  (FunctorOf cat f, MultimapOf cat arr x y) =>+  Multimap_ cat (S arr (Rule AnyFunctor Incoherent :+ arr')) (f x) (f y)+  where+  multimap_ (S f (Rule AnyFunctor Incoherent :+ _)) = catmap (multimapOf f)++-- "Bifunctor" instance.+-- Note: the overlap with AnyId (where x1 ~ y1, x2 ~ y2) and AnyFunctor (where x1 ~ x2)+-- is handled by putting those rules before AnyBifunctor in the list.+instance+  {-# INCOHERENT #-}+  (BifunctorOf cat f, MultimapOf cat arr x1 y1, MultimapOf cat arr x2 y2) =>+  Multimap_ cat (S arr (Rule AnyBifunctor Incoherent :+ arr')) (f x1 x2) (f y1 y2)+  where+  multimap_ (S f (Rule AnyBifunctor Incoherent :+ _)) = catbimap (multimapOf f) (multimapOf f)++-- Hardcoded special case for (->)+-- We know how to "Multimap_ (->)" over (->),+-- not "Multimap_ (Kleisli f)".+instance+  {-# INCOHERENT #-}+  (MultimapOf (->) arr y1 x1, MultimapOf (->) arr x2 y2) =>+  Multimap_ (->) (S arr (Rule AnyBifunctor Incoherent :+ arr')) (x1 -> x2) (y1 -> y2)+  where   multimap_ (S f (Rule AnyBifunctor Incoherent :+ _)) u = multimapOf f . u . multimapOf f

@@ -0,0 +1,70 @@+{- | Generalized functors, where the type parameter(s) may be nested in+arbitrary compositions of functors.++Note that these functions are __unsafe__ because they rely on incoherent+instances.++See the <#gsolomapusage Usage> section of 'gsolomap' for details.++=== Example++@+{-\# LANGUAGE DeriveGeneric \#-}+module Main where++import "Generic.Functor"+import "GHC.Generics" ('GHC.Generics.Generic')++data T a b = C Int a b+  deriving (Show, 'GHC.Generics.Generic')++fmapT :: (b -> b') -> T a b -> T a b'+fmapT = 'gsolomap'++firstT :: (a -> a') -> T a b -> T a' b+firstT = 'gsolomap'++bothT :: (a -> a') -> T a a -> T a' a'+bothT = 'gsolomap'++watT ::+  (a -> a') ->+  T (a , a ) ((a  -> a') -> Maybe a ) ->+  T (a', a') ((a' -> a ) -> Maybe a')+watT = 'gsolomap'++-- Incoherence test+main :: IO ()+main = do+  print (fmapT    ((+1) :: Int -> Int) (C 0 0 0 :: T Int Int))+  print ('gsolomap' ((+1) :: Int -> Int) (C 0 0 0 :: T Int Int) :: T Int Int)+  -- NB: Type annotations are needed on both the input and output T Int Int.+  putStrLn "We are not the same."++  -- Output:+  --     C 0 0 1+  --     C 1 1 1+  --     We are not the same.+@+-}++module Generic.Functor.Multimap+  (+    -- ** Unary functors+    gsolomap+  , solomap++    -- ** N-ary functors+  , gmultimap+  , multimap+  , (:+)(..)++    -- ** Generalized functors+  , GSolomap()+  , Solomap()+  , GMultimap()+  , Multimap()+  ) where++import Generic.Functor.Internal+import Generic.Functor.Internal.Implicit

@@ -1,220 +1,221 @@-{-# LANGUAGE
-  DeriveFoldable,
-  DeriveGeneric,
-  DerivingVia,
-  StandaloneDeriving,
-  TypeOperators #-}
-
-import Control.Monad.Trans.State ( evalState, state, State )
-import Data.Bifoldable ( Bifoldable() )
-import Data.Bifunctor ( Bifunctor(bimap) )
-import GHC.Generics ( Generic )
-import System.Exit (exitFailure)
-
-import Generic.Functor
-    ( gmultimap,
-      gsolomap,
-      gtraverse,
-      multimap,
-      solomap,
-      GenericBifunctor(..),
-      GenericFunctor(..),
-      type (:+)((:+)) )
-
--- Testing GenericFunctor (gfmap) and gsolomap
-
-data Empty a
-  deriving Generic
-  deriving (Functor, Foldable) via (GenericFunctor Empty)
-
-data Unit a = Unit
-  deriving (Eq, Show, Generic)
-  deriving (Functor, Foldable) via (GenericFunctor Unit)
-
-data Result a r = Error a | Ok r
-  deriving (Eq, Show, Generic)
-  deriving (Functor, Foldable) via (GenericFunctor (Result a))
-
-instance Traversable Empty where
-  traverse = gtraverse
-
-instance Traversable Unit where
-  traverse = gtraverse
-
-instance Traversable (Result a) where
-  traverse = gtraverse
-  
-mapError :: (a -> b) -> Result a r -> Result b r
-mapError = gsolomap
-
-mapOk :: (r -> s) -> Result a r -> Result a s
-mapOk = gsolomap
-
-mapBoth :: (a -> b) -> Result a a -> Result b b
-mapBoth = gsolomap
-
-data Writer w a = Writer w a
-  deriving (Eq, Show, Generic)
-  deriving (Functor, Foldable) via (GenericFunctor (Writer w))
-
-instance Traversable (Writer w) where
-  traverse = gtraverse
-
-mapW :: (w -> w') -> Writer w a -> Writer w' a
-mapW = gsolomap
-
-data Square a b = Square a a b b
-  deriving (Eq, Show, Generic)
-  deriving (Functor, Foldable) via (GenericFunctor (Square a))
-
-instance Traversable (Square a) where
-  traverse = gtraverse
-
-mapFirst :: (a -> a') -> Square a b -> Square a' b
-mapFirst = gsolomap
-
-data Twice a = Twice (Either a a)
-  deriving (Eq, Show, Generic)
-  deriving (Functor, Foldable) via (GenericFunctor Twice)
-
-instance Traversable Twice where
-  traverse = gtraverse
-
--- Testing solomap
-
-map1, map1' :: (a -> b) -> Either e (Maybe [(e, a)]) -> Either e (Maybe [(e, b)])
-map1 = solomap
-map1' = fmap . fmap . fmap . fmap  -- equivalent definition, just making sure it typechecks
-
-map2, map2' :: (a -> b) -> (e -> Either [a] r) -> (e -> Either [b] r)
-map2 = solomap
-map2' f = fmap (bimap (fmap f) id)
-
-type F a = ([a], Either a ())
-
-map3, map3' :: (a -> b) -> F a -> F b
-map3 = solomap
-map3' f = bimap (fmap f) (bimap f id)
-
-type G t a = (t, Maybe [Either Bool a])
-
-map4, map4', map4'' :: (a -> b) -> G t a -> G t b
-map4 = solomap
-map4' = fmap . fmap . fmap . fmap
-map4'' = multimap
-
-map6, map6' :: (a -> b) -> (c -> d) -> G a c -> G b d
-map6 f g = multimap (f :+ g)
-map6' f = bimap f . fmap . fmap . fmap
-
--- Deriving Bifunctor
-
-data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b
-  deriving (Eq, Show, Generic)
-  deriving (Functor, Foldable) via (GenericFunctor (Tree a))
-  deriving (Bifunctor, Bifoldable) via (GenericBifunctor Tree)
-
-instance Traversable (Tree a) where
-  traverse = gtraverse
-
-data CofreeF f a b = a :< f b
-  deriving (Eq, Show, Generic)
-  deriving (Bifunctor, Bifoldable) via (GenericBifunctor (CofreeF f))
-
-deriving via GenericFunctor (CofreeF f a) instance Foldable f => Foldable (CofreeF f a)
-deriving via GenericFunctor (CofreeF f a) instance Functor f => Functor (CofreeF f a)
-
-instance Traversable f => Traversable (CofreeF f a) where
-  traverse = gtraverse
-
-bimapCofreeF' :: Functor f => (a -> b) -> (c -> d) -> CofreeF f a c -> CofreeF f b d
-bimapCofreeF' f g = gmultimap (f :+ g)
-
--- Multimap
-
-data Three a b c = One a | Two b | Three c
-  deriving (Eq, Show, Generic)
-  deriving (Functor, Foldable) via (GenericFunctor (Three a b))
-
-instance Traversable (Three a b) where
-  traverse = gtraverse
-
-mapThree :: (a -> a') -> (b -> b') -> (c -> c') -> Three a b c -> Three a' b' c'
-mapThree f g h = gmultimap (f :+ g :+ h)
-
-type F5 a b c = Either a (b, c)
-
-map5, map5' :: (a -> a') -> (b -> b') -> (c -> c') -> F5 a b c -> F5 a' b' c'
-map5 f g h = multimap (f :+ g :+ h)
-map5' f g h = bimap f (bimap g h)
-
--- Run at least once
-
-twice :: Int -> Int
-twice = (* 2)
-
-foldTest :: Foldable t => t Int -> Int
-foldTest = sum  -- specialized
-
-tick :: Int -> State Int Int
-tick _ = state (\i -> (i, i+1))
-
-travTest :: Traversable t => t Int -> t Int
-travTest = (`evalState` 0) . traverse tick
-
-main :: IO ()
-main = do
-  Unit @= fmap twice Unit
-  Ok 8 @= fmap twice (Ok 4 :: Result () Int)
-  Error 8 @= mapError twice (Error 4 :: Result Int ())
-  Writer () 8 @= fmap twice (Writer () 4)
-  Writer 8 () @= mapW twice (Writer 4 ())
-  Square () () 8 10 @= fmap twice (Square () () 4 5)
-  Square 8 10 () () @= mapFirst twice (Square 4 5 () ())
-  [Twice (Left 8), Twice (Right 10)] @= (fmap . fmap) twice [Twice (Left 4), Twice (Right 5)]
-  Node 8 (Leaf 10) (Leaf 12) @= bimap twice twice (Node 4 (Leaf 5) (Leaf 6))
-  (8 :< Just 10) @= bimap twice twice (4 :< Just 5)
-  [One 8, Two False, Three 1] @= fmap (mapThree twice not length) [One 4, Two True, Three [()]]
-
-  let t1 = Right (Just [((), 4)])
-  map1 twice t1 @= map1' twice t1
-
-  let t2 x = Left [x] :: Either [Int] ()
-  map2 twice t2 4 @= map2' twice t2 4
-
-  let t3 = ([4], Left 5)
-  map3 twice t3 @= map3' twice t3
-
-  let t4 = ((), Just [Right 4])
-  map4 twice t4 @= map4' twice t4
-  map4 twice t4 @= map4'' twice t4
-
-  map6 (const True) twice t4 @= map6' (const True) twice t4
-
-  let t5 = [Left 4, Right (False, [()])]
-  fmap (map5 twice not length) t5 @= fmap (map5 twice not length) t5
-
-  -- Foldable
-  0 @= foldTest Unit
-  4 @= foldTest (Ok 4 :: Result () Int)
-  0 @= foldTest (Error 4 :: Result Int Int)
-  4 @= foldTest (Writer () 4)
-  9 @= foldTest (Square () () 4 5)
-  3 @= foldTest (Node 4 (Leaf 1) (Leaf 2) :: Tree Int Int)
-
-  -- Traversable
-  Unit @= travTest Unit
-  Ok 0 @= travTest (Ok 4 :: Result () Int)
-  Error 4 @= travTest (Error 4 :: Result Int Int)
-  Writer () 0 @= travTest (Writer () 4)
-  Square () () 0 1 @= travTest (Square () () 4 5)
-  Node 4 (Leaf 0) (Leaf 1) @= travTest (Node 4 (Leaf 5) (Leaf 6) :: Tree Int Int)
-
--- Assert equality
-(@=) :: (Eq a, Show a) => a -> a -> IO ()
-(@=) x y | x == y = pure ()
-         | otherwise = do
-  putStrLn "Not equal:"
-  print x
-  print y
-  exitFailure
+{-# LANGUAGE+  DeriveFoldable,+  DeriveGeneric,+  DerivingVia,+  StandaloneDeriving,+  TypeOperators #-}++import Control.Monad.Trans.State ( evalState, state, State )+import Data.Bifoldable ( Bifoldable() )+import Data.Bifunctor ( Bifunctor(bimap) )+import GHC.Generics ( Generic )+import System.Exit (exitFailure)++import Generic.Functor+    ( gtraverse,+      GenericBifunctor(..),+      GenericFunctor(..) )+import Generic.Functor.Multimap+    ( gmultimap,+      gsolomap,+      multimap,+      solomap,+      type (:+)((:+)) )++-- Testing GenericFunctor (gfmap) and gsolomap++data Empty a+  deriving Generic+  deriving (Functor, Foldable) via (GenericFunctor Empty)++data Unit a = Unit+  deriving (Eq, Show, Generic)+  deriving (Functor, Foldable) via (GenericFunctor Unit)++data Result a r = Error a | Ok r+  deriving (Eq, Show, Generic)+  deriving (Functor, Foldable) via (GenericFunctor (Result a))++instance Traversable Empty where+  traverse = gtraverse++instance Traversable Unit where+  traverse = gtraverse++instance Traversable (Result a) where+  traverse = gtraverse+  +mapError :: (a -> b) -> Result a r -> Result b r+mapError = gsolomap++mapOk :: (r -> s) -> Result a r -> Result a s+mapOk = gsolomap++mapBoth :: (a -> b) -> Result a a -> Result b b+mapBoth = gsolomap++data Writer w a = Writer w a+  deriving (Eq, Show, Generic)+  deriving (Functor, Foldable) via (GenericFunctor (Writer w))++instance Traversable (Writer w) where+  traverse = gtraverse++mapW :: (w -> w') -> Writer w a -> Writer w' a+mapW = gsolomap++data Square a b = Square a a b b+  deriving (Eq, Show, Generic)+  deriving (Functor, Foldable) via (GenericFunctor (Square a))++instance Traversable (Square a) where+  traverse = gtraverse++mapFirst :: (a -> a') -> Square a b -> Square a' b+mapFirst = gsolomap++data Twice a = Twice (Either a a)+  deriving (Eq, Show, Generic)+  deriving (Functor, Foldable) via (GenericFunctor Twice)++instance Traversable Twice where+  traverse = gtraverse++-- Testing solomap++map1, map1' :: (a -> b) -> Either e (Maybe [(e, a)]) -> Either e (Maybe [(e, b)])+map1 = solomap+map1' = fmap . fmap . fmap . fmap  -- equivalent definition, just making sure it typechecks++map2, map2' :: (a -> b) -> (e -> Either [a] r) -> (e -> Either [b] r)+map2 = solomap+map2' f = fmap (bimap (fmap f) id)++type F a = ([a], Either a ())++map3, map3' :: (a -> b) -> F a -> F b+map3 = solomap+map3' f = bimap (fmap f) (bimap f id)++type G t a = (t, Maybe [Either Bool a])++map4, map4', map4'' :: (a -> b) -> G t a -> G t b+map4 = solomap+map4' = fmap . fmap . fmap . fmap+map4'' = multimap++map6, map6' :: (a -> b) -> (c -> d) -> G a c -> G b d+map6 f g = multimap (f :+ g)+map6' f = bimap f . fmap . fmap . fmap++-- Deriving Bifunctor++data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b+  deriving (Eq, Show, Generic)+  deriving (Functor, Foldable) via (GenericFunctor (Tree a))+  deriving (Bifunctor, Bifoldable) via (GenericBifunctor Tree)++instance Traversable (Tree a) where+  traverse = gtraverse++data CofreeF f a b = a :< f b+  deriving (Eq, Show, Generic)+  deriving (Bifunctor, Bifoldable) via (GenericBifunctor (CofreeF f))++deriving via GenericFunctor (CofreeF f a) instance Foldable f => Foldable (CofreeF f a)+deriving via GenericFunctor (CofreeF f a) instance Functor f => Functor (CofreeF f a)++instance Traversable f => Traversable (CofreeF f a) where+  traverse = gtraverse++bimapCofreeF' :: Functor f => (a -> b) -> (c -> d) -> CofreeF f a c -> CofreeF f b d+bimapCofreeF' f g = gmultimap (f :+ g)++-- Multimap++data Three a b c = One a | Two b | Three c+  deriving (Eq, Show, Generic)+  deriving (Functor, Foldable) via (GenericFunctor (Three a b))++instance Traversable (Three a b) where+  traverse = gtraverse++mapThree :: (a -> a') -> (b -> b') -> (c -> c') -> Three a b c -> Three a' b' c'+mapThree f g h = gmultimap (f :+ g :+ h)++type F5 a b c = Either a (b, c)++map5, map5' :: (a -> a') -> (b -> b') -> (c -> c') -> F5 a b c -> F5 a' b' c'+map5 f g h = multimap (f :+ g :+ h)+map5' f g h = bimap f (bimap g h)++-- Run at least once++twice :: Int -> Int+twice = (* 2)++foldTest :: Foldable t => t Int -> Int+foldTest = sum  -- specialized++tick :: Int -> State Int Int+tick _ = state (\i -> (i, i+1))++travTest :: Traversable t => t Int -> t Int+travTest = (`evalState` 0) . traverse tick++main :: IO ()+main = do+  Unit @= fmap twice Unit+  Ok 8 @= fmap twice (Ok 4 :: Result () Int)+  Error 8 @= mapError twice (Error 4 :: Result Int ())+  Writer () 8 @= fmap twice (Writer () 4)+  Writer 8 () @= mapW twice (Writer 4 ())+  Square () () 8 10 @= fmap twice (Square () () 4 5)+  Square 8 10 () () @= mapFirst twice (Square 4 5 () ())+  [Twice (Left 8), Twice (Right 10)] @= (fmap . fmap) twice [Twice (Left 4), Twice (Right 5)]+  Node 8 (Leaf 10) (Leaf 12) @= bimap twice twice (Node 4 (Leaf 5) (Leaf 6))+  (8 :< Just 10) @= bimap twice twice (4 :< Just 5)+  [One 8, Two False, Three 1] @= fmap (mapThree twice not length) [One 4, Two True, Three [()]]++  let t1 = Right (Just [((), 4)])+  map1 twice t1 @= map1' twice t1++  let t2 x = Left [x] :: Either [Int] ()+  map2 twice t2 4 @= map2' twice t2 4++  let t3 = ([4], Left 5)+  map3 twice t3 @= map3' twice t3++  let t4 = ((), Just [Right 4])+  map4 twice t4 @= map4' twice t4+  map4 twice t4 @= map4'' twice t4++  map6 (const True) twice t4 @= map6' (const True) twice t4++  let t5 = [Left 4, Right (False, [()])]+  fmap (map5 twice not length) t5 @= fmap (map5 twice not length) t5++  -- Foldable+  0 @= foldTest Unit+  4 @= foldTest (Ok 4 :: Result () Int)+  0 @= foldTest (Error 4 :: Result Int Int)+  4 @= foldTest (Writer () 4)+  9 @= foldTest (Square () () 4 5)+  3 @= foldTest (Node 4 (Leaf 1) (Leaf 2) :: Tree Int Int)++  -- Traversable+  Unit @= travTest Unit+  Ok 0 @= travTest (Ok 4 :: Result () Int)+  Error 4 @= travTest (Error 4 :: Result Int Int)+  Writer () 0 @= travTest (Writer () 4)+  Square () () 0 1 @= travTest (Square () () 4 5)+  Node 4 (Leaf 0) (Leaf 1) @= travTest (Node 4 (Leaf 5) (Leaf 6) :: Tree Int Int)++-- Assert equality+(@=) :: (Eq a, Show a) => a -> a -> IO ()+(@=) x y | x == y = pure ()+         | otherwise = do+  putStrLn "Not equal:"+  print x+  print y+  exitFailure