deriving-via-fun (empty) → 0.1.0.0

raw patch · 6 files changed

+838/−0 lines, 6 filesdep +basedep +deriving-via-fun

Dependencies added: base, deriving-via-fun

Files

CHANGELOG.md +5/−0
LICENSE +29/−0
README.md +118/−0
deriving-via-fun.cabal +41/−0
src/DerivingViaFun.hs +622/−0
test/Main.hs +23/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for deriving-via-fun
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,29 @@+Copyright (c) 2025, Li-yao Xia
+
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the copyright holder nor the names of its
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,118 @@+# Deriving via first-class functions
+
+1. You want to derive a class instance for a type `T`.
+2. You want to reuse an existing instance for a similar type `U`.
+3. Define a function or isomorphism between `T` and `U`. Give it a "type-level name" `F`.
+4. Derive the instance for `T` via `Fun F`.
+
+[![Hackage](https://img.shields.io/hackage/v/deriving-via-fun.svg)](https://hackage.haskell.org/package/deriving-via-fun)
+
+## Deriving via generic isomorphism
+
+Example type:
+
+```haskell
+data T0 = T0 Int Bool
+```
+
+To reuse existing instances for `(Int, Bool)`,
+we can do deriving via the "generic isomorphism" `T0 ?-> (Int, Bool)`.
+
+```haskell
+deriving (Eq, Ord) via Fun (T0 ?-> (Int, Bool))
+```
+
+Complete example with extensions and imports:
+
+```haskell
+{-# LANGUAGE DeriveGeneric, DerivingVia, TypeOperators #-}
+import DerivingViaFun
+import GHC.Generics (Generic)
+import Data.Monoid (Sum(..), Any(..))
+
+data T0 = T0 Int Bool
+  deriving Generic
+  deriving (Eq, Ord)           via Fun (T0 ?-> (Int, Bool))
+  deriving (Semigroup, Monoid) via Fun (T0 ?-> (Sum Int, Any))
+```
+
+## Function composition
+
+Example: derive the `All` monoid (aka. `(&&)`) from `Any` (aka. `(||)`) by duality.
+
+```haskell
+newtype All = All Bool
+  deriving (Semigroup, Monoid)
+    via Fun (Coerce All Bool >>> Not >>> Coerce Bool Any)
+```
+
+The function `Coerce All Bool >>> Not >>> Coerce Bool Any`
+denotes a function composition of [`coerce`](https://hackage.haskell.org/package/base-4.21.0.0/docs/Data-Coerce.html)
+and the boolean function `not`,
+as well as its inverse.
+
+## How it works: classes are functors
+
+The type `Fun (f :: a ~> b)` is a newtype containing `a`.
+Deriving-via-fun is enabled for a class `C`
+by providing an instance of the form
+`C b => C (Fun (f :: a ~> b))`,
+which can be read as a function from `C b` to `C a`,
+using the mapping `f :: a ~> b`.
+In that way, we can think of many classes `C` as functors.
+Whether the mapping `f` represents a function from `a` to `b`,
+or a function from `b` to `a`, or a bijection between them,
+depends on the specific class `C`.
+
+For example, `Eq` has this instance, where `Apply f`
+provides a function `a -> b`:
+
+```haskell
+instance (Apply f, Eq b) => Eq (Fun (f :: a ~> b)) where
+```
+
+For a different example, `Bounded` has this instance,
+where `Apply (Inv f)` provides a function `b -> a`:
+
+```haskell
+instance (Apply (Inv f), Bounded b) => Bounded (Fun (f :: a ~> b)) where
+```
+
+And of course, there are classes that require going both ways,
+like `Semigroup`:
+
+```haskell
+instance (Iso f, Semigroup b) => Semigroup (Fun (f :: a ~> b)) where
+```
+
+For more details, check out [the documentation](https://hackage.haskell.org/package/deriving-via-fun/docs/DerivingViaFun.html)
+or read the source code.
+
+## Comparison with *iso-deriving*
+
+This library is quite similar to [*iso-deriving*](https://hackage.haskell.org/package/iso-deriving),
+presented in the blog post [Deriving isomorphically](https://www.tweag.io/blog/2020-04-23-deriving-isomorphically/) by Hans Hoeglund.
+
+In *iso-deriving*, the newtype `As` is indexed by a source and target type,
+and the user must declare a suitable instance of `Project` and/or `Inject`
+between these types.
+
+In *deriving-via-fun* (this library), the newtype `Fun` is indexed by a "function name". Certain function names, notably `(?->)` and `Coerce`, can be reused for many pairs of types without further ceremony. Functions can also be composed easily with `(.)` or `(>>>)`, hence "first-class functions" in the description.
+
+*deriving-via-fun* can also replicate the usage of *iso-deriving*
+using the `Adhoc` function name.
+
+## Comparison with `Generically`
+
+There is some overlap in use cases between this library and `Generically`.
+But they still represent rather different approaches.
+
+The provider of a class instance for `Generically` must commit to a
+specific behavior for products and sums once for all.
+
+Using this library, a class instance for `Fun` only needs to apply
+an arbitrary mapping. In other words, the class is seen as some kind of functor in a general sense.
+The only part of this library that knows anything about generics
+is `(?->)`, which delimits a restricted and localized usage of `Generic`.
+It's still up to the user to select a concrete product or sum type from which to
+copy the class instance.

+ deriving-via-fun.cabal view

@@ -0,0 +1,41 @@+cabal-version:      3.0
+name:               deriving-via-fun
+version:            0.1.0.0
+synopsis: Deriving via first-class functions
+description:
+  Derive class instances by mapping over them
+  like they are functors.
+license:            BSD-3-Clause
+license-file:       LICENSE
+author:             Li-yao Xia
+maintainer:         lysxia@gmail.com
+copyright:          2025 Li-yao Xia
+category:           Development
+build-type:         Simple
+extra-doc-files:    README.md, CHANGELOG.md
+tested-with: GHC == 9.8.4, GHC == 9.12.2
+
+source-repository head
+  type: git
+  location: https://gitlab.com/lysxia/deriving-via-fun
+
+common warnings
+    ghc-options: -Wall
+
+library
+    import:           warnings
+    exposed-modules:
+      DerivingViaFun
+    build-depends:    base >=4.19 && < 4.22
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+test-suite deriving-via-fun-test
+    import:           warnings
+    default-language: Haskell2010
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   test
+    main-is:          Main.hs
+    build-depends:
+        base,
+        deriving-via-fun

+ src/DerivingViaFun.hs view

@@ -0,0 +1,622 @@+{-# LANGUAGE
+  AllowAmbiguousTypes,
+  DataKinds,
+  DerivingVia,
+  FlexibleContexts,
+  FlexibleInstances,
+  MonoLocalBinds,
+  MultiParamTypeClasses,
+  PolyKinds,
+  QuantifiedConstraints,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeAbstractions,
+  TypeFamilies,
+  TypeOperators,
+  TypeApplications,
+  UndecidableInstances #-}
+
+-- | Deriving via first-class functions.
+--
+-- See the [README](https://hackage.haskell.org/package/deriving-via-fun#readme) for details.
+--
+-- = Examples
+--
+-- > data T0 = T0 Int Bool
+-- >   deriving Generic
+-- >   deriving (Eq, Ord)           via Fun (T0 ?-> (Int, Bool))
+-- >   deriving (Semigroup, Monoid) via Fun (T0 ?-> (Sum Int, Any))
+--
+-- > newtype All = All Bool
+-- >   deriving (Semigroup, Monoid)
+-- >     via Fun (Coerce All Bool >>> Not >>> Coerce Bool Any)
+--
+-- = Extensions to use this library
+--
+-- > {-# LANGUAGE DerivingVia, TypeOperators #-}
+--
+-- To use the generic isomorphism @t'(DerivingViaFun.?->)'@, you will also want
+--
+-- > {-# LANGUAGE DeriveGeneric #-}
+
+module DerivingViaFun
+  (
+  -- * Basic features
+    Fun(..)
+  , fun
+  , unfun
+  , GenericIso
+  , type (?->)
+  , Coerce
+
+  -- * Core definitions
+  , FUN
+  , type (~>)
+  , Apply(..)
+  , Inv
+  , Iso
+
+  -- * Simple function names
+  , Id
+  , type (.)
+  , type (>>>)
+  , Fst
+  , Snd
+  , Pair
+  , Fmap
+  , Bimap
+  , Not
+  , Adhoc
+
+  -- * Higher-kinded types
+  , Fun1
+  , fun1
+  , unfun1
+  , Apply1
+  , Iso1
+  , TApply
+  , Apply1_
+  ) where
+
+import Control.Applicative (Alternative(..))
+import Control.Monad.Fix (MonadFix(..))
+import Data.Bifunctor (Bifunctor(first, bimap))
+import Data.Bits (Bits(..))
+import Data.Coerce (Coercible, coerce)
+import Data.Foldable (Foldable(..))
+import Data.Function (on)
+import Data.Ix (Ix(..))
+import Data.Kind (Constraint, Type)
+import Data.Semigroup (Semigroup(..))
+import Foreign (Storable(..), castPtr)
+import GHC.Generics (Generic(..))
+import Text.Read (Read(..))
+
+-- | @DerivingVia@ wrapper for "deriving via a function".
+--
+-- A @Fun (f :: a ~> b)@ is a value of type @a@ which
+-- may be viewed as a @b@ through the function @f@.
+--
+-- The 'fun' constructor and 'unfun' destructor automatically
+-- "apply @f@" in the suitable direction, using an instance
+-- @'Apply' f@ or @'Apply' ('Inv' f)@.
+--
+-- == Usage
+--
+-- @
+-- __data__ MyType
+--   __deriving__ MyClass __via__ t'Fun' MyFun
+-- @
+--
+-- Note that @MyFun@ may need a type annotation,
+-- as in @Fun (MyFun :: MyType ~> OtherType)@,
+-- because the types often can't be inferred.
+newtype Fun (f :: a ~> b) = Fun a
+
+-- | Destruct t'Fun'.
+unfun :: forall {a} {b} (f :: a ~> b). Apply f => Fun f -> b
+unfun (Fun a) = apply @f a
+
+-- | Construct t'Fun'.
+fun :: forall {a} {b} (f :: a ~> b). Apply (Inv f) => b -> Fun f
+fun b = Fun (apply @(Inv f) b)
+
+-- |
+-- @
+-- GenericIso :: a ~> b
+-- @
+-- 'Generic' isomorphism.
+--
+-- @GenericIso :: a ~> b@ maps between 'Generic' types @a@ and @b@
+-- where @'Rep' a@ is coercible to @'Rep' b@. It is invertible.
+data GenericIso :: a ~> b
+
+-- |
+-- @
+-- a ?-> b = 'GenericIso' :: a ~> b
+-- @
+--
+-- Shorthand for @'GenericIso' :: a ~> b@.
+type (?->) :: forall {k}. forall (a :: k) (b :: k) -> a ~> b
+type a ?-> b = GenericIso
+
+infix 1 ?->
+
+type instance Inv GenericIso = GenericIso
+type instance TApply GenericIso _ = GenericIso
+
+instance (Generic a, Generic b, Coercible (Rep a) (Rep b))
+  => Apply (a ?-> b) where
+  apply = to @b @() . coerce . from @a @()
+
+-- |
+-- @
+-- Coerce a b :: a ~> b
+-- @
+-- Type-level name for 'coerce'.
+data Coerce a b :: a ~> b
+
+instance Coercible a b => Apply (Coerce a b) where
+  apply = coerce
+
+type instance Inv (Coerce a b) = Coerce b a
+type instance TApply (Coerce a b) x = Coerce (a x) (b x)
+
+-- | An implementation detail of @t'(DerivingViaFun.~>)'@.
+--
+-- If you see @FUN@ in kind signatures in the documentation,
+-- that's because Haddock messed up.
+-- In those cases, the morally correct kind signature
+-- is provided below.
+--
+-- This allows @(~>)@ to be poly-kinded.
+data FUN (a :: k) (b :: k)
+
+-- | An extensible kind of type-level function names.
+--
+-- Think of this as an abstract kind.
+-- The right-hand side of this definition is an
+-- implementation detail.
+--
+-- Function names are declared as data types. For example:
+--
+-- > data Not :: Bool -> Bool
+--
+-- 'Apply' instances associate function names to actual functions:
+--
+-- > instance Apply Not where
+-- >   apply = not
+--
+-- 'Inv' instances associate function names to their inverse:
+--
+-- > type instance Inv Not = Not
+--
+-- @(~>)@ is poly-kinded and is intended to represent
+-- morphisms of any kind. This library provides facilities
+-- for kinds @Type@ (t'Fun') and @k -> Type@ (t'Fun1').
+type a ~> b = FUN a b -> Type
+
+infixr 1 ~>
+
+-- | Class of applicable function names.
+--
+-- Interpret a type-level function name @f :: a ~> b@
+-- as an actual function @'apply' \@f :: a -> b@.
+type Apply :: forall {a :: Type} {b :: Type}. (a ~> b) -> Constraint
+class Apply (f :: a ~> b) where
+  apply :: a -> b
+
+-- |
+-- @
+-- Inv :: (a ~> b) -> (b ~> a)
+-- @
+--
+-- Inverse function name.
+--
+-- == Laws
+--
+-- Instances of @'Apply' f@ and @'Apply' (Inv f)@ must satisfy the isomorphism laws:
+--
+-- @
+-- 'apply' \@f . 'apply' \@(Inv f) = id
+-- 'apply' \@(Inv f) . 'apply' \@f = id
+-- @
+type family Inv (f :: (a ~> b)) :: (b ~> a)
+
+-- | Class of invertible function names.
+--
+-- @Iso f@ means that both @'apply' \@f@ and @'apply' \@(Inv f)@ are defined.
+type Iso :: forall {a :: Type} {b :: Type}. (a ~> b) -> Constraint
+class    (Apply f, Apply (Inv f)) => Iso f
+instance (Apply f, Apply (Inv f)) => Iso f
+
+-- * Simple functions
+
+-- |
+-- @
+-- Id :: a ~> a
+-- @
+--
+-- Identity function.
+data Id :: a ~> a
+
+instance Apply Id where
+  apply = id
+
+type instance Inv Id = Id
+type instance TApply Id _ = Id
+
+-- |
+-- @
+-- (.) :: (b ~> c) -> (a ~> b) -> (a ~> c)
+-- @
+--
+-- Function composition.
+data (.) :: forall {a} {b} {c}. (b ~> c) -> (a ~> b) -> (a ~> c)
+
+infixr 9 .
+
+instance (Apply f, Apply g) => Apply (f . g) where
+  apply = apply @f . apply @g
+
+type instance Inv (f . g) = Inv g . Inv f
+type instance TApply (f . g) a = TApply f a . TApply g a
+
+-- |
+-- @
+-- (>>>) :: (a ~> b) -> (b ~> c) -> (a ~> c)
+-- @
+--
+-- Forward function composition.
+--
+-- The name originates from "Control.Category".
+type f >>> g = g . f
+
+infixr 1 >>>
+
+-- |
+-- @
+-- Fst :: (a, b) ~> a
+-- @
+--
+-- First pair projection.
+data Fst :: (a, b) ~> a
+
+instance Apply Fst where
+  apply = fst
+
+-- |
+-- @
+-- Snd :: (a, b) ~> b
+-- @
+--
+-- Second pair projection.
+data Snd :: (a, b) ~> b
+
+instance Apply Snd where
+  apply = snd
+
+-- |
+-- @
+-- Pair :: (a ~> b) -> (a ~> c) -> (a ~> (b, c))
+-- @
+--
+-- Pointwise pairing of two functions.
+--
+-- To map on the components of a pair independently, see 'Bimap'.
+data Pair :: (a ~> b) -> (a ~> c) -> (a ~> (b, c))
+
+instance (Apply f, Apply g) => Apply (Pair f g) where
+  apply a = (apply @f a, apply @g a)
+
+-- |
+-- @
+-- Fmap :: (a ~> b) -> (p a ~> p b)
+-- @
+--
+-- Apply a function under a functor ('fmap').
+data Fmap :: forall {p} {a} {b}. (a ~> b) -> (p a ~> p b)
+
+instance (Apply f, Functor p) => Apply (Fmap f :: p a ~> p b) where
+  apply = fmap (apply @f)
+
+type instance Inv (Fmap f) = Fmap (Inv f)
+type instance TApply (Fmap f) _ = Bimap f Id
+
+-- |
+-- @
+-- Bimap :: (a ~> b) -> (c ~> d) -> (p a c ~> p b d)
+-- @
+--
+-- Apply a function under a bifunctor ('bimap').
+data Bimap :: forall {p} {a} {b} {c} {d}. (a ~> b) -> (c ~> d) -> (p a c ~> p b d)
+
+instance (Apply f, Apply g, Bifunctor p) => Apply (Bimap f g :: p a c ~> p b d) where
+  apply = bimap (apply @f) (apply @g)
+
+type instance Inv (Bimap f g) = Bimap (Inv f) (Inv g)
+
+-- |
+-- @
+-- Not :: Bool ~> Bool
+-- @
+--
+-- Boolean negation.
+data Not :: Bool ~> Bool
+
+instance Apply Not where
+  apply = not
+
+type instance Inv Not = Not
+
+-- |
+-- @
+-- Adhoc a b :: a ~> b
+-- @
+--
+-- Function name with /ad hoc/ interpretations.
+--
+-- You can define instances of @'Apply' (Adhoc a b)@
+-- as long as at least one of @a@ or @b@ is a concrete type that you own
+-- (to avoid orphan instances).
+--
+-- This allows imitating the usage of [/iso-deriving/](https://hackage.haskell.org/package/iso-deriving),
+-- a similar deriving-via library.
+--
+-- - /iso-deriving/'s @As a b@ newtype corresponds to @t'Fun' (Adhoc a b)@.
+-- - /iso-deriving/'s @Project a b@ and @Inject a b@ instances correspond to @'Apply' (Adhoc a b)@ (they are fused into one for simplicity).
+data Adhoc a b :: a ~> b
+
+type instance Inv (Adhoc a b) = Adhoc b a
+type instance TApply (Adhoc a b) x = Adhoc (a x) (b x)
+
+-- * Higher-kinded types
+
+-- | @DerivingVia@ wrapper for "deriving via indexed functions".
+--
+-- This is the indexed version of t'Fun'.
+-- Use @Fun1@ to derive higher-kinded classes like
+-- 'Functor', 'Applicative', 'Monad', 'Foldable'.
+--
+-- Function names intended to work with this should most likely
+-- implement type family instances of 'TApply'.
+type Fun1 :: forall {k} (p :: k -> Type) (q :: k -> Type). (p ~> q) -> k -> Type
+newtype Fun1 @p @q (f :: p ~> q) a = Fun1 (p a)
+
+-- | Destruct t'Fun1'.
+unfun1 :: forall {p} {q} (f :: p ~> q) a. Apply1 f => Fun1 f a -> q a
+unfun1 (Fun1 p) = apply @(TApply f a) p
+
+-- | Construct t'Fun1'.
+fun1 :: forall {p} {q} (f :: p ~> q) a. Apply1 (Inv f) => q a -> Fun1 f a
+fun1 q = Fun1 (apply @(TApply (Inv f) a) q)
+
+-- |
+-- @
+-- TApply (f :: p ~> q) :: p a ~> q a
+-- @
+--
+-- Type application for indexed function names.
+type family TApply (f :: p ~> q) (a :: k) :: p a ~> q a
+
+-- | Implementation detail of 'Apply1'.
+class    Apply (TApply f a) => Apply1_ (f :: p ~> q) a
+instance Apply (TApply f a) => Apply1_ (f :: p ~> q) a
+
+-- | Class of applicable indexed functions.
+-- 
+-- These are polymorphic functions of type @forall a. p a -> q a@.
+class    (forall a. Apply1_ f a) => Apply1 f
+instance (forall a. Apply1_ f a) => Apply1 f
+
+-- | Class of indexed isomorphisms.
+class    (Apply1 f, Apply1 (Inv f)) => Iso1 f
+instance (Apply1 f, Apply1 (Inv f)) => Iso1 f
+
+-- * Instances
+
+instance (Apply f, Eq b) => Eq (Fun (f :: a ~> b)) where
+  (==) = (==) `on` unfun
+
+instance (Apply f, Ord b) => Ord (Fun (f :: a ~> b)) where
+  compare = compare `on` unfun
+  (<=) = (<=) `on` unfun
+  (>=) = (>=) `on` unfun
+  (>) = (>) `on` unfun
+  (<) = (<) `on` unfun
+
+instance (Apply (Inv f), Bounded b) => Bounded (Fun (f :: a ~> b)) where
+  minBound = fun minBound
+  maxBound = fun maxBound
+
+instance (Iso f, Enum b) => Enum (Fun (f :: a ~> b)) where
+  succ = fun . succ . unfun
+  pred = fun . pred . unfun
+  toEnum = fun . toEnum
+  fromEnum = fromEnum . unfun
+  enumFrom = fmap fun . enumFrom . unfun
+  enumFromThen x y = fmap fun (enumFromThen (unfun x) (unfun y))
+  enumFromTo x y = fmap fun (enumFromTo (unfun x) (unfun y))
+  enumFromThenTo x y z = fmap fun (enumFromThenTo (unfun x) (unfun y) (unfun z))
+
+instance (Iso f, Ix b) => Ix (Fun (f :: a ~> b)) where
+  range (x, y) = fmap fun (range (unfun x, unfun y))
+  index (x, y) = index (unfun x, unfun y) . unfun
+  inRange (x, y) = inRange (unfun x, unfun y) . unfun
+  rangeSize (x, y) = rangeSize (unfun x, unfun y)
+
+instance (Iso f, Semigroup b) => Semigroup (Fun (f :: a ~> b)) where
+  x <> y = fun (unfun x <> unfun y)
+  sconcat = fun . sconcat . fmap unfun
+
+instance (Iso f, Monoid b, Semigroup a) => Monoid (Fun (f :: a ~> b)) where
+  mempty = fun mempty
+  mappend (Fun x) (Fun y) = Fun (x <> y)
+  mconcat = fun . mconcat . fmap unfun
+
+instance (Iso f, Num b) => Num (Fun (f :: a ~> b)) where
+  x + y = fun (unfun x + unfun y)
+  x - y = fun (unfun x - unfun y)
+  x * y = fun (unfun x * unfun y)
+  negate = fun . negate . unfun
+  abs = fun . abs . unfun
+  signum = fun . signum . unfun
+  fromInteger = fun . fromInteger
+
+instance (Iso f, Real b) => Real (Fun (f :: a ~> b)) where
+  toRational = toRational . unfun
+
+instance (Iso f, Integral b) => Integral (Fun (f :: a ~> b)) where
+  quot x y = fun (quot (unfun x) (unfun y))
+  rem x y = fun (rem (unfun x) (unfun y))
+  div x y = fun (div (unfun x) (unfun y))
+  mod x y = fun (mod (unfun x) (unfun y))
+  quotRem x y = bimap fun fun (quotRem (unfun x) (unfun y))
+  divMod x y = bimap fun fun (divMod (unfun x) (unfun y))
+  toInteger = toInteger . unfun
+
+instance (Iso f, Fractional b) => Fractional (Fun (f :: a ~> b)) where
+  x / y = fun (unfun x / unfun y)
+  recip = fun . recip . unfun
+  fromRational = fun . fromRational
+
+instance (Iso f, Floating b) => Floating (Fun (f :: a ~> b)) where
+  pi = fun pi
+  exp = fun . exp . unfun
+  log = fun . log . unfun
+  sqrt = fun . sqrt . unfun
+  x ** y = fun (unfun x ** unfun y)
+  logBase x y = fun (logBase (unfun x) (unfun y))
+  sin = fun . sin . unfun
+  cos = fun . cos . unfun
+  tan = fun . tan . unfun
+  asin = fun . asin . unfun
+  acos = fun . acos . unfun
+  atan = fun . atan . unfun
+  sinh = fun . sinh . unfun
+  cosh = fun . cosh . unfun
+  tanh = fun . tanh . unfun
+  asinh = fun . asinh . unfun
+  acosh = fun . acosh . unfun
+  atanh = fun . atanh . unfun
+
+instance (Iso f, RealFrac b) => RealFrac (Fun (f :: a ~> b)) where
+  properFraction = fmap fun . properFraction . unfun
+  truncate = truncate . unfun
+  round = round . unfun
+  ceiling = ceiling . unfun
+  floor = floor . unfun
+
+instance (Iso f, RealFloat b) => RealFloat (Fun (f :: a ~> b)) where
+  floatRadix = floatRadix . unfun
+  floatDigits = floatDigits . unfun
+  floatRange = floatRange . unfun
+  decodeFloat = decodeFloat . unfun
+  encodeFloat = fmap fun . encodeFloat
+  exponent = exponent . unfun
+  significand = fun . significand . unfun
+  scaleFloat n = fun . scaleFloat n . unfun
+  isNaN = isNaN . unfun
+  isInfinite = isInfinite . unfun
+  isDenormalized = isDenormalized . unfun
+  isNegativeZero = isNegativeZero . unfun
+  isIEEE = isIEEE . unfun
+  atan2 x y = fun (atan2 (unfun x) (unfun y))
+
+instance (Iso f, Bits b) => Bits (Fun (f :: a ~> b)) where
+  x .&. y = fun (unfun x .&. unfun y)
+  x .|. y = fun (unfun x .|. unfun y)
+  x `xor` y = fun (unfun x `xor` unfun y)
+  complement = fun . complement . unfun
+  shift = fmap fun . shift . unfun
+  rotate = fmap fun . rotate . unfun
+  zeroBits = fun zeroBits
+  bit = fun . bit
+  setBit = fmap fun . setBit . unfun
+  clearBit = fmap fun . clearBit . unfun
+  complementBit = fmap fun . complementBit . unfun
+  testBit = testBit . unfun
+  bitSizeMaybe = bitSizeMaybe . unfun
+  isSigned = isSigned . unfun
+  shiftL = fmap fun . shiftL . unfun
+  unsafeShiftL = fmap fun . unsafeShiftL . unfun
+  shiftR = fmap fun . shiftR . unfun
+  unsafeShiftR = fmap fun . unsafeShiftR . unfun
+  rotateL = fmap fun . rotateL . unfun
+  rotateR = fmap fun . rotateR . unfun
+  popCount = popCount . unfun
+  bitSize = bitSize . unfun
+
+instance (Iso f, Storable b) => Storable (Fun (f :: a ~> b)) where
+  sizeOf = sizeOf . unfun
+  alignment = alignment . unfun
+  peekElemOff ptr = fmap fun . peekElemOff (castPtr ptr)
+  pokeElemOff ptr n = pokeElemOff (castPtr ptr) n . unfun
+  peekByteOff ptr = fmap fun . peekByteOff (castPtr ptr)
+  pokeByteOff ptr n = pokeByteOff (castPtr ptr) n . unfun
+  peek = fmap fun . peek . castPtr
+  poke ptr = poke (castPtr ptr) . unfun
+
+instance (Apply f, Show b) => Show (Fun (f :: a ~> b)) where
+  showsPrec d = showsPrec d . unfun
+  show = show . unfun
+
+instance (Apply (Inv f), Read b) => Read (Fun (f :: a ~> b)) where
+  readsPrec = (fmap . fmap . fmap . first) fun readsPrec
+  readList = (fmap . fmap . first . fmap) fun readList
+  readPrec = fmap fun readPrec
+  readListPrec = (fmap . fmap) fun readListPrec
+
+instance (Iso1 f, Functor q) => Functor (Fun1 (f :: p ~> q)) where
+  fmap m = fun1 . fmap m . unfun1
+  (<$) x = fun1 . (<$) x . unfun1
+
+instance (Iso1 f, Applicative q) => Applicative (Fun1 (f :: p ~> q)) where
+  pure = fun1 . pure
+  u <*> v = fun1 (unfun1 u <*> unfun1 v)
+  liftA2 m u v = fun1 (liftA2 m (unfun1 u) (unfun1 v))
+  u <* v = fun1 (unfun1 u <* unfun1 v)
+  u *> v = fun1 (unfun1 u *> unfun1 v)
+
+instance (Iso1 f, Alternative q) => Alternative (Fun1 (f :: p ~> q)) where
+  empty = fun1 empty
+  u <|> v = fun1 (unfun1 u <|> unfun1 v)
+  some = fun1 . some . unfun1
+  many = fun1 . many . unfun1
+
+-- | This uses the @Applicative@ instance of the source type to define `return`.
+instance (Iso1 f, Monad q, Applicative p) => Monad (Fun1 (f :: p ~> q)) where
+  return = Fun1 . pure
+  u >>= v = fun1 (unfun1 u >>= unfun1 . v)
+  u >> v = fun1 (unfun1 u >> unfun1 v)
+
+instance (Iso1 f, MonadFail q, Applicative p) => MonadFail (Fun1 (f :: p ~> q)) where
+  fail = fun1 . fail
+
+instance (Iso1 f, MonadFix q, Applicative p) => MonadFix (Fun1 (f :: p ~> q)) where
+  mfix f = fun1 (mfix (unfun1 . f))
+
+instance (Apply1 f, Foldable q) => Foldable (Fun1 (f :: p ~> q)) where
+  fold = fold . unfun1
+  foldMap f = foldMap f . unfun1
+  foldMap' f = foldMap' f . unfun1
+  foldr f x = foldr f x . unfun1
+  foldl f x = foldl f x . unfun1
+  foldl' f x = foldl' f x . unfun1
+  foldr1 f = foldr1 f . unfun1
+  foldl1 f = foldl1 f . unfun1
+  toList = toList . unfun1
+  null = null . unfun1
+  length = length . unfun1
+  elem x = elem x . unfun1
+  maximum = maximum . unfun1
+  minimum = minimum . unfun1
+  sum = sum . unfun1
+  product = product . unfun1
+
+instance (Iso1 f, Traversable q) => Traversable (Fun1 (f :: p ~> q)) where
+  traverse f = fmap fun1 . traverse f . unfun1
+  sequenceA = fmap fun1 . sequenceA . unfun1
+  mapM f = fmap fun1 . mapM f . unfun1
+  sequence = fmap fun1 . sequence . unfun1

+ test/Main.hs view

@@ -0,0 +1,23 @@+{-# LANGUAGE
+  DeriveGeneric,
+  DataKinds,
+  DerivingVia,
+  KindSignatures,
+  TypeOperators #-}
+module Main (main) where
+
+import DerivingViaFun
+import Data.Monoid (Sum(..), Any(..))
+import GHC.Generics (Generic)
+
+data T0 = T0 Int Bool
+  deriving Generic
+  deriving (Eq, Ord) via Fun (T0 ?-> (Int, Bool))
+  deriving (Semigroup, Monoid) via Fun (GenericIso :: T0 ~> (Sum Int, Any)) -- test type annotations in deriving via
+
+newtype All = All Bool
+  deriving (Eq, Ord) via Fun (Coerce All Bool)
+  deriving (Semigroup, Monoid) via Fun (Coerce All Bool >>> Not >>> Coerce Bool Any)
+
+main :: IO ()
+main = pure ()