isobmff-builder-0.11.2.0: A (bytestring-) builder for the ISO-14496-12 base media file format

Safe HaskellNone
LanguageHaskell2010

Data.Type.BitRecords.Enum

Contents

Synopsis

BitRecordFields containing enum-like types

data EnumOf enum where Source #

Wrapper around a type that can be represented as a short number, indexing the clauses of the (sum) type.

Constructors

MkEnumOf :: IsAn (EnumField enum size) -> IsA (FieldValue label enum) -> BitRecord -> EnumOf enum 

Instances

type Eval (EnumOf enum) (EnumParamAlt enum size label (FixedEnum enum size)) Source # 
type Eval (EnumOf enum) (EnumParamAlt enum size label (FixedEnum enum size)) = TypeError (EnumOf enum) ((:<>:) (Text "Cannot assign an extension value to the FixedEnum ") (ShowType Type enum))
type Eval (EnumOf enum) (EnumParamAlt enum size label (ExtEnum rt k st len t enum size extInd extField)) Source # 
type Eval (EnumOf enum) (EnumParamAlt enum size label (ExtEnum rt k st len t enum size extInd extField)) = MkEnumOf enum size label (ExtEnum rt k st len t enum size extInd extField) (StaticFieldValue enum label extInd) (BitRecordMember rt k st len t ((:~) label rt k st len t extField (RuntimeFieldValue k st label)))
type Eval (EnumOf enum) (EnumParam enum size label ei) Source # 
type Eval (EnumOf enum) (EnumParam enum size label ei) = MkEnumOf enum size label ei (RuntimeFieldValue Type enum label) EmptyBitRecord
type Eval (EnumOf enum) (SetEnum enum size l ei value) Source # 
type Eval (EnumOf enum) (SetEnum enum size l ei value) = MkEnumOf enum size l ei (StaticFieldValue enum l value) EmptyBitRecord
type Eval (EnumOf enum) (SetEnumAlt k enum size l (FixedEnum enum size) value) Source # 
type Eval (EnumOf enum) (SetEnumAlt k enum size l (FixedEnum enum size) value) = TypeError (EnumOf enum) ((:<>:) (Text "Cannot assign an 'extended' value to the 'FixedEnum' ") (ShowType Type enum))
type Eval (EnumOf enum) (SetEnumAlt st enum size l (ExtEnum rt * st len t enum size extInd extField) value) Source # 
type Eval (EnumOf enum) (SetEnumAlt st enum size l (ExtEnum rt * st len t enum size extInd extField) value) = MkEnumOf enum size l (ExtEnum rt * st len t enum size extInd extField) (StaticFieldValue enum l extInd) (BitRecordMember rt * st len t ((:=) rt len st t extField value))

type family RenderEnumOf (e :: EnumOf enum) :: BitRecord where ... Source #

Equations

RenderEnumOf (MkEnumOf mainField mainFieldVal extra) = (BitRecordFieldOfEnumField mainField :~ mainFieldVal) .+: extra 

data EnumField enum size Source #

Physical representation of an EnumOf, this is an abstract type

data FixedEnum enum size :: IsAn (EnumField enum size) Source #

A fixed size EnumField

Instances

type Eval (EnumOf enum) (EnumParamAlt enum size label (FixedEnum enum size)) Source # 
type Eval (EnumOf enum) (EnumParamAlt enum size label (FixedEnum enum size)) = TypeError (EnumOf enum) ((:<>:) (Text "Cannot assign an extension value to the FixedEnum ") (ShowType Type enum))
type Eval (EnumOf enum) (SetEnumAlt k enum size l (FixedEnum enum size) value) Source # 
type Eval (EnumOf enum) (SetEnumAlt k enum size l (FixedEnum enum size) value) = TypeError (EnumOf enum) ((:<>:) (Text "Cannot assign an 'extended' value to the 'FixedEnum' ") (ShowType Type enum))

data ExtEnum enum size extInd extField :: IsAn (EnumField enum size) Source #

An enum that can be extended with an additional BitRecordField, following the regular enum field; the extension is optional, i.e. only if the regular field contains a special value (e.g. 0xff).

Instances

type Eval (EnumOf enum) (EnumParamAlt enum size label (ExtEnum rt k st len t enum size extInd extField)) Source # 
type Eval (EnumOf enum) (EnumParamAlt enum size label (ExtEnum rt k st len t enum size extInd extField)) = MkEnumOf enum size label (ExtEnum rt k st len t enum size extInd extField) (StaticFieldValue enum label extInd) (BitRecordMember rt k st len t ((:~) label rt k st len t extField (RuntimeFieldValue k st label)))
type Eval (EnumOf enum) (SetEnumAlt st enum size l (ExtEnum rt * st len t enum size extInd extField) value) Source # 
type Eval (EnumOf enum) (SetEnumAlt st enum size l (ExtEnum rt * st len t enum size extInd extField) value) = MkEnumOf enum size l (ExtEnum rt * st len t enum size extInd extField) (StaticFieldValue enum l extInd) (BitRecordMember rt * st len t ((:=) rt len st t extField value))

data SetEnum l ef v :: IsAn (EnumOf enum) Source #

Create an EnumOf that sets an enum to a static value.

Instances

type Eval (EnumOf enum) (SetEnum enum size l ei value) Source # 
type Eval (EnumOf enum) (SetEnum enum size l ei value) = MkEnumOf enum size l ei (StaticFieldValue enum l value) EmptyBitRecord

data EnumParam label ef :: IsAn (EnumOf enum) Source #

Create an EnumOf that sets the enum to a runtime value.

Instances

type Eval (EnumOf enum) (EnumParam enum size label ei) Source # 
type Eval (EnumOf enum) (EnumParam enum size label ei) = MkEnumOf enum size label ei (RuntimeFieldValue Type enum label) EmptyBitRecord

data SetEnumAlt l ef v :: IsAn (EnumOf enum) Source #

Create an EnumOf that sets an extended enum to an extended static value.

Instances

type Eval (EnumOf enum) (SetEnumAlt k enum size l (FixedEnum enum size) value) Source # 
type Eval (EnumOf enum) (SetEnumAlt k enum size l (FixedEnum enum size) value) = TypeError (EnumOf enum) ((:<>:) (Text "Cannot assign an 'extended' value to the 'FixedEnum' ") (ShowType Type enum))
type Eval (EnumOf enum) (SetEnumAlt st enum size l (ExtEnum rt * st len t enum size extInd extField) value) Source # 
type Eval (EnumOf enum) (SetEnumAlt st enum size l (ExtEnum rt * st len t enum size extInd extField) value) = MkEnumOf enum size l (ExtEnum rt * st len t enum size extInd extField) (StaticFieldValue enum l extInd) (BitRecordMember rt * st len t ((:=) rt len st t extField value))

data EnumParamAlt label ef :: IsAn (EnumOf enum) Source #

Create an EnumOf that sets the extended enum to a runtime value.

Instances

type Eval (EnumOf enum) (EnumParamAlt enum size label (FixedEnum enum size)) Source # 
type Eval (EnumOf enum) (EnumParamAlt enum size label (FixedEnum enum size)) = TypeError (EnumOf enum) ((:<>:) (Text "Cannot assign an extension value to the FixedEnum ") (ShowType Type enum))
type Eval (EnumOf enum) (EnumParamAlt enum size label (ExtEnum rt k st len t enum size extInd extField)) Source # 
type Eval (EnumOf enum) (EnumParamAlt enum size label (ExtEnum rt k st len t enum size extInd extField)) = MkEnumOf enum size label (ExtEnum rt k st len t enum size extInd extField) (StaticFieldValue enum label extInd) (BitRecordMember rt k st len t ((:~) label rt k st len t extField (RuntimeFieldValue k st label)))

Composing BitRecords with enum fields

type family FromEnum enum (entry :: enum) :: Nat Source #

Return the numeric index of an entry in a table. This emulates fromEnum a bit.

Instances

type FromEnum StreamType ObjectDescriptorStream Source # 
type FromEnum StreamType ClockReferenceStream Source # 
type FromEnum StreamType SceneDescriptionStream_Iso14496_11 Source # 
type FromEnum StreamType VisualStream Source # 
type FromEnum StreamType AudioStream Source # 
type FromEnum StreamType Mpeg7Stream Source # 
type FromEnum StreamType IpmpStream Source # 
type FromEnum StreamType ObjectContentInfoStream Source # 
type FromEnum StreamType MpegJStream Source # 
type FromEnum StreamType InteractionStream Source # 
type FromEnum StreamType IpmpToolStream_Iso14496_13 Source # 
type FromEnum ObjectTypeIndication SystemsIso14496_1_a Source # 
type FromEnum ObjectTypeIndication SystemsIso14496_1_b Source # 
type FromEnum ObjectTypeIndication InteractionStreamObjInd Source # 
type FromEnum ObjectTypeIndication SystemsIso14496_1_ExtendedBifs Source # 
type FromEnum ObjectTypeIndication SystemsIso14496_1_Afx Source # 
type FromEnum ObjectTypeIndication FontDataStream Source # 
type FromEnum ObjectTypeIndication SynthesizedTextureStream Source # 
type FromEnum ObjectTypeIndication StreamingTextStream Source # 
type FromEnum ObjectTypeIndication VisualIso14496_2 Source # 
type FromEnum ObjectTypeIndication VisualH264 Source # 
type FromEnum ObjectTypeIndication VisualH264ParameterSets Source # 
type FromEnum ObjectTypeIndication AudioIso14496_3 Source # 
type FromEnum ObjectTypeIndication VisualIso13818_2_SimpleProfile Source # 
type FromEnum ObjectTypeIndication VisualIso13818_2_MainProfile Source # 
type FromEnum ObjectTypeIndication VisualIso13818_2_SnrProfile Source # 
type FromEnum ObjectTypeIndication VisualIso13818_2_SpatialProfile Source # 
type FromEnum ObjectTypeIndication VisualIso13818_2_HighProfile Source # 
type FromEnum ObjectTypeIndication VisualIso13818_2_422Profile Source # 
type FromEnum ObjectTypeIndication AudioIso13818_7_MainProfile Source # 
type FromEnum ObjectTypeIndication AudioIso13818_7_LowComplexityProfile Source # 
type FromEnum ObjectTypeIndication AudioIso13818_7_ScalableSamplingRateProfile Source # 
type FromEnum ObjectTypeIndication AudioIso13818_3 Source # 
type FromEnum ObjectTypeIndication VisualIso11172_2 Source # 
type FromEnum ObjectTypeIndication AudioIso11172_3 Source # 
type FromEnum ObjectTypeIndication VisualIso10918_1 Source # 
type FromEnum ObjectTypeIndication VisualIso15444_1 Source # 
type FromEnum ObjectTypeIndication NoObjectTypeSpecified Source # 
type FromEnum ChannelConfigTable GasChannelConfig Source # 
type FromEnum ChannelConfigTable SingleChannel Source # 
type FromEnum ChannelConfigTable ChannelPair Source # 
type FromEnum ChannelConfigTable SinglePair Source # 
type FromEnum ChannelConfigTable SinglePairSingle Source # 
type FromEnum ChannelConfigTable SinglePairPair Source # 
type FromEnum ChannelConfigTable SinglePairPairLfe Source # 
type FromEnum ChannelConfigTable SinglePairPairPairLfe Source # 
type FromEnum SamplingFreqTable SF96000 Source # 
type FromEnum SamplingFreqTable SF88200 Source # 
type FromEnum SamplingFreqTable SF64000 Source # 
type FromEnum SamplingFreqTable SF48000 Source # 
type FromEnum SamplingFreqTable SF44100 Source # 
type FromEnum SamplingFreqTable SF32000 Source # 
type FromEnum SamplingFreqTable SF24000 Source # 
type FromEnum SamplingFreqTable SF22050 Source # 
type FromEnum SamplingFreqTable SF16000 Source # 
type FromEnum SamplingFreqTable SF12000 Source # 
type FromEnum SamplingFreqTable SF11025 Source # 
type FromEnum SamplingFreqTable SF8000 Source # 
type FromEnum SamplingFreqTable SF7350 Source # 
type FromEnum SamplingFreqTable SFReserved1 Source # 
type FromEnum SamplingFreqTable SFReserved2 Source # 
type FromEnum SamplingFreqTable SFCustom Source # 
type FromEnum AudioObjectTypeId AacMain Source # 
type FromEnum AudioObjectTypeId AacLc Source # 
type FromEnum AudioObjectTypeId AacSsr Source # 
type FromEnum AudioObjectTypeId AacLtp Source # 
type FromEnum AudioObjectTypeId Sbr Source # 
type FromEnum AudioObjectTypeId AacScalable Source # 
type FromEnum AudioObjectTypeId TwinVq Source # 
type FromEnum AudioObjectTypeId Celp Source # 
type FromEnum AudioObjectTypeId Hvxc Source # 
type FromEnum AudioObjectTypeId AoReserved1 Source # 
type FromEnum AudioObjectTypeId AoReserved2 Source # 
type FromEnum AudioObjectTypeId Ttsi Source # 
type FromEnum AudioObjectTypeId MainSunthetic Source # 
type FromEnum AudioObjectTypeId WavetableSynthesis Source # 
type FromEnum AudioObjectTypeId GeneralMidi Source # 
type FromEnum AudioObjectTypeId AlgorithmicSynthesisAndAudioFx Source # 
type FromEnum AudioObjectTypeId ErAacLc Source # 
type FromEnum AudioObjectTypeId AoReserved3 Source # 
type FromEnum AudioObjectTypeId ErAacLtp Source # 
type FromEnum AudioObjectTypeId ErAacScalable Source # 
type FromEnum AudioObjectTypeId ErTwinVq Source # 
type FromEnum AudioObjectTypeId ErBsac Source # 
type FromEnum AudioObjectTypeId ErAacLd Source # 
type FromEnum AudioObjectTypeId ErCelp Source # 
type FromEnum AudioObjectTypeId ErHvxc Source # 
type FromEnum AudioObjectTypeId ErHiln Source # 
type FromEnum AudioObjectTypeId ErParametric Source # 
type FromEnum AudioObjectTypeId Ssc Source # 
type FromEnum AudioObjectTypeId AoReserved4 Source # 
type FromEnum AudioObjectTypeId AoReserved5 Source # 
type FromEnum AudioObjectTypeId AoCustom Source # 
type FromEnum AudioObjectTypeId AoLayer1 Source # 
type FromEnum AudioObjectTypeId AoLayer2 Source # 
type FromEnum AudioObjectTypeId AoLayer3 Source # 
type FromEnum AudioObjectTypeId AoDst Source # 
type FromEnum AudioObjectTypeId AotInvalid Source # 

data EnumValue e where Source #

An enum value supplied at runtime.

Constructors

MkEnumValue :: KnownNat (FromEnum e v) => Proxy (v :: e) -> EnumValue e 

Instances

KnownChunkSize size => BitStringBuilderHoley (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) (MkField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size))) r Source # 

Associated Types

type ToBitStringBuilder (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) (MkField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size))) r :: * Source #

(KnownNat (FromEnum e v), KnownChunkSize size) => BitStringBuilderHoley (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) ((:=) (EnumValue e) size e (MkFieldCustom * (EnumValue e) e size) f v)) r Source # 

Associated Types

type ToBitStringBuilder (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) ((:=) (EnumValue e) size e (MkFieldCustom * (EnumValue e) e size) f v)) r :: * Source #

Methods

bitStringBuilderHoley :: Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) ((EnumValue e := size) e (MkFieldCustom * (EnumValue e) e size) f v) -> Holey BitStringBuilder r (ToBitStringBuilder (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) ((EnumValue e := size) e (MkFieldCustom * (EnumValue e) e size) f v)) r) Source #

type PrettyCustomFieldValue (EnumValue e) e size v Source # 
type PrettyCustomFieldValue (EnumValue e) e size v = (<+>) ((<+>) (PutNat (FromEnum e v)) ((<:>) "hex" (PutHex (FromEnum e v)))) ((<:>) "bin" (PutBits (FromEnum e v)))
type ToPretty * (EnumValue e) Source # 
type ToPretty * (EnumValue e) = PutStr "<<enum>>"
type ToBitStringBuilder (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) (MkField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size))) r Source # 
type ToBitStringBuilder (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) (MkField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size))) r = EnumValue e -> r
type ToBitStringBuilder (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) ((:=) (EnumValue e) size e (MkFieldCustom * (EnumValue e) e size) f v)) r Source # 
type ToBitStringBuilder (Proxy (A Type (BitRecordField (EnumValue e) * e size (MkFieldCustom * (EnumValue e) e size)) -> Type) ((:=) (EnumValue e) size e (MkFieldCustom * (EnumValue e) e size) f v)) r = r

enumValueProxy :: KnownNat (FromEnum e v) => Proxy (v :: e) -> EnumValue e Source #

Create an EnumValue from a Proxy. TODO remove?