Copyright | (c) Fumiaki Kinoshita 2018 |
---|---|
License | BSD3 |
Maintainer | Fumiaki Kinoshita <fumiexcel@gmail.com> |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
Synopsis
- data (s :: [k]) :& (h :: k -> *)
- type (:*) h xs = xs :& h
- nil :: '[] :& h
- (<:) :: h x -> (xs :& h) -> (x ': xs) :& h
- (<!) :: h x -> (xs :& h) -> (x ': xs) :& h
- (=<:) :: Wrapper h => Repr h x -> (xs :& h) -> (x ': xs) :& h
- hlength :: (xs :& h) -> Int
- type family (xs :: [k]) ++ (ys :: [k]) :: [k] where ...
- happend :: (xs :& h) -> (ys :& h) -> (xs ++ ys) :& h
- hmap :: (forall x. g x -> h x) -> (xs :& g) -> xs :& h
- hmapWithIndex :: (forall x. Membership xs x -> g x -> h x) -> (xs :& g) -> xs :& h
- hzipWith :: (forall x. f x -> g x -> h x) -> (xs :& f) -> (xs :& g) -> xs :& h
- hzipWith3 :: (forall x. f x -> g x -> h x -> i x) -> (xs :& f) -> (xs :& g) -> (xs :& h) -> xs :& i
- hfoldMap :: Monoid a => (forall x. h x -> a) -> (xs :& h) -> a
- hfoldMapWithIndex :: Monoid a => (forall x. Membership xs x -> g x -> a) -> (xs :& g) -> a
- hfoldrWithIndex :: (forall x. Membership xs x -> h x -> r -> r) -> r -> (xs :& h) -> r
- hfoldlWithIndex :: (forall x. Membership xs x -> r -> h x -> r) -> r -> (xs :& h) -> r
- htraverse :: Applicative f => (forall x. g x -> f (h x)) -> (xs :& g) -> f (xs :& h)
- htraverseWithIndex :: Applicative f => (forall x. Membership xs x -> g x -> f (h x)) -> (xs :& g) -> f (xs :& h)
- hsequence :: Applicative f => (xs :& Comp f h) -> f (xs :& h)
- hmapWithIndexFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> g x -> h x) -> (xs :& g) -> xs :& h
- hfoldMapFor :: (Forall c xs, Monoid a) => proxy c -> (forall x. c x => h x -> a) -> (xs :& h) -> a
- hfoldMapWithIndexFor :: (Forall c xs, Monoid a) => proxy c -> (forall x. c x => Membership xs x -> h x -> a) -> (xs :& h) -> a
- 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
- hfoldlWithIndexFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> r -> h x -> r) -> r -> (xs :& h) -> r
- hfoldMapWith :: forall c xs h a. (Forall c xs, Monoid a) => (forall x. c x => h x -> a) -> (xs :& h) -> a
- hfoldMapWithIndexWith :: forall c xs h a. (Forall c xs, Monoid a) => (forall x. c x => Membership xs x -> h x -> a) -> (xs :& h) -> a
- hfoldrWithIndexWith :: forall c xs h r. Forall c xs => (forall x. c x => Membership xs x -> h x -> r -> r) -> r -> (xs :& h) -> r
- hfoldlWithIndexWith :: forall c xs h r. Forall c xs => (forall x. c x => Membership xs x -> r -> h x -> r) -> r -> (xs :& h) -> r
- hmapWithIndexWith :: forall c xs g h. Forall c xs => (forall x. c x => Membership xs x -> g x -> h x) -> (xs :& g) -> xs :& h
- hforce :: (xs :& h) -> xs :& h
- haccumMap :: Foldable f => (a -> xs :/ g) -> (forall x. Membership xs x -> g x -> h x -> h x) -> (xs :& h) -> f a -> xs :& h
- haccum :: Foldable f => (forall x. Membership xs x -> g x -> h x -> h x) -> (xs :& h) -> f (xs :/ g) -> xs :& h
- hpartition :: (Foldable f, Generate xs) => (a -> xs :/ h) -> f a -> xs :& Comp [] h
- hlookup :: Membership xs x -> (xs :& h) -> h x
- hindex :: (xs :& h) -> Membership xs x -> h x
- class Generate (xs :: [k]) where
- henumerate :: (forall (x :: k). Membership xs x -> r -> r) -> r -> r
- hcount :: proxy xs -> Int
- hgenerateList :: Applicative f => (forall (x :: k). Membership xs x -> f (h x)) -> f (HList h xs)
- hgenerate :: (Generate xs, Applicative f) => (forall x. Membership xs x -> f (h x)) -> f (xs :& h)
- htabulate :: Generate xs => (forall x. Membership xs x -> h x) -> xs :& h
- hrepeat :: Generate xs => (forall x. h x) -> xs :& h
- hcollect :: (Functor f, Generate xs) => (a -> xs :& h) -> f a -> xs :& Comp f h
- hdistribute :: (Functor f, Generate xs) => f (xs :& h) -> xs :& Comp f h
- fromHList :: HList h xs -> xs :& h
- toHList :: forall h xs. (xs :& h) -> HList h xs
- class (ForallF c xs, Generate xs) => Forall (c :: k -> Constraint) (xs :: [k]) where
- henumerateFor :: proxy c -> proxy' xs -> (forall (x :: k). c x => Membership xs x -> r -> r) -> r -> r
- hgenerateListFor :: Applicative f => proxy c -> (forall (x :: k). c x => Membership xs x -> f (h x)) -> f (HList h xs)
- hgenerateFor :: (Forall c xs, Applicative f) => proxy c -> (forall x. c x => Membership xs x -> f (h x)) -> f (xs :& h)
- htabulateFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> h x) -> xs :& h
- hrepeatFor :: Forall c xs => proxy c -> (forall x. c x => h x) -> xs :& h
- hgenerateWith :: forall c xs f h. (Forall c xs, Applicative f) => (forall x. c x => Membership xs x -> f (h x)) -> f (xs :& h)
- htabulateWith :: forall c xs h. Forall c xs => (forall x. c x => Membership xs x -> h x) -> xs :& h
- hrepeatWith :: forall c xs h. Forall c xs => (forall x. c x => h x) -> xs :& h
Basic operations
data (s :: [k]) :& (h :: k -> *) Source #
The type of extensible products.
(:&) :: [k] -> (k -> *) -> *
Instances
(Corepresentable p, Comonad (Corep p), Functor f) => Extensible f p ((:&) :: [k] -> (k -> Type) -> Type) Source # | |
Defined in Data.Extensible.Struct type ExtensibleConstr (:&) xs h x :: Constraint Source # pieceAt :: ExtensibleConstr (:&) xs h x => Membership xs x -> Optic' p f (xs :& h) (h x) Source # | |
(Lookup xs k2 v2, Wrapper h, Repr h v2 ~ a) => HasField (k2 :: k1) (RecordOf h xs) a Source # | |
Defined in Data.Extensible.Label | |
WrapForall Unbox h (x ': xs) => Vector Vector ((x ': xs) :& h) | |
Defined in Data.Extensible.Dictionary basicUnsafeFreeze :: PrimMonad m => Mutable Vector (PrimState m) ((x ': xs) :& h) -> m (Vector ((x ': xs) :& h)) basicUnsafeThaw :: PrimMonad m => Vector ((x ': xs) :& h) -> m (Mutable Vector (PrimState m) ((x ': xs) :& h)) basicLength :: Vector ((x ': xs) :& h) -> Int basicUnsafeSlice :: Int -> Int -> Vector ((x ': xs) :& h) -> Vector ((x ': xs) :& h) basicUnsafeIndexM :: Monad m => Vector ((x ': xs) :& h) -> Int -> m ((x ': xs) :& h) basicUnsafeCopy :: PrimMonad m => Mutable Vector (PrimState m) ((x ': xs) :& h) -> Vector ((x ': xs) :& h) -> m () elemseq :: Vector ((x ': xs) :& h) -> ((x ': xs) :& h) -> b -> b | |
WrapForall Unbox h (x ': xs) => MVector MVector ((x ': xs) :& h) | |
Defined in Data.Extensible.Dictionary basicLength :: MVector s ((x ': xs) :& h) -> Int basicUnsafeSlice :: Int -> Int -> MVector s ((x ': xs) :& h) -> MVector s ((x ': xs) :& h) basicOverlaps :: MVector s ((x ': xs) :& h) -> MVector s ((x ': xs) :& h) -> Bool basicUnsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) ((x ': xs) :& h)) basicInitialize :: PrimMonad m => MVector (PrimState m) ((x ': xs) :& h) -> m () basicUnsafeReplicate :: PrimMonad m => Int -> ((x ': xs) :& h) -> m (MVector (PrimState m) ((x ': xs) :& h)) basicUnsafeRead :: PrimMonad m => MVector (PrimState m) ((x ': xs) :& h) -> Int -> m ((x ': xs) :& h) basicUnsafeWrite :: PrimMonad m => MVector (PrimState m) ((x ': xs) :& h) -> Int -> ((x ': xs) :& h) -> m () basicClear :: PrimMonad m => MVector (PrimState m) ((x ': xs) :& h) -> m () basicSet :: PrimMonad m => MVector (PrimState m) ((x ': xs) :& h) -> ((x ': xs) :& h) -> m () basicUnsafeCopy :: PrimMonad m => MVector (PrimState m) ((x ': xs) :& h) -> MVector (PrimState m) ((x ': xs) :& h) -> m () basicUnsafeMove :: PrimMonad m => MVector (PrimState m) ((x ': xs) :& h) -> MVector (PrimState m) ((x ': xs) :& h) -> m () basicUnsafeGrow :: PrimMonad m => MVector (PrimState m) ((x ': xs) :& h) -> Int -> m (MVector (PrimState m) ((x ': xs) :& h)) | |
WrapForall Bounded h xs => Bounded (xs :& h) Source # | |
WrapForall Eq h xs => Eq (xs :& h) Source # | |
(Eq (xs :& h), WrapForall Ord h xs) => Ord (xs :& h) Source # | |
Defined in Data.Extensible.Dictionary | |
WrapForall Show h xs => Show (xs :& h) Source # | |
WrapForall Semigroup h xs => Semigroup (xs :& h) Source # | |
(WrapForall Semigroup h xs, WrapForall Monoid h xs) => Monoid (xs :& h) Source # | |
WrapForall Lift h xs => Lift (xs :& h) Source # | |
WrapForall NFData h xs => NFData (xs :& h) Source # | |
Defined in Data.Extensible.Dictionary | |
WrapForall Hashable h xs => Hashable (xs :& h) | |
Defined in Data.Extensible.Dictionary | |
WrapForall Pretty h xs => Pretty (xs :& h) | |
Defined in Data.Extensible.Dictionary pretty :: (xs :& h) -> Doc ann prettyList :: [xs :& h] -> Doc ann | |
WrapForall Arbitrary h xs => Arbitrary (xs :& h) | |
Forall (KeyTargetAre KnownSymbol (Instance1 FromJSON h)) xs => FromJSON (xs :& Nullable (Field h :: Assoc Symbol v -> Type)) | |
Defined in Data.Extensible.Dictionary | |
Forall (KeyTargetAre KnownSymbol (Instance1 FromJSON h)) xs => FromJSON (xs :& (Field h :: Assoc Symbol v -> Type)) |
|
Defined in Data.Extensible.Dictionary | |
Forall (KeyTargetAre KnownSymbol (Instance1 ToJSON h)) xs => ToJSON (xs :& Nullable (Field h :: Assoc Symbol v -> Type)) | |
Defined in Data.Extensible.Dictionary | |
Forall (KeyTargetAre KnownSymbol (Instance1 ToJSON h)) xs => ToJSON (xs :& (Field h :: Assoc Symbol v -> Type)) | |
Defined in Data.Extensible.Dictionary toJSON :: (xs :& Field h) -> Value toEncoding :: (xs :& Field h) -> Encoding toJSONList :: [xs :& Field h] -> Value toEncodingList :: [xs :& Field h] -> Encoding | |
Forall (KeyTargetAre KnownSymbol (Instance1 FromField h)) xs => FromNamedRecord (xs :& (Field h :: Assoc Symbol v -> Type)) | |
Defined in Data.Extensible.Dictionary parseNamedRecord :: NamedRecord -> Parser (xs :& Field h) | |
WrapForall FromField h xs => FromRecord (xs :& h) | |
Defined in Data.Extensible.Dictionary parseRecord :: Record -> Parser (xs :& h) | |
Forall (KeyTargetAre KnownSymbol (Instance1 ToField h)) xs => ToNamedRecord (xs :& (Field h :: Assoc Symbol v -> Type)) | |
Defined in Data.Extensible.Dictionary toNamedRecord :: (xs :& Field h) -> NamedRecord | |
WrapForall ToField h xs => ToRecord (xs :& h) | |
Defined in Data.Extensible.Dictionary | |
WrapForall Unbox h (x ': xs) => Unbox ((x ': xs) :& h) | |
Defined in Data.Extensible.Dictionary | |
type ExtensibleConstr ((:&) :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type) (x :: k) Source # | |
Defined in Data.Extensible.Struct type ExtensibleConstr ((:&) :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type) (x :: k) = () | |
newtype MVector s (xs :& h) | |
Defined in Data.Extensible.Dictionary | |
newtype Vector (xs :& h) | |
Defined in Data.Extensible.Dictionary |
(<:) :: h x -> (xs :& h) -> (x ': xs) :& h infixr 0 Source #
O(n) Prepend an element onto a product.
Expressions like a <: b <: c <: nil
are transformed to a single fromHList
.
type family (xs :: [k]) ++ (ys :: [k]) :: [k] where ... infixr 5 Source #
Concatenate type level lists
hmapWithIndex :: (forall x. Membership xs x -> g x -> h x) -> (xs :& g) -> xs :& h Source #
Map a function to every element of a product.
hzipWith :: (forall x. f x -> g x -> h x) -> (xs :& f) -> (xs :& g) -> xs :& h Source #
zipWith
for heterogeneous product
hzipWith3 :: (forall x. f x -> g x -> h x -> i x) -> (xs :& f) -> (xs :& g) -> (xs :& h) -> xs :& i Source #
zipWith3
for heterogeneous product
hfoldMapWithIndex :: Monoid a => (forall x. Membership xs x -> g x -> a) -> (xs :& g) -> a Source #
hfoldMap
with the membership of elements.
hfoldrWithIndex :: (forall x. Membership xs x -> h x -> r -> r) -> r -> (xs :& h) -> r Source #
Right-associative fold of a product.
hfoldlWithIndex :: (forall x. Membership xs x -> r -> h x -> r) -> r -> (xs :& h) -> r Source #
Perform a strict left fold over the elements.
htraverse :: Applicative f => (forall x. g x -> f (h x)) -> (xs :& g) -> f (xs :& h) Source #
Traverse all elements and combine the result sequentially.
htraverse (fmap f . g) ≡ fmap (hmap f) . htraverse g
htraverse pure ≡ pure
htraverse (Comp . fmap g . f) ≡ Comp . fmap (htraverse g) . htraverse f
htraverseWithIndex :: Applicative f => (forall x. Membership xs x -> g x -> f (h x)) -> (xs :& g) -> f (xs :& h) Source #
htraverse
with Membership
s.
hsequence :: Applicative f => (xs :& Comp f h) -> f (xs :& h) Source #
sequence
analog for extensible products
Constrained fold
hmapWithIndexFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> g x -> h x) -> (xs :& g) -> xs :& h Source #
Map a function to every element of a product.
hfoldMapFor :: (Forall c xs, Monoid a) => proxy c -> (forall x. c x => h x -> a) -> (xs :& h) -> a Source #
Constrained hfoldMap
hfoldMapWithIndexFor :: (Forall c xs, Monoid a) => proxy c -> (forall x. c x => Membership xs x -> h x -> a) -> (xs :& h) -> a Source #
hfoldMapWithIndex
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 Source #
hfoldrWithIndex
with a constraint for each element.
hfoldlWithIndexFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> r -> h x -> r) -> r -> (xs :& h) -> r Source #
Constrained hfoldlWithIndex
Constraind fold without proxies
hfoldMapWith :: forall c xs h a. (Forall c xs, Monoid a) => (forall x. c x => h x -> a) -> (xs :& h) -> a Source #
Constrained hfoldMap
hfoldMapWithIndexWith :: forall c xs h a. (Forall c xs, Monoid a) => (forall x. c x => Membership xs x -> h x -> a) -> (xs :& h) -> a Source #
hfoldMapWithIndex
with a constraint for each element.
hfoldrWithIndexWith :: forall c xs h r. Forall c xs => (forall x. c x => Membership xs x -> h x -> r -> r) -> r -> (xs :& h) -> r Source #
hfoldlWithIndexWith :: forall c xs h r. Forall c xs => (forall x. c x => Membership xs x -> r -> h x -> r) -> r -> (xs :& h) -> r Source #
Constrained hfoldlWithIndex
hmapWithIndexWith :: forall c xs g h. Forall c xs => (forall x. c x => Membership xs x -> g x -> h x) -> (xs :& g) -> xs :& h Source #
Evaluating
Update
haccumMap :: Foldable f => (a -> xs :/ g) -> (forall x. Membership xs x -> g x -> h x -> h x) -> (xs :& h) -> f a -> xs :& h Source #
Accumulate sums on a product.
haccum :: Foldable f => (forall x. Membership xs x -> g x -> h x -> h x) -> (xs :& h) -> f (xs :/ g) -> xs :& h Source #
hpartition :: (Foldable f, Generate xs) => (a -> xs :/ h) -> f a -> xs :& Comp [] h Source #
Group sums by type.
Lookup
hlookup :: Membership xs x -> (xs :& h) -> h x Source #
Get an element in a product.
Generation
class Generate (xs :: [k]) where #
henumerate :: (forall (x :: k). Membership xs x -> r -> r) -> r -> r #
hgenerateList :: Applicative f => (forall (x :: k). Membership xs x -> f (h x)) -> f (HList h xs) #
Instances
Generate ([] :: [k]) | |
Defined in Type.Membership henumerate :: (forall (x :: k0). Membership [] x -> r -> r) -> r -> r # hgenerateList :: Applicative f => (forall (x :: k0). Membership [] x -> f (h x)) -> f (HList h []) # | |
Generate xs => Generate (x ': xs :: [k]) | |
Defined in Type.Membership henumerate :: (forall (x0 :: k0). Membership (x ': xs) x0 -> r -> r) -> r -> r # hcount :: proxy (x ': xs) -> Int # hgenerateList :: Applicative f => (forall (x0 :: k0). Membership (x ': xs) x0 -> f (h x0)) -> f (HList h (x ': xs)) # |
hgenerate :: (Generate xs, Applicative f) => (forall x. Membership xs x -> f (h x)) -> f (xs :& h) Source #
Applicative
version of htabulate
.
hrepeat :: Generate xs => (forall x. h x) -> xs :& h Source #
A product filled with the specified value.
hcollect :: (Functor f, Generate xs) => (a -> xs :& h) -> f a -> xs :& Comp f h Source #
The dual of htraverse
hdistribute :: (Functor f, Generate xs) => f (xs :& h) -> xs :& Comp f h Source #
The dual of hsequence
class (ForallF c xs, Generate xs) => Forall (c :: k -> Constraint) (xs :: [k]) where #
henumerateFor :: proxy c -> proxy' xs -> (forall (x :: k). c x => Membership xs x -> r -> r) -> r -> r #
hgenerateListFor :: Applicative f => proxy c -> (forall (x :: k). c x => Membership xs x -> f (h x)) -> f (HList h xs) #
Instances
Forall (c :: k -> Constraint) ([] :: [k]) | |
Defined in Type.Membership henumerateFor :: proxy c -> proxy' [] -> (forall (x :: k0). c x => Membership [] x -> r -> r) -> r -> r # hgenerateListFor :: Applicative f => proxy c -> (forall (x :: k0). c x => Membership [] x -> f (h x)) -> f (HList h []) # | |
(c x, Forall c xs) => Forall (c :: a -> Constraint) (x ': xs :: [a]) | |
Defined in Type.Membership henumerateFor :: proxy c -> proxy' (x ': xs) -> (forall (x0 :: k). c x0 => Membership (x ': xs) x0 -> r -> r) -> r -> r # hgenerateListFor :: Applicative f => proxy c -> (forall (x0 :: k). c x0 => Membership (x ': xs) x0 -> f (h x0)) -> f (HList h (x ': xs)) # |
hgenerateFor :: (Forall c xs, Applicative f) => proxy c -> (forall x. c x => Membership xs x -> f (h x)) -> f (xs :& h) Source #
Applicative
version of htabulateFor
.
htabulateFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> h x) -> xs :& h Source #
Pure version of hgenerateFor
.
hrepeatFor :: Forall c xs => proxy c -> (forall x. c x => h x) -> xs :& h Source #
A product filled with the specified value.
hgenerateWith :: forall c xs f h. (Forall c xs, Applicative f) => (forall x. c x => Membership xs x -> f (h x)) -> f (xs :& h) Source #
Applicative
version of htabulateFor
.
htabulateWith :: forall c xs h. Forall c xs => (forall x. c x => Membership xs x -> h x) -> xs :& h Source #
Pure version of hgenerateFor
.
hrepeatWith :: forall c xs h. Forall c xs => (forall x. c x => h x) -> xs :& h Source #
A product filled with the specified value.