{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------
-- |
-- Module      :  Data.Extensible.Dictionary
-- Copyright   :  (c) Fumiaki Kinoshita 2018
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
-- Reification of constraints using extensible data types.
-- Also includes orphan instances.
-----------------------------------------------------------------------
module Data.Extensible.Dictionary (library, WrapForall, Instance1, And) where
import Control.DeepSeq
import qualified Data.Aeson as J
import qualified Data.Aeson.Types as J
#ifdef CASSAVA
import qualified Data.Csv as Csv
import qualified Data.ByteString.Char8 as BC
import qualified Data.Vector as V
#endif
import Data.Extensible.Class
import Data.Extensible.Field
import Data.Extensible.Product
import Data.Extensible.Sum
import Data.Extensible.Internal.Rig
import Data.Extensible.Nullable
import Data.Constraint
import Data.Extensible.Struct
import Data.Extensible.Wrapper
import Data.Hashable
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as KM
#endif
import Data.Functor.Compose
import qualified Data.HashMap.Strict as HM
import Data.Incremental
import Data.Maybe (isJust)
import Data.Monoid (Any(..))
import Prettyprinter
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector.Unboxed as U
import Data.Type.Equality
import qualified Language.Haskell.TH.Lift as TH
#if MIN_VERSION_template_haskell(2,16,0)
import qualified Language.Haskell.TH.Syntax as TH
#endif
import Language.Haskell.TH hiding (Type)
import GHC.Records
import GHC.TypeLits
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen
import Type.Membership

#ifdef BARBIES
import Barbies
import Data.Functor.Product
#endif

-- | Reify a collection of dictionaries, as you wish.
library :: forall c xs. Forall c xs => xs :& Compose Dict c
library :: xs :& Compose Dict c
library = Proxy c
-> (forall (x :: k1). c x => Compose Dict c x)
-> xs :& Compose Dict c
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) (h :: k -> Type).
Forall c xs =>
proxy c -> (forall (x :: k). c x => h x) -> xs :& h
hrepeatFor (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c) ((forall (x :: k1). c x => Compose Dict c x)
 -> xs :& Compose Dict c)
-> (forall (x :: k1). c x => Compose Dict c x)
-> xs :& Compose Dict c
forall a b. (a -> b) -> a -> b
$ Dict (c x) -> Compose Dict c x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Dict (c x)
forall (a :: Constraint). a => Dict a
Dict
{-# INLINE library #-}

class (f x, g x) => And f g x
instance (f x, g x) => And f g x

instance WrapForall Show h xs => Show (xs :& h) where
  showsPrec :: Int -> (xs :& h) -> ShowS
showsPrec Int
d xs :& h
xs = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Show h)
-> Proxy xs
-> (forall (x :: k).
    Instance1 Show h x =>
    Membership xs x -> ShowS -> ShowS)
-> ShowS
-> ShowS
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 (Instance1 Show h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Show h)) (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
    (\Membership xs x
i ShowS
r -> Int -> h x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (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) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" <: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r)
    (String -> ShowS
showString String
"nil")

instance WrapForall Pretty h xs => Pretty (xs :& h) where
  pretty :: (xs :& h) -> Doc ann
pretty xs :& h
xs = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align
    (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"" Doc ann
"{ ") (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"" Doc ann
" }") (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"" Doc ann
"; ")
    ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Pretty h)
-> Proxy xs
-> (forall (x :: k).
    Instance1 Pretty h x =>
    Membership xs x -> [Doc ann] -> [Doc ann])
-> [Doc ann]
-> [Doc ann]
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 (Instance1 Pretty h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Pretty h)) (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
    (\Membership xs x
i [Doc ann]
r -> h x -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (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) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
r)
    []


instance WrapForall Eq h xs => Eq (xs :& h) where
  xs :& h
xs == :: (xs :& h) -> (xs :& h) -> Bool
== xs :& h
ys = Proxy (Instance1 Eq h)
-> Proxy xs
-> (forall (x :: k).
    Instance1 Eq h x =>
    Membership xs x -> Bool -> Bool)
-> Bool
-> Bool
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 (Instance1 Eq h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Eq h)) (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
    (\Membership xs x
i Bool
r -> 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 h x -> h x -> Bool
forall a. Eq a => a -> a -> Bool
== 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
ys Bool -> Bool -> Bool
&& Bool
r) Bool
True
  {-# INLINE (==) #-}

instance (Eq (xs :& h), WrapForall Ord h xs) => Ord (xs :& h) where
  compare :: (xs :& h) -> (xs :& h) -> Ordering
compare xs :& h
xs xs :& h
ys = Proxy (Instance1 Ord h)
-> Proxy xs
-> (forall (x :: k).
    Instance1 Ord h x =>
    Membership xs x -> Ordering -> Ordering)
-> Ordering
-> Ordering
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 (Instance1 Ord h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Ord h)) (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
    (\Membership xs x
i Ordering
r -> (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 h x -> h x -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` 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
ys) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` Ordering
r) Ordering
forall a. Monoid a => a
mempty
  {-# INLINE compare #-}

instance WrapForall Semigroup h xs => Semigroup (xs :& h) where
  <> :: (xs :& h) -> (xs :& h) -> xs :& h
(<>) = (forall (x :: k).
 Compose Dict (Instance1 Semigroup h) x -> h x -> h x -> h x)
-> (xs :& Compose Dict (Instance1 Semigroup h))
-> (xs :& h)
-> (xs :& h)
-> xs :& h
forall k (f :: k -> Type) (g :: k -> Type) (h :: k -> Type)
       (i :: k -> Type) (xs :: [k]).
(forall (x :: k). f x -> g x -> h x -> i x)
-> (xs :& f) -> (xs :& g) -> (xs :& h) -> xs :& i
hzipWith3 (\(Compose Dict) -> h x -> h x -> h x
forall a. Semigroup a => a -> a -> a
(<>))
    (xs :& Compose Dict (Instance1 Semigroup h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 Semigroup h))
  {-# INLINE (<>) #-}

instance (WrapForall Semigroup h xs, WrapForall Monoid h xs) => Monoid (xs :& h) where
  mempty :: xs :& h
mempty = Proxy (Instance1 Monoid h)
-> (forall (x :: k). Instance1 Monoid h 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 => h x) -> xs :& h
hrepeatFor (Proxy (Instance1 Monoid h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Monoid h)) forall (x :: k). Instance1 Monoid h x => h x
forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}
  mappend :: (xs :& h) -> (xs :& h) -> xs :& h
mappend = (xs :& h) -> (xs :& h) -> xs :& h
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}

instance (WrapForall Eq h xs, WrapForall Hashable h xs) => Hashable (xs :& h) where
  hashWithSalt :: Int -> (xs :& h) -> Int
hashWithSalt = Proxy (Instance1 Hashable h)
-> (forall (x :: k).
    Instance1 Hashable h x =>
    Membership xs x -> Int -> h x -> Int)
-> Int
-> (xs :& h)
-> Int
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) r (h :: k -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> r -> h x -> r)
-> r
-> (xs :& h)
-> r
hfoldlWithIndexFor (Proxy (Instance1 Hashable h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Hashable h))
    ((Int -> h x -> Int) -> Membership xs x -> Int -> h x -> Int
forall a b. a -> b -> a
const Int -> h x -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt)
  {-# INLINE hashWithSalt #-}

instance WrapForall Bounded h xs => Bounded (xs :& h) where
  minBound :: xs :& h
minBound = Proxy (Instance1 Bounded h)
-> (forall (x :: k). Instance1 Bounded h 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 => h x) -> xs :& h
hrepeatFor (Proxy (Instance1 Bounded h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Bounded h)) forall (x :: k). Instance1 Bounded h x => h x
forall a. Bounded a => a
minBound
  maxBound :: xs :& h
maxBound = Proxy (Instance1 Bounded h)
-> (forall (x :: k). Instance1 Bounded h 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 => h x) -> xs :& h
hrepeatFor (Proxy (Instance1 Bounded h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Bounded h)) forall (x :: k). Instance1 Bounded h x => h x
forall a. Bounded a => a
maxBound

instance WrapForall TH.Lift h xs => TH.Lift (xs :& h) where
  lift :: (xs :& h) -> Q Exp
lift = Proxy (Instance1 Lift h)
-> (forall (x :: k).
    Instance1 Lift h x =>
    Membership xs x -> h x -> Q Exp -> Q Exp)
-> Q Exp
-> (xs :& h)
-> Q Exp
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 (Instance1 Lift h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 TH.Lift h))
    (\Membership xs x
_ h x
x Q Exp
xs -> Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ h x -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift h x
x) (Name -> Q Exp
varE '(<:)) (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
xs)) (Name -> Q Exp
varE 'nil)
#if MIN_VERSION_template_haskell(2,17,0) 
  liftTyped e = TH.Code $ TH.TExp <$> TH.lift e
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: (xs :& h) -> Q (TExp (xs :& h))
liftTyped xs :& h
e = Exp -> TExp (xs :& h)
forall a. Exp -> TExp a
TH.TExp (Exp -> TExp (xs :& h)) -> Q Exp -> Q (TExp (xs :& h))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (xs :& h) -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift xs :& h
e
#endif

newtype instance U.MVector s (xs :& h) = MV_Product (xs :& Compose (U.MVector s) h)
newtype instance U.Vector (xs :& h) = V_Product (xs :& Compose U.Vector h)

hlookupC :: Membership xs a -> xs :& Compose f g -> f (g a)
hlookupC :: Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership xs a
i = Compose f g a -> f (g a)
forall k1 (f :: k1 -> Type) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose f g a -> f (g a))
-> ((xs :& Compose f g) -> Compose f g a)
-> (xs :& Compose f g)
-> f (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Membership xs a -> (xs :& Compose f g) -> Compose f g a
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs a
i

instance WrapForall U.Unbox h (x ': xs) => G.Vector U.Vector ((x ': xs) :& h) where
  basicUnsafeFreeze :: Mutable Vector (PrimState m) ((x : xs) :& h)
-> m (Vector ((x : xs) :& h))
basicUnsafeFreeze (MV_Product v) = (((x : xs) :& Compose Vector h) -> Vector ((x : xs) :& h))
-> m ((x : xs) :& Compose Vector h) -> m (Vector ((x : xs) :& h))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x : xs) :& Compose Vector h) -> Vector ((x : xs) :& h)
forall k1 (xs :: [k1]) (h :: k1 -> Type).
(xs :& Compose Vector h) -> Vector (xs :& h)
V_Product
    (m ((x : xs) :& Compose Vector h) -> m (Vector ((x : xs) :& h)))
-> m ((x : xs) :& Compose Vector h) -> m (Vector ((x : xs) :& h))
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose Vector h x))
-> m ((x : xs) :& Compose Vector h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    ((forall (x :: k).
  Instance1 Unbox h x =>
  Membership (x : xs) x -> m (Compose Vector h x))
 -> m ((x : xs) :& Compose Vector h))
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose Vector h x))
-> m ((x : xs) :& Compose Vector h)
forall a b. (a -> b) -> a -> b
$ \Membership (x : xs) x
m -> Vector (h x) -> Compose Vector h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Vector (h x) -> Compose Vector h x)
-> m (Vector (h x)) -> m (Compose Vector h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) (h x) -> m (Vector (h x))
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
m (x : xs) :& Compose (MVector (PrimState m)) h
v)
  basicUnsafeThaw :: Vector ((x : xs) :& h)
-> m (Mutable Vector (PrimState m) ((x : xs) :& h))
basicUnsafeThaw (V_Product v) = (((x : xs) :& Compose (MVector (PrimState m)) h)
 -> MVector (PrimState m) ((x : xs) :& h))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
-> m (MVector (PrimState m) ((x : xs) :& h))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) ((x : xs) :& h)
forall k1 s (xs :: [k1]) (h :: k1 -> Type).
(xs :& Compose (MVector s) h) -> MVector s (xs :& h)
MV_Product
    (m ((x : xs) :& Compose (MVector (PrimState m)) h)
 -> m (MVector (PrimState m) ((x : xs) :& h)))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
-> m (MVector (PrimState m) ((x : xs) :& h))
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    ((forall (x :: k).
  Instance1 Unbox h x =>
  Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
 -> m ((x : xs) :& Compose (MVector (PrimState m)) h))
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
forall a b. (a -> b) -> a -> b
$ \Membership (x : xs) x
m -> MVector (PrimState m) (h x) -> Compose (MVector (PrimState m)) h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (MVector (PrimState m) (h x)
 -> Compose (MVector (PrimState m)) h x)
-> m (MVector (PrimState m) (h x))
-> m (Compose (MVector (PrimState m)) h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (h x) -> m (Mutable Vector (PrimState m) (h x))
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw (Membership (x : xs) x
-> ((x : xs) :& Compose Vector h) -> Vector (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
m (x : xs) :& Compose Vector h
v)
  basicLength :: Vector ((x : xs) :& h) -> Int
basicLength (V_Product v) = Vector (h x) -> Int
forall (v :: Type -> Type) a. Vector v a => v a -> Int
G.basicLength (Vector (h x) -> Int) -> Vector (h x) -> Int
forall a b. (a -> b) -> a -> b
$ Compose Vector h x -> Vector (h x)
forall k1 (f :: k1 -> Type) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose Vector h x -> Vector (h x))
-> Compose Vector h x -> Vector (h x)
forall a b. (a -> b) -> a -> b
$ ((x : xs) :& Compose Vector h)
-> Membership (x : xs) x -> Compose Vector h x
forall k (xs :: [k]) (h :: k -> Type) (x :: k).
(xs :& h) -> Membership xs x -> h x
hindex (x : xs) :& Compose Vector h
v Membership (x : xs) x
forall k (x :: k) (xs :: [k]). Membership (x : xs) x
leadership
  basicUnsafeSlice :: Int -> Int -> Vector ((x : xs) :& h) -> Vector ((x : xs) :& h)
basicUnsafeSlice Int
i Int
n (V_Product v) = ((x : xs) :& Compose Vector h) -> Vector ((x : xs) :& h)
forall k1 (xs :: [k1]) (h :: k1 -> Type).
(xs :& Compose Vector h) -> Vector (xs :& h)
V_Product
    (((x : xs) :& Compose Vector h) -> Vector ((x : xs) :& h))
-> ((x : xs) :& Compose Vector h) -> Vector ((x : xs) :& h)
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> Compose Vector h x)
-> (x : xs) :& Compose Vector 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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    ((forall (x :: k).
  Instance1 Unbox h x =>
  Membership (x : xs) x -> Compose Vector h x)
 -> (x : xs) :& Compose Vector h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> Compose Vector h x)
-> (x : xs) :& Compose Vector h
forall a b. (a -> b) -> a -> b
$ \Membership (x : xs) x
m -> Vector (h x) -> Compose Vector h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Vector (h x) -> Compose Vector h x)
-> Vector (h x) -> Compose Vector h x
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector (h x) -> Vector (h x)
forall (v :: Type -> Type) a.
Vector v a =>
Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i Int
n (Membership (x : xs) x
-> ((x : xs) :& Compose Vector h) -> Vector (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
m (x : xs) :& Compose Vector h
v)
  basicUnsafeIndexM :: Vector ((x : xs) :& h) -> Int -> m ((x : xs) :& h)
basicUnsafeIndexM (V_Product v) Int
i = Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (h x))
-> m ((x : xs) :& h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    ((forall (x :: k).
  Instance1 Unbox h x =>
  Membership (x : xs) x -> m (h x))
 -> m ((x : xs) :& h))
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (h x))
-> m ((x : xs) :& h)
forall a b. (a -> b) -> a -> b
$ \Membership (x : xs) x
m -> Vector (h x) -> Int -> m (h x)
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM (Membership (x : xs) x
-> ((x : xs) :& Compose Vector h) -> Vector (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
m (x : xs) :& Compose Vector h
v) Int
i
  basicUnsafeCopy :: Mutable Vector (PrimState m) ((x : xs) :& h)
-> Vector ((x : xs) :& h) -> m ()
basicUnsafeCopy (MV_Product v) (V_Product w)
    = Proxy (Instance1 Unbox h)
-> Proxy (x : xs)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m () -> m ())
-> m ()
-> m ()
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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy (x : xs)
forall k (t :: k). Proxy t
Proxy :: Proxy (x ': xs)) (m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
(>>) (m () -> m () -> m ())
-> (Membership (x : xs) x -> m ())
-> Membership (x : xs) x
-> m ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Membership (x : xs) x
i -> Mutable Vector (PrimState m) (h x) -> Vector (h x) -> m ()
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v) (Membership (x : xs) x
-> ((x : xs) :& Compose Vector h) -> Vector (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose Vector h
w)) (() -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())

instance WrapForall U.Unbox h (x ': xs) => M.MVector U.MVector ((x ': xs) :& h) where
  basicLength :: MVector s ((x : xs) :& h) -> Int
basicLength (MV_Product v) = MVector s (h x) -> Int
forall (v :: Type -> Type -> Type) a s. MVector v a => v s a -> Int
M.basicLength (MVector s (h x) -> Int) -> MVector s (h x) -> Int
forall a b. (a -> b) -> a -> b
$ Compose (MVector s) h x -> MVector s (h x)
forall k1 (f :: k1 -> Type) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (MVector s) h x -> MVector s (h x))
-> Compose (MVector s) h x -> MVector s (h x)
forall a b. (a -> b) -> a -> b
$ ((x : xs) :& Compose (MVector s) h)
-> Membership (x : xs) x -> Compose (MVector s) h x
forall k (xs :: [k]) (h :: k -> Type) (x :: k).
(xs :& h) -> Membership xs x -> h x
hindex (x : xs) :& Compose (MVector s) h
v Membership (x : xs) x
forall k (x :: k) (xs :: [k]). Membership (x : xs) x
leadership
  basicUnsafeSlice :: Int
-> Int -> MVector s ((x : xs) :& h) -> MVector s ((x : xs) :& h)
basicUnsafeSlice Int
i Int
n (MV_Product v) = ((x : xs) :& Compose (MVector s) h) -> MVector s ((x : xs) :& h)
forall k1 s (xs :: [k1]) (h :: k1 -> Type).
(xs :& Compose (MVector s) h) -> MVector s (xs :& h)
MV_Product
    (((x : xs) :& Compose (MVector s) h) -> MVector s ((x : xs) :& h))
-> ((x : xs) :& Compose (MVector s) h) -> MVector s ((x : xs) :& h)
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> Compose (MVector s) h x)
-> (x : xs) :& Compose (MVector s) 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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    ((forall (x :: k).
  Instance1 Unbox h x =>
  Membership (x : xs) x -> Compose (MVector s) h x)
 -> (x : xs) :& Compose (MVector s) h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> Compose (MVector s) h x)
-> (x : xs) :& Compose (MVector s) h
forall a b. (a -> b) -> a -> b
$ \Membership (x : xs) x
m -> MVector s (h x) -> Compose (MVector s) h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (MVector s (h x) -> Compose (MVector s) h x)
-> MVector s (h x) -> Compose (MVector s) h x
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s (h x) -> MVector s (h x)
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
n (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector s) h) -> MVector s (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
m (x : xs) :& Compose (MVector s) h
v)
  basicOverlaps :: MVector s ((x : xs) :& h) -> MVector s ((x : xs) :& h) -> Bool
basicOverlaps (MV_Product v1) (MV_Product v2) = Proxy (Instance1 Unbox h)
-> Proxy (x : xs)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> Bool -> Bool)
-> Bool
-> Bool
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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy (x : xs)
forall k (t :: k). Proxy t
Proxy :: Proxy (x ': xs))
    (\Membership (x : xs) x
i -> Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> Bool -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MVector s (h x) -> MVector s (h x) -> Bool
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector s) h) -> MVector s (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector s) h
v1) (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector s) h) -> MVector s (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector s) h
v2))
    Bool
False
  basicUnsafeNew :: Int -> m (MVector (PrimState m) ((x : xs) :& h))
basicUnsafeNew Int
n = (((x : xs) :& Compose (MVector (PrimState m)) h)
 -> MVector (PrimState m) ((x : xs) :& h))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
-> m (MVector (PrimState m) ((x : xs) :& h))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) ((x : xs) :& h)
forall k1 s (xs :: [k1]) (h :: k1 -> Type).
(xs :& Compose (MVector s) h) -> MVector s (xs :& h)
MV_Product
    (m ((x : xs) :& Compose (MVector (PrimState m)) h)
 -> m (MVector (PrimState m) ((x : xs) :& h)))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
-> m (MVector (PrimState m) ((x : xs) :& h))
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    (m (Compose (MVector (PrimState m)) h x)
-> Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x)
forall a b. a -> b -> a
const (m (Compose (MVector (PrimState m)) h x)
 -> Membership (x : xs) x
 -> m (Compose (MVector (PrimState m)) h x))
-> m (Compose (MVector (PrimState m)) h x)
-> Membership (x : xs) x
-> m (Compose (MVector (PrimState m)) h x)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) (h x) -> Compose (MVector (PrimState m)) h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (MVector (PrimState m) (h x)
 -> Compose (MVector (PrimState m)) h x)
-> m (MVector (PrimState m) (h x))
-> m (Compose (MVector (PrimState m)) h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) (h x))
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n)
  basicInitialize :: MVector (PrimState m) ((x : xs) :& h) -> m ()
basicInitialize (MV_Product v) = Proxy (Instance1 Unbox h)
-> Proxy (x : xs)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m () -> m ())
-> m ()
-> m ()
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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy (x : xs)
forall k (t :: k). Proxy t
Proxy :: Proxy (x ': xs)) (m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
(>>) (m () -> m () -> m ())
-> (Membership (x : xs) x -> m ())
-> Membership (x : xs) x
-> m ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Membership (x : xs) x
i -> MVector (PrimState m) (h x) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize (MVector (PrimState m) (h x) -> m ())
-> MVector (PrimState m) (h x) -> m ()
forall a b. (a -> b) -> a -> b
$ Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v) (() -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
  basicUnsafeReplicate :: Int -> ((x : xs) :& h) -> m (MVector (PrimState m) ((x : xs) :& h))
basicUnsafeReplicate Int
n (x : xs) :& h
x = (((x : xs) :& Compose (MVector (PrimState m)) h)
 -> MVector (PrimState m) ((x : xs) :& h))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
-> m (MVector (PrimState m) ((x : xs) :& h))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) ((x : xs) :& h)
forall k1 s (xs :: [k1]) (h :: k1 -> Type).
(xs :& Compose (MVector s) h) -> MVector s (xs :& h)
MV_Product
    (m ((x : xs) :& Compose (MVector (PrimState m)) h)
 -> m (MVector (PrimState m) ((x : xs) :& h)))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
-> m (MVector (PrimState m) ((x : xs) :& h))
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    ((forall (x :: k).
  Instance1 Unbox h x =>
  Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
 -> m ((x : xs) :& Compose (MVector (PrimState m)) h))
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
forall a b. (a -> b) -> a -> b
$ \Membership (x : xs) x
m -> (MVector (PrimState m) (h x)
 -> Compose (MVector (PrimState m)) h x)
-> m (MVector (PrimState m) (h x))
-> m (Compose (MVector (PrimState m)) h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) (h x) -> Compose (MVector (PrimState m)) h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (MVector (PrimState m) (h x))
 -> m (Compose (MVector (PrimState m)) h x))
-> m (MVector (PrimState m) (h x))
-> m (Compose (MVector (PrimState m)) h x)
forall a b. (a -> b) -> a -> b
$ Int -> h x -> m (MVector (PrimState m) (h x))
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n (h x -> m (MVector (PrimState m) (h x)))
-> h x -> m (MVector (PrimState m) (h x))
forall a b. (a -> b) -> a -> b
$ Membership (x : xs) x -> ((x : xs) :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership (x : xs) x
m (x : xs) :& h
x
  basicUnsafeRead :: MVector (PrimState m) ((x : xs) :& h) -> Int -> m ((x : xs) :& h)
basicUnsafeRead (MV_Product v) Int
i = Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (h x))
-> m ((x : xs) :& h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    (\Membership (x : xs) x
m -> MVector (PrimState m) (h x) -> Int -> m (h x)
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
m (x : xs) :& Compose (MVector (PrimState m)) h
v) Int
i)
  basicUnsafeWrite :: MVector (PrimState m) ((x : xs) :& h)
-> Int -> ((x : xs) :& h) -> m ()
basicUnsafeWrite (MV_Product v) Int
i (x : xs) :& h
x = Proxy (Instance1 Unbox h)
-> Proxy (x : xs)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m () -> m ())
-> m ()
-> m ()
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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy (x : xs)
forall k (t :: k). Proxy t
Proxy :: Proxy (x ': xs)) (m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
(>>) (m () -> m () -> m ())
-> (Membership (x : xs) x -> m ())
-> Membership (x : xs) x
-> m ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Membership (x : xs) x
m -> MVector (PrimState m) (h x) -> Int -> h x -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
m (x : xs) :& Compose (MVector (PrimState m)) h
v) Int
i (Membership (x : xs) x -> ((x : xs) :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership (x : xs) x
m (x : xs) :& h
x)) (() -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
  basicClear :: MVector (PrimState m) ((x : xs) :& h) -> m ()
basicClear (MV_Product v) = Proxy (Instance1 Unbox h)
-> Proxy (x : xs)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m () -> m ())
-> m ()
-> m ()
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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy (x : xs)
forall k (t :: k). Proxy t
Proxy :: Proxy (x ': xs)) (m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
(>>) (m () -> m () -> m ())
-> (Membership (x : xs) x -> m ())
-> Membership (x : xs) x
-> m ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Membership (x : xs) x
i -> MVector (PrimState m) (h x) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear (MVector (PrimState m) (h x) -> m ())
-> MVector (PrimState m) (h x) -> m ()
forall a b. (a -> b) -> a -> b
$ Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v) (() -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
  basicSet :: MVector (PrimState m) ((x : xs) :& h) -> ((x : xs) :& h) -> m ()
basicSet (MV_Product v) (x : xs) :& h
x = Proxy (Instance1 Unbox h)
-> Proxy (x : xs)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m () -> m ())
-> m ()
-> m ()
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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy (x : xs)
forall k (t :: k). Proxy t
Proxy :: Proxy (x ': xs)) (m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
(>>) (m () -> m () -> m ())
-> (Membership (x : xs) x -> m ())
-> Membership (x : xs) x
-> m ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Membership (x : xs) x
i -> MVector (PrimState m) (h x) -> h x -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v) (Membership (x : xs) x -> ((x : xs) :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership (x : xs) x
i (x : xs) :& h
x)) (() -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
  basicUnsafeCopy :: MVector (PrimState m) ((x : xs) :& h)
-> MVector (PrimState m) ((x : xs) :& h) -> m ()
basicUnsafeCopy (MV_Product v1) (MV_Product v2)
    = Proxy (Instance1 Unbox h)
-> Proxy (x : xs)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m () -> m ())
-> m ()
-> m ()
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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy (x : xs)
forall k (t :: k). Proxy t
Proxy :: Proxy (x ': xs)) (m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
(>>) (m () -> m () -> m ())
-> (Membership (x : xs) x -> m ())
-> Membership (x : xs) x
-> m ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Membership (x : xs) x
i -> MVector (PrimState m) (h x) -> MVector (PrimState m) (h x) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v1) (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v2)) (() -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
  basicUnsafeMove :: MVector (PrimState m) ((x : xs) :& h)
-> MVector (PrimState m) ((x : xs) :& h) -> m ()
basicUnsafeMove (MV_Product v1) (MV_Product v2)
    = Proxy (Instance1 Unbox h)
-> Proxy (x : xs)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m () -> m ())
-> m ()
-> m ()
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 (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy (x : xs)
forall k (t :: k). Proxy t
Proxy :: Proxy (x ': xs)) (m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
(>>) (m () -> m () -> m ())
-> (Membership (x : xs) x -> m ())
-> Membership (x : xs) x
-> m ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Membership (x : xs) x
i -> MVector (PrimState m) (h x) -> MVector (PrimState m) (h x) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v1) (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v2)) (() -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
  basicUnsafeGrow :: MVector (PrimState m) ((x : xs) :& h)
-> Int -> m (MVector (PrimState m) ((x : xs) :& h))
basicUnsafeGrow (MV_Product v) Int
n = (((x : xs) :& Compose (MVector (PrimState m)) h)
 -> MVector (PrimState m) ((x : xs) :& h))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
-> m (MVector (PrimState m) ((x : xs) :& h))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) ((x : xs) :& h)
forall k1 s (xs :: [k1]) (h :: k1 -> Type).
(xs :& Compose (MVector s) h) -> MVector s (xs :& h)
MV_Product
    (m ((x : xs) :& Compose (MVector (PrimState m)) h)
 -> m (MVector (PrimState m) ((x : xs) :& h)))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
-> m (MVector (PrimState m) ((x : xs) :& h))
forall a b. (a -> b) -> a -> b
$ Proxy (Instance1 Unbox h)
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 Unbox h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 U.Unbox h))
    ((forall (x :: k).
  Instance1 Unbox h x =>
  Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
 -> m ((x : xs) :& Compose (MVector (PrimState m)) h))
-> (forall (x :: k).
    Instance1 Unbox h x =>
    Membership (x : xs) x -> m (Compose (MVector (PrimState m)) h x))
-> m ((x : xs) :& Compose (MVector (PrimState m)) h)
forall a b. (a -> b) -> a -> b
$ \Membership (x : xs) x
i -> MVector (PrimState m) (h x) -> Compose (MVector (PrimState m)) h x
forall k k1 (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (MVector (PrimState m) (h x)
 -> Compose (MVector (PrimState m)) h x)
-> m (MVector (PrimState m) (h x))
-> m (Compose (MVector (PrimState m)) h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (h x)
-> Int -> m (MVector (PrimState m) (h x))
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow (Membership (x : xs) x
-> ((x : xs) :& Compose (MVector (PrimState m)) h)
-> MVector (PrimState m) (h x)
forall k k (xs :: [k]) (a :: k) (f :: k -> Type) (g :: k -> k).
Membership xs a -> (xs :& Compose f g) -> f (g a)
hlookupC Membership (x : xs) x
i (x : xs) :& Compose (MVector (PrimState m)) h
v) Int
n

instance WrapForall U.Unbox h (x ': xs) => U.Unbox ((x ': xs) :& h)

instance WrapForall Arbitrary h xs => Arbitrary (xs :& h) where
  arbitrary :: Gen (xs :& h)
arbitrary = Proxy (Instance1 Arbitrary h)
-> (forall (x :: k).
    Instance1 Arbitrary h x =>
    Membership xs x -> Gen (h x))
-> Gen (xs :& h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 Arbitrary h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Arbitrary h)) (Gen (h x) -> Membership xs x -> Gen (h x)
forall a b. a -> b -> a
const Gen (h x)
forall a. Arbitrary a => Gen a
arbitrary)
  shrink :: (xs :& h) -> [xs :& h]
shrink xs :& h
xs = Proxy (Instance1 Arbitrary h)
-> Proxy xs
-> (forall (x :: k).
    Instance1 Arbitrary h x =>
    Membership xs x -> [xs :& h] -> [xs :& h])
-> [xs :& h]
-> [xs :& h]
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 (Instance1 Arbitrary h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Arbitrary h))
    (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs) (\Membership xs x
i -> [xs :& h] -> [xs :& h] -> [xs :& h]
forall a. [a] -> [a] -> [a]
(++)
    ([xs :& h] -> [xs :& h] -> [xs :& h])
-> [xs :& h] -> [xs :& h] -> [xs :& h]
forall a b. (a -> b) -> a -> b
$ (h x -> xs :& h) -> [h x] -> [xs :& h]
forall a b. (a -> b) -> [a] -> [b]
map (\h x
x -> (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 -> 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
x) xs :& h
xs) ([h x] -> [xs :& h]) -> [h x] -> [xs :& h]
forall a b. (a -> b) -> a -> b
$ h x -> [h x]
forall a. Arbitrary a => a -> [a]
shrink (h x -> [h x]) -> h x -> [h x]
forall a b. (a -> b) -> a -> b
$ (xs :& h) -> Membership xs x -> h x
forall k (xs :: [k]) (h :: k -> Type) (x :: k).
(xs :& h) -> Membership xs x -> h x
hindex xs :& h
xs Membership xs x
i)
    []

instance WrapForall NFData h xs => NFData (xs :& h) where
  rnf :: (xs :& h) -> ()
rnf xs :& h
xs = Proxy (Instance1 NFData h)
-> Proxy xs
-> (forall (x :: k).
    Instance1 NFData h x =>
    Membership xs x -> () -> ())
-> ()
-> ()
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 (Instance1 NFData h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 NFData h)) (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
    (\Membership xs x
i -> h x -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq (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)) ()
  {-# INLINE rnf #-}

#ifdef CASSAVA
instance WrapForall Csv.FromField h xs => Csv.FromRecord (xs :& h) where
  parseRecord :: Record -> Parser (xs :& h)
parseRecord Record
rec = Proxy (Instance1 FromField h)
-> (forall (x :: k).
    Instance1 FromField h x =>
    Membership xs x -> Parser (h x))
-> Parser (xs :& h)
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 (xs :& h)
hgenerateFor (Proxy (Instance1 FromField h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Csv.FromField h))
    ((forall (x :: k).
  Instance1 FromField h x =>
  Membership xs x -> Parser (h x))
 -> Parser (xs :& h))
-> (forall (x :: k).
    Instance1 FromField h x =>
    Membership xs x -> Parser (h x))
-> Parser (xs :& h)
forall a b. (a -> b) -> a -> b
$ \Membership xs x
i -> Record -> Int -> Parser Field
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.indexM Record
rec (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId Membership xs x
i) Parser Field -> (Field -> Parser (h x)) -> Parser (h x)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field -> Parser (h x)
forall a. FromField a => Field -> Parser a
Csv.parseField

instance Forall (KeyTargetAre KnownSymbol (Instance1 Csv.FromField h)) xs => Csv.FromNamedRecord (xs :& Field h) where
  parseNamedRecord :: NamedRecord -> Parser (xs :& Field h)
parseNamedRecord NamedRecord
rec = Proxy (KeyTargetAre KnownSymbol (Instance1 FromField h))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 FromField h) x =>
    Membership xs x -> Parser (Field h x))
-> Parser (xs :& Field h)
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 (xs :& h)
hgenerateFor (Proxy (KeyTargetAre KnownSymbol (Instance1 FromField h))
forall k (t :: k). Proxy t
Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 Csv.FromField h)))
    ((forall (x :: Assoc Symbol v).
  KeyTargetAre KnownSymbol (Instance1 FromField h) x =>
  Membership xs x -> Parser (Field h x))
 -> Parser (xs :& Field h))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 FromField h) x =>
    Membership xs x -> Parser (Field h x))
-> Parser (xs :& Field h)
forall a b. (a -> b) -> a -> b
$ \Membership xs x
i -> NamedRecord
rec NamedRecord -> Field -> Parser Field
forall a. FromField a => NamedRecord -> Field -> Parser a
Csv..: String -> Field
BC.pack (Proxy (KeyOf x) -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Membership xs x -> Proxy (KeyOf x)
forall k v (proxy :: Assoc k v -> Type) (kv :: Assoc k v).
proxy kv -> Proxy (KeyOf kv)
proxyKeyOf Membership xs x
i)) Parser Field -> (Field -> Parser (Field h x)) -> Parser (Field h x)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field -> Parser (Field h x)
forall a. FromField a => Field -> Parser a
Csv.parseField

instance WrapForall Csv.ToField h xs => Csv.ToRecord (xs :& h) where
  toRecord :: (xs :& h) -> Record
toRecord = [Field] -> Record
forall a. [a] -> Vector a
V.fromList
    ([Field] -> Record)
-> ((xs :& h) -> [Field]) -> (xs :& h) -> Record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (Instance1 ToField h)
-> (forall (x :: k).
    Instance1 ToField h x =>
    Membership xs x -> h x -> [Field] -> [Field])
-> [Field]
-> (xs :& h)
-> [Field]
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 (Instance1 ToField h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Csv.ToField h))
      (\Membership xs x
_ h x
v -> (:) (Field -> [Field] -> [Field]) -> Field -> [Field] -> [Field]
forall a b. (a -> b) -> a -> b
$ h x -> Field
forall a. ToField a => a -> Field
Csv.toField h x
v) []

instance Forall (KeyTargetAre KnownSymbol (Instance1 Csv.ToField h)) xs => Csv.ToNamedRecord (xs :& Field h) where
  toNamedRecord :: (xs :& Field h) -> NamedRecord
toNamedRecord = Proxy (KeyTargetAre KnownSymbol (Instance1 ToField h))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 ToField h) x =>
    Membership xs x -> NamedRecord -> Field h x -> NamedRecord)
-> NamedRecord
-> (xs :& Field h)
-> NamedRecord
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) r (h :: k -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> r -> h x -> r)
-> r
-> (xs :& h)
-> r
hfoldlWithIndexFor (Proxy (KeyTargetAre KnownSymbol (Instance1 ToField h))
forall k (t :: k). Proxy t
Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 Csv.ToField h)))
    (\Membership xs x
k NamedRecord
m Field h x
v -> Field -> Field -> NamedRecord -> NamedRecord
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (String -> Field
BC.pack (Proxy (KeyOf x) -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Membership xs x -> Proxy (KeyOf x)
forall k v (proxy :: Assoc k v -> Type) (kv :: Assoc k v).
proxy kv -> Proxy (KeyOf kv)
proxyKeyOf Membership xs x
k))) (Field h x -> Field
forall a. ToField a => a -> Field
Csv.toField Field h x
v) NamedRecord
m)
    NamedRecord
forall k v. HashMap k v
HM.empty

instance Forall (KeyIs KnownSymbol) xs => Csv.DefaultOrdered (RecordOf h xs) where
  headerOrder :: RecordOf h xs -> Record
headerOrder RecordOf h xs
_ = [Field] -> Record
forall a. [a] -> Vector a
V.fromList ([Field] -> Record) -> [Field] -> Record
forall a b. (a -> b) -> a -> b
$ Proxy (KeyIs KnownSymbol)
-> Proxy xs
-> (forall (x :: Assoc Symbol v).
    KeyIs KnownSymbol x =>
    Membership xs x -> [Field] -> [Field])
-> [Field]
-> [Field]
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
    (forall v. Proxy (KeyIs KnownSymbol)
forall k (t :: k). Proxy t
Proxy :: Proxy (KeyIs KnownSymbol))
    (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
    (\Membership xs x
k [Field]
r -> Membership xs x -> Field
forall v a (kv :: Assoc Symbol v)
       (proxy :: Assoc Symbol v -> Type).
(IsString a, KnownSymbol (KeyOf kv)) =>
proxy kv -> a
stringKeyOf Membership xs x
k Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
: [Field]
r) []
#endif

-- | @'parseJSON' 'J.Null'@ is called for missing fields.
instance Forall (KeyTargetAre KnownSymbol (Instance1 J.FromJSON h)) xs => J.FromJSON (xs :& Field h) where
  parseJSON :: Value -> Parser (xs :& Field h)
parseJSON = String
-> (Object -> Parser (xs :& Field h))
-> Value
-> Parser (xs :& Field h)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"Object" ((Object -> Parser (xs :& Field h))
 -> Value -> Parser (xs :& Field h))
-> (Object -> Parser (xs :& Field h))
-> Value
-> Parser (xs :& Field h)
forall a b. (a -> b) -> a -> b
$ \Object
v -> Proxy (KeyTargetAre KnownSymbol (Instance1 FromJSON h))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 FromJSON h) x =>
    Membership xs x -> Parser (Field h x))
-> Parser (xs :& Field h)
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 (xs :& h)
hgenerateFor
    (Proxy (KeyTargetAre KnownSymbol (Instance1 FromJSON h))
forall k (t :: k). Proxy t
Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 J.FromJSON h)))
    ((forall (x :: Assoc Symbol v).
  KeyTargetAre KnownSymbol (Instance1 FromJSON h) x =>
  Membership xs x -> Parser (Field h x))
 -> Parser (xs :& Field h))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 FromJSON h) x =>
    Membership xs x -> Parser (Field h x))
-> Parser (xs :& Field h)
forall a b. (a -> b) -> a -> b
$ \Membership xs x
m -> let k :: Key
k = Membership xs x -> Key
forall v a (kv :: Assoc Symbol v)
       (proxy :: Assoc Symbol v -> Type).
(IsString a, KnownSymbol (KeyOf kv)) =>
proxy kv -> a
stringKeyOf Membership xs x
m
      in (h (TargetOf x) -> Field h x)
-> Parser (h (TargetOf x)) -> Parser (Field h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap h (TargetOf x) -> Field h x
forall v k (h :: v -> Type) (kv :: Assoc k v).
h (TargetOf kv) -> Field h kv
Field (Parser (h (TargetOf x)) -> Parser (Field h x))
-> Parser (h (TargetOf x)) -> Parser (Field h x)
forall a b. (a -> b) -> a -> b
$ String -> Parser (h (TargetOf x)) -> Parser (h (TargetOf x))
forall a. String -> Parser a -> Parser a
J.prependFailure (String
"parsing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ") (Parser (h (TargetOf x)) -> Parser (h (TargetOf x)))
-> Parser (h (TargetOf x)) -> Parser (h (TargetOf x))
forall a b. (a -> b) -> a -> b
$ Value -> Parser (h (TargetOf x))
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Value -> Parser (h (TargetOf x)))
-> Value -> Parser (h (TargetOf x))
forall a b. (a -> b) -> a -> b
$ Value -> (Value -> Value) -> Maybe Value -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
J.Null Value -> Value
forall a. a -> a
id (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
k Object
v

instance Forall (KeyTargetAre KnownSymbol (Instance1 J.ToJSON h)) xs => J.ToJSON (xs :& Field h) where
  toJSON :: (xs :& Field h) -> Value
toJSON = Object -> Value
J.Object (Object -> Value)
-> ((xs :& Field h) -> Object) -> (xs :& Field h) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (KeyTargetAre KnownSymbol (Instance1 ToJSON h))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 ToJSON h) x =>
    Membership xs x -> Object -> Field h x -> Object)
-> Object
-> (xs :& Field h)
-> Object
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) r (h :: k -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> r -> h x -> r)
-> r
-> (xs :& h)
-> r
hfoldlWithIndexFor
    (Proxy (KeyTargetAre KnownSymbol (Instance1 ToJSON h))
forall k (t :: k). Proxy t
Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 J.ToJSON h)))
    (\Membership xs x
k Object
m Field h x
v -> Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert (Membership xs x -> Key
forall v a (kv :: Assoc Symbol v)
       (proxy :: Assoc Symbol v -> Type).
(IsString a, KnownSymbol (KeyOf kv)) =>
proxy kv -> a
stringKeyOf Membership xs x
k) (Field h x -> Value
forall a. ToJSON a => a -> Value
J.toJSON Field h x
v) Object
m)
    Object
forall v. KeyMap v
KM.empty

instance Forall (KeyTargetAre KnownSymbol (Instance1 J.FromJSON h)) xs => J.FromJSON (xs :& Nullable (Field h)) where
  parseJSON :: Value -> Parser (xs :& Nullable (Field h))
parseJSON = String
-> (Object -> Parser (xs :& Nullable (Field h)))
-> Value
-> Parser (xs :& Nullable (Field h))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"Object" ((Object -> Parser (xs :& Nullable (Field h)))
 -> Value -> Parser (xs :& Nullable (Field h)))
-> (Object -> Parser (xs :& Nullable (Field h)))
-> Value
-> Parser (xs :& Nullable (Field h))
forall a b. (a -> b) -> a -> b
$ \Object
v -> Proxy (KeyTargetAre KnownSymbol (Instance1 FromJSON h))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 FromJSON h) x =>
    Membership xs x -> Parser (Nullable (Field h) x))
-> Parser (xs :& Nullable (Field h))
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 (xs :& h)
hgenerateFor
    (Proxy (KeyTargetAre KnownSymbol (Instance1 FromJSON h))
forall k (t :: k). Proxy t
Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 J.FromJSON h)))
    ((forall (x :: Assoc Symbol v).
  KeyTargetAre KnownSymbol (Instance1 FromJSON h) x =>
  Membership xs x -> Parser (Nullable (Field h) x))
 -> Parser (xs :& Nullable (Field h)))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 FromJSON h) x =>
    Membership xs x -> Parser (Nullable (Field h) x))
-> Parser (xs :& Nullable (Field h))
forall a b. (a -> b) -> a -> b
$ \Membership xs x
m -> let k :: Key
k = Membership xs x -> Key
forall v a (kv :: Assoc Symbol v)
       (proxy :: Assoc Symbol v -> Type).
(IsString a, KnownSymbol (KeyOf kv)) =>
proxy kv -> a
stringKeyOf Membership xs x
m
      in (Maybe (Field h x) -> Nullable (Field h) x)
-> Parser (Maybe (Field h x)) -> Parser (Nullable (Field h) x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Field h x) -> Nullable (Field h) x
forall k (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable (Parser (Maybe (Field h x)) -> Parser (Nullable (Field h) x))
-> Parser (Maybe (Field h x)) -> Parser (Nullable (Field h) x)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser (Field h x))
-> Maybe Value -> Parser (Maybe (Field h x))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser (Field h x)
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Maybe Value -> Parser (Maybe (Field h x)))
-> Maybe Value -> Parser (Maybe (Field h x))
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
k Object
v

instance Forall (KeyTargetAre KnownSymbol (Instance1 J.ToJSON h)) xs => J.ToJSON (xs :& Nullable (Field h)) where
  toJSON :: (xs :& Nullable (Field h)) -> Value
toJSON = Object -> Value
J.Object (Object -> Value)
-> ((xs :& Nullable (Field h)) -> Object)
-> (xs :& Nullable (Field h))
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (KeyTargetAre KnownSymbol (Instance1 ToJSON h))
-> (forall (x :: Assoc Symbol v).
    KeyTargetAre KnownSymbol (Instance1 ToJSON h) x =>
    Membership xs x -> Object -> Nullable (Field h) x -> Object)
-> Object
-> (xs :& Nullable (Field h))
-> Object
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> Type) r (h :: k -> Type).
Forall c xs =>
proxy c
-> (forall (x :: k). c x => Membership xs x -> r -> h x -> r)
-> r
-> (xs :& h)
-> r
hfoldlWithIndexFor
    (Proxy (KeyTargetAre KnownSymbol (Instance1 ToJSON h))
forall k (t :: k). Proxy t
Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 J.ToJSON h)))
    (\Membership xs x
k Object
m (Nullable v) -> (Object -> Object)
-> (Field h x -> Object -> Object)
-> Maybe (Field h x)
-> Object
-> Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object -> Object
forall a. a -> a
id (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert (Membership xs x -> Key
forall v a (kv :: Assoc Symbol v)
       (proxy :: Assoc Symbol v -> Type).
(IsString a, KnownSymbol (KeyOf kv)) =>
proxy kv -> a
stringKeyOf Membership xs x
k) (Value -> Object -> Object)
-> (Field h x -> Value) -> Field h x -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field h x -> Value
forall a. ToJSON a => a -> Value
J.toJSON) Maybe (Field h x)
v Object
m)
    Object
forall v. KeyMap v
KM.empty

instance WrapForall Show h xs => Show (xs :/ h) where
  showsPrec :: Int -> (xs :/ h) -> ShowS
showsPrec Int
d (EmbedAt Membership xs x
i h x
h) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"EmbedAt "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Membership xs x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Membership xs x
i
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic'
  (->)
  (Const ShowS)
  (xs :& Compose Dict (Instance1 Show h))
  (Compose Dict (Instance1 Show h) x)
-> (Compose Dict (Instance1 Show h) x -> ShowS)
-> (xs :& Compose Dict (Instance1 Show h))
-> ShowS
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership xs x
-> Optic'
     (->)
     (Const ShowS)
     (xs :& Compose Dict (Instance1 Show h))
     (Compose Dict (Instance1 Show h) x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership xs x
i) (\(Compose Dict (Instance1 Show h x)
Dict) -> Int -> h x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 h x
h) (xs :& Compose Dict (Instance1 Show h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 Show h))

instance WrapForall Eq h xs => Eq (xs :/ h) where
  EmbedAt Membership xs x
p h x
g == :: (xs :/ h) -> (xs :/ h) -> Bool
== EmbedAt Membership xs x
q h x
h = case Membership xs x -> Membership xs x -> Either Ordering (x :~: x)
forall k (xs :: [k]) (x :: k) (y :: k).
Membership xs x -> Membership xs y -> Either Ordering (x :~: y)
compareMembership Membership xs x
p Membership xs x
q of
    Left Ordering
_ -> Bool
False
    Right x :~: x
Refl -> Optic'
  (->)
  (Const Bool)
  (xs :& Compose Dict (Instance1 Eq h))
  (Compose Dict (Instance1 Eq h) x)
-> (Compose Dict (Instance1 Eq h) x -> Bool)
-> (xs :& Compose Dict (Instance1 Eq h))
-> Bool
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership xs x
-> Optic'
     (->)
     (Const Bool)
     (xs :& Compose Dict (Instance1 Eq h))
     (Compose Dict (Instance1 Eq h) x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership xs x
p) (\(Compose Dict (Instance1 Eq h x)
Dict) -> h x
g h x -> h x -> Bool
forall a. Eq a => a -> a -> Bool
== h x
h x
h) (xs :& Compose Dict (Instance1 Eq h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 Eq h))
  {-# INLINE (==) #-}

instance (Eq (xs :/ h), WrapForall Ord h xs) => Ord (xs :/ h) where
  EmbedAt Membership xs x
p h x
g compare :: (xs :/ h) -> (xs :/ h) -> Ordering
`compare` EmbedAt Membership xs x
q h x
h = case Membership xs x -> Membership xs x -> Either Ordering (x :~: x)
forall k (xs :: [k]) (x :: k) (y :: k).
Membership xs x -> Membership xs y -> Either Ordering (x :~: y)
compareMembership Membership xs x
p Membership xs x
q of
    Left Ordering
x -> Ordering
x
    Right x :~: x
Refl -> Optic'
  (->)
  (Const Ordering)
  (xs :& Compose Dict (Instance1 Ord h))
  (Compose Dict (Instance1 Ord h) x)
-> (Compose Dict (Instance1 Ord h) x -> Ordering)
-> (xs :& Compose Dict (Instance1 Ord h))
-> Ordering
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership xs x
-> Optic'
     (->)
     (Const Ordering)
     (xs :& Compose Dict (Instance1 Ord h))
     (Compose Dict (Instance1 Ord h) x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership xs x
p) (\(Compose Dict (Instance1 Ord h x)
Dict) -> h x -> h x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare h x
g h x
h x
h) (xs :& Compose Dict (Instance1 Ord h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 Ord h))
  {-# INLINE compare #-}

instance WrapForall NFData h xs => NFData (xs :/ h) where
  rnf :: (xs :/ h) -> ()
rnf (EmbedAt Membership xs x
i h x
h) = Optic'
  (->)
  (Const ())
  (xs :& Compose Dict (Instance1 NFData h))
  (Compose Dict (Instance1 NFData h) x)
-> (Compose Dict (Instance1 NFData h) x -> ())
-> (xs :& Compose Dict (Instance1 NFData h))
-> ()
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership xs x
-> Optic'
     (->)
     (Const ())
     (xs :& Compose Dict (Instance1 NFData h))
     (Compose Dict (Instance1 NFData h) x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership xs x
i) (\(Compose Dict (Instance1 NFData h x)
Dict) -> h x -> ()
forall a. NFData a => a -> ()
rnf h x
h) (xs :& Compose Dict (Instance1 NFData h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 NFData h))
  {-# INLINE rnf #-}

instance (WrapForall Eq h xs, WrapForall Hashable h xs) => Hashable (xs :/ h) where
  hashWithSalt :: Int -> (xs :/ h) -> Int
hashWithSalt Int
s (EmbedAt Membership xs x
i h x
h) = Optic'
  (->)
  (Const Int)
  (xs :& Compose Dict (Instance1 Hashable h))
  (Compose Dict (Instance1 Hashable h) x)
-> (Compose Dict (Instance1 Hashable h) x -> Int)
-> (xs :& Compose Dict (Instance1 Hashable h))
-> Int
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership xs x
-> Optic'
     (->)
     (Const Int)
     (xs :& Compose Dict (Instance1 Hashable h))
     (Compose Dict (Instance1 Hashable h) x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership xs x
i)
    (\(Compose Dict (Instance1 Hashable h x)
Dict) -> Int
s Int -> Membership xs x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Membership xs x
i Int -> h x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` h x
h)
    (xs :& Compose Dict (Instance1 Hashable h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 Hashable h))
  {-# INLINE hashWithSalt #-}

instance WrapForall TH.Lift h xs => TH.Lift (xs :/ h) where
  lift :: (xs :/ h) -> Q Exp
lift (EmbedAt Membership xs x
i h x
h) = Optic'
  (->)
  (Const (Q Exp))
  (xs :& Compose Dict (Instance1 Lift h))
  (Compose Dict (Instance1 Lift h) x)
-> (Compose Dict (Instance1 Lift h) x -> Q Exp)
-> (xs :& Compose Dict (Instance1 Lift h))
-> Q Exp
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership xs x
-> Optic'
     (->)
     (Const (Q Exp))
     (xs :& Compose Dict (Instance1 Lift h))
     (Compose Dict (Instance1 Lift h) x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership xs x
i)
    (\(Compose Dict (Instance1 Lift h x)
Dict) -> Name -> Q Exp
conE 'EmbedAt Q Exp -> Q Exp -> Q Exp
`appE` Membership xs x -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift Membership xs x
i Q Exp -> Q Exp -> Q Exp
`appE` h x -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift h x
h)
    (xs :& Compose Dict (Instance1 Lift h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 TH.Lift h))
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped e = TH.Code $ TH.TExp <$> TH.lift e
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: (xs :/ h) -> Q (TExp (xs :/ h))
liftTyped xs :/ h
e = Exp -> TExp (xs :/ h)
forall a. Exp -> TExp a
TH.TExp (Exp -> TExp (xs :/ h)) -> Q Exp -> Q (TExp (xs :/ h))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (xs :/ h) -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift xs :/ h
e
#endif

instance WrapForall Arbitrary h xs => Arbitrary (xs :/ h) where
  arbitrary :: Gen (xs :/ h)
arbitrary = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Proxy xs -> Int
forall k (xs :: [k]) (proxy :: [k] -> Type).
Generate xs =>
proxy xs -> Int
hcount (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)) Gen Int -> (Int -> Gen (xs :/ h)) -> Gen (xs :/ h)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proxy (Instance1 Arbitrary h)
-> Proxy xs
-> (forall (x :: k).
    Instance1 Arbitrary h x =>
    Membership xs x -> (Int -> Gen (xs :/ h)) -> Int -> Gen (xs :/ h))
-> (Int -> Gen (xs :/ h))
-> Int
-> Gen (xs :/ h)
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 (Instance1 Arbitrary h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Arbitrary h))
      (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
      (\Membership xs x
m Int -> Gen (xs :/ h)
r Int
i -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Membership xs x -> h x -> xs :/ h
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> h x -> xs :/ h
EmbedAt Membership xs x
m (h x -> xs :/ h) -> Gen (h x) -> Gen (xs :/ h)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (h x)
forall a. Arbitrary a => Gen a
arbitrary
        else Int -> Gen (xs :/ h)
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        (String -> Int -> Gen (xs :/ h)
forall a. HasCallStack => String -> a
error String
"Impossible")
  shrink :: (xs :/ h) -> [xs :/ h]
shrink (EmbedAt Membership xs x
i h x
h) = Optic'
  (->)
  (Const [xs :/ h])
  (xs :& Compose Dict (Instance1 Arbitrary h))
  (Compose Dict (Instance1 Arbitrary h) x)
-> (Compose Dict (Instance1 Arbitrary h) x -> [xs :/ h])
-> (xs :& Compose Dict (Instance1 Arbitrary h))
-> [xs :/ h]
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership xs x
-> Optic'
     (->)
     (Const [xs :/ h])
     (xs :& Compose Dict (Instance1 Arbitrary h))
     (Compose Dict (Instance1 Arbitrary h) x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership xs x
i)
    (\(Compose Dict (Instance1 Arbitrary h x)
Dict) -> Membership xs x -> h x -> xs :/ h
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> h x -> xs :/ h
EmbedAt Membership xs x
i (h x -> xs :/ h) -> [h x] -> [xs :/ h]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> h x -> [h x]
forall a. Arbitrary a => a -> [a]
shrink h x
h)
    (xs :& Compose Dict (Instance1 Arbitrary h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 Arbitrary h))

instance WrapForall Pretty h xs => Pretty (xs :/ h) where
  pretty :: (xs :/ h) -> Doc ann
pretty (EmbedAt Membership xs x
i h x
h) = Doc ann
"EmbedAt "
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Membership xs x -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Membership xs x
i
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" "
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Optic'
  (->)
  (Const (Doc ann))
  (xs :& Compose Dict (Instance1 Pretty h))
  (Compose Dict (Instance1 Pretty h) x)
-> (Compose Dict (Instance1 Pretty h) x -> Doc ann)
-> (xs :& Compose Dict (Instance1 Pretty h))
-> Doc ann
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership xs x
-> Optic'
     (->)
     (Const (Doc ann))
     (xs :& Compose Dict (Instance1 Pretty h))
     (Compose Dict (Instance1 Pretty h) x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership xs x
i) (\(Compose Dict (Instance1 Pretty h x)
Dict) -> h x -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty h x
h)
    (xs :& Compose Dict (Instance1 Pretty h)
forall k1 (c :: k1 -> Constraint) (xs :: [k1]).
Forall c xs =>
xs :& Compose Dict c
library :: xs :& Compose Dict (Instance1 Pretty h))

-- | Forall upon a wrapper
type WrapForall c h = Forall (Instance1 c h)

-- | Composition for a class and a wrapper
class c (h x) => Instance1 c h x
instance c (h x) => Instance1 c h x

#ifdef BARBIES
instance FunctorB ((:&) xs) where
  bmap = hmap

instance FunctorB ((:/) xs) where
  bmap = hoist

instance TraversableB ((:&) xs) where
  btraverse = htraverse

instance TraversableB ((:/) xs) where
  btraverse f (EmbedAt i x) = EmbedAt i <$> f x

instance Generate xs => ApplicativeB ((:&) xs) where
  bprod = hzipWith Pair
  bpure = hrepeat

instance ConstraintsB ((:&) xs) where
  type AllB c ((:&) xs) = Forall c xs
  baddDicts = bprod bdicts

instance ConstraintsB ((:/) xs) where
  type AllB c ((:/) xs) = Forall c xs
  baddDicts (EmbedAt i x) = EmbedAt i (Pair (hlookup i bdicts) x)

#endif

instance WrapForall Incremental h xs => Incremental (xs :& h) where
  type Delta (xs :& h) = xs :& WrapDelta h
  patch :: (xs :& h) -> Delta (xs :& h) -> xs :& h
patch xs :& h
r =
    Proxy (Instance1 Incremental h)
-> (forall (x :: k).
    Instance1 Incremental h x =>
    Membership xs x -> WrapDelta h x -> h x)
-> (xs :& WrapDelta h)
-> 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 (Instance1 Incremental h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Incremental h))
      (\Membership xs x
i (WrapDelta d) -> h x -> (Delta (h x) -> h x) -> Maybe (Delta (h x)) -> h x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
r) (h x -> Delta (h x) -> h x
forall a. Incremental a => a -> Delta a -> a
patch (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
r)) Maybe (Delta (h x))
d)
  diff :: (xs :& h) -> (xs :& h) -> Maybe (Delta (xs :& h))
diff xs :& h
r =
    (xs :& WrapDelta h) -> Maybe (xs :& WrapDelta h)
forall k (xs :: [k]) (h :: k -> Type).
(xs :& WrapDelta h) -> Maybe (xs :& WrapDelta h)
check
      ((xs :& WrapDelta h) -> Maybe (xs :& WrapDelta h))
-> ((xs :& h) -> xs :& WrapDelta h)
-> (xs :& h)
-> Maybe (xs :& WrapDelta h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (Instance1 Incremental h)
-> (forall (x :: k).
    Instance1 Incremental h x =>
    Membership xs x -> h x -> WrapDelta h x)
-> (xs :& h)
-> xs :& WrapDelta 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 (Instance1 Incremental h)
forall k (t :: k). Proxy t
Proxy :: Proxy (Instance1 Incremental h))
        (\Membership xs x
i h x
x -> Maybe (Delta (h x)) -> WrapDelta h x
forall k (h :: k -> Type) (x :: k).
Maybe (Delta (h x)) -> WrapDelta h x
WrapDelta (h x -> h x -> Maybe (Delta (h x))
forall a. Incremental a => a -> a -> Maybe (Delta a)
diff (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
r) h x
x))
    where
      check :: (xs :& WrapDelta h) -> Maybe (xs :& WrapDelta h)
check xs :& WrapDelta h
t
        | Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (forall (x :: k). WrapDelta h x -> Any)
-> (xs :& WrapDelta h) -> Any
forall k a (h :: k -> Type) (xs :: [k]).
Monoid a =>
(forall (x :: k). h x -> a) -> (xs :& h) -> a
hfoldMap (Bool -> Any
Any (Bool -> Any) -> (WrapDelta h x -> Bool) -> WrapDelta h x -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Delta (h x)) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Delta (h x)) -> Bool)
-> (WrapDelta h x -> Maybe (Delta (h x))) -> WrapDelta h x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapDelta h x -> Maybe (Delta (h x))
forall k (h :: k -> Type) (x :: k).
WrapDelta h x -> Maybe (Delta (h x))
unwrapDelta) xs :& WrapDelta h
t = (xs :& WrapDelta h) -> Maybe (xs :& WrapDelta h)
forall a. a -> Maybe a
Just xs :& WrapDelta h
t
        | Bool
otherwise = Maybe (xs :& WrapDelta h)
forall a. Maybe a
Nothing

instance (Lookup xs k v, Wrapper h, Repr h v ~ a) => HasField k (RecordOf h xs) a where
  getField :: RecordOf h xs -> a
getField = Field h (k >: v) -> a
forall k (h :: k -> Type) (v :: k). Wrapper h => h v -> Repr h v
unwrap (Field h (k >: v) -> a)
-> (RecordOf h xs -> Field h (k >: v)) -> RecordOf h xs -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Membership xs (k >: v) -> RecordOf h xs -> Field h (k >: v)
forall k (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup (Membership xs (k >: v)
forall k k1 (xs :: [Assoc k k1]) (k2 :: k) (v :: k1).
Lookup xs k2 v =>
Membership xs (k2 ':> v)
association :: Membership xs (k >: v))