bytezap-1.1.0: Bytestring builder with zero intermediate allocation
Safe HaskellSafe-Inferred
LanguageGHC2021

Bytezap.Struct.Generic

Description

Generics for bytezap's struct serializer.

We can't use my generic-data-functions library, because we're doing more than just basic monoidal composition. But I still want the same pluggable generics, where the user provides the class to use for base cases. So I do that. However, unlike g-d-f, the class info can't be provided via the user-selected monoid, because you don't select that. Instead, we take a simple "index" type. It's pretty much the same idea, surprisingly. This way, we can provide a few sensible "versions" like in g-f-d, while primarily designing for DIY.

Synopsis

Documentation

type family UnwrapGenericS1 a where ... Source #

Equations

UnwrapGenericS1 (S1 c (Rec0 a)) = a 

class GPokeBase idx where Source #

Class for holding info on class to use for poking base cases.

The type is just used to map to class info. It is never instantiated. By packing KnownSizeOf into here, we don't need to enforce a type-level solution! Now it's up to you how you want to track your constant lengths.

We stay unboxed here because the internals are unboxed, just for convenience. Maybe this is bad, let me know.

Associated Types

type GPokeBaseSt idx Source #

The state token of our poker.

type GPokeBaseC idx a :: Constraint Source #

The type class that provides base case poking.

The type class should provide a function that looks like gPokeBase.

type KnownSizeOf' idx a :: Constraint Source #

The type class that provides poked length (known at compile time).

Methods

gPokeBase :: GPokeBaseC idx a => a -> Poke# (GPokeBaseSt idx) Source #

sizeOf' :: forall a. KnownSizeOf' idx a => Proxy# a -> Int# Source #

Get the poked length of the given type. Unboxed because I felt like it.

I think we have to pass a proxy, because of forall limitations on instance signatures. This would be much better with explicit type variables (GHC 9.10 or 9.12).

class GPoke idx f where Source #

Methods

gPoke :: f p -> Poke# (GPokeBaseSt idx) Source #

Instances

Instances details
GPoke (idx :: k1) (U1 :: k2 -> Type) Source #

Wow, look! Nothing!

Instance details

Defined in Bytezap.Struct.Generic

Methods

gPoke :: forall (p :: k10). U1 p -> Poke# (GPokeBaseSt idx) Source #

(GPoke idx l, GPoke idx r, GPokeBase idx, KnownSizeOf' idx (UnwrapGenericS1 l)) => GPoke (idx :: k1) (l :*: r :: k2 -> Type) Source # 
Instance details

Defined in Bytezap.Struct.Generic

Methods

gPoke :: forall (p :: k10). (l :*: r) p -> Poke# (GPokeBaseSt idx) Source #

GPoke idx f => GPoke (idx :: k1) (C1 c f :: k2 -> Type) Source # 
Instance details

Defined in Bytezap.Struct.Generic

Methods

gPoke :: forall (p :: k10). C1 c f p -> Poke# (GPokeBaseSt idx) Source #

GPoke idx f => GPoke (idx :: k1) (D1 c f :: k2 -> Type) Source # 
Instance details

Defined in Bytezap.Struct.Generic

Methods

gPoke :: forall (p :: k10). D1 c f p -> Poke# (GPokeBaseSt idx) Source #

(GPokeBase idx, GPokeBaseC idx a) => GPoke (idx :: k1) (S1 c (Rec0 a) :: k2 -> Type) Source # 
Instance details

Defined in Bytezap.Struct.Generic

Methods

gPoke :: forall (p :: k10). S1 c (Rec0 a) p -> Poke# (GPokeBaseSt idx) Source #