Safe Haskell | None |
---|---|
Language | GHC2021 |
Binrep.CBLen
Synopsis
- class IsCBLen (a :: k) where
- cblen :: forall {k} (a :: k). KnownNat (CBLen a) => Int
- cblen# :: forall {k} (a :: k). KnownNat (CBLen a) => Int#
- cblenProxy# :: forall {k} (a :: k). KnownNat (CBLen a) => Proxy# a -> Int#
- data CBLenSym (a1 :: FunKind a Natural)
- type CBLenGenericSum w a = GCBLen w (Rep a)
- type CBLenGenericNonSum a = GTFoldMapCAddition (CBLenSym :: FunKind Type Natural -> Type) (Rep a)
- type family GCBLen (w :: k) (gf :: k1 -> Type) :: Natural where ...
- type family GCBLenSum (gf :: k -> Type) where ...
- type family MaybeEq a b where ...
- type family GCBLenCaseMaybe a :: k where ...
- data JustX (a :: k) (b :: k1)
- data NothingX
Documentation
class IsCBLen (a :: k) Source #
Instances
IsCBLen Int16 Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen Int32 Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen Int64 Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen Int8 Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen Word16 Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen Word32 Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen Word64 Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen Word8 Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen () Source # | |||||
Defined in Binrep.CBLen Associated Types
| |||||
Generic a => IsCBLen (GenericallyNonSum a :: Type) Source # | Deriving via this instance necessitates | ||||
Defined in Binrep.CBLen Associated Types
| |||||
IsCBLen (Magic a :: Type) Source # | The byte length of a magic is known at compile time. | ||||
Defined in Binrep.Type.Magic Associated Types
| |||||
IsCBLen (NullPadded n a :: Type) Source # | |||||
Defined in Binrep.Type.NullPadded Associated Types
| |||||
IsCBLen (SizePrefixed pfx a :: Type) Source # | |||||
Defined in Binrep.Type.Prefix.Size Associated Types
| |||||
IsCBLen (Sized n a :: Type) Source # | |||||
Defined in Binrep.Type.Sized | |||||
IsCBLen a => IsCBLen (ByteOrdered end a :: Type) Source # | |||||
Defined in Binrep.CBLen Associated Types
| |||||
(IsCBLen l, IsCBLen r) => IsCBLen ((l, r) :: Type) Source # | |||||
Defined in Binrep.CBLen | |||||
IsCBLen (Refined pr (Refined pl a)) => IsCBLen (Refined (And pl pr) a :: Type) Source # | |||||
IsCBLen (CountPrefixed pfx f a :: Type) Source # | We can know byte length at compile time if we know it for the prefix and the list-like. This is extremely unlikely, because then what counting are we even performing for the list-like? But it's a valid instance. | ||||
Defined in Binrep.Type.Prefix.Count Associated Types
|
cblen :: forall {k} (a :: k). KnownNat (CBLen a) => Int Source #
Reify a type's constant byte length to the term level.
Generically derive CBLen
type family instances.
A type having a valid CBLen
instance usually indicates one of the following:
- it's a primitive, or extremely simple
- it holds size information in its type
- it's constructed from other constant byte length types
The first two cases must be handled manually. The third case is where Haskell generics excel, and the one this module targets.
You may derive a CBLen
type generically for a non-sum type with
instance IsCBLen a where type CBLen a = CBLenGenericNonSum a
You may attempt to derive a CBLen
type generically for a sum type with
instance IsCBLen a where type CBLen a = CBLenGenericSum w a
As with other generic sum type handlers, you must provide the type used to store
the sum tag for sum types. That sum tag type must have a CBLen
, and every
constructor must have the same CBLen
for a CBLen
to be calculated. Not many types will fit those criteria, and the code is not well-tested.
type CBLenGenericSum w a = GCBLen w (Rep a) Source #
Using this necessitates UndecidableInstances
.
type CBLenGenericNonSum a = GTFoldMapCAddition (CBLenSym :: FunKind Type Natural -> Type) (Rep a) Source #
Using this necessitates UndecidableInstances
.
type family GCBLen (w :: k) (gf :: k1 -> Type) :: Natural where ... Source #
Equations
GCBLen (w :: k1) (D1 _1 gf :: k2 -> Type) = GCBLen w gf | |
GCBLen (_1 :: k1) (V1 :: k2 -> Type) = TypeError ENoEmpty :: Natural | |
GCBLen (w :: k1) (l :+: r :: k2 -> Type) = CBLen w + (GCBLenCaseMaybe (GCBLenSum (l :+: r)) :: Natural) | |
GCBLen (w :: k1) (C1 _1 gf :: k2 -> Type) = GTFoldMapCAddition (CBLenSym :: FunKind Type Natural -> Type) gf |
type family GCBLenCaseMaybe a :: k where ... Source #
I don't know how to pattern match in types without writing type families.
Equations
GCBLenCaseMaybe (JustX n _1) = n | |
GCBLenCaseMaybe NothingX = TypeError ('Text "Two constructors didn't have equal constant size." ':$$: 'Text "Sry dunno how to thread errors thru LOL") :: k |