-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.OneLiner
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  sjoerd@w3future.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-- 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.
-- The function `createA_` does not require any such instance, but must be given
-- a constructor explicitly.
-----------------------------------------------------------------------------
{-# LANGUAGE
    RankNTypes
  , Trustworthy
  , LinearTypes
  , TypeFamilies
  , ConstraintKinds
  , FlexibleContexts
  , TypeApplications
  , AllowAmbiguousTypes
  , ScopedTypeVariables
  #-}
module Generics.OneLiner (
  -- * Producing values
  create, createA, ctorIndex,
  create1, createA1, ctorIndex1,
  createA_,
  -- * Traversing values
  gmap, gfoldMap, gtraverse,
  glmap, glfoldMap, gltraverse,
  gmap1, gfoldMap1, gtraverse1,
  glmap1, gltraverse1, gltraverse01,
  -- * Combining values
  mzipWith, mzipWith', zipWithA,
  mzipWith1, mzipWith1', zipWithA1,
  -- * Consuming values
  consume, consume1,
  -- * Functions for records
  -- | These functions only work for single constructor data types.
  nullaryOp, unaryOp, binaryOp, createA', algebra, dialgebra,
  createA1', 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.Bifunctor.Clown
import Data.Bifunctor.Joker
import Data.Functor.Compose
import Data.Functor.Contravariant.Divisible
import qualified Control.Functor.Linear as CL
import qualified Data.Functor.Linear as DL
import qualified Data.Monoid.Linear as Linear
import qualified Data.Unrestricted.Linear as Linear
import Data.Profunctor
import Data.Profunctor.Kleisli.Linear
import Data.Tagged
import Generics.OneLiner.Classes
import Generics.OneLiner.Internal (FunConstraints, FunResult, autoApply, Pair(..), (.:))
import Generics.OneLiner.Internal.Unary

-- | Create a value (one for each constructor), given how to construct the components.
--
-- @
-- `minBound` = `head` `$` `create` \@`Bounded` [`minBound`]
-- `maxBound` = `last` `$` `create` \@`Bounded` [`maxBound`]
-- @
--
-- `create` is `createA` specialized to lists.
create :: forall c t. (ADT t, Constraints t c)
       => (forall s. c s => [s]) -> [t]
create :: forall (c :: * -> Constraint) t.
(ADT t, Constraints t c) =>
(forall s. c s => [s]) -> [t]
create = forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Alternative f) =>
(forall s. c s => f s) -> f t
createA @c
{-# INLINE create #-}

-- | Create a value (one for each constructor), given how to construct the components, under an applicative effect.
--
-- Here's how to implement `get` from the `binary` package, first encoding the
-- constructor in a byte:
--
-- @
-- get = getWord8 `>>=` \\ix -> `getCompose` (`createA` \@Binary (`Compose` [get])) `!!` `fromEnum` ix
-- @
--
-- `createA` is `generic` specialized to `Joker`.
createA :: forall c t f. (ADT t, Constraints t c, Alternative f)
        => (forall s. c s => f s) -> f t
createA :: forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Alternative f) =>
(forall s. c s => f s) -> f t
createA forall s. c s => f s
f = Joker f t t -> f t
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker (Joker f t t -> f t) -> Joker f t t -> f t
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (p :: * -> * -> *) t.
(ADT t, Constraints t c, GenericProfunctor p) =>
(forall s. c s => p s s) -> p t t
generic @c ((forall s. c s => Joker f s s) -> Joker f t t)
-> (forall s. c s => Joker f s s) -> Joker f t t
forall a b. (a -> b) -> a -> b
$ f s -> Joker f s s
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker f s
forall s. c s => f s
f
{-# INLINE createA #-}

-- | Generate ways to consume values of type `t`. This is the contravariant version of `createA`.
--
-- `consume` is `generic` specialized to `Clown`.
consume :: forall c t f. (ADT t, Constraints t c, Decidable f)
        => (forall s. c s => f s) -> f t
consume :: forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Decidable f) =>
(forall s. c s => f s) -> f t
consume forall s. c s => f s
f = Clown f t t -> f t
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (b :: k2).
Clown f a b -> f a
runClown (Clown f t t -> f t) -> Clown f t t -> f t
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (p :: * -> * -> *) t.
(ADT t, Constraints t c, GenericProfunctor p) =>
(forall s. c s => p s s) -> p t t
generic @c ((forall s. c s => Clown f s s) -> Clown f t t)
-> (forall s. c s => Clown f s s) -> Clown f t t
forall a b. (a -> b) -> a -> b
$ f s -> Clown f s s
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown f s
forall s. c s => f s
f
{-# INLINE consume #-}

-- | `create1` is `createA1` specialized to lists.
create1 :: forall c t a. (ADT1 t, Constraints1 t c)
        => (forall b s. c s => [b] -> [s b]) -> [a] -> [t a]
create1 :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) a.
(ADT1 t, Constraints1 t c) =>
(forall b (s :: * -> *). c s => [b] -> [s b]) -> [a] -> [t a]
create1 = forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a.
(ADT1 t, Constraints1 t c, Alternative f) =>
(forall b (s :: * -> *). c s => f b -> f (s b)) -> f a -> f (t a)
createA1 @c
{-# INLINE create1 #-}

-- | `createA1` is `generic1` specialized to `Joker`.
createA1 :: forall c t f a. (ADT1 t, Constraints1 t c, Alternative f)
         => (forall b s. c s => f b -> f (s b)) -> f a -> f (t a)
createA1 :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a.
(ADT1 t, Constraints1 t c, Alternative f) =>
(forall b (s :: * -> *). c s => f b -> f (s b)) -> f a -> f (t a)
createA1 forall b (s :: * -> *). c s => f b -> f (s b)
f = (f a -> Joker f Any a)
-> (Joker f (t Any) (t a) -> f (t a))
-> (Joker f Any a -> Joker f (t Any) (t a))
-> f a
-> f (t a)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap f a -> Joker f Any a
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker Joker f (t Any) (t a) -> f (t a)
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker ((Joker f Any a -> Joker f (t Any) (t a)) -> f a -> f (t a))
-> (Joker f Any a -> Joker f (t Any) (t a)) -> f a -> f (t a)
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) a b.
(ADT1 t, Constraints1 t c, Generic1Profunctor p) =>
(forall d e (s :: * -> *). c s => p d e -> p (s d) (s e))
-> p a b -> p (t a) (t b)
generic1 @c ((forall d e (s :: * -> *).
  c s =>
  Joker f d e -> Joker f (s d) (s e))
 -> Joker f Any a -> Joker f (t Any) (t a))
-> (forall d e (s :: * -> *).
    c s =>
    Joker f d e -> Joker f (s d) (s e))
-> Joker f Any a
-> Joker f (t Any) (t a)
forall a b. (a -> b) -> a -> b
$ (Joker f d e -> f e)
-> (f (s e) -> Joker f (s d) (s e))
-> (f e -> f (s e))
-> Joker f d e
-> Joker f (s d) (s e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Joker f d e -> f e
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker f (s e) -> Joker f (s d) (s e)
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker f e -> f (s e)
forall b (s :: * -> *). c s => f b -> f (s b)
f
{-# INLINE createA1 #-}

-- | Create a value, given a constructor (or a function) and
-- how to construct its components, under an applicative effect.
--
-- For example, this is the implementation of `Test.QuickCheck.arbitrary` for a
-- type with a single constructor (e.g., quadruples @(,,,)@).
--
-- @
-- arbitrary = `createA_` \@`Arbitrary` arbitrary (,,,)
-- @
createA_ :: forall c t f. (FunConstraints c t, Applicative f)
         => (forall s. c s => f s) -> t -> f (FunResult t)
createA_ :: forall (c :: * -> Constraint) t (f :: * -> *).
(FunConstraints c t, Applicative f) =>
(forall s. c s => f s) -> t -> f (FunResult t)
createA_ forall s. c s => f s
run = forall (c :: * -> Constraint) t (f :: * -> *).
(FunConstraints c t, Applicative f) =>
(forall s. c s => f s) -> f t -> f (FunResult t)
autoApply @c forall s. c s => f s
run (f t -> f (FunResult t)) -> (t -> f t) -> t -> f (FunResult t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE createA_ #-}

-- | `consume1` is `generic1` specialized to `Clown`.
consume1 :: forall c t f a. (ADT1 t, Constraints1 t c, Decidable f)
         => (forall b s. c s => f b -> f (s b)) -> f a -> f (t a)
consume1 :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a.
(ADT1 t, Constraints1 t c, Decidable f) =>
(forall b (s :: * -> *). c s => f b -> f (s b)) -> f a -> f (t a)
consume1 forall b (s :: * -> *). c s => f b -> f (s b)
f = (f a -> Clown f a Any)
-> (Clown f (t a) (t Any) -> f (t a))
-> (Clown f a Any -> Clown f (t a) (t Any))
-> f a
-> f (t a)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap f a -> Clown f a Any
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown Clown f (t a) (t Any) -> f (t a)
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (b :: k2).
Clown f a b -> f a
runClown ((Clown f a Any -> Clown f (t a) (t Any)) -> f a -> f (t a))
-> (Clown f a Any -> Clown f (t a) (t Any)) -> f a -> f (t a)
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) a b.
(ADT1 t, Constraints1 t c, Generic1Profunctor p) =>
(forall d e (s :: * -> *). c s => p d e -> p (s d) (s e))
-> p a b -> p (t a) (t b)
generic1 @c ((forall d e (s :: * -> *).
  c s =>
  Clown f d e -> Clown f (s d) (s e))
 -> Clown f a Any -> Clown f (t a) (t Any))
-> (forall d e (s :: * -> *).
    c s =>
    Clown f d e -> Clown f (s d) (s e))
-> Clown f a Any
-> Clown f (t a) (t Any)
forall a b. (a -> b) -> a -> b
$ (Clown f d e -> f d)
-> (f (s d) -> Clown f (s d) (s e))
-> (f d -> f (s d))
-> Clown f d e
-> Clown f (s d) (s e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Clown f d e -> f d
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (b :: k2).
Clown f a b -> f a
runClown f (s d) -> Clown f (s d) (s e)
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown f d -> f (s d)
forall b (s :: * -> *). c s => f b -> f (s b)
f
{-# INLINE consume1 #-}


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

-- | Map each component of a structure to a monoid, and combine the results.
--
-- If you have a class `Size`, which measures the size of a structure, then this could be the default implementation:
--
-- @
-- size = `succ` `.` `getSum` `.` `gfoldMap` \@`Size` (`Sum` `.` size)
-- @
--
-- `gfoldMap` is `gtraverse` specialized to `Const`.
gfoldMap :: forall c t m. (ADT t, Constraints t c, Monoid m)
         => (forall s. c s => s -> m) -> t -> m
gfoldMap :: forall (c :: * -> Constraint) t m.
(ADT t, Constraints t c, Monoid m) =>
(forall s. c s => s -> m) -> t -> m
gfoldMap forall s. c s => s -> m
f = Const m t -> m
forall {k} a (b :: k). Const a b -> a
getConst (Const m t -> m) -> (t -> Const m t) -> t -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Applicative f) =>
(forall s. c s => s -> f s) -> t -> f t
gtraverse @c (m -> Const m s
forall {k} a (b :: k). a -> Const a b
Const (m -> Const m s) -> (s -> m) -> s -> Const m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m
forall s. c s => s -> m
f)
{-# INLINE gfoldMap #-}

-- | Map each component of a structure to a monoid, and combine the results.
--
-- If you have a class `Size`, which measures the size of a structure, then this could be the default implementation:
--
-- @
-- consume = `glfoldMap` \@`Linear.Consumable` `Linear.consume`
-- @
--
-- `glfoldMap` is `gltraverse` specialized to `Const`.
glfoldMap :: forall c t m. (ADT t, Constraints t c, Linear.Monoid m)
          => (forall s. c s => s %1-> m) -> t %1-> m
glfoldMap :: forall (c :: * -> Constraint) t m.
(ADT t, Constraints t c, Monoid m) =>
(forall s. c s => s %1 -> m) -> t %1 -> m
glfoldMap forall s. c s => s %1 -> m
f t
t = (\(Const m
c) -> m
c) (forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Applicative f) =>
(forall s. c s => s %1 -> f s) -> t %1 -> f t
gltraverse @c (\s
x -> m %1 -> Const m s
forall {k} a (b :: k). a -> Const a b
Const (s %1 -> m
forall s. c s => s %1 -> m
f s
x)) t
t)
{-# INLINE glfoldMap #-}

-- | 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 f. (ADT t, Constraints t c, Applicative f)
          => (forall s. c s => s -> f s) -> t -> f t
gtraverse :: forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Applicative f) =>
(forall s. c s => s -> f s) -> t -> f t
gtraverse forall s. c 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.
(ADT t, Constraints t c, GenericProfunctor p) =>
(forall s. c s => p s s) -> p t t
generic @c ((forall s. c s => Star f s s) -> Star f t t)
-> (forall s. c 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. c 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.
--
-- @
-- dupV = `gltraverse` \@`Linear.Dupable` `Linear.dupV`
-- move = `gltraverse` \@`Linear.Movable` `Linear.move`
-- @
--
-- `gltraverse` is `generic` specialized to linear `Kleisli`.
gltraverse :: forall c t f. (ADT t, Constraints t c, DL.Applicative f)
           => (forall s. c s => s %1-> f s) -> t %1-> f t
gltraverse :: forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Applicative f) =>
(forall s. c s => s %1 -> f s) -> t %1 -> f t
gltraverse forall s. c 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.
(ADT t, Constraints t c, GenericProfunctor p) =>
(forall s. c s => p s s) -> p t t
generic @c ((forall s. c s => Kleisli f s s) -> Kleisli f t t)
-> (forall s. c 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. c s => s %1 -> f s
f
{-# INLINE gltraverse #-}

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

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

-- |
-- @
-- foldMap = `gfoldMap1` \@`Foldable` `foldMap`
-- @
--
-- `gfoldMap1` is `gtraverse1` specialized to `Const`.
gfoldMap1 :: forall c t m a. (ADT1 t, Constraints1 t c, Monoid m)
          => (forall s b. c s => (b -> m) -> s b -> m) -> (a -> m) -> t a -> m
gfoldMap1 :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) m a.
(ADT1 t, Constraints1 t c, Monoid m) =>
(forall (s :: * -> *) b. c s => (b -> m) -> s b -> m)
-> (a -> m) -> t a -> m
gfoldMap1 forall (s :: * -> *) b. c s => (b -> m) -> s b -> m
f = ((a -> m) -> a -> Const m Any)
-> ((t a -> Const m (t Any)) -> t a -> m)
-> ((a -> Const m Any) -> t a -> Const m (t Any))
-> (a -> m)
-> t a
-> m
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (m -> Const m Any
forall {k} a (b :: k). a -> Const a b
Const (m -> Const m Any) -> (a -> m) -> a -> Const m Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (Const m (t Any) -> m
forall {k} a (b :: k). Const a b -> a
getConst (Const m (t Any) -> m) -> (t a -> Const m (t Any)) -> t a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (((a -> Const m Any) -> t a -> Const m (t Any))
 -> (a -> m) -> t a -> m)
-> ((a -> Const m Any) -> t a -> Const m (t Any))
-> (a -> m)
-> t a
-> m
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a
       b.
(ADT1 t, Constraints1 t c, Applicative f) =>
(forall d e (s :: * -> *). c s => (d -> f e) -> s d -> f (s e))
-> (a -> f b) -> t a -> f (t b)
gtraverse1 @c ((forall d e (s :: * -> *).
  c s =>
  (d -> Const m e) -> s d -> Const m (s e))
 -> (a -> Const m Any) -> t a -> Const m (t Any))
-> (forall d e (s :: * -> *).
    c s =>
    (d -> Const m e) -> s d -> Const m (s e))
-> (a -> Const m Any)
-> t a
-> Const m (t Any)
forall a b. (a -> b) -> a -> b
$ ((d -> Const m e) -> d -> m)
-> ((s d -> m) -> s d -> Const m (s e))
-> ((d -> m) -> s d -> m)
-> (d -> Const m e)
-> s d
-> Const m (s e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (Const m e -> m
forall {k} a (b :: k). Const a b -> a
getConst (Const m e -> m) -> (d -> Const m e) -> d -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (m -> Const m (s e)
forall {k} a (b :: k). a -> Const a b
Const (m -> Const m (s e)) -> (s d -> m) -> s d -> Const m (s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (d -> m) -> s d -> m
forall (s :: * -> *) b. c s => (b -> m) -> s b -> m
f
{-# INLINE gfoldMap1 #-}

-- |
-- @
-- traverse = `gtraverse1` \@`Traversable` `traverse`
-- @
--
-- `gtraverse1` is `generic1` specialized to `Star`.
gtraverse1 :: forall c t f a b. (ADT1 t, Constraints1 t c, Applicative f)
           => (forall d e s. c s => (d -> f e) -> s d -> f (s e)) -> (a -> f b) -> t a -> f (t b)
gtraverse1 :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a
       b.
(ADT1 t, Constraints1 t c, Applicative f) =>
(forall d e (s :: * -> *). c s => (d -> f e) -> s d -> f (s e))
-> (a -> f b) -> t a -> f (t b)
gtraverse1 forall d e (s :: * -> *). c 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 :: * -> *) a b.
(ADT1 t, Constraints1 t c, Generic1Profunctor p) =>
(forall d e (s :: * -> *). c s => p d e -> p (s d) (s e))
-> p a b -> p (t a) (t b)
generic1 @c ((forall d e (s :: * -> *).
  c 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 :: * -> *).
    c 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 :: * -> *). c s => (d -> f e) -> s d -> f (s e)
f
{-# INLINE gtraverse1 #-}

-- |
-- @
-- traverse = `gltraverse1` \@`DL.Traversable` `DL.traverse`
-- @
--
-- `gltraverse1` is `generic1` specialized to linear `Kleisli`.
gltraverse1 :: forall c t f a b. (ADT1 t, Constraints1 t c, CL.Applicative f)
            => (forall d e s. c 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 :: * -> *) (f :: * -> *) a
       b.
(ADT1 t, Constraints1 t c, Applicative f) =>
(forall d e (s :: * -> *).
 c 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 :: * -> *). c 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 :: * -> *) a b.
(ADT1 t, Constraints1 t c, Generic1Profunctor p) =>
(forall d e (s :: * -> *). c s => p d e -> p (s d) (s e))
-> p a b -> p (t a) (t b)
generic1 @c ((forall d e (s :: * -> *).
  c 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 :: * -> *).
    c 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 :: * -> *). c 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 f a b. (ADT1 t, Constraints01 t Linear.Movable c, DL.Applicative f)
             => (forall d e s. c 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 :: * -> *) (f :: * -> *) a
       b.
(ADT1 t, Constraints01 t Movable c, Applicative f) =>
(forall d e (s :: * -> *).
 c 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 :: * -> *). c 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 :: * -> *) a b.
(ADT1 t, Constraints01 t c0 c1, GenericProfunctor p) =>
(forall s. c0 s => p s s)
-> (forall d e (s :: * -> *). c1 s => p d e -> p (s d) (s e))
-> p a b
-> p (t a) (t b)
generic01 @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 :: * -> *).
  c 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 :: * -> *).
    c 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 :: * -> *). c 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 to a monoid, and combine the results.
-- Returns `mempty` if the constructors don't match.
--
-- @
-- `compare` s t = `compare` (`ctorIndex` s) (`ctorIndex` t) `<>` `mzipWith` \@`Ord` `compare` s t
-- @
--
-- `mzipWith` is `zipWithA` specialized to @`Compose` `Maybe` (`Const` m)@
mzipWith :: forall c t m. (ADT t, Constraints t c, Monoid m)
         => (forall s. c s => s -> s -> m) -> t -> t -> m
mzipWith :: forall (c :: * -> Constraint) t m.
(ADT t, Constraints t c, Monoid m) =>
(forall s. c s => s -> s -> m) -> t -> t -> m
mzipWith = forall (c :: * -> Constraint) t m.
(ADT t, Constraints t c, Monoid m) =>
m -> (forall s. c s => s -> s -> m) -> t -> t -> m
mzipWith' @c m
forall a. Monoid a => a
mempty
{-# INLINE mzipWith #-}

-- | Variant of `mzipWith` where you can choose the value which is returned
-- when the constructors don't match.
--
-- @
-- `compare` s t = `mzipWith'` \@`Ord` (`compare` (`ctorIndex` s) (`ctorIndex` t)) `compare` s t
-- @
mzipWith' :: forall c t m. (ADT t, Constraints t c, Monoid m)
          => m -> (forall s. c s => s -> s -> m) -> t -> t -> m
mzipWith' :: forall (c :: * -> Constraint) t m.
(ADT t, Constraints t c, Monoid m) =>
m -> (forall s. c s => s -> s -> m) -> t -> t -> m
mzipWith' m
m forall s. c s => s -> s -> m
f = m -> (t -> t -> Compose Maybe (Const m) t) -> t -> t -> m
forall m t a.
Monoid m =>
m -> (t -> t -> Compose Maybe (Const m) a) -> t -> t -> m
outm2 m
m ((t -> t -> Compose Maybe (Const m) t) -> t -> t -> m)
-> (t -> t -> Compose Maybe (Const m) t) -> t -> t -> m
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Alternative f) =>
(forall s. c s => s -> s -> f s) -> t -> t -> f t
zipWithA @c ((forall s. c s => s -> s -> Compose Maybe (Const m) s)
 -> t -> t -> Compose Maybe (Const m) t)
-> (forall s. c s => s -> s -> Compose Maybe (Const m) s)
-> t
-> t
-> Compose Maybe (Const m) t
forall a b. (a -> b) -> a -> b
$ (s -> s -> m) -> s -> s -> Compose Maybe (Const m) s
forall t m a. (t -> t -> m) -> t -> t -> Compose Maybe (Const m) a
inm2 s -> s -> m
forall s. c s => s -> s -> m
f
{-# INLINE mzipWith' #-}

-- | 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 f. (ADT t, Constraints t c, Alternative f)
         => (forall s. c s => s -> s -> f s) -> t -> t -> f t
zipWithA :: forall (c :: * -> Constraint) t (f :: * -> *).
(ADT t, Constraints t c, Alternative f) =>
(forall s. c s => s -> s -> f s) -> t -> t -> f t
zipWithA forall s. c 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.
(ADT t, Constraints t c, GenericProfunctor p) =>
(forall s. c s => p s s) -> p t t
generic @c ((forall s. c s => Zip f s s) -> Zip f t t)
-> (forall s. c 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. c s => s -> s -> f s
f
{-# INLINE zipWithA #-}

-- |
-- @
-- `liftCompare` = `mzipWith1` \@`Ord1` `liftCompare`
-- @
--
-- `mzipWith1` is `zipWithA1` specialized to @`Compose` `Maybe` (`Const` m)@
mzipWith1 :: forall c t m a. (ADT1 t, Constraints1 t c, Monoid m)
          => (forall s b. c s => (b -> b -> m) -> s b -> s b -> m)
          -> (a -> a -> m) -> t a -> t a -> m
mzipWith1 :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) m a.
(ADT1 t, Constraints1 t c, Monoid m) =>
(forall (s :: * -> *) b. c s => (b -> b -> m) -> s b -> s b -> m)
-> (a -> a -> m) -> t a -> t a -> m
mzipWith1 = forall (c :: (* -> *) -> Constraint) (t :: * -> *) m a.
(ADT1 t, Constraints1 t c, Monoid m) =>
m
-> (forall (s :: * -> *) b.
    c s =>
    (b -> b -> m) -> s b -> s b -> m)
-> (a -> a -> m)
-> t a
-> t a
-> m
mzipWith1' @c m
forall a. Monoid a => a
mempty
{-# INLINE mzipWith1 #-}

-- | Variant of `mzipWith1` where you can choose the value which is returned
-- when the constructors don't match.
mzipWith1' :: forall c t m a. (ADT1 t, Constraints1 t c, Monoid m)
           => m
           -> (forall s b. c s => (b -> b -> m) -> s b -> s b -> m)
           -> (a -> a -> m) -> t a -> t a -> m
mzipWith1' :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) m a.
(ADT1 t, Constraints1 t c, Monoid m) =>
m
-> (forall (s :: * -> *) b.
    c s =>
    (b -> b -> m) -> s b -> s b -> m)
-> (a -> a -> m)
-> t a
-> t a
-> m
mzipWith1' m
m forall (s :: * -> *) b. c s => (b -> b -> m) -> s b -> s b -> m
f = ((a -> a -> m) -> a -> a -> Compose Maybe (Const m) Any)
-> ((t a -> t a -> Compose Maybe (Const m) (t Any))
    -> t a -> t a -> m)
-> ((a -> a -> Compose Maybe (Const m) Any)
    -> t a -> t a -> Compose Maybe (Const m) (t Any))
-> (a -> a -> m)
-> t a
-> t a
-> m
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a -> a -> m) -> a -> a -> Compose Maybe (Const m) Any
forall t m a. (t -> t -> m) -> t -> t -> Compose Maybe (Const m) a
inm2 (m
-> (t a -> t a -> Compose Maybe (Const m) (t Any))
-> t a
-> t a
-> m
forall m t a.
Monoid m =>
m -> (t -> t -> Compose Maybe (Const m) a) -> t -> t -> m
outm2 m
m) (((a -> a -> Compose Maybe (Const m) Any)
  -> t a -> t a -> Compose Maybe (Const m) (t Any))
 -> (a -> a -> m) -> t a -> t a -> m)
-> ((a -> a -> Compose Maybe (Const m) Any)
    -> t a -> t a -> Compose Maybe (Const m) (t Any))
-> (a -> a -> m)
-> t a
-> t a
-> m
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a
       b.
(ADT1 t, Constraints1 t c, Alternative f) =>
(forall d e (s :: * -> *).
 c s =>
 (d -> d -> f e) -> s d -> s d -> f (s e))
-> (a -> a -> f b) -> t a -> t a -> f (t b)
zipWithA1 @c ((forall d e (s :: * -> *).
  c s =>
  (d -> d -> Compose Maybe (Const m) e)
  -> s d -> s d -> Compose Maybe (Const m) (s e))
 -> (a -> a -> Compose Maybe (Const m) Any)
 -> t a
 -> t a
 -> Compose Maybe (Const m) (t Any))
-> (forall d e (s :: * -> *).
    c s =>
    (d -> d -> Compose Maybe (Const m) e)
    -> s d -> s d -> Compose Maybe (Const m) (s e))
-> (a -> a -> Compose Maybe (Const m) Any)
-> t a
-> t a
-> Compose Maybe (Const m) (t Any)
forall a b. (a -> b) -> a -> b
$ ((d -> d -> Compose Maybe (Const m) e) -> d -> d -> m)
-> ((s d -> s d -> m)
    -> s d -> s d -> Compose Maybe (Const m) (s e))
-> ((d -> d -> m) -> s d -> s d -> m)
-> (d -> d -> Compose Maybe (Const m) e)
-> s d
-> s d
-> Compose Maybe (Const m) (s e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (m -> (d -> d -> Compose Maybe (Const m) e) -> d -> d -> m
forall m t a.
Monoid m =>
m -> (t -> t -> Compose Maybe (Const m) a) -> t -> t -> m
outm2 m
m) (s d -> s d -> m) -> s d -> s d -> Compose Maybe (Const m) (s e)
forall t m a. (t -> t -> m) -> t -> t -> Compose Maybe (Const m) a
inm2 (d -> d -> m) -> s d -> s d -> m
forall (s :: * -> *) b. c s => (b -> b -> m) -> s b -> s b -> m
f
{-# INLINE mzipWith1' #-}

-- | `zipWithA1` is `generic1` specialized to `Zip`
zipWithA1 :: forall c t f a b. (ADT1 t, Constraints1 t c, Alternative f)
          => (forall d e s. c 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 :: * -> *) (f :: * -> *) a
       b.
(ADT1 t, Constraints1 t c, Alternative f) =>
(forall d e (s :: * -> *).
 c 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 :: * -> *).
c 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 :: * -> *) a b.
(ADT1 t, Constraints1 t c, Generic1Profunctor p) =>
(forall d e (s :: * -> *). c s => p d e -> p (s d) (s e))
-> p a b -> p (t a) (t b)
generic1 @c ((forall d e (s :: * -> *). c 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 :: * -> *).
    c 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 :: * -> *).
c s =>
(d -> d -> f e) -> s d -> s d -> f (s e)
f
{-# INLINE zipWithA1 #-}

inm2 :: (t -> t -> m) -> t -> t -> Compose Maybe (Const m) a
inm2 :: forall t m a. (t -> t -> m) -> t -> t -> Compose Maybe (Const m) a
inm2 t -> t -> m
f = Maybe (Const m a) -> Compose Maybe (Const m) a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Maybe (Const m a) -> Compose Maybe (Const m) a)
-> (t -> t -> Maybe (Const m a))
-> t
-> t
-> Compose Maybe (Const m) a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Const m a -> Maybe (Const m a)
forall a. a -> Maybe a
Just (Const m a -> Maybe (Const m a))
-> (t -> t -> Const m a) -> t -> t -> Maybe (Const m a)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: m -> Const m a
forall {k} a (b :: k). a -> Const a b
Const (m -> Const m a) -> (t -> t -> m) -> t -> t -> Const m a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: t -> t -> m
f
{-# INLINE inm2 #-}
outm2 :: Monoid m => m -> (t -> t -> Compose Maybe (Const m) a) -> t -> t -> m
outm2 :: forall m t a.
Monoid m =>
m -> (t -> t -> Compose Maybe (Const m) a) -> t -> t -> m
outm2 m
z t -> t -> Compose Maybe (Const m) a
f = m -> (Const m a -> m) -> Maybe (Const m a) -> m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m
z Const m a -> m
forall {k} a (b :: k). Const a b -> a
getConst (Maybe (Const m a) -> m)
-> (t -> t -> Maybe (Const m a)) -> t -> t -> m
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Compose Maybe (Const m) a -> Maybe (Const m a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose Maybe (Const m) a -> Maybe (Const m a))
-> (t -> t -> Compose Maybe (Const m) a)
-> t
-> t
-> Maybe (Const m a)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: t -> t -> Compose Maybe (Const m) a
f
{-# INLINE outm2 #-}

-- | Implement a nullary operator by calling the operator for each component.
--
-- @
-- `mempty` = `nullaryOp` \@`Monoid` `mempty`
-- `fromInteger` i = `nullaryOp` \@`Num` (`fromInteger` i)
-- @
--
-- `nullaryOp` is `record` specialized to `Tagged`.
nullaryOp :: forall c t. (ADTRecord t, Constraints t c)
          => (forall s. c s => s) -> t
nullaryOp :: forall (c :: * -> Constraint) t.
(ADTRecord t, Constraints t c) =>
(forall s. c s => s) -> t
nullaryOp forall s. c s => s
f = Tagged t t -> t
forall {k} (s :: k) b. Tagged s b -> b
unTagged (Tagged t t -> t) -> Tagged t t -> t
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (p :: * -> * -> *) t.
(ADTRecord t, Constraints t c, GenericRecordProfunctor p) =>
(forall s. c s => p s s) -> p t t
record @c ((forall s. c s => Tagged s s) -> Tagged t t)
-> (forall s. c s => Tagged s s) -> Tagged t t
forall a b. (a -> b) -> a -> b
$ s -> Tagged s s
forall {k} (s :: k) b. b -> Tagged s b
Tagged s
forall s. c s => s
f
{-# INLINE nullaryOp #-}

-- | 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. (ADTRecord t, Constraints t c)
        => (forall s. c s => s -> s) -> t -> t
unaryOp :: forall (c :: * -> Constraint) t.
(ADTRecord t, Constraints t c) =>
(forall s. c s => s -> s) -> t -> t
unaryOp = forall (c :: * -> Constraint) (p :: * -> * -> *) t.
(ADTRecord t, Constraints t c, GenericRecordProfunctor p) =>
(forall s. c 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. (ADTRecord t, Constraints t c)
         => (forall s. c s => s -> s -> s) -> t -> t -> t
binaryOp :: forall (c :: * -> Constraint) t.
(ADTRecord t, Constraints t c) =>
(forall s. c s => s -> s -> s) -> t -> t -> t
binaryOp forall s. c s => s -> s -> s
f = forall (c :: * -> Constraint) t (f :: * -> *).
(ADTRecord t, Constraints t c, Functor f) =>
(forall s. c s => f s -> s) -> f t -> t
algebra @c (\(Pair s
a s
b) -> s -> s -> s
forall s. c 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 a value of a record type (with exactly one constructor), given
-- how to construct the components, under an applicative effect.
--
-- Here's how to implement `get` from the `binary` package:
--
-- @
-- get = `createA'` (`For` :: `For` Binary) get
-- @
--
-- `createA'` is `record` specialized to `Joker`.
createA' :: forall c t f. (ADTRecord t, Constraints t c, Applicative f)
         => (forall s. c s => f s) -> f t
createA' :: forall (c :: * -> Constraint) t (f :: * -> *).
(ADTRecord t, Constraints t c, Applicative f) =>
(forall s. c s => f s) -> f t
createA' forall s. c s => f s
f = Joker f t t -> f t
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker (Joker f t t -> f t) -> Joker f t t -> f t
forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (p :: * -> * -> *) t.
(ADTRecord t, Constraints t c, GenericRecordProfunctor p) =>
(forall s. c s => p s s) -> p t t
record @c ((forall s. c s => Joker f s s) -> Joker f t t)
-> (forall s. c s => Joker f s s) -> Joker f t t
forall a b. (a -> b) -> a -> b
$ f s -> Joker f s s
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker f s
forall s. c s => f s
f
{-# INLINE createA' #-}

-- | 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 f. (ADTRecord t, Constraints t c, Functor f)
        => (forall s. c s => f s -> s) -> f t -> t
algebra :: forall (c :: * -> Constraint) t (f :: * -> *).
(ADTRecord t, Constraints t c, Functor f) =>
(forall s. c s => f s -> s) -> f t -> t
algebra forall s. c 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.
(ADTRecord t, Constraints t c, GenericRecordProfunctor p) =>
(forall s. c s => p s s) -> p t t
record @c ((forall s. c s => Costar f s s) -> Costar f t t)
-> (forall s. c 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. c s => f s -> s
f
{-# INLINE algebra #-}

-- | `dialgebra` is `record` specialized to @`Biff` (->)@.
dialgebra :: forall c t f g. (ADTRecord t, Constraints t c, Functor f, Applicative g)
        => (forall s. c s => f s -> g s) -> f t -> g t
dialgebra :: forall (c :: * -> Constraint) t (f :: * -> *) (g :: * -> *).
(ADTRecord t, Constraints t c, Functor f, Applicative g) =>
(forall s. c s => f s -> g s) -> f t -> g t
dialgebra forall s. c 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.
(ADTRecord t, Constraints t c, GenericRecordProfunctor p) =>
(forall s. c s => p s s) -> p t t
record @c ((forall s. c s => Biff (->) f g s s) -> Biff (->) f g t t)
-> (forall s. c 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. c s => f s -> g s
f
{-# INLINE dialgebra #-}

-- | `createA1'` is `record1` specialized to `Joker`.
createA1' :: forall c t f a. (ADTRecord1 t, Constraints1 t c, Applicative f)
         => (forall b s. c s => f b -> f (s b)) -> f a -> f (t a)
createA1' :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a.
(ADTRecord1 t, Constraints1 t c, Applicative f) =>
(forall b (s :: * -> *). c s => f b -> f (s b)) -> f a -> f (t a)
createA1' forall b (s :: * -> *). c s => f b -> f (s b)
f = (f a -> Joker f Any a)
-> (Joker f (t Any) (t a) -> f (t a))
-> (Joker f Any a -> Joker f (t Any) (t a))
-> f a
-> f (t a)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap f a -> Joker f Any a
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker Joker f (t Any) (t a) -> f (t a)
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker ((Joker f Any a -> Joker f (t Any) (t a)) -> f a -> f (t a))
-> (Joker f Any a -> Joker f (t Any) (t a)) -> f a -> f (t a)
forall a b. (a -> b) -> a -> b
$ forall (c :: (* -> *) -> Constraint) (p :: * -> * -> *)
       (t :: * -> *) a b.
(ADTRecord1 t, Constraints1 t c, GenericRecordProfunctor p) =>
(forall d e (s :: * -> *). c s => p d e -> p (s d) (s e))
-> p a b -> p (t a) (t b)
record1 @c ((forall d e (s :: * -> *).
  c s =>
  Joker f d e -> Joker f (s d) (s e))
 -> Joker f Any a -> Joker f (t Any) (t a))
-> (forall d e (s :: * -> *).
    c s =>
    Joker f d e -> Joker f (s d) (s e))
-> Joker f Any a
-> Joker f (t Any) (t a)
forall a b. (a -> b) -> a -> b
$ (Joker f d e -> f e)
-> (f (s e) -> Joker f (s d) (s e))
-> (f e -> f (s e))
-> Joker f d e
-> Joker f (s d) (s e)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Joker f d e -> f e
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker f (s e) -> Joker f (s d) (s e)
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker f e -> f (s e)
forall b (s :: * -> *). c s => f b -> f (s b)
f
{-# INLINE createA1' #-}

-- |
--
-- @
-- cotraverse = `gcotraverse1` \@`Distributive` `cotraverse`
-- @
--
-- `gcotraverse1` is `record1` specialized to `Costar`.
gcotraverse1 :: forall c t f a b. (ADTRecord1 t, Constraints1 t c, Functor f)
             => (forall d e s. c s => (f d -> e) -> f (s d) -> s e) -> (f a -> b) -> f (t a) -> t b
gcotraverse1 :: forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a
       b.
(ADTRecord1 t, Constraints1 t c, Functor f) =>
(forall d e (s :: * -> *). c s => (f d -> e) -> f (s d) -> s e)
-> (f a -> b) -> f (t a) -> t b
gcotraverse1 forall d e (s :: * -> *). c 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 :: * -> *) a b.
(ADTRecord1 t, Constraints1 t c, GenericRecordProfunctor p) =>
(forall d e (s :: * -> *). c 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 :: * -> *). c 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 #-}