{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Extensible.Product
-- Copyright   :  (c) Fumiaki Kinoshita 2018
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
------------------------------------------------------------------------
module Data.Extensible.Product (
  -- * Basic operations
  (:&)
  , nil
  , (<:)
  , (<!)
  , (=<:)
  , hlength
  , type (++)
  , happend
  , hmap
  , hmapWithIndex
  , hzipWith
  , hzipWith3
  , hfoldMap
  , hfoldMapWithIndex
  , hfoldrWithIndex
  , hfoldlWithIndex
  , htraverse
  , htraverseWithIndex
  , hsequence
  -- * Constrained fold
  , hmapWithIndexFor
  , hfoldMapFor
  , hfoldMapWithIndexFor
  , hfoldrWithIndexFor
  , hfoldlWithIndexFor
  -- * Constraind fold without proxies
  , hfoldMapWith
  , hfoldMapWithIndexWith
  , hfoldrWithIndexWith
  , hfoldlWithIndexWith
  , hmapWithIndexWith
  -- * Evaluating
  , hforce
  -- * Update
  , haccumMap
  , haccum
  , hpartition
  -- * Lookup
  , hlookup
  , hindex
  -- * Generation
  , Generate(..)
  , hgenerate
  , htabulate
  , hrepeat
  , hcollect
  , hdistribute
  , fromHList
  , toHList
  , Forall(..)
  , hgenerateFor
  , htabulateFor
  , hrepeatFor
  , hgenerateWith
  , htabulateWith
  , hrepeatWith) where

import Data.Extensible.Internal.Rig (review)
import Data.Extensible.Struct
import Data.Extensible.Sum
import Data.Extensible.Class
import Data.Extensible.Wrapper
import Data.Functor.Compose
import Data.Proxy
import qualified Type.Membership.HList as HList

-- | O(n) Prepend an element onto a product.
-- Expressions like @a <: b <: c <: nil@ are transformed to a single 'fromHList'.
(<:) :: h x -> xs :& h -> (x ': xs) :& h
<: :: h x -> (xs :& h) -> (x : xs) :& h
(<:) h x
x = HList h (x : xs) -> (x : xs) :& h
forall k (h :: k -> Type) (xs :: [k]). HList h xs -> xs :& h
fromHList (HList h (x : xs) -> (x : xs) :& h)
-> ((xs :& h) -> HList h (x : xs)) -> (xs :& h) -> (x : xs) :& h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h x -> HList h xs -> HList h (x : xs)
forall k (h :: k -> Type) (x :: k) (xs1 :: [k]).
h x -> HList h xs1 -> HList h (x : xs1)
HList.HCons h x
x (HList h xs -> HList h (x : xs))
-> ((xs :& h) -> HList h xs) -> (xs :& h) -> HList h (x : xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (xs :& h) -> HList h xs
forall k (h :: k -> Type) (xs :: [k]). (xs :& h) -> HList h xs
toHList
{-# INLINE (<:) #-}
infixr 0 <:

(=<:) :: Wrapper h => Repr h x -> xs :& h -> (x ': xs) :& h
=<: :: Repr h x -> (xs :& h) -> (x : xs) :& h
(=<:) = h x -> (xs :& h) -> (x : xs) :& h
forall k (h :: k -> Type) (x :: k) (xs :: [k]).
h x -> (xs :& h) -> (x : xs) :& h
(<:) (h x -> (xs :& h) -> (x : xs) :& h)
-> (Repr h x -> h x) -> Repr h x -> (xs :& h) -> (x : xs) :& h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' Tagged Identity (h x) (Repr h x) -> Repr h x -> h x
forall s a. Optic' Tagged Identity s a -> a -> s
review Optic' Tagged Identity (h x) (Repr h x)
forall k (h :: k -> Type) (f :: Type -> Type)
       (p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper
{-# INLINE (=<:) #-}
infixr 0 =<:

-- | Strict version of ('<:').
(<!) :: h x -> xs :& h -> (x ': xs) :& h
<! :: h x -> (xs :& h) -> (x : xs) :& h
(<!) h x
x = HList h (x : xs) -> (x : xs) :& h
forall k (h :: k -> Type) (xs :: [k]). HList h xs -> xs :& h
fromHList (HList h (x : xs) -> (x : xs) :& h)
-> ((xs :& h) -> HList h (x : xs)) -> (xs :& h) -> (x : xs) :& h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (h x -> HList h xs -> HList h (x : xs)
forall k (h :: k -> Type) (x :: k) (xs1 :: [k]).
h x -> HList h xs1 -> HList h (x : xs1)
HList.HCons (h x -> HList h xs -> HList h (x : xs))
-> h x -> HList h xs -> HList h (x : xs)
forall a b. (a -> b) -> a -> b
$! h x
x) (HList h xs -> HList h (x : xs))
-> ((xs :& h) -> HList h xs) -> (xs :& h) -> HList h (x : xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (xs :& h) -> HList h xs
forall k (h :: k -> Type) (xs :: [k]). (xs :& h) -> HList h xs
toHList
{-# INLINE (<!) #-}
infixr 0 <!

-- | An empty product.
nil :: '[] :& h
nil :: '[] :& h
nil = (forall s. ST s (Struct s h '[])) -> '[] :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen ((forall s. ST s (Struct s h '[])) -> '[] :& h)
-> (forall s. ST s (Struct s h '[])) -> '[] :& h
forall a b. (a -> b) -> a -> b
$ (forall (x :: k). Membership '[] x -> h x)
-> ST s (Struct (PrimState (ST s)) h '[])
forall k (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
new ((forall (x :: k). Membership '[] x -> h x)
 -> ST s (Struct (PrimState (ST s)) h '[]))
-> (forall (x :: k). Membership '[] x -> h x)
-> ST s (Struct (PrimState (ST s)) h '[])
forall a b. (a -> b) -> a -> b
$ [Char] -> Membership '[] x -> h x
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible"
{-# NOINLINE nil #-}
{-# RULES "toHList/nil" toHList nil = HList.HNil #-}

-- | Convert 'HList.HList' into a product.
fromHList :: HList.HList h xs -> xs :& h
fromHList :: HList h xs -> xs :& h
fromHList HList h xs
xs = (forall s. ST s (Struct s h xs)) -> xs :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen (HList h xs -> ST s (Struct (PrimState (ST s)) h xs)
forall k (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
PrimMonad m =>
HList h xs -> m (Struct (PrimState m) h xs)
newFromHList HList h xs
xs)
{-# INLINE fromHList #-}

-- | Flipped 'hlookup'
hindex :: xs :& h -> Membership xs x ->  h x
hindex :: (xs :& h) -> Membership xs x -> h x
hindex = (Membership xs x -> (xs :& h) -> h x)
-> (xs :& h) -> Membership xs x -> h x
forall a b c. (a -> b -> c) -> b -> a -> c
flip Membership xs x -> (xs :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup
{-# INLINE hindex #-}

-- | Map a function to every element of a product.
hmapWithIndex :: (forall x. Membership xs x -> g x -> h x) -> xs :& g -> xs :& h
hmapWithIndex :: (forall (x :: k). Membership xs x -> g x -> h x)
-> (xs :& g) -> xs :& h
hmapWithIndex forall (x :: k). Membership xs x -> g x -> h x
t xs :& g
p = (forall s. ST s (Struct s h xs)) -> xs :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen ((xs :& g)
-> (forall (x :: k). Membership xs x -> g x -> h x)
-> ST s (Struct (PrimState (ST s)) h xs)
forall k (g :: k -> Type) (h :: k -> Type) (m :: Type -> Type)
       (xs :: [k]).
PrimMonad m =>
(xs :& g)
-> (forall (x :: k). Membership xs x -> g x -> h x)
-> m (Struct (PrimState m) h xs)
newFrom xs :& g
p forall (x :: k). Membership xs x -> g x -> h x
t)
{-# INLINE hmapWithIndex #-}

-- | Map a function to every element of a product.
hmapWithIndexFor :: Forall c xs
  => proxy c
  -> (forall x. c x => Membership xs x -> g x -> h x)
  -> xs :& g -> xs :& h
hmapWithIndexFor :: proxy c
-> (forall (x :: k). c x => Membership xs x -> g x -> h x)
-> (xs :& g)
-> xs :& h
hmapWithIndexFor proxy c
c forall (x :: k). c x => Membership xs x -> g x -> h x
t xs :& g
p = (forall s. ST s (Struct s h xs)) -> xs :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen ((forall s. ST s (Struct s h xs)) -> xs :& h)
-> (forall s. ST s (Struct s h xs)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> ST s (Struct (PrimState (ST s)) h xs)
forall k (proxy :: (k -> Constraint) -> Type)
       (c :: k -> Constraint) (h :: k -> Type) (m :: Type -> Type)
       (xs :: [k]).
(PrimMonad m, Forall c xs) =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newFor proxy c
c ((forall (x :: k). c x => Membership xs x -> h x)
 -> ST s (Struct (PrimState (ST s)) h xs))
-> (forall (x :: k). c x => Membership xs x -> h x)
-> ST s (Struct (PrimState (ST s)) h xs)
forall a b. (a -> b) -> a -> b
$ \Membership xs x
i -> Membership xs x -> g x -> h x
forall (x :: k). c x => Membership xs x -> g x -> h x
t Membership xs x
i (g x -> h x) -> g x -> h x
forall a b. (a -> b) -> a -> b
$ Membership xs x -> (xs :& g) -> g x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i xs :& g
p
{-# INLINE hmapWithIndexFor #-}

hmapWithIndexWith :: forall c xs g h. Forall c xs
  => (forall x. c x => Membership xs x -> g x -> h x)
  -> xs :& g -> xs :& h
hmapWithIndexWith :: (forall (x :: k). c x => Membership xs x -> g x -> h x)
-> (xs :& g) -> xs :& h
hmapWithIndexWith = Proxy c
-> (forall (x :: k). c x => Membership xs x -> g x -> h x)
-> (xs :& g)
-> xs :& h
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) (g :: k -> Type)
       (h :: k -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> g x -> h x)
-> (xs :& g)
-> xs :& h
hmapWithIndexFor (Proxy c
forall k (t :: k). Proxy t
Proxy @c)

-- | Transform every element in a product, preserving the order.
--
-- @
-- 'hmap' 'id' ≡ 'id'
-- 'hmap' (f . g) ≡ 'hmap' f . 'hmap' g
-- @
hmap :: (forall x. g x -> h x) -> xs :& g -> xs :& h
hmap :: (forall (x :: k). g x -> h x) -> (xs :& g) -> xs :& h
hmap forall (x :: k). g x -> h x
f = (forall (x :: k). Membership xs x -> g x -> h x)
-> (xs :& g) -> xs :& h
forall k (xs :: [k]) (g :: k -> Type) (h :: k -> Type).
(forall (x :: k). Membership xs x -> g x -> h x)
-> (xs :& g) -> xs :& h
hmapWithIndex ((g x -> h x) -> Membership xs x -> g x -> h x
forall a b. a -> b -> a
const g x -> h x
forall (x :: k). g x -> h x
f)
{-# INLINE hmap #-}

-- | 'zipWith' for heterogeneous product
hzipWith :: (forall x. f x -> g x -> h x) -> xs :& f -> xs :& g -> xs :& h
hzipWith :: (forall (x :: k). f x -> g x -> h x)
-> (xs :& f) -> (xs :& g) -> xs :& h
hzipWith forall (x :: k). f x -> g x -> h x
t xs :& f
xs = (forall (x :: k). Membership xs x -> g x -> h x)
-> (xs :& g) -> xs :& h
forall k (xs :: [k]) (g :: k -> Type) (h :: k -> Type).
(forall (x :: k). Membership xs x -> g x -> h x)
-> (xs :& g) -> xs :& h
hmapWithIndex (\Membership xs x
i -> f x -> g x -> h x
forall (x :: k). f x -> g x -> h x
t (Membership xs x -> (xs :& f) -> f x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i xs :& f
xs))
{-# INLINE hzipWith #-}

-- | 'zipWith3' for heterogeneous product
hzipWith3 :: (forall x. f x -> g x -> h x -> i x) -> xs :& f -> xs :& g -> xs :& h -> xs :& i
hzipWith3 :: (forall (x :: k). f x -> g x -> h x -> i x)
-> (xs :& f) -> (xs :& g) -> (xs :& h) -> xs :& i
hzipWith3 forall (x :: k). f x -> g x -> h x -> i x
t xs :& f
xs xs :& g
ys = (forall (x :: k). Membership xs x -> h x -> i x)
-> (xs :& h) -> xs :& i
forall k (xs :: [k]) (g :: k -> Type) (h :: k -> Type).
(forall (x :: k). Membership xs x -> g x -> h x)
-> (xs :& g) -> xs :& h
hmapWithIndex (\Membership xs x
i -> f x -> g x -> h x -> i x
forall (x :: k). f x -> g x -> h x -> i x
t (Membership xs x -> (xs :& f) -> f x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i xs :& f
xs) (Membership xs x -> (xs :& g) -> g x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i xs :& g
ys))
{-# INLINE hzipWith3 #-}

-- | Map elements to a monoid and combine the results.
--
-- @'hfoldMap' f . 'hmap' g ≡ 'hfoldMap' (f . g)@
hfoldMap :: Monoid a => (forall x. h x -> a) -> xs :& h -> a
hfoldMap :: (forall (x :: k). h x -> a) -> (xs :& h) -> a
hfoldMap forall (x :: k). h x -> a
f = (forall (x :: k). Membership xs x -> h x -> a) -> (xs :& h) -> a
forall k a (xs :: [k]) (g :: k -> Type).
Monoid a =>
(forall (x :: k). Membership xs x -> g x -> a) -> (xs :& g) -> a
hfoldMapWithIndex ((h x -> a) -> Membership xs x -> h x -> a
forall a b. a -> b -> a
const h x -> a
forall (x :: k). h x -> a
f)
{-# INLINE hfoldMap #-}

-- | 'hfoldMap' with the membership of elements.
hfoldMapWithIndex :: Monoid a
  => (forall x. Membership xs x -> g x -> a) -> xs :& g -> a
hfoldMapWithIndex :: (forall (x :: k). Membership xs x -> g x -> a) -> (xs :& g) -> a
hfoldMapWithIndex forall (x :: k). Membership xs x -> g x -> a
f = (forall (x :: k). Membership xs x -> g x -> a -> a)
-> a -> (xs :& g) -> a
forall k (xs :: [k]) (h :: k -> Type) r.
(forall (x :: k). Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndex (\Membership xs x
i -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> (g x -> a) -> g x -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Membership xs x -> g x -> a
forall (x :: k). Membership xs x -> g x -> a
f Membership xs x
i) a
forall a. Monoid a => a
mempty
{-# INLINE hfoldMapWithIndex #-}

-- | Perform a strict left fold over the elements.
hfoldlWithIndex :: (forall x. Membership xs x -> r -> h x -> r) -> r -> xs :& h -> r
hfoldlWithIndex :: (forall (x :: k). Membership xs x -> r -> h x -> r)
-> r -> (xs :& h) -> r
hfoldlWithIndex forall (x :: k). Membership xs x -> r -> h x -> r
f r
r xs :& h
xs = (forall (x :: k). Membership xs x -> h x -> (r -> r) -> r -> r)
-> (r -> r) -> (xs :& h) -> r -> r
forall k (xs :: [k]) (h :: k -> Type) r.
(forall (x :: k). Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndex (\Membership xs x
i h x
x r -> r
c r
a -> r -> r
c (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$! Membership xs x -> r -> h x -> r
forall (x :: k). Membership xs x -> r -> h x -> r
f Membership xs x
i r
a h x
x) r -> r
forall a. a -> a
id xs :& h
xs r
r
{-# INLINE hfoldlWithIndex #-}

-- | 'hfoldrWithIndex' with a constraint for each element.
hfoldrWithIndexFor :: forall c xs h r proxy. (Forall c xs) => proxy c
  -> (forall x. c x => Membership xs x -> h x -> r -> r) -> r -> xs :& h -> r
hfoldrWithIndexFor :: proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> r -> r)
-> r
-> (xs :& h)
-> r
hfoldrWithIndexFor proxy c
p forall (x :: k). c x => Membership xs x -> h x -> r -> r
f r
r xs :& h
xs = proxy c
-> Proxy xs
-> (forall (x :: k). c x => Membership xs x -> r -> r)
-> r
-> r
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) (proxy' :: [k] -> Type) r.
Forall c xs =>
proxy c
-> proxy' xs
-> (forall (x :: k). c x => Membership xs x -> r -> r)
-> r
-> r
henumerateFor proxy c
p (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs) (\Membership xs x
i -> Membership xs x -> h x -> r -> r
forall (x :: k). c x => Membership xs x -> h x -> r -> r
f Membership xs x
i (Membership xs x -> (xs :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i xs :& h
xs)) r
r
{-# INLINE hfoldrWithIndexFor #-}

hfoldrWithIndexWith :: forall c xs h r. (Forall c xs)
  => (forall x. c x => Membership xs x -> h x -> r -> r) -> r -> xs :& h -> r
hfoldrWithIndexWith :: (forall (x :: k). c x => Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndexWith forall (x :: k). c x => Membership xs x -> h x -> r -> r
f r
r xs :& h
xs = Proxy c
-> Proxy xs
-> (forall (x :: k). c x => Membership xs x -> r -> r)
-> r
-> r
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) (proxy' :: [k] -> Type) r.
Forall c xs =>
proxy c
-> proxy' xs
-> (forall (x :: k). c x => Membership xs x -> r -> r)
-> r
-> r
henumerateFor (Proxy c
forall k (t :: k). Proxy t
Proxy @c) (Proxy xs
forall k (t :: k). Proxy t
Proxy @xs) (\Membership xs x
i -> Membership xs x -> h x -> r -> r
forall (x :: k). c x => Membership xs x -> h x -> r -> r
f Membership xs x
i (Membership xs x -> (xs :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i xs :& h
xs)) r
r
{-# INLINE hfoldrWithIndexWith #-}

-- | Constrained 'hfoldlWithIndex'
hfoldlWithIndexFor :: (Forall c xs) => proxy c
  -> (forall x. c x => Membership xs x -> r -> h x -> r) -> r -> xs :& h -> r
hfoldlWithIndexFor :: proxy c
-> (forall (x :: k). c x => Membership xs x -> r -> h x -> r)
-> r
-> (xs :& h)
-> r
hfoldlWithIndexFor proxy c
p forall (x :: k). c x => Membership xs x -> r -> h x -> r
f r
r xs :& h
xs = proxy c
-> (forall (x :: k).
    c x =>
    Membership xs x -> h x -> (r -> r) -> r -> r)
-> (r -> r)
-> (xs :& h)
-> r
-> r
forall k (c :: k -> Constraint) (xs :: [k]) (h :: k -> Type) r
       (proxy :: (k -> Constraint) -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> r -> r)
-> r
-> (xs :& h)
-> r
hfoldrWithIndexFor proxy c
p (\Membership xs x
i h x
x r -> r
c r
a -> r -> r
c (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$! Membership xs x -> r -> h x -> r
forall (x :: k). c x => Membership xs x -> r -> h x -> r
f Membership xs x
i r
a h x
x) r -> r
forall a. a -> a
id xs :& h
xs r
r
{-# INLINE hfoldlWithIndexFor #-}

-- | Constrained 'hfoldlWithIndex'
hfoldlWithIndexWith :: forall c xs h r. (Forall c xs)
  => (forall x. c x => Membership xs x -> r -> h x -> r) -> r -> xs :& h -> r
hfoldlWithIndexWith :: (forall (x :: k). c x => Membership xs x -> r -> h x -> r)
-> r -> (xs :& h) -> r
hfoldlWithIndexWith forall (x :: k). c x => Membership xs x -> r -> h x -> r
f r
r xs :& h
xs = (forall (x :: k).
 c x =>
 Membership xs x -> h x -> (r -> r) -> r -> r)
-> (r -> r) -> (xs :& h) -> r -> r
forall k (c :: k -> Constraint) (xs :: [k]) (h :: k -> Type) r.
Forall c xs =>
(forall (x :: k). c x => Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndexWith @c (\Membership xs x
i h x
x r -> r
c r
a -> r -> r
c (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$! Membership xs x -> r -> h x -> r
forall (x :: k). c x => Membership xs x -> r -> h x -> r
f Membership xs x
i r
a h x
x) r -> r
forall a. a -> a
id xs :& h
xs r
r
{-# INLINE hfoldlWithIndexWith #-}

-- | 'hfoldMapWithIndex' with a constraint for each element.
hfoldMapWithIndexFor :: (Forall c xs, Monoid a) => proxy c
  -> (forall x. c x => Membership xs x -> h x -> a) -> xs :& h -> a
hfoldMapWithIndexFor :: proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> a)
-> (xs :& h)
-> a
hfoldMapWithIndexFor proxy c
p forall (x :: k). c x => Membership xs x -> h x -> a
f = proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> a -> a)
-> a
-> (xs :& h)
-> a
forall k (c :: k -> Constraint) (xs :: [k]) (h :: k -> Type) r
       (proxy :: (k -> Constraint) -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> r -> r)
-> r
-> (xs :& h)
-> r
hfoldrWithIndexFor proxy c
p (\Membership xs x
i -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> (h x -> a) -> h x -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Membership xs x -> h x -> a
forall (x :: k). c x => Membership xs x -> h x -> a
f Membership xs x
i) a
forall a. Monoid a => a
mempty
{-# INLINE hfoldMapWithIndexFor #-}

-- | 'hfoldMapWithIndex' with a constraint for each element.
hfoldMapWithIndexWith :: forall c xs h a. (Forall c xs, Monoid a)
  => (forall x. c x => Membership xs x -> h x -> a) -> xs :& h -> a
hfoldMapWithIndexWith :: (forall (x :: k). c x => Membership xs x -> h x -> a)
-> (xs :& h) -> a
hfoldMapWithIndexWith forall (x :: k). c x => Membership xs x -> h x -> a
f = (forall (x :: k). c x => Membership xs x -> h x -> a -> a)
-> a -> (xs :& h) -> a
forall k (c :: k -> Constraint) (xs :: [k]) (h :: k -> Type) r.
Forall c xs =>
(forall (x :: k). c x => Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndexWith @c (\Membership xs x
i -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> (h x -> a) -> h x -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Membership xs x -> h x -> a
forall (x :: k). c x => Membership xs x -> h x -> a
f Membership xs x
i) a
forall a. Monoid a => a
mempty
{-# INLINE hfoldMapWithIndexWith #-}

-- | Constrained 'hfoldMap'
hfoldMapFor :: (Forall c xs, Monoid a) => proxy c
  -> (forall x. c x => h x -> a) -> xs :& h -> a
hfoldMapFor :: proxy c -> (forall (x :: k). c x => h x -> a) -> (xs :& h) -> a
hfoldMapFor proxy c
p forall (x :: k). c x => h x -> a
f = proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> a)
-> (xs :& h)
-> a
forall k (c :: k -> Constraint) (xs :: [k]) a
       (proxy :: (k -> Constraint) -> Type) (h :: k -> Type).
(Forall c xs, Monoid a) =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> a)
-> (xs :& h)
-> a
hfoldMapWithIndexFor proxy c
p ((h x -> a) -> Membership xs x -> h x -> a
forall a b. a -> b -> a
const h x -> a
forall (x :: k). c x => h x -> a
f)
{-# INLINE hfoldMapFor #-}

-- | Constrained 'hfoldMap'
hfoldMapWith :: forall c xs h a. (Forall c xs, Monoid a)
  => (forall x. c x => h x -> a) -> xs :& h -> a
hfoldMapWith :: (forall (x :: k). c x => h x -> a) -> (xs :& h) -> a
hfoldMapWith forall (x :: k). c x => h x -> a
f = Proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> a)
-> (xs :& h)
-> a
forall k (c :: k -> Constraint) (xs :: [k]) a
       (proxy :: (k -> Constraint) -> Type) (h :: k -> Type).
(Forall c xs, Monoid a) =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x -> a)
-> (xs :& h)
-> a
hfoldMapWithIndexFor (Proxy c
forall k (t :: k). Proxy t
Proxy @c) ((h x -> a) -> Membership xs x -> h x -> a
forall a b. a -> b -> a
const h x -> a
forall (x :: k). c x => h x -> a
f)
{-# INLINE hfoldMapWith #-}

-- | Traverse all elements and combine the result sequentially.
-- @
-- htraverse (fmap f . g) ≡ fmap (hmap f) . htraverse g
-- htraverse pure ≡ pure
-- htraverse (Compose . fmap g . f) ≡ Compose . fmap (htraverse g) . htraverse f
-- @
htraverse :: Applicative f => (forall x. g x -> f (h x)) -> xs :& g -> f (xs :& h)
htraverse :: (forall (x :: k). g x -> f (h x)) -> (xs :& g) -> f (xs :& h)
htraverse forall (x :: k). g x -> f (h x)
f = (HList h xs -> xs :& h) -> f (HList h xs) -> f (xs :& h)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap HList h xs -> xs :& h
forall k (h :: k -> Type) (xs :: [k]). HList h xs -> xs :& h
fromHList (f (HList h xs) -> f (xs :& h))
-> ((xs :& g) -> f (HList h xs)) -> (xs :& g) -> f (xs :& h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: k). g x -> f (h x)) -> HList g xs -> f (HList h xs)
forall k (f :: Type -> Type) (g :: k -> Type) (h :: k -> Type)
       (xs :: [k]).
Applicative f =>
(forall (x :: k). g x -> f (h x)) -> HList g xs -> f (HList h xs)
HList.htraverse forall (x :: k). g x -> f (h x)
f (HList g xs -> f (HList h xs))
-> ((xs :& g) -> HList g xs) -> (xs :& g) -> f (HList h xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (xs :& g) -> HList g xs
forall k (h :: k -> Type) (xs :: [k]). (xs :& h) -> HList h xs
toHList
{-# INLINE htraverse #-}

-- | 'sequence' analog for extensible products
hsequence :: Applicative f => xs :& Compose f h -> f (xs :& h)
hsequence :: (xs :& Compose f h) -> f (xs :& h)
hsequence = (forall (x :: k). Compose f h x -> f (h x))
-> (xs :& Compose f h) -> f (xs :& h)
forall k (f :: Type -> Type) (g :: k -> Type) (h :: k -> Type)
       (xs :: [k]).
Applicative f =>
(forall (x :: k). g x -> f (h x)) -> (xs :& g) -> f (xs :& h)
htraverse forall (x :: k). Compose f h x -> f (h x)
forall k1 (f :: k1 -> Type) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
{-# INLINE hsequence #-}

-- | The dual of 'htraverse'
hcollect :: (Functor f, Generate xs) => (a -> xs :& h) -> f a -> xs :& Compose f h
hcollect :: (a -> xs :& h) -> f a -> xs :& Compose f h
hcollect a -> xs :& h
f f a
m = (forall (x :: k1). Membership xs x -> Compose f h x)
-> xs :& Compose f h
forall k (xs :: [k]) (h :: k -> Type).
Generate xs =>
(forall (x :: k). Membership xs x -> h x) -> xs :& h
htabulate ((forall (x :: k1). Membership xs x -> Compose f h x)
 -> xs :& Compose f h)
-> (forall (x :: k1). Membership xs x -> Compose f h x)
-> xs :& Compose f h
forall a b. (a -> b) -> a -> b
$ \Membership xs x
i -> f (h x) -> Compose f h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (h x) -> Compose f h x) -> f (h x) -> Compose f h x
forall a b. (a -> b) -> a -> b
$ (a -> h x) -> f a -> f (h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Membership xs x -> (xs :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i ((xs :& h) -> h x) -> (a -> xs :& h) -> a -> h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> xs :& h
f) f a
m
{-# INLINABLE hcollect #-}

-- | The dual of 'hsequence'
hdistribute :: (Functor f, Generate xs) => f (xs :& h) -> xs :& Compose f h
hdistribute :: f (xs :& h) -> xs :& Compose f h
hdistribute = ((xs :& h) -> xs :& h) -> f (xs :& h) -> xs :& Compose f h
forall k1 (f :: Type -> Type) (xs :: [k1]) a (h :: k1 -> Type).
(Functor f, Generate xs) =>
(a -> xs :& h) -> f a -> xs :& Compose f h
hcollect (xs :& h) -> xs :& h
forall a. a -> a
id
{-# INLINE hdistribute #-}

-- | 'htraverse' with 'Membership's.
htraverseWithIndex :: Applicative f
  => (forall x. Membership xs x -> g x -> f (h x)) -> xs :& g -> f (xs :& h)
htraverseWithIndex :: (forall (x :: k). Membership xs x -> g x -> f (h x))
-> (xs :& g) -> f (xs :& h)
htraverseWithIndex forall (x :: k). Membership xs x -> g x -> f (h x)
f = (HList h xs -> xs :& h) -> f (HList h xs) -> f (xs :& h)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap HList h xs -> xs :& h
forall k (h :: k -> Type) (xs :: [k]). HList h xs -> xs :& h
fromHList (f (HList h xs) -> f (xs :& h))
-> ((xs :& g) -> f (HList h xs)) -> (xs :& g) -> f (xs :& h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: k). Membership xs x -> g x -> f (h x))
-> HList g xs -> f (HList h xs)
forall k (f :: Type -> Type) (g :: k -> Type) (h :: k -> Type)
       (xs :: [k]).
Applicative f =>
(forall (x :: k). Membership xs x -> g x -> f (h x))
-> HList g xs -> f (HList h xs)
HList.htraverseWithIndex forall (x :: k). Membership xs x -> g x -> f (h x)
f (HList g xs -> f (HList h xs))
-> ((xs :& g) -> HList g xs) -> (xs :& g) -> f (HList h xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (xs :& g) -> HList g xs
forall k (h :: k -> Type) (xs :: [k]). (xs :& h) -> HList h xs
toHList
{-# INLINE htraverseWithIndex #-}

-- | A product filled with the specified value.
hrepeat :: Generate xs => (forall x. h x) -> xs :& h
hrepeat :: (forall (x :: k). h x) -> xs :& h
hrepeat forall (x :: k). h x
x = (forall s. ST s (Struct s h xs)) -> xs :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen ((forall s. ST s (Struct s h xs)) -> xs :& h)
-> (forall s. ST s (Struct s h xs)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ (forall (x :: k). h x) -> ST s (Struct (PrimState (ST s)) h xs)
forall k (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat forall (x :: k). h x
x
{-# INLINE hrepeat #-}

-- | Construct a product using a function which takes a 'Membership'.
--
-- @
-- 'hmap' f ('htabulate' g) ≡ 'htabulate' (f . g)
-- 'htabulate' ('hindex' m) ≡ m
-- 'hindex' ('htabulate' k) ≡ k
-- @
htabulate :: Generate xs => (forall x. Membership xs x -> h x) -> xs :& h
htabulate :: (forall (x :: k). Membership xs x -> h x) -> xs :& h
htabulate forall (x :: k). Membership xs x -> h x
f = (forall s. ST s (Struct s h xs)) -> xs :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen ((forall s. ST s (Struct s h xs)) -> xs :& h)
-> (forall s. ST s (Struct s h xs)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ (forall (x :: k). Membership xs x -> h x)
-> ST s (Struct (PrimState (ST s)) h xs)
forall k (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
new forall (x :: k). Membership xs x -> h x
f
{-# INLINE htabulate #-}

-- | 'Applicative' version of 'htabulate'.
hgenerate :: (Generate xs, Applicative f)
  => (forall x. Membership xs x -> f (h x)) -> f (xs :& h)
hgenerate :: (forall (x :: k). Membership xs x -> f (h x)) -> f (xs :& h)
hgenerate forall (x :: k). Membership xs x -> f (h x)
f = (HList h xs -> xs :& h) -> f (HList h xs) -> f (xs :& h)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap HList h xs -> xs :& h
forall k (h :: k -> Type) (xs :: [k]). HList h xs -> xs :& h
fromHList (f (HList h xs) -> f (xs :& h)) -> f (HList h xs) -> f (xs :& h)
forall a b. (a -> b) -> a -> b
$ (forall (x :: k). Membership xs x -> f (h x)) -> f (HList h xs)
forall k (xs :: [k]) (f :: Type -> Type) (h :: k -> Type).
(Generate xs, Applicative f) =>
(forall (x :: k). Membership xs x -> f (h x)) -> f (HList h xs)
hgenerateList forall (x :: k). Membership xs x -> f (h x)
f
{-# INLINE hgenerate #-}

-- | Pure version of 'hgenerateFor'.
htabulateFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> h x) -> xs :& h
htabulateFor :: proxy c
-> (forall (x :: k). c x => Membership xs x -> h x) -> xs :& h
htabulateFor proxy c
p forall (x :: k). c x => Membership xs x -> h x
f = (forall s. ST s (Struct s h xs)) -> xs :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen ((forall s. ST s (Struct s h xs)) -> xs :& h)
-> (forall s. ST s (Struct s h xs)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> ST s (Struct (PrimState (ST s)) h xs)
forall k (proxy :: (k -> Constraint) -> Type)
       (c :: k -> Constraint) (h :: k -> Type) (m :: Type -> Type)
       (xs :: [k]).
(PrimMonad m, Forall c xs) =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newFor proxy c
p forall (x :: k). c x => Membership xs x -> h x
f
{-# INLINE htabulateFor #-}

-- | Pure version of 'hgenerateFor'.
htabulateWith :: forall c xs h. Forall c xs => (forall x. c x => Membership xs x -> h x) -> xs :& h
htabulateWith :: (forall (x :: k). c x => Membership xs x -> h x) -> xs :& h
htabulateWith forall (x :: k). c x => Membership xs x -> h x
f = (forall s. ST s (Struct s h xs)) -> xs :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen ((forall s. ST s (Struct s h xs)) -> xs :& h)
-> (forall s. ST s (Struct s h xs)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ Proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> ST s (Struct (PrimState (ST s)) h xs)
forall k (proxy :: (k -> Constraint) -> Type)
       (c :: k -> Constraint) (h :: k -> Type) (m :: Type -> Type)
       (xs :: [k]).
(PrimMonad m, Forall c xs) =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newFor (Proxy c
forall k (t :: k). Proxy t
Proxy @c) forall (x :: k). c x => Membership xs x -> h x
f
{-# INLINE htabulateWith #-}

-- | A product filled with the specified value.
hrepeatFor :: Forall c xs => proxy c -> (forall x. c x => h x) -> xs :& h
hrepeatFor :: proxy c -> (forall (x :: k). c x => h x) -> xs :& h
hrepeatFor proxy c
p forall (x :: k). c x => h x
f = proxy c
-> (forall (x :: k). c x => Membership xs x -> h x) -> xs :& h
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) (h :: k -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x) -> xs :& h
htabulateFor proxy c
p (h x -> Membership xs x -> h x
forall a b. a -> b -> a
const h x
forall (x :: k). c x => h x
f)
{-# INLINE hrepeatFor #-}

-- | A product filled with the specified value.
hrepeatWith :: forall c xs h. Forall c xs => (forall x. c x => h x) -> xs :& h
hrepeatWith :: (forall (x :: k). c x => h x) -> xs :& h
hrepeatWith forall (x :: k). c x => h x
f = Proxy c
-> (forall (x :: k). c x => Membership xs x -> h x) -> xs :& h
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) (h :: k -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> h x) -> xs :& h
htabulateFor (Proxy c
forall k (t :: k). Proxy t
Proxy @c) (h x -> Membership xs x -> h x
forall a b. a -> b -> a
const h x
forall (x :: k). c x => h x
f)
{-# INLINE hrepeatWith #-}

-- | 'Applicative' version of 'htabulateFor'.
hgenerateFor :: (Forall c xs, Applicative f)
  => proxy c -> (forall x. c x => Membership xs x -> f (h x)) -> f (xs :& h)
hgenerateFor :: proxy c
-> (forall (x :: k). c x => Membership xs x -> f (h x))
-> f (xs :& h)
hgenerateFor proxy c
p forall (x :: k). c x => Membership xs x -> f (h x)
f = (HList h xs -> xs :& h) -> f (HList h xs) -> f (xs :& h)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap HList h xs -> xs :& h
forall k (h :: k -> Type) (xs :: [k]). HList h xs -> xs :& h
fromHList (f (HList h xs) -> f (xs :& h)) -> f (HList h xs) -> f (xs :& h)
forall a b. (a -> b) -> a -> b
$ proxy c
-> (forall (x :: k). c x => Membership xs x -> f (h x))
-> f (HList h xs)
forall k (c :: k -> Constraint) (xs :: [k]) (f :: Type -> Type)
       (proxy :: (k -> Constraint) -> Type) (h :: k -> Type).
(Forall c xs, Applicative f) =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> f (h x))
-> f (HList h xs)
hgenerateListFor proxy c
p forall (x :: k). c x => Membership xs x -> f (h x)
f
{-# INLINE hgenerateFor #-}

-- | 'Applicative' version of 'htabulateFor'.
hgenerateWith :: forall c xs f h. (Forall c xs, Applicative f)
  => (forall x. c x => Membership xs x -> f (h x)) -> f (xs :& h)
hgenerateWith :: (forall (x :: k). c x => Membership xs x -> f (h x)) -> f (xs :& h)
hgenerateWith forall (x :: k). c x => Membership xs x -> f (h x)
f = (HList h xs -> xs :& h) -> f (HList h xs) -> f (xs :& h)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap HList h xs -> xs :& h
forall k (h :: k -> Type) (xs :: [k]). HList h xs -> xs :& h
fromHList (f (HList h xs) -> f (xs :& h)) -> f (HList h xs) -> f (xs :& h)
forall a b. (a -> b) -> a -> b
$ Proxy c
-> (forall (x :: k). c x => Membership xs x -> f (h x))
-> f (HList h xs)
forall k (c :: k -> Constraint) (xs :: [k]) (f :: Type -> Type)
       (proxy :: (k -> Constraint) -> Type) (h :: k -> Type).
(Forall c xs, Applicative f) =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> f (h x))
-> f (HList h xs)
hgenerateListFor (Proxy c
forall k (t :: k). Proxy t
Proxy @c) forall (x :: k). c x => Membership xs x -> f (h x)
f
{-# INLINE hgenerateWith #-}

-- | Accumulate sums on a product.
haccumMap :: Foldable f
  => (a -> xs :/ g)
  -> (forall x. Membership xs x -> g x -> h x -> h x)
  -> xs :& h -> f a -> xs :& h
haccumMap :: (a -> xs :/ g)
-> (forall (x :: k). Membership xs x -> g x -> h x -> h x)
-> (xs :& h)
-> f a
-> xs :& h
haccumMap a -> xs :/ g
f forall (x :: k). Membership xs x -> g x -> h x -> h x
g xs :& h
p0 f a
xs = (forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
forall k (h :: k -> Type) (xs :: [k]).
(forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
hmodify
  (\Struct s h xs
s -> (a -> ST s ()) -> f a -> ST s ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\a
x -> case a -> xs :/ g
f a
x of EmbedAt Membership xs x
i g x
v -> Struct (PrimState (ST s)) h xs -> Membership xs x -> ST s (h x)
forall k (m :: Type -> Type) (h :: k -> Type) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get Struct s h xs
Struct (PrimState (ST s)) h xs
s Membership xs x
i ST s (h x) -> (h x -> ST s ()) -> ST s ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Struct (PrimState (ST s)) h xs -> Membership xs x -> h x -> ST s ()
forall k (m :: Type -> Type) (h :: k -> Type) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct s h xs
Struct (PrimState (ST s)) h xs
s Membership xs x
i (h x -> ST s ()) -> (h x -> h x) -> h x -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Membership xs x -> g x -> h x -> h x
forall (x :: k). Membership xs x -> g x -> h x -> h x
g Membership xs x
i g x
v) f a
xs)
  xs :& h
p0
{-# INLINE haccumMap #-}

-- | @haccum = 'haccumMap' 'id'@
haccum :: Foldable f
  => (forall x. Membership xs x -> g x -> h x -> h x)
  -> xs :& h -> f (xs :/ g) -> xs :& h
haccum :: (forall (x :: k). Membership xs x -> g x -> h x -> h x)
-> (xs :& h) -> f (xs :/ g) -> xs :& h
haccum = ((xs :/ g) -> xs :/ g)
-> (forall (x :: k). Membership xs x -> g x -> h x -> h x)
-> (xs :& h)
-> f (xs :/ g)
-> xs :& h
forall k (f :: Type -> Type) a (xs :: [k]) (g :: k -> Type)
       (h :: k -> Type).
Foldable f =>
(a -> xs :/ g)
-> (forall (x :: k). Membership xs x -> g x -> h x -> h x)
-> (xs :& h)
-> f a
-> xs :& h
haccumMap (xs :/ g) -> xs :/ g
forall a. a -> a
id
{-# INLINE haccum #-}

-- | Group sums by type.
hpartition :: (Foldable f, Generate xs) => (a -> xs :/ h) -> f a -> xs :& Compose [] h
hpartition :: (a -> xs :/ h) -> f a -> xs :& Compose [] h
hpartition a -> xs :/ h
f = (a -> xs :/ h)
-> (forall (x :: k1).
    Membership xs x -> h x -> Compose [] h x -> Compose [] h x)
-> (xs :& Compose [] h)
-> f a
-> xs :& Compose [] h
forall k (f :: Type -> Type) a (xs :: [k]) (g :: k -> Type)
       (h :: k -> Type).
Foldable f =>
(a -> xs :/ g)
-> (forall (x :: k). Membership xs x -> g x -> h x -> h x)
-> (xs :& h)
-> f a
-> xs :& h
haccumMap a -> xs :/ h
f (\Membership xs x
_ h x
x (Compose xs) -> [h x] -> Compose [] h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (h x
xh x -> [h x] -> [h x]
forall a. a -> [a] -> [a]
:[h x]
xs)) ((xs :& Compose [] h) -> f a -> xs :& Compose [] h)
-> (xs :& Compose [] h) -> f a -> xs :& Compose [] h
forall a b. (a -> b) -> a -> b
$ (forall (x :: k1). Compose [] h x) -> xs :& Compose [] h
forall k (xs :: [k]) (h :: k -> Type).
Generate xs =>
(forall (x :: k). h x) -> xs :& h
hrepeat ((forall (x :: k1). Compose [] h x) -> xs :& Compose [] h)
-> (forall (x :: k1). Compose [] h x) -> xs :& Compose [] h
forall a b. (a -> b) -> a -> b
$ [h x] -> Compose [] h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose []
{-# INLINE hpartition #-}

-- | Evaluate every element in a product.
hforce :: xs :& h -> xs :& h
hforce :: (xs :& h) -> xs :& h
hforce xs :& h
p = (forall (x :: k). Membership xs x -> h x -> (xs :& h) -> xs :& h)
-> (xs :& h) -> (xs :& h) -> xs :& h
forall k (xs :: [k]) (h :: k -> Type) r.
(forall (x :: k). Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndex ((h x -> (xs :& h) -> xs :& h)
-> Membership xs x -> h x -> (xs :& h) -> xs :& h
forall a b. a -> b -> a
const h x -> (xs :& h) -> xs :& h
seq) xs :& h
p xs :& h
p
{-# INLINE hforce #-}