Safe Haskell | None |
---|---|
Language | Haskell2010 |
Definition of the most basic element in an ISOBMFF file: a box. See Chapter 4 in the standard document. A box is a container with a type, a size, some data and some nested boxes. The standard defines - among other characteristics - available box types and their semantics, the fields they contain and how they are nested into each other. This library tries to capture some of these characteristics using modern Haskell type system features, in order to provide compile time checks for (partial) standard compliance.
- class (KnownSymbol (BoxTypeSymbol t), IsBoxContent (BoxContent t)) => IsBox t where
- type BoxContent t
- type family BoxTypeSymbol (t :: k) :: Symbol
- class IsBoxContent a where
- data Box b where
- Box :: !(BoxContent b) -> Box b
- data ContainerBox b bs where
- ContainerBox :: IsBox b => !(BoxContent b) -> !(Boxes bs) -> ContainerBox b bs
- data Boxes boxTypes where
- ($:) :: IsBox l => (Boxes '[Box l] -> r) -> Box l -> r
- singletonBox :: IsBox l => Box l -> Boxes '[Box l]
- typeListLength :: forall a proxy ts. (KnownNat (Length ts), Num a) => proxy ts -> a
- containerBox :: IsBox t => BoxContent t -> Boxes ts -> Box (ContainerBox t ts)
- data BoxSize
- newtype BoxSizeExtension = BoxSizeExtension BoxSize
- data BoxType
- = StdType !FourCc
- | CustomBoxType !String
- parseBoxType :: KnownSymbol t => proxy t -> BoxType
- newtype FourCc = FourCc (Char, Char, Char, Char)
- newtype BoxTypeExtension = BoxTypeExtension BoxType
- data a :+ b = !a :+ !b
- newtype ListContent sizeType contentType = ListContent [contentType]
- type OM b bs = ContainerBox b bs
- type OO b bs = OnceOptionalX (ContainerBox b bs)
- type SM b bs = SomeMandatoryX (ContainerBox b bs)
- type SO b bs = SomeOptionalX (ContainerBox b bs)
- type OM_ b = Box b
- type OO_ b = OnceOptionalX (Box b)
- type SM_ b = SomeMandatoryX (Box b)
- type SO_ b = SomeOptionalX (Box b)
- type family IsContainerBox t :: Bool where ...
- type family ChildBoxes c where ...
Box Type Classes
class (KnownSymbol (BoxTypeSymbol t), IsBoxContent (BoxContent t)) => IsBox t where Source #
Base class for all (abstractphantomnormal-) types that represent boxes
type BoxContent t Source #
type family BoxTypeSymbol (t :: k) :: Symbol Source #
A type family used by the type-level consistency checks. It is required
that an instance of this type family exists for every IsBox
instance.
This family could not be associative since it is used by type families that
cannot have type class constraints.
class IsBoxContent a where Source #
Types that go into a box. A box content is a piece of data that can be
reused in different instances of IsBox
. It has no BoxType
and hence
defines no box.
Box Contents
A type that wraps the contents of a box and the box type.
Box :: !(BoxContent b) -> Box b |
Default (BoxContent b) => Default (Box b) Source # | |
IsBoxContent [Box SomeColourInformation] Source # | |
IsBox cnt => IsBoxContent (Box cnt) Source # | |
IsBox b => IsBox (Box b) Source # | |
type BoxContent (Box b) Source # | |
type BoxTypeSymbol * (Box b) Source # | |
type IsRuleConform * * (Box b) (Box r) Source # | |
type IsRuleConform * * (Box (SampleEntry k g' f)) (MatchSampleEntry g) Source # | |
type IsRuleConform * * (Box b) (ContainerBox b' rules) Source # | |
data ContainerBox b bs where Source #
Compose BoxContent
and Boxes
under the Constraint that they are
composable.
ContainerBox :: IsBox b => !(BoxContent b) -> !(Boxes bs) -> ContainerBox b bs |
IsBoxContent (ContainerBox b bs) Source # | |
IsBox b => IsBox (ContainerBox b bs) Source # | |
type IsRuleConform * * (Box b) (ContainerBox b' rules) Source # | |
type BoxTypeSymbol * (ContainerBox b bs) Source # | |
type BoxContent (ContainerBox b bs) Source # | |
data Boxes boxTypes where Source #
A heterogenous collection of boxes.
typeListLength :: forall a proxy ts. (KnownNat (Length ts), Num a) => proxy ts -> a Source #
Get the elements in a type level array
containerBox :: IsBox t => BoxContent t -> Boxes ts -> Box (ContainerBox t ts) Source #
A box that contains no fields, but nested boxes.
Box Size and Type
The size of the box. If the size is limited to a (fixed) value, it can be
provided as a Word64
which will be represented as either a 32bit compact
size or as 64 bit largesize. If UnlimitedSize
is used, the box extends to
the end of the file.
newtype BoxSizeExtension Source #
The BoxSize
can be > 2^32 in which case an BoxSizeExtension
must be
added after the type field.
A box has a type, this is the value level representation for the box type.
parseBoxType :: KnownSymbol t => proxy t -> BoxType Source #
Create a box type from a Symbol
. Parse the symbol value, if it's a four
charachter code, then return that as StdType
otherwise parse a UUID (TODO)
and return a CustomBoxType
.
A type containin a printable four letter character code. TODO replace impl with U32Text
newtype BoxTypeExtension Source #
When using custom types extra data must be written after the extra size information. Since the box type and the optional custom box type are not guaranteed to be consequtive, this type handles the second part seperately.
IsBoxContent
instances
Box concatenation
Box content composition
!a :+ !b infixr 3 |
(Default a, Default b) => Default ((:+) a b) Source # | |
(IsBoxContent p, IsBoxContent c) => IsBoxContent ((:+) p c) Source # | |
Tagged boxes
List Box Content
newtype ListContent sizeType contentType Source #
A list of things that renders to a size field with the number of elements and the sequence of elements. This type is index with the size field type.
ListContent [contentType] |
Default (ListContent k sizeTupe contentType) Source # | |
(Num sizeType, IsBoxContent sizeType, IsBoxContent contentType) => IsBoxContent (ListContent * sizeType contentType) Source # | |
Type Layout Rule Matchers
type OM b bs = ContainerBox b bs Source #
Mandatory, container box, exactly one
type OO b bs = OnceOptionalX (ContainerBox b bs) Source #
Optional, container box, zero or one
type SM b bs = SomeMandatoryX (ContainerBox b bs) Source #
Mandatory, container box, one or more
type SO b bs = SomeOptionalX (ContainerBox b bs) Source #
Optional, container box, zero or more
type OO_ b = OnceOptionalX (Box b) Source #
Optional, zero or one, no children
type SM_ b = SomeMandatoryX (Box b) Source #
Mandatory, one or more, no children
type SO_ b = SomeOptionalX (Box b) Source #
Optional, zero or more, no children
type family IsContainerBox t :: Bool where ... Source #
IsContainerBox (ContainerBox a as) = True | |
IsContainerBox b = False |
type family ChildBoxes c where ... Source #
ChildBoxes (ContainerBox a as) = Boxes as |