binrep
Safe HaskellNone
LanguageGHC2021

Binrep.CBLen

Synopsis

Documentation

class IsCBLen (a :: k) Source #

Associated Types

type CBLen (a :: k) :: Natural Source #

Instances

Instances details
IsCBLen Int16 Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen Int16 
Instance details

Defined in Binrep.CBLen

type CBLen Int16 = 2 ^ 1
IsCBLen Int32 Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen Int32 
Instance details

Defined in Binrep.CBLen

type CBLen Int32 = 2 ^ 2
IsCBLen Int64 Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen Int64 
Instance details

Defined in Binrep.CBLen

type CBLen Int64 = 2 ^ 3
IsCBLen Int8 Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen Int8 
Instance details

Defined in Binrep.CBLen

type CBLen Int8 = 2 ^ 0
IsCBLen Word16 Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen Word16 
Instance details

Defined in Binrep.CBLen

type CBLen Word16 = 2 ^ 1
IsCBLen Word32 Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen Word32 
Instance details

Defined in Binrep.CBLen

type CBLen Word32 = 2 ^ 2
IsCBLen Word64 Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen Word64 
Instance details

Defined in Binrep.CBLen

type CBLen Word64 = 2 ^ 3
IsCBLen Word8 Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen Word8 
Instance details

Defined in Binrep.CBLen

type CBLen Word8 = 2 ^ 0
IsCBLen () Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen () 
Instance details

Defined in Binrep.CBLen

type CBLen () = 0
Generic a => IsCBLen (GenericallyNonSum a :: Type) Source #

Deriving via this instance necessitates UndecidableInstances.

Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen (GenericallyNonSum a :: Type) 
Instance details

Defined in Binrep.CBLen

IsCBLen (Magic a :: Type) Source #

The byte length of a magic is known at compile time.

Instance details

Defined in Binrep.Type.Magic

Associated Types

type CBLen (Magic a :: Type) 
Instance details

Defined in Binrep.Type.Magic

type CBLen (Magic a :: Type) = Length (MagicBytes a)
IsCBLen (NullPadded n a :: Type) Source # 
Instance details

Defined in Binrep.Type.NullPadded

Associated Types

type CBLen (NullPadded n a :: Type) 
Instance details

Defined in Binrep.Type.NullPadded

type CBLen (NullPadded n a :: Type) = n
IsCBLen (SizePrefixed pfx a :: Type) Source # 
Instance details

Defined in Binrep.Type.Prefix.Size

Associated Types

type CBLen (SizePrefixed pfx a :: Type) 
Instance details

Defined in Binrep.Type.Prefix.Size

type CBLen (SizePrefixed pfx a :: Type) = CBLen pfx + CBLen a
IsCBLen (Sized n a :: Type) Source # 
Instance details

Defined in Binrep.Type.Sized

Associated Types

type CBLen (Sized n a :: Type) 
Instance details

Defined in Binrep.Type.Sized

type CBLen (Sized n a :: Type) = n
IsCBLen a => IsCBLen (ByteOrdered end a :: Type) Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen (ByteOrdered end a :: Type)

Endianness does not alter constant length.

Instance details

Defined in Binrep.CBLen

type CBLen (ByteOrdered end a :: Type) = CBLen a
(IsCBLen l, IsCBLen r) => IsCBLen ((l, r) :: Type) Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen ((l, r) :: Type) 
Instance details

Defined in Binrep.CBLen

type CBLen ((l, r) :: Type) = CBLen l + CBLen r
IsCBLen (Refined pr (Refined pl a)) => IsCBLen (Refined (And pl pr) a :: Type) Source # 
Instance details

Defined in Binrep.CBLen

Associated Types

type CBLen (Refined (And pl pr) a :: Type) 
Instance details

Defined in Binrep.CBLen

type CBLen (Refined (And pl pr) a :: Type) = CBLen (Refined pr (Refined pl a))
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.

Instance details

Defined in Binrep.Type.Prefix.Count

Associated Types

type CBLen (CountPrefixed pfx f a :: Type) 
Instance details

Defined in Binrep.Type.Prefix.Count

type CBLen (CountPrefixed pfx f a :: Type) = CBLen pfx + CBLen (f a)

cblen :: forall {k} (a :: k). KnownNat (CBLen a) => Int Source #

Reify a type's constant byte length to the term level.

cblen# :: forall {k} (a :: k). KnownNat (CBLen a) => Int# Source #

cblenProxy# :: forall {k} (a :: k). KnownNat (CBLen a) => Proxy# a -> Int# Source #

data CBLenSym (a1 :: FunKind a Natural) Source #

Defunctionalization symbol for CBLen.

This is required for parameterized type-level generics e.g. bytezap's GPokeBase.

Instances

Instances details
type App (CBLenSym :: FunKind k Natural -> Type) (a :: k) Source # 
Instance details

Defined in Binrep.CBLen

type App (CBLenSym :: FunKind k Natural -> Type) (a :: k) = CBLen a

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 GCBLenSum (gf :: k -> Type) where ... Source #

Equations

GCBLenSum (C1 ('MetaCons name _1 _2) gf :: k -> Type) = JustX (GTFoldMapCAddition (CBLenSym :: FunKind Type Natural -> Type) gf) name 
GCBLenSum (l :+: r :: k -> Type) = MaybeEq (GCBLenSum l) (GCBLenSum r) 

type family MaybeEq a b where ... Source #

Equations

MaybeEq (JustX n nName) (JustX m _1) = If (n == m) (JustX n nName) NothingX 
MaybeEq _1 _2 = NothingX 

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 

data JustX (a :: k) (b :: k1) Source #