isobmff-builder 0.10.5.0 → 0.11.2.0

raw patch · 104 files changed

+5831/−1620 lines, 104 filesdep +QuickCheckdep +criteriondep +mtldep −vector-sizeddep ~bytestringdep ~hspecdep ~type-specPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, criterion, mtl, pretty-types, template-haskell, vector

Dependencies removed: vector-sized

Dependency ranges changed: bytestring, hspec, type-spec

API changes (from Hackage documentation)

Files

• .gitignore +3/−0
• .travis.yml +2/−2
• LICENSE +1/−1
• README.md +1/−1
• benchmarks/bit-records/Main.hs +193/−0
• doc/ES_Descriptor.markDown +36/−0
• doc/trun.markDown +43/−0
• examples/734397657.m4s binary
• examples/audio.mpd +0/−16
• examples/init.mp4 binary
• isobmff-builder.cabal +148/−26
• spec/BitRecordsSpec.hs +470/−0
• spec/BoxFieldsSpec.hs +3/−0
• spec/BoxSpec.hs +2/−1
• spec/BrandTypeSpec.hs +0/−70
• spec/DashSpec.hs +0/−105
• spec/DataReferenceSpec.hs +1/−0
• spec/ElementaryStreamDescriptorSpec.hs +40/−0
• spec/EnumSpec.hs +29/−0
• spec/ExpandableSpec.hs +68/−0
• spec/MediaFileSpec.hs +71/−0
• spec/Mp4AudioFileSpec.hs +195/−0
• spec/Mp4AudioSampleEntry.hs +27/−0
• spec/Mp4AudioSegmentSpec.hs +75/−0
• spec/TypeLayoutSpec.hs +9/−1
• src/Data/ByteString/IsoBaseFileFormat/Box.hs +379/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes.hs +13/−10
• src/Data/ByteString/IsoBaseFileFormat/Boxes/AudioSampleEntry.hs +16/−26
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Box.hs +0/−360
• src/Data/ByteString/IsoBaseFileFormat/Boxes/BoxFields.hs +0/−298
• src/Data/ByteString/IsoBaseFileFormat/Boxes/ChunkOffset.hs +52/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/DataEntryUrl.hs +3/−2
• src/Data/ByteString/IsoBaseFileFormat/Boxes/DataEntryUrn.hs +2/−2
• src/Data/ByteString/IsoBaseFileFormat/Boxes/DataInformation.hs +1/−1
• src/Data/ByteString/IsoBaseFileFormat/Boxes/DataReference.hs +4/−3
• src/Data/ByteString/IsoBaseFileFormat/Boxes/FileType.hs +5/−4
• src/Data/ByteString/IsoBaseFileFormat/Boxes/FullBox.hs +0/−92
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Handler.hs +8/−3
• src/Data/ByteString/IsoBaseFileFormat/Boxes/HintMediaHeader.hs +4/−3
• src/Data/ByteString/IsoBaseFileFormat/Boxes/HintSampleEntry.hs +6/−8
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Language.hs +6/−5
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Media.hs +1/−1
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MediaData.hs +1/−1
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MediaHeader.hs +7/−7
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MediaInformation.hs +1/−1
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MetaDataSampleEntry.hs +5/−13
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Movie.hs +1/−1
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieExtends.hs +22/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieExtendsHeader.hs +27/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieFragment.hs +20/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieFragmentHeader.hs +28/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieHeader.hs +15/−15
• src/Data/ByteString/IsoBaseFileFormat/Boxes/NullMediaHeader.hs +3/−2
• src/Data/ByteString/IsoBaseFileFormat/Boxes/ProgressiveDownloadInformation.hs +5/−4
• src/Data/ByteString/IsoBaseFileFormat/Boxes/SampleDescription.hs +8/−7
• src/Data/ByteString/IsoBaseFileFormat/Boxes/SampleEntry.hs +28/−28
• src/Data/ByteString/IsoBaseFileFormat/Boxes/SampleSize.hs +42/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/SampleTable.hs +1/−1
• src/Data/ByteString/IsoBaseFileFormat/Boxes/SampleToChunk.hs +32/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/SegmentType.hs +25/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Skip.hs +6/−4
• src/Data/ByteString/IsoBaseFileFormat/Boxes/SoundMediaHeader.hs +4/−3
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Time.hs +0/−72
• src/Data/ByteString/IsoBaseFileFormat/Boxes/TimeToSample.hs +4/−3
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Track.hs +1/−1
• src/Data/ByteString/IsoBaseFileFormat/Boxes/TrackExtends.hs +62/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/TrackFragBaseMediaDecodeTime.hs +32/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/TrackFragment.hs +23/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/TrackFragmentHeader.hs +33/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/TrackHeader.hs +39/−19
• src/Data/ByteString/IsoBaseFileFormat/Boxes/TrackRun.hs +80/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Versioned.hs +0/−24
• src/Data/ByteString/IsoBaseFileFormat/Boxes/VideoMediaHeader.hs +4/−3
• src/Data/ByteString/IsoBaseFileFormat/Boxes/VisualSampleEntry.hs +10/−24
• src/Data/ByteString/IsoBaseFileFormat/Brands/Dash.hs +32/−54
• src/Data/ByteString/IsoBaseFileFormat/Brands/Types.hs +0/−17
• src/Data/ByteString/IsoBaseFileFormat/MediaFile.hs +18/−0
• src/Data/ByteString/IsoBaseFileFormat/ReExports.hs +41/−0
• src/Data/ByteString/IsoBaseFileFormat/Util/BitRecords.hs +0/−214
• src/Data/ByteString/IsoBaseFileFormat/Util/BoxFields.hs +304/−0
• src/Data/ByteString/IsoBaseFileFormat/Util/FullBox.hs +93/−0
• src/Data/ByteString/IsoBaseFileFormat/Util/Time.hs +140/−0
• src/Data/ByteString/IsoBaseFileFormat/Util/Versioned.hs +25/−0
• src/Data/ByteString/Mp4/AudioStreaming.hs +292/−0
• src/Data/ByteString/Mp4/Boxes/AudioSpecificConfig.hs +310/−0
• src/Data/ByteString/Mp4/Boxes/BaseDescriptor.hs +72/−0
• src/Data/ByteString/Mp4/Boxes/DecoderConfigDescriptor.hs +55/−0
• src/Data/ByteString/Mp4/Boxes/DecoderSpecificInfo.hs +112/−0
• src/Data/ByteString/Mp4/Boxes/ElementaryStreamDescriptor.hs +80/−0
• src/Data/ByteString/Mp4/Boxes/Expandable.hs +73/−0
• src/Data/ByteString/Mp4/Boxes/Mp4AudioSampleEntry.hs +90/−0
• src/Data/ByteString/Mp4/Boxes/SyncLayerConfigDescriptor.hs +18/−0
• src/Data/Kind/Extra.hs +156/−0
• src/Data/Type/BitRecords.hs +21/−0
• src/Data/Type/BitRecords/Arithmetic.hs +118/−0
• src/Data/Type/BitRecords/Assert.hs +91/−0
• src/Data/Type/BitRecords/Builder/BitBuffer.hs +163/−0
• src/Data/Type/BitRecords/Builder/Holey.hs +49/−0
• src/Data/Type/BitRecords/Builder/LazyByteStringBuilder.hs +322/−0
• src/Data/Type/BitRecords/Core.hs +379/−0
• src/Data/Type/BitRecords/Enum.hs +141/−0
• src/Data/Type/BitRecords/Sized.hs +73/−0
• src/Data/Type/BitRecords/SizedString.hs +74/−0
• stack.yaml +3/−61

@@ -6,6 +6,9 @@ *_flymake.hs .hsenv .stack-work/+/*.html TAGS /.idea/ /.dir-locals.el+*.refactored.hs+/*.html

@@ -18,7 +18,7 @@  install:   - stack -j 2 setup --no-terminal --resolver nightly-  - stack -j 2 build --only-snapshot --no-terminal  script:-  - stack -j 2 test --no-terminal+  - stack test --flag isobmff-builder:-complextests --flag isobmff-builder:-fullbenchmarks --fast --no-terminal+  - stack bench --flag isobmff-builder:-complextests --flag isobmff-builder:-fullbenchmarks --fast --no-terminal

@@ -1,4 +1,4 @@-Copyright Sven Heyll (c) 2016+Copyright Sven Heyll and Lindenbaum GmbH (c) 2016  All rights reserved. 

@@ -1,5 +1,5 @@ [![Build Status](https://travis-ci.org/sheyll/isobmff-builder.svg?branch=master)](https://travis-ci.org/sheyll/isobmff-builder)-[![Hackage](https://img.shields.io/badge/hackage-isobmff-green.svg?style=flat)](http://hackage.haskell.org/package/isobmff-builder)+[![Hackage](https://img.shields.io/badge/hackage-isobmffbuilder-green.svg?style=flat)](http://hackage.haskell.org/package/isobmff-builder)  # ISO-14496-12 Base Media File Format Builder 

@@ -0,0 +1,193 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE CPP #-}+module Main where++import           Prelude hiding ( (.), id )+import           Control.Category+import           Criterion.Main+import qualified Data.ByteString.Builder as L+import qualified Data.ByteString.Lazy as L+import           Data.Proxy+import           Data.Type.BitRecords+import           Data.Word+import           Data.Tagged+import           GHC.TypeLits ()+#ifdef FULLBENCHMARKS+import           Data.Type.Equality+#endif+import           Test.TypeSpecCrazy++#ifdef FULLBENCHMARKS++type Static64 =+      Field 3 := 2+  .+. Field 5 := 4+  .+. Field 9 := 333+  .+. Field 7 := 35+  .+. Field 30 := 458329+  .+. Field 2 := 1+  .+. Field 2 := 0+  .+. Field 2 := 1+  .+. Field 4 := 9+++type Static64WithParams =+      Field 3 := 0+  .+. Field 5 := 0+  .+. Field 9 := 0+  .+. "x" @: Field 7+  .+. Field 30 := 0+  .+. "y" @: Field 2+  .+. Field 2 := 0+  .+. Field 2 := 0+  .+. Field 4 := 0++type Static128 = Field 64 := 3735928559 .+. Field 64 := 3405688830++type Static256 = Static64 :+: Static128 :+: Static64++type Static517 = Static256 :+: Static256 :+. Field 5 := 0++#else++type Static64 = 'BitRecordMember (Field 64 := 0)+++type Static64WithParams =+      "x" @: Field 32+  .+. "y" @: Field 32++#endif++aboutStatic64 ::++  "Test Types Sizes"+  ########################++        It's "64 bit long: Static64" (ShouldBe 64 (BitRecordSize Static64))+     -* It's "64 bit long: Static64WithParams" (ShouldBe 64 (BitRecordSize Static64WithParams))+#ifdef FULLBENCHMARKS+     -* It's "128 bit long" (ShouldBeTrue ((BitRecordSize Static128) == 128))+     -* It's "256 bit long" (ShouldBeTrue ((BitRecordSize Static256) == 256))+     -* It's "517 bit long" (ShouldBeTrue ((BitRecordSize Static517) == 517))+#endif++aboutStatic64 =+  Valid++lumpUp :: Word64 -> L.Builder -> [Word8]+lumpUp m = L.unpack . L.toLazyByteString . mconcat . replicate (fromIntegral m)++static64 m = lumpUp m $+    runBitStringBuilderHoley $ bitStringBuilderHoley (Proxy :: Proxy Static64)++static64WithParam m = lumpUp m $+    runBitStringBuilderHoley (bitStringBuilderHoley (Proxy :: Proxy Static64WithParams))+                        (B m)+                        (B m)++#ifdef FULLBENCHMARKS++static128 m =+  lumpUp m $ runBitStringBuilderHoley $ bitStringBuilderHoley (Proxy :: Proxy Static128)++static256 m =+  lumpUp m $ runBitStringBuilderHoley $ bitStringBuilderHoley (Proxy :: Proxy Static256)++static517 m =+  lumpUp m $ runBitStringBuilderHoley $ bitStringBuilderHoley (Proxy :: Proxy Static517)++staticPlain512bitBaseline m =+  lumpUp m $ runBitStringBuilderHoley $ bitStringBuilderHoley+    (Proxy :: Proxy (+      Field 64 .+. Field 64 .+. Field 64 .+. Field 64 .+.+      Field 64 .+. Field 64 .+. Field 64 .+. Field 64+    ))+++#endif++main = do+    print aboutStatic64+    defaultMain [ bgroup "ByteStringBuilder"+                         [ bgroup "64-bit"+                                  [ bench "1" $ nf static64 1+                                  , bench "100" $ nf static64 5+                                  , bench "1000" $ nf static64 1000+                                  ]+                         , bgroup "64-bit parameterized"+                                  [ bench "1" $+                                      nf static64WithParam 1+                                  , bench "100" $+                                      nf static64WithParam 5+                                  , bench "1000" $+                                      nf static64WithParam 1000+                                  ]+#ifdef FULLBENCHMARKS+                         , bgroup "128-bit"+                                  [ bench "1" $+                                      nf static128 1+                                  , bench "100" $+                                      nf static128 5+                                  , bench "1000" $+                                      nf static128 1000+                                  ]+                         , bgroup "256-bit"+                                  [ bench "1" $+                                      nf static256 1+                                  , bench "100" $+                                      nf static256 5+                                  , bench "1000" $+                                      nf static256 1000+                                  ]+                         , bgroup "517-bit"+                                  [ bench "1" $+                                      nf static517 1+                                  , bench "100" $+                                      nf static517 5+                                  , bench "1000" $+                                      nf static517 1000+                                  ]+                         , bgroup "512-bit baseline"+                                  [ bench "1" $+                                      nf staticPlain512bitBaseline 1+                                  , bench "100" $+                                      nf staticPlain512bitBaseline 100+                                  , bench "1000" $+                                      nf staticPlain512bitBaseline 1000+                                  ]+#endif+                         , bgroup "BitString Word64 direct"+                                  [ bench "1" $+                                      nf bitStringWord64Direct 1+                                  , bench "100" $+                                      nf bitStringWord64Direct 5+                                  , bench "1000" $+                                      nf bitStringWord64Direct 1000+                                  ]+                         , bgroup "BitString Word64 holey"+                                  [ bench "1" $+                                      nf bitStringWord64Holey 1+                                  , bench "100" $+                                      nf bitStringWord64Holey 5+                                  , bench "1000" $+                                      nf bitStringWord64Holey 1000+                                  ]+                         ]+                ]++bitStringWord64Direct m =+  lumpUp 1+    $ runBitStringBuilder+    $ mconcat+    $ replicate m+    $ appendBitString+    $ bitString 64 0x01020304050607++bitStringWord64Holey m =+  lumpUp 1+    $ runBitStringBuilderHoley+    $ mconcat+    $ replicate m+    $ bitStringBuilderHoley+    $ bitString 64 0x01020304050607

@@ -0,0 +1,36 @@+# `esds` Box Contents++      00000027 65736473 00000000++         ES_Descriptor+         | length+      x 03 |   ES_ID+      x   19   |sdf+      x     0001|url+      b         0|ocr+      b          0|    stream priority+      b           0    | DecoderConfigDescriptor+      b            00000 | length+      x                 04 | objectype indication: Audio ISO/IEC 14496-3+      x                   11 |     stream-type: 0x5 AudioStream+      x                     40     |Upstream+      b                       000101|reserved+      b                             0|     BufferSize DB+      b                              1     |       maxBitrate+      x                               000000       |       avgBitrate+      x                                     00000000       | DecoderSpecificInfo+      x                                             00000000 | length+      x                                                     05 |+      x                                                       02+      x                                                            1   1   9   0+      =b                                                        00010 - audioObjectType: 2 AAC LC+      =b                                                             0011 - (=3) samplingFrequencyIndex: 48k+      =b                                                                 0010 - channelConfiguration: channel pair+      =b                                                                     0 - frameLenflag           \+      =b                                                                      0 - dependsOnCoreCoder     | GASpecificconfig+      =b                                                                       0 - coreCoderDelay       /+                                                             SLConfigDescrTag+                                                             | length: 1+      x                                                     06 | Predefined according to iso 14496-14 section 3.1.2+      x                                                       01 |+      x                                                         02

@@ -0,0 +1,43 @@++# Contents of a `trun` box+++                                            0000 047c+    00000060: 7472 756e 0000 0701 0000 005e 0000 04c8+    00000070: 0000 0400 0000 0095 0200 0000 0000 0400+    00000080: 0000 0076 0200 0000 0000 0400 0000 008c+    00000090: 0200 0000 0000 0400 0000 008b 0200 0000+    000000a0: 0000 0400 0000 0094 0200 0000 0000 0400+    000000b0: 0000 007a 0200 0000 0000 0400 0000 0087+    000000c0: 0200 0000 0000 0400 0000 0099 0200 0000+    000000d0: 0000 0400 0000 0095 0200 0000 0000 0400++## Box header++    0x0000047c        size+    0x7472 756e       'trun'+    0x00              version+    0x000701          flags+    0x0000005e        sample_count = 94+    0x000004c8        data_offset++## A closer look at a single entry++    0x00000400        sample duration+    0x00000095        sample size+    0x02000000        sample flags+++### Sample flags++    0    2    0    0    0    0    0    0      (hex)+    0000 0010 0000 0000 0000 0000 0000 0000   (binary)++    0000 -> 4 bits reserved = 0+         00 -> is_leading+           10 -> sample_depends+              00 -> sample_is_depended_on+                00 -> sample has redundancy+                   000 -> padding+                      0 -> non sync+                        0000 0000 0000 0000  degradation priority

binary file changed (13293 → absent bytes)

@@ -1,16 +0,0 @@-<?xml version="1.0" encoding="utf-8"?>-<MPD availabilityStartTime="1970-01-01T00:00:00Z" maxSegmentDuration="PT2S" minBufferTime="PT2S" minimumUpdatePeriod="P100Y" profiles="urn:mpeg:dash:profile:isoff-live:2011,http://dashif.org/guidelines/dash-if-simple" timeShiftBufferDepth="PT5M" type="dynamic" ns1:schemaLocation="urn:mpeg:dash:schema:mpd:2011 DASH-MPD.xsd" xmlns="urn:mpeg:dash:schema:mpd:2011" xmlns:ns1="http://www.w3.org/2001/XMLSchema-instance">-   <ProgramInformation>-      <Title>Media Presentation Description for audio only from DASH-IF live simulator</Title>-   </ProgramInformation>-   <BaseURL>http://vm2.dashif.org/livesim/testpic_2s/</BaseURL>-<Period id="p0" start="PT0S">-      <AdaptationSet contentType="audio" lang="eng" mimeType="audio/mp4" segmentAlignment="true" startWithSAP="1">-         <Role schemeIdUri="urn:mpeg:dash:role:2011" value="main" />-         <SegmentTemplate duration="2" initialization="$RepresentationID$/init.mp4" media="$RepresentationID$/$Number$.m4s" startNumber="0" />-         <Representation audioSamplingRate="48000" bandwidth="48000" codecs="mp4a.40.2" id="A48">-            <AudioChannelConfiguration schemeIdUri="urn:mpeg:dash:23003:3:audio_channel_configuration:2011" value="2" />-         </Representation>-      </AdaptationSet>-   </Period>-</MPD>

binary file changed (651 → absent bytes)

@@ -1,13 +1,13 @@ name:                isobmff-builder-version:             0.10.5.0+version:             0.11.2.0 synopsis:            A (bytestring-) builder for the ISO-14496-12 base media file format description:         Please see README.md homepage:            https://github.com/sheyll/isobmff-builder#readme license:             BSD3 license-file:        LICENSE author:              Sven Heyll-maintainer:          sven.heyll@gmail.com-copyright:           2016 Sven Heyll+maintainer:          sven.heyll@lindenbaum.eu+copyright:           2016 Sven Heyll, Lindenbaum GmbH category:            Codec build-type:          Simple extra-source-files:   README.md@@ -15,24 +15,34 @@                     , .travis.yml                     , doc/basic-structure.svg                     , doc/data_reference_box.svg-                    , examples/734397657.m4s-                    , examples/init.mp4-                    , examples/audio.mpd+                    , doc/ES_Descriptor.markDown+                    , doc/trun.markDown                     , .gitignore cabal-version:       >=1.10 +flag tracing+  description: Build with trace output enabled+  default:     True++flag fullbenchmarks+  description: Enable the compilation of all benchmarks, takes a long time to compile+  default:     True++flag complextests+  description: Enable the compilation of all unit tests, even those, that take a long time to compile+  default:     True+ library   hs-source-dirs:      src-  exposed-modules:     Data.ByteString.IsoBaseFileFormat.Boxes+  exposed-modules:     Data.ByteString.IsoBaseFileFormat.Box+                     , Data.ByteString.IsoBaseFileFormat.Boxes                      , Data.ByteString.IsoBaseFileFormat.Boxes.AudioSampleEntry-                     , Data.ByteString.IsoBaseFileFormat.Boxes.Box-                     , Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+                     , Data.ByteString.IsoBaseFileFormat.Boxes.ChunkOffset                      , Data.ByteString.IsoBaseFileFormat.Boxes.DataEntryUrl                      , Data.ByteString.IsoBaseFileFormat.Boxes.DataEntryUrn                      , Data.ByteString.IsoBaseFileFormat.Boxes.DataInformation                      , Data.ByteString.IsoBaseFileFormat.Boxes.DataReference                      , Data.ByteString.IsoBaseFileFormat.Boxes.FileType-                     , Data.ByteString.IsoBaseFileFormat.Boxes.FullBox                      , Data.ByteString.IsoBaseFileFormat.Boxes.Handler                      , Data.ByteString.IsoBaseFileFormat.Boxes.HintMediaHeader                      , Data.ByteString.IsoBaseFileFormat.Boxes.HintSampleEntry@@ -42,46 +52,90 @@                      , Data.ByteString.IsoBaseFileFormat.Boxes.MediaInformation                      , Data.ByteString.IsoBaseFileFormat.Boxes.MetaDataSampleEntry                      , Data.ByteString.IsoBaseFileFormat.Boxes.Movie+                     , Data.ByteString.IsoBaseFileFormat.Boxes.MovieExtends+                     , Data.ByteString.IsoBaseFileFormat.Boxes.MovieExtendsHeader+                     , Data.ByteString.IsoBaseFileFormat.Boxes.MovieFragment+                     , Data.ByteString.IsoBaseFileFormat.Boxes.MovieFragmentHeader                      , Data.ByteString.IsoBaseFileFormat.Boxes.MovieHeader                      , Data.ByteString.IsoBaseFileFormat.Boxes.NullMediaHeader                      , Data.ByteString.IsoBaseFileFormat.Boxes.ProgressiveDownloadInformation                      , Data.ByteString.IsoBaseFileFormat.Boxes.Language                      , Data.ByteString.IsoBaseFileFormat.Boxes.SampleDescription                      , Data.ByteString.IsoBaseFileFormat.Boxes.SampleEntry+                     , Data.ByteString.IsoBaseFileFormat.Boxes.SampleSize                      , Data.ByteString.IsoBaseFileFormat.Boxes.SampleTable+                     , Data.ByteString.IsoBaseFileFormat.Boxes.SampleToChunk+                     , Data.ByteString.IsoBaseFileFormat.Boxes.SegmentType                      , Data.ByteString.IsoBaseFileFormat.Boxes.Skip                      , Data.ByteString.IsoBaseFileFormat.Boxes.SoundMediaHeader                      , Data.ByteString.IsoBaseFileFormat.Boxes.SpecificMediaHeader-                     , Data.ByteString.IsoBaseFileFormat.Boxes.Time                      , Data.ByteString.IsoBaseFileFormat.Boxes.TimeToSample                      , Data.ByteString.IsoBaseFileFormat.Boxes.Track+                     , Data.ByteString.IsoBaseFileFormat.Boxes.TrackExtends+                     , Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragBaseMediaDecodeTime+                     , Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragment+                     , Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragmentHeader                      , Data.ByteString.IsoBaseFileFormat.Boxes.TrackHeader-                     , Data.ByteString.IsoBaseFileFormat.Boxes.Versioned+                     , Data.ByteString.IsoBaseFileFormat.Boxes.TrackRun                      , Data.ByteString.IsoBaseFileFormat.Boxes.VideoMediaHeader                      , Data.ByteString.IsoBaseFileFormat.Boxes.VisualSampleEntry                      , Data.ByteString.IsoBaseFileFormat.Brands.Dash-                     , Data.ByteString.IsoBaseFileFormat.Brands.Types+                     , Data.ByteString.IsoBaseFileFormat.MediaFile+                     , Data.ByteString.IsoBaseFileFormat.ReExports+                     , Data.ByteString.IsoBaseFileFormat.Util.BoxFields+                     , Data.ByteString.IsoBaseFileFormat.Util.FullBox+                     , Data.ByteString.IsoBaseFileFormat.Util.Time                      , Data.ByteString.IsoBaseFileFormat.Util.TypeLayout-                     , Data.ByteString.IsoBaseFileFormat.Util.BitRecords+                     , Data.ByteString.IsoBaseFileFormat.Util.Versioned+                     , Data.ByteString.Mp4.Boxes.AudioSpecificConfig+                     , Data.ByteString.Mp4.Boxes.BaseDescriptor+                     , Data.ByteString.Mp4.Boxes.DecoderConfigDescriptor+                     , Data.ByteString.Mp4.Boxes.DecoderSpecificInfo+                     , Data.ByteString.Mp4.Boxes.ElementaryStreamDescriptor+                     , Data.ByteString.Mp4.Boxes.Expandable+                     , Data.ByteString.Mp4.Boxes.Mp4AudioSampleEntry+                     , Data.ByteString.Mp4.Boxes.SyncLayerConfigDescriptor+                     , Data.ByteString.Mp4.AudioStreaming+                     , Data.Kind.Extra+                     , Data.Type.BitRecords+                     , Data.Type.BitRecords.Arithmetic+                     , Data.Type.BitRecords.Assert+                     , Data.Type.BitRecords.Builder.BitBuffer+                     , Data.Type.BitRecords.Builder.Holey+                     , Data.Type.BitRecords.Builder.LazyByteStringBuilder+                     , Data.Type.BitRecords.Core+                     , Data.Type.BitRecords.Enum+                     , Data.Type.BitRecords.SizedString+                     , Data.Type.BitRecords.Sized   build-depends:       base >= 4.9 && < 5                      , bytestring >= 0.10.8.1 && < 0.11                      , type-list >= 0.5.0.0 && < 0.6                      , data-default >= 0.7.1.1 && < 0.8-                     , vector-sized >= 0.3.2.0 && < 0.4+                     , vector >= 0.11 && < 0.12                      , singletons >= 2.2 && < 3                      , tagged >= 0.8 && < 1                      , time >= 1.6.0.1 && < 2                      , text >= 1.2.2.1 && < 2-                     , type-spec >= 0.1+                     , type-spec >= 0.3+                     , mtl >= 2.2 && < 3+                     , pretty-types >= 0.2.3 && < 0.3+                     , template-haskell >= 2.11 && < 3   default-language:    Haskell2010-  ghc-options:       -Wall -funbox-strict-fields -fno-warn-unused-do-bind-  default-extensions:  ConstraintKinds+  ghc-options:       -O2 -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fprint-explicit-kinds+  if flag(tracing)+    cpp-options:      -DTRACING+  else+    cpp-options:      -DNTRACING++  default-extensions:  BangPatterns+                     , ConstraintKinds                      , CPP                      , DataKinds                      , DefaultSignatures                      , DeriveDataTypeable                      , DeriveFunctor                      , DeriveGeneric+                     , DuplicateRecordFields                      , FlexibleInstances                      , FlexibleContexts                      , FunctionalDependencies@@ -97,32 +151,44 @@                      , StandaloneDeriving                      , TemplateHaskell                      , TupleSections+                     , TypeApplications                      , TypeFamilies                      , TypeInType                      , TypeOperators                      , TypeSynonymInstances-+                     , UnicodeSyntax test-suite spec   type:                exitcode-stdio-1.0   ghc-options:         -Wall   hs-source-dirs:      spec   default-language:    Haskell2010   main-is:             Spec.hs-  other-modules:       BoxFieldsSpec+  other-modules:       BitRecordsSpec+                     , BoxFieldsSpec                      , BoxSpec-                     , BrandTypeSpec                      , DataReferenceSpec-                     , DashSpec+                     , ElementaryStreamDescriptorSpec+                     , EnumSpec+                     , ExpandableSpec+                     , Mp4AudioSampleEntry+                     , MediaFileSpec+                     , Mp4AudioFileSpec+                     , Mp4AudioSegmentSpec                      , TypeLayoutSpec   build-depends:       base >= 4.9 && < 5                      , bytestring >= 0.10.8.1-                     , hspec+                     , hspec >= 2.2 && < 3                      , isobmff-builder                      , binary                      , text >= 1.2.2.1 && < 2-                     , type-spec >= 0.1+                     , type-spec >= 0.3+                     , mtl >= 2.2 && < 3+                     , QuickCheck+                     , tagged >= 0.8 && < 1+                     , pretty-types >= 0.2.1 && < 0.3   default-language:    Haskell2010-  default-extensions:  ConstraintKinds+  default-extensions:  BangPatterns+                     , ConstraintKinds                      , CPP                      , DataKinds                      , DefaultSignatures@@ -144,12 +210,68 @@                      , StandaloneDeriving                      , TemplateHaskell                      , TupleSections+                     , TypeApplications                      , TypeFamilies                      , TypeInType                      , TypeOperators                      , TypeSynonymInstances+                     , UnicodeSyntax   ghc-options:       -Wall -O0 -j +RTS -A256m -n2m -RTS-                     -fwarn-unused-binds -fno-warn-unused-do-bind -fno-warn-missing-signatures+                     -fwarn-unused-binds -fno-warn-unused-do-bind -fno-warn-missing-signatures -fprint-explicit-kinds+  if flag(complextests)+    cpp-options:      -DCOMPLEXTESTS+  else+    cpp-options:      -DNCOMPLEXTESTS++benchmark bit-records+  type:                exitcode-stdio-1.0+  hs-source-dirs:      benchmarks/bit-records+  main-is:             Main.hs+  default-language:    Haskell2010+  build-depends:       base >= 4.9 && < 5+                     , isobmff-builder+                     , binary+                     , bytestring >= 0.10.8.1 && < 0.11+                     , criterion >= 1.1 && < 2+                     , tagged >= 0.8 && < 1+                     , type-spec >= 0.3+  default-language:    Haskell2010+  default-extensions:  BangPatterns+                     , ConstraintKinds+                     , CPP+                     , DataKinds+                     , DefaultSignatures+                     , DeriveDataTypeable+                     , DeriveFunctor+                     , DeriveGeneric+                     , FlexibleInstances+                     , FlexibleContexts+                     , FunctionalDependencies+                     , GADTs+                     , GeneralizedNewtypeDeriving+                     , KindSignatures+                     , MultiParamTypeClasses+                     , OverloadedStrings+                     , QuasiQuotes+                     , RecordWildCards+                     , RankNTypes+                     , ScopedTypeVariables+                     , StandaloneDeriving+                     , TemplateHaskell+                     , TupleSections+                     , TypeApplications+                     , TypeFamilies+                     , TypeInType+                     , TypeOperators+                     , TypeSynonymInstances+                     , UnicodeSyntax+  ghc-options:       -O2 -j +RTS -A256m -n2m -RTS+                     -Wall -fwarn-unused-binds+                     -fno-warn-unused-do-bind -fprint-explicit-kinds+  if flag(fullbenchmarks)+    cpp-options:       -DFULLBENCHMARKS+  else+    cpp-options:       -DNFULLBENCHMARKS  source-repository head   type:     git

@@ -0,0 +1,470 @@+{-# LANGUAGE UndecidableInstances #-}+module BitRecordsSpec (spec) where++import Data.Bits+import Data.ByteString.Builder+import Data.Proxy+import Data.Type.BitRecords+import Data.Type.Equality ()+import Data.Kind.Extra+import GHC.TypeLits+import Prelude hiding ((.), id)+import Test.Hspec+import Test.QuickCheck (property, Arbitrary(..), choose)+import Test.TypeSpecCrazy+import Text.Printf++basicsSpec = do+  describe "Maybe, Lists, Either, Bool, 'True, 'False, FlagJust, FlagNothing" $ do+    let checkFlagJust ::+          "Type Level Bool, 'True, 'False, FlagJust, FlagNothing Accessors"+          ##################################################################++          "The record size works"+          ~~~~~~~~~~~~~~~~~~~~~~~~+              1 `ShouldBe` BitRecordFieldSize (FlagJust 'Nothing)+          -*  1 `ShouldBe` BitRecordFieldSize (FlagJust ('Just "Blah"))+          -*  1 `ShouldBe` BitRecordFieldSize (FlagNothing ('Just "Blah"))+          -- TODO reenable tests+          -- -*  32 `ShouldBe` BitRecordSize (ToBitRecord ('Just FieldU32))+          -- -*  0 `ShouldBe` BitRecordSize (ToBitRecord '[])+          -- -*  10 `ShouldBe` BitRecordSize (ToBitRecord '[Field 10])+          -- -*  25 `ShouldBe` BitRecordSize (ToBitRecord '[Field 10, Field 15])+          -- -*  1 `ShouldBe` BitRecordSize (ToBitRecord Bool)+          -- -*  1 `ShouldBe` BitRecordSize (ToBitRecord 'True)+          -- -*  1 `ShouldBe` BitRecordSize (ToBitRecord 'False)+        checkFlagJust = Valid+    runIO $ print checkFlagJust+  describe "bitStringBuilder" $ do+    describe "Just x" $ it "writes x" $+      bitStringPrinter (Proxy :: Proxy (OptionalRecord ('Just ('BitRecordMember (Flag := 'True))))) `shouldBe` "<< 80 >>"+    describe "Nothing" $ it "writes nothing" $+      bitStringPrinter (Proxy :: Proxy (OptionalRecord ('Nothing))) `shouldBe` "<<  >>"+    -- describe "'[]" $ it "writes nothing" $+    --   bitStringPrinter (Proxy :: Proxy (BitRecordOfList (Fun1 RecordField)  ('[]))) `shouldBe` "<<  >>"+    -- describe "'[x1, x2]" $ it "writes x1 then x2" $+    --   bitStringPrinter (Proxy :: Proxy (BitRecordOfList (Fun1 RecordField) ('[FieldU8 := 1, FieldU8 := 2]))) `shouldBe` "<< 01 02 >>"+    describe "'True" $ it "writes a single bit with a 1" $+      bitStringPrinter (Proxy :: Proxy (RecordField (Flag := 'True))) `shouldBe` "<< 80 >>"+    describe "'False" $ it "writes a single bit with a 0" $+      bitStringPrinter (Proxy :: Proxy (RecordField (Flag := 'False))) `shouldBe` "<< 00 >>"+    describe "@: labelled fields"  $ do+      it "writes them ..." $+        let fld = Proxy @(Eval (RecordField ( "foo" @: FlagJust 'Nothing  )))+        in bitStringPrinter fld `shouldBe` "<< 00 >>"+    describe "FlagJust" $ do+      it "writes a single bit '1' for a 'Just ...' parameter" $+        bitStringPrinter (Proxy :: Proxy (RecordField (FlagJust ('Just "test")))) `shouldBe` "<< 80 >>"+      it "writes a single bit '0' for a 'Nothing' parameter" $+        bitStringPrinter (Proxy :: Proxy (RecordField (FlagJust 'Nothing))) `shouldBe` "<< 00 >>"+    describe "FlagNothing" $ do+      it "writes a single bit '0' for a 'Just ...' parameter" $+        bitStringPrinter (Proxy :: Proxy (RecordField (FlagNothing ('Just "test")))) `shouldBe` "<< 00 >>"+      it "writes a single bit '1' for a 'Nothing' parameter" $+        bitStringPrinter (Proxy :: Proxy (RecordField (FlagNothing 'Nothing))) `shouldBe` "<< 80 >>"+  -- TODO reenable showRecord tests+  -- describe "showRecord" $ do+  --   describe "Maybe" $ do+  --     it "prints 'Just x'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord ('Just 'True))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\n  Static Value: 'True"+  --     it "prints nothing for 'Nothing'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord ('Nothing))) `shouldBe` ""+  --   describe "List" $ do+  --     it "prints '[x]'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord ('[ 'True ]))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\n  Static Value: 'True"+  --     it "prints '[x1, x2, x3]'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord ('[ Bool, Bool, Bool ]))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\nField:\n  Demote Rep: Bool\n  Bits: 1\nField:\n  Demote Rep: Bool\n  Bits: 1"+  --     it "prints nothing for '[]'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord ('[]))) `shouldBe` ""+  --   describe "Bool" $ do+  --     it "prints 'True" $+  --       showRecord (Proxy :: Proxy (ToBitRecord ('True))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\n  Static Value: 'True"+  --     it "prints 'False" $+  --       showRecord (Proxy :: Proxy (ToBitRecord ('False))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\n  Static Value: 'False"+  --     it "prints a Bool" $+  --       showRecord (Proxy :: Proxy (ToBitRecord Bool)) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1"+  --   describe "FlagJust" $ do+  --     it "prints a 'FlagJust 'Just ..'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord (FlagJust ('Just "123")))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\n  Static Value: 'True"+  --     it "prints a 'FlagJust 'Nothing'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord (FlagJust 'Nothing))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\n  Static Value: 'False"+  --   describe "FlagNothing" $ do+  --     it "prints 'FlagNothing 'Just ..'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord (FlagNothing ('Just "123")))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\n  Static Value: 'False"+  --     it "prints a 'FlagNothing 'Nothing'" $+  --       showRecord (Proxy :: Proxy (ToBitRecord (FlagNothing 'Nothing))) `shouldBe` "Field:\n  Demote Rep: Bool\n  Bits: 1\n  Static Value: 'True"++#ifdef COMPLEXTESTS+arraySpec :: SpecWith ()+arraySpec =+    describe "RecArray" $ do+      describe "level record accessors" $ do+        let checkArrayRec ::+              "BitRecord accessors involving RecArray"+              #######################################++              "The record size works"+              ~~~~~~~~~~~~~~~~~~~~~~~~+                  1 `ShouldBe` BitRecordSize (Eval (RecArray ('BitRecordMember Flag) 1))+              -* 91 `ShouldBe` BitRecordSize (Eval (("foo" @: Flag .+. FieldU8) ^^ 10) :+. Flag)+              -* 91 `ShouldBe` BitRecordSize (Eval (RecArray ("foo" @: Flag .+. FieldU8) 10) :+. Flag)+            checkArrayRec = Valid+        runIO $ print checkArrayRec+      describe "showRecord" $+        it "appends its body n times" $+        let expected = "utf-8(40) := <<hello>> [5 Bytes]\nutf-8(40) := <<hello>> [5 Bytes]\nutf-8(40) := <<hello>> [5 Bytes]\nutf-8(40) := <<hello>> [5 Bytes]\nutf-8(40) := <<hello>> [5 Bytes]"+            actual = showARecord (Proxy @ (('BitRecordMember [utf8|hello|] ^^ 5)))+            in actual `shouldBe` expected+      describe "bitStringBuilder" $+        it "writes its contents n times to the builder" $+          let actual = bitStringPrinter (Proxy :: Proxy (('BitRecordMember (Field 24 := 0x010203) ^^ 4)))+              expected = "<< 01 02 03 01 02 03 01 02 03 01 02 03 >>"+              in actual `shouldBe` expected++sizedSpec =+  describe "Sized" $ do+    describe "TypeChecks" $+      let+          checkSized ::+             "Sized"+            #########++            "SizedString"+            ~~~~~~~~~~~~~~~+                88 `ShouldBe` BitRecordFieldSize [utf8|Hello World|]+            -* 104 `ShouldBe` BitRecordSize (Eval (RecordField [utf8|Heλλo World|]))++            -/-++            "Sized BitRecord Members"+            ~~~~~~~~~~~~~~~~~~~~~~~~+                8 `ShouldBe` BitRecordSize (Eval (Sized8 'EmptyBitRecord))+            -*  9 `ShouldBe` BitRecordSize (Eval (Sized8 ('BitRecordMember Flag)))+            -*  0 `ShouldBe` SizeFieldValue 'EmptyBitRecord+            -*  1 `ShouldBe` SizeFieldValue ('BitRecordMember Flag)++            -/-++            "SizedField"+            ~~~~~~~~~~~~+                9 `ShouldBe` BitRecordSize (Eval (SizedField8 Flag))+            -*  1 `ShouldBe` SizeFieldValue  Flag++            -- TODO add more Sized tests, especially for SizedField+          checkSized = Valid+      in runIO $ print checkSized+    describe "showRecord" $ do+      describe "SizedString" $+        it "renders a string containing wide utf-8 characters to a header containing the number of chars and the actual string" $+        showARecord (Proxy :: Proxy (RecordField [utf8|Heλλo World!|])) `shouldBe` "utf-8(112) := <<He\955\955o World!>> [14 Bytes]"+      describe "Sized SizeField16 SizedString" $+        it "renders the number bytes not chars as the size field value" $+        showARecord (Proxy :: Proxy (SizedField16 [utf8|Heλλo World!|])) `shouldBe` "sized-field\n  size: U16 := hex: 000e (dec: 14)\n  utf-8(112) := <<He\955\955o World!>> [14 Bytes]"+    describe "bitStringBuilder" $ do+      describe "no length prefix" $+        it "renders no size prefix and the string as UTF-8 bytes" $+        bitStringPrinter (Proxy :: Proxy (RecordField [utf8|ABC|]))+        `shouldBe`+        "<< 41 42 43 >>"+      describe "8-bit length prefix" $+        it "renders a single byte size prefix and the string as UTF-8 bytes" $+        bitStringPrinter (Proxy :: Proxy (SizedField8 [utf8|ABC|]))+        `shouldBe`+        "<< 03 41 42 43 >>"+      describe "16-bit length prefix" $+        it "renders a big endian 16 bit size prefix and the string as UTF-8 bytes" $+        bitStringPrinter (Proxy :: Proxy (SizedField16 [utf8|ABC|]))+        `shouldBe`+        "<< 00 03 41 42 43 >>"+      describe "32-bit length prefix" $+        it "renders a big endian 32 bit size prefix and the string as UTF-8 bytes" $+        bitStringPrinter (Proxy :: Proxy (SizedField32 [utf8|ABC|]))+        `shouldBe`+        "<< 00 00 00 03 41 42 43 >>"+      describe "64-bit length prefix" $+        it "renders a big endian 64 bit size prefix and the string as UTF-8 bytes" $+        bitStringPrinter (Proxy :: Proxy (SizedField64 [utf8|ABC|]))+        `shouldBe`+        "<< 00 00 00 00 00 00 00 03 41 42 43 >>"++type TestRecAligned =+  "bar" @: Field 8       .+:+            Field 8  := 0 .+:+  "baz" @: Field 8       .+:+            Field 32 := 0 .+:+  "foo" @: Field 8       .+:+            Field 8  := 0 .+:+  "oof" @: Field 8       .+:+            Field 8  := 0 .+.+  "rab" @: Field 8++checkTestRecAligned+  :: Expect '[ ShouldBe 96        (BitRecordSize TestRecAligned)  ]+checkTestRecAligned = Valid++type TestRecUnAligned =+  "bar" @: Field 8       .+:+            Field 8  := 0 .+:+  "baz" @: Field 7       .+:+            Field 32 := 0 .+:+  "foo" @: Field 8       .+.+            Field 8  := 0xfe++checkTestRecUnAligned+  :: Expect '[ ShouldBe 71        (BitRecordSize TestRecUnAligned) ]+checkTestRecUnAligned = Valid++testTakeLastN ::+  "Taking the last n elements of a list" #######################################++       TakeLastN 0 '[1,2,3] `ShouldBe` ('[] :: [Nat])+    -* TakeLastN 1 '[1,2,3] `ShouldBe` '[3]+    -* TakeLastN 2 '[1,2,3] `ShouldBe` '[2,3]+    -* TakeLastN 5 '[1,2,3] `ShouldBe` '[1,2,3]++testTakeLastN = Valid++testRem+  :: Expect '[ Rem 0 3 `ShouldBe` 0+             , Rem 1 3 `ShouldBe` 1+             , Rem 2 3 `ShouldBe` 2+             , Rem 3 3 `ShouldBe` 0+             , Rem 4 3 `ShouldBe` 1+             , Rem 5 3 `ShouldBe` 2+             , Rem 6 3 `ShouldBe` 0+            ]+testRem = Valid++testRemPow2+  ::+  "RemPow2"+  #########++  "Remainder of '1'"+  ~~~~~~~~~~~~~~~~~~++      It "1 `RemPow2` 1 is 1"  (Is 1 (RemPow2 1 1))+  -*  It "1 `RemPow2` 8 is 1"  (Is 1 (RemPow2 1 8))++  -/-++   "Remainder of '3916441'"+  ~~~~~~~~~~~~~~~~~~~~~~~~~~~++      It " `RemPow2` 1 is 1"   (Is 1 (RemPow2 3916441 1))+  -*  It " `RemPow2` 4 is 9"   (Is 9 (RemPow2 3916441 4))+  -*  It " `RemPow2` 8 is 153" (Is 153 (RemPow2 3916441 8))++testRemPow2 = Valid++testDiv+  :: Expect '[ Div 0 3 `ShouldBe` 0+             , Div 1 3 `ShouldBe` 0+             , Div 2 3 `ShouldBe` 0+             , Div 3 3 `ShouldBe` 1+             , Div 4 3 `ShouldBe` 1+             , Div 5 3 `ShouldBe` 1+             , Div 6 3 `ShouldBe` 2+             , Div 144 13 `ShouldBe` 11+             -- , Div 512 128 `ShouldBe` 11+            ]+testDiv = Valid++testNatBits+  :: "Type Level bit operations"+     ###########################++     "TestHighBit"+     ~~~~~~~~~~~~++        ShouldBeFalse (TestHighBit 127 8)+     -* ShouldBeFalse (TestHighBit 127 7)+     -* ShouldBeTrue  (TestHighBit 127 6)+     -* ShouldBeFalse (TestHighBit  32 6)+     -* ShouldBeTrue  (TestHighBit  32 5)+     -* ShouldBeFalse (TestHighBit  16 5)+     -* ShouldBeTrue  (TestHighBit  16 4)+     -* ShouldBeFalse (TestHighBit   8 4)+     -* ShouldBeTrue  (TestHighBit   8 3)+     -* ShouldBeFalse (TestHighBit   4 3)+     -* ShouldBeTrue  (TestHighBit   4 2)+     -* ShouldBeFalse (TestHighBit   2 2)+     -* ShouldBeTrue  (TestHighBit   2 1)+     -* ShouldBeFalse (TestHighBit   0 1)+     -* ShouldBeTrue  (TestHighBit   1 0)++  -/-++    "ToBits"+    ~~~~~~~~~++       It "returns the empty list for a zero bit length"+          (ToBits 1023 0 `ShouldBe` ('[] :: [Bool]) )++    -* It "returns [] for a single unset bit"+          (ShouldBe ('[] :: [Bool]) (ToBits 0 1))++    -* It "returns [True] for a single set bit"+          (ShouldBe '[ 'True] (ToBits 1 1))++    -* It "returns [True, False] when getting two bits from 0x2"+          (ShouldBe '[ 'True, 'False] (ToBits 0x2 2))++    -* It "returns the list of bits in correct order"+          (ShouldBe '[ 'True, 'True, 'True, 'True+                     , 'False, 'False, 'False, 'False]+                     (ToBits 0xf0 8))++    -* It "returns no leading 'False (i.e. it omits leading zero bits)"+          (ShouldBe '[ 'True, 'True, 'True, 'True]+                     (ToBits 0x0000000f 32))+  -/-++    "FromBits"+    ~~~~~~~~~++      It "returns 0 for '[]"+          (ShouldBe 0   (FromBits ('[] :: [Bool])))++    -* It "returns 0 for [False]"+          (ShouldBe 0   (FromBits '[ 'False]))++    -* It "returns 1 for [True]"+          (ShouldBe 1   (FromBits '[ 'True]))++    -* It "returns 2 for [True, False]"+          (ShouldBe 2   (FromBits '[ 'True, 'False]))++    -* It "returns 4 for [True, False, False]"+          (ShouldBe 4   (FromBits '[ 'True, 'False, 'False]))++    -* It "returns 5 for [True, False, True]"+          (ShouldBe 5   (FromBits '[ 'True, 'False, 'True]))+  -/-++    "ShiftBitsR"+    ~~~~~~~~~~~~++      It "returns the input bits for n == 0"+        (ShouldBe '[ 'True, 'False] (ShiftBitsR ['True, 'False] 0))++    -* It "returns '[] when shifting [True] 1 bits"+        (ShouldBe ('[] :: [Bool]) (ShiftBitsR '[ 'True ] 1))++    -* It "returns '[True] when shifting [True, True] 1 bits"+        (ShouldBe '[ 'True] (ShiftBitsR '[ 'True, 'True ] 1))++    -* It "returns (ToBits 12 8) when shifting (ToBits 97 8) 3 bits to the right"+        (ShouldBe (ToBits 12 8) (ShiftBitsR (ToBits 97 8) 3))+  -/-++     "GetMostSignificantBitIndex"+    ~~~~~~~~~~~~~~~++      It "returns 1 for 0"+        (ShouldBe 1 (GetMostSignificantBitIndex 64 0))++    -* It "returns 1 for 1"+        (ShouldBe 1 (GetMostSignificantBitIndex 64 1))++    -* It "returns 1 for 2"+        (ShouldBe 1 (GetMostSignificantBitIndex 64 2))++    -* It "returns 1 for 3"+        (ShouldBe 1 (GetMostSignificantBitIndex 64 3))++    -* It "returns 2 for 4"+        (ShouldBe 2 (GetMostSignificantBitIndex 64 4))++    -* It "returns 2 for 5"+        (ShouldBe 2 (GetMostSignificantBitIndex 64 4))++    -* It "returns 8 for 511"+        (ShouldBe 8 (GetMostSignificantBitIndex 64 511))++    -* It "returns 63 for (2^64 - 1)"+        (ShouldBe 63 (GetMostSignificantBitIndex 64 (2^64 - 1)))++  -/-+++    "ShiftR"+    ~~~~~~~~~++       It "returns '0' when shifting '42' 6 bits to the right"+        (ShouldBe 0 (ShiftR 64 42 6))+    -* It "returns 2 when shifting 512 8 bits to the right"+        (ShouldBe 2 (ShiftR 64 512 8))++testNatBits = Valid+#endif+++spec :: Spec+spec = do+  basicsSpec+#ifdef COMPLEXTESTS+  sizedSpec+  arraySpec+  describe "The Set of Type Functions" $+    it "is sound" $ do+      print (Valid :: Expect (BitRecordSize (Flag .+. Field 7) `Is` 8))+      print testTakeLastN+      print testRem+      print testRemPow2+      print testDiv+      print testNatBits+      print checkTestRecAligned+      print checkTestRecUnAligned+  describe "showARecord" $ do+    it "prints (Field 4 .+. (Field 4 := 0x96)) to \"<..>0110\"" $+      let actual = showRecord (Proxy :: Proxy (Field 4 .+. Field 4 := 0x96))+          in actual `shouldBe` "bits(4)\nbits(4) := 10010110 (hex: 96 dec: 150)"+  describe "StaticLazybytestringbuilder" $ do+    it "writes (and flushes) bits" $+        let rec = Proxy+            rec :: Proxy TestRecUnAligned+            actualB :: Builder+            actualB =+                  runBitStringBuilderHoley+                  (bitStringBuilderHoley rec)+                          1+                          3+                          7+            actual = printBuilder actualB+            in  actual `shouldBe`+                  "<< 01 00 06 00 00 00 00 0f fc >>"+    describe "Formatting sub-byte fields" $ do+      it "only the addressed bits are copied to the output" $+        property $ \value ->+          let rec = Proxy+              rec :: Proxy (Field 4 := 0 .+. "here" @: Field 4)+              actualB :: Builder+              actualB = runBitStringBuilderHoley (bitStringBuilderHoley rec) value+              actual = printBuilder actualB+              expected = printf "<< %.2x >>" (value .&. 0xf)+              in actual `shouldBe` expected+      it "renders (Flag := 0 .+. Field 7 := 130) to << 02 >>" $+        let rec = Proxy+            rec :: Proxy (Flag := 'False .+. Field 7 := 130)+            actual = printBuilder b+              where b = runBitStringBuilderHoley (bitStringBuilderHoley rec)+        in actual `shouldBe` "<< 02 >>"+  describe "ByteStringBuilder" $+    describe "runBitStringBuilderHoley" $+      it "0x01020304050607 to << 00 01 02 03 04 05 06 07 >>" $+        let expected = "<< 00 01 02 03 04 05 06 07 >>"+            actual =+               printBuilder+                (runBitStringBuilderHoley+                 (bitStringBuilderHoley+                     (bitString 64 0x01020304050607)))+            in actual `shouldBe` expected+#endif++instance (KnownNat n, n <= 64) => Arbitrary (B n) where+  arbitrary = do+    let h = 2^(n'-1) - 1+        n' = fromIntegral (natVal (Proxy @n)) :: Int+    x <- choose (0, h + h + 1)+    return (B x)

@@ -2,6 +2,9 @@  import Test.Hspec import Data.ByteString.IsoBaseFileFormat.Boxes+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields import qualified Data.ByteString.Lazy as BL import Control.Exception (evaluate) 

@@ -1,7 +1,8 @@ module BoxSpec (spec) where  import Test.Hspec-import Data.ByteString.IsoBaseFileFormat.Boxes+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as BL import qualified Data.Binary.Get as Binary

@@ -1,70 +0,0 @@-module BrandTypeSpec-  (spec)-  where--import Test.Hspec-import Data.ByteString.IsoBaseFileFormat.Boxes-import Data.ByteString.IsoBaseFileFormat.Brands.Types-import Data.ByteString.Lazy (unpack)--spec :: Spec-spec =-  describe "mediaBuilder" $-  do describe "Empty BoxLayout" $-       it "accepts valid box content types" $-       let test =-             mediaBuilder (Proxy :: Proxy TestBrandEmpty)-                          NoBoxes-       in printBuilder test-     describe "Single Box BoxLayout" $-       it "accepts valid box content types" $-       let test =-             mediaBuilder (Proxy :: Proxy TestBrandSingle)-                          (singletonBox testBox1)-       in printBuilder test-     describe "Multiple nested Boxes BoxLayout" $-       it "accepts valid box content types" $-       let test =-             mediaBuilder (Proxy :: Proxy TestBrandNested)-                          (singletonBox (testParentBox1 $: testBox1))-       in printBuilder test--printBuilder :: Builder -> IO ()-printBuilder b =-  putStrLn $ unlines $ ("                     "++) <$> lines (show (unpack (toLazyByteString b)))--data TestBox1--instance IsBox TestBox1 where-  type BoxContent TestBox1 = ()--type instance BoxTypeSymbol TestBox1 = "tst1"--testBox1 :: Box TestBox1-testBox1 = Box ()--data TestParentBox1--instance IsBox TestParentBox1 where-  type BoxContent TestParentBox1 = ()--type instance BoxTypeSymbol TestParentBox1 = "par1"--testParentBox1-  :: Boxes ts -> Box (ContainerBox TestParentBox1 ts)-testParentBox1 = containerBox ()--data TestBrandEmpty--instance IsMediaFileFormat TestBrandEmpty where-  type BoxLayout TestBrandEmpty = Boxes '[]--data TestBrandSingle--instance IsMediaFileFormat TestBrandSingle where-  type BoxLayout TestBrandSingle = Boxes '[OM_ TestBox1]--data TestBrandNested--instance IsMediaFileFormat TestBrandNested where-  type BoxLayout TestBrandNested = Boxes '[OM TestParentBox1 '[OM_ TestBox1]]

@@ -1,105 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module DashSpec (spec) where -- TODO rename to mp4 audio init spec--import Test.Hspec-import Data.ByteString.IsoBaseFileFormat.Brands.Dash-import qualified Data.ByteString.Lazy as BL-import Data.Text ()--spec :: Spec-spec =-  do describe "SingleAudioTrackInit version 0" $-       do it "renders some output at all" $-            do createionTime <- mp4CurrentTime-               let ct :: Word32-                   ct = fromScalar createionTime-                   ct3 = (ct `shiftR` 24) .&. 255-                   ct2 = (ct `shiftR` 16) .&. 255-                   ct1 = (ct `shiftR` 8) .&. 255-                   ct0 = (ct `shiftR` 0) .&. 255-                   cts :: [Word8]-                   cts = fromIntegral <$> [ct3,ct2,ct1,ct0]-               let args = exampleSingleTrackInit createionTime-                   doc = mkSingleTrackInit args-                   rendered = BL.unpack $ toLazyByteString $ doc-                   expected =-                     [-                      -- ftyp box-                      0,0,0,28,102,116,121,112,100,97,115,104,0,0,0,0-                      ,105,115,111,109,105,115,111,53,109,112,52,50-                      -- moov box-                     ,0,0,1,180,109 ,111 ,111 ,118-                      -- mvhd box-                     ,0 ,0 ,0 ,108 ,109 ,118 ,104 ,100 ,0 ,0 ,0 ,0]-                      ++ cts ++ [0 ,0 ,0 ,0 ,0-                     ,1 ,95 ,144 ,0 ,1 ,95 ,144 ,0 ,1 ,0 ,0 ,1 ,0 ,0 ,0-                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0-                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0-                     ,0 ,0 ,0 ,0 ,0 ,0 ,64 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0-                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0-                     ,255 ,255 ,255 ,255-                     -- trak box-                     ,0 ,0 ,1,64-                     ,116 ,114 ,97 ,107-                     -- tkhd box-                     ,0 ,0 ,0 ,92-                     ,116 ,107 ,104 ,100-                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0-                     ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,1 ,95 ,144 ,0 ,0-                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0-                     ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0-                     ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0-                     ,0 ,64 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0-                     -- mdia box-                     ,0,0,0,220-                     ,109,100,105,97-                     ,0,0,0,32,109,100,104,100,0,0,0,0-                     ,0,0,0,0,0,0,0,0,0,1,95,144,0,0,0,0,16,181,0,0-                     -- hdlr box-                     ,0,0,0,44-                     ,104,100,108,114-                     ,0,0,0,0,0,0,0,0,115,111,117,110,0,0,0,0,0,0,0,0,0,0,0,0-                     ,72,101,108,108,111,32,119,111,114,108,100,0-                     -- minf box-                     ,0,0,0,136-                     ,109,105,110,102-                     ,0,0,0,16-                     ,115,109,104,100,0,0,0,0,0,0,0,0-                     -- dinf box-                     ,0,0,0,36-                     ,100,105,110,102-                     -- dref box-                     ,0,0,0,28-                     ,100,114,101,102-                     ,0,0,0,0,0,0,0,1-                     -- url  box-                     ,0,0,0,12-                     ,117,114,108,32-                     ,0,0,0,1-                     -- stbl-                     ,0,0,0,76,115,116,98,108-                     -- stsd-                     ,0,0,0,52,115,116,115,100-                     ,0,0,0,0,0,0,0,1-                     -- mp4a-                     ,0,0,0,36,109,112,52,97-                     ,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,2,0,16,0,0,0,0-                     ,187,128,0,0-                     -- stts-                     ,0,0,0,16,115,116,116,115,0,0,0,0,0,0,0,0]-               BL.writeFile "/tmp/isobmff-test-case-dash-spec.mp4" (BL.pack rendered)-               rendered `shouldBe`-                 expected--exampleSingleTrackInit :: U32 "creation_time" -> SingleAudioTrackInit-exampleSingleTrackInit creationTime =-  SingleAudioTrackInit-                  (MovieHeader $-                   V0 (creationTime :+ 0 :+ Template :+ durationFromSeconds Template 1) :+-                   def)-                  (TrackHeader $-                   V0 (0 :+ 0 :+ 1 :+ Constant :+ durationFromSeconds Template 1) :+-                   def)-                  (MediaHeader def)-                  (namedAudioTrackHandler "Hello world")-                  (SoundMediaHeader def)

@@ -1,5 +1,6 @@ module DataReferenceSpec (spec) where +import           Data.ByteString.IsoBaseFileFormat.Box import           Data.ByteString.IsoBaseFileFormat.Boxes import           Test.Hspec 

@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+module ElementaryStreamDescriptorSpec (spec) where++import Test.Hspec+import Data.ByteString.Mp4.Boxes.ElementaryStreamDescriptor+import Data.ByteString.Mp4.Boxes.AudioSpecificConfig+import Data.ByteString.Mp4.Boxes.DecoderConfigDescriptor+import Data.ByteString.Mp4.Boxes.DecoderSpecificInfo+import Data.ByteString.IsoBaseFileFormat.ReExports+import Data.ByteString.IsoBaseFileFormat.Box++spec :: Spec+spec = do+#ifndef COMPLEXTESTS+  return ()+#else+  describe "EsdBox" $ do+    let eb = esdBox (Proxy @TestEsDescriptor) False 0 0 0+    it "has the correct size" $+      boxSize eb `shouldBe` 39+    it "generates the expected bits" $+      printBuilder (boxBuilder eb)+      `shouldBe` "<< 00 00 00 27 65 73 64 73 00 00 00 00 03 19 00 01 00 04 11 40 15 00 00 00 00 00 00 00 00 00 00 00 05 02 11 98 06 01 02 >>"++type TestEsDescriptor  =+  ESDescriptorMp4File+   (StaticFieldValue "esId" 1)+   TestConfigDescriptor++type TestConfigDescriptor  =+  DecoderConfigDescriptor+  'AudioIso14496_3+  'AudioStream+  '[AudioConfigAacMinimal+     'AacLc+     DefaultGASpecificConfig+     (SetEnum "samplingFreq" SamplingFreq 'SF48000)+     (SetEnum "channelConfig" ChannelConfig 'SinglePair)]+  '[]+#endif

@@ -0,0 +1,29 @@+{-# LANGUAGE UndecidableInstances #-}+module EnumSpec (spec) where++import Data.Proxy+import Data.Type.BitRecords+import Data.Type.Equality ()+import Prelude hiding ((.), id)+import Test.Hspec++spec = do+  describe "ToPretty" $ do+    it "renders as a record using showRecord" $+      showRecord (Proxy @(BitRecordOfEnum (EnumParam "test" TestEnumExt)))+      `shouldBe` "test: <<enum>>(2)"+  describe "BitStringBuilder" $ do+    it "produces binary output" $+     bitStringPrinter (Proxy  @(BitRecordOfEnum (EnumParam "test" TestEnumExt)))+      (MkEnumValue (Proxy @'A))+     `shouldBe` "<< 40 >>"++type TestEnumExt = ExtEnum TestEnum 2 'Be FieldU16+++data TestEnum =+  A | Be | C++type instance FromEnum TestEnum 'A = 1+type instance FromEnum TestEnum 'Be = 2+type instance FromEnum TestEnum 'C = 4

@@ -0,0 +1,68 @@+{-# LANGUAGE UndecidableInstances #-}+module ExpandableSpec (spec) where+++import           Data.ByteString.Builder+import           Data.ByteString.IsoBaseFileFormat.Box+import           Data.ByteString.IsoBaseFileFormat.ReExports+import qualified Data.ByteString.Lazy                                 as B+import           Data.ByteString.Mp4.Boxes.Expandable+import           Test.Hspec+import           Test.QuickCheck+++spec :: Spec+spec = do+  describe "StaticExpandable" $ do+    describe "ExpandableSizeLastChunk" $+      it "renders both 2 and 130 as 00000010 " $ do+        let actual130 = bitStringPrinter (Proxy :: Proxy ((ExpandableSizeLastChunk 130)))+            actual2 = bitStringPrinter (Proxy :: Proxy (ExpandableSizeLastChunk 2))+        actual130 `shouldBe` actual2+        actual2 `shouldBe` "<< 02 >>"+    describe "ExpandableSize" $+      it "creates a stdandard conform size representation for the size 130" $+        let actualStr = bitStringPrinter (Proxy :: Proxy (ExpandableSize 130))+        in actualStr `shouldBe` "<< 81 02 >>"++    -- TODO add new test+    -- it "has a boxSize of 3 when using a 16-bit body value" $+    --   boxSize (staticExpandable (Proxy :: Proxy (RecordField (Field 16 := 1234 )))) `shouldBe` BoxSize 3+    -- it "has a boxBuilder that writes the body in big endian byte order for a 32-bit body value" $+    --   B.unpack (toLazyByteString (boxBuilder (staticExpandable (Proxy :: Proxy (RecordField (Field  32 := 0x12345678 ))))))+    --   `shouldBe` [4, 0x12, 0x34, 0x56, 0x78]+    it "writes the size 128 as [ 0b10000001, 0b00000000 ] " $+      let actual = B.unpack $ toLazyByteString (boxBuilder (Expandable (ETC 128)))+          expected = [ 129, 0 ]+      in actual `shouldBe` expected+    it "writes the size (2 ^ 21) as [ 0b10000001, 0b10000000, 0b10000000, 0b00000000 ] " $+      let actual = B.unpack $ toLazyByteString (boxBuilder (Expandable (ETC (2^(21 :: Int)))))+          expected = [ 129, 128, 128, 0 ]+      in actual `shouldBe` expected+    it "writes the size (2 ^ 21 - 1) as [ 0b11111111, 0b11111111, 0b01111111 ] " $+      let actual = B.unpack $ toLazyByteString (boxBuilder (Expandable (ETC (2^(21 :: Int) - 1))))+          expected = [ 255, 255, 127 ]+      in actual `shouldBe` expected+    it "writes size according to the spec" $+      property $ \etc@(ETC s) ->+        let expectedBoxSize =+              BoxSize $+              s ++                   if s < 2 ^ ( 7 :: Int) then  1+              else if s < 2 ^ (14 :: Int) then  2+              else if s < 2 ^ (21 :: Int) then  3 else 4+            actualBoxSize = boxSize (Expandable etc)+            in+              actualBoxSize `shouldBe` expectedBoxSize+++instance Arbitrary ExpandableTestContent where+  arbitrary = ETC <$> choose (0, 2^(28::Integer) - 1)++newtype ExpandableTestContent =+    ETC Word64+  deriving (Show, Eq)++instance IsBoxContent ExpandableTestContent where+  boxSize (ETC s) = BoxSize s+  boxBuilder _ = mempty

@@ -0,0 +1,71 @@+module MediaFileSpec+  (spec)+  where++import Test.Hspec+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.MediaFile+import Data.ByteString.IsoBaseFileFormat.ReExports+import Data.ByteString.Lazy (unpack)++spec :: Spec+spec =+  describe "mediaBuilder" $+  do describe "Empty BoxLayout" $+       it "accepts valid box content types" $+       let test =+             mediaBuilder (Proxy :: Proxy TestBrandEmpty)+                          NoBoxes+       in printBuilderStdOut test+     describe "Single Box BoxLayout" $+       it "accepts valid box content types" $+       let test =+             mediaBuilder (Proxy :: Proxy TestBrandSingle)+                          (singletonBox testBox1)+       in printBuilderStdOut test+     describe "Multiple nested Boxes BoxLayout" $+       it "accepts valid box content types" $+       let test =+             mediaBuilder (Proxy :: Proxy TestBrandNested)+                          (singletonBox (testParentBox1 $: testBox1))+       in printBuilderStdOut test++printBuilderStdOut :: Builder -> IO ()+printBuilderStdOut b =+  putStrLn $ unlines $ ("                     "++) <$> lines (show (unpack (toLazyByteString b)))++data TestBox1++instance IsBox TestBox1 where+  type BoxContent TestBox1 = ()++type instance BoxTypeSymbol TestBox1 = "tst1"++testBox1 :: Box TestBox1+testBox1 = Box ()++data TestParentBox1++instance IsBox TestParentBox1 where+  type BoxContent TestParentBox1 = ()++type instance BoxTypeSymbol TestParentBox1 = "par1"++testParentBox1+  :: Boxes ts -> Box (ContainerBox TestParentBox1 ts)+testParentBox1 = containerBox ()++data TestBrandEmpty++instance IsMediaFileFormat TestBrandEmpty where+  type BoxLayout TestBrandEmpty = Boxes '[]++data TestBrandSingle++instance IsMediaFileFormat TestBrandSingle where+  type BoxLayout TestBrandSingle = Boxes '[OM_ TestBox1]++data TestBrandNested++instance IsMediaFileFormat TestBrandNested where+  type BoxLayout TestBrandNested = Boxes '[OM TestParentBox1 '[OM_ TestBox1]]

@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings #-}+module Mp4AudioFileSpec (spec) where -- TODO rename to mp4 audio init spec++import Test.Hspec+import Data.ByteString.Mp4.Boxes.BaseDescriptor+import Data.ByteString.Mp4.Boxes.AudioSpecificConfig+import Data.ByteString.Mp4.Boxes.Mp4AudioSampleEntry+import Data.ByteString.Mp4.AudioStreaming+import qualified Data.ByteString.Lazy as BL+import Data.Text ()++spec :: Spec+spec =+  do+     describe "Mp4AacAudioDecoderConfigDescriptor" $ do+       it "can be pretty printed" $+         showRecord (Proxy @(BitRecordOfDescriptor+                              $~ (Eval (Mp4AacAudioDecoderConfigDescriptor+                                        (AudioConfigAacLc+                                         (EnumParam "samplingFreq" SamplingFreq)+                                          (EnumParam "channelConfig" ChannelConfig))))))+         `shouldEndWith`+         "has-gas-extension: boolean := no"++#ifdef COMPLEXTESTS+       it "can be transformed to binary output" $+         let actual =+              bitStringPrinter+                (Proxy @(BitRecordOfDescriptor+                               $~ Eval  (Mp4AacAudioDecoderConfigDescriptor+                                         (AudioConfigAacLc+                                          (EnumParam "samplingFreq" SamplingFreq)+                                           (EnumParam "channelConfig" ChannelConfig)))))+                True+                1+                2+                3+                (MkEnumValue (Proxy @'SF16000))+                (MkEnumValue (Proxy @'SingleChannel))+             expexted = "<< 04 11 40 17 00 00 01 00 00 00 02 00 00 00 03 05 02 14 08 >>"+         in actual `shouldBe` expexted+     describe "Mp4AacLcEsDescriptor" $+       do it "can be transformed to binary output" $+            bitStringPrinter (Proxy @(BitRecordOfDescriptor $~ Eval Mp4AacLcEsDescriptor))+                             False 0 0 0+                             (MkEnumValue (Proxy @'SF48000))+                             (MkEnumValue (Proxy @'SingleChannel))+            `shouldBe`+              "<< 03 19 00 01 00 04 11 40 15 00 00 00 00 00 00 00 00 00 00 00 05 02 11 88 06 01 02 >>"+          it "can be pretty printed" $+            showRecord (Proxy @(BitRecordOfDescriptor $~ Eval Mp4AacLcEsDescriptor))+            `shouldStartWith` "base-descriptor: 03\n"+     describe "Mp4HeAacEsDescriptor" $+       do it "can be transformed to binary output" $+            bitStringPrinter (Proxy @(BitRecordOfDescriptor $~ Eval Mp4HeAacEsDescriptor))+                             False 0 0 0+                             (MkEnumValue (Proxy @'SF48000))+                             (MkEnumValue (Proxy @'SingleChannel))+                             (MkEnumValue (Proxy @'SF24000))+            `shouldBe`+              "<< 03 1a 00 01 00 04 12 40 15 00 00 00 00 00 00 00 00 00 00 00 05 03 29 8b 08 03 00 81 00 >>"+          it "can be pretty printed" $+            showRecord (Proxy @(BitRecordOfDescriptor $~ Eval Mp4HeAacEsDescriptor))+            `shouldStartWith` "base-descriptor: 03\n"+     describe "SingleAudioTrackInit version 0" $+       do it "renders some output at all" $+            do creationTime <- mp4CurrentTime+               let ct :: Word32+                   ct = fromScalar creationTime+                   ct3 = (ct `shiftR` 24) .&. 255+                   ct2 = (ct `shiftR` 16) .&. 255+                   ct1 = (ct `shiftR` 8) .&. 255+                   ct0 = (ct `shiftR` 0) .&. 255+                   cts :: [Word8]+                   cts = fromIntegral <$> [ct3,ct2,ct1,ct0]+               let args = exampleSingleTrackInit creationTime+                   doc = buildAacMp4StreamInit args+                   rendered = BL.unpack $ toLazyByteString $ doc+                   expected =+                     [+                      -- ftyp box+                       0,0,0,32+                     ,102,116,121,112+                     ,105,115,111,53,0,0,0,0+                     ,105,115,111,109+                     ,105,115,111,53+                     ,100,97,115,104+                     ,109,112,52,50+                     -- skip box+                     ,0,0,0,56+                     ,115,107,105,112+                     ,76,105,110,100,101,110,98,97,117,109,32,71,109,98,72,32,105+                     ,115,111,98,109,102,102,45,98,117,105,108,100,101,114,44,32+                     ,83,118,101,110,32,72,101,121,108,108,32,50,48,49,54+                     -- moov box+                     ,0,0,2,57,109 ,111 ,111 ,118+                      -- mvhd box+                     ,0 ,0 ,0 ,108 ,109 ,118 ,104 ,100 ,0 ,0 ,0 ,0]+                      ++ cts ++ cts +++                     [0 ,1 ,95 ,144+                     ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,1 ,0 ,0 ,0+                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0+                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0+                     ,0 ,0 ,0 ,0 ,0 ,0 ,64 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0+                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0+                     ,0 ,0 ,0 ,2+                     -- trak box+                     ,0 ,0 ,1,157+                     ,116 ,114 ,97 ,107+                     -- tkhd box+                     ,0 ,0 ,0 ,92+                     ,116 ,107 ,104 ,100+                     ,0 ,0 ,0 ,7]+                      ++ cts ++ cts +++                     [0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0+                     ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0+                     ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0+                     ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0+                     ,0 ,64 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0+                     -- mdia box+                     ,0,0,1,57+                     ,109,100,105,97+                     -- mdhd box+                     ,0,0,0,32+                     ,109,100,104,100+                     ,0,0,0,0]+                     ++ cts ++ cts +++                     [0,0,187,128+                     ,0,0,0,0+                     ,85,196+                     ,0,0+                     -- hdlr box+                     ,0,0,0,44+                     ,104,100,108,114+                     ,0,0,0,0,0,0,0,0,115,111,117,110,0,0,0,0,0,0,0,0,0,0,0,0+                     ,72,101,108,108,111,32,119,111,114,108,100,0+                     -- minf box+                     ,0,0,0,229+                     ,109,105,110,102+                     -- smhd box+                     ,0,0,0,16+                     ,115,109,104,100,0,0,0,0,0,0,0,0+                     -- dinf boimport Data.ByteString.IsoBaseFileFormat.Boxes+                     ,0,0,0,36+                     ,100,105,110,102+                     -- dref box+                     ,0,0,0,28+                     ,100,114,101,102+                     ,0,0,0,0,0,0,0,1+                     -- url  box+                     ,0,0,0,12+                     ,117,114,108,32+                     ,0,0,0,1+                     -- stbl box+                     ,0,0,0,169+                     ,115,116,98,108+                     -- stsd box+                     ,0,0,0,93+                     ,115,116,115,100+                     ,0,0,0,0,0,0,0,1+                     -- mp4a box+                     ,0,0,0,77+                     ,109,112,52,97+                     ,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,16,0,0,0,0,187,128,0,0+                     -- esds box+                     ,0,0,0,41+                     ,101,115,100,115+                     ,0,0,0,0,3,26,0,1,0,4,18,64,21+                     ,0,0,0,0,0,0,0,0,0,0,0,5,3,41,137,136,3,0,129,0+                     -- stts box+                     ,0,0,0,16+                     ,115,116,116,115,0,0,0,0,0,0,0,0+                     -- stsc box+                     ,0,0,0,16+                     ,115,116,115,99,0,0,0,0,0,0,0,0+                     -- stsz box+                     ,0,0,0,20+                     ,115,116,115,122,0,0,0,0,0,0,0,0,0,0,0,0+                     -- stc0 box+                     ,0,0,0,16+                     ,115,116,99,111,0,0,0,0,0,0,0,0+                     -- mvex box+                     ,0,0,0,40+                     ,109,118,101,120+                     -- trex box+                     ,0,0,0,32+                     ,116,114,101,120,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0]+               BL.writeFile "/tmp/isobmff-test-case-dash-spec.mp4" (BL.pack rendered)+               rendered `shouldBe`+                 expected++exampleSingleTrackInit :: U32 "creation_time" -> AacMp4StreamConfig+exampleSingleTrackInit creationTime =+  AacMp4StreamConfig creationTime "Hello world" True SF48000 SingleChannel+#endif

@@ -0,0 +1,27 @@+module Mp4AudioSampleEntry ( spec ) where++import           Data.ByteString.Builder+import           Data.ByteString.IsoBaseFileFormat.ReExports+import qualified Data.ByteString.Lazy                                 as B+import           Data.ByteString.Mp4.Boxes.Mp4AudioSampleEntry+import           Data.Type.BitRecords+import           Test.Hspec++spec :: Spec+spec = describe "AudioObjectType" $+    it "type-checks" $ do+        print testAudioObjectType++testAudioObjectType = Valid+testAudioObjectType ::++      "Audio Object Types"+      #####################++      "Small Audio Object Types"+      ~~~~~~~~~~~~~~~~~~~~~~~~~~~+         5 `ShouldBe` BitRecordSize (ToBitRecord (AudioObjectType 30))  -/-++      "Big Audio Object Types"+      ~~~~~~~~~~~~~~~~~~~~~~~~+        11 `ShouldBe` BitRecordSize (ToBitRecord (AudioObjectType 31))

@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}+module Mp4AudioSegmentSpec (spec) where++import qualified Data.ByteString                             as BS+import           Data.ByteString.IsoBaseFileFormat.ReExports+import qualified Data.ByteString.Lazy                        as BL+import           Data.ByteString.Mp4.AudioStreaming+import           Data.Text                                   ()+import           Test.Hspec++spec :: Spec+spec =+  describe "AacMp4TrackFragment" $+   do let args = moof+          doc = buildAacMp4TrackFragment args+          rendered = BL.unpack $ toLazyByteString $ doc+          dataOffset = 120+          expected =+                     [+                      -- styp box+                       0,0,0,24+                     ,115,116,121,112+                     ,109,115,100,104,0,0,0,0+                     ,109,115,100,104+                     ,100,97,115,104+                     -- moov box [offset here: 32]+                     ,0,0,0,112+                     ,109,111,111,102+                     -- mfhd box+                     ,0,0,0,16+                     ,109,102,104,100+                     ,0,0,0,0,0,0,0,13+                     -- traf+                     ,0,0,0,88+                     ,116,114,97,102+                     -- tfhd+                     ,0,0,0,16+                     ,116,102,104,100+                     ,0,2,0,0,0,0,0,1+                     -- tfdt+                     ,0,0,0,20+                     ,116,102,100,116+                     ,1,0,0,0,0,0,0,0,0,0,0,37+                     -- trun+                     ,0,0,0,44+                     ,116,114,117,110+                     ,0,0,7,1+                     ,0,0,0,2+                     ,0,0,0,dataOffset+                     -- sample 1+                     ,0,0,0,23 -- duration+                     ,0,0,0,192 -- length+                     ,2,0,0,0 -- flags+                     -- sample 2+                     ,0,0,0,23+                     ,0,0,0,192+                     ,2,0,0,0+                     -- mdat+                     ,0,0,1,136+                     ,109,100,97,116]+                     -- sample 1+                     ++ [0..191]+                     -- sample 2+                     ++ [0..191]+      it "renders the exact expectected output" $ do+#ifdef COMPLEXTESTS+        BL.writeFile "/tmp/isobmff-test-case-dash-spec.m4s" (BL.pack rendered)+#endif+        rendered `shouldBe` expected+      it "calculates the data-offset correctly" $+        drop ((fromIntegral dataOffset) + 12 * 2) rendered+        `shouldBe` ([0..191] ++ [0..191])++moof :: AacMp4TrackFragment+moof = AacMp4TrackFragment 13 37 (replicate 2 (23, BS.pack [0..191]))

@@ -5,7 +5,7 @@ import Test.Hspec import GHC.TypeLits () import Data.ByteString.IsoBaseFileFormat.Util.TypeLayout-import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box  spec :: Spec spec =@@ -25,6 +25,7 @@       describe "SomeMandatory" $ do         it "validates a singleton container" $ test5a `shouldBe` ()         it "validates a multi-element container" $ test5b `shouldBe` ()+#ifdef COMPLEXTESTS       it "validates a Mix of SomeMandatory, OnceOptional, SomeOptional" $ do         test6a `shouldBe` ()         test6b `shouldBe` ()@@ -34,6 +35,7 @@         test7a `shouldBe` ()         test7b `shouldBe` ()         test7c `shouldBe` ()+#endif  ---- data Foo@@ -84,7 +86,10 @@ type TestType5b = Box (ContainerBox Foo '[Bar, Bar]) test5b :: (IsRuleConform TestType5b TestRule5 ~ 'True) => () test5b = ()++ ----+#ifdef COMPLEXTESTS type TestRule6 =            (ContainerBox Foo            '[ OnceOptionalX (MatchSymbol "baz ")@@ -106,6 +111,8 @@ type TestType6d = Box (ContainerBox Foo '[Bar,Foo]) test6d :: (IsRuleConform TestType6d TestRule6 ~ 'True) => () test6d = ()++ ---- type TestRule7 =   TopLevel (ContainerBox Foo@@ -142,3 +149,4 @@                        ]) test7c :: (IsRuleConform TestType7c TestRule7 ~ 'True) => () test7c = ()+#endif

@@ -0,0 +1,379 @@+{-# LANGUAGE UndecidableInstances #-}++-- | 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.+module Data.ByteString.IsoBaseFileFormat.Box where++import Data.ByteString.IsoBaseFileFormat.ReExports+import           Data.Singletons.Prelude.List                      ((:++),+                                                                    Length)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.ByteString as B++-- * Box Type Classes+-- | Base class for all (abstract/phantom/normal-) types that represent boxes+class (KnownSymbol (BoxTypeSymbol t), IsBoxContent (BoxContent t))+   => IsBox (t :: Type) where+  type BoxContent t+  type BoxContent t = t+  toBoxType :: proxy t -> BoxType+  toBoxType _ = parseBoxType (Proxy :: Proxy (BoxTypeSymbol t))++-- | 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.+type family BoxTypeSymbol (t :: k) :: Symbol++-- | 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.+class IsBoxContent a  where+  boxSize :: a -> BoxSize+  boxBuilder :: a -> Builder++-- * Box Contents+--  TODO move all IsBoxContent stuff to BoxContent.hs++-- | A type that wraps the contents of a box and the box type.+data Box b where+        Box ::+            !(BoxContent b) -> Box b++instance IsBox b => IsBox (Box b) where+  type BoxContent (Box b) = BoxContent b+  toBoxType _ = toBoxType (Proxy :: Proxy b)++type instance BoxTypeSymbol (Box b) = BoxTypeSymbol b++instance IsBox cnt => IsBoxContent (Box cnt) where+  boxBuilder b@(Box cnt) = sB <> tB <> sExtB <> tExtB <> cntB+    where s = boxSize b+          t = toBoxType b+          sB = boxBuilder s+          sExtB = boxBuilder (BoxSizeExtension s)+          tB = boxBuilder t+          tExtB = boxBuilder (BoxTypeExtension t)+          cntB = boxBuilder cnt+  boxSize b@(Box cnt) = sPayload + boxSize (BoxSizeExtension sPayload)+    where sPayload =+            boxSize (BoxSize undefined) + boxSize t + boxSize cnt ++            boxSize (BoxTypeExtension t)+          t = toBoxType b++instance (Default (BoxContent b)) => Default (Box b) where+  def = Box def++-- | Compose 'BoxContent' and 'Boxes' under the Constraint that they are+-- composable.+data ContainerBox b (bs :: [Type]) where+  ContainerBox :: IsBox b => !(BoxContent b) -> !(Boxes bs) -> ContainerBox b bs++instance (IsBox b) => IsBox (ContainerBox b bs)++type instance BoxTypeSymbol (ContainerBox b bs) = BoxTypeSymbol b++instance IsBoxContent (ContainerBox b bs) where+    boxSize (ContainerBox c bs) = boxSize (c :+ bs)+    boxBuilder (ContainerBox c bs) = boxBuilder (c :+ bs)++-- | A heterogenous collection of boxes.+data Boxes (boxTypes :: [Type]) where+    NoBoxes :: Boxes '[]+    (:.) :: IsBox l => !(Box l) -> !(Boxes r) -> Boxes (Box l ': r)+    -- | Create a 'Boxes' collection from two 'Box'es+    (:<>) :: !(Boxes l) -> !(Boxes r) -> Boxes (l :++ r)+    (:|) :: (IsBox l, IsBox r) => !(Box l) -> !(Box r) -> Boxes '[Box l, Box r]++infixr 1 :<>+infixr 2 :.+infixr 2 :|+infixr 3 $:++-- | Apply a function to a 'Boxes' collection containing only a single 'Box'.+($:) :: IsBox l => (Boxes '[Box l] -> r) -> Box l -> r+($:) f = f . singletonBox++-- | Create a 'Boxes' collection with a single 'Box'.+singletonBox :: IsBox l =>  Box l -> Boxes '[Box l]+singletonBox b = b :. NoBoxes++-- | Get the elements in a type level array+typeListLength :: forall a proxy (ts :: [k]) . (KnownNat (Length ts), Num a)+               => proxy ts -> a+typeListLength _ = fromIntegral (natVal (Proxy :: Proxy (Length ts)))++instance IsBoxContent (Boxes bs) where+  boxSize NoBoxes = 0+  boxSize (l :. r) = boxSize l + boxSize r+  boxSize (l :| r) = boxSize l + boxSize r+  boxSize (l :<> r) = boxSize l + boxSize r+  boxBuilder NoBoxes = mempty+  boxBuilder (l :. r) = boxBuilder l <> boxBuilder r+  boxBuilder (l :| r) = boxBuilder l <> boxBuilder r+  boxBuilder (l :<> r) = boxBuilder l <> boxBuilder r++-- | A box that contains no fields, but nested boxes.+containerBox :: (IsBox t)+             => BoxContent t -> Boxes ts -> Box (ContainerBox t ts)+containerBox c bs = Box (ContainerBox c bs)++-- * 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.+data BoxSize+  = UnlimitedSize+  | BoxSize !Word64+  deriving (Show,Eq)++fromBoxSize :: Num a => a -> BoxSize -> a+fromBoxSize !fallback UnlimitedSize = fallback+fromBoxSize _fallback (BoxSize !s) = fromIntegral s++instance IsBoxContent BoxSize where+  boxSize _ = BoxSize 4+  boxBuilder UnlimitedSize = word32BE 0+  boxBuilder (BoxSize n) =+    word32BE $+    if n < (4294967296 :: Word64)+       then fromIntegral n+       else 1++instance Num BoxSize where+  (+) UnlimitedSize _ = UnlimitedSize+  (+) _ UnlimitedSize = UnlimitedSize+  (+) (BoxSize l) (BoxSize r) = BoxSize (l + r)+  (-) UnlimitedSize _ = UnlimitedSize+  (-) _ UnlimitedSize = UnlimitedSize+  (-) (BoxSize l) (BoxSize r) = BoxSize (l - r)+  (*) UnlimitedSize _ = UnlimitedSize+  (*) _ UnlimitedSize = UnlimitedSize+  (*) (BoxSize l) (BoxSize r) = BoxSize (l * r)+  abs UnlimitedSize = UnlimitedSize+  abs (BoxSize n) = BoxSize (abs n)+  signum UnlimitedSize = UnlimitedSize+  signum (BoxSize n) = BoxSize (signum n)+  fromInteger n = BoxSize $ fromInteger n++-- | The 'BoxSize' can be > 2^32 in which case an 'BoxSizeExtension' must be+-- added after the type field.+newtype BoxSizeExtension =+  BoxSizeExtension BoxSize++instance IsBoxContent BoxSizeExtension where+  boxBuilder (BoxSizeExtension UnlimitedSize) = mempty+  boxBuilder (BoxSizeExtension (BoxSize n)) =+    if n < 4294967296+       then mempty+       else word64BE n+  boxSize (BoxSizeExtension UnlimitedSize) = 0+  boxSize (BoxSizeExtension (BoxSize n)) =+    BoxSize $+    if n < 4294967296+       then 0+       else 8++-- | A box has a /type/, this is the value level representation for the box type.+data BoxType+  =+    -- | `FourCc` can be used as @boxType@ in `Box`, standard four letter character+    -- code, e.g. @ftyp@+    StdType !FourCc+  |+    -- | CustomBoxType defines custom @boxType@s in `Box`es.+    CustomBoxType !String+  deriving (Show,Eq)++-- | 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'.+parseBoxType :: KnownSymbol t => proxy t -> BoxType+parseBoxType px = StdType (fromString (symbolVal px))++-- | A type containin a printable four letter character code. TODO replace impl with U32Text+newtype FourCc =+  FourCc (Char,Char,Char,Char)+  deriving (Show,Eq)++instance IsString FourCc where+  fromString !str+    | length str == 4 =+      let [!a,!b,!c,!d] = str+      in FourCc (a,b,c,d)+    | otherwise =+      error ("cannot make a 'FourCc' of a String which isn't exactly 4 bytes long: " +++             show str ++ " has a length of " ++ show (length str))++instance IsBoxContent FourCc where+  boxSize _ = 4+  boxBuilder (FourCc (!a,!b,!c,!d)) = putW a <> putW b <> putW c <> putW d+    where putW = word8 . fromIntegral . fromEnum++instance IsBoxContent BoxType where+  boxSize _ = boxSize (FourCc undefined)+  boxBuilder t =+    case t of+      StdType x -> boxBuilder x+      CustomBoxType _ -> boxBuilder (FourCc ('u','u','i','d'))++-- | 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.+newtype BoxTypeExtension =+  BoxTypeExtension BoxType++instance IsBoxContent BoxTypeExtension where+  boxSize (BoxTypeExtension !(StdType _)) = 0+  boxSize (BoxTypeExtension !(CustomBoxType _)) = 16 * 4+  boxBuilder (BoxTypeExtension !(StdType _)) = mempty+  boxBuilder (BoxTypeExtension !(CustomBoxType str)) =+    mconcat (map (word8 . fromIntegral . fromEnum)+                 (take (16 * 4) str) +++             repeat (word8 0))++-- * 'IsBoxContent' instances+-- | An empty box content can by represented by @()@ (i.e. /unit/).+instance IsBoxContent () where+  boxSize _ = 0+  boxBuilder _ = mempty++-- | Trivial instance for 'ByteString'+instance IsBoxContent B.ByteString where+  boxSize = fromIntegral . B.length+  boxBuilder = byteString-- -- | A list, a maybe, and every other 'Foldable' of contents is a content.+                         -- instance (Foldable f, IsBoxContent t) => IsBoxContent (f t) where+                         --   boxSize = foldr' (\e acc -> acc + boxSize e) 0+                         --   boxBuilder = foldMap boxBuilder++-- | This 'Text' instance writes a null terminated UTF-8 string.+instance IsBoxContent T.Text where+  boxSize = (1+) . fromIntegral . T.length+  boxBuilder txt = boxBuilder (T.encodeUtf8 txtNoNulls) <> word8 0+    where txtNoNulls = T.map (\c -> if c == '\0' then ' ' else c) txt++-- | This instance writes zero bytes for 'Nothing' and delegates on 'Just'.+instance IsBoxContent a => IsBoxContent (Maybe a) where+  boxSize = maybe 0 boxSize+  boxBuilder = maybe mempty boxBuilder++-- * Box concatenation++-- | Box content composition+data a :+ b = !a :+ !b++infixr 3 :+++instance (IsBoxContent p,IsBoxContent c) => IsBoxContent (p :+ c) where+  boxSize    (p :+ c) = boxSize    p +  boxSize    c+  boxBuilder (p :+ c) = boxBuilder p <> boxBuilder c++instance (Default a, Default b) => Default (a :+ b) where+  def = def :+ def++-- * Tagged boxes++instance IsBoxContent c => IsBoxContent (Tagged s c) where+  boxSize = boxSize . untag+  boxBuilder = boxBuilder . untag++-- * List Box Content++-- | 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.+newtype ListContent sizeType contentType =+  ListContent [contentType]++instance (Num sizeType, IsBoxContent sizeType, IsBoxContent contentType)+  => IsBoxContent (ListContent sizeType contentType) where+    boxSize (ListContent es) =+      boxSize (fromIntegral (length es) :: sizeType) + sum (boxSize <$> es)+    boxBuilder (ListContent es) =+      boxBuilder (fromIntegral (length es) :: sizeType)+      <> fold (boxBuilder <$> es)++instance Default (ListContent sizeTupe contentType) where+  def = ListContent []++-- * Words and Integer++instance IsBoxContent Word8 where+  boxSize _ = 1+  boxBuilder = word8++instance IsBoxContent Word16 where+  boxSize _ = 2+  boxBuilder = word16BE++instance IsBoxContent Word32 where+  boxSize _ = 4+  boxBuilder = word32BE++instance IsBoxContent Word64 where+  boxSize _ = 8+  boxBuilder = word64BE++instance IsBoxContent Int8 where+  boxSize _ = 1+  boxBuilder = int8++instance IsBoxContent Int16 where+  boxSize _ = 2+  boxBuilder = int16BE++instance IsBoxContent Int32 where+  boxSize _ = 4+  boxBuilder = int32BE++instance IsBoxContent Int64 where+  boxSize _ = 8+  boxBuilder = int64BE++-- * Boxes of Bits++instance IsBoxContent BuilderBox where+  boxSize (MkBuilderBox !s _) = fromIntegral s+  boxBuilder (MkBuilderBox _ !b) = b++-- * Type Layout Rule Matchers++-- | Mandatory, container box, exactly one+type OM b bs = ContainerBox b bs+-- | Optional, container box, zero or one+type OO b bs = OnceOptionalX (ContainerBox b bs)+-- | Mandatory, container box, one or more+type SM b bs = SomeMandatoryX (ContainerBox b bs)+-- | Optional, container box, zero or more+type SO b bs = SomeOptionalX (ContainerBox b bs)++-- | Mandatory, exactly one, no children+type OM_ b = Box b+-- | Optional, zero or one, no children+type OO_ b = OnceOptionalX (Box b)+-- | Mandatory, one or more, no children+type SM_ b = SomeMandatoryX (Box b)+-- | Optional, zero or more, no children+type SO_ b = SomeOptionalX (Box b)++----+type instance IsRuleConform (Box b) (Box r) = BoxTypeSymbol b == BoxTypeSymbol r+----+type instance IsRuleConform (Boxes bs) (Boxes rs) = IsRuleConform bs rs -- TODO+----+type instance IsRuleConform (Box b) (ContainerBox b' rules)+  = IsContainerBox b+    && IsRuleConform (Box b) (Box b')+    && IsRuleConform (ChildBoxes b) (Boxes rules)+type family IsContainerBox t :: Bool where+  IsContainerBox (ContainerBox a as) = 'True+  IsContainerBox b = 'False+type family ChildBoxes c where+  ChildBoxes (ContainerBox a as) = Boxes as

@@ -4,14 +4,12 @@   where  import           Data.ByteString.IsoBaseFileFormat.Boxes.AudioSampleEntry               as X-import           Data.ByteString.IsoBaseFileFormat.Boxes.Box                            as X-import           Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields                      as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.ChunkOffset                    as X import           Data.ByteString.IsoBaseFileFormat.Boxes.DataEntryUrl                   as X import           Data.ByteString.IsoBaseFileFormat.Boxes.DataEntryUrn                   as X import           Data.ByteString.IsoBaseFileFormat.Boxes.DataInformation                as X import           Data.ByteString.IsoBaseFileFormat.Boxes.DataReference                  as X import           Data.ByteString.IsoBaseFileFormat.Boxes.FileType                       as X-import           Data.ByteString.IsoBaseFileFormat.Boxes.FullBox                        as X import           Data.ByteString.IsoBaseFileFormat.Boxes.Handler                        as X import           Data.ByteString.IsoBaseFileFormat.Boxes.HintMediaHeader                as X import           Data.ByteString.IsoBaseFileFormat.Boxes.HintSampleEntry                as X@@ -22,24 +20,29 @@ import           Data.ByteString.IsoBaseFileFormat.Boxes.MediaInformation               as X import           Data.ByteString.IsoBaseFileFormat.Boxes.MetaDataSampleEntry            as X import           Data.ByteString.IsoBaseFileFormat.Boxes.Movie                          as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.MovieExtends                   as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.MovieExtendsHeader             as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.MovieFragment                  as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.MovieFragmentHeader            as X import           Data.ByteString.IsoBaseFileFormat.Boxes.MovieHeader                    as X import           Data.ByteString.IsoBaseFileFormat.Boxes.NullMediaHeader                as X import           Data.ByteString.IsoBaseFileFormat.Boxes.ProgressiveDownloadInformation as X import           Data.ByteString.IsoBaseFileFormat.Boxes.SampleDescription              as X import           Data.ByteString.IsoBaseFileFormat.Boxes.SampleEntry                    as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.SampleSize                     as X import           Data.ByteString.IsoBaseFileFormat.Boxes.SampleTable                    as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.SampleToChunk                  as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.SegmentType                    as X import           Data.ByteString.IsoBaseFileFormat.Boxes.Skip                           as X import           Data.ByteString.IsoBaseFileFormat.Boxes.SoundMediaHeader               as X import           Data.ByteString.IsoBaseFileFormat.Boxes.SpecificMediaHeader            as X-import           Data.ByteString.IsoBaseFileFormat.Boxes.Time                           as X import           Data.ByteString.IsoBaseFileFormat.Boxes.TimeToSample                   as X import           Data.ByteString.IsoBaseFileFormat.Boxes.Track                          as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.TrackExtends                   as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragBaseMediaDecodeTime   as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragment                  as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragmentHeader            as X import           Data.ByteString.IsoBaseFileFormat.Boxes.TrackHeader                    as X-import           Data.ByteString.IsoBaseFileFormat.Boxes.Versioned                      as X+import           Data.ByteString.IsoBaseFileFormat.Boxes.TrackRun                       as X import           Data.ByteString.IsoBaseFileFormat.Boxes.VideoMediaHeader               as X import           Data.ByteString.IsoBaseFileFormat.Boxes.VisualSampleEntry              as X--import           Data.Kind                                                              as X-                                                                                              (Constraint,-                                                                                              Type)-import           Text.Printf                                                            as X

@@ -1,40 +1,30 @@ -- | Detailed audio sample description. module Data.ByteString.IsoBaseFileFormat.Boxes.AudioSampleEntry where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields import Data.ByteString.IsoBaseFileFormat.Boxes.Handler-import Data.ByteString.IsoBaseFileFormat.Boxes.SampleEntry---- | Construct an audio sample entry box.-audioSampleEntry ::-     (KnownSymbol-       (BoxTypeSymbol (SampleEntry 'AudioTrack (AudioCoding c))))-  => AudioCoding c-  -> U16 "data_reference_index"-  -> SampleEntry 'AudioTrack (AudioCoding c)-  -> Box (SampleEntry 'AudioTrack (AudioCoding c))-audioSampleEntry _ = sampleEntry+import Data.ByteString.IsoBaseFileFormat.ReExports --- | Fields if audio sample entries-newtype instance SampleEntry 'AudioTrack (AudioCoding c) where+-- | Fields of audio sample entries+newtype AudioSampleEntry b where     AudioSampleEntry       :: Constant (U32Arr "reserved" 2) '[0,0]       :+ Template (U16 "channelcount") 2       :+ Template (U16 "samplesize") 16       :+ U16 "pre_defined"       :+ Constant (U16 "reserved") 0-      :+ Template (U32 "samplerate") (DefaultSoundSamplerate * 65536)-      -- TODO implement fix point integer-      -> SampleEntry 'AudioTrack (AudioCoding c)-    deriving (IsBoxContent, Default)--type DefaultSoundSamplerate = 48000+      :+ Template (U32 "samplerate")+         (DefaultSoundSamplerate * 65536) -- TODO implement fix point integer+      :+ b+      -> AudioSampleEntry b+      deriving (Default, IsBoxContent) --- | A coproduct of audio codec types-data family AudioCoding (c :: Symbol)+instance Functor AudioSampleEntry where+  fmap fun (AudioSampleEntry (a :+ b :+ c :+ d :+ e :+ f :+ x)) =+    AudioSampleEntry (a :+ b :+ c :+ d :+ e :+ f :+ fun x) --- | The MPEG-4 AAC Audio codec-data instance AudioCoding "mp4a" = Mpeg4Aac+type DefaultSoundSamplerate = 48000 -type instance BoxTypeSymbol (AudioCoding c) = c+type instance GetHandlerType (AudioSampleEntry b) = 'AudioTrack+type instance BoxTypeSymbol (AudioSampleEntry b) = BoxTypeSymbol b

@@ -1,360 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- | 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.-module Data.ByteString.IsoBaseFileFormat.Boxes.Box-       (module Data.ByteString.IsoBaseFileFormat.Boxes.Box, module X)-       where--import Data.ByteString.IsoBaseFileFormat.Util.TypeLayout as X-import Data.Default as X-import Data.Foldable as X (fold)-import Data.Int as X-import Data.Maybe as X-import Data.Tagged as X-import Data.Proxy as X-import Data.Word as X-import Data.Bits as X-import Data.ByteString.Builder as X-import Data.Monoid as X-import Data.Kind-import GHC.TypeLits as X-import Data.String as X-import Data.Singletons.Prelude.List (Length, (:++))-import Data.Type.Equality as X-import Data.Type.Bool as X-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.ByteString as B---- * Box Type Classes--- | Base class for all (abstract/phantom/normal-) types that represent boxes-class (KnownSymbol (BoxTypeSymbol t), IsBoxContent (BoxContent t)) => IsBox (t :: Type) where-  type BoxContent t-  type BoxContent t = t-  toBoxType :: proxy t -> BoxType-  toBoxType _ = parseBoxType (Proxy :: Proxy (BoxTypeSymbol t))---- | 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.-type family BoxTypeSymbol (t :: k) :: Symbol---- | 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.-class IsBoxContent a  where-  boxSize :: a -> BoxSize-  boxBuilder :: a -> Builder---- * Box Contents---  TODO move all IsBoxContent stuff to BoxContent.hs---- | A type that wraps the contents of a box and the box type.-data Box b where-        Box ::-            !(BoxContent b) -> Box b--instance IsBox b => IsBox (Box b) where-  type BoxContent (Box b) = BoxContent b-  toBoxType _ = toBoxType (Proxy :: Proxy b)--type instance BoxTypeSymbol (Box b) = BoxTypeSymbol b--instance IsBox cnt => IsBoxContent (Box cnt) where-  boxBuilder b@(Box cnt) = sB <> tB <> sExtB <> tExtB <> cntB-    where s = boxSize b-          t = toBoxType b-          sB = boxBuilder s-          sExtB = boxBuilder (BoxSizeExtension s)-          tB = boxBuilder t-          tExtB = boxBuilder (BoxTypeExtension t)-          cntB = boxBuilder cnt-  boxSize b@(Box cnt) = sPayload + boxSize (BoxSizeExtension sPayload)-    where sPayload =-            boxSize (BoxSize undefined) + boxSize t + boxSize cnt +-            boxSize (BoxTypeExtension t)-          t = toBoxType b--instance (Default (BoxContent b)) => Default (Box b) where-  def = Box def---- | Compose 'BoxContent' and 'Boxes' under the Constraint that they are--- composable.-data ContainerBox b (bs :: [Type]) where-  ContainerBox :: IsBox b => !(BoxContent b) -> !(Boxes bs) -> ContainerBox b bs--instance (IsBox b) => IsBox (ContainerBox b bs)--type instance BoxTypeSymbol (ContainerBox b bs) = BoxTypeSymbol b--instance IsBoxContent (ContainerBox b bs) where-    boxSize (ContainerBox c bs) = boxSize (c :+ bs)-    boxBuilder (ContainerBox c bs) = boxBuilder (c :+ bs)---- | A heterogenous collection of boxes.-data Boxes (boxTypes :: [Type]) where-    NoBoxes :: Boxes '[]-    (:.) :: IsBox l => !(Box l) -> !(Boxes r) -> Boxes (Box l ': r)-    -- | Create a 'Boxes' collection from two 'Box'es-    (:<>) :: !(Boxes l) -> !(Boxes r) -> Boxes (l :++ r)-    (:|) :: (IsBox l, IsBox r) => !(Box l) -> !(Box r) -> Boxes '[Box l, Box r]--infixr 1 :<>-infixr 2 :.-infixr 2 :|-infixr 3 $:---- | Apply a function to a 'Boxes' collection containing only a single 'Box'.-($:) :: IsBox l => (Boxes '[Box l] -> r) -> Box l -> r-($:) f = f . singletonBox---- | Create a 'Boxes' collection with a single 'Box'.-singletonBox :: IsBox l =>  Box l -> Boxes '[Box l]-singletonBox b = b :. NoBoxes---- | Get the elements in a type level array-typeListLength :: forall a proxy (ts :: [k]) . (KnownNat (Length ts), Num a)-               => proxy ts -> a-typeListLength _ = fromIntegral (natVal (Proxy :: Proxy (Length ts)))--instance IsBoxContent (Boxes bs) where-  boxSize NoBoxes = 0-  boxSize (l :. r) = boxSize l + boxSize r-  boxSize (l :| r) = boxSize l + boxSize r-  boxSize (l :<> r) = boxSize l + boxSize r-  boxBuilder NoBoxes = mempty-  boxBuilder (l :. r) = boxBuilder l <> boxBuilder r-  boxBuilder (l :| r) = boxBuilder l <> boxBuilder r-  boxBuilder (l :<> r) = boxBuilder l <> boxBuilder r---- | A box that contains no fields, but nested boxes.-containerBox :: (IsBox t)-             => BoxContent t -> Boxes ts -> Box (ContainerBox t ts)-containerBox c bs = Box (ContainerBox c bs)---- * 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.-data BoxSize-  = UnlimitedSize-  | BoxSize !Word64-  deriving (Show,Eq)--instance IsBoxContent BoxSize where-  boxSize _ = BoxSize 4-  boxBuilder UnlimitedSize = word32BE 0-  boxBuilder (BoxSize n) =-    word32BE $-    if n < (4294967296 :: Word64)-       then fromIntegral n-       else 1--instance Num BoxSize where-  (+) UnlimitedSize _ = UnlimitedSize-  (+) _ UnlimitedSize = UnlimitedSize-  (+) (BoxSize l) (BoxSize r) = BoxSize (l + r)-  (-) UnlimitedSize _ = UnlimitedSize-  (-) _ UnlimitedSize = UnlimitedSize-  (-) (BoxSize l) (BoxSize r) = BoxSize (l - r)-  (*) UnlimitedSize _ = UnlimitedSize-  (*) _ UnlimitedSize = UnlimitedSize-  (*) (BoxSize l) (BoxSize r) = BoxSize (l * r)-  abs UnlimitedSize = UnlimitedSize-  abs (BoxSize n) = BoxSize (abs n)-  signum UnlimitedSize = UnlimitedSize-  signum (BoxSize n) = BoxSize (signum n)-  fromInteger n = BoxSize $ fromInteger n---- | The 'BoxSize' can be > 2^32 in which case an 'BoxSizeExtension' must be--- added after the type field.-newtype BoxSizeExtension =-  BoxSizeExtension BoxSize--instance IsBoxContent BoxSizeExtension where-  boxBuilder (BoxSizeExtension UnlimitedSize) = mempty-  boxBuilder (BoxSizeExtension (BoxSize n)) =-    if n < 4294967296-       then mempty-       else word64BE n-  boxSize (BoxSizeExtension UnlimitedSize) = 0-  boxSize (BoxSizeExtension (BoxSize n)) =-    BoxSize $-    if n < 4294967296-       then 0-       else 8---- | A box has a /type/, this is the value level representation for the box type.-data BoxType-  =-    -- | `FourCc` can be used as @boxType@ in `Box`, standard four letter character-    -- code, e.g. @ftyp@-    StdType !FourCc-  |-    -- | CustomBoxType defines custom @boxType@s in `Box`es.-    CustomBoxType !String-  deriving (Show,Eq)---- | 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'.-parseBoxType :: KnownSymbol t => proxy t -> BoxType-parseBoxType px = StdType (fromString (symbolVal px))---- | A type containin a printable four letter character code. TODO replace impl with U32Text-newtype FourCc =-  FourCc (Char,Char,Char,Char)-  deriving (Show,Eq)--instance IsString FourCc where-  fromString str-    | length str == 4 =-      let [a,b,c,d] = str-      in FourCc (a,b,c,d)-    | otherwise =-      error ("cannot make a 'FourCc' of a String which isn't exactly 4 bytes long: " ++-             show str ++ " has a length of " ++ show (length str))--instance IsBoxContent FourCc where-  boxSize _ = 4-  boxBuilder (FourCc (a,b,c,d)) = putW a <> putW b <> putW c <> putW d-    where putW = word8 . fromIntegral . fromEnum--instance IsBoxContent BoxType where-  boxSize _ = boxSize (FourCc undefined)-  boxBuilder t =-    case t of-      StdType x -> boxBuilder x-      CustomBoxType _ -> boxBuilder (FourCc ('u','u','i','d'))---- | 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.-newtype BoxTypeExtension =-  BoxTypeExtension BoxType--instance IsBoxContent BoxTypeExtension where-  boxSize (BoxTypeExtension (StdType _)) = 0-  boxSize (BoxTypeExtension (CustomBoxType _)) = 16 * 4-  boxBuilder (BoxTypeExtension (StdType _)) = mempty-  boxBuilder (BoxTypeExtension (CustomBoxType str)) =-    mconcat (map (word8 . fromIntegral . fromEnum)-                 (take (16 * 4) str) ++-             repeat (word8 0))---- * 'IsBoxContent' instances--- | An empty box content can by represented by @()@ (i.e. /unit/).-instance IsBoxContent () where-  boxSize _ = 0-  boxBuilder _ = mempty---- | Trivial instance for 'ByteString'-instance IsBoxContent B.ByteString where-  boxSize = fromIntegral . B.length-  boxBuilder = byteString-- -- | A list, a maybe, and every other 'Foldable' of contents is a content.-                         -- instance (Foldable f, IsBoxContent t) => IsBoxContent (f t) where-                         --   boxSize = foldr' (\e acc -> acc + boxSize e) 0-                         --   boxBuilder = foldMap boxBuilder--instance Default B.ByteString where-  def = mempty---- | This 'Text' instance writes a null terminated UTF-8 string.-instance IsBoxContent T.Text where-  boxSize = (1+) . fromIntegral . T.length-  boxBuilder txt = boxBuilder (T.encodeUtf8 txtNoNulls) <> word8 0-    where txtNoNulls = T.map (\c -> if c == '\0' then ' ' else c) txt--instance Default T.Text where-  def = ""----- | This instance writes zero bytes for 'Nothing' and delegates on 'Just'.-instance IsBoxContent a => IsBoxContent (Maybe a) where-  boxSize = maybe 0 boxSize-  boxBuilder = maybe mempty boxBuilder---- * Box concatenation---- | Box content composition-data a :+ b = !a :+ !b--infixr 3 :+--instance (IsBoxContent p,IsBoxContent c) => IsBoxContent (p :+ c) where-  boxSize    (p :+ c) = boxSize    p +  boxSize    c-  boxBuilder (p :+ c) = boxBuilder p <> boxBuilder c--instance (Default a, Default b) => Default (a :+ b) where-  def = def :+ def---- * Tagged boxes--instance IsBoxContent c => IsBoxContent (Tagged s c) where-  boxSize = boxSize . untag-  boxBuilder = boxBuilder . untag--instance Default c => Default (Tagged s c) where-  def = Tagged def---- * List Box Content---- | 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.-newtype ListContent sizeType contentType =-  ListContent [contentType]--instance (Num sizeType, IsBoxContent sizeType, IsBoxContent contentType)-  => IsBoxContent (ListContent sizeType contentType) where-    boxSize (ListContent es) =-      boxSize (fromIntegral (length es) :: sizeType) + sum (boxSize <$> es)-    boxBuilder (ListContent es) =-      boxBuilder (fromIntegral (length es) :: sizeType)-      <> fold (boxBuilder <$> es)--instance Default (ListContent sizeTupe contentType) where-  def = ListContent []---- * Type Layout Rule Matchers---- | Mandatory, container box, exactly one-type OM b bs = ContainerBox b bs--- | Optional, container box, zero or one-type OO b bs = OnceOptionalX (ContainerBox b bs)--- | Mandatory, container box, one or more-type SM b bs = SomeMandatoryX (ContainerBox b bs)--- | Optional, container box, zero or more-type SO b bs = SomeOptionalX (ContainerBox b bs)---- | Mandatory, exactly one, no children-type OM_ b = Box b--- | Optional, zero or one, no children-type OO_ b = OnceOptionalX (Box b)--- | Mandatory, one or more, no children-type SM_ b = SomeMandatoryX (Box b)--- | Optional, zero or more, no children-type SO_ b = SomeOptionalX (Box b)-------type instance IsRuleConform (Box b) (Box r) = BoxTypeSymbol b == BoxTypeSymbol r------type instance IsRuleConform (Boxes bs) (Boxes rs) = IsRuleConform bs rs -- TODO------type instance IsRuleConform (Box b) (ContainerBox b' rules)-  = IsContainerBox b-    && IsRuleConform (Box b) (Box b')-    && IsRuleConform (ChildBoxes b) (Boxes rules)-type family IsContainerBox t :: Bool where-  IsContainerBox (ContainerBox a as) = 'True-  IsContainerBox b = 'False-type family ChildBoxes c where-  ChildBoxes (ContainerBox a as) = Boxes as

@@ -1,298 +0,0 @@--- | Mini EDSL for labelled box fields. The boxfields can be 'Scalar' or--- 'ScalarArray's.-module Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-       where--import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Text.Printf-import Data.Singletons-import Data.Singletons.Prelude.List-import qualified Data.Vector.Sized as Vec-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.ByteString as B----- * Scalar box fields--type U64 label = Scalar Word64 label--type I64 label = Scalar Int64 label--u64 :: Word64 -> U64 label-u64 = Scalar--i64 :: Int64 -> I64 label-i64 = Scalar--type U32 label = Scalar Word32 label-type I32 label = Scalar Int32 label--u32 :: Word32 -> U32 label-u32 = Scalar--i32 :: Int32 -> I32 label-i32 = Scalar--type U16 label = Scalar Word16 label--type I16 label = Scalar Int16 label--u16 :: Word16 -> U16 label-u16 = Scalar--i16 :: Int16 -> I16 label-i16 = Scalar--type U8 label = Scalar Word8 label--type I8 label = Scalar Int8 label--u8 :: Word8 -> U8 label-u8 = Scalar--i8 :: Int8 -> I8 label-i8 = Scalar---- | A numeric box field with a type level label. Note that it has a 'Num'--- instance. Use the type aliases above, e.g.--- 'U8','I8','U16','I16','U32','I32','U64','I64' from above. Use either the--- smart constructors, e.g. 'u8','i8','u16','i16','u32','i32','u64','i64' or the--- 'Num' instance, whereas the constructors might give a bit more safety.-newtype Scalar scalartype (label :: k) =-  Scalar {fromScalar :: scalartype}-  deriving (Show, Read, Ord, Eq, Num, Default)---- | Relabel a scalar value, e.g. convert a @Scalar U32 "foo"@ to a @Scalar U32--- "bar"@.-relabelScalar :: Scalar t l -> Scalar t l'-relabelScalar (Scalar x) = (Scalar x)--instance IsBoxContent (Scalar Word8 label) where-  boxSize _ = 1-  boxBuilder (Scalar v) = word8 v--instance IsBoxContent (Scalar Word16 label) where-  boxSize _ = 2-  boxBuilder (Scalar v) = word16BE v--instance IsBoxContent (Scalar Word32 label) where-  boxSize _ = 4-  boxBuilder (Scalar v) = word32BE v--instance IsBoxContent (Scalar Word64 label) where-  boxSize _ = 8-  boxBuilder (Scalar v) = word64BE v--instance IsBoxContent (Scalar Int8 label) where-  boxSize _ = 1-  boxBuilder (Scalar v) = int8 v--instance IsBoxContent (Scalar Int16 label) where-  boxSize _ = 2-  boxBuilder (Scalar v) = int16BE v--instance IsBoxContent (Scalar Int32 label) where-  boxSize _ = 4-  boxBuilder (Scalar v) = int32BE v--instance IsBoxContent (Scalar Int64 label) where-  boxSize _ = 8-  boxBuilder (Scalar v) = int64BE v--instance (KnownNat scalar,Num o) => FromTypeLit (Scalar o label) scalar where-  fromTypeLit _ = Scalar $ fromIntegral $ natVal (Proxy :: Proxy scalar)---- * Array fields--type U64Arr label size = ScalarArray label size Word64--u64Arr :: (KnownNat size,KnownSymbol label)-       => [Word64] -> U64Arr label size-u64Arr = fromList--type I64Arr label size = ScalarArray label size Int64--i64Arr :: (KnownNat size,KnownSymbol label)-       => [Int64] -> I64Arr label size-i64Arr = fromList--type U32Arr label size = ScalarArray label size Word32--u32Arr :: (KnownNat size,KnownSymbol label)-       => [Word32] -> U32Arr label size-u32Arr = fromList--type I32Arr label size = ScalarArray label size Int32--i32Arr :: (KnownNat size,KnownSymbol label)-       => [Int32] -> I32Arr label size-i32Arr = fromList--type U16Arr label size = ScalarArray label size Word16--u16Arr :: (KnownNat size,KnownSymbol label)-       => [Word16] -> U16Arr label size-u16Arr = fromList--type I16Arr label size = ScalarArray label size Int16--i16Arr :: (KnownNat size,KnownSymbol label)-       => [Int16] -> I16Arr label size-i16Arr = fromList--type U8Arr label size = ScalarArray label size Word8--u8Arr :: (KnownNat size,KnownSymbol label)-      => [Word8] -> U8Arr label size-u8Arr = fromList--type I8Arr label size = ScalarArray label size Int8--i8Arr :: (KnownNat size,KnownSymbol label)-      => [Int8] -> I8Arr label size-i8Arr = fromList---- | A box field that is an array of 'Scalar's with a type level label. Use the--- type aliases, e.g.--- 'U8Arr','I8Arr','U16Arr','I16Arr','U32Arr','I32Arr','U64Arr','I64Arr' from--- above. Use the smart constructors, e.g.--- 'u8Arr','i8Arr','u16Arr','i16Arr','u32Arr','i32Arr','u64Arr','i64Arr' .-newtype ScalarArray (label :: k) (len :: Nat) o where-        ScalarArray :: Vec.Vector n o -> ScalarArray label n o-        deriving (Show,Eq)--instance (Default o,KnownNat (len :: Nat)) => Default (ScalarArray label len o) where-  def = ScalarArray $ Vec.replicate def--instance (Num o,IsBoxContent (Scalar o label),KnownNat (len :: Nat)) => IsBoxContent (ScalarArray label len o) where-  boxSize (ScalarArray vec) =-    fromIntegral (Vec.length vec) * boxSize (Scalar 0 :: Scalar o label)-  boxBuilder (ScalarArray vec) =-    Vec.foldl' mappend-               mempty-               (Vec.map (boxBuilder . mkScalar) vec)-    where mkScalar :: o -> Scalar o label-          mkScalar = Scalar---- | Internal function-fromList :: forall label n o.-            (KnownSymbol label,KnownNat n)-         => [o] -> ScalarArray label n o-fromList l =-  ScalarArray $-  case Vec.fromList l of-    Nothing ->-      error $-      printf "Invalid number of array elements for array %s. Got length: %d elments, expected %d."-             (show (symbolVal (Proxy :: Proxy label)))-             (length l)-             (natVal (Proxy :: Proxy n))-    Just v -> v---- * Constant fields---- | Wrapper around a field, e.g. a 'Scalar' or 'ScalarArray', with a type level--- value. The wrapped content must implement 'FromTypeLit'. To get the value of--- a 'Constant'  use 'fromTypeLit'.-data Constant o v where-        Constant :: Constant o v--instance (IsBoxContent o,FromTypeLit o v) => IsBoxContent (Constant o v) where-  boxSize = boxSize . fromTypeLit-  boxBuilder = boxBuilder . fromTypeLit--instance Default (Constant o v) where-  def = Constant---- * Template Fields---- | Fields with default values that can be overriden with custom value. Like--- 'Constant' this is a wrapper around a field, e.g. a 'Scalar' or--- 'ScalarArray', with a type level default value. The wrapped content must--- implement 'FromTypeLit'.-data Template o v where-        Template :: Template o v-        Custom :: o -> Template o v--instance Default (Template o v) where-  def = Template---- | Get a value from a 'Template'.-templateValue :: FromTypeLit o v => Template o v -> o-templateValue d@Template = fromTypeLit d-templateValue (Custom v) = v--instance (IsBoxContent o,FromTypeLit o v) => IsBoxContent (Template o v) where-  boxSize = boxSize . templateValue-  boxBuilder = boxBuilder . templateValue---- * Conversion from type-level numbers and lists to values---- | Types that can be constructed from type level value representations.-class FromTypeLit o v  where-  fromTypeLit :: proxy o v -> o--instance (SingI arr,Num o,SingKind [Nat],KnownNat len,len ~ Length arr) => FromTypeLit (ScalarArray label len o) (arr :: [Nat]) where-  fromTypeLit _ =-    let s = sing :: Sing arr-        vs :: [Integer]-        vs = fromSing s-        vs' :: [o]-        vs' = fromIntegral <$> vs-    in ScalarArray (fromJust (Vec.fromList vs'))--instance KnownSymbol str => FromTypeLit T.Text (str :: Symbol) where-  fromTypeLit = T.pack . symbolVal---- * String/Text field types---- | A fixed size string, the first byte is the string length, after the String,--- the field is padded with @0@ bytes. The string must be in UTF8 format.-newtype FixSizeText (len :: Nat) (label :: Symbol) where-  FixSizeText :: T.Text -> FixSizeText len label---- | A constraint that matches type level numbers that are valid text sizes for---  'FixSizeText's.-type IsTextSize len = (KnownNat len, 1 <= len, len <= 255)--instance IsTextSize len => IsBoxContent (FixSizeText len label) where-  boxSize    _               = fromIntegral (natVal (Proxy :: Proxy len))-  boxBuilder (FixSizeText t) =-    let-      --                                         leave room for the size byte-      maxSize             = fromIntegral (natVal (Proxy :: Proxy len) - 1)-      displayableText     = B.take maxSize (T.encodeUtf8 t)-      displayableTextSize = B.length displayableText-      paddingSize         = max 0 (maxSize - displayableTextSize)-      in-               word8      (fromIntegral displayableTextSize)-            <> byteString displayableText-            <> fold       (replicate paddingSize (word8 0))--instance IsTextSize len => Default (FixSizeText len label) where-  def = FixSizeText ""---- | Four character strings embedded in a uint32.-newtype U32Text (label :: Symbol) where-  U32Text :: Word32 -> U32Text label--instance IsString (U32Text label) where-  fromString str = U32Text $-    let cw s c = (0xFF .&. (fromIntegral (fromEnum c))) `shiftL` s-        in case str of-             []          -> 0x20202020-             [a]         -> (cw 24 a .|. 0x00202020)-             [a,b]       -> (cw 24 a .|. cw 16 b  .|. 0x00002020)-             [a,b,c]     -> (cw 24 a .|. cw 16 b  .|. cw 8 c  .|. 0x20)-             (a:b:c:d:_) -> (cw 24 a .|. cw 16 b  .|. cw 8 c  .|. cw 0 d)--instance IsBoxContent (U32Text label) where-  boxSize _ = 4-  boxBuilder (U32Text t) = word32BE t--instance KnownSymbol str => FromTypeLit (U32Text label) (str :: Symbol) where-  fromTypeLit = fromString . symbolVal--instance Default (U32Text label) where-  def = U32Text 0x20202020

@@ -0,0 +1,52 @@+-- | A table mapping chunks to *absolute* file offsets.+-- Two variants exist: 32 or 64 bits.++module Data.ByteString.IsoBaseFileFormat.Boxes.ChunkOffset where++import Data.ByteString.IsoBaseFileFormat.ReExports+import           Data.ByteString.IsoBaseFileFormat.Box+import           Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import           Data.ByteString.IsoBaseFileFormat.Util.FullBox++-- | Create a hunk offset box for 32 bit entries (@stco@). If possible use+-- this over 'ChunkOffset64'+chunkOffset32 :: [StcoEntry32] -> Box ChunkOffset32+chunkOffset32 = fullBox 0 . ChunkOffsetTable . ListContent++-- | Create a hunk offset box for 64 bit entries (@stco@). If possible use+-- 'ChunkOffset32'+chunkOffset64 :: [StcoEntry64] -> Box ChunkOffset64+chunkOffset64 = fullBox 0 . ChunkOffsetTable . ListContent++-- | Chunk offset box for 32 bit entries (@stco@). If possible use+-- this over 'ChunkOffset64'+type ChunkOffset32 = FullBox ChunkOffsetTable32 0++-- | Chunk offset box for 64 bit entries (@stco@). If possible use+-- 'ChunkOffset32'+type ChunkOffset64 = FullBox ChunkOffsetTable64 0++-- | Alias for 'ChunkOffsetTable' for 32 bit entries (@stco@)+type ChunkOffsetTable32 = ChunkOffsetTable StcoEntry32++-- | Alias for 'ChunkOffsetTable' for 64 bit entries (@co64@)+type ChunkOffsetTable64 = ChunkOffsetTable StcoEntry64++-- | A list of 'StcoEntry32' or 'StcoEntry64' entries.+newtype ChunkOffsetTable stcoEntry =+  ChunkOffsetTable (ListContent (U32 "entry_count") stcoEntry)+  deriving (Default, IsBoxContent)++-- | An entry of the 'ChunkOffsetTable' contains just the absolute file offset+-- to the chunk.+type StcoEntry32 = U32 "chunk_offset"++-- | An entry of the 'ChunkOffsetTable' contains just the absolute file offset+-- to the chunk.+type StcoEntry64 = U64 "chunk_offset"++type instance BoxTypeSymbol ChunkOffsetTable32 = "stco"+type instance BoxTypeSymbol ChunkOffsetTable64 = "co64"++instance IsBox ChunkOffsetTable32+instance IsBox ChunkOffsetTable64

@@ -6,9 +6,10 @@   )   where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import qualified Data.Text as T+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | A container for a URL or an indicator for local only media newtype DataEntryUrl =

@@ -5,8 +5,8 @@   )   where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import qualified Data.Text as T  -- | A container for a URN and optionally a URL

@@ -2,7 +2,7 @@ -- 'Track' the actual location are stored in 'DataReference's. module Data.ByteString.IsoBaseFileFormat.Boxes.DataInformation where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box  -- | Data information box phantom type. data DataInformation

@@ -9,11 +9,12 @@   )   where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import Data.ByteString.IsoBaseFileFormat.Boxes.DataEntryUrl-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields import Data.Singletons.Prelude.List (Length)+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | A container for 'DataEntryUrl's and 'DataEntryUrn's newtype DataReference =

@@ -1,6 +1,7 @@ module Data.ByteString.IsoBaseFileFormat.Boxes.FileType where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | File Type Box instance IsBox FileType where@@ -14,9 +15,9 @@  -- | Contents of a 'ftyp' box are some 'FourCc' /brands/ and a version. data FileType =-  FileType {majorBrand :: FourCc-           ,minorVersion :: Word32-           ,compatibleBrands :: [FourCc]}+  FileType {majorBrand :: !FourCc -- TODO use U32String+           ,minorVersion :: !Word32 -- TODO use U32String+           ,compatibleBrands :: ![FourCc]}  -- TODO use U32String  instance IsBoxContent FileType where   boxSize (FileType maj _ver comps) = boxSize maj + 4 + sum (boxSize <$> comps)

@@ -1,92 +0,0 @@--- | Full Boxes-module Data.ByteString.IsoBaseFileFormat.Boxes.FullBox-       (FullBox(..), fullBox, BoxFlags(..))-       where--import Data.ByteString.IsoBaseFileFormat.Boxes.Box---- | A 'FullBox' contains an extra version and a flags field. In this--- implementation it is wrapped around the rest of the box content. This--- enforces that the 'FullBox' header fields are always at the beginning - at--- least as long as this module hides the 'FullBox' constructor ;)-data FullBox t (version :: Nat) where-  FullBox :: (KnownNat version, IsBox t)-          => BoxFlags 24-          -> BoxContent t-          -> FullBox t version--instance (KnownNat version, IsBox t, Default (BoxContent t))-  => Default (FullBox t version) where-  def = FullBox 0 def--instance (KnownNat v, IsBox t) => IsBox (FullBox t v) where-  type BoxContent (FullBox t v) = FullBox t v--type instance BoxTypeSymbol (FullBox t v) = BoxTypeSymbol t--instance (IsBox t, KnownNat v) => IsBoxContent (FullBox t v) where-  boxSize (FullBox f c) = 1 + boxSize f + boxSize c-  boxBuilder (FullBox f c) =-       word8 (fromIntegral (natVal (Proxy :: Proxy v)))-    <> boxBuilder f-    <> boxBuilder c---- | Create a 'FullBox' from a 'BoxVersion' and 'BoxFlags'-fullBox-  :: (KnownNat v, IsBox t)-  => BoxFlags 24 -> BoxContent t -> Box (FullBox t v)-fullBox f c = Box (FullBox f c)---- | In addition to a version there can be 24 bits for custom flags etc in--- a 'FullBox'.-newtype BoxFlags bits =-  BoxFlags Integer-  deriving (Eq,Show,Num)---- | Internal function that creates a bit mask with all bits in a 'BoxFlags' set--- to 1.-boxFlagBitMask :: KnownNat bits-               => BoxFlags bits -> Integer-boxFlagBitMask px = 2 ^ natVal px - 1---- | Internal function that masks-out all bits higher than 'bits'.-cropBits :: KnownNat bits-         => BoxFlags bits -> BoxFlags bits-cropBits f@(BoxFlags b) = BoxFlags (b .&. boxFlagBitMask f)---- | Get the number of bytes required to store a number of bits.-instance KnownNat bits => IsBoxContent (BoxFlags bits) where-  boxSize f =-    let minBytes = fromInteger $ natVal f `div` 8-        modBytes = fromInteger $ natVal f `mod` 8-    in BoxSize $ minBytes + signum modBytes-  boxBuilder f@(BoxFlags b) =-    let bytes =-          let (BoxSize bytes') = boxSize f-          in fromIntegral bytes'-        wordSeq n-          | n <= bytes =-            word8 (fromIntegral (shiftR b ((bytes - n) * 8) .&. 255)) <>-            wordSeq (n + 1)-          | otherwise = mempty-    in wordSeq 1--instance KnownNat bits => Bits (BoxFlags bits) where-  (.&.) (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ l .&. r-  (.|.) (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ l .&. r-  xor (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ xor l r-  complement (BoxFlags x) = cropBits $ BoxFlags $ complement x-  shift (BoxFlags x) = cropBits . BoxFlags . shift x-  rotateL = error "TODO rotateL"-  rotateR = error "TODO rotateR"-  bitSize = fromInteger . natVal-  bitSizeMaybe = Just . fromInteger . natVal-  isSigned _ = False-  testBit f n =-    let (BoxFlags b) = cropBits f-    in testBit b n-  bit = cropBits . BoxFlags . bit-  popCount f =-    let (BoxFlags b) = cropBits f-    in popCount b-  zeroBits = BoxFlags 0

@@ -15,13 +15,15 @@   ,auxilliaryVideoTrackHandler   ,namedAuxilliaryVideoTrackHandler   ,HandlerType(..)+  ,GetHandlerType   ,HandlerTypeCode)   where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import qualified Data.Text as T+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | Handler box fields. A handler box may also contain a null terminated -- description text in UTF-8. The 'T.Text' parameter is a human readable name of@@ -43,6 +45,9 @@   | HintTrack   | TimedMetaDataTrack   | AuxilliaryVideoTrack++-- | Return 'HandlerType' for 'BoxLayout' checking.+type family GetHandlerType t :: HandlerType  type family HandlerTypeCode (handlertype :: HandlerType) :: Symbol where   HandlerTypeCode 'VideoTrack           = "vide"

@@ -1,11 +1,12 @@ -- | Media-independent properties of a hint tracks media content. module Data.ByteString.IsoBaseFileFormat.Boxes.HintMediaHeader where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import Data.ByteString.IsoBaseFileFormat.Boxes.Handler import Data.ByteString.IsoBaseFileFormat.Boxes.SpecificMediaHeader+import Data.ByteString.IsoBaseFileFormat.ReExports  type instance MediaHeaderFor 'HintTrack = HintMediaHeader 

@@ -2,16 +2,14 @@ -- | Format of the hint track as well as streaming protocol settings. module Data.ByteString.IsoBaseFileFormat.Boxes.HintSampleEntry where -import Data.ByteString.IsoBaseFileFormat.Boxes.SampleEntry+import Data.ByteString.IsoBaseFileFormat.Boxes.SampleEntry () import Data.ByteString.IsoBaseFileFormat.Boxes.Handler-import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box  -- | Protocol specific data. To create 'HintSampleEntry's a protocol specific -- 'HintFields' instance must be provided-data instance SampleEntry 'HintTrack protocol where-  HintSampleEntry-    :: (IsBoxContent (HintFields protocol), Default (HintFields protocol))-     => HintFields protocol -> SampleEntry 'HintTrack protocol+newtype HintSampleEntry protocol where+  HintSampleEntry :: protocol -> HintSampleEntry protocol --- | Family of protocol specific contents for 'HintTrack's.-type family HintFields (protocol :: Symbol)+type instance GetHandlerType (HintSampleEntry protocol) = 'HintTrack+type instance BoxTypeSymbol (HintSampleEntry protocol) = BoxTypeSymbol protocol

@@ -1,22 +1,23 @@ -- | Boxfield indicating an ISO 639-2 alpha-3 language code. module Data.ByteString.IsoBaseFileFormat.Boxes.Language (Language, mkLanguage) where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import           Data.ByteString.IsoBaseFileFormat.Box+import           Data.ByteString.IsoBaseFileFormat.ReExports  -- | A Boxfield contains an ISO 639-2-T alpha-3 language code,  which is encoded -- as a single bit followed by three 5 bit words, each representing the -- lower-case character from the language code subtracted by 0x60. -- If available, the code for /terminoligy/ purposes should be used (T-code).-data Language = Language Word16+newtype Language = Language Word16 -- TODO use bitrecords  -- | Create a 'Language', throw a runtime error when bad characters were given. -- The characters must be in @a - z@ (lower-case!), there must be exactly three -- characters. mkLanguage :: String -> Language mkLanguage  [c0,c1,c2] |-  (c0 > toEnum 0x60 && c0 < toEnum 0x7b &&+   c0 > toEnum 0x60 && c0 < toEnum 0x7b &&    c1 > toEnum 0x60 && c1 < toEnum 0x7b &&-   c2 > toEnum 0x60 && c2 < toEnum 0x7b) =+   c2 > toEnum 0x60 && c2 < toEnum 0x7b =      let          s :: Char -> Word16          s c = fromIntegral (fromEnum c) - 0x60@@ -31,7 +32,7 @@   fromString = mkLanguage  instance Default Language where-  def = mkLanguage "deu"+  def = mkLanguage "und"  instance IsBoxContent Language where   boxSize _ = 2

@@ -1,7 +1,7 @@ -- | Track specific media information container box. module Data.ByteString.IsoBaseFileFormat.Boxes.Media where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box  -- | Media data box data Media

@@ -1,7 +1,7 @@ -- | Media data box module Data.ByteString.IsoBaseFileFormat.Boxes.MediaData where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box import qualified Data.ByteString as B  -- | Media data box phantom type

@@ -1,17 +1,17 @@ -- | Media-independent properties of a tracks media content. module Data.ByteString.IsoBaseFileFormat.Boxes.MediaHeader where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import Data.ByteString.IsoBaseFileFormat.Boxes.Language-import Data.ByteString.IsoBaseFileFormat.Boxes.Time+import Data.ByteString.IsoBaseFileFormat.Util.Time+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | Media header data box.-data MediaHeader (v :: Nat) where+newtype MediaHeader (v :: Nat) where   MediaHeader-   :: KnownNat v-   => Timing v :+ Language :+ Constant (I16 "pre_defined") 0+   :: Timing v :+ Language :+ Constant (I16 "pre_defined") 0    -> MediaHeader v  -- | Create a 'MediaHeader' box.

@@ -2,7 +2,7 @@ -- technicalities of the media data associated with a 'Track'. module Data.ByteString.IsoBaseFileFormat.Boxes.MediaInformation where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box  -- | Media information box type. data MediaInformation

@@ -1,26 +1,18 @@ module Data.ByteString.IsoBaseFileFormat.Boxes.MetaDataSampleEntry where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import Data.ByteString.IsoBaseFileFormat.Boxes.Handler-import Data.ByteString.IsoBaseFileFormat.Boxes.SampleEntry import qualified Data.Text as T import qualified Data.ByteString as B import Data.Tagged () import Data.Default ()+import Data.ByteString.IsoBaseFileFormat.ReExports  -- * Generat meta data sample entry --- | Construct a meta data sample entry box. For every 'MetaDataCoding'--- a 'SampleEntry' instances must be provided.-metaDataSampleEntry ::-     MetaDataCoding c-  -> U16 "data_reference_index"-  -> SampleEntry 'TimedMetaDataTrack (MetaDataCoding c)-  -> Box (SampleEntry 'TimedMetaDataTrack (MetaDataCoding c))-metaDataSampleEntry _ = sampleEntry-+type instance GetHandlerType (MetaDataCoding c) = 'TimedMetaDataTrack type instance BoxTypeSymbol (MetaDataCoding c) = c  -- | A coproduct of meta data codings (XML, Text, ...)

@@ -1,7 +1,7 @@ -- | Meta data for a presentation of a /movie/. module Data.ByteString.IsoBaseFileFormat.Boxes.Movie where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box  -- | Compose a set of boxes into a 'Movie' movie :: Boxes ts -> Box (ContainerBox Movie ts)

@@ -0,0 +1,22 @@+-- | Indicate the possibility of 'MovieFragment' boxes in the current file; the+-- total samples are comprised of those fragments, so they must be parsed by the+-- player.+module Data.ByteString.IsoBaseFileFormat.Boxes.MovieExtends where++import Data.ByteString.IsoBaseFileFormat.Box++-- * @mvex@ Box++-- | Indicate that the media fragmented; more detailed info is obtained by the+-- extra boxes contained in this box, e.g. the 'MovieExtendsHeader' or the+-- 'TrackExtends' boxes.+movieExtends :: Boxes ts -> Box (ContainerBox MovieExtends ts)+movieExtends = containerBox ()++-- | Phantom type to indicate @mvex@ boxes, see ISO-14496-12 8.8.1+data MovieExtends++instance IsBox MovieExtends where+  type BoxContent MovieExtends = ()++type instance BoxTypeSymbol MovieExtends = "mvex"

@@ -0,0 +1,27 @@+-- | Overall duration of fragmented media.+module Data.ByteString.IsoBaseFileFormat.Boxes.MovieExtendsHeader where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.Util.Versioned+import Data.ByteString.IsoBaseFileFormat.ReExports++-- * @mehd@ Box++-- | Construct a 'MovieHeader' box.+movieExtendsHeader+  :: (KnownNat version)+  => MovieExtendsHeader version -> Box (FullBox (MovieExtendsHeader version) version)+movieExtendsHeader = fullBox 0++-- | Movie length incorporating all fragments.+newtype MovieExtendsHeader (version :: Nat) where+        MovieExtendsHeader ::+          Versioned (U32 "fragment_duration") (U64 "fragment_duration") version+            -> MovieExtendsHeader version+    deriving (IsBoxContent)++instance IsBox (MovieExtendsHeader version)++type instance BoxTypeSymbol (MovieExtendsHeader v) = "mehd"

@@ -0,0 +1,20 @@+-- | TODO: this box is a bit of a hack due to the deadline pressure...+module Data.ByteString.IsoBaseFileFormat.Boxes.MovieFragment where++import Data.ByteString.IsoBaseFileFormat.Box++-- | Compose a set of boxes into a 'MovieFragment'+movieFragment :: Boxes ts -> Box (ContainerBox MovieFragment ts)+movieFragment = containerBox ()++-- | Movie Fragments+data MovieFragment++instance IsBox MovieFragment where+  type BoxContent MovieFragment = ()++type instance BoxTypeSymbol MovieFragment = "moof"++-- | Return the static size of the empty box+movieFragmentStaticSize :: Num a => a+movieFragmentStaticSize = fromBoxSize 0 (boxSize (movieFragment NoBoxes))

@@ -0,0 +1,28 @@+-- | Meta data for a presentation of a /movie fragment/.+module Data.ByteString.IsoBaseFileFormat.Boxes.MovieFragmentHeader where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.Default++-- * @mvhd@ Box++-- | Construct a 'MovieFragmentHeader' box.+movieFragmentHeader+  :: MovieFragmentHeader-> Box (FullBox MovieFragmentHeader 0)+movieFragmentHeader = fullBox 0++-- | Movie fragment meta data+-- The sequence number, just an increasing number, of this fragment+newtype MovieFragmentHeader where+        MovieFragmentHeader ::  U32 "sequence_number" -> MovieFragmentHeader+    deriving (IsBoxContent, Default)++instance IsBox MovieFragmentHeader++type instance BoxTypeSymbol MovieFragmentHeader = "mfhd"++-- | Return the static size of the empty box+movieFragmentHeaderStaticSize :: Num a => a+movieFragmentHeaderStaticSize = fromBoxSize 0 (boxSize (movieFragmentHeader def))

@@ -1,10 +1,11 @@ -- | Meta data for a presentation of a /movie/. module Data.ByteString.IsoBaseFileFormat.Boxes.MovieHeader where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox-import Data.ByteString.IsoBaseFileFormat.Boxes.Time+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.Util.Time+import Data.ByteString.IsoBaseFileFormat.ReExports  -- * @mvhd@ Box @@ -23,9 +24,8 @@ -- available track id, if the track ID is (0xFFFFFFFF) then the system must -- search through all tracks associated with this presentation and figure it -- out, 0 is not allowed.-data MovieHeader (version :: Nat) where+newtype MovieHeader (version :: Nat) where         MovieHeader ::-            KnownNat version =>                Timing version             :+ Template (I32 "rate") 0x00010000             :+ Template (I16 "volume") 0x0100@@ -36,12 +36,17 @@             :+ Template (U32Arr "pre_defined" 6) '[0,0,0,0,0,0]             :+ Template (U32 "next_track_ID") 0xFFFFFFFF             -> MovieHeader version+    deriving (IsBoxContent)  -- | Time and timing information about a movie (32bit version).-type MovieHeaderTimesV0 = MovieHeaderTimes (Scalar Word32)+type MovieHeaderTimesV0 = MovieHeaderTimes+                             (Scalar Word32)+                             (Template (U32 "duration") 0xffffffff)  -- | Time and timing information about a movie (64bit version).-type MovieHeaderTimesV1 = MovieHeaderTimes (Scalar Word64)+type MovieHeaderTimesV1 = MovieHeaderTimes+                             (Scalar Word64)+                             (Template (U64 "duration") 0xffffffffffffffff)  -- | Time and timing information about a movie. --@@ -50,16 +55,11 @@ -- number of time units that pass one second. The time coordinate system is used -- by e.g. the duration field, which by the way contains the duration of the -- longest track, if known, or simply the equivalent of 1s.-type MovieHeaderTimes uint =+type MovieHeaderTimes uint dur =       uint "creation_time"    :+ uint "modification_time"    :+ TimeScale-   :+ uint "duration"---instance IsBoxContent (MovieHeader version) where-  boxSize (MovieHeader c) = boxSize c-  boxBuilder (MovieHeader c) = boxBuilder c+   :+ dur  instance IsBox (MovieHeader version) 

@@ -1,8 +1,9 @@ -- | Indicate that a tracks media content is /null/ or /dummy/ media. module Data.ByteString.IsoBaseFileFormat.Boxes.NullMediaHeader where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | Null header data box. data NullMediaHeader = NullMediaHeader

@@ -1,9 +1,9 @@ module Data.ByteString.IsoBaseFileFormat.Boxes.ProgressiveDownloadInformation        where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox  -- | A Box with progressive download information data ProgressiveDownload@@ -19,5 +19,6 @@  -- | Construct a @pdin@ box. pdinBox-  :: ProgressiveDownloadContent -> Box (FullBox ProgressiveDownload 0)+  :: ProgressiveDownloadContent+  -> Box (FullBox ProgressiveDownload 0) pdinBox = fullBox 0

@@ -3,13 +3,14 @@ -- entry boxes are entailed. module Data.ByteString.IsoBaseFileFormat.Boxes.SampleDescription where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields import Data.Singletons.Prelude.List (Length)+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | A sample table contains no fieds.-newtype SampleDescription handlerType =+newtype SampleDescription =   SampleDescription (U32 "entry_count")   deriving (Default,IsBoxContent) @@ -17,11 +18,11 @@ sampleDescription   :: (KnownNat (Length ts))   => Boxes ts-  -> Box (ContainerBox (FullBox (SampleDescription h) 0) ts)+  -> Box (ContainerBox (FullBox SampleDescription 0) ts) sampleDescription bs =   containerBox (FullBox 0 $ SampleDescription (typeListLength bs))                bs -instance IsBox (SampleDescription h)+instance IsBox SampleDescription -type instance BoxTypeSymbol (SampleDescription  h) = "stsd"+type instance BoxTypeSymbol SampleDescription = "stsd"

@@ -3,50 +3,50 @@ -- reference entry table. module Data.ByteString.IsoBaseFileFormat.Boxes.SampleEntry where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box import Data.ByteString.IsoBaseFileFormat.Boxes.Handler-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields---- | Specific sample entries must provide an instance for this data family.--- The @format@ parameter will be used as 'BoxTypeSymbol'.-data family SampleEntry (handlertype :: HandlerType) (format :: k)+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | Create a 'SampleEntry' 'Box' from the data reference index and the -- 'HandlerType' specific 'SampleEntry' instance. sampleEntry-  :: forall (handlertype :: HandlerType) (format :: k)-  .  U16 "data_reference_index"-  -> SampleEntry handlertype format-  -> Box (SampleEntry handlertype format)-sampleEntry i c = Box (SampleEntryFields (Constant :+ i :+ c))+  :: U16 "data_reference_index"+  -> handlerSpecific+  -> Box (SampleEntry handlerSpecific)+sampleEntry i se = Box (SampleEntry (Constant :+ i :+ se))  -- | A common header for all specific sample entries, the 'BoxContent' of the--- abstract 'SampleEntry' is @SampleEntryFields (SampleEntry h f)@.-newtype SampleEntryFields a where-  SampleEntryFields+-- abstract 'SampleEntry' is @SampleEntry (SampleEntry h f)@.+newtype SampleEntry handlerSpecific where+  SampleEntry     :: Constant (U8Arr "reserved" 6) '[0,0,0,0,0,0]     :+ U16 "data_reference_index"-    :+ a-    -> SampleEntryFields a-deriving instance IsBoxContent a => IsBoxContent (SampleEntryFields a)-deriving instance Default a => Default (SampleEntryFields a)+    :+ handlerSpecific+    -> SampleEntry handlerSpecific +deriving instance IsBoxContent handlerSpecific =>+  IsBoxContent (SampleEntry handlerSpecific)++deriving instance Default handlerSpecific =>+  Default (SampleEntry handlerSpecific)+ -- | Use this in 'IsMediaFileFormat's 'BoxLayout' to range over any specific -- 'SampleEntry', disregarding the second parameter (that indicates low-level--- format, protocol or codec characteristics).-data MatchSampleEntry (handlerType :: HandlerType)+-- format, protocol or codec characteristics). Add a 'GetHandlerType' instance for+-- 'MatchSampleEntry' to match a sample type specific entry.+data MatchSampleEntry :: HandlerType -> Type  type instance-  IsRuleConform (Box (SampleEntry g' f)) (MatchSampleEntry g) =-    HandlerTypeCode g' == HandlerTypeCode g+  IsRuleConform (Box (SampleEntry handlerSpecificEntry))+                (MatchSampleEntry handlerType) =+  HandlerTypeCode (GetHandlerType handlerSpecificEntry) == HandlerTypeCode handlerType  -- | The 'BoxTypeSymbol' of sample entry is exactly the @format@ type index of -- the 'SampleEntry' family. type instance-  BoxTypeSymbol (SampleEntry handlertype format) = BoxTypeSymbol format+  BoxTypeSymbol (SampleEntry handlerSpecific) = BoxTypeSymbol handlerSpecific -instance (IsBoxContent (SampleEntry handlertype format)-         ,KnownSymbol (BoxTypeSymbol (SampleEntry handlertype format)))-  => IsBox (SampleEntry handlertype format) where-    type BoxContent (SampleEntry handlertype format) =-      SampleEntryFields (SampleEntry handlertype format)+instance (IsBoxContent handlertype+         ,KnownSymbol (BoxTypeSymbol handlertype))+  => IsBox (SampleEntry handlertype)

@@ -0,0 +1,42 @@+-- | A box containing the sample count and sample size table.+module Data.ByteString.IsoBaseFileFormat.Boxes.SampleSize where++import           Data.ByteString.IsoBaseFileFormat.Box+import           Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.ReExports++-- | Content type of the 'FullBox' containing the 'SampleSize'.+type SampleSize = FullBox SampleSizeTable 0++-- | Create a 'SampleSize' box for the case where all sample sizes are equal, no+-- table with the size of each sample is required.+fixedSampleSize :: Word32 -> Word32 -> Box SampleSize+fixedSampleSize sampleSize sampleCount =+  fullBox 0 $ FixedSampleSize sampleSize sampleCount++-- | Create a 'SampleSize' box for the case where samples have different sizes.+-- The list MUST contain an entry for **every sample** in the media file.+individualSampleSizes :: [Word32] -> Box SampleSize+individualSampleSizes sampleSizes =+  fullBox 0 $+    SampleSizeTable (ListContent sampleSizes)++-- | The 'SampleSize' box content. If @sampleSize == 0@ then each sample has its+-- own size and the @table@ field contains an entry for **every** sample, the+-- number of entries is stored in @sampleCount@. Otherwise the samples are+-- assumed to all have the same size: @sampleSize@.+data SampleSizeTable =+    FixedSampleSize { sampleSize :: !Word32, sampleCount :: !Word32 }+  | SampleSizeTable !(ListContent Word32 Word32)++instance IsBox SampleSizeTable++type instance BoxTypeSymbol SampleSizeTable = "stsz"++instance IsBoxContent SampleSizeTable where+  boxSize (FixedSampleSize _ _) = 8+  boxSize (SampleSizeTable entries) = 4 + boxSize entries+  boxBuilder (FixedSampleSize size count) = word32BE size <> word32BE count+  boxBuilder (SampleSizeTable entries) = word32BE 0 <> boxBuilder entries++-- TODO implement compact sample size box (stz2)

@@ -5,7 +5,7 @@ -- block of audio samples. module Data.ByteString.IsoBaseFileFormat.Boxes.SampleTable where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box  -- | A sample table contains no fieds. data SampleTable = SampleTable

@@ -0,0 +1,32 @@+-- | The chunks into which samples are grouped, can vary in size, as can the+-- samples within a chunk. This compact table contains the info to find the+-- chunk and offset within of a sample.+module Data.ByteString.IsoBaseFileFormat.Boxes.SampleToChunk where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.ReExports++-- | An alias for the box content type.+type SampleToChunk = FullBox SampleToChunkTable 0++-- | Define an entry of the compact table. An entry represents a group of chunks+-- of the same size and the same 'SampleDescription'. The @first_chunk@ is an+-- index of the first chunk in a sequence of chunks correspondiing to an entry.+-- The very first  entry has an index of 1.+type StscEntry =+  U32 "first_chunk" :+ U32 "samples_per_chunk" :+ U32 "sample_description_index"++-- | A compact table to map decoding time to sample number.+newtype SampleToChunkTable =+  SampleToChunkTable (ListContent (U32 "entry_count") StscEntry)+  deriving (Default, IsBoxContent)++-- | Create a hint media header data box.+sampleToChunk :: [StscEntry] -> Box SampleToChunk+sampleToChunk = fullBox 0 . SampleToChunkTable . ListContent++instance IsBox SampleToChunkTable++type instance BoxTypeSymbol SampleToChunkTable = "stsc"

@@ -0,0 +1,25 @@+module Data.ByteString.IsoBaseFileFormat.Boxes.SegmentType where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports++-- | Segment Type Box+instance IsBox SegmentType where+  type BoxContent SegmentType = SegmentType+type instance BoxTypeSymbol SegmentType = "styp"++-- | Create a 'SegmentTypeBox' from a major brand, a minor version and a list of+-- compatible brands+segmentTypeBox :: SegmentType -> Box SegmentType+segmentTypeBox = Box++-- | Contents of a 'styp' box are some 'FourCc' /brands/ and a version.+data SegmentType =+  SegmentType {majorBrand :: !FourCc -- TODO use U32String+           ,minorVersion :: !Word32 -- TODO use U32String+           ,compatibleBrands :: ![FourCc]}  -- TODO use U32String++instance IsBoxContent SegmentType where+  boxSize (SegmentType maj _ver comps) = boxSize maj + 4 + sum (boxSize <$> comps)+  boxBuilder (SegmentType maj ver comps) =+    boxBuilder maj <> word32BE ver <> mconcat (boxBuilder <$> comps)

@@ -1,10 +1,12 @@ -- | A filler box with a specific size. module Data.ByteString.IsoBaseFileFormat.Boxes.Skip where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import qualified Data.ByteString as B+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | Contents of a 'skip' box are just any number of filler bytes.-newtype Skip = Skip Int+newtype Skip = Skip B.ByteString  instance IsBox Skip where   type BoxContent Skip = Skip@@ -16,5 +18,5 @@ skipBox = Box  instance IsBoxContent Skip where-  boxSize (Skip bs) = fromIntegral bs-  boxBuilder (Skip bs) = mconcat (replicate bs (word8 0))+  boxSize (Skip bs) = fromIntegral $ B.length bs+  boxBuilder (Skip bs) = byteString bs

@@ -1,11 +1,12 @@ -- | Media-independent properties of a tracks sound content. module Data.ByteString.IsoBaseFileFormat.Boxes.SoundMediaHeader where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import Data.ByteString.IsoBaseFileFormat.Boxes.Handler import Data.ByteString.IsoBaseFileFormat.Boxes.SpecificMediaHeader+import Data.ByteString.IsoBaseFileFormat.ReExports  type instance MediaHeaderFor 'AudioTrack = SoundMediaHeader 

@@ -1,72 +0,0 @@--- | Time and timing utilities.-module Data.ByteString.IsoBaseFileFormat.Boxes.Time-       (referenceTime, utcToMp4, mp4CurrentTime, durationFromSeconds,-        TimeScale, Timing)-       where--import Data.Time.Clock-import Data.Time.Calendar-import Data.Ratio-import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.Versioned---- * Absolute Dates--- | According to the standard, fields with absolute dates and times are in--- seconds since 1904/01/01 at midnight (UTC). This is this reference time.-referenceTime :: UTCTime-referenceTime =-  let startDay = fromGregorian 1904 1 1-      startTime = 0-  in UTCTime startDay startTime---- | Convert a 'UTCTime' to a number of seconds since 'referenceTime'.-utcToMp4 :: Num t-         => UTCTime -> t-utcToMp4 u =-  let picoSecondsDiff = toRational $ diffUTCTime u referenceTime-      picoSecondsDiffNumerator = numerator picoSecondsDiff-      picoSecondsDiffDenominator = denominator picoSecondsDiff-      secondsSinceReferenceTime =-        div picoSecondsDiffNumerator picoSecondsDiffDenominator-  in fromIntegral secondsSinceReferenceTime---- | Get the current time as number of seconds since 'referenceTime'-mp4CurrentTime :: Num t-               => IO t-mp4CurrentTime = utcToMp4 <$> getCurrentTime---- * Time-Scale and Durations--- | Default time-scale value---   Based on history and tradition this value is @90000@.---   MPEG-2 TS defines a single clock for each program, running at 27MHz. The---   timescale of MPEG-2 TS Hint Tracks should be divisable by 90000.-type TimeScale = Template (U32 "timescale") 90000---- | Utility function to convert seconds (Integers) to any 'Num' using a--- 'TimeScale', Since 'Scalar' has a 'Num' instance this can be used to generate--- @duration@ fields.-durationFromSeconds :: Num t-                    => TimeScale -> Integer -> t-durationFromSeconds timeScale seconds =-  let timeScaleI = fromIntegral $ fromScalar $ templateValue timeScale-  in timeScaleI * fromInteger seconds---- | Time and timing information about a movie.------ The creation/modification times are in seconds since midnight, Jan. 1, 1904,--- in UTC time. Time scale declares the time coordinate system, it specifies the--- number of time units that pass one second. The time coordinate system is used--- by e.g. the duration field, which by the way contains the duration of the--- longest track, if known, or simply the equivalent of 1s.-type Timing (version :: Nat) = Versioned TimingV0 TimingV1 version--type TimingV0 = TimingImpl (Scalar Word32)--type TimingV1 = TimingImpl (Scalar Word64)--type TimingImpl uint =-     uint "creation_time"-  :+ uint "modification_time"-  :+ TimeScale-  :+ uint "duration"

@@ -2,9 +2,10 @@ -- seeking in complex media files. module Data.ByteString.IsoBaseFileFormat.Boxes.TimeToSample where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.ReExports  -- | An alias for the box content type. type TimeToSample = FullBox TimeToSampleTable 0

@@ -1,7 +1,7 @@ -- | Meta data for a presentation of a /movie/. module Data.ByteString.IsoBaseFileFormat.Boxes.Track where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Box  -- * @trak@ Box -- | Compose a 'Track' box from the given boxes.

@@ -0,0 +1,62 @@+-- | Default values for duration, size and other metadata of track fragments.+-- This might allow a more efficient transfer and decoding of media.+module Data.ByteString.IsoBaseFileFormat.Boxes.TrackExtends where++import Data.ByteString.IsoBaseFileFormat.Box++import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.ReExports++-- * @trex@ Box++-- | Construct a 'TrackExtends' box, with all durations and sizes set to @0@.+-- Only the track index and the index into the sample description table is+-- passed set.+trackExtendsUnknownDuration :: Word32 -> Word32 -> Box (FullBox TrackExtends 0)+trackExtendsUnknownDuration trackId descrIndex = trackExtends trackId descrIndex+  0 0 0 0 0 0 0 False 0++-- | Construct a 'TrackExtends' box from all its parameters+trackExtends+  :: Word32 -- ^ Track ID+  -> Word32 -- ^ Sample Description Index+  -> Word32 -- ^ Sample Duration+  -> Word32 -- ^ Sample Size+  -> B 2    -- ^ is leading+  -> B 2    -- ^ sample depends on+  -> B 2    -- ^ sample is depended on+  -> B 2    -- ^ sample has redundancy+  -> B 3    -- ^ padding value+  -> Bool   -- ^ is non sync sample+  -> Word16 -- ^ sample degradation priority+  -> Box (FullBox TrackExtends 0)+trackExtends =+   wrapBitBuilderBox (fullBox 0 . MkTrackExtends) (Proxy @TrackExtendsBody)++-- | Defaults for movie fragments - the type alias+newtype TrackExtends where+  MkTrackExtends :: BuilderBox -> TrackExtends+  deriving (IsBoxContent)++instance IsBox TrackExtends++type instance BoxTypeSymbol TrackExtends = "trex"++-- | Defaults for movie fragment - the content+type TrackExtendsBody =+     "track_ID"                         @: FieldU32+ .+: "default_sample_description_index" @: FieldU32+ .+: "default_sample_duration"          @: FieldU32+ .+: "default_sample_size"              @: FieldU32+ .+: TrackExtendsDefaultSampleFlags++type TrackExtendsDefaultSampleFlags =+      "reserved"                    @: Field 4 := 0+  .+: "is_leading"                  @: Field 2+  .+: "sample_depends_on"           @: Field 2+  .+: "sample_is_depended_on"       @: Field 2+  .+: "sample_has_redundancy"       @: Field 2+  .+: "sample_padding_value"        @: Field 3+  .+: "sample_is_non_sync_sample"   @: Flag+  .+: "sample_degradation_priority" @: FieldU16+  .+: 'EmptyBitRecord

@@ -0,0 +1,32 @@+-- | Sum of the total base media time in the timescale from the movie header box.+module Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragBaseMediaDecodeTime where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.Util.Time+import GHC.TypeLits++-- * @tfdt@ Box++-- | Construct a 'TrackFragBaseMediaDecodeTime box.+trackFragBaseMediaDecodeTime -- TODO allow 64 bit variant+  :: KnownNat version+  => TS version "track-fragment-base-media-decode-time"+  -> Box (FullBox (TrackFragBaseMediaDecodeTime version) version)+trackFragBaseMediaDecodeTime = fullBox 0 . TrackFragBaseMediaDecodeTime++-- | Track fragment media base decode time+newtype TrackFragBaseMediaDecodeTime (version :: Nat) where+  TrackFragBaseMediaDecodeTime+    :: TS version "track-fragment-base-media-decode-time"+    -> TrackFragBaseMediaDecodeTime version+  deriving (IsBoxContent)++instance IsBox (TrackFragBaseMediaDecodeTime v)++type instance BoxTypeSymbol (TrackFragBaseMediaDecodeTime v) = "tfdt"++-- | Return the static size of the empty box+trackFragBaseMediaDecodeTimeStaticSize64 :: Num a => a+trackFragBaseMediaDecodeTimeStaticSize64 =+  fromBoxSize 0 (boxSize (trackFragBaseMediaDecodeTime (TSv1 0)))

@@ -0,0 +1,23 @@+-- | Meta data for fragments of a track inside a movie fragment.+module Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragment where++import Data.ByteString.IsoBaseFileFormat.Box++-- * @traf@ Box++-- | Compose a 'TrackFragment' box from the given boxes.+trackFragment+  :: Boxes ts -> Box (ContainerBox TrackFragment ts)+trackFragment = containerBox ()++-- | Container box for tracks.+data TrackFragment++instance IsBox TrackFragment where+  type BoxContent TrackFragment = ()++type instance BoxTypeSymbol TrackFragment = "traf"++-- | Return the static size of the empty box+trackFragmentStaticSize :: Num a => a+trackFragmentStaticSize = fromBoxSize 0 (boxSize (trackFragment NoBoxes))

@@ -0,0 +1,33 @@+-- | Meta data for a presentation of a /movie fragment/.+module Data.ByteString.IsoBaseFileFormat.Boxes.TrackFragmentHeader where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.Default++-- * @tfhd@ Box++-- | Construct a 'TrackFragmentHeader' box.++trackFragmentHeader -- TODO allow 64 bit variant+  :: TrackFragmentHeader -> Box (FullBox TrackFragmentHeader 0)+trackFragmentHeader =+  fullBox 0x020000 -- TODO box is hard coded for file offset calculations in the 'trun' box++-- | Track fragment meta data+-- TODO box is hard coded for file offset calculations in the 'trun' box+newtype TrackFragmentHeader where+  TrackFragmentHeader ::+    Template (U32 "track_ID") 0x001+    -> TrackFragmentHeader+    -- TODO all optional fields currently omitted for offset calculations in the 'trun' box+  deriving (IsBoxContent, Default)++instance IsBox TrackFragmentHeader++type instance BoxTypeSymbol TrackFragmentHeader = "tfhd"++-- | Return the static size of the empty box+trackFragmentHeaderStaticSize :: Num a => a+trackFragmentHeaderStaticSize = fromBoxSize 0 (boxSize (trackFragmentHeader def))

@@ -1,20 +1,39 @@ -- | Track header box-module Data.ByteString.IsoBaseFileFormat.Boxes.TrackHeader where+module Data.ByteString.IsoBaseFileFormat.Boxes.TrackHeader+  (trackHeader, TrackHeader(..), TrackHeaderFlags(..)+  , type TrackHeaderTimes , type TrackHeaderTimesV0 , type TrackHeaderTimesV1 ) where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox-import Data.ByteString.IsoBaseFileFormat.Boxes.Versioned+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox+import Data.ByteString.IsoBaseFileFormat.Util.Versioned+import Data.ByteString.IsoBaseFileFormat.Util.Time+import Data.ByteString.IsoBaseFileFormat.ReExports  -- * @tkhd@ Box -- | Create a 'TrackHeader' box. trackHeader-  :: KnownNat version-  => TrackHeader version -> Box (FullBox (TrackHeader version) version)-trackHeader = fullBox 0+  :: forall version . ( KnownNat version )+  => TrackHeaderFlags+  -> TrackHeader version+  -> Box (FullBox (TrackHeader version) version)+trackHeader flags = fullBox flags'+  where+    flags' = case flags of+      TrackDisabled -> 0+      TrackEnabled -> 1+      TrackInMovie -> 3+      TrackInMovieAndPreview -> 7 +data TrackHeaderFlags =+    TrackDisabled+  | TrackEnabled+  | TrackInMovie+  | TrackInMovieAndPreview++ -- | Track meta data, indexed by a version.-data TrackHeader (version :: Nat) where+newtype TrackHeader (version :: Nat) where         TrackHeader ::           Versioned TrackHeaderTimesV0 TrackHeaderTimesV1 version             :+ Constant (I32Arr "reserved" 2) '[0, 0]@@ -27,25 +46,26 @@             :+ I32 "width"             :+ I32 "height"             -> TrackHeader version+  deriving (IsBoxContent)  -- | Time and timing information about a track (32bit version).-type TrackHeaderTimesV0 = TrackHeaderTimes (Scalar Word32)+type TrackHeaderTimesV0 = TrackHeaderTimes+                          (Scalar Word32)+                          (TS32 "duration")  -- | Time and timing information about a track (64bit version).-type TrackHeaderTimesV1 = TrackHeaderTimes (Scalar Word64)+type TrackHeaderTimesV1 = TrackHeaderTimes+                          (Scalar Word64)+                          (TS64 "duration")  -- | Time and timing information about a track.-type TrackHeaderTimes uint =+type TrackHeaderTimes uint dur =      uint "creation_time"   :+ uint "modification_time"   :+ U32 "track_ID"   :+ Constant (U32 "reserved") 0-  :+ uint "duration"--instance IsBoxContent (TrackHeader version) where-  boxSize (TrackHeader c) = boxSize c-  boxBuilder (TrackHeader c) = boxBuilder c+  :+ dur -instance IsBox (TrackHeader version)+instance IsBox (TrackHeader v) -type instance BoxTypeSymbol (TrackHeader version) = "tkhd"+type instance BoxTypeSymbol (TrackHeader v) = "tkhd"

@@ -0,0 +1,80 @@+-- | A list of sample offsets and sizes of a track. This tells the decoder where+-- stuff inside an 'mdat' box is, and also where the 'mdat' box /starts/, which+-- is the reason why currently there are several TODOs concercning the offset+-- calculation.+module Data.ByteString.IsoBaseFileFormat.Boxes.TrackRun (trackRunIso5, TrackRun) where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports+import qualified Data.ByteString as BS++-- | Create a track run box. First parameter is the accumulated offset to the+-- /moof/ box. This is needed for data offset calculation. Then follows a list+-- of __sample-duration__ and __sample-sizes__. All samples are flagged+-- /independent/.+trackRunIso5 :: Int32 -> [(Word32, BS.ByteString)] -> Box TrackRun+trackRunIso5 !mdatOffset !samples = Box c+  where+    !c = TrackRun (header <> body)+      where+        !header = h (fromIntegral sampleCount) dataOffset+          where+            !dataOffset       = 8 -- box size field + fourcc code of this very box+                                  + mdatOffset + 8  -- +8 because we want to skip the box header od the mdat box+                                  + fromIntegral+                                  ((headerStaticSize `div` 8)+                                   + sampleCount * (sampleStaticSize `div` 8))+            !h                = bitBuilderBox (Proxy @(Header TrackRunFlagsIso5))+            !headerStaticSize = (natVal (Proxy @(BitRecordSize (Header TrackRunFlagsIso5))))+            !sampleStaticSize = (natVal (Proxy @(BitRecordSize (Sample TrackRunFlagsIso5))))+            !sampleCount      = fromIntegral (length samples)++        !body = mconcat $ s <$> samples+          where+            s (!duration, !bs) = bitBuilderBox (Proxy @(Sample TrackRunFlagsIso5)) duration size+              where+                !size = fromIntegral (BS.length bs)++newtype TrackRun where+  TrackRun :: BuilderBox -> TrackRun+  deriving (IsBoxContent)++instance IsBox TrackRun+type instance BoxTypeSymbol TrackRun = "trun"++-- class MkTrackRunArgs (t :: IsA (TrackRunFlags sop fsp sdp ssp sfp sop)) where+--   data TrRunArgs (t :: IsA (TrackRunFlags sop fsp sdp ssp sfp sop))++data TrackRunFlags+  (dataOffsetPresent :: Bool)+  (firstSampleFlagsPresent :: Bool)+  (sampleDurationPresent :: Bool)+  (sampleSizePresent :: Bool)+  (sampleFlagsPresent :: Bool)+  (sampleCompositionTimeOffsetPresent :: Bool)++data TrackRunFlagsIso5+  :: IsA (TrackRunFlags 'True 'False 'True 'True 'True 'False)++type Header (t :: IsA (TrackRunFlags dop fsp sdp ssp sfp sctop)) =+      "version"                   @: FieldU8  := 0 -- TODO allow version 1+  .+:                                Field 12 := 0+  .+: "sample-scto-present"       @: Flag     := sctop+  .+: "sample-flags-present"      @: Flag     := sfp+  .+: "sample-size-present"       @: Flag     := ssp+  .+: "sample-duration-present"   @: Flag     := sdp+  .+:                                Field  5 := 0+  .+: "first-sample-flag-present" @: Flag     := fsp+  .+:                                Flag     := 'False+  .+: "data-offset-preset"        @: Flag     := dop+  .+: "sample-count"              @: FieldU32+  .+: WhenR dop+        ('BitRecordMember ("data-offset"        @: FieldI32))+  :+: WhenR fsp+        ('BitRecordMember ("first-sample-flags" @: FieldU32))+++type Sample (t :: IsA (TrackRunFlags dop fsp sdp ssp sfp sctop)) =+      WhenR sdp ('BitRecordMember ("sample-duration" @: FieldU32))+  :+: WhenR ssp ('BitRecordMember ("sample-size"     @: FieldU32))+  :+: WhenR sfp ('BitRecordMember ("sample-flags"    @: FieldU32 := 0x02000000)) -- TODO allow flags as in TrackExtends 

@@ -1,24 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--- | A binary version 0/1 field with seperate content for each version.-module Data.ByteString.IsoBaseFileFormat.Boxes.Versioned-       (Versioned(..))-       where--import Data.ByteString.IsoBaseFileFormat.Boxes.Box---- TODO rewrite/cleanup the versioned mess---- | Two alternative representations based on a /version/ index.---   Use this for box content that can be either 32 or 64 bit.-data Versioned v0 v1 (version :: Nat) where-        V0 :: IsBoxContent v0 => v0 -> Versioned v0 v1 0-        V1 :: IsBoxContent v1 => v1 -> Versioned v0 v1 1--instance (version ~ 0,IsBoxContent v0,Default v0) => Default (Versioned v0 v1 (version :: Nat)) where-  def = V0 def--instance IsBoxContent (Versioned v0 v1 version) where-  boxSize (V0 c) = boxSize c-  boxSize (V1 c) = boxSize c-  boxBuilder (V0 c) = boxBuilder c-  boxBuilder (V1 c) = boxBuilder c

@@ -1,11 +1,12 @@ -- | Media-independent properties of a tracks video content. module Data.ByteString.IsoBaseFileFormat.Boxes.VideoMediaHeader where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.FullBox import Data.ByteString.IsoBaseFileFormat.Boxes.Handler import Data.ByteString.IsoBaseFileFormat.Boxes.SpecificMediaHeader+import Data.ByteString.IsoBaseFileFormat.ReExports  type instance MediaHeaderFor 'VideoTrack = VideoMediaHeader 

@@ -2,27 +2,17 @@ -- | Detailed visual sample description. module Data.ByteString.IsoBaseFileFormat.Boxes.VisualSampleEntry where -import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields import Data.ByteString.IsoBaseFileFormat.Boxes.Handler-import Data.ByteString.IsoBaseFileFormat.Boxes.SampleEntry+import Data.ByteString.IsoBaseFileFormat.ReExports import qualified Data.Text as T --- | Construct a visual sample entry box-visualSampleEntry ::-     (KnownSymbol-       (BoxTypeSymbol (SampleEntry 'VideoTrack (VideoCoding codec))))-  => VideoCoding codec-  -> U16 "data_reference_index"-  -> SampleEntry 'VideoTrack (VideoCoding codec)-  -> Box (SampleEntry 'VideoTrack (VideoCoding codec))-visualSampleEntry _ = sampleEntry- -- | Fields if visual sample entries. --  A @depth@ of 0x0018 means colour image with no alpha. --  The @horizresolution@ and @vertresolution@ of 0x00480000 means 72 dpi. --  The @frame_count@ indicates the number of video frames per sample.-newtype instance SampleEntry 'VideoTrack (VideoCoding c) where+newtype VideoSampleEntry c where     VideoSampleEntry       :: U16 "pre_defined"       :+ Constant (U16 "reserved") 0@@ -38,21 +28,17 @@       :+ Maybe (Box CleanAperture)       :+ Maybe (Box PixelAspectRatio)       :+ [Box SomeColourInformation]-      -> SampleEntry 'VideoTrack (VideoCoding c)+      :+ c+      -> VideoSampleEntry c     deriving (IsBoxContent, Default) +type instance GetHandlerType (VideoSampleEntry c) = 'VideoTrack+type instance BoxTypeSymbol (VideoSampleEntry c) = BoxTypeSymbol c+ instance IsBoxContent [Box SomeColourInformation] where   boxSize = sum . fmap boxSize   boxBuilder = fold . fmap boxBuilder --- | A coproduct of video codec types-data family VideoCoding (c :: Symbol)---- | Simple default  MPEG-4 video-data instance VideoCoding "mp4v" = Mpeg4Avc--type instance BoxTypeSymbol (VideoCoding c) = c- -- * Clean Aperture sub box  -- | Construct a 'CleanAperture' (sub-) 'Box'@@ -124,7 +110,7 @@   SomeColourInformation     :: forall (profile :: ColourTypeProfile)     . IsBoxContent (ColourInformation profile)-    => ColourInformation profile+    => !(ColourInformation profile)     -> SomeColourInformation instance IsBoxContent SomeColourInformation where   boxSize (SomeColourInformation c) = boxSize c

@@ -4,13 +4,15 @@ -- educational, current need. -- This is a convenient way of building documents of that kind. module Data.ByteString.IsoBaseFileFormat.Brands.Dash-       (Dash, SingleAudioTrackInit(..), mkSingleTrackInit, module X)+       (Dash, dash)        where+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.MediaFile+import Data.ByteString.IsoBaseFileFormat.Boxes+import Data.ByteString.IsoBaseFileFormat.ReExports -import Data.ByteString.IsoBaseFileFormat.Brands.Types-import Data.ByteString.IsoBaseFileFormat.Boxes as X hiding (All)-import Data.Kind (Type, Constraint) +-- TODO rename dash to iso5 -- | A phantom type to indicate this branding. Version can be 0 or 1 it is used -- in some boxes to switch between 32/64 bits. data Dash (version :: Nat)@@ -20,11 +22,16 @@ dash = Proxy  -- | A 'BoxLayout' which contains the stuff needed for the 'dash' brand.--- TODO incomplete+-- TODO add iso1 iso2 iso3 iso5 isom formats instance IsMediaFileFormat (Dash v) where   type BoxLayout (Dash v) =+    OneOf '[ MovieLayout v+           , SegmentLayout]++type MovieLayout v =     Boxes      '[ OM_ FileType+      , OM_ Skip       , OM  Movie            '[ OM_ (MovieHeader v)             , SomeMandatoryX@@ -33,8 +40,10 @@                        , TrackLayout v 'HintTrack                        , TrackLayout v 'TimedMetaDataTrack                        , TrackLayout v 'AuxilliaryVideoTrack])+            , OO  MovieExtends+                 '[ OO_ (MovieExtendsHeader v)+                  , OM_ TrackExtends ]             ]-     , SO_ Skip      ]  type TrackLayout version handlerType =@@ -52,58 +61,27 @@                                (OneOf '[ OM_ DataEntryUrl                                        , OM_ DataEntryUrn])]]                 , OM  SampleTable-                      '[ OM  (SampleDescription handlerType)+                      '[ OM  SampleDescription                             '[ SomeMandatoryX (MatchSampleEntry handlerType) ]                        , OM_ TimeToSample-                --       , OM_ (SampleToChunk version)-                --       , OO_ (SampleSizes version)-                --       , OM_ (SampleChunkOffset version)+                       , OM_ SampleToChunk+                       , OM_ SampleSize+                       , OneOf '[ OM_ ChunkOffset32+                                , OM_ ChunkOffset64 ]                        ]                 ]          ]     ]) ---- Missing Boxes---  stts---  stsc---  stsz---  stco---  esds---  mvex---  trex--- For media--- styp--- moof--- mfhd--- traf--- tfhd--- trun--- | A record which contains the stuff needed for a single track initialization--- document according to the 'Dash' brand. TODO incomplete--- TODO take this out into its own module, make a new package for specific file formats-data SingleAudioTrackInit =-  SingleAudioTrackInit {mvhd :: MovieHeader 0-                       ,tkhd :: TrackHeader 0-                       ,mdhd :: MediaHeader 0-                       ,hdlr :: Handler 'AudioTrack-                       ,smhd :: SoundMediaHeader}---- | Convert a 'SingleAudioTrackInit' record to a generic 'Boxes' collection.-mkSingleTrackInit-  :: SingleAudioTrackInit -> Builder-mkSingleTrackInit doc = mediaBuilder dash $-     fileTypeBox (FileType "dash" 0 ["isom","iso5","mp42"])-  :| movie-      ( movieHeader (mvhd doc)-      :| track-          ( trackHeader (tkhd doc)-          :| media-              ( mediaHeader (mdhd doc)-              :. handler (hdlr doc)-              :| mediaInformation-                   ( soundMediaHeader (smhd doc)-                   :. (dataInformation $: localMediaDataReference)-                   :| sampleTable-                       ((sampleDescription $: audioSampleEntry Mpeg4Aac 1 def)-                        :| timeToSample [] )))))+type SegmentLayout =+  Boxes '[ OM_ SegmentType+         , OM  MovieFragment+              '[ OM_ MovieFragmentHeader+               , OM  TrackFragment+                    '[ OM_ TrackFragmentHeader+                     , OO_ (TrackFragBaseMediaDecodeTime 1)+                     , SO_ TrackRun+                     ]+               ]+         , SM_ MediaData+         ]

@@ -1,17 +0,0 @@--- | Brand/Box-validation-module Data.ByteString.IsoBaseFileFormat.Brands.Types-        where--import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Util.TypeLayout ()---- TODO move this to general module merge with Box.hs--- | A class that describes (on the type level) how a box can be nested into--- other boxes (see 'Boxes).-class IsMediaFileFormat brand where-  -- | The layout that an IsBoxContent instance has to have, before 'packMedia' accepts it-  type BoxLayout brand-  mediaBuilder-    :: forall t proxy . (IsBoxContent t, IsRuleConform t (BoxLayout brand) ~ 'True)-    => proxy brand -> t -> Builder-  mediaBuilder _ t = boxBuilder t

@@ -0,0 +1,18 @@+-- | Brand/Box-validation+module Data.ByteString.IsoBaseFileFormat.MediaFile+        where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.TypeLayout+import Data.ByteString.IsoBaseFileFormat.ReExports++-- TODO move this to general module merge with Box.hs+-- | A class that describes (on the type level) how a box can be nested into+-- other boxes (see 'Boxes).+class IsMediaFileFormat brand where+  -- | The layout that an IsBoxContent instance has to have, before 'packMedia' accepts it+  type BoxLayout brand+  mediaBuilder+    :: forall t proxy . (IsBoxContent t, IsRuleConform t (BoxLayout brand) ~ 'True)+    => proxy brand -> t -> Builder+  mediaBuilder _ t = boxBuilder t

@@ -0,0 +1,41 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | A module of re-exports and orphan instances+module Data.ByteString.IsoBaseFileFormat.ReExports (module X) where+++import           Data.Bits                                         as X+import qualified Data.ByteString                                   as B+import           Data.ByteString.Builder                           as X+import           Data.ByteString.IsoBaseFileFormat.Util.TypeLayout as X+import           Data.Default                                      as X+import           Data.Foldable                                     as X (fold)+import           Data.Int                                          as X+import           Data.Kind                                         as X (Constraint,+                                                                         Type)+import           Data.Kind.Extra                                   as X+import           Data.Maybe                                        as X+import           Data.Monoid                                       as X+import           Data.Proxy                                        as X+import           Data.String                                       as X+import           Data.Tagged                                       as X+import qualified Data.Text                                         as T+import           Data.Type.Bool                                    as X+import           Data.Type.BitRecords                              as X+import           Data.Type.Equality                                as X+import           Data.Type.Pretty                                  as X+import           Data.Word                                         as X+import           GHC.TypeLits                                      as X+import           Test.TypeSpecCrazy                                as X hiding+                                                                         (type Not)+import           Text.Printf                                       as X+import Debug.Trace as X++instance Default B.ByteString where+  def = mempty++instance Default T.Text where+  def = ""++instance Default c => Default (Tagged s c) where+  def = Tagged def

@@ -1,214 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-module Data.ByteString.IsoBaseFileFormat.Util.BitRecords where--import Data.Kind-import Data.Word-import Data.Type.Bool-import GHC.TypeLits-import Data.Bits-import Data.Proxy-import Test.TypeSpecCrazy--data Field :: Nat -> Type-data (:=>) :: k -> Type -> Type-data (:*:) :: Type -> Type -> Type-type FieldPosition = (Nat, Nat)--type Flag = Field 1--infixr 6 :=>-infixl 5 :*:---- nested fields-data (:/) :: Symbol -> k -> Type-infixr 7 :/---type family-  GetFieldSize (f :: l) :: Nat where-  GetFieldSize (label :=> f) = GetFieldSize f-  GetFieldSize (Field n ) = n-  GetFieldSize (l :*: r) = GetFieldSize l + GetFieldSize r--type family-  HasField (f :: fk) (l :: lk) :: Bool where-  HasField (l :=> f) l = 'True-  HasField (l :=> f) (l :/ p) = HasField f p-  HasField (f1 :*: f2) l = HasField f1 l || HasField f2 l-  HasField f l = 'False--type family-  HasFieldConstraint (label :: lk) (field :: fk) :: Constraint where-  HasFieldConstraint l f =-      If (HasField f l)-         (HasField f l ~ 'True)-         (TypeError ('Text "Label not found: '"-                     ':<>: 'ShowType l-                     ':<>: 'Text "' in:"-                     ':$$: 'ShowType f ))--type family-  FocusOn (l :: lk) (f :: fk) :: Result fk where-    FocusOn l f =-      If (HasField f l)-         ('Right (FocusOnUnsafe l f))-         ('Left ('Text "Label not found. Cannot focus '"-                     ':<>: 'ShowType l-                     ':<>: 'Text "' in:"-                     ':$$: 'ShowType f ))--type family-  FocusOnUnsafe (l :: lk) (f :: fk) :: fk where-  FocusOnUnsafe l        (l :=> f) = f-  FocusOnUnsafe (l :/ p) (l :=> f) = FocusOnUnsafe p f-  FocusOnUnsafe l        (f :*: f') = FocusOnUnsafe l (If (HasField f l) f f')---- field location and access--type family-  GetFieldPosition (f :: field) (l :: label) :: Result FieldPosition where-  GetFieldPosition f l =-     If (HasField f l)-       ('Right (GetFieldPositionUnsafe f l))-       ('Left ('Text "Label not found. Cannot get bit range for '"-          ':<>: 'ShowType l-          ':<>: 'Text "' in:"-          ':$$: 'ShowType f ))--type family-  GetFieldPositionUnsafe (f :: field) (l :: label) :: FieldPosition where-  GetFieldPositionUnsafe (l :=> f)  l        = '(0, GetFieldSize f - 1)-  GetFieldPositionUnsafe (l :=> f)  (l :/ p) = GetFieldPositionUnsafe f p-  GetFieldPositionUnsafe (f :*: f') l        =-     If (HasField f l)-      (GetFieldPositionUnsafe f l)-      (AddToFieldPosition (GetFieldSize f) (GetFieldPositionUnsafe f' l))--type family-  AddToFieldPosition (v :: Nat) (e :: (Nat, Nat)) :: (Nat, Nat) where-  AddToFieldPosition v '(a,b) = '(a + v, b + v)--type family-  IsFieldPostition (pos :: FieldPosition) :: Constraint where-  IsFieldPostition '(a, b) =-    If (a <=? b)-       (a <= b, KnownNat a, KnownNat b)-       (TypeError-         ('Text "Bad field position: " ':<>: 'ShowType '(a,b)-          ':$$: 'Text "First index greater than last: "-          ':<>: 'ShowType a-          ':<>: 'Text " > "-          ':<>: 'ShowType b ))--type family-  FieldPostitionToList (pos :: FieldPosition) :: [Nat] where-    FieldPostitionToList '(a, a) = '[a]-    FieldPostitionToList '(a, b) = (a ': (FieldPostitionToList '(a+1, b)))--type family-  AlignField (a :: Nat) (f :: field) :: Result field where-  AlignField 0 f = 'Left ('Text "Invalid alignment of 0")-  AlignField a f = 'Right (AddPadding ((a - (GetFieldSize f `Rem` a)) `Rem` a) f)--type family-  AddPadding (n :: Nat) (f :: field) :: field where-  AddPadding 0 f = f-  AddPadding n f = f :*: Field n---- | Get the remainder of the integer division of x and y, such that @forall x--- y. exists k. (Rem x y) == x - y * k@ The algorithm is: count down x--- until zero, incrementing the accumulator at each step. Whenever the--- accumulator is equal to y set it to zero.------ If the accumulator has reached y reset it. It is important to do this--- BEFORE checking if x == y and then returning the accumulator, for the case--- where x = k * y with k > 0. For example:------ @---  6 `Rem` 3     = RemImpl 6 3 0---  RemImpl 6 3 0 = RemImpl (6-1) 3 (0+1)   -- RemImpl Clause 4---  RemImpl 5 3 1 = RemImpl (5-1) 3 (1+1)   -- RemImpl Clause 4---  RemImpl 4 3 2 = RemImpl (4-1) 3 (2+1)   -- RemImpl Clause 4---  RemImpl 3 3 3 = RemImpl 3 3 0           -- RemImpl Clause 2 !!!---  RemImpl 3 3 0 = 0                       -- RemImpl Clause 3 !!!--- @----type Rem (x :: Nat) (y :: Nat) = RemImpl x y 0-type family-  RemImpl (x :: Nat) (y :: nat) (acc :: Nat) :: Nat where-  -- finished if x was < y:-  RemImpl 0 y acc = acc-  RemImpl x y y   = RemImpl x y 0-  -- finished if x was >= y:-  RemImpl y y acc = acc-  -- the base case-  RemImpl x y acc = RemImpl (x - 1) y (acc + 1)--getFlag-  :: forall a (path :: k) (first :: Nat) field p1 p2-  . ( IsFieldC path field first first-    , Bits a )-   => p1 path -> p2 field -> a -> Bool-getFlag _ _ a = testBit a pos-    where pos = fromIntegral $ natVal (Proxy :: Proxy first)--setFlag-  :: forall a (path :: k) (first :: Nat) field p1 p2-  . ( IsFieldC path field first first-    , Bits a )-   => p1 path -> p2 field -> Bool -> a -> a-setFlag _ _ v a = modifyBit a pos-    where pos = fromIntegral $ natVal (Proxy :: Proxy first)-          modifyBit = if v then setBit else clearBit--getField-  :: forall a b (path :: k) (first :: Nat) (last :: Nat) field pxy1 pxy2-  . ( IsFieldC path field first last-    , Integral a-    , Bits a-    , Num b)-   => pxy1 path -> pxy2 field -> a -> b-getField _ _ a = fromIntegral ((a `shiftR` posFirst) .&. bitMask)-    where-      bitMask =-        let bitCount = 1 + posLast - posFirst-            in (2 ^ bitCount) - 1-      posFirst = fromIntegral $ natVal (Proxy :: Proxy first)-      posLast = fromIntegral $ natVal (Proxy :: Proxy last)--setField-  :: forall a b (path :: k) (first :: Nat) (last :: Nat) field pxy1 pxy2-  . ( IsFieldC path field first last-    , Num a-    , Bits a-    , Integral b)-   => pxy1 path -> pxy2 field -> b -> a -> a-setField _ _ v x = (x .&. bitMaskField) .|. (v' `shiftL` posFirst)-    where-      v' = bitMaskValue .&. fromIntegral v-      bitMaskField = complement (bitMaskValue `shiftL` posFirst)-      bitMaskValue =-        let bitCount = 1 + posLast - posFirst-            in (2 ^ bitCount) - 1-      posFirst = fromIntegral $ natVal (Proxy :: Proxy first)-      posLast = fromIntegral $ natVal (Proxy :: Proxy last)----type Foo =-       "foo" :=> Flag-   :*:           Field 4-   :*: "bar" :=> Field 2-   :*:           Field 4-   :*: "baz" :=> Field 17--type IsFieldC name field first last =-    ( name `HasFieldConstraint` field-     , KnownNat first-     , KnownNat last-     , 'Right '(first, last) ~ (GetFieldPosition field name)-     )--getFooField :: IsFieldC name Foo first last-   => proxy name -> Word64 -> Word64-getFooField px = getField px (Proxy :: Proxy Foo)

@@ -0,0 +1,304 @@+{-# LANGUAGE UndecidableInstances #-}+-- | Mini EDSL for labelled box fields. The boxfields can be 'Scalar' or+-- 'ScalarArray's.+module Data.ByteString.IsoBaseFileFormat.Util.BoxFields+       where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports+import Data.Singletons++import Data.Singletons.Prelude.List+import qualified Data.Vector as Vec+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.ByteString as B+++-- * Scalar box fields++type U64 label = Scalar Word64 label++type I64 label = Scalar Int64 label++u64 :: Word64 -> U64 label+u64 = Scalar++i64 :: Int64 -> I64 label+i64 = Scalar++type U32 label = Scalar Word32 label+type I32 label = Scalar Int32 label++u32 :: Word32 -> U32 label+u32 = Scalar++i32 :: Int32 -> I32 label+i32 = Scalar++type U16 label = Scalar Word16 label++type I16 label = Scalar Int16 label++u16 :: Word16 -> U16 label+u16 = Scalar++i16 :: Int16 -> I16 label+i16 = Scalar++type U8 label = Scalar Word8 label++type I8 label = Scalar Int8 label++u8 :: Word8 -> U8 label+u8 = Scalar++i8 :: Int8 -> I8 label+i8 = Scalar++-- | A numeric box field with a type level label. Note that it has a 'Num'+-- instance. Use the type aliases above, e.g.+-- 'U8','I8','U16','I16','U32','I32','U64','I64' from above. Use either the+-- smart constructors, e.g. 'u8','i8','u16','i16','u32','i32','u64','i64' or the+-- 'Num' instance, whereas the constructors might give a bit more safety.+newtype Scalar scalartype (label :: k) =+  Scalar {fromScalar :: scalartype}+  deriving (Show, Read, Ord, Eq, Num, Default)++-- | Relabel a scalar value, e.g. convert a @Scalar U32 "foo"@ to a @Scalar U32+-- "bar"@.+relabelScalar :: Scalar t l -> Scalar t l'+relabelScalar (Scalar !x) = Scalar x++instance IsBoxContent (Scalar Word8 label) where+  boxSize _ = 1+  boxBuilder (Scalar !v) = word8 v++instance IsBoxContent (Scalar Word16 label) where+  boxSize _ = 2+  boxBuilder (Scalar !v) = word16BE v++instance IsBoxContent (Scalar Word32 label) where+  boxSize _ = 4+  boxBuilder (Scalar !v) = word32BE v++instance IsBoxContent (Scalar Word64 label) where+  boxSize _ = 8+  boxBuilder (Scalar !v) = word64BE v++instance IsBoxContent (Scalar Int8 label) where+  boxSize _ = 1+  boxBuilder (Scalar !v) = int8 v++instance IsBoxContent (Scalar Int16 label) where+  boxSize _ = 2+  boxBuilder (Scalar !v) = int16BE v++instance IsBoxContent (Scalar Int32 label) where+  boxSize _ = 4+  boxBuilder (Scalar !v) = int32BE v++instance IsBoxContent (Scalar Int64 label) where+  boxSize _ = 8+  boxBuilder (Scalar !v) = int64BE v++instance (KnownNat scalar,Num o) => FromTypeLit (Scalar o label) scalar where+  fromTypeLit _ = Scalar $ fromIntegral $ natVal (Proxy :: Proxy scalar)++-- * Array fields++type U64Arr label size = ScalarArray label size Word64++u64Arr :: (KnownNat size,KnownSymbol label)+       => [Word64] -> U64Arr label size+u64Arr = fromList++type I64Arr label size = ScalarArray label size Int64++i64Arr :: (KnownNat size,KnownSymbol label)+       => [Int64] -> I64Arr label size+i64Arr = fromList++type U32Arr label size = ScalarArray label size Word32++u32Arr :: (KnownNat size,KnownSymbol label)+       => [Word32] -> U32Arr label size+u32Arr = fromList++type I32Arr label size = ScalarArray label size Int32++i32Arr :: (KnownNat size,KnownSymbol label)+       => [Int32] -> I32Arr label size+i32Arr = fromList++type U16Arr label size = ScalarArray label size Word16++u16Arr :: (KnownNat size,KnownSymbol label)+       => [Word16] -> U16Arr label size+u16Arr = fromList++type I16Arr label size = ScalarArray label size Int16++i16Arr :: (KnownNat size,KnownSymbol label)+       => [Int16] -> I16Arr label size+i16Arr = fromList++type U8Arr label size = ScalarArray label size Word8++u8Arr :: (KnownNat size,KnownSymbol label)+      => [Word8] -> U8Arr label size+u8Arr = fromList++type I8Arr label size = ScalarArray label size Int8++i8Arr :: (KnownNat size,KnownSymbol label)+      => [Int8] -> I8Arr label size+i8Arr = fromList++-- | A box field that is an array of 'Scalar's with a type level label. Use the+-- type aliases, e.g.+-- 'U8Arr','I8Arr','U16Arr','I16Arr','U32Arr','I32Arr','U64Arr','I64Arr' from+-- above. Use the smart constructors, e.g.+-- 'u8Arr','i8Arr','u16Arr','i16Arr','u32Arr','i32Arr','u64Arr','i64Arr' .+newtype ScalarArray (label :: k) (len :: Nat) o where+        ScalarArray :: Vec.Vector o -> ScalarArray label n o+        deriving (Show,Eq)++instance (Default o,KnownNat (len :: Nat))+  => Default (ScalarArray label len o) where+  def = ScalarArray $ Vec.replicate (fromIntegral (natVal (Proxy @len))) def++instance (Num o,IsBoxContent (Scalar o label))+  => IsBoxContent (ScalarArray label len o) where+  boxSize (ScalarArray !vec) =+    fromIntegral (Vec.length vec) * boxSize (Scalar 0 :: Scalar o label)+  boxBuilder (ScalarArray !vec) =+    Vec.foldl' mappend+               mempty+               (Vec.map (boxBuilder . mkScalar) vec)+    where mkScalar :: o -> Scalar o label+          !mkScalar = Scalar++-- | Internal function+fromList :: forall label n o.+            (KnownSymbol label,KnownNat n)+         => [o] -> ScalarArray label n o+fromList l =+  ScalarArray $+  if natVal (Proxy @n) /= toInteger (length l)+  then+    error $ printf "Invalid number of array elements for array %s. Got length: %d elments, expected %d."+             (show (symbolVal (Proxy :: Proxy label)))+             (length l)+             (natVal (Proxy :: Proxy n))+    else+      Vec.fromList l++-- * Constant fields++-- | Wrapper around a field, e.g. a 'Scalar' or 'ScalarArray', with a type level+-- value. The wrapped content must implement 'FromTypeLit'. To get the value of+-- a 'Constant'  use 'fromTypeLit'.+data Constant o v where+        Constant :: Constant o v++instance (IsBoxContent o,FromTypeLit o v) => IsBoxContent (Constant o v) where+  boxSize = boxSize . fromTypeLit+  boxBuilder = boxBuilder . fromTypeLit++instance Default (Constant o v) where+  def = Constant++-- * Template Fields++-- | Fields with default values that can be overriden with custom value. Like+-- 'Constant' this is a wrapper around a field, e.g. a 'Scalar' or+-- 'ScalarArray', with a type level default value. The wrapped content must+-- implement 'FromTypeLit'.+data Template o v where -- TODO replace with newtype and replace the 'Template'+                        -- case with the 'Default' instance.+        Template :: Template o v+        Custom :: !o -> Template o v++instance Default (Template o v) where+  def = Template++-- | Get a value from a 'Template'.+templateValue :: FromTypeLit o v => Template o v -> o+templateValue d@Template = fromTypeLit d+templateValue (Custom !v) = v++instance (IsBoxContent o,FromTypeLit o v) => IsBoxContent (Template o v) where+  boxSize = boxSize . templateValue+  boxBuilder = boxBuilder . templateValue++-- * Conversion from type-level numbers and lists to values++-- | Types that can be constructed from type level value representations.+class FromTypeLit o v  where+  fromTypeLit :: proxy o v -> o++instance forall arr o len (label :: Symbol) .+  (KnownSymbol label,SingI arr,Num o,SingKind [Nat],KnownNat len,len ~ Length arr)+  => FromTypeLit (ScalarArray label len o) (arr :: [Nat]) where+  fromTypeLit _ =+    let s = sing :: Sing arr+        vs :: [Integer]+        !vs = fromSing s+        vs' :: [o]+        !vs' = fromIntegral <$> vs+    in (fromList vs' :: ScalarArray label len o)++instance KnownSymbol str => FromTypeLit T.Text (str :: Symbol) where+  fromTypeLit = T.pack . symbolVal++-- * String/Text field types++-- | A fixed size string, the first byte is the string length, after the String,+-- the field is padded with @0@ bytes. The string must be in UTF8 format.+newtype FixSizeText (len :: Nat) (label :: Symbol) where+  FixSizeText :: T.Text -> FixSizeText len label++-- | A constraint that matches type level numbers that are valid text sizes for+--  'FixSizeText's.+type IsTextSize len = (KnownNat len, 1 <= len, len <= 255)++instance IsTextSize len => IsBoxContent (FixSizeText len label) where+  boxSize    _               = fromIntegral (natVal (Proxy :: Proxy len))+  boxBuilder (FixSizeText !t) =+    let+      -- leave room for the size byte+      !maxSize             = fromIntegral (natVal (Proxy :: Proxy len) - 1)+      !displayableText     = B.take maxSize (T.encodeUtf8 t)+      !displayableTextSize = B.length displayableText+      !paddingSize         = max 0 (maxSize - displayableTextSize)+      in word8 (fromIntegral displayableTextSize)+         <> byteString displayableText+         <> fold (replicate paddingSize (word8 0))++instance IsTextSize len => Default (FixSizeText len label) where+  def = FixSizeText ""++-- | Four character strings embedded in a uint32.+newtype U32Text (label :: Symbol) where+  U32Text :: Word32 -> U32Text label++instance IsString (U32Text label) where+  fromString !str = U32Text $+    let cw !s !c = (0xFF .&. fromIntegral (fromEnum c)) `shiftL` s+        in case str of+             []                           -> 0x20202020+             [!a]                         -> cw 24 a .|. 0x00202020+             [!a,!b]                      -> cw 24 a .|. cw 16 b  .|. 0x00002020+             [!a,!b,!c]                   -> cw 24 a .|. cw 16 b  .|. cw 8 c  .|. 0x20+             (!a : (!b) : (!c) : (!d) :_) -> cw 24 a .|. cw 16 b  .|. cw 8 c  .|. cw 0 d++instance IsBoxContent (U32Text label) where+  boxSize _ = 4+  boxBuilder (U32Text !t) = word32BE t++instance KnownSymbol str => FromTypeLit (U32Text label) (str :: Symbol) where+  fromTypeLit = fromString . symbolVal++instance Default (U32Text label) where+  def = U32Text 0x20202020

@@ -0,0 +1,93 @@+-- | Full Boxes+module Data.ByteString.IsoBaseFileFormat.Util.FullBox+       (FullBox(..), fullBox, BoxFlags(..))+       where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports++-- | A 'FullBox' contains an extra version and a flags field. In this+-- implementation it is wrapped around the rest of the box content. This+-- enforces that the 'FullBox' header fields are always at the beginning - at+-- least as long as this module hides the 'FullBox' constructor ;)+data FullBox t (version :: Nat) where+  FullBox :: (KnownNat version, IsBox t)+          => !(BoxFlags 24)+          -> !(BoxContent t)+          -> FullBox t version++instance (KnownNat version, IsBox t, Default (BoxContent t))+  => Default (FullBox t version) where+  def = FullBox 0 def++instance (KnownNat v, IsBox t) => IsBox (FullBox t v) where+  type BoxContent (FullBox t v) = FullBox t v++type instance BoxTypeSymbol (FullBox t v) = BoxTypeSymbol t++instance (IsBox t, KnownNat v) => IsBoxContent (FullBox t v) where+  boxSize (FullBox f c) = 1 + boxSize f + boxSize c+  boxBuilder (FullBox f c) =+       word8 (fromIntegral (natVal (Proxy :: Proxy v)))+    <> boxBuilder f+    <> boxBuilder c++-- | Create a 'FullBox' from a 'BoxVersion' and 'BoxFlags'+fullBox+  :: (KnownNat v, IsBox t)+  => BoxFlags 24 -> BoxContent t -> Box (FullBox t v)+fullBox f c = Box (FullBox f c)++-- | In addition to a version there can be 24 bits for custom flags etc in+-- a 'FullBox'.+newtype BoxFlags bits =+  BoxFlags Integer+  deriving (Eq,Show,Num)++-- | Internal function that creates a bit mask with all bits in a 'BoxFlags' set+-- to 1.+boxFlagBitMask :: KnownNat bits+               => BoxFlags bits -> Integer+boxFlagBitMask px = 2 ^ natVal px - 1++-- | Internal function that masks-out all bits higher than 'bits'.+cropBits :: KnownNat bits+         => BoxFlags bits -> BoxFlags bits+cropBits f@(BoxFlags b) = BoxFlags (b .&. boxFlagBitMask f)++-- | Get the number of bytes required to store a number of bits.+instance KnownNat bits => IsBoxContent (BoxFlags bits) where+  boxSize f =+    let minBytes = fromInteger $ natVal f `div` 8+        modBytes = fromInteger $ natVal f `mod` 8+    in BoxSize $ minBytes + signum modBytes+  boxBuilder f@(BoxFlags b) =+    let bytes =+          let (BoxSize bytes') = boxSize f+          in fromIntegral bytes'+        wordSeq n+          | n <= bytes =+            word8 (fromIntegral (shiftR b ((bytes - n) * 8) .&. 255)) <>+            wordSeq (n + 1)+          | otherwise = mempty+    in wordSeq 1++instance KnownNat bits => Bits (BoxFlags bits) where+  (.&.) (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ l .&. r+  (.|.) (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ l .&. r+  xor (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ xor l r+  complement (BoxFlags x) = cropBits $ BoxFlags $ complement x+  shift (BoxFlags x) = cropBits . BoxFlags . shift x+  rotateL = error "TODO rotateL"+  rotateR = error "TODO rotateR"+  bitSize = fromInteger . natVal+  bitSizeMaybe = Just . fromInteger . natVal+  isSigned _ = False+  testBit f n =+    let (BoxFlags b) = cropBits f+    in testBit b n+  bit = cropBits . BoxFlags . bit+  popCount f =+    let (BoxFlags b) = cropBits f+    in popCount b+  zeroBits = BoxFlags 0

@@ -0,0 +1,140 @@+-- | Time and timing utilities.+module Data.ByteString.IsoBaseFileFormat.Util.Time+       (referenceTime, utcToMp4, mp4CurrentTime, durationFromSeconds,+        oneSecond32, oneSecond64, diffTimeToTicks,ticksToDiffTime,+        TimeScale(..), Timing, TS(..), type TS32, type TS64, Ticks(..), Ticks32(..))+       where++import Data.Time.Clock+import Data.Time.Calendar+import Data.Ratio+import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.Util.BoxFields+import Data.ByteString.IsoBaseFileFormat.Util.Versioned+import Data.ByteString.IsoBaseFileFormat.ReExports+import Data.Typeable+import Foreign.Storable++-- * Absolute Dates+-- | According to the standard, fields with absolute dates and times are in+-- seconds since 1904/01/01 at midnight (UTC). This is this reference time.+referenceTime :: UTCTime+referenceTime =+  let startDay = fromGregorian 1904 1 1+      startTime = 0+  in UTCTime startDay startTime++-- | Convert a 'UTCTime' to a number of seconds since 'referenceTime'.+utcToMp4 :: Num t+         => UTCTime -> t+utcToMp4 u =+  let picoSecondsDiff = toRational $ diffUTCTime u referenceTime+      picoSecondsDiffNumerator = numerator picoSecondsDiff+      picoSecondsDiffDenominator = denominator picoSecondsDiff+      secondsSinceReferenceTime =+        div picoSecondsDiffNumerator picoSecondsDiffDenominator+  in fromIntegral secondsSinceReferenceTime+++-- | Convert a 'NominalDiffTime' to the number of 'Ticks' with respect+-- to a given 'TimeScale'.+diffTimeToTicks :: Integral t+                => NominalDiffTime -> TimeScale -> t+diffTimeToTicks !diff (TimeScale !scale) =+  round (diff * (fromIntegral scale))++-- | Convert a 'NominalDiffTime' to the number of 'Ticks' with respect+-- to a given 'TimeScale'.+ticksToDiffTime :: Integral t+                => t -> TimeScale -> NominalDiffTime+ticksToDiffTime !t (TimeScale !scale) =+  fromRational (toInteger t % toInteger scale)+++-- | Get the current time as number of seconds since 'referenceTime'+mp4CurrentTime :: Num t+               => IO t+mp4CurrentTime = utcToMp4 <$> getCurrentTime++-- * Time-Scale and Durations+-- | Default time-scale value+--   Based on history and tradition this value is @90000@.+--   MPEG-2 TS defines a single clock for each program, running at 27MHz. The+--   timescale of MPEG-2 TS Hint Tracks should be divisable by 90000.+newtype TimeScale = TimeScale {fromTimeScale :: Word32}+  deriving (Show,Eq,Num,Bounded,Ord,Bits,Integral,Typeable,Storable,Enum,Real)++instance Default TimeScale where+  def = TimeScale 90000++instance IsBoxContent TimeScale where+  boxSize = boxSize . fromTimeScale+  boxBuilder = boxBuilder . fromTimeScale++-- | Utility function to convert seconds (Integers) to any 'Num' using a+-- 'TimeScale', Since 'Scalar' has a 'Num' instance this can be used to generate+-- @duration@ fields.+durationFromSeconds :: Num t+                    => TimeScale -> Integer -> t+durationFromSeconds timeScale seconds =+  let timeScaleI = fromIntegral timeScale+  in timeScaleI * fromInteger seconds++-- | Utility function to generate the equivalent of one second (@1 s@)+oneSecond32 = Scalar . flip durationFromSeconds 1+oneSecond32 :: TimeScale -> TS32 label++-- | Utility function to generate the equivalent of one second (@1 s@)+oneSecond64 :: TimeScale -> TS64 label+oneSecond64 = Scalar . flip durationFromSeconds 1++-- | A type that denotes a time relative to a 'TimeScale' which is included in+-- its type. 'Ticks' is the number of time units passed, where each time unit+-- has a physical duration of @timescale * 1/s@ i.e. @timescale@ 'Ticks' last+-- about @1 s@.+-- TODO use this instead of raw Word32s+newtype Ticks (timeScale :: Nat) = MkTicks {fromTicks :: Word64}+  deriving (Show,Eq,Num,Bounded,Ord,Bits,Integral,Typeable,Storable,Enum,Real)++instance IsBoxContent (Ticks n) where+  boxSize = boxSize . fromTicks+  boxBuilder = boxBuilder . fromTicks++newtype Ticks32 (timeScale :: Nat) = MkTicks32 {fromTicks32 :: Word32}+  deriving (Show,Eq,Num,Bounded,Ord,Bits,Integral,Typeable,Storable,Enum,Real)++instance IsBoxContent (Ticks32 n) where+  boxSize = boxSize . fromTicks32+  boxBuilder = boxBuilder . fromTicks32++-- | Time and timing information about a movie.+--+-- The creation/modification times are in seconds since midnight, Jan. 1, 1904,+-- in UTC time. Time scale declares the time coordinate system, it specifies the+-- number of time units that pass one second. The time coordinate system is used+-- by e.g. the duration field, which by the way contains the duration of the+-- longest track, if known, or simply the equivalent of 1s.+type Timing (version :: Nat) = Versioned TimingV0 TimingV1 version++type TS32 = Scalar Word32+type TS64 = Scalar Word64++data TS (version :: Nat) (label :: Symbol) where+  TSv0 :: !Word32 -> TS 0 label+  TSv1 :: !Word64 -> TS 1 label++instance IsBoxContent (TS v n) where+  boxSize (TSv0 _t) = 4+  boxSize (TSv1 _t) = 8+  boxBuilder (TSv0 !t) = word32BE t+  boxBuilder (TSv1 !t) = word64BE t++type TimingV0 = TimingImpl (Scalar Word32) (TS 0 "duration")++type TimingV1 = TimingImpl (Scalar Word64) (TS 1 "duration")++type TimingImpl uint dur =+     uint "creation_time"+  :+ uint "modification_time"+  :+ TimeScale+  :+ dur

@@ -0,0 +1,25 @@+{-# LANGUAGE UndecidableInstances #-}+-- | A binary version 0/1 field with seperate content for each version.+module Data.ByteString.IsoBaseFileFormat.Util.Versioned+       (Versioned(..))+       where++import Data.ByteString.IsoBaseFileFormat.Box+import Data.ByteString.IsoBaseFileFormat.ReExports++-- TODO rewrite/cleanup the versioned mess++-- | Two alternative representations based on a /version/ index.+--   Use this for box content that can be either 32 or 64 bit.+data Versioned v0 v1 (version :: Nat) where+        V0 :: IsBoxContent v0 => !v0 -> Versioned v0 v1 0+        V1 :: IsBoxContent v1 => !v1 -> Versioned v0 v1 1++instance (version ~ 0,IsBoxContent v0,Default v0) => Default (Versioned v0 v1 (version :: Nat)) where+  def = V0 def++instance IsBoxContent (Versioned v0 v1 version) where+  boxSize (V0 c) = boxSize c+  boxSize (V1 c) = boxSize c+  boxBuilder (V0 c) = boxBuilder c+  boxBuilder (V1 c) = boxBuilder c

@@ -0,0 +1,292 @@+-- | A single-track AAC audio streaming utility wrapping 'AudioFile' for+-- streaming via e.g. DASH.+module Data.ByteString.Mp4.AudioStreaming+  (   Segment(..)+    , InitSegment(..)+    , StreamingContext, AacMp4StreamConfig(..)+    , AacMp4TrackFragment(..)+    , numberOfChannels+    , buildAacMp4TrackFragment+    , buildAacMp4StreamInit+    , getStreamConfig, getStreamBaseTime, getStreamSequence+    , addToBaseTime, getSegmentDuration+    , streamInitINTERNAL_TESTING, streamInitUtc, streamNextSample, streamFlush+    , module X)++where++import Data.Time.Clock+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import           Data.ByteString.IsoBaseFileFormat.Box+import           Data.ByteString.IsoBaseFileFormat.Boxes+import           Data.ByteString.IsoBaseFileFormat.Brands.Dash    as X+import           Data.ByteString.IsoBaseFileFormat.MediaFile      as X+import           Data.ByteString.IsoBaseFileFormat.ReExports      as X+import           Data.ByteString.IsoBaseFileFormat.Util.BoxFields as X+import           Data.ByteString.IsoBaseFileFormat.Util.Time      as X+import           Data.ByteString.IsoBaseFileFormat.Util.Versioned+import           Data.ByteString.Mp4.Boxes.AudioSpecificConfig    as X+import           Data.ByteString.Mp4.Boxes.Mp4AudioSampleEntry    as X+import qualified Data.Text                                        as T+import qualified Data.Text.Encoding                               as TE++-- | Contains a sample in the ISO14496 style interpretation, i.e.+-- a smallish buffer of e.g. 20ms audio data or a single video frame.+-- A sample has some kind of time or at least order associated to it.+-- TODO not right now, add it+--+-- Also a sample has a duration measured as the sampleCount. TODO make this a+-- real data type, and possible refactor this to be a seperate issue from+-- filling stream gaps and determining the offsets and the decoding time stamp.++-- | Contains the configuration and state for the creation of a DASH audio+-- stream.+data StreamingContext =+  StreamingContext { acConfig          :: !AacMp4StreamConfig+                   , acSegmentDuration :: !Word64 -- (in ticks)+                   , acSequence        :: !Word32+                   , acBaseTime        :: !Word64+                   , acSegments        :: ![(Word32, BS.ByteString)]+                   }++-- | Initialisation segment parameters of an aac audio stream mp4 file.+data AacMp4StreamConfig =+  AacMp4StreamConfig { creationTime  :: !(TS32 "creation_time")+                     , trackName     :: !String+                     , useHeAac      :: !Bool+                     , sampleRate    :: !SamplingFreqTable+                     , channelConfig :: !ChannelConfigTable}++data Segment =+  Segment+  { segmentSequence :: !Word32+  , segmentTime     :: !Word64+  , segmentData     :: !BS.ByteString+  }++newtype InitSegment =+  InitSegment+  { fromInitSegment :: BS.ByteString }++-- | Media fragment segment parameters of an aac audio stream mp4 file.+data AacMp4TrackFragment =+  AacMp4TrackFragment { fragmentSampleSequence      :: !Word32+                      , fragmentBaseMediaDecodeTime :: !Word64+                      , fragmentSamples             :: ![(Word32, BS.ByteString)]+                      }++numberOfChannels :: Num a => StreamingContext -> a+numberOfChannels = channelConfigToNumber . channelConfig . acConfig++addToBaseTime :: StreamingContext -> NominalDiffTime -> StreamingContext+addToBaseTime !sc !dt =+  sc { acSequence = newSequence+     , acBaseTime = diffTimeToTicks newBaseTime timeScale}+  where+    !timeScale = getAacMp4StreamConfigTimeScale (acConfig sc)+    !newSequence = round (newBaseTime / segmentDuration)+      where+        !segmentDuration = ticksToDiffTime (acSegmentDuration sc) timeScale+    !newBaseTime = dt + baseTime+      where+        !baseTime = ticksToDiffTime (acBaseTime sc) timeScale+++-- | Return the 'AacMp4StreamConfig' from an 'StreamingContext'+getStreamConfig :: StreamingContext -> AacMp4StreamConfig+getStreamConfig StreamingContext{..} = acConfig++-- | Return the current base decoding time+getStreamBaseTime :: StreamingContext -> Word64+getStreamBaseTime StreamingContext{..} = acBaseTime++-- | Return the current sequence number+getStreamSequence :: StreamingContext -> Word32+getStreamSequence StreamingContext{..} = acSequence++instance Show Segment where+  show (Segment !s !t !d) =+    printf "SEGMENT - seq: %14d - time: %14d - size: %14d" s t (BS.length d)+++getSegmentDuration :: StreamingContext -> NominalDiffTime+getSegmentDuration !sc = segmentDuration+  where+    !segmentDuration = ticksToDiffTime (acSegmentDuration sc) timeScale+    !timeScale = getAacMp4StreamConfigTimeScale (acConfig sc)++sampleCountDuration :: AacMp4StreamConfig -> Word32 -> Word64+sampleCountDuration (AacMp4StreamConfig _ _ _ _ _c) r =+  fromIntegral r -- `div` channelConfigToNumber c TODO clean this whole mess up and remove all Word32/Word64++getAacMp4StreamConfigTimeScale :: AacMp4StreamConfig -> TimeScale+getAacMp4StreamConfigTimeScale AacMp4StreamConfig{..} =+  TimeScale (sampleRateToNumber sampleRate)++-- | Initiate the 'StreamingContext' and create the /MP4 init segment/.+-- This lives in 'IO' because it read the current time from the real world.+streamInitINTERNAL_TESTING+  :: String+  -> NominalDiffTime+  -> Bool+  -> SamplingFreqTable+  -> ChannelConfigTable+  -> IO (InitSegment, StreamingContext)+streamInitINTERNAL_TESTING !trackTitle !segmentDuration !sbr !rate !channels = do+  t <- mp4CurrentTime+  let !cfg = AacMp4StreamConfig t trackTitle sbr rate channels+      !dur = diffTimeToTicks segmentDuration timeScale+      !timeScale = getAacMp4StreamConfigTimeScale cfg+  return (InitSegment+          (BL.toStrict (toLazyByteString (buildAacMp4StreamInit cfg)))+         , StreamingContext cfg dur 0 0 [])++instance Show InitSegment where+  show (InitSegment !d) =+    printf "INIT SEGMENT - size: %14d" (BS.length d)++-- | Initiate the 'StreamingContext' and create the /MP4 init segment/.+-- This lives in 'IO' because it read the current time from the real world.+streamInitUtc -- TODO remove 'streamInit' in favor of this ??+  :: String+  -> UTCTime+  -> UTCTime+  -> NominalDiffTime+  -> Bool+  -> SamplingFreqTable+  -> ChannelConfigTable+  -> (InitSegment, StreamingContext)+streamInitUtc !trackTitle !availabilityStartTime !refTime !segmentDuration !sbr !rate !channels =+  let !cfg = AacMp4StreamConfig t0 trackTitle sbr rate channels+      !t0  = utcToMp4 availabilityStartTime+      !secondsSinceRef = diffUTCTime availabilityStartTime refTime+      !dur = diffTimeToTicks segmentDuration timeScale+      !timeScale = getAacMp4StreamConfigTimeScale cfg+  in (InitSegment+      (BL.toStrict (toLazyByteString (buildAacMp4StreamInit cfg)))+     , addToBaseTime (StreamingContext cfg dur 0 0 []) secondsSinceRef)++-- | Enqueue a sample, if enough samples are accumulated, generate the next segment+streamNextSample+  :: Word32+  -> BS.ByteString+  -> StreamingContext+  -> (Maybe Segment, StreamingContext)+streamNextSample !sampleCount !sample !ctx@StreamingContext{..} =+  let !segments       = (sampleCount, sample) : acSegments+      !currentEndTime = sampleCountDuration acConfig (sum (fst <$> segments)) + acBaseTime+      !nextBaseTime   = (fromIntegral acSequence + 1) * acSegmentDuration64+      !acSegmentDuration64 = fromIntegral acSegmentDuration+  in+    if currentEndTime >= nextBaseTime then+      let !ctx' =+            ctx { acSequence = fromIntegral (currentEndTime `div` acSegmentDuration64)+                , acBaseTime = currentEndTime+                , acSegments = []+                }+          -- Output to write into fragment:+          !tf = buildAacMp4TrackFragment $+                AacMp4TrackFragment acSequence acBaseTime (reverse segments)++      in (Just (Segment acSequence acBaseTime (BL.toStrict (toLazyByteString tf))), ctx')+    else+      (Nothing, ctx{ acSegments = segments })++-- | Enqueue a sample, if enough samples are accumulated, generate the next segment+streamFlush+  ::  StreamingContext+  -> (Maybe Segment, StreamingContext)+streamFlush !ctx@StreamingContext{..} =+  let currentEndTime =+        sampleCountDuration acConfig (sum (fst <$> acSegments)) + acBaseTime+  in+    if not (null acSegments) then+      let !tf = buildAacMp4TrackFragment $+                AacMp4TrackFragment acSequence acBaseTime (reverse acSegments)+          !ctx' = ctx { acSequence = fromIntegral+                        (currentEndTime `div` fromIntegral acSegmentDuration)+                      , acBaseTime = currentEndTime+                      , acSegments = []}+      in (Just (Segment acSequence acBaseTime (BL.toStrict (toLazyByteString tf))), ctx')+    else (Nothing, ctx)++-- | Convert a 'AacMp4StreamConfig' record to a generic 'Boxes' collection.+buildAacMp4StreamInit+  :: AacMp4StreamConfig -> Builder+buildAacMp4StreamInit AacMp4StreamConfig{..} =+  let+    timeScaleForSampleRate = TimeScale (sampleRateToNumber sampleRate)+  in+    mediaBuilder dash $+    -- TODO must be iso5 for the way we use elementary stream descriptors+    fileTypeBox (FileType "iso5" 0 ["isom","iso5","dash","mp42"])+    :. skipBox (Skip (TE.encodeUtf8 (T.pack "Lindenbaum GmbH isobmff-builder, Sven Heyll 2016")))+    :| movie+        ( movieHeader+          (MovieHeader $+           V0 (creationTime+                :+ relabelScalar creationTime+                :+ def+                :+ TSv0 0)+            :+ def :+ def :+def :+ def :+ def :+ def :+ Custom (Scalar 2))+          :. track+            (trackHeader+              TrackInMovieAndPreview+              (TrackHeader $+                V0 (creationTime+                    :+ relabelScalar creationTime+                    :+ 1+                    :+ Constant+                    :+ 0) :++                def)+              :| media+              (mediaHeader (MediaHeader $+                             V0 (creationTime+                                  :+ relabelScalar creationTime+                                  :+ timeScaleForSampleRate+                                  :+ TSv0 0)+                             :+ def)+                :. handler (namedAudioTrackHandler (T.pack trackName))+                :| mediaInformation+                ( soundMediaHeader (SoundMediaHeader def)+                  :. (dataInformation $: localMediaDataReference)+                  :| sampleTable+                  ((sampleDescription+                     $: audioSampleEntry 1 (aacAudioSampleEntrySimple+                                            useHeAac+                                            sampleRate+                                            channelConfig+                                            (Scalar 16))+                     :. timeToSample []+                     :. sampleToChunk []+                     :. fixedSampleSize 0 0+                     :| chunkOffset32 [])))))+            :| (movieExtends $: trackExtendsUnknownDuration 1 1))++-- | Convert a 'AacMp4TrackFragment record to a generic 'Boxes' collection.+buildAacMp4TrackFragment+  :: AacMp4TrackFragment -> Builder+buildAacMp4TrackFragment AacMp4TrackFragment{..} =+    mediaBuilder dash+      (  styp+      :. movieFragment+           (  mfhd+           :| trackFragment+                (  tfhd+                :. tfdt+                :| trun))+      :| mdat)+  where+    !styp = segmentTypeBox               (SegmentType "msdh" 0 ["msdh","dash"])+    !mfhd = movieFragmentHeader          (MovieFragmentHeader (Scalar fragmentSampleSequence))+    !tfhd = trackFragmentHeader          def+    !tfdt = trackFragBaseMediaDecodeTime (TSv1 fragmentBaseMediaDecodeTime)+    !trun = trackRunIso5                 mdatOffset fragmentSamples+      where+        !mdatOffset = movieFragmentStaticSize+                     + movieFragmentHeaderStaticSize+                     + trackFragmentStaticSize+                     + trackFragmentHeaderStaticSize+                     + trackFragBaseMediaDecodeTimeStaticSize64+    !mdat = mediaData (MediaData (BS.concat (snd <$> fragmentSamples)))

@@ -0,0 +1,310 @@+{-# LANGUAGE UndecidableInstances #-}+-- | @mp4a@ Audio sample entry according to ISO 14496-14+module Data.ByteString.Mp4.Boxes.AudioSpecificConfig where++import           Data.ByteString.IsoBaseFileFormat.ReExports+import           Data.ByteString.Mp4.Boxes.DecoderSpecificInfo++-- * Decoder Configuration for ISO 14496-3 (Audio)++-- | A audio config using 'AudioConfigAacMinimal' for AAC-LC.+type AudioConfigAacLc freq channels =+  AudioConfigAacMinimal 'AacLc DefaultGASpecificConfig freq channels++-- | A audio config using 'AudioConfigSbrExplicitHierachical' for HE-AAC (v1) in+-- dual rate mode.+type AudioConfigHeAac freq channels =+  AudioConfigSbrExplicitHierachical+  'AacLc DefaultGASpecificConfig freq channels freq++-- | A minimalistic audio config without sync and error protection+data AudioConfigAacMinimal+  :: AudioObjectTypeId+  -> IsAn AudioSubConfig+  -> IsAn (EnumOf SamplingFreqTable)+  -> IsAn (EnumOf ChannelConfigTable)+  -> IsA (DecoderSpecificInfo 'AudioIso14496_3 'AudioStream)++type instance+  Eval (AudioConfigAacMinimal+        aoId+        subCfg+        freq+        channels) =+   ('MkDecoderSpecificInfo+    (AudioConfigCommon aoId freq channels (BitRecordOfAudioSubConfig subCfg)))++-- | A audio config with SBR signalled explicit and hierachical+data AudioConfigSbrExplicitHierachical+  :: AudioObjectTypeId+  -> IsAn AudioSubConfig+  -> IsAn (EnumOf SamplingFreqTable)+  -> IsAn (EnumOf ChannelConfigTable)+  -> IsAn (EnumOf SamplingFreqTable) -- extension SamplingFrequency+  -> IsA (DecoderSpecificInfo 'AudioIso14496_3 'AudioStream)++type instance+  Eval (AudioConfigSbrExplicitHierachical+        aoId+        subCfg+        freq+        channels+        extFreq+       ) =+   ('MkDecoderSpecificInfo+    (AudioConfigCommon 'Sbr freq channels+     ("SBR audio object type" <:> PutHex8 (FromEnum AudioObjectTypeId aoId)+      #+: BitRecordOfEnum extFreq+      :+: AudioObjectTypeRec aoId+      :+: BitRecordOfAudioSubConfig subCfg)))++-- | Common header for audio specific config+type AudioConfigCommon aoId samplingFrequencyIndex channels rest =+  ("audio-specific-config" <:> PutHex8 (FromEnum AudioObjectTypeId aoId))+  #+$ (AudioObjectTypeRec aoId+       :+: BitRecordOfEnum samplingFrequencyIndex+       :+: BitRecordOfEnum channels+       :+: rest)++-- ** Audio Object Type++data AudioObjectTypeId =+    AacMain                        -- ^ ISO 14496-4 subpart 4+  | AacLc                          -- ^ ISO 14496-4 subpart 4+  | AacSsr                         -- ^ ISO 14496-4 subpart 4+  | AacLtp                         -- ^ ISO 14496-4 subpart 4+  | Sbr                            -- ^ ISO 14496-4 subpart 4+  | AacScalable                    -- ^ ISO 14496-4 subpart 4+  | TwinVq                         -- ^ ISO 14496-4 subpart 4+  | Celp                           -- ^ ISO 14496-4 subpart 3+  | Hvxc                           -- ^ ISO 14496-4 subpart 2+  | AoReserved1+  | AoReserved2+  | Ttsi                           -- ^ ISO 14496-4 subpart 6+  | MainSunthetic                  -- ^ ISO 14496-4 subpart 5+  | WavetableSynthesis             -- ^ ISO 14496-4 subpart 5+  | GeneralMidi                    -- ^ ISO 14496-4 subpart 5+  | AlgorithmicSynthesisAndAudioFx -- ^ ISO 14496-4 subpart 5+  | ErAacLc                        -- ^ ISO 14496-4 subpart 4+  | AoReserved3+  | ErAacLtp                       -- ^ ISO 14496-4 subpart 4+  | ErAacScalable                  -- ^ ISO 14496-4 subpart 4+  | ErTwinVq                       -- ^ ISO 14496-4 subpart 4+  | ErBsac                         -- ^ ISO 14496-4 subpart 4+  | ErAacLd                        -- ^ ISO 14496-4 subpart 4+  | ErCelp                         -- ^ ISO 14496-4 subpart 3+  | ErHvxc                         -- ^ ISO 14496-4 subpart 2+  | ErHiln                         -- ^ ISO 14496-4 subpart 7+  | ErParametric                   -- ^ ISO 14496-4 subpart 2 or 7+  | Ssc                            -- ^ ISO 14496-4 subpart 8+  | AoReserved4+  | AoReserved5+  | AoCustom+  | AoLayer1                       -- ^ ISO 14496-4 subpart 9+  | AoLayer2                       -- ^ ISO 14496-4 subpart 9+  | AoLayer3                       -- ^ ISO 14496-4 subpart 9+  | AoDst                          -- ^ ISO 14496-4 subpart 10+  | AotInvalid++type instance FromEnum AudioObjectTypeId 'AotInvalid                     = 0+type instance FromEnum AudioObjectTypeId 'AacMain                        = 1+type instance FromEnum AudioObjectTypeId 'AacLc                          = 2+type instance FromEnum AudioObjectTypeId 'AacSsr                         = 3+type instance FromEnum AudioObjectTypeId 'AacLtp                         = 4+type instance FromEnum AudioObjectTypeId 'Sbr                            = 5+type instance FromEnum AudioObjectTypeId 'AacScalable                    = 6+type instance FromEnum AudioObjectTypeId 'TwinVq                         = 7+type instance FromEnum AudioObjectTypeId 'Celp                           = 8+type instance FromEnum AudioObjectTypeId 'Hvxc                           = 9+type instance FromEnum AudioObjectTypeId 'AoReserved1                    = 10+type instance FromEnum AudioObjectTypeId 'AoReserved2                    = 11+type instance FromEnum AudioObjectTypeId 'Ttsi                           = 12+type instance FromEnum AudioObjectTypeId 'MainSunthetic                  = 13+type instance FromEnum AudioObjectTypeId 'WavetableSynthesis             = 14+type instance FromEnum AudioObjectTypeId 'GeneralMidi                    = 15+type instance FromEnum AudioObjectTypeId 'AlgorithmicSynthesisAndAudioFx = 16+type instance FromEnum AudioObjectTypeId 'ErAacLc                        = 17+type instance FromEnum AudioObjectTypeId 'AoReserved3                    = 18+type instance FromEnum AudioObjectTypeId 'ErAacLtp                       = 19+type instance FromEnum AudioObjectTypeId 'ErAacScalable                  = 20+type instance FromEnum AudioObjectTypeId 'ErTwinVq                       = 21+type instance FromEnum AudioObjectTypeId 'ErBsac                         = 22+type instance FromEnum AudioObjectTypeId 'ErAacLd                        = 23+type instance FromEnum AudioObjectTypeId 'ErCelp                         = 24+type instance FromEnum AudioObjectTypeId 'ErHvxc                         = 25+type instance FromEnum AudioObjectTypeId 'ErHiln                         = 26+type instance FromEnum AudioObjectTypeId 'ErParametric                   = 27+type instance FromEnum AudioObjectTypeId 'Ssc                            = 28+type instance FromEnum AudioObjectTypeId 'AoReserved4                    = 29+type instance FromEnum AudioObjectTypeId 'AoReserved5                    = 30+type instance FromEnum AudioObjectTypeId 'AoCustom                       = 31+type instance FromEnum AudioObjectTypeId 'AoLayer1                       = 32+type instance FromEnum AudioObjectTypeId 'AoLayer2                       = 33+type instance FromEnum AudioObjectTypeId 'AoLayer3                       = 34+type instance FromEnum AudioObjectTypeId 'AoDst                          = 35++type AudioObjectTypeRec n =+    (If ((FromEnum AudioObjectTypeId n) <=? 30)+            "AudioObjectType"+            "ExtAudioObjectType") <:> PutHex8 (FromEnum AudioObjectTypeId n)+    #+$ AudioObjectTypeField1 (FromEnum AudioObjectTypeId n)+    .+: AudioObjectTypeField2 (FromEnum AudioObjectTypeId n)++type family AudioObjectTypeField1 (n :: Nat)+  :: IsA (BitRecordField ('MkFieldBits :: BitField (B 5) Nat 5)) where+  AudioObjectTypeField1 n =+    If (n <=? 30) (Field 5 := n) (Field 5 := 31)++type family AudioObjectTypeField2 (n :: Nat) :: BitRecord where+  AudioObjectTypeField2 n =+    If (n <=? 30) 'EmptyBitRecord ('BitRecordMember (Field 6 := (n - 31)))++-- *** Sampling Frequency++type SamplingFreq = ExtEnum SamplingFreqTable 4 'SFCustom (Field 24)++data SamplingFreqTable =+      SF96000+    | SF88200+    | SF64000+    | SF48000+    | SF44100+    | SF32000+    | SF24000+    | SF22050+    | SF16000+    | SF12000+    | SF11025+    | SF8000+    | SF7350+    | SFReserved1+    | SFReserved2+    | SFCustom++type instance FromEnum SamplingFreqTable 'SF96000 = 0+type instance FromEnum SamplingFreqTable 'SF88200 = 1+type instance FromEnum SamplingFreqTable 'SF64000 = 2+type instance FromEnum SamplingFreqTable 'SF48000 = 3+type instance FromEnum SamplingFreqTable 'SF44100 = 4+type instance FromEnum SamplingFreqTable 'SF32000 = 5+type instance FromEnum SamplingFreqTable 'SF24000 = 6+type instance FromEnum SamplingFreqTable 'SF22050 = 7+type instance FromEnum SamplingFreqTable 'SF16000 = 8+type instance FromEnum SamplingFreqTable 'SF12000 = 9+type instance FromEnum SamplingFreqTable 'SF11025 = 0xa+type instance FromEnum SamplingFreqTable 'SF8000  = 0xb+type instance FromEnum SamplingFreqTable 'SF7350  = 0xc+type instance FromEnum SamplingFreqTable 'SFReserved1 = 0xd+type instance FromEnum SamplingFreqTable 'SFReserved2 = 0xe+type instance FromEnum SamplingFreqTable 'SFCustom  = 0xf++sampleRateToNumber :: Num a => SamplingFreqTable -> a+sampleRateToNumber SF96000 = 96000+sampleRateToNumber SF88200 = 88200+sampleRateToNumber SF64000 = 64000+sampleRateToNumber SF48000 = 48000+sampleRateToNumber SF44100 = 44100+sampleRateToNumber SF32000 = 32000+sampleRateToNumber SF24000 = 24000+sampleRateToNumber SF22050 = 22050+sampleRateToNumber SF16000 = 16000+sampleRateToNumber SF12000 = 12000+sampleRateToNumber SF11025 = 11025+sampleRateToNumber SF8000  =  8000+sampleRateToNumber SF7350  =  7350+sampleRateToNumber _  =  0++sampleRateToEnum :: SamplingFreqTable -> EnumValue SamplingFreqTable+sampleRateToEnum SF96000     = MkEnumValue (Proxy @'SF96000)+sampleRateToEnum SF88200     = MkEnumValue (Proxy @'SF88200)+sampleRateToEnum SF64000     = MkEnumValue (Proxy @'SF64000)+sampleRateToEnum SF48000     = MkEnumValue (Proxy @'SF48000)+sampleRateToEnum SF44100     = MkEnumValue (Proxy @'SF44100)+sampleRateToEnum SF32000     = MkEnumValue (Proxy @'SF32000)+sampleRateToEnum SF24000     = MkEnumValue (Proxy @'SF24000)+sampleRateToEnum SF22050     = MkEnumValue (Proxy @'SF22050)+sampleRateToEnum SF16000     = MkEnumValue (Proxy @'SF16000)+sampleRateToEnum SF12000     = MkEnumValue (Proxy @'SF12000)+sampleRateToEnum SF11025     = MkEnumValue (Proxy @'SF11025)+sampleRateToEnum SF8000      = MkEnumValue (Proxy @'SF8000)+sampleRateToEnum SF7350      = MkEnumValue (Proxy @'SF7350)+sampleRateToEnum SFReserved1 = MkEnumValue (Proxy @'SFReserved1)+sampleRateToEnum SFReserved2 = MkEnumValue (Proxy @'SFReserved2)+sampleRateToEnum SFCustom    = MkEnumValue (Proxy @'SFCustom)++-- *** Channel Config (Mono, Stereo, 7-1 Surround, ...)++type ChannelConfig = FixedEnum ChannelConfigTable 4++data ChannelConfigTable =+    GasChannelConfig+  | SingleChannel+  | ChannelPair+  | SinglePair+  | SinglePairSingle+  | SinglePairPair+  | SinglePairPairLfe+  | SinglePairPairPairLfe++type instance FromEnum ChannelConfigTable 'GasChannelConfig      = 0+type instance FromEnum ChannelConfigTable 'SingleChannel         = 1+type instance FromEnum ChannelConfigTable 'ChannelPair           = 2+type instance FromEnum ChannelConfigTable 'SinglePair            = 3+type instance FromEnum ChannelConfigTable 'SinglePairSingle      = 4+type instance FromEnum ChannelConfigTable 'SinglePairPair        = 5+type instance FromEnum ChannelConfigTable 'SinglePairPairLfe     = 6+type instance FromEnum ChannelConfigTable 'SinglePairPairPairLfe = 7++channelConfigToNumber :: Num a => ChannelConfigTable -> a+channelConfigToNumber GasChannelConfig      = 0+channelConfigToNumber SingleChannel         = 1+channelConfigToNumber ChannelPair           = 2+channelConfigToNumber SinglePair            = 3+channelConfigToNumber SinglePairSingle      = 4+channelConfigToNumber SinglePairPair        = 5+channelConfigToNumber SinglePairPairLfe     = 6+channelConfigToNumber SinglePairPairPairLfe = 7++channelConfigToEnum :: ChannelConfigTable -> EnumValue ChannelConfigTable+channelConfigToEnum GasChannelConfig      = MkEnumValue (Proxy @'GasChannelConfig)+channelConfigToEnum SingleChannel         = MkEnumValue (Proxy @'SingleChannel)+channelConfigToEnum ChannelPair           = MkEnumValue (Proxy @'ChannelPair)+channelConfigToEnum SinglePair            = MkEnumValue (Proxy @'SinglePair)+channelConfigToEnum SinglePairSingle      = MkEnumValue (Proxy @'SinglePairSingle)+channelConfigToEnum SinglePairPair        = MkEnumValue (Proxy @'SinglePairPair)+channelConfigToEnum SinglePairPairLfe     = MkEnumValue (Proxy @'SinglePairPairLfe)+channelConfigToEnum SinglePairPairPairLfe = MkEnumValue (Proxy @'SinglePairPairPairLfe)++-- ** More Specific audio decoder config++data AudioSubConfig :: Type++type family BitRecordOfAudioSubConfig (x :: IsA AudioSubConfig) :: BitRecord++data GASpecificConfig+  (frameLenFlag   :: IsA (FieldValue "frameLenFlag" Bool))+  (coreCoderDelay :: Maybe (IsA (FieldValue "coreCoderDelay" Nat)))+  (extension      :: IsA GASExtension)+  :: IsA AudioSubConfig++type DefaultGASpecificConfig =+  GASpecificConfig (StaticFieldValue "frameLenFlag" 'False) 'Nothing MkGASExtension++type instance Eval (GASpecificConfig fl cd ext)+  = TypeError ('Text "AudioSubConfig is abstract!")+++type instance+  BitRecordOfAudioSubConfig (GASpecificConfig fl cd ext) =+     (    Flag :~ fl+      .+: FlagJust cd+      .+: Field 14 :+? cd+      :+: BitRecordOfGASExtension ext+     )++-- | TODO implment that GAS extensions+data GASExtension+data MkGASExtension :: IsA GASExtension++type BitRecordOfGASExtension (x :: IsA GASExtension) =+  'BitRecordMember ("has-gas-extension" @: Flag := 'False)

@@ -0,0 +1,72 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.ByteString.Mp4.Boxes.BaseDescriptor where++import           Data.ByteString.IsoBaseFileFormat.ReExports+import           Data.ByteString.Mp4.Boxes.Expandable++-- * Static base constructor++-- | Abstract class of /descriptors/ as recognized by ISO/IEC 14496-1 (Systems).+-- A specifc descriptor is identified by the 'ClassTag'.+data Descriptor :: ClassTag n -> Type where+  MkDescriptor :: BitRecord -> Descriptor tag++-- TODO ok... this fixed the current problem in DecoderSpecificInfo .. but remove this instances ... or the above ... or ... I dunno++data BitRecordOfDescriptor :: IsA (Descriptor c :-> BitRecord)++type instance+  BitRecordOfDescriptor $~ ('MkDescriptor body :: Descriptor (tag :: ClassTag tagInd)) =+   ("base-descriptor" <:> PutHex8 tagInd)+   #+$ FieldU8 := tagInd+   .+: Eval (StaticExpandableContent body)++type family GetClassTag (c :: ClassTag n) :: Nat where+  GetClassTag (c :: ClassTag n) = n++-- | Base Descriptor Class Tags TODO rename to xxxTag+data ClassTag (tag :: Nat) where+  ObjectDescr                      :: ClassTag 0x01+  InitialObjectDescr               :: ClassTag 0x02+  ES_Descr                         :: ClassTag 0x03+  DecoderConfigDescr               :: ClassTag 0x04+  DecSpecificInfo                  :: ClassTag 0x05+  SLConfigDescr                    :: ClassTag 0x06+  ContentIdentDescr                :: ClassTag 0x07+  SupplContentIdentDescr           :: ClassTag 0x08+  IPI_DescrPointer                 :: ClassTag 0x09+  IPMP_DescrPointer                :: ClassTag 0x0A+  IPMP_Descr                       :: ClassTag 0x0B+  QoS_Descr                        :: ClassTag 0x0C+  RegistrationDescr                :: ClassTag 0x0D+  ES_ID_Ref                        :: ClassTag 0x0F+  MP4_IOD_                         :: ClassTag 0x10+  MP4_OD_                          :: ClassTag 0x11+  IPL_DescrPointerRef              :: ClassTag 0x12+  ExtensionProfileLevelDescr       :: ClassTag 0x13+  ProfileLevelIndicationIndexDescr :: ClassTag 0x14+  ContentClassificationDescr       :: ClassTag 0x40+  KeyWordDescr                     :: ClassTag 0x41+  RatingDescr                      :: ClassTag 0x42+  LanguageDescr                    :: ClassTag 0x43+  ShortTextualDescr                :: ClassTag 0x44+  ExpandedTextualDescr             :: ClassTag 0x45+  ContentCreatorNameDescr          :: ClassTag 0x46+  ContentCreationDateDescr         :: ClassTag 0x47+  OCICreatorNameDescr              :: ClassTag 0x48+  OCICreationDateDescr             :: ClassTag 0x49+  SmpteCameraPositionDescr         :: ClassTag 0x4A+  SegmentDescr                     :: ClassTag 0x4B+  MediaTimeDescr                   :: ClassTag 0x4C+  IPMP_ToolsListDescr              :: ClassTag 0x60+  IPMP_Tool                        :: ClassTag 0x61+  M4MuxTimingDescr                 :: ClassTag 0x62+  M4MuxCodeTableDescr              :: ClassTag 0x63+  ExtSLConfigDescr                 :: ClassTag 0x64+  M4MuxBufferSizeDescr             :: ClassTag 0x65+  M4MuxIdentDescr                  :: ClassTag 0x66+  DependencyPointer                :: ClassTag 0x67+  DependencyMarker                 :: ClassTag 0x68+  M4MuxChannelDescr                :: ClassTag 0x69+  ExtDescrTag :: forall (n :: Nat) . (0x6A <= n, n <= 0xFE) =>  ClassTag n+  OCIDescrTag :: forall (n :: Nat) . (0x40 <= n, n <= 0x5F) =>  ClassTag n

@@ -0,0 +1,55 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.ByteString.Mp4.Boxes.DecoderConfigDescriptor where++import           Data.ByteString.Mp4.Boxes.BaseDescriptor+import           Data.ByteString.Mp4.Boxes.DecoderSpecificInfo+import           Data.Type.BitRecords+import           Data.Type.Pretty+import           Data.Kind.Extra+import           GHC.TypeLits++-- | Information about what decoder is required for the an elementary stream.+-- The stream type indicates the general category of the stream and.+data DecoderConfigDescriptor+       (ot :: ObjectTypeIndication)+       (st :: StreamType)+          :: [IsA (DecoderSpecificInfo ot st)]+          -> [IsA (Descriptor 'ProfileLevelIndicationIndexDescr)]+          -> IsA (Descriptor 'DecoderConfigDescr)++type instance Eval (DecoderConfigDescriptor ot st di ps) =+  'MkDescriptor (DecoderConfigDescriptorBody ot st di ps)++type family+    DecoderConfigDescriptorBody+      ot st+      (di :: [IsA (DecoderSpecificInfo ot st)])+      (ps :: [IsA (Descriptor 'ProfileLevelIndicationIndexDescr)])+        :: BitRecord+  where+    DecoderConfigDescriptorBody ot st di ps =+      PutStr "decoder-config-descriptor"+        #+$ (BitRecordOfEnum (SetEnum "objectTypeIndication" ObjectTypeIndicationEnum ot)+              :+: BitRecordOfEnum (SetEnum "objectTypeIndication" StreamTypeEnum st)+              :+: "upstream" @: Flag+              .+: "reserved" @: Field 1        :=  1+              .+: "bufferSizeDB" @: Field 24+              .+: "maxBitrate"   @: FieldU32+              .+: "avgBitrate"   @: FieldU32+              .+: Eval (BitRecordOfList+                        (DescriptorOfDecoderSpecificInfo+                         :^>>>: BitRecordOfDescriptor)+                        (di ?:: LengthIn 0 1))+              :+: Eval (BitRecordOfList+                        (Extract :>>>: BitRecordOfDescriptor)+                        (ps ?:: LengthIn 0 255)))++-- ** 'ProfileLevelIndicationIndexDescriptor'++data ProfileLevelIndicationIndexDescriptor+  :: IsA (FieldValue "profileLevelIndicationIndex" Nat)+  -> IsA (Descriptor 'ProfileLevelIndicationIndexDescr)++type instance Eval (ProfileLevelIndicationIndexDescriptor val) =+  'MkDescriptor+  ('BitRecordMember (FieldU8 :~ val))

@@ -0,0 +1,112 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.ByteString.Mp4.Boxes.DecoderSpecificInfo where++import           Data.ByteString.Mp4.Boxes.BaseDescriptor+import           Data.Type.BitRecords+import           Data.Type.Pretty+import           Data.Kind.Extra+import           Data.Kind (type Type)++-- * Abstract class for opaque object- and stream type dependent decoder+-- settings.++-- | Base type of decoders+data DecoderSpecificInfo :: ObjectTypeIndication -> StreamType -> Type where+  MkDecoderSpecificInfo :: BitRecord -> DecoderSpecificInfo o s++data DescriptorOfDecoderSpecificInfo+  :: IsA (DecoderSpecificInfo ot st :-> Descriptor 'DecSpecificInfo)++type instance DescriptorOfDecoderSpecificInfo $~ 'MkDecoderSpecificInfo body =+   'MkDescriptor (PutStr "decoder-specific-info" #+$ body)++type ObjectTypeIndicationEnum = FixedEnum ObjectTypeIndication 8++data ObjectTypeIndication =+    SystemsIso14496_1_a+  | SystemsIso14496_1_b+  | InteractionStreamObjInd+  | SystemsIso14496_1_ExtendedBifs+  | SystemsIso14496_1_Afx+  | FontDataStream+  | SynthesizedTextureStream+  | StreamingTextStream+  | VisualIso14496_2+  | VisualH264+  | VisualH264ParameterSets+  | AudioIso14496_3+  | VisualIso13818_2_SimpleProfile+  | VisualIso13818_2_MainProfile+  | VisualIso13818_2_SnrProfile+  | VisualIso13818_2_SpatialProfile+  | VisualIso13818_2_HighProfile+  | VisualIso13818_2_422Profile+  | AudioIso13818_7_MainProfile+  | AudioIso13818_7_LowComplexityProfile+  | AudioIso13818_7_ScalableSamplingRateProfile+  | AudioIso13818_3+  | VisualIso11172_2+  | AudioIso11172_3+  | VisualIso10918_1+  | VisualIso15444_1+  | NoObjectTypeSpecified++type instance FromEnum ObjectTypeIndication 'SystemsIso14496_1_a                         = 0x01+type instance FromEnum ObjectTypeIndication 'SystemsIso14496_1_b                         = 0x02+type instance FromEnum ObjectTypeIndication 'InteractionStreamObjInd                     = 0x03+type instance FromEnum ObjectTypeIndication 'SystemsIso14496_1_ExtendedBifs              = 0x04+type instance FromEnum ObjectTypeIndication 'SystemsIso14496_1_Afx                       = 0x05+type instance FromEnum ObjectTypeIndication 'FontDataStream                              = 0x06+type instance FromEnum ObjectTypeIndication 'SynthesizedTextureStream                    = 0x07+type instance FromEnum ObjectTypeIndication 'StreamingTextStream                         = 0x08+type instance FromEnum ObjectTypeIndication 'VisualIso14496_2                            = 0x20+type instance FromEnum ObjectTypeIndication 'VisualH264                                  = 0x21+type instance FromEnum ObjectTypeIndication 'VisualH264ParameterSets                     = 0x22+type instance FromEnum ObjectTypeIndication 'AudioIso14496_3                             = 0x40+type instance FromEnum ObjectTypeIndication 'VisualIso13818_2_SimpleProfile              = 0x60+type instance FromEnum ObjectTypeIndication 'VisualIso13818_2_MainProfile                = 0x61+type instance FromEnum ObjectTypeIndication 'VisualIso13818_2_SnrProfile                 = 0x62+type instance FromEnum ObjectTypeIndication 'VisualIso13818_2_SpatialProfile             = 0x63+type instance FromEnum ObjectTypeIndication 'VisualIso13818_2_HighProfile                = 0x64+type instance FromEnum ObjectTypeIndication 'VisualIso13818_2_422Profile                 = 0x65+type instance FromEnum ObjectTypeIndication 'AudioIso13818_7_MainProfile                 = 0x66+type instance FromEnum ObjectTypeIndication 'AudioIso13818_7_LowComplexityProfile        = 0x67+type instance FromEnum ObjectTypeIndication 'AudioIso13818_7_ScalableSamplingRateProfile = 0x68+type instance FromEnum ObjectTypeIndication 'AudioIso13818_3                             = 0x69+type instance FromEnum ObjectTypeIndication 'VisualIso11172_2                            = 0x6A+type instance FromEnum ObjectTypeIndication 'AudioIso11172_3                             = 0x6B+type instance FromEnum ObjectTypeIndication 'VisualIso10918_1                            = 0x6C+type instance FromEnum ObjectTypeIndication 'VisualIso15444_1                            = 0x6E+type instance FromEnum ObjectTypeIndication 'NoObjectTypeSpecified                       = 0xFF++-- * Stream Type++type family+  GetStreamType (t :: k) :: StreamType++type StreamTypeEnum = FixedEnum StreamType 6++data StreamType =+    ObjectDescriptorStream+  | ClockReferenceStream+  | SceneDescriptionStream_Iso14496_11+  | VisualStream+  | AudioStream+  | Mpeg7Stream+  | IpmpStream+  | ObjectContentInfoStream+  | MpegJStream+  | InteractionStream+  | IpmpToolStream_Iso14496_13++type instance FromEnum StreamType 'ObjectDescriptorStream             = 1+type instance FromEnum StreamType 'ClockReferenceStream               = 2+type instance FromEnum StreamType 'SceneDescriptionStream_Iso14496_11 = 3+type instance FromEnum StreamType 'VisualStream                       = 4+type instance FromEnum StreamType 'AudioStream                        = 5+type instance FromEnum StreamType 'Mpeg7Stream                        = 6+type instance FromEnum StreamType 'IpmpStream                         = 7+type instance FromEnum StreamType 'ObjectContentInfoStream            = 8+type instance FromEnum StreamType 'MpegJStream                        = 9+type instance FromEnum StreamType 'InteractionStream                  = 0xa+type instance FromEnum StreamType 'IpmpToolStream_Iso14496_13         = 0xb