{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Avoid lambda using `infix`" #-}
{-# HLINT ignore "Avoid lambda" #-}
{-# HLINT ignore "Use const" #-}
{-# HLINT ignore "Redundant bracket" #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

{- |
Module:  Data.EvalRecord

This module is intended to be imported qualified, to avoid name clashes with
Prelude and base functions:

@
import qualified Data.EvalRecord as Rec
@

A common Haskell idiom is to parameterise a datatype by a functor or GADT
(or any "indexed type" @k -> 'Data.Kind.Type'@), a pattern
sometimes called <https://reasonablypolymorphic.com/blog/higher-kinded-data/ HKD>).
This parameter acts as a wrapper of the base type, turning it into a record
that serves a different purpose. The canonical example would be:

@
data Person f
  = Person
      { name :: f 'String'
      , age  :: f 'Int'
      }
@

However, this library uses a different approach, where the parameter is
a type-level function @Type -> Exp Type@, from the @first-class-families@ package.
The type of each field is then given by applying 'Eval (f x)' (also known as '@@') to the field:

@
data Person (f :: Type -> 'Exp' Type)
  = Person
      { name :: f '@@' 'String'
      , age  :: f '@@' 'Int'
      }
@

Let's say that we are writing an application where @Person@ data
will be read from a web form, validated, and stored in a database. Some
possibles outfits that we could use along the way are:

@
-- for the raw input from the web-form,
webInput :: Person ('ConstFn' 'String')
webInput = Person "John" "30b"

-- for the result of parsing and validating,
validated :: Person ('Pure1' ('Either' 'String'))
validated = Person (Right "John") (Left "Not a number")

-- Person 'Pure' for the actual data,
domainModel :: Person 'Pure'
domainModel = Person "John" 30

dbModel :: Person ('Pure1' DbColumn) -- To describe how to read / write a @Person@ to the db
dbModel = Person
  { name = DbColumn "name" (Right . fromString) toDbString
  , age  = DbColumn "age"  (readEither . fromString) show
  }

data DbColumn a
  = DbColumn
      { colName :: 'String'
      , fromDb  :: DbDataParser a
      , toDb    :: a -> DbData
      }
@

In such application it is likely that one will have lots of types like
@Person@ so we will like to handle these transformations uniformly,
without boilerplate or repetitions.  This package provides classes to
manipulate these types, using notions that are familiar to haskellers like
'Functor', 'Applicative' or 'Traversable'. For example, instead of writing
an ad-hoc function that checks that all fields have a correct value, like

@
checkPerson :: Person ('Either' 'String') -> 'Either' ['String'] (Person 'Pure')
@

we can write only one such function:

@
check :: 'TraversableRec' rec => rec ('Either' 'String') -> 'Either' ['String'] (rec 'Pure')
check be
  = case 'traverse' ('either' ('const' 'Nothing') 'Just') be of
      'Just' bi -> 'Right' bi
      'Nothing' -> 'Left' ('foldMap' ('either' (:[]) ('const' [])) be)
@

Moreover, these classes come with template-haskell functions to derive
the instances automatically, so that one can write:

@
import Data.EvalRecord
import Data.EvalRecord.TH

mkEvalRecord [d|
  data Bump = Bump
    { bump :: Maybe Int
    , bomp :: Bool
    , bamp :: String
    } deriving (Read, Show, Eq, Ord)
  |]
@
-}
module Data.EvalRecord (
  -- * Type Witnesses
  WitnessFieldTypes (..),
  Metadata (..),

  -- ** Lenses
  LensRec (..),
  getLens,
  nestLens,

  -- * Functor
  FunctorRec (..),

  -- * Traversable
  TraversableRec (..),

  -- ** Utility functions
  Data.EvalRecord.for,
  Data.EvalRecord.for_,
  Data.EvalRecord.foldMap,
  Data.EvalRecord.sequence,
  Data.EvalRecord.sequence',

  -- * Distributive
  DistributiveRec (..),
  Data.EvalRecord.distribute',
  Data.EvalRecord.cotraverse,
  Data.EvalRecord.decompose,
  Data.EvalRecord.recompose,

  -- * Applicative
  ApplicativeRec (..),
  Tuple2,

  -- ** Utility functions
  Data.EvalRecord.zip,
  Data.EvalRecord.unzip,
  Data.EvalRecord.zipWith,
  Data.EvalRecord.zipWith3,
  Data.EvalRecord.zipWith4,

  -- * Constraints
  ConstraintsRec (..),
  AllRecF,
  ClassF,
  ClassFG,
  type (&),
  Dict (..),

  -- ** Utility functions
  dicts,
  requiringDict,
  mapC,
  foldMapC,
  traverseC,
  forC,
  zipWithC,
  zipWith3C,
  zipWith4C,
  pureC,
  Data.EvalRecord.mempty,

  -- * Partial record mapping
  MapMatches,
  ValueOnMatch,
  ApplyOnMatch,
  mapMatching,
  applyPred,

  -- * Reexports
  module Fcf,
) where

import Data.Bifunctor (first)
import Data.Kind
import qualified Data.List.NonEmpty as NE
import Data.Proxy
import Data.Typeable
import Fcf
import Unsafe.Coerce
import Prelude hiding (
  map,
  pure,
  zipWith,
  zipWith3,
 )
import qualified Prelude


-- ---------------------------------------------------------------------
-- We roll our own State/efficient-Writer monad, not to add dependencies
-- ---------------------------------------------------------------------

newtype St s a
  = St (s -> (a, s))


runSt :: s -> St s a -> (a, s)
runSt :: forall s a. s -> St s a -> (a, s)
runSt s
s (St s -> (a, s)
f) =
  s -> (a, s)
f s
s


instance Functor (St s) where
  fmap :: forall a b. (a -> b) -> St s a -> St s b
fmap a -> b
f (St s -> (a, s)
g) =
    (s -> (b, s)) -> St s b
forall s a. (s -> (a, s)) -> St s a
St ((s -> (b, s)) -> St s b) -> (s -> (b, s)) -> St s b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (a, s) -> (b, s)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f ((a, s) -> (b, s)) -> (s -> (a, s)) -> s -> (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (a, s)
g
  {-# INLINE fmap #-}


instance Applicative (St s) where
  pure :: forall a. a -> St s a
pure =
    (s -> (a, s)) -> St s a
forall s a. (s -> (a, s)) -> St s a
St ((s -> (a, s)) -> St s a) -> (a -> s -> (a, s)) -> a -> St s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,)
  {-# INLINE pure #-}


  St s -> (a -> b, s)
l <*> :: forall a b. St s (a -> b) -> St s a -> St s b
<*> St s -> (a, s)
r =
    (s -> (b, s)) -> St s b
forall s a. (s -> (a, s)) -> St s a
St ((s -> (b, s)) -> St s b) -> (s -> (b, s)) -> St s b
forall a b. (a -> b) -> a -> b
$ \s
s ->
      let (a -> b
f, s
s') = s -> (a -> b, s)
l s
s
          (a
x, s
s'') = s -> (a, s)
r s
s'
      in (a -> b
f a
x, s
s'')
  {-# INLINE (<*>) #-}


instance Monad (St s) where
  return :: forall a. a -> St s a
return = a -> St s a
forall a. a -> St s a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
  {-# INLINE return #-}


  St s -> (a, s)
action >>= :: forall a b. St s a -> (a -> St s b) -> St s b
>>= a -> St s b
f =
    (s -> (b, s)) -> St s b
forall s a. (s -> (a, s)) -> St s a
St ((s -> (b, s)) -> St s b) -> (s -> (b, s)) -> St s b
forall a b. (a -> b) -> a -> b
$ \s
s ->
      let
        (a
a, !s
s') = s -> (a, s)
action s
s
        St s -> (b, s)
go = a -> St s b
f a
a
      in
        s -> (b, s)
go s
s'
  {-# INLINE (>>=) #-}


type Wr = St


execWr :: Monoid w => Wr w a -> w
execWr :: forall w a. Monoid w => Wr w a -> w
execWr =
  (a, w) -> w
forall a b. (a, b) -> b
snd ((a, w) -> w) -> (Wr w a -> (a, w)) -> Wr w a -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Wr w a -> (a, w)
forall s a. s -> St s a -> (a, s)
runSt w
forall a. Monoid a => a
Prelude.mempty


tell :: Monoid w => w -> Wr w ()
tell :: forall w. Monoid w => w -> Wr w ()
tell w
w =
  (w -> ((), w)) -> St w ()
forall s a. (s -> (a, s)) -> St s a
St (\w
s -> ((), w
s w -> w -> w
forall a. Monoid a => a -> a -> a
`mappend` w
w))


{- | A first-class-families version of 'Data.Functor.Product.Product'.

When used with `Eval`, it resolves in a tuple of the applied type-level functions.
-}
data Tuple2 :: (Type -> Exp Type) -> (Type -> Exp Type) -> Type -> Exp Type


type instance Eval (Tuple2 f g x) = (f @@ x, g @@ x)


data LensRec rec a = LensRec
  { forall {k} (rec :: (k -> * -> *) -> *) (a :: k).
LensRec rec a -> forall (f :: k -> * -> *). rec f -> f @@ a
view :: forall f. rec f -> f @@ a
  , forall {k} (rec :: (k -> * -> *) -> *) (a :: k).
LensRec rec a
-> forall (f :: k -> * -> *). (f @@ a) -> rec f -> rec f
set :: forall f. f @@ a -> rec f -> rec f
  }


nestLens :: (forall h. a h -> (b h -> a h, b h)) -> LensRec b c -> LensRec a c
nestLens :: forall {k} (a :: (k -> * -> *) -> *) (b :: (k -> * -> *) -> *)
       (c :: k).
(forall (h :: k -> * -> *). a h -> (b h -> a h, b h))
-> LensRec b c -> LensRec a c
nestLens forall (h :: k -> * -> *). a h -> (b h -> a h, b h)
l (LensRec forall (f :: k -> * -> *). b f -> f @@ c
lv forall (f :: k -> * -> *). (f @@ c) -> b f -> b f
ls) =
  (forall (f :: k -> * -> *). a f -> f @@ c)
-> (forall (f :: k -> * -> *). (f @@ c) -> a f -> a f)
-> LensRec a c
forall {k} (rec :: (k -> * -> *) -> *) (a :: k).
(forall (f :: k -> * -> *). rec f -> f @@ a)
-> (forall (f :: k -> * -> *). (f @@ a) -> rec f -> rec f)
-> LensRec rec a
LensRec (b f -> Eval (f c)
forall (f :: k -> * -> *). b f -> f @@ c
lv (b f -> Eval (f c)) -> (a f -> b f) -> a f -> Eval (f c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b f -> a f, b f) -> b f
forall a b. (a, b) -> b
snd ((b f -> a f, b f) -> b f)
-> (a f -> (b f -> a f, b f)) -> a f -> b f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a f -> (b f -> a f, b f)
forall (h :: k -> * -> *). a h -> (b h -> a h, b h)
l) (\f @@ c
n a f
h -> let (b f -> a f
s, b f
x) = a f -> (b f -> a f, b f)
forall (h :: k -> * -> *). a h -> (b h -> a h, b h)
l a f
h in b f -> a f
s ((f @@ c) -> b f -> b f
forall (f :: k -> * -> *). (f @@ c) -> b f -> b f
ls f @@ c
n b f
x))
{-# INLINE nestLens #-}


-- | Obtain a van-laarhoven lens (compatible with the lens library) from 'LensRec'
getLens :: Functor f => LensRec rec a -> (h @@ a -> f (h @@ a)) -> rec h -> f (rec h)
getLens :: forall {k1} (f :: * -> *) (rec :: (k1 -> * -> *) -> *) (a :: k1)
       (h :: k1 -> * -> *).
Functor f =>
LensRec rec a -> ((h @@ a) -> f (h @@ a)) -> rec h -> f (rec h)
getLens (LensRec forall (f :: k1 -> * -> *). rec f -> f @@ a
v forall (f :: k1 -> * -> *). (f @@ a) -> rec f -> rec f
s) (h @@ a) -> f (h @@ a)
f rec h
b = (\h @@ a
x -> (h @@ a) -> rec h -> rec h
forall (f :: k1 -> * -> *). (f @@ a) -> rec f -> rec f
s h @@ a
x rec h
b) ((h @@ a) -> rec h) -> f (h @@ a) -> f (rec h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (h @@ a) -> f (h @@ a)
f (rec h -> h @@ a
forall (f :: k1 -> * -> *). rec f -> f @@ a
v rec h
b)
{-# INLINE getLens #-}


{- | A type witness for a field of type @a@.

For convenience, it also carries `Typeable` evidence and the name of the field.
-}
data Metadata a where
  Metadata
    :: Typeable a
    => { forall {k} (a :: k). Metadata a -> String
name :: String
       }
    -> Metadata a


{- | Functions that try to convert from f @@ a to some other type don't work without a little
help due to injectivity. This class provides that help by providing a function that provides
a witness of the type of a for each field of the record.
-}
class WitnessFieldTypes (rec :: (Type -> Exp Type) -> Type) where
  typeName :: Proxy rec -> String
  default typeName :: Typeable rec => Proxy rec -> String
  typeName Proxy rec
p = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [TyCon -> String
tyConModule TyCon
tc, String
".", TyCon -> String
tyConName TyCon
tc]
    where
      tc :: TyCon
tc = TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> TypeRep -> TyCon
forall a b. (a -> b) -> a -> b
$ Proxy rec -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy rec
p
  typeProxies :: rec (Pure1 Metadata)
  getAccessors :: rec (Pure1 (LensRec rec))
  nestedFieldNames :: rec (ConstFn (NE.NonEmpty String))


{- | Record-types that can be mapped over. Instances of 'FunctorRec' should
  satisfy the following laws:

@
'map' 'id' = 'id'
'map' f . 'map' g = 'map' (f . g)
@
-}
class FunctorRec (rec :: (Type -> Exp Type) -> Type) where
  map :: (forall a. Metadata a -> f @@ a -> g @@ a) -> rec f -> rec g


{- | Record-types that can be traversed from left to right. Instances should
  satisfy the following laws:

@
 t . 'traverse' f   = 'traverse' (t . f)  -- naturality
'traverse' 'Data.Functor.Identity' = 'Data.Functor.Identity'           -- identity
'traverse' ('fmap' g . f) = 'fmap' ('traverse' g) . 'traverse' f -- composition
@
-}
class FunctorRec rec => TraversableRec (rec :: (Type -> Exp Type) -> Type) where
  traverse :: Applicative e => (forall a. Metadata a -> f @@ a -> e (g @@ a)) -> rec f -> e (rec g)


  -- | Map each element to an action, evaluate these actions from left to right,
  --   and ignore the results.
  traverse_ :: Applicative e => (forall a. Metadata a -> f @@ a -> e c) -> rec f -> e ()


{- | A 'FunctorRec' with application, providing operations to:

    * embed an "empty" value ('pure')

    * align and combine values ('prod')

 It should satisfy the following laws:

 [Naturality of 'prod']

@
'map' (\(a, b) -> (f a, g b)) (u `'prod'` v) = 'map' f u `'prod'` 'map' g v
@


 [Left and right identity]

@
'map' (\(_, b) -> b) ('pure' e `'prod'` v) = v
'map' (\(a, _) -> a) (u `'prod'` 'pure' e) = u
@

[Associativity]

@
'map' (\(a, (b, c)) -> ((a, b), c) (u `'prod'` (v `'prod'` w)) = (u `'prod'` v) `'prod'` w
@

 It is to 'FunctorRec' in the same way as 'Applicative'
 relates to 'Functor'. For a presentation of 'Applicative' as
 a monoidal functor, see Section 7 of
 <http://www.soi.city.ac.uk/~ross/papers/Applicative.html Applicative Programming with Effects>.
-}
class FunctorRec rec => ApplicativeRec (rec :: (Type -> Exp Type) -> Type) where
  pure :: (forall a. Metadata a -> f @@ a) -> rec f
  prod :: rec f -> rec g -> rec (Tuple2 f g)


{- | 'traverse' with the arguments flipped. Useful when the traversing function is a large lambda:

@
for someRecord $ \fa -> ...
@

@since 0.0.1.0
-}
for
  :: (TraversableRec rec, Applicative e)
  => rec f
  -> (forall a. Metadata a -> f @@ a -> e (g @@ a))
  -> e (rec g)
for :: forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
(TraversableRec rec, Applicative e) =>
rec f
-> (forall a. Metadata a -> (f @@ a) -> e (g @@ a)) -> e (rec g)
for rec f
b forall a. Metadata a -> (f @@ a) -> e (g @@ a)
f = (forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
forall (e :: * -> *) (f :: * -> * -> *) (g :: * -> * -> *).
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
(TraversableRec rec, Applicative e) =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
Data.EvalRecord.traverse Metadata a -> (f @@ a) -> e (g @@ a)
forall a. Metadata a -> (f @@ a) -> e (g @@ a)
f rec f
b


for_
  :: (TraversableRec rec, Applicative e)
  => rec f
  -> (forall a. Metadata a -> f @@ a -> e c)
  -> e ()
for_ :: forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       c.
(TraversableRec rec, Applicative e) =>
rec f -> (forall a. Metadata a -> (f @@ a) -> e c) -> e ()
for_ rec f
b forall a. Metadata a -> (f @@ a) -> e c
f = (forall a. Metadata a -> (f @@ a) -> e c) -> rec f -> e ()
forall (e :: * -> *) (f :: * -> * -> *) c.
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e c) -> rec f -> e ()
forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       c.
(TraversableRec rec, Applicative e) =>
(forall a. Metadata a -> (f @@ a) -> e c) -> rec f -> e ()
Data.EvalRecord.traverse_ Metadata a -> (f @@ a) -> e c
forall a. Metadata a -> (f @@ a) -> e c
f rec f
b


{- | Evaluate each action in the structure from left to right,
  and collect the results.
-}
sequence :: (Applicative e, TraversableRec rec) => rec (Pure1 e <=< f) -> e (rec f)
sequence :: forall (e :: * -> *) (rec :: (* -> * -> *) -> *)
       (f :: * -> * -> *).
(Applicative e, TraversableRec rec) =>
rec (Pure1 e <=< f) -> e (rec f)
sequence = (forall a. Metadata a -> ((Pure1 e <=< f) @@ a) -> e (f @@ a))
-> rec (Pure1 e <=< f) -> e (rec f)
forall (e :: * -> *) (f :: * -> * -> *) (g :: * -> * -> *).
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
(TraversableRec rec, Applicative e) =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
Data.EvalRecord.traverse (\Metadata a
_ (Pure1 e <=< f) @@ a
x -> e (f @@ a)
(Pure1 e <=< f) @@ a
x)


-- | A version of 'sequence' with @f@ specialized to 'Pure'.
sequence' :: (Applicative e, TraversableRec rec) => rec (Pure1 e) -> e (rec Pure)
sequence' :: forall (e :: * -> *) (rec :: (* -> * -> *) -> *).
(Applicative e, TraversableRec rec) =>
rec (Pure1 e) -> e (rec Pure)
sequence' = (forall a. Metadata a -> (Pure1 e @@ a) -> e (Pure @@ a))
-> rec (Pure1 e) -> e (rec Pure)
forall (e :: * -> *) (f :: * -> * -> *) (g :: * -> * -> *).
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
(TraversableRec rec, Applicative e) =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
Data.EvalRecord.traverse (\Metadata a
_ Pure1 e @@ a
x -> e (Pure @@ a)
Pure1 e @@ a
x)


-- | Map each element to a monoid, and combine the results.
foldMap :: (TraversableRec rec, Monoid m) => (forall a. Metadata a -> f @@ a -> m) -> rec f -> m
foldMap :: forall (rec :: (* -> * -> *) -> *) m (f :: * -> * -> *).
(TraversableRec rec, Monoid m) =>
(forall a. Metadata a -> (f @@ a) -> m) -> rec f -> m
foldMap forall a. Metadata a -> (f @@ a) -> m
f = Wr m () -> m
forall w a. Monoid w => Wr w a -> w
execWr (Wr m () -> m) -> (rec f -> Wr m ()) -> rec f -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Metadata a -> (f @@ a) -> Wr m ()) -> rec f -> Wr m ()
forall (e :: * -> *) (f :: * -> * -> *) c.
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e c) -> rec f -> e ()
forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       c.
(TraversableRec rec, Applicative e) =>
(forall a. Metadata a -> (f @@ a) -> e c) -> rec f -> e ()
Data.EvalRecord.traverse_ (\Metadata a
p f @@ a
x -> m -> Wr m ()
forall w. Monoid w => w -> Wr w ()
tell (Metadata a -> (f @@ a) -> m
forall a. Metadata a -> (f @@ a) -> m
f Metadata a
p f @@ a
x))


-- | An alias of 'prod', since this is like a 'zip'.
zip :: ApplicativeRec rec => rec f -> rec g -> rec (Tuple2 f g)
zip :: forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
zip = rec f -> rec g -> rec (Tuple2 f g)
forall (f :: * -> * -> *) (g :: * -> * -> *).
rec f -> rec g -> rec (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
prod


-- | An equivalent of 'unzip'.
unzip :: ApplicativeRec rec => rec (Tuple2 f g) -> (rec f, rec g)
unzip :: forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec (Tuple2 f g) -> (rec f, rec g)
unzip rec (Tuple2 f g)
f = ((forall a. Metadata a -> (Tuple2 f g @@ a) -> f @@ a)
-> rec (Tuple2 f g) -> rec f
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
Data.EvalRecord.map (\Metadata a
_ (f @@ a
l, Eval (g a)
_) -> f @@ a
l) rec (Tuple2 f g)
f, (forall a. Metadata a -> (Tuple2 f g @@ a) -> g @@ a)
-> rec (Tuple2 f g) -> rec g
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
Data.EvalRecord.map (\Metadata a
_ (Eval (f a)
_, g @@ a
r) -> g @@ a
r) rec (Tuple2 f g)
f)


-- | An equivalent of 'Data.List.zipWith'.
zipWith
  :: ApplicativeRec rec
  => (forall a. Metadata a -> f @@ a -> g @@ a -> h @@ a)
  -> rec f
  -> rec g
  -> rec h
zipWith :: forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *) (h :: * -> * -> *).
ApplicativeRec rec =>
(forall a. Metadata a -> (f @@ a) -> (g @@ a) -> h @@ a)
-> rec f -> rec g -> rec h
zipWith forall a. Metadata a -> (f @@ a) -> (g @@ a) -> h @@ a
f rec f
bf rec g
bg =
  (forall a. Metadata a -> (Tuple2 f g @@ a) -> h @@ a)
-> rec (Tuple2 f g) -> rec h
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
Data.EvalRecord.map
    (\Metadata a
p (Eval (f a)
fa, Eval (g a)
ga) -> Metadata a -> Eval (f a) -> Eval (g a) -> h @@ a
forall a. Metadata a -> (f @@ a) -> (g @@ a) -> h @@ a
f Metadata a
p Eval (f a)
fa Eval (g a)
ga)
    (rec f
bf rec f -> rec g -> rec (Tuple2 f g)
forall (f :: * -> * -> *) (g :: * -> * -> *).
rec f -> rec g -> rec (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` rec g
bg)


-- | An equivalent of 'Data.List.zipWith3'.
zipWith3
  :: ApplicativeRec rec
  => (forall a. Metadata a -> f @@ a -> g @@ a -> h @@ a -> i @@ a)
  -> rec f
  -> rec g
  -> rec h
  -> rec i
zipWith3 :: forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *) (h :: * -> * -> *) (i :: * -> * -> *).
ApplicativeRec rec =>
(forall a.
 Metadata a -> (f @@ a) -> (g @@ a) -> (h @@ a) -> i @@ a)
-> rec f -> rec g -> rec h -> rec i
zipWith3 forall a. Metadata a -> (f @@ a) -> (g @@ a) -> (h @@ a) -> i @@ a
f rec f
bf rec g
bg rec h
bh =
  (forall a. Metadata a -> (Tuple2 (Tuple2 f g) h @@ a) -> i @@ a)
-> rec (Tuple2 (Tuple2 f g) h) -> rec i
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
Data.EvalRecord.map
    (\Metadata a
p ((Eval (f a)
fa, Eval (g a)
ga), Eval (h a)
ha) -> Metadata a -> Eval (f a) -> Eval (g a) -> Eval (h a) -> i @@ a
forall a. Metadata a -> (f @@ a) -> (g @@ a) -> (h @@ a) -> i @@ a
f Metadata a
p Eval (f a)
fa Eval (g a)
ga Eval (h a)
ha)
    (rec f
bf rec f -> rec g -> rec (Tuple2 f g)
forall (f :: * -> * -> *) (g :: * -> * -> *).
rec f -> rec g -> rec (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` rec g
bg rec (Tuple2 f g) -> rec h -> rec (Tuple2 (Tuple2 f g) h)
forall (f :: * -> * -> *) (g :: * -> * -> *).
rec f -> rec g -> rec (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` rec h
bh)


-- | An equivalent of 'Data.List.zipWith4'.
zipWith4
  :: ApplicativeRec rec
  => (forall a. Metadata a -> f @@ a -> g @@ a -> h @@ a -> i @@ a -> j @@ a)
  -> rec f
  -> rec g
  -> rec h
  -> rec i
  -> rec j
zipWith4 :: forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *) (h :: * -> * -> *) (i :: * -> * -> *)
       (j :: * -> * -> *).
ApplicativeRec rec =>
(forall a.
 Metadata a
 -> (f @@ a) -> (g @@ a) -> (h @@ a) -> (i @@ a) -> j @@ a)
-> rec f -> rec g -> rec h -> rec i -> rec j
zipWith4 forall a.
Metadata a
-> (f @@ a) -> (g @@ a) -> (h @@ a) -> (i @@ a) -> j @@ a
f rec f
bf rec g
bg rec h
bh rec i
bi =
  (forall a.
 Metadata a -> (Tuple2 (Tuple2 (Tuple2 f g) h) i @@ a) -> j @@ a)
-> rec (Tuple2 (Tuple2 (Tuple2 f g) h) i) -> rec j
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
Data.EvalRecord.map
    (\Metadata a
p (((Eval (f a)
fa, Eval (g a)
ga), Eval (h a)
ha), Eval (i a)
ia) -> Metadata a
-> Eval (f a) -> Eval (g a) -> Eval (h a) -> Eval (i a) -> j @@ a
forall a.
Metadata a
-> (f @@ a) -> (g @@ a) -> (h @@ a) -> (i @@ a) -> j @@ a
f Metadata a
p Eval (f a)
fa Eval (g a)
ga Eval (h a)
ha Eval (i a)
ia)
    (rec f
bf rec f -> rec g -> rec (Tuple2 f g)
forall (f :: * -> * -> *) (g :: * -> * -> *).
rec f -> rec g -> rec (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` rec g
bg rec (Tuple2 f g) -> rec h -> rec (Tuple2 (Tuple2 f g) h)
forall (f :: * -> * -> *) (g :: * -> * -> *).
rec f -> rec g -> rec (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` rec h
bh rec (Tuple2 (Tuple2 f g) h)
-> rec i -> rec (Tuple2 (Tuple2 (Tuple2 f g) h) i)
forall (f :: * -> * -> *) (g :: * -> * -> *).
rec f -> rec g -> rec (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` rec i
bi)


{- | @'Dict' c a@ is evidence that there exists an instance of @c a@.

  It is essentially equivalent to @Dict (c a)@ from the
  <http://hackage.haskell.org/package/constraints constraints> package,
  but because of its kind, it allows us to define things like @'Dict' 'Show'@.
-}
data Dict c a where
  Dict :: c a => Dict c a


instance Eq (Dict c a) where
  Dict c a
_ == :: Dict c a -> Dict c a -> Bool
== Dict c a
_ = Bool
True


instance Show (Dict c a) where
  showsPrec :: Int -> Dict c a -> String -> String
showsPrec Int
_ Dict c a
Dict = String -> String -> String
showString String
"Dict"


-- instance Show1 (Dict c)  where
--   liftShowsPrec _ _ = showsPrec

{- | Turn a constrained-function into an unconstrained one
  that uses the packed instance dictionary instead.
-}
requiringDict :: (c a => r) -> (Dict c a -> r)
requiringDict :: forall {k} (c :: k -> Constraint) (a :: k) r.
(c a => r) -> Dict c a -> r
requiringDict c a => r
r Dict c a
Dict = r
c a => r
r


{- | Instances of this class provide means to talk about constraints,
  both at compile-time, using 'AllRec', and at run-time, in the form
  of 'Dict', via 'addDicts'.

  A manual definition would look like this:

@
data T f = A (f 'Int') (f 'String') | B (f 'Bool') (f 'Int')

instance 'ConstraintsB' T where
  type 'AllRec' c T = (c 'Int', c 'String', c 'Bool')

  'addDicts' t = case t of
    A x y -> A ('Dict', x) ('Dict', y)
    B z w -> B ('Dict', z) ('Dict', w)
@

Now, when we given a @T f@, if we need to use the 'Show' instance of
their fields, we can use:

@
addDicts' :: AllRec Show b => b f -> b ('Dict' 'Show' `'Tuple2'` f)
@
-}
class FunctorRec rec => ConstraintsRec (rec :: (Type -> Exp Type) -> Type) where
  type AllRec (c :: k -> Constraint) rec :: Constraint


  addDicts
    :: forall c f
     . AllRec c rec
    => rec f
    -> rec (Pure1 (Dict c) `Tuple2` f)


class (c a, d a) => (c & d) a


instance (c a, d a) => (c & d) a


{- | Like 'map' but a constraint is allowed to be required on
  each element of @rec@

E.g. If all fields of @rec@ are 'Show'able then you
could store each shown value in it's slot using 'ConstFn String':

> showFields :: (AllRec Show rec, ConstraintsRec rec) => b Pure -> b (ConstFn String)
> showFields = mapC @Show showField
>   where
>     showField :: forall a. Show a => Metadata a -> a -> String
>     showField _ = show

Notice that one can use the '(&)' class as a way to require several
constraints to hold simultaneously:

> map @(Show & Eq & Enum) r
-}
mapC
  :: forall c b f g
   . (AllRec c b, ConstraintsRec b)
  => (forall a. c a => Metadata a -> f @@ a -> g @@ a)
  -> b f
  -> b g
mapC :: forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *).
(AllRec c b, ConstraintsRec b) =>
(forall a. c a => Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
mapC forall a. c a => Metadata a -> (f @@ a) -> g @@ a
f b f
bf = (forall a.
 Metadata a -> (Tuple2 (Pure1 (Dict c)) f @@ a) -> g @@ a)
-> b (Tuple2 (Pure1 (Dict c)) f) -> b g
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
Data.EvalRecord.map Metadata a -> (Tuple2 (Pure1 (Dict c)) f @@ a) -> g @@ a
forall a. Metadata a -> (Tuple2 (Pure1 (Dict c)) f @@ a) -> g @@ a
go (b f -> b (Tuple2 (Pure1 (Dict c)) f)
forall (c :: * -> Constraint) (f :: * -> * -> *).
AllRec c b =>
b f -> b (Tuple2 (Pure1 (Dict c)) f)
forall (rec :: (* -> * -> *) -> *) (c :: * -> Constraint)
       (f :: * -> * -> *).
(ConstraintsRec rec, AllRec c rec) =>
rec f -> rec (Tuple2 (Pure1 (Dict c)) f)
addDicts b f
bf)
  where
    go :: forall a. Metadata a -> (Pure1 (Dict c) `Tuple2` f) @@ a -> g @@ a
    go :: forall a. Metadata a -> (Tuple2 (Pure1 (Dict c)) f @@ a) -> g @@ a
go Metadata a
p (Dict c a
d, Eval (f a)
fa) = (c a => Eval (g a)) -> Dict c a -> Eval (g a)
forall {k} (c :: k -> Constraint) (a :: k) r.
(c a => r) -> Dict c a -> r
requiringDict (Metadata a -> Eval (f a) -> Eval (g a)
forall a. c a => Metadata a -> (f @@ a) -> g @@ a
f Metadata a
p Eval (f a)
fa) Dict c a
d


-- | Like 'traverse' but with a constraint on the elements of @b@.
traverseC
  :: forall c b f g e
   . (TraversableRec b, ConstraintsRec b, AllRec c b, Applicative e)
  => (forall a. c a => Metadata a -> f @@ a -> e (g @@ a))
  -> b f
  -> e (b g)
traverseC :: forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *) (e :: * -> *).
(TraversableRec b, ConstraintsRec b, AllRec c b, Applicative e) =>
(forall a. c a => Metadata a -> (f @@ a) -> e (g @@ a))
-> b f -> e (b g)
traverseC forall a. c a => Metadata a -> (f @@ a) -> e (g @@ a)
f b f
bf =
  (forall a.
 Metadata a -> (Tuple2 (Pure1 (Dict c)) f @@ a) -> e (g @@ a))
-> b (Tuple2 (Pure1 (Dict c)) f) -> e (b g)
forall (e :: * -> *) (f :: * -> * -> *) (g :: * -> * -> *).
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a)) -> b f -> e (b g)
forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
(TraversableRec rec, Applicative e) =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
Data.EvalRecord.traverse (\Metadata a
p (Dict c a
Dict :: Dict c a, Eval (f a)
x) -> Metadata a -> Eval (f a) -> e (g @@ a)
forall a. c a => Metadata a -> (f @@ a) -> e (g @@ a)
f Metadata a
p Eval (f a)
x) (b f -> b (Tuple2 (Pure1 (Dict c)) f)
forall (c :: * -> Constraint) (f :: * -> * -> *).
AllRec c b =>
b f -> b (Tuple2 (Pure1 (Dict c)) f)
forall (rec :: (* -> * -> *) -> *) (c :: * -> Constraint)
       (f :: * -> * -> *).
(ConstraintsRec rec, AllRec c rec) =>
rec f -> rec (Tuple2 (Pure1 (Dict c)) f)
addDicts b f
bf)


{- | 'traverseC' with the arguments flipped. Useful when the traversing function is a large lambda:

@
forC someRec $ \fa -> ...
@

@since 0.0.1.0
-}
forC
  :: forall c b f g e
   . (TraversableRec b, ConstraintsRec b, AllRec c b, Applicative e)
  => b f
  -> (forall a. c a => Metadata a -> f @@ a -> e (g @@ a))
  -> e (b g)
forC :: forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *) (e :: * -> *).
(TraversableRec b, ConstraintsRec b, AllRec c b, Applicative e) =>
b f
-> (forall a. c a => Metadata a -> (f @@ a) -> e (g @@ a))
-> e (b g)
forC b f
b forall a. c a => Metadata a -> (f @@ a) -> e (g @@ a)
f = forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *) (e :: * -> *).
(TraversableRec b, ConstraintsRec b, AllRec c b, Applicative e) =>
(forall a. c a => Metadata a -> (f @@ a) -> e (g @@ a))
-> b f -> e (b g)
traverseC @c Metadata a -> (f @@ a) -> e (g @@ a)
forall a. c a => Metadata a -> (f @@ a) -> e (g @@ a)
f b f
b


foldMapC
  :: forall c b m f
   . (TraversableRec b, ConstraintsRec b, AllRec c b, Monoid m)
  => (forall a. c a => Metadata a -> f @@ a -> m)
  -> b f
  -> m
foldMapC :: forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *) m
       (f :: * -> * -> *).
(TraversableRec b, ConstraintsRec b, AllRec c b, Monoid m) =>
(forall a. c a => Metadata a -> (f @@ a) -> m) -> b f -> m
foldMapC forall a. c a => Metadata a -> (f @@ a) -> m
f = Wr m (b (ConstFn ())) -> m
forall w a. Monoid w => Wr w a -> w
execWr (Wr m (b (ConstFn ())) -> m)
-> (b f -> Wr m (b (ConstFn ()))) -> b f -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *) (e :: * -> *).
(TraversableRec b, ConstraintsRec b, AllRec c b, Applicative e) =>
(forall a. c a => Metadata a -> (f @@ a) -> e (g @@ a))
-> b f -> e (b g)
traverseC @c @b @f @(ConstFn ()) @(St m) (\Metadata a
p f @@ a
x -> m -> Wr m ()
forall w. Monoid w => w -> Wr w ()
tell (m -> Wr m ()) -> m -> Wr m ()
forall a b. (a -> b) -> a -> b
$ Metadata a -> (f @@ a) -> m
forall a. c a => Metadata a -> (f @@ a) -> m
f Metadata a
p f @@ a
x)


-- | Like 'zipWith' but with a constraint on the elements of @b@.
zipWithC
  :: forall c b f g h
   . (AllRec c b, ConstraintsRec b, ApplicativeRec b)
  => (forall a. c a => Metadata a -> f @@ a -> g @@ a -> h @@ a)
  -> b f
  -> b g
  -> b h
zipWithC :: forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *) (h :: * -> * -> *).
(AllRec c b, ConstraintsRec b, ApplicativeRec b) =>
(forall a. c a => Metadata a -> (f @@ a) -> (g @@ a) -> h @@ a)
-> b f -> b g -> b h
zipWithC forall a. c a => Metadata a -> (f @@ a) -> (g @@ a) -> h @@ a
f b f
bf b g
bg =
  forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *).
(AllRec c b, ConstraintsRec b) =>
(forall a. c a => Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
mapC @c Metadata a -> (Tuple2 f g @@ a) -> h @@ a
forall a. c a => Metadata a -> (Tuple2 f g @@ a) -> h @@ a
go (b f
bf b f -> b g -> b (Tuple2 f g)
forall (f :: * -> * -> *) (g :: * -> * -> *).
b f -> b g -> b (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` b g
bg)
  where
    go :: forall a. c a => Metadata a -> Tuple2 f g @@ a -> h @@ a
    go :: forall a. c a => Metadata a -> (Tuple2 f g @@ a) -> h @@ a
go Metadata a
p (Eval (f a)
fa, Eval (g a)
ga) = Metadata a -> Eval (f a) -> Eval (g a) -> h @@ a
forall a. c a => Metadata a -> (f @@ a) -> (g @@ a) -> h @@ a
f Metadata a
p Eval (f a)
fa Eval (g a)
ga


-- | Like 'zipWith3' but with a constraint on the elements of @b@.
zipWith3C
  :: forall c b f g h i
   . (AllRec c b, ConstraintsRec b, ApplicativeRec b)
  => (forall a. c a => Metadata a -> f @@ a -> g @@ a -> h @@ a -> i @@ a)
  -> b f
  -> b g
  -> b h
  -> b i
zipWith3C :: forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *) (h :: * -> * -> *)
       (i :: * -> * -> *).
(AllRec c b, ConstraintsRec b, ApplicativeRec b) =>
(forall a.
 c a =>
 Metadata a -> (f @@ a) -> (g @@ a) -> (h @@ a) -> i @@ a)
-> b f -> b g -> b h -> b i
zipWith3C forall a.
c a =>
Metadata a -> (f @@ a) -> (g @@ a) -> (h @@ a) -> i @@ a
f b f
bf b g
bg b h
bh =
  forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *).
(AllRec c b, ConstraintsRec b) =>
(forall a. c a => Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
mapC @c Metadata a -> (Tuple2 (Tuple2 f g) h @@ a) -> i @@ a
forall a.
c a =>
Metadata a -> (Tuple2 (Tuple2 f g) h @@ a) -> i @@ a
go (b f
bf b f -> b g -> b (Tuple2 f g)
forall (f :: * -> * -> *) (g :: * -> * -> *).
b f -> b g -> b (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` b g
bg b (Tuple2 f g) -> b h -> b (Tuple2 (Tuple2 f g) h)
forall (f :: * -> * -> *) (g :: * -> * -> *).
b f -> b g -> b (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` b h
bh)
  where
    go :: forall a. c a => Metadata a -> (Tuple2 f g `Tuple2` h) @@ a -> i @@ a
    go :: forall a.
c a =>
Metadata a -> (Tuple2 (Tuple2 f g) h @@ a) -> i @@ a
go Metadata a
p ((Eval (f a)
fa, Eval (g a)
ga), Eval (h a)
ha) = Metadata a -> Eval (f a) -> Eval (g a) -> Eval (h a) -> i @@ a
forall a.
c a =>
Metadata a -> (f @@ a) -> (g @@ a) -> (h @@ a) -> i @@ a
f Metadata a
p Eval (f a)
fa Eval (g a)
ga Eval (h a)
ha


-- | Like 'zipWith4' but with a constraint on the elements of @b@.
zipWith4C
  :: forall c b f g h i j
   . (AllRec c b, ConstraintsRec b, ApplicativeRec b)
  => (forall a. c a => Metadata a -> f @@ a -> g @@ a -> h @@ a -> i @@ a -> j @@ a)
  -> b f
  -> b g
  -> b h
  -> b i
  -> b j
zipWith4C :: forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *) (h :: * -> * -> *)
       (i :: * -> * -> *) (j :: * -> * -> *).
(AllRec c b, ConstraintsRec b, ApplicativeRec b) =>
(forall a.
 c a =>
 Metadata a
 -> (f @@ a) -> (g @@ a) -> (h @@ a) -> (i @@ a) -> j @@ a)
-> b f -> b g -> b h -> b i -> b j
zipWith4C forall a.
c a =>
Metadata a
-> (f @@ a) -> (g @@ a) -> (h @@ a) -> (i @@ a) -> j @@ a
f b f
bf b g
bg b h
bh b i
bi =
  forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *).
(AllRec c b, ConstraintsRec b) =>
(forall a. c a => Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
mapC @c Metadata a -> (Tuple2 (Tuple2 (Tuple2 f g) h) i @@ a) -> j @@ a
forall a.
c a =>
Metadata a -> (Tuple2 (Tuple2 (Tuple2 f g) h) i @@ a) -> j @@ a
go (b f
bf b f -> b g -> b (Tuple2 f g)
forall (f :: * -> * -> *) (g :: * -> * -> *).
b f -> b g -> b (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` b g
bg b (Tuple2 f g) -> b h -> b (Tuple2 (Tuple2 f g) h)
forall (f :: * -> * -> *) (g :: * -> * -> *).
b f -> b g -> b (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` b h
bh b (Tuple2 (Tuple2 f g) h)
-> b i -> b (Tuple2 (Tuple2 (Tuple2 f g) h) i)
forall (f :: * -> * -> *) (g :: * -> * -> *).
b f -> b g -> b (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec rec =>
rec f -> rec g -> rec (Tuple2 f g)
`prod` b i
bi)
  where
    go :: forall a. c a => Metadata a -> (Tuple2 f g `Tuple2` h `Tuple2` i) @@ a -> j @@ a
    go :: forall a.
c a =>
Metadata a -> (Tuple2 (Tuple2 (Tuple2 f g) h) i @@ a) -> j @@ a
go Metadata a
p (((Eval (f a)
fa, Eval (g a)
ga), Eval (h a)
ha), Eval (i a)
ia) = Metadata a
-> Eval (f a) -> Eval (g a) -> Eval (h a) -> Eval (i a) -> j @@ a
forall a.
c a =>
Metadata a
-> (f @@ a) -> (g @@ a) -> (h @@ a) -> (i @@ a) -> j @@ a
f Metadata a
p Eval (f a)
fa Eval (g a)
ga Eval (h a)
ha Eval (i a)
ia


{- | 'ClassF' has one universal instance that makes @'ClassF' c f a@
  equivalent to @c (f a)@. However, we have

@
'ClassF c f :: k -> 'Data.Kind.Constraint'
@

This is useful since it allows to define constraint-constructors like
@'ClassF' 'Monoid' 'Pure1 Maybe'@
-}
class c (f @@ a) => ClassF c f a


instance c (f @@ a) => ClassF c f a


-- | Like 'ClassF' but for binary relations.
class c (f @@ a) (g @@ a) => ClassFG c f g a


instance c (f @@ a) (g @@ a) => ClassFG c f g a


{- | Similar to 'AllRec' but will put the functor argument @f@
  between the constraint @c@ and the type @a@. For example:

  @
  'AllRec'  'Show'   Person ~ ('Show'    'String',  'Show'    'Int')
  'AllRecF' 'Show' f Person ~ ('Show' (f @@ 'String'), 'Show' (f @@ 'Int'))
  @
-}
type AllRecF c f b = AllRec (ClassF c f) b


{- | Similar to 'addDicts' but can produce the instance dictionaries
  "out of the blue".
-}
dicts
  :: forall c b
   . (AllRec c b, ApplicativeRec b, ConstraintsRec b)
  => b (Pure1 (Dict c))
dicts :: forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *).
(AllRec c b, ApplicativeRec b, ConstraintsRec b) =>
b (Pure1 (Dict c))
dicts = b (Pure1 (Dict c))
dicts'
  where
    dicts' :: b (Pure1 (Dict c))
    dicts' :: b (Pure1 (Dict c))
dicts' = (forall a.
 Metadata a
 -> (Tuple2 (Pure1 (Dict c)) (Pure1 Proxy) @@ a)
 -> Pure1 (Dict c) @@ a)
-> b (Tuple2 (Pure1 (Dict c)) (Pure1 Proxy)) -> b (Pure1 (Dict c))
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
Data.EvalRecord.map (\Metadata a
_ (Dict c a
c, Proxy a
_) -> Pure1 (Dict c) @@ a
Dict c a
c) b (Tuple2 (Pure1 (Dict c)) (Pure1 Proxy))
addedDicts
    addedDicts :: b (Tuple2 (Pure1 (Dict c)) (Pure1 Proxy))
    addedDicts :: b (Tuple2 (Pure1 (Dict c)) (Pure1 Proxy))
addedDicts =
      forall (rec :: (* -> * -> *) -> *) (c :: * -> Constraint)
       (f :: * -> * -> *).
(ConstraintsRec rec, AllRec c rec) =>
rec f -> rec (Tuple2 (Pure1 (Dict c)) f)
addDicts @b @c @(Pure1 Proxy) (b (Pure1 Proxy) -> b (Tuple2 (Pure1 (Dict c)) (Pure1 Proxy)))
-> b (Pure1 Proxy) -> b (Tuple2 (Pure1 (Dict c)) (Pure1 Proxy))
forall a b. (a -> b) -> a -> b
$
        b (Pure1 Proxy)
proxyRec
    proxyRec :: b (Pure1 Proxy)
proxyRec = forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *).
ApplicativeRec rec =>
(forall a. Metadata a -> f @@ a) -> rec f
Data.EvalRecord.pure @b @(Pure1 Proxy) (Proxy a -> Metadata a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy)


{- | Like 'pure' but a constraint is allowed to be required on
  each element of @b@.
-}
pureC
  :: forall c f b
   . ( AllRecF c f b
     , ConstraintsRec b
     , ApplicativeRec b
     )
  => (forall a. c (f @@ a) => Metadata a -> f @@ a)
  -> b f
pureC :: forall (c :: * -> Constraint) (f :: * -> * -> *)
       (b :: (* -> * -> *) -> *).
(AllRecF c f b, ConstraintsRec b, ApplicativeRec b) =>
(forall a. c (f @@ a) => Metadata a -> f @@ a) -> b f
pureC forall a. c (f @@ a) => Metadata a -> f @@ a
fa =
  (forall a.
 Metadata a -> (Pure1 (Dict (ClassF c f)) @@ a) -> f @@ a)
-> b (Pure1 (Dict (ClassF c f))) -> b f
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
Data.EvalRecord.map (\Metadata a
p -> forall {k} (c :: k -> Constraint) (a :: k) r.
(c a => r) -> Dict c a -> r
forall (c :: * -> Constraint) a r. (c a => r) -> Dict c a -> r
requiringDict @(ClassF c f) (Metadata a -> f @@ a
forall a. c (f @@ a) => Metadata a -> f @@ a
fa Metadata a
p)) (forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *).
(AllRec c b, ApplicativeRec b, ConstraintsRec b) =>
b (Pure1 (Dict c))
dicts @(ClassF c f) @b)


-- | Builds a @b f@, by applying 'mempty' on every field of @b@.
mempty
  :: forall f b
   . ( AllRecF Monoid f b
     , ConstraintsRec b
     , ApplicativeRec b
     )
  => b f
mempty :: forall (f :: * -> * -> *) (b :: (* -> * -> *) -> *).
(AllRecF Monoid f b, ConstraintsRec b, ApplicativeRec b) =>
b f
mempty =
  forall (c :: * -> Constraint) (f :: * -> * -> *)
       (b :: (* -> * -> *) -> *).
(AllRecF c f b, ConstraintsRec b, ApplicativeRec b) =>
(forall a. c (f @@ a) => Metadata a -> f @@ a) -> b f
Data.EvalRecord.pureC @Monoid ((forall a. Monoid (f @@ a) => Metadata a -> f @@ a) -> b f)
-> (forall a. Monoid (f @@ a) => Metadata a -> f @@ a) -> b f
forall a b. (a -> b) -> a -> b
$ \Metadata a
_ -> f @@ a
forall a. Monoid a => a
Prelude.mempty


{- | A 'FunctorRec' where the effects can be distributed to the fields:
 `distribute` turns an effectful way of building a Record-type
 into a pure Record-type with effectful ways of computing the
 values of its fields.

 This class is the categorical dual of `TraversableRec`,
 with `distribute` the dual of `sequence`
 and `cotraverse` the dual of `traverse`. As such,
 instances need to satisfy these laws:

@
'distribute' . h = 'map' h) . 'distribute'    -- naturality
'distribute' . 'Data.Functor.Identity' = 'map' 'Data.Functor.Identity'                 -- identity
@

By specializing @f@ to @((->) a)@ and @g@ to 'Identity', we can define a function that
decomposes a function on distributive records into a collection of simpler functions:

@
'decompose' :: 'DistributiveRec' b => (a -> b 'Identity') -> b ((->) a)
'decompose' = 'map' ('fmap' 'runIdentity' . 'getCompose') . 'distribute'
@

Lawful instances of the class can then be characterized as those that satisfy:

@
'recompose' . 'decompose' = 'id'
'decompose' . 'recompose' = 'id'
@

This means intuitively that instances need to have a fixed shape (i.e. no sum-types can be involved).
Typically, this means record types, as long as they don't contain fields where the functor argument is not applied.
-}
class FunctorRec rec => DistributiveRec (rec :: (Type -> Exp Type) -> Type) where
  distribute :: Functor f => f (rec g) -> rec (Pure1 f <=< g)


dropPureBind :: rec (f <=< Pure) -> rec f
dropPureBind :: forall {b} {c} (rec :: (b -> c -> *) -> *) (f :: b -> c -> *).
rec (f <=< Pure) -> rec f
dropPureBind = rec (f <=< Pure) -> rec f
forall a b. a -> b
unsafeCoerce


-- | A version of `distribute` with @g@ specialized to `Pure`.
distribute' :: (DistributiveRec rec, Functor f) => f (rec Pure) -> rec (Pure1 f)
distribute' :: forall (rec :: (* -> * -> *) -> *) (f :: * -> *).
(DistributiveRec rec, Functor f) =>
f (rec Pure) -> rec (Pure1 f)
distribute' f (rec Pure)
f = rec (Pure1 f <=< Pure) -> rec (Pure1 f)
forall {b} {c} (rec :: (b -> c -> *) -> *) (f :: b -> c -> *).
rec (f <=< Pure) -> rec f
dropPureBind (f (rec Pure) -> rec (Pure1 f <=< Pure)
forall (f :: * -> *) (g :: * -> * -> *).
Functor f =>
f (rec g) -> rec (Pure1 f <=< g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> *)
       (g :: * -> * -> *).
(DistributiveRec rec, Functor f) =>
f (rec g) -> rec (Pure1 f <=< g)
distribute f (rec Pure)
f)
{-# INLINE distribute' #-}


-- Dual of 'traverse'
cotraverse :: (DistributiveRec rec, Functor f) => (forall a. f (g @@ a) -> f a) -> f (rec g) -> rec (Pure1 f)
cotraverse :: forall (rec :: (* -> * -> *) -> *) (f :: * -> *)
       (g :: * -> * -> *).
(DistributiveRec rec, Functor f) =>
(forall a. f (g @@ a) -> f a) -> f (rec g) -> rec (Pure1 f)
cotraverse forall a. f (g @@ a) -> f a
h = (forall a. Metadata a -> ((Pure1 f <=< g) @@ a) -> Pure1 f @@ a)
-> rec (Pure1 f <=< g) -> rec (Pure1 f)
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
map (\Metadata a
_ -> f (g @@ a) -> f a
((Pure1 f <=< g) @@ a) -> Pure1 f @@ a
forall a. f (g @@ a) -> f a
h) (rec (Pure1 f <=< g) -> rec (Pure1 f))
-> (f (rec g) -> rec (Pure1 f <=< g)) -> f (rec g) -> rec (Pure1 f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (rec g) -> rec (Pure1 f <=< g)
forall (f :: * -> *) (g :: * -> * -> *).
Functor f =>
f (rec g) -> rec (Pure1 f <=< g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> *)
       (g :: * -> * -> *).
(DistributiveRec rec, Functor f) =>
f (rec g) -> rec (Pure1 f <=< g)
distribute
{-# INLINE cotraverse #-}


{- | Decompose a function returning a distributive record into
  a collection of simpler functions.
-}
decompose :: (DistributiveRec rec) => (a -> rec Pure) -> rec (Pure1 ((->) a))
decompose :: forall (rec :: (* -> * -> *) -> *) a.
DistributiveRec rec =>
(a -> rec Pure) -> rec (Pure1 ((->) a))
decompose a -> rec Pure
f = rec (Pure1 ((->) a) <=< Pure) -> rec (Pure1 ((->) a))
forall {b} {c} (rec :: (b -> c -> *) -> *) (f :: b -> c -> *).
rec (f <=< Pure) -> rec f
dropPureBind ((a -> rec Pure) -> rec (Pure1 ((->) a) <=< Pure)
forall (f :: * -> *) (g :: * -> * -> *).
Functor f =>
f (rec g) -> rec (Pure1 f <=< g)
forall (rec :: (* -> * -> *) -> *) (f :: * -> *)
       (g :: * -> * -> *).
(DistributiveRec rec, Functor f) =>
f (rec g) -> rec (Pure1 f <=< g)
distribute a -> rec Pure
f)
{-# INLINE decompose #-}


-- | Recompose a decomposed function.
recompose :: FunctorRec rec => rec (Pure1 ((->) a)) -> a -> rec Pure
recompose :: forall (rec :: (* -> * -> *) -> *) a.
FunctorRec rec =>
rec (Pure1 ((->) a)) -> a -> rec Pure
recompose rec (Pure1 ((->) a))
bfs a
a = (forall a. Metadata a -> (Pure1 ((->) a) @@ a) -> Pure @@ a)
-> rec (Pure1 ((->) a)) -> rec Pure
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
map (\Metadata a
_ Pure1 ((->) a) @@ a
f -> Pure1 ((->) a) @@ a
a -> a
f a
a) rec (Pure1 ((->) a))
bfs
{-# INLINE recompose #-}


-- | A wrapper for Eval Record-types, providing useful instances.
newtype EvalRecord b (f :: Type -> Exp Type) = EvalRecord {forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
EvalRecord b f -> b f
evalRecord :: b f}
  deriving newtype ((forall (f :: * -> * -> *) (g :: * -> * -> *).
 (forall a. Metadata a -> (f @@ a) -> g @@ a)
 -> EvalRecord b f -> EvalRecord b g)
-> FunctorRec (EvalRecord b)
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a)
-> EvalRecord b f -> EvalRecord b g
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec b =>
(forall a. Metadata a -> (f @@ a) -> g @@ a)
-> EvalRecord b f -> EvalRecord b g
forall (rec :: (* -> * -> *) -> *).
(forall (f :: * -> * -> *) (g :: * -> * -> *).
 (forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g)
-> FunctorRec rec
$cmap :: forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec b =>
(forall a. Metadata a -> (f @@ a) -> g @@ a)
-> EvalRecord b f -> EvalRecord b g
map :: forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a)
-> EvalRecord b f -> EvalRecord b g
FunctorRec, FunctorRec (EvalRecord b)
FunctorRec (EvalRecord b) =>
(forall (f :: * -> * -> *).
 (forall a. Metadata a -> f @@ a) -> EvalRecord b f)
-> (forall (f :: * -> * -> *) (g :: * -> * -> *).
    EvalRecord b f -> EvalRecord b g -> EvalRecord b (Tuple2 f g))
-> ApplicativeRec (EvalRecord b)
forall (f :: * -> * -> *).
(forall a. Metadata a -> f @@ a) -> EvalRecord b f
forall (f :: * -> * -> *) (g :: * -> * -> *).
EvalRecord b f -> EvalRecord b g -> EvalRecord b (Tuple2 f g)
forall (b :: (* -> * -> *) -> *).
ApplicativeRec b =>
FunctorRec (EvalRecord b)
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
ApplicativeRec b =>
(forall a. Metadata a -> f @@ a) -> EvalRecord b f
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec b =>
EvalRecord b f -> EvalRecord b g -> EvalRecord b (Tuple2 f g)
forall (rec :: (* -> * -> *) -> *).
FunctorRec rec =>
(forall (f :: * -> * -> *).
 (forall a. Metadata a -> f @@ a) -> rec f)
-> (forall (f :: * -> * -> *) (g :: * -> * -> *).
    rec f -> rec g -> rec (Tuple2 f g))
-> ApplicativeRec rec
$cpure :: forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
ApplicativeRec b =>
(forall a. Metadata a -> f @@ a) -> EvalRecord b f
pure :: forall (f :: * -> * -> *).
(forall a. Metadata a -> f @@ a) -> EvalRecord b f
$cprod :: forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
ApplicativeRec b =>
EvalRecord b f -> EvalRecord b g -> EvalRecord b (Tuple2 f g)
prod :: forall (f :: * -> * -> *) (g :: * -> * -> *).
EvalRecord b f -> EvalRecord b g -> EvalRecord b (Tuple2 f g)
ApplicativeRec)


instance (WitnessFieldTypes b, FunctorRec b) => WitnessFieldTypes (EvalRecord b) where
  typeName :: Proxy (EvalRecord b) -> String
typeName Proxy (EvalRecord b)
_ = Proxy b -> String
forall (rec :: (* -> * -> *) -> *).
WitnessFieldTypes rec =>
Proxy rec -> String
typeName (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
  typeProxies :: EvalRecord b (Pure1 Metadata)
typeProxies = EvalRecord b (Pure1 Metadata)
forall (rec :: (* -> * -> *) -> *).
WitnessFieldTypes rec =>
rec (Pure1 Metadata)
typeProxies
  getAccessors :: EvalRecord b (Pure1 (LensRec (EvalRecord b)))
getAccessors =
    b (Pure1 (LensRec (EvalRecord b)))
-> EvalRecord b (Pure1 (LensRec (EvalRecord b)))
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
b f -> EvalRecord b f
EvalRecord (b (Pure1 (LensRec (EvalRecord b)))
 -> EvalRecord b (Pure1 (LensRec (EvalRecord b))))
-> b (Pure1 (LensRec (EvalRecord b)))
-> EvalRecord b (Pure1 (LensRec (EvalRecord b)))
forall a b. (a -> b) -> a -> b
$
      (forall a.
 Metadata a
 -> (Pure1 (LensRec b) @@ a) -> Pure1 (LensRec (EvalRecord b)) @@ a)
-> b (Pure1 (LensRec b)) -> b (Pure1 (LensRec (EvalRecord b)))
forall (f :: * -> * -> *) (g :: * -> * -> *).
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
FunctorRec rec =>
(forall a. Metadata a -> (f @@ a) -> g @@ a) -> rec f -> rec g
map
        ( \Metadata a
_ (LensRec forall (f :: * -> * -> *). b f -> f @@ a
getter forall (f :: * -> * -> *). (f @@ a) -> b f -> b f
setter) ->
            LensRec
              { view :: forall (f :: * -> * -> *). EvalRecord b f -> f @@ a
view = b f -> Eval (f a)
forall (f :: * -> * -> *). b f -> f @@ a
getter (b f -> Eval (f a))
-> (EvalRecord b f -> b f) -> EvalRecord b f -> Eval (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalRecord b f -> b f
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
EvalRecord b f -> b f
evalRecord
              , set :: forall (f :: * -> * -> *).
(f @@ a) -> EvalRecord b f -> EvalRecord b f
set = \f @@ a
x (EvalRecord b f
record) -> b f -> EvalRecord b f
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
b f -> EvalRecord b f
EvalRecord (b f -> EvalRecord b f) -> b f -> EvalRecord b f
forall a b. (a -> b) -> a -> b
$ (f @@ a) -> b f -> b f
forall (f :: * -> * -> *). (f @@ a) -> b f -> b f
setter f @@ a
x b f
record
              }
        )
        (b (Pure1 (LensRec b))
forall (rec :: (* -> * -> *) -> *).
WitnessFieldTypes rec =>
rec (Pure1 (LensRec rec))
getAccessors :: b (Pure1 (LensRec b)))
  nestedFieldNames :: EvalRecord b (ConstFn (NonEmpty String))
nestedFieldNames = b (ConstFn (NonEmpty String))
-> EvalRecord b (ConstFn (NonEmpty String))
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
b f -> EvalRecord b f
EvalRecord b (ConstFn (NonEmpty String))
forall (rec :: (* -> * -> *) -> *).
WitnessFieldTypes rec =>
rec (ConstFn (NonEmpty String))
nestedFieldNames


-- Need to derive it manually to make GHC 8.0.2 happy
instance ConstraintsRec b => ConstraintsRec (EvalRecord b) where
  type AllRec c (EvalRecord b) = AllRec c b
  addDicts :: forall (c :: * -> Constraint) (f :: * -> * -> *).
AllRec c (EvalRecord b) =>
EvalRecord b f -> EvalRecord b (Tuple2 (Pure1 (Dict c)) f)
addDicts = b (Tuple2 (Pure1 (Dict c)) f)
-> EvalRecord b (Tuple2 (Pure1 (Dict c)) f)
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
b f -> EvalRecord b f
EvalRecord (b (Tuple2 (Pure1 (Dict c)) f)
 -> EvalRecord b (Tuple2 (Pure1 (Dict c)) f))
-> (EvalRecord b f -> b (Tuple2 (Pure1 (Dict c)) f))
-> EvalRecord b f
-> EvalRecord b (Tuple2 (Pure1 (Dict c)) f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b f -> b (Tuple2 (Pure1 (Dict c)) f)
forall (c :: * -> Constraint) (f :: * -> * -> *).
AllRec c b =>
b f -> b (Tuple2 (Pure1 (Dict c)) f)
forall (rec :: (* -> * -> *) -> *) (c :: * -> Constraint)
       (f :: * -> * -> *).
(ConstraintsRec rec, AllRec c rec) =>
rec f -> rec (Tuple2 (Pure1 (Dict c)) f)
addDicts (b f -> b (Tuple2 (Pure1 (Dict c)) f))
-> (EvalRecord b f -> b f)
-> EvalRecord b f
-> b (Tuple2 (Pure1 (Dict c)) f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalRecord b f -> b f
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
EvalRecord b f -> b f
evalRecord


instance TraversableRec b => TraversableRec (EvalRecord b) where
  traverse :: forall (e :: * -> *) (f :: * -> * -> *) (g :: * -> * -> *).
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> EvalRecord b f -> e (EvalRecord b g)
traverse forall a. Metadata a -> (f @@ a) -> e (g @@ a)
f = (b g -> EvalRecord b g) -> e (b g) -> e (EvalRecord b g)
forall a b. (a -> b) -> e a -> e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b g -> EvalRecord b g
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
b f -> EvalRecord b f
EvalRecord (e (b g) -> e (EvalRecord b g))
-> (EvalRecord b f -> e (b g))
-> EvalRecord b f
-> e (EvalRecord b g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Metadata a -> (f @@ a) -> e (g @@ a)) -> b f -> e (b g)
forall (e :: * -> *) (f :: * -> * -> *) (g :: * -> * -> *).
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a)) -> b f -> e (b g)
forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       (g :: * -> * -> *).
(TraversableRec rec, Applicative e) =>
(forall a. Metadata a -> (f @@ a) -> e (g @@ a))
-> rec f -> e (rec g)
Data.EvalRecord.traverse Metadata a -> (f @@ a) -> e (g @@ a)
forall a. Metadata a -> (f @@ a) -> e (g @@ a)
f (b f -> e (b g))
-> (EvalRecord b f -> b f) -> EvalRecord b f -> e (b g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalRecord b f -> b f
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
EvalRecord b f -> b f
evalRecord
  traverse_ :: forall (e :: * -> *) (f :: * -> * -> *) c.
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e c) -> EvalRecord b f -> e ()
traverse_ forall a. Metadata a -> (f @@ a) -> e c
f = (forall a. Metadata a -> (f @@ a) -> e c) -> b f -> e ()
forall (e :: * -> *) (f :: * -> * -> *) c.
Applicative e =>
(forall a. Metadata a -> (f @@ a) -> e c) -> b f -> e ()
forall (rec :: (* -> * -> *) -> *) (e :: * -> *) (f :: * -> * -> *)
       c.
(TraversableRec rec, Applicative e) =>
(forall a. Metadata a -> (f @@ a) -> e c) -> rec f -> e ()
Data.EvalRecord.traverse_ Metadata a -> (f @@ a) -> e c
forall a. Metadata a -> (f @@ a) -> e c
f (b f -> e ()) -> (EvalRecord b f -> b f) -> EvalRecord b f -> e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalRecord b f -> b f
forall (b :: (* -> * -> *) -> *) (f :: * -> * -> *).
EvalRecord b f -> b f
evalRecord


instance (ConstraintsRec b, ApplicativeRec b, AllRecF Semigroup f b) => Semigroup (EvalRecord b f) where
  <> :: EvalRecord b f -> EvalRecord b f -> EvalRecord b f
(<>) = (forall a.
 Metadata a
 -> (Pure1 (Dict (ClassF Semigroup f)) @@ a)
 -> (f @@ a)
 -> (f @@ a)
 -> f @@ a)
-> EvalRecord b (Pure1 (Dict (ClassF Semigroup f)))
-> EvalRecord b f
-> EvalRecord b f
-> EvalRecord b f
forall (rec :: (* -> * -> *) -> *) (f :: * -> * -> *)
       (g :: * -> * -> *) (h :: * -> * -> *) (i :: * -> * -> *).
ApplicativeRec rec =>
(forall a.
 Metadata a -> (f @@ a) -> (g @@ a) -> (h @@ a) -> i @@ a)
-> rec f -> rec g -> rec h -> rec i
zipWith3 Metadata a
-> Eval (Pure1 (Dict (ClassF Semigroup f)) a)
-> (f @@ a)
-> (f @@ a)
-> f @@ a
Metadata a
-> Dict (ClassF Semigroup f) a -> (f @@ a) -> (f @@ a) -> f @@ a
forall a.
Metadata a
-> (Pure1 (Dict (ClassF Semigroup f)) @@ a)
-> (f @@ a)
-> (f @@ a)
-> f @@ a
forall a.
Metadata a
-> Dict (ClassF Semigroup f) a -> (f @@ a) -> (f @@ a) -> f @@ a
mk EvalRecord b (Pure1 (Dict (ClassF Semigroup f)))
forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *).
(AllRec c b, ApplicativeRec b, ConstraintsRec b) =>
b (Pure1 (Dict c))
dicts
    where
      mk :: Metadata a -> Dict (ClassF Semigroup f) a -> f @@ a -> f @@ a -> f @@ a
      mk :: forall a.
Metadata a
-> Dict (ClassF Semigroup f) a -> (f @@ a) -> (f @@ a) -> f @@ a
mk Metadata a
_ = (ClassF Semigroup f a => Eval (f a) -> Eval (f a) -> Eval (f a))
-> Dict (ClassF Semigroup f) a
-> Eval (f a)
-> Eval (f a)
-> Eval (f a)
forall {k} (c :: k -> Constraint) (a :: k) r.
(c a => r) -> Dict c a -> r
requiringDict Eval (f a) -> Eval (f a) -> Eval (f a)
ClassF Semigroup f a => Eval (f a) -> Eval (f a) -> Eval (f a)
forall a. Semigroup a => a -> a -> a
(<>)


instance (ConstraintsRec b, ApplicativeRec b, AllRecF Semigroup f b, AllRecF Monoid f b) => Monoid (EvalRecord b f) where
  mempty :: EvalRecord b f
mempty = EvalRecord b f
forall (f :: * -> * -> *) (b :: (* -> * -> *) -> *).
(AllRecF Monoid f b, ConstraintsRec b, ApplicativeRec b) =>
b f
Data.EvalRecord.mempty
  mappend :: EvalRecord b f -> EvalRecord b f -> EvalRecord b f
mappend = EvalRecord b f -> EvalRecord b f -> EvalRecord b f
forall a. Semigroup a => a -> a -> a
(<>)


data MapMatches pred f :: Type -> Exp Type


type instance Eval (MapMatches pred f a) = ValueOnMatch (pred @@ a) (f @@ a) a


type family ValueOnMatch cond b a where
  ValueOnMatch 'True b _ = b
  ValueOnMatch 'False _ a = a


class ApplyOnMatch (cond :: Bool) where
  applyOnMatch :: Proxy cond -> (a -> b) -> a -> ValueOnMatch cond b a


instance ApplyOnMatch 'True where
  applyOnMatch :: forall a b. Proxy 'True -> (a -> b) -> a -> ValueOnMatch 'True b a
applyOnMatch Proxy 'True
_ a -> b
f = a -> b
a -> ValueOnMatch 'True b a
f


instance ApplyOnMatch 'False where
  applyOnMatch :: forall a b.
Proxy 'False -> (a -> b) -> a -> ValueOnMatch 'False b a
applyOnMatch Proxy 'False
_ a -> b
_ a
x = a
ValueOnMatch 'False b a
x


mapMatching
  :: forall (pred :: Type -> Exp Bool) (f :: Type -> Exp Type) (g :: Type -> Exp Type) rec
   . (FunctorRec rec, ConstraintsRec rec, AllRecF ApplyOnMatch (pred <=< f) rec)
  => Proxy (pred :: Type -> Exp Bool)
  -> (forall a. Metadata a -> f @@ a -> (g <=< f) @@ a)
  -> rec f
  -> rec (MapMatches pred g <=< f)
mapMatching :: forall (pred :: * -> Exp Bool) (f :: * -> * -> *)
       (g :: * -> * -> *) (rec :: (* -> * -> *) -> *).
(FunctorRec rec, ConstraintsRec rec,
 AllRecF ApplyOnMatch (pred <=< f) rec) =>
Proxy pred
-> (forall a. Metadata a -> (f @@ a) -> (g <=< f) @@ a)
-> rec f
-> rec (MapMatches pred g <=< f)
mapMatching Proxy pred
p forall a. Metadata a -> (f @@ a) -> (g <=< f) @@ a
f =
  forall (c :: * -> Constraint) (b :: (* -> * -> *) -> *)
       (f :: * -> * -> *) (g :: * -> * -> *).
(AllRec c b, ConstraintsRec b) =>
(forall a. c a => Metadata a -> (f @@ a) -> g @@ a) -> b f -> b g
Data.EvalRecord.mapC @(ClassF ApplyOnMatch (pred <=< f))
    Metadata a -> (f @@ a) -> (MapMatches pred g <=< f) @@ a
forall a.
ApplyOnMatch ((pred <=< f) @@ a) =>
Metadata a -> (f @@ a) -> (MapMatches pred g <=< f) @@ a
forall a.
ClassF ApplyOnMatch (pred <=< f) a =>
Metadata a -> (f @@ a) -> (MapMatches pred g <=< f) @@ a
applyIfRelevant
  where
    applyIfRelevant :: forall a. ApplyOnMatch ((pred <=< f) @@ a) => Metadata a -> f @@ a -> (MapMatches pred g <=< f) @@ a
    applyIfRelevant :: forall a.
ApplyOnMatch ((pred <=< f) @@ a) =>
Metadata a -> (f @@ a) -> (MapMatches pred g <=< f) @@ a
applyIfRelevant Metadata a
meta Eval (f a)
x =
      let
        predAppProxy :: Proxy (pred @@ (f @@ a))
        predAppProxy :: Proxy (Eval (pred (Eval (f a))))
predAppProxy = Proxy pred -> Eval (f a) -> Proxy (Eval (pred (Eval (f a))))
forall {k} (pred :: * -> Exp k) a.
Proxy pred -> a -> Proxy (pred @@ a)
applyPred Proxy pred
p Eval (f a)
x

        mapFn :: f @@ a -> (g <=< f) @@ a
        mapFn :: Eval (f a) -> (g <=< f) @@ a
mapFn = Metadata a -> Eval (f a) -> (g <=< f) @@ a
forall a. Metadata a -> (f @@ a) -> (g <=< f) @@ a
f Metadata a
meta
      in
        Proxy (Eval (pred (Eval (f a))))
-> (Eval (f a) -> Eval (g (Eval (f a))))
-> Eval (f a)
-> ValueOnMatch
     (Eval (pred (Eval (f a)))) (Eval (g (Eval (f a)))) (Eval (f a))
forall (cond :: Bool) a b.
ApplyOnMatch cond =>
Proxy cond -> (a -> b) -> a -> ValueOnMatch cond b a
forall a b.
Proxy (Eval (pred (Eval (f a))))
-> (a -> b) -> a -> ValueOnMatch (Eval (pred (Eval (f a)))) b a
applyOnMatch Proxy (Eval (pred (Eval (f a))))
predAppProxy Eval (f a) -> Eval (g (Eval (f a)))
Eval (f a) -> (g <=< f) @@ a
mapFn Eval (f a)
x


applyPred :: Proxy pred -> a -> Proxy (pred @@ a)
applyPred :: forall {k} (pred :: * -> Exp k) a.
Proxy pred -> a -> Proxy (pred @@ a)
applyPred Proxy pred
_ a
_ = Proxy (Eval (pred a))
forall {k} (t :: k). Proxy t
Proxy