diff --git a/isobmff-builder.cabal b/isobmff-builder.cabal --- a/isobmff-builder.cabal +++ b/isobmff-builder.cabal @@ -1,5 +1,5 @@ name: isobmff-builder -version: 0.1.0.1 +version: 0.2.0.1 synopsis: A (bytestring-) builder for the ISO base media file format ISO-14496-12 description: Please see README.md homepage: https://github.com/sheyll/isobmff-builder#readme @@ -22,7 +22,7 @@ , Data.ByteString.IsoBaseFileFormat.Boxes.Skip , Data.ByteString.IsoBaseFileFormat.Boxes.ProgressiveDownloadInformation , Data.ByteString.IsoBaseFileFormat.Boxes.MovieBox - build-depends: base >= 4.7 && < 5 + build-depends: base >= 4.9 && < 5 , bytestring >= 0.10.8.1 , type-list >= 0.5.0.0 default-language: Haskell2010 diff --git a/src/Data/ByteString/IsoBaseFileFormat/Boxes/Box.hs b/src/Data/ByteString/IsoBaseFileFormat/Boxes/Box.hs --- a/src/Data/ByteString/IsoBaseFileFormat/Boxes/Box.hs +++ b/src/Data/ByteString/IsoBaseFileFormat/Boxes/Box.hs @@ -212,30 +212,59 @@ -- * Type-safe box composition +-- | A 'ParentBox' is a 'Box' but without it's children. It has no +-- 'IsBoxContent' instance, and it must be converted to a real 'Box' using +-- 'boxes'. This is to prevent creation of boxes with invalid children. +data ParentBox (b :: t) where + ParentBox :: (IsBoxType t,IsBoxContent c) => BoxType -> c -> ParentBox t + +-- | A parent box. Similar to 'box' but for 'ParentBox'es. +parentBox :: forall t c . (IsBoxType t, IsBoxContent c) => c -> ParentBox t +parentBox = toParentBox . box + where toParentBox :: IsBoxType s => Box s -> ParentBox s + toParentBox (Box t c) = ParentBox t c + +-- | An /empty/ parent box. This is for boxes without fields. All these boxes +-- contain is their obligatory 'BoxHeader' possibly nested boxes. +emptyParentBox :: forall t . (IsBoxType t) => ParentBox t +emptyParentBox = parentBox () + -- | A box that may contain nested boxes. The nested boxes are type checked to -- be valid in the container box. This results in a container-box with only --- valid and all required child boxes. This is checked by the type system. -boxes :: forall ts t. - (IsBoxType t,ValidBoxes t ts) - => Boxes t ts -> Box t -boxes = box +-- valid and all required child boxes. This is checked by the type system. It +-- accept a 'ParentBox' and the nested 'Boxes' and returns a 'Box', if the type +-- checker is convinced that the parent box and the nested boxes are valid. +boxes :: (IsBoxType t,IsBoxContent (Boxes t ts)) + => ParentBox t -> Boxes t ts -> Box t +boxes p = box . Extend (toBox p) + where + toBox :: IsBoxType t => ParentBox t -> Box t + toBox (ParentBox t c) = Box t c --- | A container-box with child boxes. +-- | An operator for starting a 'Boxes' from the parent box. +-- +-- Example: +-- > xxx :: Box "moov" +-- > xxx = movieBox +-- > ^- Nested (movieHeaderBox (MovieHeader ...)) +-- > :- (trackBox +-- > ^- Nested (trackHeaderBox (TrackHeader ...)) +-- > :- trackReferenceBox (TrackReference ...) +-- > :- trackGroupingIndication (TrackGroupingInd ...)) +-- +(^-) :: (IsBoxType t,IsBoxContent (Boxes t ts)) + => ParentBox t -> Boxes t ts -> Box t +parent ^- nested = parent ^- nested + +infixr 1 ^- + +-- | A heterogenous collection of child boxes for a parent box wiht type @cont@. data Boxes (cont :: x) (boxTypes :: [x]) where - Parent :: IsBoxType t => Box t -> Boxes t '[] + Nested :: IsBoxType t => Box t -> Boxes c '[t] (:-) :: IsBoxType t => Boxes c ts -> Box t -> Boxes c (t ': ts) infixl 2 :- --- | A container box that contains only the parent, and no children (yet). -type Container parent = Boxes parent '[] - --- | An operator for @Parent parent :- firstChild@ -(^-) :: (IsBoxType t, IsBoxType u) => Box t -> Box u -> Boxes t '[u] -parent ^- firstChild = Parent parent :- firstChild - -infixl 2 ^- - -- | To be nested into a box, 'Boxes' must be an instance of 'IsBoxContent'. -- This instance concatenates all nested boxes. instance (IsBoxType t,ValidBoxes t bs) => IsBoxContent (Boxes t bs) where @@ -250,9 +279,9 @@ newtype UnverifiedBoxes t ts = UnverifiedBoxes (Boxes t ts) instance IsBoxContent (UnverifiedBoxes t bs) where - boxSize (UnverifiedBoxes (Parent c)) = boxSize c + boxSize (UnverifiedBoxes (Nested b)) = boxSize b boxSize (UnverifiedBoxes (bs :- b)) = boxSize (UnverifiedBoxes bs) + boxSize b - boxBuilder (UnverifiedBoxes (Parent c)) = boxBuilder c + boxBuilder (UnverifiedBoxes (Nested b)) = boxBuilder b boxBuilder (UnverifiedBoxes (bs :- b)) = boxBuilder (UnverifiedBoxes bs) <> boxBuilder b -- * Type level consistency checks diff --git a/src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieBox.hs b/src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieBox.hs --- a/src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieBox.hs +++ b/src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieBox.hs @@ -2,14 +2,13 @@ module Data.ByteString.IsoBaseFileFormat.Boxes.MovieBox where import Data.ByteString.IsoBaseFileFormat.Boxes.Box - -- Uncomment this to see what the custom compiler errors look like: -- --- import Data.ByteString.IsoBaseFileFormat.Boxes.Skip +import Data.ByteString.IsoBaseFileFormat.Boxes.Skip + -- xxx :: Box "moov" -- xxx = movieBox -- (movieBoxContainer :- skipBox (Skip 100)) - -- | The metadata for a presentation, a single 'MovieBox' which occurs only once -- and top-level. It is pretty empty on it's own, but it contains nested boxes -- with all the relevant meta data. @@ -18,22 +17,16 @@ instance BoxRules "moov" where type RequiredNestedBoxes "moov" = '["mvhd", "trak"] --- | Compose a movie box from the required 'Boxes'. -movieBox :: forall ts. ValidBoxes "moov" ts => Boxes "moov" ts -> Box "moov" -movieBox = boxes - --- | The movie box container, use this to create movie boxes filled with nested --- boxes, for example: +-- | A movie parent box. Combine with the nested 'Boxes' using 'boxes' or '(^-)' -- +-- Example: -- > xxx :: Box "moov" -- > xxx = movieBox --- > (movieBoxContainer --- > :- movieHeaderBox (MovieHeader ...) --- > :- trackBox --- > (trackBoxContainer --- > :- trackHeaderBox --- > :- trackReferenceBox --- > :- trackGroupingIndication)) +-- > ^- Nested (movieHeaderBox (MovieHeader ...)) +-- > :- (trackBox +-- > ^- Nested (trackHeaderBox (TrackHeader ...)) +-- > :- trackReferenceBox (TrackReference ...) +-- > :- trackGroupingIndication (TrackGroupingInd ...)) -- -movieBoxContainer :: Container "moov" -movieBoxContainer = Parent emptyBox +movieBox :: ParentBox "moov" +movieBox = emptyParentBox