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

Safe HaskellNone
LanguageHaskell2010

Data.ByteString.IsoBaseFileFormat.Util.TypeLayout

Documentation

type family IsRuleConform (b :: k) (r :: l) :: Bool Source #

Instances

type IsRuleConform Type k t (OneOf ((:) Type r rs)) Source # 
type IsRuleConform Type k t (OneOf ((:) Type r rs)) = (||) (IsRuleConform Type k t r) (IsRuleConform Type k t (OneOf rs))
type IsRuleConform Type k t (OneOf ([] Type)) Source # 
type IsRuleConform Type k t (OneOf ([] Type)) = False
type IsRuleConform Type k t (TopLevel rule) Source # 
type IsRuleConform Type k t (TopLevel rule) = IsRuleConform Type k t rule
type IsRuleConform Type * b (MatchSymbol fourcc) Source # 
type IsRuleConform Type * b (MatchSymbol fourcc) = (==) Symbol (ToSymbol b) fourcc
type IsRuleConform Type * (Box (SampleEntry handlerSpecificEntry)) (MatchSampleEntry handlerType) Source # 
type IsRuleConform Type * (Box (SampleEntry handlerSpecificEntry)) (MatchSampleEntry handlerType) = (==) Symbol (HandlerTypeCode (GetHandlerType handlerSpecificEntry)) (HandlerTypeCode handlerType)
type IsRuleConform [Type] [Type] bs sq Source # 
type IsRuleConform [Type] [Type] bs sq = IsSequence Type Type bs sq
type IsRuleConform * * (Boxes bs) (Boxes rs) Source # 
type IsRuleConform * * (Boxes bs) (Boxes rs) = IsRuleConform [Type] [Type] bs rs
type IsRuleConform * * (Box b) (Box r) Source # 
type IsRuleConform * * (Box b) (ContainerBox b' rules) Source # 
type IsRuleConform * * (Box b) (ContainerBox b' rules) = (&&) (IsContainerBox b) ((&&) (IsRuleConform * * (Box b) (Box b')) (IsRuleConform * * (ChildBoxes b) (Boxes rules)))

data IsRuleConform0 :: k ~> (l ~> Bool) Source #

Instances

type Apply k ((~>) l Bool) (IsRuleConform0 k l) ts Source # 
type Apply k ((~>) l Bool) (IsRuleConform0 k l) ts = IsRuleConform1 l k ts

data IsRuleConform1 :: k -> l ~> Bool Source #

Instances

type Apply l Bool (IsRuleConform1 l k ts) rule Source # 
type Apply l Bool (IsRuleConform1 l k ts) rule = IsRuleConform l k ts rule

data TopLevel :: Type -> Type Source #

Instances

type IsRuleConform Type k t (TopLevel rule) Source # 
type IsRuleConform Type k t (TopLevel rule) = IsRuleConform Type k t rule

data OneOf :: [Type] -> Type Source #

Instances

type IsRuleConform Type k t (OneOf ((:) Type r rs)) Source # 
type IsRuleConform Type k t (OneOf ((:) Type r rs)) = (||) (IsRuleConform Type k t r) (IsRuleConform Type k t (OneOf rs))
type IsRuleConform Type k t (OneOf ([] Type)) Source # 
type IsRuleConform Type k t (OneOf ([] Type)) = False

data MatchSymbol :: Symbol -> Type Source #

Instances

type IsRuleConform Type * b (MatchSymbol fourcc) Source # 
type IsRuleConform Type * b (MatchSymbol fourcc) = (==) Symbol (ToSymbol b) fourcc

type family ToSymbol t :: Symbol Source #

type family IsSequence (bs :: [k]) (rs :: [j]) :: Bool where ... Source #

Equations

IsSequence '[] '[] = True 
IsSequence (b ': bs) '[] = False 
IsSequence '[] (OnceOptionalX r ': rs) = IsSequence '[] rs 
IsSequence (b ': bs) (OnceOptionalX r ': rs) = If (IsRuleConform b r) (IsSequence bs rs) (IsSequence (b ': bs) rs) 
IsSequence '[] (SomeOptionalX r ': rs) = IsSequence '[] rs 
IsSequence (b ': bs) (SomeOptionalX r ': rs) = If (IsRuleConform b r) (IsSequence bs (SomeOptionalX r ': rs)) (IsSequence (b ': bs) rs) 
IsSequence '[] (SomeMandatoryX r ': rs) = False 
IsSequence (b ': bs) (SomeMandatoryX r ': rs) = IsRuleConform b r && IsSequence bs (SomeOptionalX r ': rs) 
IsSequence '[] (r ': rs) = False 
IsSequence (b ': bs) (r ': rs) = IsRuleConform b r && IsSequence bs rs