-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.OneLiner.Binary
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  sjoerd@w3future.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-- These generic functions allow changing the types of the constant leaves.
-- They require type classes with 2 parameters, the first for the input type
-- and the second for the output type.
--
-- All functions without postfix are for instances of `Generic`, and functions
-- with postfix @1@ are for instances of `Generic1` (with kind @Type -> Type@) which
-- get an extra argument to specify how to deal with the parameter.
-- Functions with postfix @01@ are also for `Generic1` but they get yet another
-- argument that, like the `Generic` functions, allows handling of constant leaves.
-----------------------------------------------------------------------------
{-# LANGUAGE
    RankNTypes
  , LinearTypes
  , Trustworthy
  , TypeFamilies
  , ConstraintKinds
  , FlexibleContexts
  , TypeApplications
  , AllowAmbiguousTypes
  , ScopedTypeVariables
  #-}
module Generics.OneLiner.Binary
(
  -- * Traversing values
  gmap, gtraverse,
  glmap, gltraverse,
  gmap1, gtraverse1,
  glmap1, gltraverse1, gltraverse01,
  -- * Combining values
  zipWithA, zipWithA1,
  -- * Functions for records
  -- | These functions only work for single constructor data types.
  unaryOp, binaryOp, algebra, dialgebra, gcotraverse1,
  -- * Generic programming with profunctors
  -- | All the above functions have been implemented using these functions,
  -- using different `profunctor`s.
  record, nonEmpty, generic,
  record1, nonEmpty1, generic1,
  record01, nonEmpty01, generic01,
  -- ** Classes
  GenericRecordProfunctor,
  GenericNonEmptyProfunctor,
  GenericProfunctor,
  Generic1Profunctor,
  GenericUnitProfunctor(..),
  GenericProductProfunctor(..),
  GenericSumProfunctor(..),
  GenericEmptyProfunctor(..),
  GenericConstantProfunctor(..),
  -- * Types
  ADT, ADTNonEmpty, ADTRecord, Constraints,
  ADT1, ADTNonEmpty1, ADTRecord1, Constraints1, Constraints01,
  FunConstraints, FunResult,
  AnyType
)
where

import Control.Applicative
import Data.Bifunctor.Biff
import Data.Profunctor
import Data.Profunctor.Kleisli.Linear
import Generics.OneLiner.Classes
import Generics.OneLiner.Internal
import Generics.OneLiner.Internal.Unary (D)
import qualified Data.Functor.Linear as DL
import qualified Data.Unrestricted.Linear as Linear
import qualified Control.Functor.Linear as CL

-- | Map over a structure, updating each component.
--
-- `gmap` is `generic` specialized to @(->)@.
gmap :: forall c t t'. (ADT t t', Constraints t t' c)
     => (forall s s'. c s s' => s -> s') -> t -> t'
gmap :: forall (c :: * -> * -> Constraint) t t'.
(ADT t t', Constraints t t' c) =>
(forall s s'. c s s' => s -> s') -> t -> t'
gmap = forall (c :: * -> * -> Constraint) (p :: * -> * -> *) t t'.
(ADT t t', Constraints t t' c, GenericProfunctor p) =>
(forall s s'. c s s' => p s s') -> p t t'
generic @c
{-# INLINE gmap #-}

-- | Map over a structure linearly, updating each component.
--
-- `glmap` is `generic` specialized to the linear arrow.
glmap :: forall c t t'. (ADT t t', Constraints t t' c)
      => (forall s s'. c s s' => s %1-> s') -> t %1-> t'
glmap :: forall (c :: * -> * -> Constraint) t t'.
(ADT t t', Constraints t t' c) =>
(forall s s'. c s s' => s %1 -> s') -> t %1 -> t'
glmap = forall (c :: * -> * -> Constraint) (p :: * -> * -> *) t t'.
(ADT t t', Constraints t t' c, GenericProfunctor p) =>
(forall s s'. c s s' => p s s') -> p t t'
generic @c
{-# INLINE glmap #-}

-- | Map each component of a structure to an action, evaluate these actions from left to right, and collect the results.
--
-- `gtraverse` is `generic` specialized to `Star`.
gtraverse :: forall c t t' f. (ADT t t', Constraints t t' c, Applicative f)
          => (forall s s'. c s s' => s -> f s') -> t -> f t'
gtraverse :: forall (c :: * -> * -> Constraint) t t' (f :: * -> *).
(ADT t t', Constraints t t' c, Applicative f) =>
(forall s s'. c s s' => s -> f s') -> t -> f t'
gtraverse forall s s'. c s s' => s -> f s'
f = Star f t t' -> t -> f t'
forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar (Star f t t' -> t -> f t') -> Star f t t' -> t -> f t'
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> * -> Constraint) (p :: * -> * -> *) t t'.
(ADT t t', Constraints t t' c, GenericProfunctor p) =>
(forall s s'. c s s' => p s s') -> p t t'
generic @c ((forall s s'. c s s' => Star f s s') -> Star f t t')
-> (forall s s'. c s s' => Star f s s') -> Star f t t'
forall a b. (a -> b) -> a -> b
$ (s -> f s') -> Star f s s'
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star s -> f s'
forall s s'. c s s' => s -> f s'
f
{-# INLINE gtraverse #-}

-- | Map each component of a structure to an action linearly, evaluate these actions from left to right, and collect the results.
--
-- `gltraverse` is `generic` specialized to linear `Kleisli`.
gltraverse :: forall c t t' f. (ADT t t', Constraints t t' c, DL.Applicative f)
           => (forall s s'. c s s' => s %1-> f s') -> t %1-> f t'
gltraverse :: forall (c :: * -> * -> Constraint) t t' (f :: * -> *).
(ADT t t', Constraints t t' c, Applicative f) =>
(forall s s'. c s s' => s %1 -> f s') -> t %1 -> f t'
gltraverse forall s s'. c s s' => s %1 -> f s'
f = Kleisli f t t' -> t %1 -> f t'
forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
runKleisli (Kleisli f t t' -> t %1 -> f t') -> Kleisli f t t' -> t %1 -> f t'
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> * -> Constraint) (p :: * -> * -> *) t t'.
(ADT t t', Constraints t t' c, GenericProfunctor p) =>
(forall s s'. c s s' => p s s') -> p t t'
generic @c ((forall s s'. c s s' => Kleisli f s s') -> Kleisli f t t')
-> (forall s s'. c s s' => Kleisli f s s') -> Kleisli f t t'
forall a b. (a -> b) -> a -> b
$ (s %1 -> f s') -> Kleisli f s s'
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli s %1 -> f s'
forall s s'. c s s' => s %1 -> f s'
f
{-# INLINE gltraverse #-}

-- | `gmap1` is `generic1` specialized to @(->)@.
gmap1 :: forall c t t' a b. (ADT1 t t', Constraints1 t t' c)
      => (forall d e s s'. c s s' => (d -> e) -> s d -> s' e) -> (a -> b) -> t a -> t' b
gmap1 :: forall (c :: (* -> *) -> (* -> *) -> Constraint) (t :: * -> *)
       (t' :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 (d -> e) -> s d -> s' e)
-> (a -> b) -> t a -> t' b
gmap1 = forall (c :: (* -> *) -> (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) (t' :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c, Generic1Profunctor p) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 p d e -> p (s d) (s' e))
-> p a b -> p (t a) (t' b)
generic1 @c
{-# INLINE gmap1 #-}

-- | `glmap1` is `generic1` specialized to the linear arrow.
glmap1 :: forall c t t' a b. (ADT1 t t', Constraints1 t t' c)
       => (forall d e s s'. c s s' => (d %1-> e) -> s d %1-> s' e) -> (a %1-> b) -> t a %1-> t' b
glmap1 :: forall (c :: (* -> *) -> (* -> *) -> Constraint) (t :: * -> *)
       (t' :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 (d %1 -> e) -> s d %1 -> s' e)
-> (a %1 -> b) -> t a %1 -> t' b
glmap1 = forall (c :: (* -> *) -> (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) (t' :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c, Generic1Profunctor p) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 p d e -> p (s d) (s' e))
-> p a b -> p (t a) (t' b)
generic1 @c
{-# INLINE glmap1 #-}

-- | `gtraverse1` is `generic1` specialized to `Star`.
gtraverse1 :: forall c t t' f a b. (ADT1 t t', Constraints1 t t' c, Applicative f)
           => (forall d e s s'. c s s' => (d -> f e) -> s d -> f (s' e)) -> (a -> f b) -> t a -> f (t' b)
gtraverse1 :: forall (c :: (* -> *) -> (* -> *) -> Constraint) (t :: * -> *)
       (t' :: * -> *) (f :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c, Applicative f) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 (d -> f e) -> s d -> f (s' e))
-> (a -> f b) -> t a -> f (t' b)
gtraverse1 forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(d -> f e) -> s d -> f (s' e)
f = ((a -> f b) -> Star f a b)
-> (Star f (t a) (t' b) -> t a -> f (t' b))
-> (Star f a b -> Star f (t a) (t' b))
-> (a -> f b)
-> t a
-> f (t' b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a -> f b) -> Star f a b
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star Star f (t a) (t' b) -> t a -> f (t' b)
forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar ((Star f a b -> Star f (t a) (t' b))
 -> (a -> f b) -> t a -> f (t' b))
-> (Star f a b -> Star f (t a) (t' b))
-> (a -> f b)
-> t a
-> f (t' b)
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) (t' :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c, Generic1Profunctor p) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 p d e -> p (s d) (s' e))
-> p a b -> p (t a) (t' b)
generic1 @c ((forall d e (s :: * -> *) (s' :: * -> *).
  c s s' =>
  Star f d e -> Star f (s d) (s' e))
 -> Star f a b -> Star f (t a) (t' b))
-> (forall d e (s :: * -> *) (s' :: * -> *).
    c s s' =>
    Star f d e -> Star f (s d) (s' e))
-> Star f a b
-> Star f (t a) (t' b)
forall a b. (a -> b) -> a -> b
$ (Star f d e -> d -> f e)
-> ((s d -> f (s' e)) -> Star f (s d) (s' e))
-> ((d -> f e) -> s d -> f (s' e))
-> Star f d e
-> Star f (s d) (s' e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Star f d e -> d -> f e
forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar (s d -> f (s' e)) -> Star f (s d) (s' e)
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star (d -> f e) -> s d -> f (s' e)
forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(d -> f e) -> s d -> f (s' e)
f
{-# INLINE gtraverse1 #-}

-- | `gltraverse1` is `generic1` specialized to linear `Kleisli`.
gltraverse1 :: forall c t t' f a b. (ADT1 t t', Constraints1 t t' c, CL.Applicative f)
            => (forall d e s s'. c s s' => (d %1-> f e) -> s d %1-> f (s' e)) -> (a %1-> f b) -> t a %1-> f (t' b)
gltraverse1 :: forall (c :: (* -> *) -> (* -> *) -> Constraint) (t :: * -> *)
       (t' :: * -> *) (f :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c, Applicative f) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 (d %1 -> f e) -> s d %1 -> f (s' e))
-> (a %1 -> f b) -> t a %1 -> f (t' b)
gltraverse1 forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(d %1 -> f e) -> s d %1 -> f (s' e)
f = ((a %1 -> f b) -> Kleisli f a b)
-> (Kleisli f (t a) (t' b) -> t a %1 -> f (t' b))
-> (Kleisli f a b -> Kleisli f (t a) (t' b))
-> (a %1 -> f b)
-> t a
%1 -> f (t' b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a %1 -> f b) -> Kleisli f a b
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli Kleisli f (t a) (t' b) -> t a %1 -> f (t' b)
forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
runKleisli ((Kleisli f a b -> Kleisli f (t a) (t' b))
 -> (a %1 -> f b) -> t a %1 -> f (t' b))
-> (Kleisli f a b -> Kleisli f (t a) (t' b))
-> (a %1 -> f b)
-> t a
%1 -> f (t' b)
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) (t' :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c, Generic1Profunctor p) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 p d e -> p (s d) (s' e))
-> p a b -> p (t a) (t' b)
generic1 @c ((forall d e (s :: * -> *) (s' :: * -> *).
  c s s' =>
  Kleisli f d e -> Kleisli f (s d) (s' e))
 -> Kleisli f a b -> Kleisli f (t a) (t' b))
-> (forall d e (s :: * -> *) (s' :: * -> *).
    c s s' =>
    Kleisli f d e -> Kleisli f (s d) (s' e))
-> Kleisli f a b
-> Kleisli f (t a) (t' b)
forall a b. (a -> b) -> a -> b
$ (Kleisli f d e -> d %1 -> f e)
-> ((s d %1 -> f (s' e)) -> Kleisli f (s d) (s' e))
-> ((d %1 -> f e) -> s d %1 -> f (s' e))
-> Kleisli f d e
-> Kleisli f (s d) (s' e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Kleisli f d e -> d %1 -> f e
forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
runKleisli (s d %1 -> f (s' e)) -> Kleisli f (s d) (s' e)
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (d %1 -> f e) -> s d %1 -> f (s' e)
forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(d %1 -> f e) -> s d %1 -> f (s' e)
f
{-# INLINE gltraverse1 #-}

-- | `gltraverse01` is `generic01` specialized to linear `Kleisli`, requiring `Linear.Movable` for constants.
gltraverse01 :: forall c t t' f a b. (ADT1 t t', Constraints01 t t' (D Linear.Movable) c, DL.Applicative f)
             => (forall d e s s'. c s s' => (d %1-> f e) -> s d %1-> f (s' e)) -> (a %1-> f b) -> t a %1-> f (t' b)
gltraverse01 :: forall (c :: (* -> *) -> (* -> *) -> Constraint) (t :: * -> *)
       (t' :: * -> *) (f :: * -> *) a b.
(ADT1 t t', Constraints01 t t' (D Movable) c, Applicative f) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 (d %1 -> f e) -> s d %1 -> f (s' e))
-> (a %1 -> f b) -> t a %1 -> f (t' b)
gltraverse01 forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(d %1 -> f e) -> s d %1 -> f (s' e)
f = ((a %1 -> f b) -> Kleisli f a b)
-> (Kleisli f (t a) (t' b) -> t a %1 -> f (t' b))
-> (Kleisli f a b -> Kleisli f (t a) (t' b))
-> (a %1 -> f b)
-> t a
%1 -> f (t' b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a %1 -> f b) -> Kleisli f a b
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli Kleisli f (t a) (t' b) -> t a %1 -> f (t' b)
forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
runKleisli ((Kleisli f a b -> Kleisli f (t a) (t' b))
 -> (a %1 -> f b) -> t a %1 -> f (t' b))
-> (Kleisli f a b -> Kleisli f (t a) (t' b))
-> (a %1 -> f b)
-> t a
%1 -> f (t' b)
forall a b. (a -> b) -> a -> b
$ forall (c0 :: * -> * -> Constraint)
       (c1 :: (* -> *) -> (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) (t' :: * -> *) a b.
(ADT1 t t', Constraints01 t t' c0 c1, GenericProfunctor p) =>
(forall s s'. c0 s s' => p s s')
-> (forall d e (s :: * -> *) (s' :: * -> *).
    c1 s s' =>
    p d e -> p (s d) (s' e))
-> p a b
-> p (t a) (t' b)
generic01 @(D Linear.Movable) @c ((s %1 -> f s) -> Kleisli f s s
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (\s
a -> Ur s %1 -> f s
forall (f :: * -> *) a. Applicative f => Ur a %1 -> f a
urpure (s %1 -> Ur s
forall a. Movable a => a %1 -> Ur a
Linear.move s
a))) ((forall d e (s :: * -> *) (s' :: * -> *).
  c s s' =>
  Kleisli f d e -> Kleisli f (s d) (s' e))
 -> Kleisli f a b -> Kleisli f (t a) (t' b))
-> (forall d e (s :: * -> *) (s' :: * -> *).
    c s s' =>
    Kleisli f d e -> Kleisli f (s d) (s' e))
-> Kleisli f a b
-> Kleisli f (t a) (t' b)
forall a b. (a -> b) -> a -> b
$ (Kleisli f d e -> d %1 -> f e)
-> ((s d %1 -> f (s' e)) -> Kleisli f (s d) (s' e))
-> ((d %1 -> f e) -> s d %1 -> f (s' e))
-> Kleisli f d e
-> Kleisli f (s d) (s' e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Kleisli f d e -> d %1 -> f e
forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
runKleisli (s d %1 -> f (s' e)) -> Kleisli f (s d) (s' e)
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (d %1 -> f e) -> s d %1 -> f (s' e)
forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(d %1 -> f e) -> s d %1 -> f (s' e)
f
{-# INLINE gltraverse01 #-}

urpure :: DL.Applicative f => Linear.Ur a %1-> f a
urpure :: forall (f :: * -> *) a. Applicative f => Ur a %1 -> f a
urpure (Linear.Ur a
a) = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
DL.pure a
a

-- | Combine two values by combining each component of the structures with the given function, under an applicative effect.
-- Returns `empty` if the constructors don't match.
--
-- `zipWithA` is `generic` specialized to `Zip`
zipWithA :: forall c t t' f. (ADT t t', Constraints t t' c, Alternative f)
         => (forall s s'. c s s' => s -> s -> f s') -> t -> t -> f t'
zipWithA :: forall (c :: * -> * -> Constraint) t t' (f :: * -> *).
(ADT t t', Constraints t t' c, Alternative f) =>
(forall s s'. c s s' => s -> s -> f s') -> t -> t -> f t'
zipWithA forall s s'. c s s' => s -> s -> f s'
f = Zip f t t' -> t -> t -> f t'
forall (f :: * -> *) a b. Zip f a b -> a -> a -> f b
runZip (Zip f t t' -> t -> t -> f t') -> Zip f t t' -> t -> t -> f t'
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> * -> Constraint) (p :: * -> * -> *) t t'.
(ADT t t', Constraints t t' c, GenericProfunctor p) =>
(forall s s'. c s s' => p s s') -> p t t'
generic @c ((forall s s'. c s s' => Zip f s s') -> Zip f t t')
-> (forall s s'. c s s' => Zip f s s') -> Zip f t t'
forall a b. (a -> b) -> a -> b
$ (s -> s -> f s') -> Zip f s s'
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip s -> s -> f s'
forall s s'. c s s' => s -> s -> f s'
f
{-# INLINE zipWithA #-}

-- | `zipWithA1` is `generic1` specialized to `Zip`
zipWithA1 :: forall c t t' f a b. (ADT1 t t', Constraints1 t t' c, Alternative f)
          => (forall d e s s'. c s s' => (d -> d -> f e) -> s d -> s d -> f (s' e))
          -> (a -> a -> f b) -> t a -> t a -> f (t' b)
zipWithA1 :: forall (c :: (* -> *) -> (* -> *) -> Constraint) (t :: * -> *)
       (t' :: * -> *) (f :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c, Alternative f) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 (d -> d -> f e) -> s d -> s d -> f (s' e))
-> (a -> a -> f b) -> t a -> t a -> f (t' b)
zipWithA1 forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(d -> d -> f e) -> s d -> s d -> f (s' e)
f = ((a -> a -> f b) -> Zip f a b)
-> (Zip f (t a) (t' b) -> t a -> t a -> f (t' b))
-> (Zip f a b -> Zip f (t a) (t' b))
-> (a -> a -> f b)
-> t a
-> t a
-> f (t' b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a -> a -> f b) -> Zip f a b
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip Zip f (t a) (t' b) -> t a -> t a -> f (t' b)
forall (f :: * -> *) a b. Zip f a b -> a -> a -> f b
runZip ((Zip f a b -> Zip f (t a) (t' b))
 -> (a -> a -> f b) -> t a -> t a -> f (t' b))
-> (Zip f a b -> Zip f (t a) (t' b))
-> (a -> a -> f b)
-> t a
-> t a
-> f (t' b)
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) (t' :: * -> *) a b.
(ADT1 t t', Constraints1 t t' c, Generic1Profunctor p) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 p d e -> p (s d) (s' e))
-> p a b -> p (t a) (t' b)
generic1 @c ((forall d e (s :: * -> *) (s' :: * -> *).
  c s s' =>
  Zip f d e -> Zip f (s d) (s' e))
 -> Zip f a b -> Zip f (t a) (t' b))
-> (forall d e (s :: * -> *) (s' :: * -> *).
    c s s' =>
    Zip f d e -> Zip f (s d) (s' e))
-> Zip f a b
-> Zip f (t a) (t' b)
forall a b. (a -> b) -> a -> b
$ (Zip f d e -> d -> d -> f e)
-> ((s d -> s d -> f (s' e)) -> Zip f (s d) (s' e))
-> ((d -> d -> f e) -> s d -> s d -> f (s' e))
-> Zip f d e
-> Zip f (s d) (s' e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Zip f d e -> d -> d -> f e
forall (f :: * -> *) a b. Zip f a b -> a -> a -> f b
runZip (s d -> s d -> f (s' e)) -> Zip f (s d) (s' e)
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip (d -> d -> f e) -> s d -> s d -> f (s' e)
forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(d -> d -> f e) -> s d -> s d -> f (s' e)
f
{-# INLINE zipWithA1 #-}

-- | Implement a unary operator by calling the operator on the components.
-- This is here for consistency, it is the same as `record`.
--
-- @
-- `negate` = `unaryOp` \@`Num` `negate`
-- @
unaryOp :: forall c t t'. (ADTRecord t t', Constraints t t' c)
        => (forall s s'. c s s' => s -> s') -> t -> t'
unaryOp :: forall (c :: * -> * -> Constraint) t t'.
(ADTRecord t t', Constraints t t' c) =>
(forall s s'. c s s' => s -> s') -> t -> t'
unaryOp = forall (c :: * -> * -> Constraint) (p :: * -> * -> *) t t'.
(ADTRecord t t', Constraints t t' c, GenericRecordProfunctor p) =>
(forall s s'. c s s' => p s s') -> p t t'
record @c
{-# INLINE unaryOp #-}

-- | Implement a binary operator by calling the operator on the components.
--
-- @
-- `mappend` = `binaryOp` \@`Monoid` `mappend`
-- (`+`) = `binaryOp` \@`Num` (`+`)
-- @
--
-- `binaryOp` is `algebra` specialized to pairs.
binaryOp :: forall c t t'. (ADTRecord t t', Constraints t t' c)
         => (forall s s'. c s s' => s -> s -> s') -> t -> t -> t'
binaryOp :: forall (c :: * -> * -> Constraint) t t'.
(ADTRecord t t', Constraints t t' c) =>
(forall s s'. c s s' => s -> s -> s') -> t -> t -> t'
binaryOp forall s s'. c s s' => s -> s -> s'
f = forall (c :: * -> * -> Constraint) t t' (f :: * -> *).
(ADTRecord t t', Constraints t t' c, Functor f) =>
(forall s s'. c s s' => f s -> s') -> f t -> t'
algebra @c (\(Pair s
a s
b) -> s -> s -> s'
forall s s'. c s s' => s -> s -> s'
f s
a s
b) (Pair t -> t') -> (t -> t -> Pair t) -> t -> t -> t'
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: t -> t -> Pair t
forall a. a -> a -> Pair a
Pair
{-# INLINE binaryOp #-}

-- | Create an F-algebra, given an F-algebra for each of the components.
--
-- @
-- `binaryOp` f l r = `algebra` \@c (\\(Pair a b) -> f a b) (Pair l r)
-- @
--
-- `algebra` is `record` specialized to `Costar`.
algebra :: forall c t t' f. (ADTRecord t t', Constraints t t' c, Functor f)
        => (forall s s'. c s s' => f s -> s') -> f t -> t'
algebra :: forall (c :: * -> * -> Constraint) t t' (f :: * -> *).
(ADTRecord t t', Constraints t t' c, Functor f) =>
(forall s s'. c s s' => f s -> s') -> f t -> t'
algebra forall s s'. c s s' => f s -> s'
f = Costar f t t' -> f t -> t'
forall {k} (f :: k -> *) (d :: k) c. Costar f d c -> f d -> c
runCostar (Costar f t t' -> f t -> t') -> Costar f t t' -> f t -> t'
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> * -> Constraint) (p :: * -> * -> *) t t'.
(ADTRecord t t', Constraints t t' c, GenericRecordProfunctor p) =>
(forall s s'. c s s' => p s s') -> p t t'
record @c ((forall s s'. c s s' => Costar f s s') -> Costar f t t')
-> (forall s s'. c s s' => Costar f s s') -> Costar f t t'
forall a b. (a -> b) -> a -> b
$ (f s -> s') -> Costar f s s'
forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
Costar f s -> s'
forall s s'. c s s' => f s -> s'
f
{-# INLINE algebra #-}

-- | `dialgebra` is `record` specialized to @`Biff` (->)@.
dialgebra :: forall c t t' f g. (ADTRecord t t', Constraints t t' c, Functor f, Applicative g)
        => (forall s s'. c s s' => f s -> g s') -> f t -> g t'
dialgebra :: forall (c :: * -> * -> Constraint) t t' (f :: * -> *)
       (g :: * -> *).
(ADTRecord t t', Constraints t t' c, Functor f, Applicative g) =>
(forall s s'. c s s' => f s -> g s') -> f t -> g t'
dialgebra forall s s'. c s s' => f s -> g s'
f = Biff (->) f g t t' -> f t -> g t'
forall {k1} {k2} {k3} {k4} (p :: k1 -> k2 -> *) (f :: k3 -> k1)
       (g :: k4 -> k2) (a :: k3) (b :: k4).
Biff p f g a b -> p (f a) (g b)
runBiff (Biff (->) f g t t' -> f t -> g t')
-> Biff (->) f g t t' -> f t -> g t'
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> * -> Constraint) (p :: * -> * -> *) t t'.
(ADTRecord t t', Constraints t t' c, GenericRecordProfunctor p) =>
(forall s s'. c s s' => p s s') -> p t t'
record @c ((forall s s'. c s s' => Biff (->) f g s s') -> Biff (->) f g t t')
-> (forall s s'. c s s' => Biff (->) f g s s')
-> Biff (->) f g t t'
forall a b. (a -> b) -> a -> b
$ (f s -> g s') -> Biff (->) f g s s'
forall {k} {k1} {k2} {k3} (p :: k -> k1 -> *) (f :: k2 -> k)
       (g :: k3 -> k1) (a :: k2) (b :: k3).
p (f a) (g b) -> Biff p f g a b
Biff f s -> g s'
forall s s'. c s s' => f s -> g s'
f
{-# INLINE dialgebra #-}

-- | `gcotraverse1` is `record1` specialized to `Costar`.
gcotraverse1 :: forall c t t' f a b. (ADTRecord1 t t', Constraints1 t t' c, Functor f)
             => (forall d e s s'. c s s' => (f d -> e) -> f (s d) -> s' e) -> (f a -> b) -> f (t a) -> t' b
gcotraverse1 :: forall (c :: (* -> *) -> (* -> *) -> Constraint) (t :: * -> *)
       (t' :: * -> *) (f :: * -> *) a b.
(ADTRecord1 t t', Constraints1 t t' c, Functor f) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 (f d -> e) -> f (s d) -> s' e)
-> (f a -> b) -> f (t a) -> t' b
gcotraverse1 forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(f d -> e) -> f (s d) -> s' e
f f a -> b
p = Costar f (t a) (t' b) -> f (t a) -> t' b
forall {k} (f :: k -> *) (d :: k) c. Costar f d c -> f d -> c
runCostar (Costar f (t a) (t' b) -> f (t a) -> t' b)
-> Costar f (t a) (t' b) -> f (t a) -> t' b
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) (t' :: * -> *) a b.
(ADTRecord1 t t', Constraints1 t t' c,
 GenericRecordProfunctor p) =>
(forall d e (s :: * -> *) (s' :: * -> *).
 c s s' =>
 p d e -> p (s d) (s' e))
-> p a b -> p (t a) (t' b)
record1 @c ((f (s d) -> s' e) -> Costar f (s d) (s' e)
forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
Costar ((f (s d) -> s' e) -> Costar f (s d) (s' e))
-> (Costar f d e -> f (s d) -> s' e)
-> Costar f d e
-> Costar f (s d) (s' e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f d -> e) -> f (s d) -> s' e
forall d e (s :: * -> *) (s' :: * -> *).
c s s' =>
(f d -> e) -> f (s d) -> s' e
f ((f d -> e) -> f (s d) -> s' e)
-> (Costar f d e -> f d -> e) -> Costar f d e -> f (s d) -> s' e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Costar f d e -> f d -> e
forall {k} (f :: k -> *) (d :: k) c. Costar f d c -> f d -> c
runCostar) ((f a -> b) -> Costar f a b
forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
Costar f a -> b
p)
{-# INLINE gcotraverse1 #-}