isobmff-builder 0.3.0.0 → 0.9.0.0

raw patch · 28 files changed

+1329/−457 lines, 28 filesdep +data-defaultdep +lensdep +textdep ~bytestringdep ~singletonsdep ~type-listPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default, lens, text, time

Dependency ranges changed: bytestring, singletons, type-list, vector-sized

API changes (from Hackage documentation)

Files

• isobmff-builder.cabal +27/−9
• spec/BoxFieldsSpec.hs +69/−48
• spec/BoxSpec.hs +17/−15
• spec/DashSpec.hs +297/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes.hs +43/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Box.hs +71/−149
• src/Data/ByteString/IsoBaseFileFormat/Boxes/BoxFields.hs +38/−16
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Brand.hs +217/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/FileType.hs +5/−8
• src/Data/ByteString/IsoBaseFileFormat/Boxes/FullBox.hs +7/−18
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Handler.hs +48/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Language.hs +40/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Media.hs +15/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MediaData.hs +6/−7
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MediaHeader.hs +29/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MediaInformation.hs +17/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Movie.hs +17/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieBox.hs +0/−156
• src/Data/ByteString/IsoBaseFileFormat/Boxes/MovieHeader.hs +66/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/ProgressiveDownloadInformation.hs +4/−5
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Skip.hs +3/−6
• src/Data/ByteString/IsoBaseFileFormat/Boxes/SpecificMediaHeader.hs +51/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Time.hs +72/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Track.hs +17/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/TrackHeader.hs +51/−0
• src/Data/ByteString/IsoBaseFileFormat/Boxes/Versioned.hs +22/−0
• src/Data/ByteString/IsoBaseFileFormat/Brands/Dash.hs +80/−0
• src/Data/ByteString/IsoBaseFileFormat/Builder.hs +0/−20

@@ -1,5 +1,5 @@ name:                isobmff-builder-version:             0.3.0.0+version:             0.9.0.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@@ -15,21 +15,37 @@  library   hs-source-dirs:      src-  exposed-modules:     Data.ByteString.IsoBaseFileFormat.Builder+  exposed-modules:     Data.ByteString.IsoBaseFileFormat.Boxes                      , Data.ByteString.IsoBaseFileFormat.Boxes.Box                      , Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Brand                      , Data.ByteString.IsoBaseFileFormat.Boxes.FileType                      , Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Handler+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Media                      , Data.ByteString.IsoBaseFileFormat.Boxes.MediaData-                     , Data.ByteString.IsoBaseFileFormat.Boxes.Skip+                     , Data.ByteString.IsoBaseFileFormat.Boxes.MediaHeader+                     , Data.ByteString.IsoBaseFileFormat.Boxes.MediaInformation+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Movie+                     , Data.ByteString.IsoBaseFileFormat.Boxes.MovieHeader                      , Data.ByteString.IsoBaseFileFormat.Boxes.ProgressiveDownloadInformation-                     , Data.ByteString.IsoBaseFileFormat.Boxes.MovieBox+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Language+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Skip+                     , Data.ByteString.IsoBaseFileFormat.Boxes.SpecificMediaHeader+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Time+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Track+                     , Data.ByteString.IsoBaseFileFormat.Boxes.TrackHeader+                     , Data.ByteString.IsoBaseFileFormat.Boxes.Versioned+                     , Data.ByteString.IsoBaseFileFormat.Brands.Dash   build-depends:       base >= 4.9 && < 5-                     , bytestring >= 0.10.8.1-                     , type-list >= 0.5.0.0-                     -- , mtl-                     , vector-sized >= 0.3.2.0-                     , singletons >= 2.2+                     , 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+                     , singletons >= 2.2 && < 3+                     , lens >= 4.14 && < 5+                     , time >= 1.6.0.1 && < 2+                     , text >= 1.2.2.1 && < 2   default-language:    Haskell2010   ghc-options:       -Wall -funbox-strict-fields -fno-warn-unused-do-bind   default-extensions:  ConstraintKinds@@ -67,11 +83,13 @@   main-is:             Spec.hs   other-modules:       BoxFieldsSpec                      , BoxSpec+                     , DashSpec   build-depends:       base >= 4.9 && < 5                      , bytestring >= 0.10.8.1                      , hspec                      , isobmff-builder                      , binary+                     , text >= 1.2.2.1 && < 2   default-language:    Haskell2010   default-extensions:  ConstraintKinds                      , CPP

@@ -1,47 +1,80 @@ module BoxFieldsSpec (spec) where  import Test.Hspec-import Data.ByteString.IsoBaseFileFormat.Builder+import Data.ByteString.IsoBaseFileFormat.Boxes -- import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as BL -- import qualified Data.Binary.Get as Binary import Control.Exception (evaluate)+import qualified Data.Text as T  -- import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as BL import -- qualified Data.Binary.Get as Binary- spec :: Spec spec =-  describe "Scalar, Constant, Template and ScalarArry composition" $-  describe "IsBoxContent instances" $-  do describe "example1" $-       do it "boxSize reports the correct size" $-             boxSize example1 `shouldBe` (1 + 1 + (3 * 8) + (7 * 8))-          it "crashes during rendering because of the invalid number of array elements for \"baz\"" $-             evaluate (renderBox example1') `shouldThrow` anyException-     describe "example2" $-       do it "boxSize reports the correct size" $-             boxSize example2 `shouldBe` (2 * 4 + 2 + 2 + 2 + 2 + 9 * 4 + 4 + 4)-          it "it renders the expected content" $-             renderBox example2 `shouldBe` (BL.pack [0,0,0,0,-                                                     0,0,0,0,-                                                        0,65,-                                                        0,66,-                                                         1,0,-                                                         0,0,-                                                     0,0,0,67,-                                                     0,0,0,68,-                                                     0,0,0,69,-                                                     0,0,0,70,-                                                     0,0,0,71,-                                                     0,0,0,72,-                                                     0,0,0,73,-                                                     0,0,0,74,-                                                     0,0,0,75,-                                                     0,0,0,76,-                                                     0,0,0,77])+  do describe "boxSize of Data.Text.Text" $+       it "returns string length + 1 (for the null termination byte)" $ do+          boxSize (T.pack "") `shouldBe` 1+          boxSize (T.pack "Hello!") `shouldBe` 7+     describe "boxBuilder of Data.Text.Text" $ do+       it "appends the null termination byte" $+          let expected = [72,101,108,108,111,32,119,111,114,108,100,33,0]+              actual = BL.unpack $ toLazyByteString $ boxBuilder (T.pack "Hello world!")+              in actual `shouldBe` expected+       it "appends the null termination byte" $+          let expected = [72,101,108,108,111,32,119,111,114,108,100,33,0]+              actual = BL.unpack $ toLazyByteString $ boxBuilder (T.pack "Hello world!")+              in actual `shouldBe` expected+       it "replaces embeded NULL characters with a space (0x20)" $+          let expected = [72,101,108,108,111,32,119,111,114,108,100,33,0]+              actual = BL.unpack $ toLazyByteString $ boxBuilder (T.pack "Hello\0world!")+              in actual `shouldBe` expected+     describe "mkLanguage" $+       do it "throws runtime exceptions when the code is too short or too long" $+            do evaluate (mkLanguage "") `shouldThrow` anyException+               evaluate (mkLanguage "a") `shouldThrow` anyException+               evaluate (mkLanguage "aa") `shouldThrow` anyException+               evaluate (mkLanguage "bbbb") `shouldThrow` anyException+               evaluate (mkLanguage "bbbbb") `shouldThrow` anyException+          it "throws runtime exceptions when the code is not in aaa .. zzz" $+            do evaluate (mkLanguage "! 3") `shouldThrow` anyException+               evaluate (mkLanguage "AAA") `shouldThrow` anyException+          it "renders lower case three-letter strings correctly" $+            let actual =+                  BL.unpack (toLazyByteString (boxBuilder (mkLanguage "deu")))+                expected =+                  BL.unpack (toLazyByteString (word16BE (4 * 1024 + 5 * 32 + 21)))+            in actual `shouldBe` expected+     describe "Scalar, Constant, Template and ScalarArry composition" $+       describe "IsBoxContent instances" $+       do describe "example1" $+            do it "boxSize reports the correct size" $ boxSize example1 `shouldBe`+                 (1 + 1 + (3 * 8) + (7 * 8))+               it "crashes during rendering because of the invalid number of array elements for \"baz\"" $+                 evaluate (renderBox example1') `shouldThrow`+                 anyException+          describe "example2" $+            do it "boxSize reports the correct size" $ boxSize example2 `shouldBe`+                 (2 * 4 + 2 + 2 + 2 + 2 + 9 * 4 + 4 + 4)+               it "it renders the expected content" $ renderBox example2 `shouldBe`+                 (BL.pack [0 ,0 ,0 ,0+                          ,0 ,0 ,0 ,0+                          ,0 ,65 ,0 ,66+                          ,1 ,0 ,0 ,0+                          ,0 ,0 ,0 ,67+                          ,0 ,0 ,0 ,68+                          ,0 ,0 ,0 ,69+                          ,0 ,0 ,0 ,70+                          ,0 ,0 ,0 ,71+                          ,0 ,0 ,0 ,72+                          ,0 ,0 ,0 ,73+                          ,0 ,0 ,0 ,74+                          ,0 ,0 ,0 ,75+                          ,0 ,0 ,0 ,76+                          ,0 ,0 ,0 ,77]) -renderBox :: IsBoxContent c => c -> BL.ByteString+renderBox :: IsBoxContent c+          => c -> BL.ByteString renderBox = toLazyByteString . boxBuilder  type ExampleContent = Scalar Word8 "bla" :+ Constant (Scalar Word8 "blub") 123 :+ Template (ScalarArray "foos" 3 Int64) '[1, 2, 3] :+ ScalarArray "baz" 7 Word64@@ -49,28 +82,16 @@ type ExampleContentShort = U8 "bla" :+ Constant (U8 "blub") 123 :+ Template (I64Arr "foos" 3) '[1, 2, 3] :+ U64Arr "baz" 7  example1 :: ExampleContent-example1 = Scalar 100 <+> Constant <+> Default <+> u64Arr [1,2,3]+example1 = Scalar 100 :+ Constant :+ Default :+ u64Arr [1,2,3]  example1' :: ExampleContentShort example1' = example1 -type Example2 isAudio =-     Constant (I32Arr "reserved" 2) '[0, 0]-  :+ Template (I16 "layer") 0-  :+ Template (I16 "alternate_group") 0-  :+ Template (I16 "volume") (If isAudio 256 0)-  :+ Constant (I16 "reserved") 0-  :+ Template (I32Arr "matrix" 9) '[65536, 0, 0, 0, 65536, 0, 0, 0, 1073741824]-  :+ I32 "width"-  :+ I32 "height"+type Example2 isAudio = Constant (I32Arr "reserved" 2) '[0, 0] :+ Template (I16 "layer") 0 :+ Template (I16 "alternate_group") 0 :+ Template (I16 "volume") (If isAudio 256 0) :+ Constant (I16 "reserved") 0 :+ Template (I32Arr "matrix" 9) '[65536, 0, 0, 0, 65536, 0, 0, 0, 1073741824] :+ I32 "width" :+ I32 "height"  example2 :: Example2 'True example2 =-  Constant <+>-  Custom 65 <+>-  Custom 66 <+>-  Default <+>-  Constant <+>-  Custom (i32Arr [67 .. 75]) <+>-  i32 76 <+>+  Constant :+ Custom 65 :+ Custom 66 :+ Default :+ Constant :++  Custom (i32Arr [67 .. 75]) :++  i32 76 :+   i32 77

@@ -1,7 +1,8 @@ module BoxSpec (spec) where  import Test.Hspec-import Data.ByteString.IsoBaseFileFormat.Builder+import Data.ByteString.IsoBaseFileFormat.Boxes+ import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as BL import qualified Data.Binary.Get as Binary@@ -22,10 +23,10 @@             do describe "boxSize" $                  do describe "a box with one nested box" $                       do it "returns the sum of both boxSizes" $-                           boxSize (testParentBox1 $ Nested :. testBox1) `shouldBe`+                           boxSize (testParentBox1 $ singletonBox testBox1) `shouldBe`                            (2 * boxSize testBox1)                          it "returns the same value as written by boxBuilder" $-                           let b = testParentBox1 $ Nested :. testBox1+                           let b = testParentBox1 $ singletonBox testBox1                                writtenSize =                                  let out = toLazyByteString (boxBuilder b)                                      getSize = Binary.runGet Binary.getWord32be@@ -33,25 +34,26 @@                                reportedSize = boxSize b                            in writtenSize `shouldBe` reportedSize +data TestBrand -data TestBox1+instance IsBrand TestBrand where+  type BoxLayout TestBrand =+    '[ 'OnceMandatory TestParentBox1 '[ 'SomeOptional TestBox1 '[]] ] -instance BoxRules TestBox1 where-  type RestrictedTo TestBox1 = 'Nothing+data TestBox1 -instance IsBoxType' TestBox1 where-  toBoxType' _ = StdType "tst1"+instance IsBoxType TestBox1 where+  toBoxType _ _ = StdType "tst1" -testBox1 :: Box' TestBox1+testBox1 :: Box TestBrand TestBox1 testBox1 = closedBox () - data TestParentBox1 -instance BoxRules TestParentBox1--instance IsBoxType' TestParentBox1 where-  toBoxType' _ = StdType "par1"+instance IsBoxType TestParentBox1 where+  toBoxType _ _ = StdType "par1" -testParentBox1 :: (ValidBoxes TestParentBox1 ts) => Boxes ts -> Box' TestParentBox1+testParentBox1+  :: ValidContainerBox TestBrand TestParentBox1 ts+  => Boxes TestBrand ts -> Box TestBrand TestParentBox1 testParentBox1 = containerBox

@@ -0,0 +1,297 @@+{-# LANGUAGE OverloadedStrings #-}+module DashSpec (spec) where++import Test.Hspec+import Data.ByteString.IsoBaseFileFormat.Brands.Dash+import qualified Data.ByteString.Lazy as BL+import Data.Text ()++spec :: Spec+spec =+  do describe "minimalIsobmff 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 $ packMediaFile doc+                   expected =+                     [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+                     ,0+                     ,0+                     ,1+                     ,73 -- Here+                     ,109+                     ,111+                     ,111+                     ,118+                     ,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+                     ,0+                     ,0+                     ,0+                     ,213 -- Here+                     ,116+                     ,114+                     ,97+                     ,107+                     ,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+                     ,0,0,0,113 -- HERE+                     ,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+                     ,0,0,0,45 -- HERE+                     ,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,33,0+                     ,0,0,0,28 -- HERE+                     ,109,105,110,102+                     ,0,0,0,20 -- HERE+                     ,115,109,104,100,0,0,0,0,0,0,0,0,0,0,0,0]+               -- BL.writeFile "/tmp/xxx.mp4" (BL.pack rendered)+               rendered `shouldBe`+                 expected++exampleSingleTrackInit :: U32 "creation_time" -> SingleTrackInit+exampleSingleTrackInit creationTime =+  SingleTrackInit (MovieHeader $+                   V0 (creationTime :+ 0 :+ Default :+ durationFromSeconds Default 1) :++                   def)+                  (TrackHeader $+                   V0 (0 :+ 0 :+ 1 :+ Constant :+ durationFromSeconds Default 1) :++                   def)+                  (MediaHeader $ def)+                  (Handler $ def :+ AudioTrack :+ def :+ (Custom "Hello world!"))+                  (SoundMediaHeader def)

@@ -0,0 +1,43 @@+-- | This module re-exports all modules needed to build /ISOBMFF/ documents.+module Data.ByteString.IsoBaseFileFormat.Boxes+  (module Data.ByteString.IsoBaseFileFormat.Boxes, module X)+  where++import Data.ByteString.IsoBaseFileFormat.Boxes.Box as X+import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields 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.Media as X+import Data.ByteString.IsoBaseFileFormat.Boxes.MediaData as X+import Data.ByteString.IsoBaseFileFormat.Boxes.MediaHeader as X+import Data.ByteString.IsoBaseFileFormat.Boxes.MediaInformation as X+import Data.ByteString.IsoBaseFileFormat.Boxes.Movie as X+import Data.ByteString.IsoBaseFileFormat.Boxes.MovieHeader as X+import Data.ByteString.IsoBaseFileFormat.Boxes.ProgressiveDownloadInformation as X+import Data.ByteString.IsoBaseFileFormat.Boxes.Language as X+import Data.ByteString.IsoBaseFileFormat.Boxes.Skip as X+import Data.ByteString.IsoBaseFileFormat.Boxes.SpecificMediaHeader as X+import Data.ByteString.IsoBaseFileFormat.Boxes.Time as X+import Data.ByteString.IsoBaseFileFormat.Boxes.Track as X+import Data.ByteString.IsoBaseFileFormat.Boxes.TrackHeader as X+import Data.ByteString.IsoBaseFileFormat.Boxes.Versioned as X+import qualified Data.ByteString.Lazy as BL++import Data.Int as X+import Data.Kind as X  (Type, Constraint)+import Data.Maybe as X+import Data.Type.Bool as X+import Data.Type.Equality as X+import Text.Printf as X+import Data.Default as X++-- * MediaFiles++-- | The toplevel container for all boxes of a media file.+data MediaFile brand where+  MediaFile :: (ValidTopLevel brand ts) => Boxes brand ts -> MediaFile brand++-- | Generate a lazy 'ByteString' with the contents of a 'MediaFile'+packMediaFile :: MediaFile brand -> BL.ByteString+packMediaFile (MediaFile bs) = toLazyByteString (boxBuilder bs)

@@ -12,45 +12,26 @@        (module Data.ByteString.IsoBaseFileFormat.Boxes.Box, module X)        where +import Data.ByteString.IsoBaseFileFormat.Boxes.Brand as X import Data.Bits as X import Data.ByteString.Builder as X import Data.Monoid as X import Data.Proxy as X import Data.Word as X+import Data.Kind import GHC.TypeLits as X import Data.String-import Data.Type.Equality-import Data.Type.List-import Data.Type.Bool+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Singletons.Prelude.List ((:++)) import qualified Data.ByteString as B --- * Basic Types and classes-+-- * Box Type Classes -- | Base class for all (abstract/phantom/normal-) types that represent boxes-class (IsBoxContent (BoxContent t), BoxRules t) => IsBoxType' t where+class (IsBoxContent (BoxContent t)) => IsBoxType t  where   type BoxContent t   type BoxContent t = ()-  toBoxType' :: proxy t -> BoxType---- | A class that describes (on the type level) how a box can be nested into--- other boxes (see 'Boxes).-class BoxRules (t :: k) where-  -- | List of boxes that this box can be nested into.-  type RestrictedTo t :: Maybe [k]-  type RestrictedTo t = 'Just '[]-  -- | If the box is also allowed 'top-level' i.e. in the file directly, not-  -- nested in an other box.-  type IsTopLevelBox t :: Bool-  type IsTopLevelBox t = 'True-  -- | Describes which nested boxes MUST be present in a box using 'boxes'.-  type RequiredNestedBoxes t :: [k]-  type RequiredNestedBoxes t = '[]-  -- | Describes how many times a box should be present in a container (-box).-  type GetCardinality t (c :: k) :: Cardinality-  type GetCardinality t any = 'ExactlyOnce---- | Describes how many times a box should be present in a container.-data Cardinality = AtMostOnce | ExactlyOnce | OnceOrMore+  toBoxType :: proxy t -> BoxContent t -> BoxType  -- | 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@@ -60,57 +41,72 @@   boxBuilder :: a -> Builder  -- * Data types- -- | A type that wraps the contents of a box and the box type.-data Box' b where-  Box' :: (IsBoxType' b, ValidBoxes b ts) => BoxContent b -> Boxes ts -> Box' b+data Box brand b where+        Box ::+            (IsBoxType b, IsBrandConform brand ('Just b) ts) =>+            BoxContent b -> Boxes brand ts -> Box brand b -instance IsBoxContent (Box' cnt) where-  boxBuilder b@(Box' cnt nested) = sB <> tB <> sExtB <> tExtB <> cntB <> nestedB-    where s       = boxSize    b-          t       = toBoxType' b-          sB      = boxBuilder s-          sExtB   = boxBuilder (BoxSizeExtension s)-          tB      = boxBuilder t-          tExtB   = boxBuilder (BoxTypeExtension t)-          cntB    = boxBuilder cnt+instance IsBoxContent (Box brand cnt) where+  boxBuilder b@(Box cnt nested) = sB <> tB <> sExtB <> tExtB <> cntB <> nestedB+    where s = boxSize b+          t = toBoxType b cnt+          sB = boxBuilder s+          sExtB = boxBuilder (BoxSizeExtension s)+          tB = boxBuilder t+          tExtB = boxBuilder (BoxTypeExtension t)+          cntB = boxBuilder cnt           nestedB = boxBuilder nested--  boxSize b@(Box' cnt nested) = sPayload + boxSize (BoxSizeExtension sPayload)-    where sPayload =   boxSize (BoxSize undefined)-                     + boxSize t-                     + boxSize cnt-                     + boxSize (BoxTypeExtension t)-                     + boxSize nested-          t        = toBoxType' b+  boxSize b@(Box cnt nested) = sPayload + boxSize (BoxSizeExtension sPayload)+    where sPayload =+            boxSize (BoxSize undefined) + boxSize t + boxSize cnt ++            boxSize (BoxTypeExtension t) ++            boxSize nested+          t = toBoxType b cnt  -- | A heterogenous collection of boxes.-data Boxes (boxTypes :: [k]) where-        Nested :: Boxes '[]-        (:.) :: Boxes ts -> Box' t -> Boxes (t ': ts)+data Boxes brand (boxTypes :: [Type]) where+        NoBoxes :: Boxes brand '[]+        (:.) :: Box brand l -> Boxes brand r -> Boxes brand (l ': r)+        -- | Create a 'Boxes' collection from two 'Box'es+        (:|) :: Box brand l -> Box brand r -> Boxes brand '[l, r]+        (:<>) :: Boxes brand l -> Boxes brand r -> Boxes brand (l :++ r) -infixl 2 :.+infixr 1 :<>+infixr 2 :.+infixr 2 :|+infixr 3 $: -instance IsBoxContent (Boxes bs) where-  boxSize Nested = 0-  boxSize (bs :. b) = boxSize bs + boxSize b-  boxBuilder Nested = mempty-  boxBuilder (bs :. b) = boxBuilder bs <> boxBuilder b+-- | Apply a function to a 'Boxes' collection containing only a single 'Box'.+($:) :: (Boxes brand '[l] -> r) -> Box brand l -> r+($:) f = f . singletonBox +-- | Create a 'Boxes' collection with a single 'Box'.+singletonBox :: Box brand l -> Boxes brand '[l]+singletonBox b = b :. NoBoxes+++instance IsBoxContent (Boxes brand 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 nested boxes.-closedBox :: (IsBoxType' t, ValidBoxes t '[]) => BoxContent t -> Box' t-closedBox c = Box' c Nested+closedBox :: (IsBoxType t, IsBrandConform brand ('Just t) '[])+          => BoxContent t -> Box brand t+closedBox c = Box c NoBoxes  -- | A box that contains no fields, but nested boxes.-containerBox :: (IsBoxType' t, ValidBoxes t ts, BoxContent t ~ ()) => Boxes ts -> Box' t-containerBox = Box' ()---- | A complete media file, consisting of top-level boxes.-mediaFile :: Boxes ts -> Builder-mediaFile = boxBuilder+containerBox :: (IsBoxType t,IsBrandConform brand ('Just t) ts,BoxContent t ~ ())+             => Boxes brand ts -> Box brand t+containerBox = Box ()  -- * 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@@ -215,90 +211,7 @@                  (take (16 * 4) str) ++              repeat (word8 0)) --- * Type-safe box composition----- * Type level consistency checks---- | A type-level check that uses 'BoxRules' to check that the contained boxes--- are standard conform.-type ValidBoxes t ts =-  ( AllAllowedIn t ts ~ 'True-  , HasAllRequiredBoxes t (RequiredNestedBoxes t) ts ~ 'True )---- | A type function to check that all nested boxes are allowed in the--- container.-type family AllAllowedIn (container :: k) (boxes :: [k]) :: Bool-     where-        AllAllowedIn c '[] = 'True-        AllAllowedIn c (t ': ts) =-          If (CheckAllowedIn c t (RestrictedTo t))-             (AllAllowedIn c ts)-             (TypeError (NotAllowedMsg c t))--type family CheckAllowedIn (c :: k) (t :: k) (a :: Maybe [k]) :: Bool where-  CheckAllowedIn c t 'Nothing   = 'True-  CheckAllowedIn c t ('Just rs) = Find c rs----- | The custom (type-) error message for 'AllAllowedIn'.-type NotAllowedMsg c t =-  'Text "Boxes of type: "-  ':<>: 'ShowType c-  ':<>: 'Text " may not contain boxes of type "-  ':<>: 'ShowType t-  ':$$: 'Text "Valid containers for "-  ':<>: 'ShowType t-  ':<>: 'Text " boxes are: "-  ':$$: 'ShowType (RestrictedTo t)-  ':$$: 'ShowType t-  ':<>: If (IsTopLevelBox c)-          ('Text " boxes may appear top-level in a file.")-          ('Text " boxes must be nested.")----- | Check that all required boxes have been nested.-type family HasAllRequiredBoxes (c :: k) (req :: [k]) (nested :: [k]) :: Bool-     where-       HasAllRequiredBoxes c '[] nested = 'True-       HasAllRequiredBoxes c (r ': restReq) nested =-         If (Find r nested)-            (HasAllRequiredBoxes c restReq nested)-            (TypeError (MissingRequired c r nested))--type IsSubSet base sub = Intersection base sub == sub---- | The custom (type-) error message for 'HasAllRequiredBoxes.-type MissingRequired c r nested =-  'Text "Boxes of type: "-  ':<>: 'ShowType c-  ':<>: 'Text " require these nested boxes: "-  ':<>: 'ShowType (RequiredNestedBoxes c)-  ':$$: 'Text "but only these box types were nested: "-  ':<>: 'ShowType nested-  ':$$: 'Text "e.g. this type is missing: "-  ':<>: 'ShowType r---- | Check that all boxes may appear top-level.-type family CheckAllTopLevelOk (ts :: [k]) :: Bool where-   CheckAllTopLevelOk '[] = 'True-   CheckAllTopLevelOk (t ': rest) = CheckTopLevelOk t && CheckAllTopLevelOk rest---- | Check that the box may appear top-level.-type family CheckTopLevelOk (t :: k) :: Bool where-   CheckTopLevelOk t = IsTopLevelBox t || TypeError (NotTopLevenError t)----- | The custom (type-) error message indicating that a box may not appear--- top-level.-type NotTopLevenError c =-        'Text "Boxes of type "-  ':<>: 'ShowType c-  ':<>: 'Text " MUST be nested inside boxes of these types: "-  ':$$: 'ShowType (RestrictedTo c)- -- * 'IsBoxContent' instances- -- | An empty box content can by represented by @()@ (i.e. /unit/). instance IsBoxContent () where   boxSize _ = 0@@ -307,4 +220,13 @@ -- | Trivial instance for 'ByteString' instance IsBoxContent B.ByteString where   boxSize = fromIntegral . B.length-  boxBuilder = byteString+  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

@@ -4,12 +4,14 @@        where  import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.Default import Data.Int import Data.Maybe import Text.Printf import Data.Singletons import Data.Singletons.Prelude.List import qualified Data.Vector.Sized as Vec+import qualified Data.Text as T  -- * Scalar box fields @@ -59,8 +61,14 @@ -- 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 scalartype deriving (Show, Read, Ord, Eq, Num)+  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@@ -153,7 +161,11 @@ -- '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)@@ -182,7 +194,8 @@ -- * Constant fields  -- | Wrapper around a field, e.g. a 'Scalar' or 'ScalarArray', with a type level--- value. The wrapped content must implement 'FromTypeLit'.+-- 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 @@ -190,6 +203,9 @@   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@@ -200,10 +216,17 @@         Default :: Template o v         Custom :: o -> Template o v +instance Default (Template o v) where+  def = Default++-- | Get a value from a 'Template'.+templateValue :: FromTypeLit o v => Template o v -> o+templateValue d@Default = fromTypeLit d+templateValue (Custom v) = v+ instance (IsBoxContent o,FromTypeLit o v) => IsBoxContent (Template o v) where-  boxSize = boxSize . fromTypeLit-  boxBuilder d@Default = boxBuilder $ fromTypeLit d-  boxBuilder (Custom o) = boxBuilder o+  boxSize = boxSize . templateValue+  boxBuilder = boxBuilder . templateValue  -- * Conversion from type-level numbers and lists to values @@ -220,20 +243,19 @@         vs' = fromIntegral <$> vs     in ScalarArray (fromJust (Vec.fromList vs')) +instance KnownSymbol str => FromTypeLit T.Text (str :: Symbol) where+  fromTypeLit = T.pack . symbolVal+ -- * Box concatenation  -- | Box content composition-data Extend a b =-  Extend a-         b+data a :+ b = a :+ b --- | An operator for 'Extend'.-type a :+ b = Extend a b+infixr 3 :+ --- | An operator for 'Extend'.-(<+>) :: a -> b -> Extend a b-(<+>) = Extend+instance (IsBoxContent p,IsBoxContent c) => IsBoxContent (p :+ c) where+  boxSize (p :+ c) = boxSize p + boxSize c+  boxBuilder (p :+ c) = boxBuilder p <> boxBuilder c -instance (IsBoxContent p,IsBoxContent c) => IsBoxContent (Extend p c) where-  boxSize (Extend p c) = boxSize p + boxSize c-  boxBuilder (Extend p c) = boxBuilder p <> boxBuilder c+instance (Default a, Default b) => Default (a :+ b) where+  def = def :+ def

@@ -0,0 +1,217 @@+-- | Brand/Box-validation+{-# LANGUAGE UndecidableInstances #-}+module Data.ByteString.IsoBaseFileFormat.Boxes.Brand+        (IsBrand(..), ValidBox, ValidContainerBox, ValidTopLevel,+        IsBrandConform, BoxTree(..), BoxForrest,+        OM,OM_,OO,OO_,SM,SM_,SO,SO_)+        where++import Data.Kind+import Data.Type.Bool+import GHC.TypeLits+-- import GHC.Exts+import Data.Singletons (Apply, type (~>))+import Data.Singletons.Prelude.List as S (Map, (:++))+import Data.Type.List (Find)++-- | A class that describes (on the type level) how a box can be nested into+-- other boxes (see 'Boxes).+class KnownNat (GetVersion brand) => IsBrand brand  where+  type BoxLayout brand :: BoxForrest+  type BoxLayout brand = '[]+  type GetVersion brand :: Nat+  type GetVersion brand = 0++-- | Mandatory, container box, exactly one+type OM b bs = 'OnceMandatory b bs+-- | Optional, container box, zero or one+type OO b bs = 'OnceOptional b bs+-- | Mandatory, container box, one or more+type SM b bs = 'SomeMandatory b bs+-- | Optional, container box, zero or more+type SO b bs = 'SomeOptional b bs++-- | Mandatory, exactly one, no children+type OM_ b = 'OnceMandatory b '[]+-- | Optional, zero or one, no children+type OO_ b = 'OnceOptional b '[]+-- | Mandatory, one or more, no children+type SM_ b = 'SomeMandatory b '[]+-- | Optional, zero or more, no children+type SO_ b = 'SomeOptional b '[]++-- | Boxes that valid according to the box structure defined in a 'IsBrand'+-- instance, i.e. where 'IsBrandConform' holds.+type family+  IsBrandConform (b :: Type) (parent :: Maybe Type) (ts :: [Type]) :: Constraint where+  IsBrandConform b 'Nothing ts =+    IsBrandConformImpl b (TopLevel b) ts (BoxLayout b)+  IsBrandConform b ('Just parent) ts =+    IsBrandConformImpl b parent ts (LookUpSubtrees parent (BoxLayout b))++-- | Convenience wrapper around @(IsBrandConform b ('Just t) '[])@+type ValidBox b t = IsBrandConform b ('Just t) '[]++-- | Convenience wrapper around @(IsBrandConform b ('Just t) ts)@+type ValidContainerBox b t ts = IsBrandConform b ('Just t) ts++-- | Convenience wrapper around @(IsBrandConform b 'Nothing ts)@+type ValidTopLevel b ts = IsBrandConform b 'Nothing ts+++-- | Define the cardinality and valid child boxes of a box.+data BoxTree+  = OnceOptional Type+        BoxForrest+  | OnceMandatory Type+        BoxForrest+  | SomeOptional Type+        BoxForrest+  | SomeMandatory Type+        BoxForrest++-- | A list of 'BoxTree's+type BoxForrest = [BoxTree]++-- * Implementation++-- | A type for marking top-level boxes in TypeError messages, in the+-- 'IsBrandConformImpl' constraint.+data TopLevel :: t -> Type+++type family+  LookUpSubtrees t (trees :: BoxForrest) :: BoxForrest where+    LookUpSubtrees t '[] = '[]+    LookUpSubtrees t ('OnceOptional t sub ': rest) = sub+    LookUpSubtrees t ('OnceOptional u sub ': rest) = LookUpSubtrees t (sub :++ rest)+    LookUpSubtrees t ('OnceMandatory t sub ': rest) = sub+    LookUpSubtrees t ('OnceMandatory u sub ': rest) = LookUpSubtrees t (sub :++ rest)+    LookUpSubtrees t ('SomeOptional t sub ': rest) = sub+    LookUpSubtrees t ('SomeOptional u sub ': rest) = LookUpSubtrees t (sub :++ rest)+    LookUpSubtrees t ('SomeMandatory t sub ': rest) = sub+    LookUpSubtrees t ('SomeMandatory u sub ': rest) = LookUpSubtrees t (sub :++ rest)++-- | A constraint that is solved if all 'Box'es layed out in accordance with the+-- 'BoxLayout' if an 'IsBrand' instance.+type IsBrandConformImpl b (info :: Type) (ts :: [Type]) (boxForrest :: BoxForrest) =+  ( IsBrand b+  , ReportIt '[AllRequiredBoxes+                 boxForrest+                 ts]+  , ReportIt '[OnlyValidBoxes info+                 boxForrest+                 ts]+  , ReportIt (Map (RuleAppliesFun info ts)+                  boxForrest))++type family+  ReportIt (es :: [Maybe ErrorMessage]) :: Constraint where+    ReportIt '[] = ()+    ReportIt ('Nothing ': rest) = ReportIt rest+    ReportIt ('Just e ': rest) = TypeError e++type family+  AllRequiredBoxes (f :: BoxForrest) (ts :: [t]) :: Maybe ErrorMessage where+    AllRequiredBoxes '[] children = 'Nothing++    AllRequiredBoxes ('OnceMandatory c sub ': rules) '[] =+      'Just ('Text "OnceMandatory box '"+             ':<>: 'ShowType c ':<>: 'Text "' missing, or out of order.")+    AllRequiredBoxes ('SomeMandatory c sub ': rules) '[] =+      'Just ('Text "SomeMandatory box '"+             ':<>: 'ShowType c ':<>: 'Text "' missing, or out of order.")++    AllRequiredBoxes ('OnceMandatory c sub ': rules) (c ': children) =+      AllRequiredBoxes rules children+    AllRequiredBoxes ('SomeMandatory c sub ': rules) (c ': children) =+      AllRequiredBoxes rules (RemoveNext c children)++    AllRequiredBoxes ('OnceMandatory c sub ': rules) children =+      AllRequiredBoxes rules children+    AllRequiredBoxes ('SomeMandatory c sub ': rules) children =+      AllRequiredBoxes rules children++    AllRequiredBoxes ('OnceOptional c sub ': rules) (c ': children) =+      AllRequiredBoxes rules children+    AllRequiredBoxes ('OnceOptional c sub ': rules) children =+      AllRequiredBoxes rules children+    AllRequiredBoxes ('SomeOptional c sub ': rules) children =+      AllRequiredBoxes rules (RemoveNext c children)++type family+  OnlyValidBoxes (r :: t) (f :: BoxForrest) (ts :: [t]) :: Maybe ErrorMessage where+    OnlyValidBoxes r rules (c ': children) =+      If (Find c (ExtractBoxes rules))+         (OnlyValidBoxes r rules children)+         ('Just ('Text "Invalid box '" ':<>: 'ShowType c+                 ':<>: 'Text "' in box '" ':<>: 'ShowType r ':<>: 'Text "'"))+    OnlyValidBoxes r rules '[] = 'Nothing++type family+  ExtractBoxes (f :: BoxForrest) :: [t] where+    ExtractBoxes '[] = '[]+    ExtractBoxes ('OnceMandatory c sub ': rules) =+      c ': ExtractBoxes rules+    ExtractBoxes ('SomeMandatory c sub ': rules) =+      c ': ExtractBoxes rules+    ExtractBoxes ('OnceOptional c sub ': rules) =+      c ': ExtractBoxes rules+    ExtractBoxes ('SomeOptional c sub ': rules) =+      c ': ExtractBoxes rules++type family+  RemoveNext (t :: k) (ts :: [k]) :: [k] where+    RemoveNext t (t ': ts) = RemoveNext t ts+    RemoveNext t ts = ts++data RuleAppliesFun :: t -> [t] -> BoxTree ~> Maybe ErrorMessage++type instance Apply (RuleAppliesFun parent childBoxes) rules =+  RuleApplies parent childBoxes rules++type family+  RuleApplies (parent :: t) (childBoxes :: [t]) (rules :: BoxTree) :: Maybe ErrorMessage where+  -- Zero or more+  RuleApplies parent children ('SomeOptional other sub) =+    'Nothing+  -- zero or one+  RuleApplies parent (child ': others) ('OnceOptional child sub) =+    If (Find child others)+       ('Just ('Text "It is not allowed to have more than one '"+               ':<>: 'ShowType child+               ':<>: 'Text "' in '"+               ':<>: 'ShowType parent+               ':<>: 'Text "'."))+      'Nothing+  RuleApplies parent (notChild ': others) ('OnceOptional child sub) =+    RuleApplies parent others ('OnceOptional child sub)+  RuleApplies parent '[] ('OnceOptional child sub) = 'Nothing+  -- exactly one+  RuleApplies parent (child ': others) ('OnceMandatory child sub) =+    If (Find child others)+       ('Just ('Text "It is not allowed to have more than one '"+               ':<>: 'ShowType child+               ':<>: 'Text "' in '"+               ':<>: 'ShowType parent+               ':<>: 'Text "'."))+      'Nothing+  RuleApplies parent (notChild ': others) ('OnceMandatory child sub) =+    RuleApplies parent others ('OnceMandatory child sub)+  RuleApplies parent '[] ('OnceMandatory child sub) =+    'Just ('Text "Need exactly one '"+           ':<>: 'ShowType child+           ':<>: 'Text "' in '"+           ':<>: 'ShowType parent+           ':<>: 'Text "'.")+  -- OnceMandatory or more+  RuleApplies parent (child ': others) ('SomeMandatory child sub) =+    'Nothing+  RuleApplies parent (notChild ': others) ('SomeMandatory child sub) =+    RuleApplies parent others ('SomeMandatory child sub)+  RuleApplies parent '[] ('SomeMandatory child sub) =+    'Just ('Text "Need at least one '"+           ':<>: 'ShowType child+           ':<>: 'Text "' in '"+           ':<>: 'ShowType parent+           ':<>: 'Text "'.")

@@ -3,16 +3,14 @@ import Data.ByteString.IsoBaseFileFormat.Boxes.Box  -- | File Type Box--instance BoxRules FileType--instance IsBoxType' FileType where+instance IsBoxType FileType where   type BoxContent FileType = FileType-  toBoxType' _ = StdType "ftyp"+  toBoxType _ _ = StdType "ftyp"  -- | Create a 'FileTypeBox' from a major brand, a minor version and a list of -- compatible brands-fileTypeBox :: FileType -> Box' FileType+fileTypeBox :: (ValidBox b FileType)+            => FileType -> Box b FileType fileTypeBox = closedBox  -- | Contents of a 'ftyp' box are some 'FourCc' /brands/ and a version.@@ -22,7 +20,6 @@            ,compatibleBrands :: [FourCc]}  instance IsBoxContent FileType where-  boxSize (FileType maj _ver comps) =-    boxSize maj + 4 + sum (boxSize <$> comps)+  boxSize (FileType maj _ver comps) = boxSize maj + 4 + sum (boxSize <$> comps)   boxBuilder (FileType maj ver comps) =     boxBuilder maj <> word32BE ver <> mconcat (boxBuilder <$> comps)

@@ -1,6 +1,7 @@ -- | Full Boxes module Data.ByteString.IsoBaseFileFormat.Boxes.FullBox-       (FullBox(), fullBox, closedFullBox, BoxVersion, BoxFlags(..), Versioned(..)) where+       (FullBox(..), fullBox, closedFullBox, BoxVersion, BoxFlags(..))+       where  import Data.ByteString.IsoBaseFileFormat.Boxes.Box import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields@@ -19,30 +20,18 @@  -- | Create a 'FullBox' from a 'BoxVersion' and 'BoxFlags' fullBox-  :: (IsBoxType' t,ValidBoxes t ts,BoxContent t ~ FullBox version c)-  => BoxVersion version -> BoxFlags 24 -> c -> Boxes ts -> Box' t-fullBox version fs cnt = Box' (FullBox version fs cnt)+  :: (IsBoxType t,ValidContainerBox brand t ts,BoxContent t ~ FullBox version c)+  => BoxVersion version -> BoxFlags 24 -> c -> Boxes brand ts -> Box brand t+fullBox version fs cnt = Box (FullBox version fs cnt)  -- | Create a 'FullBox' from a 'BoxVersion' and 'BoxFlags' without nested boxes. closedFullBox-  :: (IsBoxType' t,ValidBoxes t '[],BoxContent t ~ FullBox version c)-  => BoxVersion version -> BoxFlags 24 -> c -> Box' t+  :: (IsBoxType t,ValidBox brand t,BoxContent t ~ FullBox version c)+  => BoxVersion version -> BoxFlags 24 -> c -> Box brand t closedFullBox version fs cnt = closedBox (FullBox version fs cnt)  -- | The box version (in a 'FullBox') is a single byte type BoxVersion v = Template (U8 "fullbox-version") v---- | 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 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  -- | In addition to a 'BoxVersion' there can be 24 bits for custom flags etc in -- a 'FullBox'.

@@ -0,0 +1,48 @@+-- | A 'Handler' box describes how a track is presentation and by which sensory+-- process it is perceived, e.g. audio, video, text, see 'HandlerType'+module Data.ByteString.IsoBaseFileFormat.Boxes.Handler where++import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox+import Data.Default+import qualified Data.Text as T++-- | Handler box fields. A handler box may also contain a null terminated+-- description text in UTF-8.+newtype Handler where+  Handler :: Constant (U32 "pre_defined") 0+          :+ HandlerType+          :+ Constant (U32Arr "reserved" 3) '[0,0,0]+          :+ Template T.Text ""+          -> Handler+  deriving (IsBoxContent, Default)++-- | A 'Handler' can be exactly one of these.+data HandlerType =+    VideoTrack+  | AudioTrack+  | HintTrack+  | TimedMetadataTrack+  | AuxilliaryVideoTrack++-- | Create a 'MediaDataBox' from a strict 'ByteString'+handler+  :: (ValidBox brand Handler)+  => Handler -> Box brand Handler+handler = closedFullBox Default 0++instance IsBoxType Handler where+  type BoxContent Handler = FullBox 0 Handler+  toBoxType _ _ = StdType "hdlr"++instance Default HandlerType where+  def = AudioTrack++instance IsBoxContent HandlerType where+  boxSize    _                    = 4+  boxBuilder VideoTrack           = boxBuilder (FourCc ('v','i','d','e'))+  boxBuilder AudioTrack           = boxBuilder (FourCc ('s','o','u','n'))+  boxBuilder HintTrack            = boxBuilder (FourCc ('h','i','n','t'))+  boxBuilder TimedMetadataTrack   = boxBuilder (FourCc ('m','e','t','a'))+  boxBuilder AuxilliaryVideoTrack = boxBuilder (FourCc ('a','u','x','v'))

@@ -0,0 +1,40 @@+-- | 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.Default+import Data.String++-- | 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++-- | 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 &&+   c1 > toEnum 0x60 && c1 < toEnum 0x7b &&+   c2 > toEnum 0x60 && c2 < toEnum 0x7b) =+     let+         s :: Char -> Word16+         s c = fromIntegral (fromEnum c) - 0x60+         in Language (shiftL (s c0) 10 .|.  shiftL (s c1) 5 .|. s c2)++mkLanguage other =+  error $+    "Invalid ISO 639-2 language code: " ++ show other +++    ". The code must consist of three lower-case letters between 'a' .. 'z'."++instance IsString Language where+  fromString = mkLanguage++instance Default Language where+  def = mkLanguage "deu"++instance IsBoxContent Language where+  boxSize _ = 2+  boxBuilder (Language c) = word16BE c

@@ -0,0 +1,15 @@+-- | Track specific media information container box.+module Data.ByteString.IsoBaseFileFormat.Boxes.Media where++import Data.ByteString.IsoBaseFileFormat.Boxes.Box++-- | Media data box+data Media++instance IsBoxType Media where+  toBoxType _ _ = StdType "mdia"++-- | Create a 'MediaDataBox' from a strict 'ByteString'+media :: ValidContainerBox brand Media ts+      => Boxes brand ts -> Box brand Media+media = containerBox

@@ -1,18 +1,17 @@+-- | Media data box module Data.ByteString.IsoBaseFileFormat.Boxes.MediaData where  import Data.ByteString.IsoBaseFileFormat.Boxes.Box import qualified Data.ByteString as B --- | Media data box+-- | Media data box phantom type data MediaData -instance BoxRules MediaData--instance IsBoxType' MediaData where+instance IsBoxType MediaData where   -- | Contents of a 'mdat' box are just bytes from a strict 'ByteString'   type BoxContent MediaData = B.ByteString-  toBoxType' _ = StdType "mdat"+  toBoxType _ _ = StdType "mdat"  -- | Create a 'MediaDataBox' from a strict 'ByteString'-mediaDataBox :: B.ByteString -> Box' MediaData-mediaDataBox = closedBox+mediaData :: ValidBox b MediaData => B.ByteString -> Box b MediaData+mediaData = closedBox

@@ -0,0 +1,29 @@+-- | 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.Boxes.Language+import Data.ByteString.IsoBaseFileFormat.Boxes.Time++-- | Media header data box.+data MediaHeader (v :: Nat) where+  MediaHeader+   :: KnownNat v+   => Timing v :+ Language :+ Constant (I16 "pre_defined") 0+   -> MediaHeader v++-- | Create a 'MediaHeader' box.+mediaHeader+  :: (KnownNat v, ValidBox brand (MediaHeader v))+  => MediaHeader v -> Box brand (MediaHeader v)+mediaHeader = closedFullBox Default 0++instance (KnownNat v) => IsBoxType (MediaHeader v) where+  type BoxContent (MediaHeader v) = FullBox v (MediaHeader v)+  toBoxType _ _ = StdType "mdhd"++instance IsBoxContent (MediaHeader v) where+  boxSize (MediaHeader c) = boxSize c+  boxBuilder (MediaHeader c) = boxBuilder c

@@ -0,0 +1,17 @@+-- | Media information container for all boxes declaring the specific+-- technicalities of the media data associated with a 'Track'.+module Data.ByteString.IsoBaseFileFormat.Boxes.MediaInformation where++import Data.ByteString.IsoBaseFileFormat.Boxes.Box++-- | Media information box phantom type.+data MediaInformation++-- | Create a 'MediaInformation' from a strict 'ByteString'+mediaInformation+  :: ValidContainerBox brand MediaInformation ts+  => Boxes brand ts -> Box brand MediaInformation+mediaInformation = containerBox++instance IsBoxType MediaInformation where+  toBoxType _ _ = StdType "minf"

@@ -0,0 +1,17 @@+-- | Meta data for a presentation of a /movie/.+module Data.ByteString.IsoBaseFileFormat.Boxes.Movie where++import Data.ByteString.IsoBaseFileFormat.Boxes.Box++-- | Compose a set of boxes into a 'Movie'+movie :: (ValidContainerBox brand Movie ts)+      => Boxes brand ts -> Box brand Movie+movie = containerBox++-- | The metadata for a presentation, a single 'Movie' which occurs only once+-- and top-level. It is pretty empty on it's own, but it contains nested boxes+-- with all the relevant meta data.+data Movie++instance IsBoxType Movie where+  toBoxType _ _ = StdType "moov"

@@ -1,156 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- | Meta data for a presentation of a /movie/.-module Data.ByteString.IsoBaseFileFormat.Boxes.MovieBox where--import Data.ByteString.IsoBaseFileFormat.Boxes.Box-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox---- | Compose a set of boxes into a 'MovieBox'------ Example:------ >  xxx :: Box' Movie--- >  xxx = movieBox $--- >         Nested (movieHeaderBox (...))--- >         :. (trackBox $--- >              Nested (trackHeaderBox (TrackHeader ...))--- >              :. trackReferenceBox (TrackReference ...)--- >              :. trackGroupingIndication (TrackGroupingInd ...))----movieBox :: ValidBoxes (Movie version) ts-         => Boxes ts -> Box' (Movie version)-movieBox = containerBox---- | The metadata for a presentation, a single 'Movie' which occurs only once--- and top-level. It is pretty empty on it's own, but it contains nested boxes--- with all the relevant meta data.-data Movie (version :: Nat)--instance IsBoxType' (Movie version) where-  toBoxType' _ = StdType "moov"--instance BoxRules (Movie version) where-  type RequiredNestedBoxes (Movie version) = '[MovieHeader version]---- * @mvhd@ Box---- | Construct a 'MovieHeader' box.-movieHeaderBox-  :: KnownNat version-  => MovieHeader version -> Box' (MovieHeader version)-movieHeaderBox = closedFullBox Default 0---- | Movie meta data, indexed by a version.-data MovieHeader (version :: Nat) where-        MovieHeader ::-            KnownNat version =>-               Versioned MovieHeaderTimesV0-                         MovieHeaderTimesV1-                         version-            :+ Template (I32 "rate") 0x00010000-            :+ Template (I16 "volume") 0x0100-            :+ Constant (I16 "reserved") 0-            :+ Constant (I32Arr "reserved" 2) '[0,0]-            :+ Constant (I32Arr "matrix" 9)-                        '[65536, 0, 0, 0, 65536, 0, 0, 0, 1073741824]-            :+ Template (U32Arr "pre_defined" 6) '[0,0,0,0,0,0]-            :+ U32 "next_track_ID"-            -> MovieHeader version---- | Time and timing information about a movie (32bit version).-type MovieHeaderTimesV0 = MovieHeaderTimes (Scalar Word32)---- | Time and timing information about a movie (64bit version).-type MovieHeaderTimesV1 = MovieHeaderTimes (Scalar Word64)---- | Time and timing information about a movie.-type MovieHeaderTimes uint =-      uint "creation_time"-   :+ uint "modification_time"-   :+ U32 "timescale"-   :+ uint "duration"--instance IsBoxContent (MovieHeader version) where-  boxSize (MovieHeader c) = boxSize c-  boxBuilder (MovieHeader c) = boxBuilder c--instance KnownNat version => IsBoxType' (MovieHeader version) where-  toBoxType' _ = StdType "mvhd"-  type BoxContent (MovieHeader version) = FullBox version (MovieHeader version)--instance BoxRules (MovieHeader version) where-  type IsTopLevelBox (MovieHeader version) = 'False-  type GetCardinality (MovieHeader version) any = 'ExactlyOnce-  type RestrictedTo (MovieHeader version) = 'Just '[Movie version]---- * @trak@ Box---- | Compose a 'Track' box from the given boxes.-track :: ValidBoxes (Track version) ts-      => Boxes ts -> Box' (Track version)-track = containerBox---- | Container box for tracks.-data Track (version :: Nat)--instance IsBoxType' (Track version) where-  toBoxType' _ = StdType "trak"--instance BoxRules (Track version) where-  type IsTopLevelBox (Track version) = 'False-  type GetCardinality (Track version) any = 'ExactlyOnce-  type RestrictedTo (Track version) = 'Just '[Movie version]---- * @tkhd@ Box----- | Create a 'TrackHeader' box.-trackHeader-  :: KnownNat version => TrackHeader version -> Box' (TrackHeader version)-trackHeader = closedFullBox Default 0---- | Track meta data, indexed by a version.-data TrackHeader (version :: Nat) where-        TrackHeader ::-               Versioned TrackHeaderTimesV0-                         TrackHeaderTimesV1-                         version-            :+ Constant (I32Arr "reserved" 2) '[0, 0]-            :+ Template (I16 "layer") 0-            :+ Template (I16 "alternate_group") 0-            :+ Template (I16 "volume") 256-            :+ Constant (I16 "reserved") 0-            :+ Template (I32Arr "matrix" 9)-                        '[65536, 0, 0, 0, 65536, 0, 0, 0, 1073741824]-            :+ I32 "width"-            :+ I32 "height"-            -> TrackHeader version---- | Time and timing information about a track (32bit version).-type TrackHeaderTimesV0 = TrackHeaderTimes (Scalar Word32)---- | Time and timing information about a track (64bit version).-type TrackHeaderTimesV1 = TrackHeaderTimes (Scalar Word64)---- | Time and timing information about a track.-type TrackHeaderTimes uint =-      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--instance KnownNat version => IsBoxType' (TrackHeader version) where-  type BoxContent (TrackHeader version) = FullBox version (TrackHeader version)-  toBoxType' _ = StdType "tkhd"--instance BoxRules (TrackHeader version) where-  type IsTopLevelBox (TrackHeader version) = 'False-  type GetCardinality (TrackHeader version) any = 'ExactlyOnce-  type RestrictedTo (TrackHeader version) = 'Just '[Track version]

@@ -0,0 +1,66 @@+-- | 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++-- * @mvhd@ Box++-- | Construct a 'MovieHeader' box.+movieHeader+  :: (KnownNat version, ValidBox brand (MovieHeader version))+  => MovieHeader version -> Box brand (MovieHeader version)+movieHeader = closedFullBox Default 0++-- | Movie meta data, indexed by a version.+--+-- The @rate@ field is a 16.16 fix point number, 1.0 indicates the preferred+-- normal playback rate. @volume@ is also a fix point number, albeit smaller+-- with only 8.8. A volume of 1.0 is the full (loudest) volume. @matrix@ is the+-- video image transformation matrix. The @next_track_ID@  indicates the next+-- 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+        MovieHeader ::+            KnownNat version =>+               Timing version+            :+ Template (I32 "rate") 0x00010000+            :+ Template (I16 "volume") 0x0100+            :+ Constant (I16 "reserved") 0+            :+ Constant (I32Arr "reserved" 2) '[0,0]+            :+ Template (I32Arr "matrix" 9)+                        '[65536, 0, 0, 0, 65536, 0, 0, 0, 1073741824]+            :+ Template (U32Arr "pre_defined" 6) '[0,0,0,0,0,0]+            :+ Template (U32 "next_track_ID") 0xFFFFFFFF+            -> MovieHeader version++-- | Time and timing information about a movie (32bit version).+type MovieHeaderTimesV0 = MovieHeaderTimes (Scalar Word32)++-- | Time and timing information about a movie (64bit version).+type MovieHeaderTimesV1 = MovieHeaderTimes (Scalar Word64)++-- | 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 MovieHeaderTimes uint =+      uint "creation_time"+   :+ uint "modification_time"+   :+ TimeScale+   :+ uint "duration"+++instance IsBoxContent (MovieHeader version) where+  boxSize (MovieHeader c) = boxSize c+  boxBuilder (MovieHeader c) = boxBuilder c++instance KnownNat version => IsBoxType (MovieHeader version) where+  toBoxType _ _ = StdType "mvhd"+  type BoxContent (MovieHeader version) = FullBox version (MovieHeader version)

@@ -8,11 +8,9 @@ -- | A Box with progressive download information data ProgressiveDownload -instance BoxRules ProgressiveDownload--instance IsBoxType' ProgressiveDownload where+instance IsBoxType ProgressiveDownload where   type BoxContent ProgressiveDownload = FullBox 0 ProgressiveDownloadContent-  toBoxType' _ = StdType "pdin"+  toBoxType _ _ = StdType "pdin"  -- | Information for progressive media data download/playback encompasses the -- delay for initial playback and expected download bit rate.@@ -20,5 +18,6 @@  -- | Construct a @pdin@ box. pdinBox-  :: ProgressiveDownloadContent -> Box' ProgressiveDownload+  :: ValidBox brand ProgressiveDownload+  => ProgressiveDownloadContent -> Box brand ProgressiveDownload pdinBox = closedFullBox Default 0

@@ -6,15 +6,12 @@ -- | Contents of a 'skip' box are just any number of filler bytes. newtype Skip = Skip Int -instance IsBoxType' Skip where+instance IsBoxType Skip where   type BoxContent Skip = Skip-  toBoxType' _ = StdType "skip"--instance BoxRules Skip where-  type RestrictedTo Skip = 'Nothing+  toBoxType _ _ = StdType "skip"  -- | Create a 'Skip' with a given size.-skipBox :: Skip -> Box' Skip+skipBox :: ValidBox brand Skip => Skip -> Box brand Skip skipBox = closedBox  instance IsBoxContent Skip where

@@ -0,0 +1,51 @@+-- | Media-independent properties of a tracks media content.+module Data.ByteString.IsoBaseFileFormat.Boxes.SpecificMediaHeader where++import Data.ByteString.IsoBaseFileFormat.Boxes.Box+import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields+import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox++-- | Media header data box. The actual box type is determined by the claused+-- used to construct the record.+data SpecificMediaHeader where+  VideoMediaHeader+   :: Template (U16 "graphicsmode") 0+   :+ Template (U16 "reserved") 0+   -> SpecificMediaHeader+  SoundMediaHeader+   :: Template (I16 "balance") 0+   :+ Constant (U16Arr "opcolor" 3) '[0,0,0]+   -> SpecificMediaHeader+  HintMediaHeader+   :: U16 "maxPDUsize"+   :+ U16 "avgPDUsize"+   :+ U16 "maxbitrate"+   :+ U16 "avgbitrate"+   :+ U32 "reserved"+   -> SpecificMediaHeader+  NullMediaHeader+   :: SpecificMediaHeader++-- | Create a 'SpecificMediaHeader' box.+specificMediaHeader+  :: ValidBox brand SpecificMediaHeader+  => SpecificMediaHeader -> Box brand SpecificMediaHeader+specificMediaHeader h@(VideoMediaHeader _) = closedFullBox Default 1 h+specificMediaHeader h                      = closedFullBox Default 0 h++instance IsBoxType SpecificMediaHeader where+  type BoxContent SpecificMediaHeader = FullBox 0 SpecificMediaHeader+  toBoxType _ (FullBox _ _ (VideoMediaHeader _)) = StdType "vmhd"+  toBoxType _ (FullBox _ _ (SoundMediaHeader _)) = StdType "smhd"+  toBoxType _ (FullBox _ _ (HintMediaHeader  _)) = StdType "hmhd"+  toBoxType _ (FullBox _ _ NullMediaHeader)      = StdType "nmhd"++instance IsBoxContent SpecificMediaHeader where+  boxSize (VideoMediaHeader c) = boxSize c+  boxSize (SoundMediaHeader c) = boxSize c+  boxSize (HintMediaHeader  c) = boxSize c+  boxSize NullMediaHeader      = boxSize ()+  boxBuilder (VideoMediaHeader c) = boxBuilder c+  boxBuilder (SoundMediaHeader c) = boxBuilder c+  boxBuilder (HintMediaHeader  c) = boxBuilder c+  boxBuilder NullMediaHeader      = boxBuilder ()

@@ -0,0 +1,72 @@+-- | 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"

@@ -0,0 +1,17 @@+-- | Meta data for a presentation of a /movie/.+module Data.ByteString.IsoBaseFileFormat.Boxes.Track where++import Data.ByteString.IsoBaseFileFormat.Boxes.Box++-- * @trak@ Box+-- | Compose a 'Track' box from the given boxes.+track+  :: (ValidContainerBox brand Track ts)+  => Boxes brand ts -> Box brand Track+track = containerBox++-- | Container box for tracks.+data Track++instance IsBoxType Track where+  toBoxType _ _ = StdType "trak"

@@ -0,0 +1,51 @@+-- | Track header box+module Data.ByteString.IsoBaseFileFormat.Boxes.TrackHeader 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++-- * @tkhd@ Box+-- | Create a 'TrackHeader' box.+trackHeader+  :: (ValidBox brand (TrackHeader version), version ~ GetVersion brand)+  => TrackHeader version -> Box brand (TrackHeader version)+trackHeader = closedFullBox Default 0++-- | Track meta data, indexed by a version.+data TrackHeader (version :: Nat) where+        TrackHeader ::+          Versioned TrackHeaderTimesV0 TrackHeaderTimesV1 version+            :+ Constant (I32Arr "reserved" 2) '[0, 0]+            :+ Template (I16 "layer") 0+            :+ Template (I16 "alternate_group") 0+            :+ Template (I16 "volume") 256+            :+ Constant (I16 "reserved") 0+            :+ Template (I32Arr "matrix" 9)+                        '[65536, 0, 0, 0, 65536, 0, 0, 0, 1073741824]+            :+ I32 "width"+            :+ I32 "height"+            -> TrackHeader version++-- | Time and timing information about a track (32bit version).+type TrackHeaderTimesV0 = TrackHeaderTimes (Scalar Word32)++-- | Time and timing information about a track (64bit version).+type TrackHeaderTimesV1 = TrackHeaderTimes (Scalar Word64)++-- | Time and timing information about a track.+type TrackHeaderTimes uint =+     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++instance KnownNat version => IsBoxType (TrackHeader version) where+  type BoxContent (TrackHeader version) = FullBox version (TrackHeader version)+  toBoxType _ _ = StdType "tkhd"

@@ -0,0 +1,22 @@+-- | 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+import Data.Default++-- | 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,80 @@+-- | Predefined Box composition matching the @dash@ brand. TODO this is an+-- incomplete,  special-purpose variant of this brand, serving my personal,+-- educational, current need.+-- This is a convenient way of building documents of that kind.+module Data.ByteString.IsoBaseFileFormat.Brands.Dash+       (Dash, SingleTrackInit(..), mkSingleTrackInit, module X) where++import Data.ByteString.IsoBaseFileFormat.Boxes as X+import Data.Kind (Type, Constraint)+import Control.Lens++-- | 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)++-- | A 'BoxLayout' which contains the stuff needed for the 'dash' brand.+-- TODO incomplete+instance KnownNat v => IsBrand (Dash v) where+  type GetVersion (Dash v) = v+  type BoxLayout (Dash v) =+    '[OM_ FileType,+      OM Movie+        '[OM_ (MovieHeader v),+          SM Track+            '[OM_ (TrackHeader v),+              OM Media+                '[OM_ (MediaHeader v), OM_ Handler,+                  OM MediaInformation '[OO_ SpecificMediaHeader]]]],+      SO_ Skip]++-- Missing Boxes+-- START 17:47:+--  mdia+--  mdhd+--  hdlr+--  minf+--  smhd+--  dinf+--  dref+--  ??url+--  stbl+--  stsd+--  stts+--  stsc+--  stsz+--  stco+--  soun+--  mp4a+--  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+data SingleTrackInit =+  SingleTrackInit {_mvhd :: MovieHeader 0+                  ,_tkhd :: TrackHeader 0+                  ,_mdhd :: MediaHeader 0+                  ,_hdlr :: Handler+                  ,_xmhd :: SpecificMediaHeader}++makeLenses ''SingleTrackInit++-- | Convert a 'SingleTrackInit' record to a generic 'Boxes' collection.+mkSingleTrackInit+  :: SingleTrackInit -> MediaFile (Dash 0)+mkSingleTrackInit doc =+  MediaFile $+  fileTypeBox (FileType "iso5" 0 ["isom","iso5","dash","mp42"]) :|+  movie (movieHeader (doc ^. mvhd) :|+         track (trackHeader (doc ^. tkhd) :|+                media (mediaHeader (doc ^. mdhd) :. handler (doc ^. hdlr) :|+                       mediaInformation $:+                       specificMediaHeader (doc ^. xmhd))))

@@ -1,20 +0,0 @@--- | This module re-exports all modules needed to build /ISOBMFF/ documents.-module Data.ByteString.IsoBaseFileFormat.Builder-  (module X)-  where--import Data.ByteString.IsoBaseFileFormat.Boxes.Box as X-import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields as X-import Data.ByteString.IsoBaseFileFormat.Boxes.FileType as X-import Data.ByteString.IsoBaseFileFormat.Boxes.FullBox as X-import Data.ByteString.IsoBaseFileFormat.Boxes.MediaData as X-import Data.ByteString.IsoBaseFileFormat.Boxes.MovieBox as X-import Data.ByteString.IsoBaseFileFormat.Boxes.ProgressiveDownloadInformation as X-import Data.ByteString.IsoBaseFileFormat.Boxes.Skip as X--import Data.Int as X-import Data.Kind as X  (Type, Constraint)-import Data.Maybe as X-import Data.Type.Bool as X-import Data.Type.Equality as X-import Text.Printf as X