HCodecs 0.4.2 → 0.5

raw patch · 13 files changed

+1207/−1267 lines, 13 filesdep ~QuickCheckdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

Files

• HCodecs.cabal +7/−7
• src/Codec/ByteString/Builder.hs +392/−0
• src/Codec/ByteString/Parser.hs +593/−0
• src/Codec/Internal/Arbitrary.hs +52/−0
• src/Codec/Internal/TestSuite.hs +117/−0
• src/Codec/Midi.hs +31/−31
• src/Codec/SoundFont.hs +8/−16
• src/Codec/Wav.hs +2/−2
• src/Data/Audio.hs +5/−7
• src/Internal/Arbitrary.hs +0/−101
• src/Internal/ByteString/Builder.hs +0/−392
• src/Internal/ByteString/Parser.hs +0/−593
• src/Internal/TestSuite.hs +0/−118

@@ -1,5 +1,5 @@ name: HCodecs-version: 0.4.2+version: 0.5 cabal-Version: >= 1.8 license: BSD3 license-file: LICENSE@@ -24,20 +24,20 @@ library   hs-source-dirs: src   ghc-options: -O3 -Wall-  build-depends: base < 5, bytestring, random, array >= 0.4, QuickCheck < 2+  build-depends: base < 5, bytestring, random, array >= 0.4, QuickCheck >= 2.0   exposed-modules:     Codec.Midi     Codec.Wav     Codec.SoundFont+    Codec.ByteString.Parser+    Codec.ByteString.Builder     Data.Audio   other-modules:-    Internal.ByteString.Parser-    Internal.ByteString.Builder-    Internal.Arbitrary+    Codec.Internal.Arbitrary  test-suite tests   type: exitcode-stdio-1.0   hs-source-dirs: src   ghc-options: -O3 -Wall-  build-depends: base < 5, bytestring, random, array >= 0.4, QuickCheck < 2-  main-is: Internal/TestSuite.hs+  build-depends: base < 5, bytestring, random, array >= 0.4, QuickCheck >= 2.0+  main-is: Codec/Internal/TestSuite.hs

@@ -0,0 +1,392 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Data.ByteString.Builder+-- Copyright   : Lennart Kolmodin, Ross Paterson, George Giorgidze+-- License     : BSD3+--+-- Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>+-- Stability   : experimental+-- Portability : Portable+--+-- Efficient construction of lazy bytestrings.+--+-----------------------------------------------------------------------------+module Codec.ByteString.Builder (++    -- * The Builder type+      Builder+    , toLazyByteString++    -- * Constructing Builders+    , empty+    , singleton+    , putWord8+    , putInt8+    , append+    , fromByteString        -- :: S.ByteString -> Builder+    , fromLazyByteString    -- :: L.ByteString -> Builder+    , putString++    -- * Flushing the buffer state+    , flush++    -- * Derived Builders+    -- ** Big-endian writes+    , putWord16be           -- :: Word16 -> Builder+    , putWord24be           -- :: Word32 -> Builder+    , putWord32be           -- :: Word32 -> Builder+    , putWord64be           -- :: Word64 -> Builder++    , putInt16be           -- :: Int16 -> Builder+    , putInt32be           -- :: Int32 -> Builder+    , putInt64be           -- :: Int64 -> Builder++    -- ** Little-endian writes+    , putWord16le           -- :: Word16 -> Builder+    , putWord24le           -- :: Word32 -> Builder+    , putWord32le           -- :: Word32 -> Builder+    , putWord64le           -- :: Word64 -> Builder++    , putInt16le           -- :: Int16 -> Builder+    , putInt32le           -- :: Int32 -> Builder+    , putInt64le           -- :: Int64 -> Builder++    -- ** Host-endian, unaligned writes+    , putWordHost           -- :: Word -> Builder+    , putWord16host         -- :: Word16 -> Builder+    , putWord32host         -- :: Word32 -> Builder+    , putWord64host         -- :: Word64 -> Builder+    -- Variable length numbers+    , putVarLenBe+    , putVarLenLe++  ) where+++import qualified Data.ByteString.Internal as S+import qualified Data.ByteString          as S+import qualified Data.ByteString.Lazy     as L++import Foreign.Storable         (Storable, poke, sizeOf)+import Foreign.Ptr              (Ptr, plusPtr)+import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr)+import System.IO.Unsafe         (unsafePerformIO)+import Data.ByteString.Internal (inlinePerformIO,c2w)++import Data.Bits+import Data.Word+import Data.Int+import Data.Monoid++------------------------------------------------------------------------++-- | A 'Builder' is an efficient way to build lazy 'L.ByteString's.+-- There are several functions for constructing 'Builder's, but only one+-- to inspect them: to extract any data, you have to turn them into lazy+-- 'L.ByteString's using 'toLazyByteString'.+--+-- Internally, a 'Builder' constructs a lazy 'L.Bytestring' by filling byte+-- arrays piece by piece.  As each buffer is filled, it is \'popped\'+-- off, to become a new chunk of the resulting lazy 'L.ByteString'.+-- All this is hidden from the user of the 'Builder'.++newtype Builder = Builder {+        -- Invariant (from Data.ByteString.Lazy):+        --      The lists include no null ByteStrings.+        runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString]+    }++instance Monoid Builder where+    mempty  = empty+    mappend = append++------------------------------------------------------------------------++-- | /O(1)./ The empty Builder, satisfying+--+--  * @'toLazyByteString' 'empty' = 'L.empty'@+--+empty :: Builder+empty = Builder id++-- | /O(1)./ A Builder taking a single byte, satisfying+--+--  * @'toLazyByteString' ('singleton' b) = 'L.singleton' b@+--+singleton :: Word8 -> Builder+singleton = writeN 1 . flip poke++putWord8 :: Word8 -> Builder+putWord8 = singleton+------------------------------------------------------------------------++-- | /O(1)./ The concatenation of two Builders, an associative operation+-- with identity 'empty', satisfying+--+--  * @'toLazyByteString' ('append' x y) = 'L.append' ('toLazyByteString' x) ('toLazyByteString' y)@+--+append :: Builder -> Builder -> Builder+append (Builder f) (Builder g) = Builder (f . g)++-- | /O(1)./ A Builder taking a 'S.ByteString', satisfying+--+--  * @'toLazyByteString' ('fromByteString' bs) = 'L.fromChunks' [bs]@+--+fromByteString :: S.ByteString -> Builder+fromByteString bs+  | S.null bs = empty+  | otherwise = flush `append` mapBuilder (bs :)++-- | /O(1)./ A Builder taking a lazy 'L.ByteString', satisfying+--+--  * @'toLazyByteString' ('fromLazyByteString' bs) = bs@+--+fromLazyByteString :: L.ByteString -> Builder+fromLazyByteString bss = flush `append` mapBuilder (L.toChunks bss ++)++putString :: String -> Builder+putString = fromLazyByteString . L.pack . map c2w++------------------------------------------------------------------------++-- Our internal buffer type+data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)+                     {-# UNPACK #-} !Int                -- offset+                     {-# UNPACK #-} !Int                -- used bytes+                     {-# UNPACK #-} !Int                -- length left++------------------------------------------------------------------------++-- | /O(n)./ Extract a lazy 'L.ByteString' from a 'Builder'.+-- The construction work takes place if and when the relevant part of+-- the lazy 'L.ByteString' is demanded.+--+toLazyByteString :: Builder -> L.ByteString+toLazyByteString m = L.fromChunks $ unsafePerformIO $ do+    buf <- newBuffer defaultSize+    return (runBuilder (m `append` flush) (const []) buf)++-- | /O(1)./ Pop the 'S.ByteString' we have constructed so far, if any,+-- yielding a new chunk in the result lazy 'L.ByteString'.+flush :: Builder+flush = Builder $ \ k buf@(Buffer p o u l) ->+    if u == 0+      then k buf+      else S.PS p o u : k (Buffer p (o+u) 0 l)++------------------------------------------------------------------------++--+-- copied from Data.ByteString.Lazy+--+defaultSize :: Int+defaultSize = 32 * k - overhead+    where k = 1024+          overhead = 2 * sizeOf (undefined :: Int)++------------------------------------------------------------------------++-- | Sequence an IO operation on the buffer+unsafeLiftIO :: (Buffer -> IO Buffer) -> Builder+unsafeLiftIO f =  Builder $ \ k buf -> inlinePerformIO $ do+    buf' <- f buf+    return (k buf')++-- | Get the size of the buffer+withSize :: (Int -> Builder) -> Builder+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->+    runBuilder (f l) k buf++-- | Map the resulting list of bytestrings.+mapBuilder :: ([S.ByteString] -> [S.ByteString]) -> Builder+mapBuilder f = Builder (f .)++------------------------------------------------------------------------++-- | Ensure that there are at least @n@ many bytes available.+ensureFree :: Int -> Builder+ensureFree n = n `seq` withSize $ \ l ->+    if n <= l then empty else+        flush `append` unsafeLiftIO (const (newBuffer (max n defaultSize)))++-- | Ensure that @n@ many bytes are available, and then use @f@ to write some+-- bytes into the memory.+writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder+writeN n f = ensureFree n `append` unsafeLiftIO (writeNBuffer n f)++writeNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer+writeNBuffer n f (Buffer fp o u l) = do+    withForeignPtr fp (\p -> f (p `plusPtr` (o+u)))+    return (Buffer fp o (u+n) (l-n))++newBuffer :: Int -> IO Buffer+newBuffer size = do+    fp <- S.mallocByteString size+    return $! Buffer fp 0 0 size++------------------------------------------------------------------------+-- Aligned, host order writes of storable values++-- | Ensure that @n@ many bytes are available, and then use @f@ to write some+-- storable values into the memory.+writeNbytes :: Storable a => Int -> (Ptr a -> IO ()) -> Builder+writeNbytes n f = ensureFree n `append` unsafeLiftIO (writeNBufferBytes n f)++writeNBufferBytes :: Storable a => Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer+writeNBufferBytes n f (Buffer fp o u l) = do+    withForeignPtr fp (\p -> f (p `plusPtr` (o+u)))+    return (Buffer fp o (u+n) (l-n))++------------------------------------------------------------------------++--+-- We rely on the fromIntegral to do the right masking for us.+-- The inlining here is critical, and can be worth 4x performance+--++-- | Write a Word16 in big endian format+putWord16be :: Word16 -> Builder+putWord16be w = writeN 2 $ \p -> do+    poke p               (fromIntegral (shiftR w 8) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (w)              :: Word8)++-- | Write a Word16 in little endian format+putWord16le :: Word16 -> Builder+putWord16le w = writeN 2 $ \p -> do+    poke p               (fromIntegral (w)              :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)++-- putWord16le w16 = writeN 2 (\p -> poke (castPtr p) w16)++-- | Write a 24 bit number in big endian format represented as Word32+putWord24be :: Word32 -> Builder+putWord24be w = writeN 3 $ \p -> do+    poke p               (fromIntegral (shiftR w 16) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (w) :: Word8)++-- | Write a 24 bit number in little endian format represented as Word32+putWord24le :: Word32 -> Builder+putWord24le w = writeN 3 $ \p -> do+    poke p               (fromIntegral (w)           :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftR w  8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)++-- | Write a Word32 in big endian format+putWord32be :: Word32 -> Builder+putWord32be w = writeN 4 $ \p -> do+    poke p               (fromIntegral (shiftR w 24) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftR w 16) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftR w  8) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (w)           :: Word8)++--+-- a data type to tag Put/Check. writes construct these which are then+-- inlined and flattened. matching Checks will be more robust with rules.+--++-- | Write a Word32 in little endian format+putWord32le :: Word32 -> Builder+putWord32le w = writeN 4 $ \p -> do+    poke p               (fromIntegral (w)               :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftR w  8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)++-- on a little endian machine:+-- putWord32le w32 = writeN 4 (\p -> poke (castPtr p) w32)++-- | Write a Word64 in big endian format+putWord64be :: Word64 -> Builder+putWord64be w = writeN 8 $ \p -> do+    poke p               (fromIntegral (shiftR w 56) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftR w 48) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftR w 40) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftR w 32) :: Word8)+    poke (p `plusPtr` 4) (fromIntegral (shiftR w 24) :: Word8)+    poke (p `plusPtr` 5) (fromIntegral (shiftR w 16) :: Word8)+    poke (p `plusPtr` 6) (fromIntegral (shiftR w  8) :: Word8)+    poke (p `plusPtr` 7) (fromIntegral (w)               :: Word8)++-- | Write a Word64 in little endian format+putWord64le :: Word64 -> Builder+putWord64le w = writeN 8 $ \p -> do+    poke p               (fromIntegral (w)               :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftR w  8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)+    poke (p `plusPtr` 4) (fromIntegral (shiftR w 32) :: Word8)+    poke (p `plusPtr` 5) (fromIntegral (shiftR w 40) :: Word8)+    poke (p `plusPtr` 6) (fromIntegral (shiftR w 48) :: Word8)+    poke (p `plusPtr` 7) (fromIntegral (shiftR w 56) :: Word8)++-- on a little endian machine:+-- putWord64le w64 = writeN 8 (\p -> poke (castPtr p) w64)++-----------------------------------------------------------------------++putInt8 :: Int8 -> Builder+putInt8 = putWord8 . fromIntegral++putInt16le :: Int16 -> Builder+putInt16le = putWord16le . fromIntegral++putInt16be :: Int16 -> Builder+putInt16be = putWord16be . fromIntegral++putInt32le :: Int32 -> Builder+putInt32le = putWord32le . fromIntegral++putInt32be :: Int32 -> Builder+putInt32be = putWord32be . fromIntegral++putInt64le :: Int64 -> Builder+putInt64le = putWord64le . fromIntegral++putInt64be :: Int64 -> Builder+putInt64be = putWord64be . fromIntegral++------------------------------------------------------------------------+-- Unaligned, word size ops++-- | /O(1)./ A Builder taking a single native machine word. The word is+-- written in host order, host endian form, for the machine you're on.+-- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine,+-- 4 bytes. Values written this way are not portable to+-- different endian or word sized machines, without conversion.+--+putWordHost :: Word -> Builder+putWordHost w = writeNbytes (sizeOf (undefined :: Word)) (\p -> poke p w)++-- | Write a Word16 in native host order and host endianness.+-- 2 bytes will be written, unaligned.+putWord16host :: Word16 -> Builder+putWord16host w16 = writeNbytes (sizeOf (undefined :: Word16)) (\p -> poke p w16)++-- | Write a Word32 in native host order and host endianness.+-- 4 bytes will be written, unaligned.+putWord32host :: Word32 -> Builder+putWord32host w32 = writeNbytes (sizeOf (undefined :: Word32)) (\p -> poke p w32)++-- | Write a Word64 in native host order.+-- On a 32 bit machine we write two host order Word32s, in big endian form.+-- 8 bytes will be written, unaligned.+putWord64host :: Word64 -> Builder+putWord64host w = writeNbytes (sizeOf (undefined :: Word64)) (\p -> poke p w)++------------------------------------------------------------------------++putVarLenBe :: Word64 -> Builder+putVarLenBe w = varLenAux2 $ reverse $ varLenAux1 w+  +putVarLenLe :: Word64 -> Builder+putVarLenLe w = varLenAux2 $ varLenAux1 w+  +varLenAux1 :: Word64 -> [Word8]+varLenAux1 0 = []+varLenAux1 w = (fromIntegral $ w .&. 0x7F) : (varLenAux1 $ shiftR w 7)++varLenAux2 :: [Word8] -> Builder+varLenAux2  [] = putWord8 0+varLenAux2  [w] = putWord8 w+varLenAux2 (w : ws) = putWord8 (setBit w 7) `append` varLenAux2 ws

@@ -0,0 +1,593 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Data.ByteString.Parser+-- Copyright   : Lennart Kolmodin, George Giorgidze+-- License     : BSD3+--+-- Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>+-- Stability   : experimental+-- Portability : Portable+--+-- A monad for efficiently building structures from+-- encoded lazy ByteStrings.+--+-----------------------------------------------------------------------------++module Codec.ByteString.Parser (++    -- * The Parser type+      Parser+    , runParser+    , runParserState++    -- * Parsing+    , choice+    , expect+    , skip+    , lookAhead+    , lookAheadM+    , lookAheadE++    -- * Utility+    , bytesRead+    , getBytes+    , remaining+    , isEmpty++    -- * Parsing particular types+    , satisfy+    , getString+    , getStringNul+    , string+    , getWord8+    , getInt8+    , word8+    , int8++    -- ** ByteStrings+    , getByteString+    , getLazyByteString+    , getLazyByteStringNul+    , getRemainingLazyByteString++    -- ** Big-endian reads+    , getWord16be+    , word16be+    , getWord24be+    , word24be+    , getWord32be+    , word32be+    , getWord64be+    , word64be++    , getInt16be+    , int16be+    , getInt32be+    , int32be+    , getInt64be+    , int64be++    -- ** Little-endian reads+    , getWord16le+    , word16le+    , getWord24le+    , word24le+    , getWord32le+    , word32le+    , getWord64le+    , word64le++    , getInt16le+    , int16le+    , getInt32le+    , int32le+    , getInt64le+    , int64le++    -- ** Host-endian, unaligned reads+    , getWordHost+    , wordHost+    , getWord16host+    , word16host+    , getWord32host+    , word32host+    , getWord64host+    , word64host++    -- Variable length reads+    , getVarLenBe+    , varLenBe+    , getVarLenLe+    , varLenLe+  ) where++import qualified Data.ByteString               as B+import qualified Data.ByteString.Lazy          as L+import qualified Data.ByteString.Internal      as B+import qualified Data.ByteString.Lazy.Internal as L++import Foreign.Storable        (Storable, peek, sizeOf)+import Foreign.Ptr             (plusPtr, castPtr)+import Foreign.ForeignPtr      (withForeignPtr)+import Control.Monad.ST        (runST)+import Control.Monad.ST.Unsafe (unsafeInterleaveST)++import Control.Monad+import Control.Applicative+import Data.STRef+import Data.Word+import Data.Int+import Data.Bits+import Data.Maybe++-- | The parse state+data S = S {-# UNPACK #-} !B.ByteString  -- current chunk+           L.ByteString                  -- the rest of the input+           {-# UNPACK #-} !Int64         -- bytes read++-- | The Get monad is just a State monad carrying around the input ByteString+newtype Parser a = Parser { unParser :: S -> Either String (a, S) }++instance Functor Parser where+    fmap f m = Parser $ \s -> case unParser m s of+      Left e -> Left e+      Right (a, s') -> Right (f a, s')+    +instance Monad Parser where+    return a  = Parser (\s -> Right (a, s))+    m >>= k   = Parser $ \s -> case (unParser m) s of+      Left e -> Left e+      Right (a, s') -> (unParser (k a)) s'+    fail  err  = Parser $ \(S _ _ bytes) ->+        Left (err ++ ". Failed reading at byte position " ++ show bytes)+instance MonadPlus Parser where+  mzero = Parser $ \_ -> Left []+  mplus p1 p2 = Parser $ \s -> case (unParser p1 s) of+    Left e1 -> case (unParser p2 s) of+      Left e2 -> Left (e1 ++ "\n" ++ e2)+      ok -> ok+    ok -> ok++instance Applicative Parser where+  pure  = return+  (<*>) = ap+  +instance Alternative Parser where+  empty = mzero+  (<|>) = mplus++------------------------------------------------------------------------++get :: Parser S+get   = Parser $ \s -> Right (s, s)++put :: S -> Parser ()+put s = Parser $ \_ -> Right ((), s)++------------------------------------------------------------------------++initState :: L.ByteString -> S+initState xs = mkState xs 0++mkState :: L.ByteString -> Int64 -> S+mkState l = case l of+    L.Empty      -> S B.empty L.empty+    L.Chunk x xs -> S x xs++-- | Run the Get monad applies a 'get'-based parser on the input ByteString+runParser :: Parser a -> L.ByteString -> Either String a+runParser m str = case unParser m (initState str) of+  Left e -> Left e+  Right (a, _) -> Right a++-- | Run the Get monad applies a 'get'-based parser on the input+-- ByteString. Additional to the result of get it returns the number of+-- consumed bytes and the rest of the input.+runParserState :: Parser a -> L.ByteString -> Int64 -> Either String (a, L.ByteString, Int64)+runParserState m str off =+    case unParser m (mkState str off) of+      Left e -> Left e+      Right (a, ~(S s ss newOff)) -> Right (a, s `bsJoin` ss, newOff)++------------------------------------------------------------------------++choice :: [Parser a] -> Parser a+choice = foldl (<|>) mzero++-- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.+skip :: Word64 -> Parser ()+skip n = readN (fromIntegral n) (const ())++-- | Run @ga@, but return without consuming its input.+-- Fails if @ga@ fails.+lookAhead :: Parser a -> Parser a+lookAhead ga = do+    s <- get+    a <- ga+    put s+    return a++-- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'.+-- Fails if @gma@ fails.+lookAheadM :: Parser (Maybe a) -> Parser (Maybe a)+lookAheadM gma = do+    s <- get+    ma <- gma+    when (isNothing ma) $ put s+    return ma++-- | Like 'lookAhead', but consume the input if @gea@ returns 'Right _'.+-- Fails if @gea@ fails.+lookAheadE :: Parser (Either a b) -> Parser (Either a b)+lookAheadE gea = do+    s <- get+    ea <- gea+    case ea of+        Left _ -> put s+        _      -> return ()+    return ea++expect :: (Show a, Eq a) => (a -> Bool) -> Parser a -> Parser a+expect f p = do+  v <- p+  when (not $ f v) $ fail $ show v ++ " was not expected."+  return v++getString :: Int -> Parser String+getString l = do+  bs <- getLazyByteString (fromIntegral l)+  return $! map B.w2c (L.unpack bs)++getStringNul :: Parser String+getStringNul = do+  bs <- getLazyByteStringNul+  return $! map B.w2c (L.unpack bs)++string :: String -> Parser String+string s = expect (s ==) (getString $ length s)++-- Utility++-- | Get the total number of bytes read to this point.+bytesRead :: Parser Int64+bytesRead = do+    S _ _ b <- get+    return b++-- | Get the number of remaining unparsed bytes.+-- Useful for checking whether all input has been consumed.+-- Note that this forces the rest of the input.+remaining :: Parser Int64+remaining = do+    S s ss _ <- get+    return $! (fromIntegral (B.length s) + L.length ss)++-- | Test whether all input has been consumed,+-- i.e. there are no remaining unparsed bytes.+isEmpty :: Parser Bool+isEmpty = do+    S s ss _ <- get+    return $! (B.null s && L.null ss)++------------------------------------------------------------------------+-- Utility with ByteStrings++-- | An efficient 'get' method for strict ByteStrings. Fails if fewer+-- than @n@ bytes are left in the input.+getByteString :: Int -> Parser B.ByteString+getByteString n = readN n id++-- | An efficient 'get' method for lazy ByteStrings. Does not fail if fewer than+-- @n@ bytes are left in the input.+getLazyByteString :: Int64 -> Parser L.ByteString+getLazyByteString n = do+    S s ss bytes <- get+    let big = s `bsJoin` ss+    case splitAtST n big of+      (consume, rest) -> do put $ mkState rest (bytes + n)+                            return consume++-- | Get a lazy ByteString that is terminated with a NUL byte. Fails+-- if it reaches the end of input without hitting a NUL.+getLazyByteStringNul :: Parser L.ByteString+getLazyByteStringNul = do+    S s ss bytes <- get+    let big = s `bsJoin` ss+        (consume, t) = L.break (== 0) big+        (h, rest) = L.splitAt 1 t+    when (L.null h) $ fail "too few bytes"+    put $ mkState rest (bytes + L.length consume + 1)+    return consume++-- | Get the remaining bytes as a lazy ByteString+getRemainingLazyByteString :: Parser L.ByteString+getRemainingLazyByteString = do+    S s ss _ <- get+    return $! (s `bsJoin` ss)++------------------------------------------------------------------------+-- Helpers++-- | Pull @n@ bytes from the input, as a strict ByteString.+getBytes :: Int -> Parser B.ByteString+getBytes n = do+    S s ss bytes <- get+    if n <= B.length s+        then do let (consume,rest) = B.splitAt n s+                put $! S rest ss (bytes + fromIntegral n)+                return $! consume+        else+              case L.splitAt (fromIntegral n) (s `bsJoin` ss) of+                (consuming, rest) ->+                    do let now = B.concat . L.toChunks $ consuming+                       put $! mkState rest (bytes + fromIntegral n)+                       -- forces the next chunk before this one is returned+                       when (B.length now < n) $ fail "too few bytes"+                       return now++bsJoin :: B.ByteString -> L.ByteString -> L.ByteString+bsJoin bb lb+    | B.null bb = lb+    | otherwise = L.Chunk bb lb++-- | Split a ByteString. If the first result is consumed before the --+-- second, this runs in constant heap space.+--+-- You must force the returned tuple for that to work, e.g.+--+-- > case splitAtST n xs of+-- >    (ys,zs) -> consume ys ... consume zs+--+splitAtST :: Int64 -> L.ByteString -> (L.ByteString, L.ByteString)+splitAtST i ps | i <= 0 = (L.empty, ps)+splitAtST i ps          = runST (+     do r  <- newSTRef undefined+        xs <- first r i ps+        ys <- unsafeInterleaveST (readSTRef r)+        return (xs, ys))++  where+        first r 0 xs@(L.Chunk _ _) = writeSTRef r xs    >> return L.Empty+        first r _ L.Empty          = writeSTRef r L.Empty >> return L.Empty++        first r n (L.Chunk x xs)+          | n < l     = do writeSTRef r (L.Chunk (B.drop (fromIntegral n) x) xs)+                           return $! L.Chunk (B.take (fromIntegral n) x) L.Empty+          | otherwise = do writeSTRef r (L.drop (n - l) xs)+                           liftM (L.Chunk x) $ unsafeInterleaveST (first r (n - l) xs)++         where l = fromIntegral (B.length x)++-- Pull n bytes from the input, and apply a parser to those bytes,+-- yielding a value. If less than @n@ bytes are available, fail with an+-- error. This wraps @getBytes@.+readN :: Int -> (B.ByteString -> a) -> Parser a+readN n f = fmap f $ getBytes n+++------------------------------------------------------------------------+-- Primtives++-- helper, get a raw Ptr onto a strict ByteString copied out of the+-- underlying lazy byteString. So many indirections from the raw parser+-- state that my head hurts...++getPtr :: Storable a => Int -> Parser a+getPtr n = do+    (fp,o,_) <- readN n B.toForeignPtr+    return . B.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)++------------------------------------------------------------------------++satisfy :: (Word8 -> Bool) -> Parser Word8+satisfy f = do+  w <- getWord8+  guard (f w)+  return w++-- | Read a Word8 from the monad state+getWord8 :: Parser Word8+getWord8 = getPtr (sizeOf (undefined :: Word8))++word8 :: Word8 -> Parser Word8+word8 w = expect (w ==) getWord8++-- | Read a Word16 in big endian format+getWord16be :: Parser Word16+getWord16be = do+    s <- readN 2 id+    return $! (fromIntegral (s `B.index` 0) `shiftL` 8) .|.+              (fromIntegral (s `B.index` 1))++word16be :: Word16 -> Parser Word16+word16be w = expect (w ==) getWord16be++-- | Read a Word16 in little endian format+getWord16le :: Parser Word16+getWord16le = do+    s <- readN 2 id+    return $! (fromIntegral (s `B.index` 1) `shiftL` 8) .|.+              (fromIntegral (s `B.index` 0) )++word16le :: Word16 -> Parser Word16+word16le w = expect (w ==) getWord16le++-- | Read a 24 bit word into Word32 in big endian format+getWord24be :: Parser Word32+getWord24be = do+    s <- readN 3 id+    return $! (fromIntegral (s `B.index` 0) `shiftL` 16) .|.+              (fromIntegral (s `B.index` 1) `shiftL`  8) .|.+              (fromIntegral (s `B.index` 2) )++word24be :: Word32 -> Parser Word32+word24be w = expect (w ==) getWord24be++getWord24le :: Parser Word32+getWord24le = do+    s <- readN 3 id+    return $! (fromIntegral (s `B.index` 2) `shiftL` 16) .|.+              (fromIntegral (s `B.index` 1) `shiftL`  8) .|.+              (fromIntegral (s `B.index` 0) )++word24le :: Word32 -> Parser Word32+word24le w = expect (w ==) getWord24le++-- | Read a Word32 in big endian format+getWord32be :: Parser Word32+getWord32be = do+    s <- readN 4 id+    return $! (fromIntegral (s `B.index` 0) `shiftL` 24) .|.+              (fromIntegral (s `B.index` 1) `shiftL` 16) .|.+              (fromIntegral (s `B.index` 2) `shiftL`  8) .|.+              (fromIntegral (s `B.index` 3) )++word32be :: Word32 -> Parser Word32+word32be w = expect (w ==) getWord32be++-- | Read a Word32 in little endian format+getWord32le :: Parser Word32+getWord32le = do+    s <- readN 4 id+    return $! (fromIntegral (s `B.index` 3) `shiftL` 24) .|.+              (fromIntegral (s `B.index` 2) `shiftL` 16) .|.+              (fromIntegral (s `B.index` 1) `shiftL`  8) .|.+              (fromIntegral (s `B.index` 0) )++word32le :: Word32 -> Parser Word32+word32le w = expect (w ==) getWord32le+++-- | Read a Word64 in big endian format+getWord64be :: Parser Word64+getWord64be = do+    s <- readN 8 id+    return $! (fromIntegral (s `B.index` 0) `shiftL` 56) .|.+              (fromIntegral (s `B.index` 1) `shiftL` 48) .|.+              (fromIntegral (s `B.index` 2) `shiftL` 40) .|.+              (fromIntegral (s `B.index` 3) `shiftL` 32) .|.+              (fromIntegral (s `B.index` 4) `shiftL` 24) .|.+              (fromIntegral (s `B.index` 5) `shiftL` 16) .|.+              (fromIntegral (s `B.index` 6) `shiftL`  8) .|.+              (fromIntegral (s `B.index` 7) )++word64be :: Word64 -> Parser Word64+word64be w = expect (w ==) getWord64be++-- | Read a Word64 in little endian format+getWord64le :: Parser Word64+getWord64le = do+    s <- readN 8 id+    return $! (fromIntegral (s `B.index` 7) `shiftL` 56) .|.+              (fromIntegral (s `B.index` 6) `shiftL` 48) .|.+              (fromIntegral (s `B.index` 5) `shiftL` 40) .|.+              (fromIntegral (s `B.index` 4) `shiftL` 32) .|.+              (fromIntegral (s `B.index` 3) `shiftL` 24) .|.+              (fromIntegral (s `B.index` 2) `shiftL` 16) .|.+              (fromIntegral (s `B.index` 1) `shiftL`  8) .|.+              (fromIntegral (s `B.index` 0) )++word64le :: Word64 -> Parser Word64+word64le w = expect (w ==) getWord64le+------------------------------------------------------------------------+getInt8 :: Parser Int8+getInt8 = getWord8 >>= return . fromIntegral++int8 :: Int8 -> Parser Int8+int8 i = expect (i ==) getInt8++getInt16le :: Parser Int16+getInt16le = getWord16le >>= return . fromIntegral++int16le :: Int16 -> Parser Int16+int16le i = expect (i ==) getInt16le++getInt16be :: Parser Int16+getInt16be = getWord16be >>= return . fromIntegral++int16be :: Int16 -> Parser Int16+int16be i = expect (i ==) getInt16be++getInt32le :: Parser Int32+getInt32le = getWord32le >>= return . fromIntegral++int32le :: Int32 -> Parser Int32+int32le i = expect (i ==) getInt32le++getInt32be :: Parser Int32+getInt32be = getWord32be >>= return . fromIntegral++int32be :: Int32 -> Parser Int32+int32be i = expect (i ==) getInt32be++getInt64le :: Parser Int64+getInt64le = getWord64le >>= return . fromIntegral++int64le :: Int64 -> Parser Int64+int64le i = expect (i ==) getInt64le++getInt64be :: Parser Int64+getInt64be = getWord64be >>= return . fromIntegral++int64be :: Int64 -> Parser Int64+int64be i = expect (i ==) getInt64be++------------------------------------------------------------------------+-- Host-endian reads++-- | /O(1)./ Read a single native machine word. The word is read in+-- host order, host endian form, for the machine you're on. On a 64 bit+-- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes.+getWordHost :: Parser Word+getWordHost = getPtr (sizeOf (undefined :: Word))++wordHost :: Word -> Parser Word+wordHost w = expect (w ==) getWordHost++-- | /O(1)./ Read a 2 byte Word16 in native host order and host endianness.+getWord16host :: Parser Word16+getWord16host = getPtr (sizeOf (undefined :: Word16))++word16host :: Word16 -> Parser Word16+word16host w = expect (w ==) getWord16host++-- | /O(1)./ Read a Word32 in native host order and host endianness.+getWord32host :: Parser Word32+getWord32host = getPtr  (sizeOf (undefined :: Word32))++word32host :: Word32 -> Parser Word32+word32host w = expect (w ==) getWord32host++-- | /O(1)./ Read a Word64 in native host order and host endianess.+getWord64host   :: Parser Word64+getWord64host = getPtr  (sizeOf (undefined :: Word64))++word64host :: Word64 -> Parser Word64+word64host w = expect (w ==) getWord64host++-- Variable length numbers++getVarLenBe :: Parser Word64+getVarLenBe = f 0+  where+  f :: Word64 -> Parser Word64+  f acc =  do+    w <- getWord8 >>= return . fromIntegral+    if testBit w 7+      then f      $! (shiftL acc 7) .|. (clearBit w 7)+      else return $! (shiftL acc 7) .|. w++varLenBe :: Word64 -> Parser Word64+varLenBe a = expect (a ==) getVarLenBe++getVarLenLe :: Parser Word64+getVarLenLe = do+  w <- getWord8 >>= return . fromIntegral+  if testBit w 7+    then do+      w' <- getVarLenLe+      return $! (clearBit w 7) .|. (shiftL w' 7)+    else return $! w++varLenLe :: Word64 -> Parser Word64+varLenLe a = expect (a ==) getVarLenLe

@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Arbitrary+-- Copyright   : George Giorgidze+-- License     : BSD3+--+-- Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>+-- Stability   : Experimental+-- Portability : Portable+--+-- Additional instances of the 'Arbitrary' type class defined in 'Test.QuickCheck'.+-- Some portions of code were copied from the test suite of 'binary' package.+--+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Codec.Internal.Arbitrary (+    arrayGen+  , stringNulGen+  ) where++import qualified Data.ByteString      as B+import qualified Data.ByteString.Lazy as L++import Test.QuickCheck+import Data.Array.IArray+import Data.List+import Data.Word+import Data.Char++instance Arbitrary L.ByteString where+  arbitrary = arbitrary >>= return . L.fromChunks . filter (not. B.null)++instance Arbitrary B.ByteString where+  arbitrary = B.pack `fmap` arbitrary+  +instance (Arbitrary e, Num i, IArray Array e, Ix i) =>  Arbitrary (Array i e) where+  arbitrary = do+    n <- choose (1, 128)+    arrayGen n++arrayGen :: (Arbitrary e, Num i, IArray a e, Ix i) => Word -> Gen (a i e)+arrayGen 0 = error "Array with 0 elements can not be defined"+arrayGen n = do+  es <- vector (fromIntegral n)+  return $! listArray (0 , fromIntegral $ n - 1) es+  +stringNulGen :: Word -> Gen String+stringNulGen n = do+  sequence $ genericReplicate n $ choose (1,255) >>= return . chr

@@ -0,0 +1,117 @@+module Main (main) where++import qualified Codec.Wav as Wav+import qualified Codec.SoundFont as SF+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L++import Test.QuickCheck (quickCheck, (==>))++import Data.Audio+import Codec.Midi+import Codec.ByteString.Parser+import Codec.ByteString.Builder++import Data.Int+import Data.Word+import Data.Bits+import Data.Monoid+import Debug.Trace++roundTrip :: (Eq a, Show a) => (a -> Builder) -> Parser a -> a -> Bool+roundTrip b p a = if Right a == ea'+  then True+  else trace (unlines $ [show ea']) $ False+  where ea' = runParser p bs+        bs = toLazyByteString $ b a++testAudio :: IO ()+testAudio = do+  putStrLn "TESTING Inctances of Audible"+  quickCheck (prop_audible :: Word8 -> Bool)+  quickCheck (prop_audible :: Word16 -> Bool)+  quickCheck (prop_audible :: Word32 -> Bool)+  -- quickCheck (prop_audible :: Word64 -> Bool)+  quickCheck (prop_audible :: Int8 -> Bool)+  quickCheck (prop_audible :: Int16 -> Bool)+  quickCheck (prop_audible :: Int32 -> Bool)+  -- quickCheck (prop_audible :: Int64 -> Bool)++  -- These two tests are commented, because they fail+  -- Reason for that is the fact that Double is not abble to accomodate+  -- 64 bit numbers in full precision+  where+  prop_audible :: (Eq a, Audible a) => a -> Bool+  prop_audible a = (a ==  fromSample s) && (s >= -1.0) && (s <= 1.0)+    where s = toSample a++testMidi :: IO ()+testMidi =  do+  putStrLn "TESTING PARSING AND BUILDING of Midi"++  quickCheck $ roundTrip buildMessage (parseMessage Nothing)+  quickCheck $ roundTrip buildMidi parseMidi+  quickCheck $ \trk -> trk == fromAbsTime (toAbsTime trk :: Track Ticks)+  quickCheck $ \trk td -> trk == fromRealTime td (toRealTime td trk)++  quickCheck $ \m -> (not $ null $ tracks m) ==>+                       let (Midi SingleTrack _ trks) = toSingleTrack m+                       in  length (concat $ tracks m) - length (concat trks) == length (tracks m) - 1++testWav :: IO ()+testWav =  do+  putStrLn "TESTING PARSING AND BUILDING of Wav"+  quickCheck $ roundTrip (Wav.buildWav :: Audio Word8 -> Builder) Wav.parseWav+  quickCheck $ roundTrip (Wav.buildWav :: Audio Int16 -> Builder) Wav.parseWav+  quickCheck $ roundTrip (Wav.buildWav :: Audio Int32 -> Builder) Wav.parseWav++testSoundFont :: IO ()+testSoundFont =  do+  putStrLn "TESTING PARSING AND BUILDING of SoundFont"+  quickCheck $ roundTrip SF.buildSoundFont SF.parseSoundFont++testParserBuilder :: IO ()+testParserBuilder = do+  putStrLn "TESTING PARSING AND BUILDING OF NUMERICAL TYPES"++  quickCheck $ roundTrip putWord8 getWord8+  quickCheck $ roundTrip putWord16be getWord16be+  quickCheck $ roundTrip putWord16le getWord16le+  quickCheck $ \w -> roundTrip putWord24be getWord24be (w .&. 0xFFFFFF)+  quickCheck $ \w -> roundTrip putWord24le getWord24le (w .&. 0xFFFFFF)+  quickCheck $ roundTrip putWord32be getWord32be+  quickCheck $ roundTrip putWord32le getWord32le+  quickCheck $ roundTrip putWord64be getWord64be+  quickCheck $ roundTrip putWord64le getWord64le++  quickCheck $ roundTrip putInt8 getInt8+  quickCheck $ roundTrip putInt16be getInt16be+  quickCheck $ roundTrip putInt16le getInt16le+  quickCheck $ roundTrip putInt32be getInt32be+  quickCheck $ roundTrip putInt32le getInt32le+  quickCheck $ roundTrip putInt64be getInt64be+  quickCheck $ roundTrip putInt64le getInt64le++  quickCheck $ roundTrip putWordHost getWordHost+  quickCheck $ roundTrip putWord16host getWord16host+  quickCheck $ roundTrip putWord32host getWord32host+  quickCheck $ roundTrip putWord64host getWord64host++  quickCheck $ roundTrip putVarLenBe getVarLenBe+  quickCheck $ roundTrip putVarLenLe getVarLenLe++  putStrLn "TESTING PARSING AND BUILDING OF String and ByteString"++  quickCheck $ \s1 s2 -> roundTrip (\s -> putString s `mappend` putString s2) (getString $ length s1) s1+  quickCheck $ \s1 s2 -> roundTrip (\s -> fromByteString s `mappend` fromByteString s2) (getByteString $ B.length s1) s1+  quickCheck $ \s1 s2 -> roundTrip (\s -> fromLazyByteString s `mappend` fromLazyByteString s2) (getLazyByteString $  L.length s1) s1+  quickCheck $ \bs -> roundTrip fromLazyByteString getRemainingLazyByteString bs+++main :: IO ()+main = do+  testAudio+  testParserBuilder+  testMidi+  testWav+  testSoundFont

@@ -3,7 +3,7 @@ -- Module      : Codec.Midi -- Copyright   : George Giorgidze -- License     : BSD3--- +-- -- Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/> -- Stability   : Experimental -- Portability : Portable@@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module Codec.Midi +module Codec.Midi   (     Midi (..)   , FileType (..)@@ -29,7 +29,7 @@   , Preset   , Bank   , PitchWheel-  , Tempo +  , Tempo      , isNoteOff   , isNoteOn@@ -62,21 +62,22 @@   )    where -import Internal.ByteString.Parser-import Internal.ByteString.Builder-import Internal.Arbitrary ()+import qualified Data.ByteString.Lazy as L +import Test.QuickCheck (Arbitrary, arbitrary, choose, oneof)++import Codec.ByteString.Parser+import Codec.ByteString.Builder+import Codec.Internal.Arbitrary ()+ import Data.Word-import qualified Data.ByteString.Lazy as L import Data.Bits import Data.Maybe import Data.List import Data.Monoid import Control.Applicative import Control.Monad-import Test.QuickCheck - data Midi = Midi {     fileType :: FileType   , timeDiv :: TimeDiv@@ -95,15 +96,13 @@         trks <- arbitrary >>= return . map fAux         return $! Midi ft td trks     where-    fAux = (++ [(0,TrackEnd)]) . map (\(dt,m) -> (abs dt,m)) . removeTrackEnds -  coarbitrary = undefined+    fAux = (++ [(0,TrackEnd)]) . map (\(dt,m) -> (abs dt,m)) . removeTrackEnds  data FileType = SingleTrack | MultiTrack | MultiPattern   deriving (Eq, Show)  instance Arbitrary FileType where   arbitrary = oneof [return SingleTrack , return MultiTrack , return MultiPattern]-  coarbitrary = undefined    type Track a = [(a,Message)] @@ -117,7 +116,6 @@   arbitrary = oneof [       choose (1,2 ^ (15 :: Int) - 1) >>= return . TicksPerBeat     , two (choose (1,127)) >>= \(w1,w2) -> return $! TicksPerSecond w1 w2]-  coarbitrary = undefined  type Ticks = Int -- 0 - (2^28 - 1) type Time = Double@@ -129,7 +127,7 @@ type Preset = Int	-- 0 - 127 type Bank = Int type PitchWheel = Int	-- 0 - (2^14 - 1)-type Tempo = Int -- microseconds per beat  1 - (2^24 - 1) +type Tempo = Int -- microseconds per beat  1 - (2^24 - 1)  data Message = -- Channel Messages@@ -141,7 +139,7 @@   ChannelPressure { channel :: !Channel, pressure :: !Pressure } |   PitchWheel      { channel :: !Channel, pitchWheel :: !PitchWheel } | -- Meta Messages-  SequenceNumber !Int | -- 0 - (2^16 - 1) +  SequenceNumber !Int | -- 0 - (2^16 - 1)   Text !String |   Copyright !String |   TrackName !String |@@ -172,7 +170,7 @@       , two (choose (0,127))  >>= \(w2,w3) -> return $! KeyPressure c w2 w3       , two (choose (0,127))  >>= \(w2,w3) -> return $! ControlChange c w2 w3       , choose (0,127)        >>= \w2      -> return $! ProgramChange c w2-      , choose (0,127)        >>= \w2      -> return $! ChannelPressure c w2 +      , choose (0,127)        >>= \w2      -> return $! ChannelPressure c w2       , do p <- choose (0,2 ^ (14 :: Int) - 1)            return $! PitchWheel c p       -- Meta Messages@@ -207,7 +205,6 @@       , do w <- oneof [return 0xF0, return 0xF7]            bs <- arbitrary            return $! Sysex w bs]-  coarbitrary = undefined  isNoteOff :: Message -> Bool isNoteOff (NoteOff {}) = True@@ -295,19 +292,19 @@ toAbsTime trk = zip ts' ms   where   (ts,ms) = unzip trk-  (_,ts') = mapAccumL (\acc t -> let t' = acc + t in (t',t')) 0 ts +  (_,ts') = mapAccumL (\acc t -> let t' = acc + t in (t',t')) 0 ts    fromAbsTime :: (Num a) => Track a -> Track a-fromAbsTime trk = zip ts' ms +fromAbsTime trk = zip ts' ms   where   (ts,ms) = unzip trk-  (_,ts') = mapAccumL (\acc t -> (t,t - acc)) 0 ts +  (_,ts') = mapAccumL (\acc t -> (t,t - acc)) 0 ts  toRealTime :: TimeDiv -> Track Ticks -> Track Time toRealTime (TicksPerBeat tpb) trk = trk'   where   (_,trk') = mapAccumL f (div 60000000 120) trk -- default tempo 120 beats per minute-  formula dt tempo = +  formula dt tempo =     (fromIntegral dt / fromIntegral tpb) * (fromIntegral tempo) * (1.0E-6)   f :: Tempo -> (Ticks,Message) -> (Tempo, (Time,Message))   f _ (dt, TempoChange tempo) = (tempo, (formula dt tempo, TempoChange tempo))@@ -320,7 +317,7 @@ fromRealTime (TicksPerBeat tpb) trk = trk'   where   (_,trk') = mapAccumL f (div 60000000 120) trk -- default tempo 120 beats per minute-  formula dt tempo = round $ +  formula dt tempo = round $     (dt * fromIntegral tpb) / (fromIntegral tempo * 1.0E-6)   f :: Tempo -> (Time,Message) -> (Tempo, (Ticks,Message))   f _ (dt, TempoChange tempo) = (tempo, (formula dt tempo, TempoChange tempo))@@ -329,7 +326,7 @@   where   f (dt,msg) = (round $ dt * fromIntegral fps * fromIntegral tpf, msg) --- MIDI import +-- MIDI import importFile :: FilePath -> IO (Either String Midi) importFile f = do   bs <- L.readFile f@@ -338,7 +335,7 @@ exportFile :: FilePath -> Midi ->  IO () exportFile f m = do   let bs = toLazyByteString $ buildMidi m-  L.writeFile f bs +  L.writeFile f bs  -- All numeric values are stored in big-endian format @@ -371,7 +368,7 @@     putString "MThd"   , putWord32be 6   , case fileType m of-      SingleTrack -> putWord16be 0 +      SingleTrack -> putWord16be 0       MultiTrack -> putWord16be 1       MultiPattern -> putWord16be 2   , putWord16be (fromIntegral $ length $ tracks m)@@ -385,7 +382,7 @@ parseTrack :: Parser (Track Ticks) parseTrack = do   _ <- string "MTrk"-  _ <- getWord32be -- trackSize +  _ <- getWord32be -- trackSize   track' <- parseMessages Nothing   return track'  @@ -395,12 +392,12 @@   , putWord32be $ fromIntegral $ L.length bs   , fromLazyByteString bs]   where-  f (dt,msg) = (putVarLenBe $ fromIntegral dt) `append` buildMessage msg +  f (dt,msg) = (putVarLenBe $ fromIntegral dt) `append` buildMessage msg   bs = toLazyByteString $ mconcat (map f trk)  parseMessages :: Maybe Message -> Parser (Track Ticks) parseMessages mPreMsg = do-  dt <- getVarLenBe >>= return . fromIntegral +  dt <- getVarLenBe >>= return . fromIntegral   msg <- parseMessage mPreMsg   if (isTrackEnd msg)     then return [(dt,msg)]@@ -539,7 +536,7 @@   case msg of     SequenceNumber i -> mconcat       [putWord8 0x00, putVarLenBe 2, putWord16be $ fromIntegral $ i]-    Text s -> mconcat +    Text s -> mconcat       [putWord8 0x01, putVarLenBe (fromIntegral $ length s), putString s]     Copyright s -> mconcat       [putWord8 0x02, putVarLenBe (fromIntegral $ length s), putString s]@@ -579,7 +576,7 @@         putWord8 (fromIntegral w)       , putVarLenBe (fromIntegral $ L.length bs)       , fromLazyByteString bs]-    _ -> mempty  +    _ -> mempty  parseSequenceNumber :: Parser Message parseSequenceNumber = do@@ -675,7 +672,7 @@ parseSMPTEOffset = do   _ <- word8 0x54   _ <- varLenBe 5-  bs <- getLazyByteString 5 +  bs <- getLazyByteString 5   let [n1,n2,n3,n4,n5] = map fromIntegral (L.unpack bs)   return $! SMPTEOffset n1 n2 n3 n4 n5 @@ -715,3 +712,6 @@           , putVarLenBe $ fromIntegral $ L.length bs           , fromLazyByteString bs] buildSysexMessage _ = mempty++two :: Applicative f => f a -> f (a,a)+two a = pure ((,)) <*> a <*> a

@@ -37,9 +37,9 @@   , buildPdta   )  where -import Internal.ByteString.Parser-import Internal.ByteString.Builder-import Internal.Arbitrary+import Codec.ByteString.Parser+import Codec.ByteString.Builder+import Codec.Internal.Arbitrary import qualified Data.Audio as Audio  import Data.Word@@ -65,7 +65,6 @@   arbitrary = do     f1 <- arbitrary; f2 <- arbitrary; f3 <- arbitrary;     return $! SoundFont f1 f2 f3-  coarbitrary = undefined  -- instance Show SoundFont where --   show sf = (show $ length $ elems $ sampleData sf) ++ "\n" ++ (show $ length $ show $ articulation sf) ++ "\n"@@ -90,13 +89,15 @@  instance Arbitrary Info where   arbitrary = oneof [-      do (w1,w2) <- two $ choose (minBound :: Word16, maxBound);+      do w1 <- choose (minBound :: Word16, maxBound)+         w2 <- choose (minBound :: Word16, maxBound)          return $ Version (fromIntegral w1) (fromIntegral w2);     , do l <- choose (0,255); s <- genStringNul l; return  $ TargetSoundEngine s     , do l <- choose (0,255); s <- genStringNul l; return  $ BankName s     , do l <- choose (0,255); s <- genStringNul l; return  $ RomName s-    , do (w1,w2) <- two $ choose (minBound :: Word16, maxBound);-         return $ RomVersion (fromIntegral w1) (fromIntegral w2);+    , do w1 <- choose (minBound :: Word16, maxBound)+         w2 <- choose (minBound :: Word16, maxBound)+         return $ RomVersion (fromIntegral w1) (fromIntegral w2)     , do l <- choose (0,255); s <- genStringNul l; return  $ CreationDate s     , do l <- choose (0,255); s <- genStringNul l; return  $ Authors s     , do l <- choose (0,255); s <- genStringNul l; return  $ IntendedProduct s@@ -108,7 +109,6 @@     where     genStringNul :: Int -> Gen String      genStringNul l = sequence $ replicate l $ fmap w2c $ choose (1,255)-  coarbitrary = undefined  data Sdta = Sdta {     smpl :: Audio.SampleData Int16@@ -124,7 +124,6 @@       , do sm24' <- arrayGen sn            return $! Sdta smpl1 (Just sm24')       ]-  coarbitrary = undefined  data Pdta = Pdta {     phdrs :: Array Word Phdr@@ -144,7 +143,6 @@     f5 <- arbitrary; f6 <- arbitrary; f7 <- arbitrary; f8 <- arbitrary;     f9 <- arbitrary;     return $! Pdta f1 f2 f3 f4 f5 f6 f7 f8 f9-  coarbitrary = undefined  data Phdr = Phdr {     presetName :: String@@ -175,7 +173,6 @@       , genre = fromIntegral $ genre'       , morphology = fromIntegral $ morphology'       }-  coarbitrary = undefined  data Bag = Bag {     genNdx :: Word@@ -189,7 +186,6 @@     return $! Bag {         genNdx = fromIntegral genNdx'       , modNdx = fromIntegral modNdx'}-  coarbitrary = undefined  data Mod = Mod {     srcOper :: Word@@ -213,7 +209,6 @@       , amtSrcOper = fromIntegral amtSrcOper'       , transOper = fromIntegral transOper'       }-  coarbitrary = undefined  data Generator =   -- Oscillator@@ -375,7 +370,6 @@       , RootKey w            , ReservedGen i' i]-  coarbitrary = undefined  isSampleIndex :: Generator -> Bool isSampleIndex g = case g of@@ -400,7 +394,6 @@     return $! Inst {         instName = instName'       , instBagNdx = fromIntegral $ instBagNdx'}-  coarbitrary = undefined  data Shdr = Shdr {     sampleName :: String@@ -440,7 +433,6 @@       , sampleLink = fromIntegral sampleLink'       , sampleType = fromIntegral sampleType'       }-  coarbitrary = undefined  ---- SoundFont import 

@@ -23,8 +23,8 @@   ) where  import Data.Audio-import Internal.ByteString.Parser-import Internal.ByteString.Builder+import Codec.ByteString.Parser+import Codec.ByteString.Builder  import Data.Word import Data.Int

@@ -33,9 +33,9 @@ import Data.Array.IO     (MArray, IOUArray, newArray_, writeArray) import Data.Array.Unsafe (unsafeFreeze, unsafeThaw) -import Internal.Arbitrary-import Internal.ByteString.Parser-import Internal.ByteString.Builder+import Codec.Internal.Arbitrary+import Codec.ByteString.Parser+import Codec.ByteString.Builder  import Test.QuickCheck import System.IO.Unsafe@@ -74,11 +74,10 @@ instance (Arbitrary a, IArray UArray a) => Arbitrary (Audio a) where   arbitrary = do     sr <- choose (1, 44100 * 8)-    cn <- choose (1, 64)-    sn <- choose (1, 1024) >>= return . (fromIntegral cn *)+    cn <- choose (1, 8)+    sn <- choose (1, 128) >>= return . (fromIntegral cn *)     sd <- arrayGen sn     return (Audio sr cn sd)-  coarbitrary = undefined  sampleNumber :: (IArray UArray a) => SampleData a -> Int sampleNumber sd = (snd (bounds sd)) + 1@@ -144,4 +143,3 @@  instance Arbitrary SampleMode where   arbitrary = oneof [return NoLoop, return ContLoop, return PressLoop]-  coarbitrary = undefined

@@ -1,101 +0,0 @@--------------------------------------------------------------------------------- |--- Module      : Data.Arbitrary--- Copyright   : George Giorgidze--- License     : BSD3------ Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>--- Stability   : Experimental--- Portability : Portable------ Additional instances of the 'Arbitrary' type class defined in 'Test.QuickCheck'.--- Some portions of code were copied from the test suite of 'binary' package.-----------------------------------------------------------------------------------{-# LANGUAGE FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Internal.Arbitrary (-    arrayGen-  , stringNulGen-  ) where---import Test.QuickCheck--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L--import Data.Word-import Data.Int-import Data.Char--import Data.List-import Data.Array.IArray--import System.Random ()--instance Arbitrary Word8 where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Word16 where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Word32 where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Word64 where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Int8 where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Int16 where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Int32 where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Int64 where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Word where-    arbitrary       = choose (minBound, maxBound)-    coarbitrary     = undefined--instance Arbitrary Char where-    arbitrary = choose (0, 255) >>= return . toEnum-    coarbitrary = undefined--instance Arbitrary L.ByteString where-    arbitrary     = arbitrary >>= return . L.fromChunks . filter (not. B.null)-    coarbitrary s = coarbitrary (L.unpack s)--instance Arbitrary B.ByteString where-  arbitrary = B.pack `fmap` arbitrary-  coarbitrary s = coarbitrary (B.unpack s)-  -instance (Arbitrary e, Num i, IArray Array e, Ix i) =>  Arbitrary (Array i e) where-  arbitrary = do-    n <- choose (1, 128)-    arrayGen n-  coarbitrary = undefined--arrayGen :: (Arbitrary e, Num i, IArray a e, Ix i) => Word -> Gen (a i e)-arrayGen 0 = error "Array with 0 elements can not be defined"-arrayGen n = do-  es <- vector (fromIntegral n)-  return $! listArray (0 , fromIntegral $ n - 1) es-  -stringNulGen :: Word -> Gen String-stringNulGen n = do-  sequence $ genericReplicate n $ choose (1,255) >>= return . chr

@@ -1,392 +0,0 @@--------------------------------------------------------------------------------- |--- Module      : Data.ByteString.Builder--- Copyright   : Lennart Kolmodin, Ross Paterson, George Giorgidze--- License     : BSD3------ Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>--- Stability   : experimental--- Portability : Portable------ Efficient construction of lazy bytestrings.----------------------------------------------------------------------------------module Internal.ByteString.Builder (--    -- * The Builder type-      Builder-    , toLazyByteString--    -- * Constructing Builders-    , empty-    , singleton-    , putWord8-    , putInt8-    , append-    , fromByteString        -- :: S.ByteString -> Builder-    , fromLazyByteString    -- :: L.ByteString -> Builder-    , putString--    -- * Flushing the buffer state-    , flush--    -- * Derived Builders-    -- ** Big-endian writes-    , putWord16be           -- :: Word16 -> Builder-    , putWord24be           -- :: Word32 -> Builder-    , putWord32be           -- :: Word32 -> Builder-    , putWord64be           -- :: Word64 -> Builder--    , putInt16be           -- :: Int16 -> Builder-    , putInt32be           -- :: Int32 -> Builder-    , putInt64be           -- :: Int64 -> Builder--    -- ** Little-endian writes-    , putWord16le           -- :: Word16 -> Builder-    , putWord24le           -- :: Word32 -> Builder-    , putWord32le           -- :: Word32 -> Builder-    , putWord64le           -- :: Word64 -> Builder--    , putInt16le           -- :: Int16 -> Builder-    , putInt32le           -- :: Int32 -> Builder-    , putInt64le           -- :: Int64 -> Builder--    -- ** Host-endian, unaligned writes-    , putWordHost           -- :: Word -> Builder-    , putWord16host         -- :: Word16 -> Builder-    , putWord32host         -- :: Word32 -> Builder-    , putWord64host         -- :: Word64 -> Builder-    -- Variable length numbers-    , putVarLenBe-    , putVarLenLe--  ) where---import qualified Data.ByteString.Internal as S-import qualified Data.ByteString          as S-import qualified Data.ByteString.Lazy     as L--import Foreign.Storable         (Storable, poke, sizeOf)-import Foreign.Ptr              (Ptr, plusPtr)-import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr)-import System.IO.Unsafe         (unsafePerformIO)-import Data.ByteString.Internal (inlinePerformIO,c2w)--import Data.Bits-import Data.Word-import Data.Int-import Data.Monoid------------------------------------------------------------------------------ | A 'Builder' is an efficient way to build lazy 'L.ByteString's.--- There are several functions for constructing 'Builder's, but only one--- to inspect them: to extract any data, you have to turn them into lazy--- 'L.ByteString's using 'toLazyByteString'.------ Internally, a 'Builder' constructs a lazy 'L.Bytestring' by filling byte--- arrays piece by piece.  As each buffer is filled, it is \'popped\'--- off, to become a new chunk of the resulting lazy 'L.ByteString'.--- All this is hidden from the user of the 'Builder'.--newtype Builder = Builder {-        -- Invariant (from Data.ByteString.Lazy):-        --      The lists include no null ByteStrings.-        runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString]-    }--instance Monoid Builder where-    mempty  = empty-    mappend = append------------------------------------------------------------------------------ | /O(1)./ The empty Builder, satisfying------  * @'toLazyByteString' 'empty' = 'L.empty'@----empty :: Builder-empty = Builder id---- | /O(1)./ A Builder taking a single byte, satisfying------  * @'toLazyByteString' ('singleton' b) = 'L.singleton' b@----singleton :: Word8 -> Builder-singleton = writeN 1 . flip poke--putWord8 :: Word8 -> Builder-putWord8 = singleton----------------------------------------------------------------------------- | /O(1)./ The concatenation of two Builders, an associative operation--- with identity 'empty', satisfying------  * @'toLazyByteString' ('append' x y) = 'L.append' ('toLazyByteString' x) ('toLazyByteString' y)@----append :: Builder -> Builder -> Builder-append (Builder f) (Builder g) = Builder (f . g)---- | /O(1)./ A Builder taking a 'S.ByteString', satisfying------  * @'toLazyByteString' ('fromByteString' bs) = 'L.fromChunks' [bs]@----fromByteString :: S.ByteString -> Builder-fromByteString bs-  | S.null bs = empty-  | otherwise = flush `append` mapBuilder (bs :)---- | /O(1)./ A Builder taking a lazy 'L.ByteString', satisfying------  * @'toLazyByteString' ('fromLazyByteString' bs) = bs@----fromLazyByteString :: L.ByteString -> Builder-fromLazyByteString bss = flush `append` mapBuilder (L.toChunks bss ++)--putString :: String -> Builder-putString = fromLazyByteString . L.pack . map c2w------------------------------------------------------------------------------ Our internal buffer type-data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)-                     {-# UNPACK #-} !Int                -- offset-                     {-# UNPACK #-} !Int                -- used bytes-                     {-# UNPACK #-} !Int                -- length left------------------------------------------------------------------------------ | /O(n)./ Extract a lazy 'L.ByteString' from a 'Builder'.--- The construction work takes place if and when the relevant part of--- the lazy 'L.ByteString' is demanded.----toLazyByteString :: Builder -> L.ByteString-toLazyByteString m = L.fromChunks $ unsafePerformIO $ do-    buf <- newBuffer defaultSize-    return (runBuilder (m `append` flush) (const []) buf)---- | /O(1)./ Pop the 'S.ByteString' we have constructed so far, if any,--- yielding a new chunk in the result lazy 'L.ByteString'.-flush :: Builder-flush = Builder $ \ k buf@(Buffer p o u l) ->-    if u == 0-      then k buf-      else S.PS p o u : k (Buffer p (o+u) 0 l)--------------------------------------------------------------------------------- copied from Data.ByteString.Lazy----defaultSize :: Int-defaultSize = 32 * k - overhead-    where k = 1024-          overhead = 2 * sizeOf (undefined :: Int)------------------------------------------------------------------------------ | Sequence an IO operation on the buffer-unsafeLiftIO :: (Buffer -> IO Buffer) -> Builder-unsafeLiftIO f =  Builder $ \ k buf -> inlinePerformIO $ do-    buf' <- f buf-    return (k buf')---- | Get the size of the buffer-withSize :: (Int -> Builder) -> Builder-withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->-    runBuilder (f l) k buf---- | Map the resulting list of bytestrings.-mapBuilder :: ([S.ByteString] -> [S.ByteString]) -> Builder-mapBuilder f = Builder (f .)------------------------------------------------------------------------------ | Ensure that there are at least @n@ many bytes available.-ensureFree :: Int -> Builder-ensureFree n = n `seq` withSize $ \ l ->-    if n <= l then empty else-        flush `append` unsafeLiftIO (const (newBuffer (max n defaultSize)))---- | Ensure that @n@ many bytes are available, and then use @f@ to write some--- bytes into the memory.-writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder-writeN n f = ensureFree n `append` unsafeLiftIO (writeNBuffer n f)--writeNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer-writeNBuffer n f (Buffer fp o u l) = do-    withForeignPtr fp (\p -> f (p `plusPtr` (o+u)))-    return (Buffer fp o (u+n) (l-n))--newBuffer :: Int -> IO Buffer-newBuffer size = do-    fp <- S.mallocByteString size-    return $! Buffer fp 0 0 size----------------------------------------------------------------------------- Aligned, host order writes of storable values---- | Ensure that @n@ many bytes are available, and then use @f@ to write some--- storable values into the memory.-writeNbytes :: Storable a => Int -> (Ptr a -> IO ()) -> Builder-writeNbytes n f = ensureFree n `append` unsafeLiftIO (writeNBufferBytes n f)--writeNBufferBytes :: Storable a => Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer-writeNBufferBytes n f (Buffer fp o u l) = do-    withForeignPtr fp (\p -> f (p `plusPtr` (o+u)))-    return (Buffer fp o (u+n) (l-n))--------------------------------------------------------------------------------- We rely on the fromIntegral to do the right masking for us.--- The inlining here is critical, and can be worth 4x performance------- | Write a Word16 in big endian format-putWord16be :: Word16 -> Builder-putWord16be w = writeN 2 $ \p -> do-    poke p               (fromIntegral (shiftR w 8) :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (w)              :: Word8)---- | Write a Word16 in little endian format-putWord16le :: Word16 -> Builder-putWord16le w = writeN 2 $ \p -> do-    poke p               (fromIntegral (w)              :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)---- putWord16le w16 = writeN 2 (\p -> poke (castPtr p) w16)---- | Write a 24 bit number in big endian format represented as Word32-putWord24be :: Word32 -> Builder-putWord24be w = writeN 3 $ \p -> do-    poke p               (fromIntegral (shiftR w 16) :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)-    poke (p `plusPtr` 2) (fromIntegral (w) :: Word8)---- | Write a 24 bit number in little endian format represented as Word32-putWord24le :: Word32 -> Builder-putWord24le w = writeN 3 $ \p -> do-    poke p               (fromIntegral (w)           :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (shiftR w  8) :: Word8)-    poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)---- | Write a Word32 in big endian format-putWord32be :: Word32 -> Builder-putWord32be w = writeN 4 $ \p -> do-    poke p               (fromIntegral (shiftR w 24) :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (shiftR w 16) :: Word8)-    poke (p `plusPtr` 2) (fromIntegral (shiftR w  8) :: Word8)-    poke (p `plusPtr` 3) (fromIntegral (w)           :: Word8)------- a data type to tag Put/Check. writes construct these which are then--- inlined and flattened. matching Checks will be more robust with rules.------- | Write a Word32 in little endian format-putWord32le :: Word32 -> Builder-putWord32le w = writeN 4 $ \p -> do-    poke p               (fromIntegral (w)               :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (shiftR w  8) :: Word8)-    poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)-    poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)---- on a little endian machine:--- putWord32le w32 = writeN 4 (\p -> poke (castPtr p) w32)---- | Write a Word64 in big endian format-putWord64be :: Word64 -> Builder-putWord64be w = writeN 8 $ \p -> do-    poke p               (fromIntegral (shiftR w 56) :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (shiftR w 48) :: Word8)-    poke (p `plusPtr` 2) (fromIntegral (shiftR w 40) :: Word8)-    poke (p `plusPtr` 3) (fromIntegral (shiftR w 32) :: Word8)-    poke (p `plusPtr` 4) (fromIntegral (shiftR w 24) :: Word8)-    poke (p `plusPtr` 5) (fromIntegral (shiftR w 16) :: Word8)-    poke (p `plusPtr` 6) (fromIntegral (shiftR w  8) :: Word8)-    poke (p `plusPtr` 7) (fromIntegral (w)               :: Word8)---- | Write a Word64 in little endian format-putWord64le :: Word64 -> Builder-putWord64le w = writeN 8 $ \p -> do-    poke p               (fromIntegral (w)               :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (shiftR w  8) :: Word8)-    poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)-    poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)-    poke (p `plusPtr` 4) (fromIntegral (shiftR w 32) :: Word8)-    poke (p `plusPtr` 5) (fromIntegral (shiftR w 40) :: Word8)-    poke (p `plusPtr` 6) (fromIntegral (shiftR w 48) :: Word8)-    poke (p `plusPtr` 7) (fromIntegral (shiftR w 56) :: Word8)---- on a little endian machine:--- putWord64le w64 = writeN 8 (\p -> poke (castPtr p) w64)---------------------------------------------------------------------------putInt8 :: Int8 -> Builder-putInt8 = putWord8 . fromIntegral--putInt16le :: Int16 -> Builder-putInt16le = putWord16le . fromIntegral--putInt16be :: Int16 -> Builder-putInt16be = putWord16be . fromIntegral--putInt32le :: Int32 -> Builder-putInt32le = putWord32le . fromIntegral--putInt32be :: Int32 -> Builder-putInt32be = putWord32be . fromIntegral--putInt64le :: Int64 -> Builder-putInt64le = putWord64le . fromIntegral--putInt64be :: Int64 -> Builder-putInt64be = putWord64be . fromIntegral----------------------------------------------------------------------------- Unaligned, word size ops---- | /O(1)./ A Builder taking a single native machine word. The word is--- written in host order, host endian form, for the machine you're on.--- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine,--- 4 bytes. Values written this way are not portable to--- different endian or word sized machines, without conversion.----putWordHost :: Word -> Builder-putWordHost w = writeNbytes (sizeOf (undefined :: Word)) (\p -> poke p w)---- | Write a Word16 in native host order and host endianness.--- 2 bytes will be written, unaligned.-putWord16host :: Word16 -> Builder-putWord16host w16 = writeNbytes (sizeOf (undefined :: Word16)) (\p -> poke p w16)---- | Write a Word32 in native host order and host endianness.--- 4 bytes will be written, unaligned.-putWord32host :: Word32 -> Builder-putWord32host w32 = writeNbytes (sizeOf (undefined :: Word32)) (\p -> poke p w32)---- | Write a Word64 in native host order.--- On a 32 bit machine we write two host order Word32s, in big endian form.--- 8 bytes will be written, unaligned.-putWord64host :: Word64 -> Builder-putWord64host w = writeNbytes (sizeOf (undefined :: Word64)) (\p -> poke p w)----------------------------------------------------------------------------putVarLenBe :: Word64 -> Builder-putVarLenBe w = varLenAux2 $ reverse $ varLenAux1 w-  -putVarLenLe :: Word64 -> Builder-putVarLenLe w = varLenAux2 $ varLenAux1 w-  -varLenAux1 :: Word64 -> [Word8]-varLenAux1 0 = []-varLenAux1 w = (fromIntegral $ w .&. 0x7F) : (varLenAux1 $ shiftR w 7)--varLenAux2 :: [Word8] -> Builder-varLenAux2  [] = putWord8 0-varLenAux2  [w] = putWord8 w-varLenAux2 (w : ws) = putWord8 (setBit w 7) `append` varLenAux2 ws

@@ -1,593 +0,0 @@--------------------------------------------------------------------------------- |--- Module      : Data.ByteString.Parser--- Copyright   : Lennart Kolmodin, George Giorgidze--- License     : BSD3------ Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>--- Stability   : experimental--- Portability : Portable------ A monad for efficiently building structures from--- encoded lazy ByteStrings.-----------------------------------------------------------------------------------module Internal.ByteString.Parser (--    -- * The Parser type-      Parser-    , runParser-    , runParserState--    -- * Parsing-    , choice-    , expect-    , skip-    , lookAhead-    , lookAheadM-    , lookAheadE--    -- * Utility-    , bytesRead-    , getBytes-    , remaining-    , isEmpty--    -- * Parsing particular types-    , satisfy-    , getString-    , getStringNul-    , string-    , getWord8-    , getInt8-    , word8-    , int8--    -- ** ByteStrings-    , getByteString-    , getLazyByteString-    , getLazyByteStringNul-    , getRemainingLazyByteString--    -- ** Big-endian reads-    , getWord16be-    , word16be-    , getWord24be-    , word24be-    , getWord32be-    , word32be-    , getWord64be-    , word64be--    , getInt16be-    , int16be-    , getInt32be-    , int32be-    , getInt64be-    , int64be--    -- ** Little-endian reads-    , getWord16le-    , word16le-    , getWord24le-    , word24le-    , getWord32le-    , word32le-    , getWord64le-    , word64le--    , getInt16le-    , int16le-    , getInt32le-    , int32le-    , getInt64le-    , int64le--    -- ** Host-endian, unaligned reads-    , getWordHost-    , wordHost-    , getWord16host-    , word16host-    , getWord32host-    , word32host-    , getWord64host-    , word64host--    -- Variable length reads-    , getVarLenBe-    , varLenBe-    , getVarLenLe-    , varLenLe-  ) where--import qualified Data.ByteString               as B-import qualified Data.ByteString.Lazy          as L-import qualified Data.ByteString.Internal      as B-import qualified Data.ByteString.Lazy.Internal as L--import Foreign.Storable        (Storable, peek, sizeOf)-import Foreign.Ptr             (plusPtr, castPtr)-import Foreign.ForeignPtr      (withForeignPtr)-import Control.Monad.ST        (runST)-import Control.Monad.ST.Unsafe (unsafeInterleaveST)--import Control.Monad-import Control.Applicative-import Data.STRef-import Data.Word-import Data.Int-import Data.Bits-import Data.Maybe---- | The parse state-data S = S {-# UNPACK #-} !B.ByteString  -- current chunk-           L.ByteString                  -- the rest of the input-           {-# UNPACK #-} !Int64         -- bytes read---- | The Get monad is just a State monad carrying around the input ByteString-newtype Parser a = Parser { unParser :: S -> Either String (a, S) }--instance Functor Parser where-    fmap f m = Parser $ \s -> case unParser m s of-      Left e -> Left e-      Right (a, s') -> Right (f a, s')-    -instance Monad Parser where-    return a  = Parser (\s -> Right (a, s))-    m >>= k   = Parser $ \s -> case (unParser m) s of-      Left e -> Left e-      Right (a, s') -> (unParser (k a)) s'-    fail  err  = Parser $ \(S _ _ bytes) ->-        Left (err ++ ". Failed reading at byte position " ++ show bytes)-instance MonadPlus Parser where-  mzero = Parser $ \_ -> Left []-  mplus p1 p2 = Parser $ \s -> case (unParser p1 s) of-    Left e1 -> case (unParser p2 s) of-      Left e2 -> Left (e1 ++ "\n" ++ e2)-      ok -> ok-    ok -> ok--instance Applicative Parser where-  pure  = return-  (<*>) = ap-  -instance Alternative Parser where-  empty = mzero-  (<|>) = mplus----------------------------------------------------------------------------get :: Parser S-get   = Parser $ \s -> Right (s, s)--put :: S -> Parser ()-put s = Parser $ \_ -> Right ((), s)----------------------------------------------------------------------------initState :: L.ByteString -> S-initState xs = mkState xs 0--mkState :: L.ByteString -> Int64 -> S-mkState l = case l of-    L.Empty      -> S B.empty L.empty-    L.Chunk x xs -> S x xs---- | Run the Get monad applies a 'get'-based parser on the input ByteString-runParser :: Parser a -> L.ByteString -> Either String a-runParser m str = case unParser m (initState str) of-  Left e -> Left e-  Right (a, _) -> Right a---- | Run the Get monad applies a 'get'-based parser on the input--- ByteString. Additional to the result of get it returns the number of--- consumed bytes and the rest of the input.-runParserState :: Parser a -> L.ByteString -> Int64 -> Either String (a, L.ByteString, Int64)-runParserState m str off =-    case unParser m (mkState str off) of-      Left e -> Left e-      Right (a, ~(S s ss newOff)) -> Right (a, s `bsJoin` ss, newOff)----------------------------------------------------------------------------choice :: [Parser a] -> Parser a-choice = foldl (<|>) mzero---- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.-skip :: Word64 -> Parser ()-skip n = readN (fromIntegral n) (const ())---- | Run @ga@, but return without consuming its input.--- Fails if @ga@ fails.-lookAhead :: Parser a -> Parser a-lookAhead ga = do-    s <- get-    a <- ga-    put s-    return a---- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'.--- Fails if @gma@ fails.-lookAheadM :: Parser (Maybe a) -> Parser (Maybe a)-lookAheadM gma = do-    s <- get-    ma <- gma-    when (isNothing ma) $ put s-    return ma---- | Like 'lookAhead', but consume the input if @gea@ returns 'Right _'.--- Fails if @gea@ fails.-lookAheadE :: Parser (Either a b) -> Parser (Either a b)-lookAheadE gea = do-    s <- get-    ea <- gea-    case ea of-        Left _ -> put s-        _      -> return ()-    return ea--expect :: (Show a, Eq a) => (a -> Bool) -> Parser a -> Parser a-expect f p = do-  v <- p-  when (not $ f v) $ fail $ show v ++ " was not expected."-  return v--getString :: Int -> Parser String-getString l = do-  bs <- getLazyByteString (fromIntegral l)-  return $! map B.w2c (L.unpack bs)--getStringNul :: Parser String-getStringNul = do-  bs <- getLazyByteStringNul-  return $! map B.w2c (L.unpack bs)--string :: String -> Parser String-string s = expect (s ==) (getString $ length s)---- Utility---- | Get the total number of bytes read to this point.-bytesRead :: Parser Int64-bytesRead = do-    S _ _ b <- get-    return b---- | Get the number of remaining unparsed bytes.--- Useful for checking whether all input has been consumed.--- Note that this forces the rest of the input.-remaining :: Parser Int64-remaining = do-    S s ss _ <- get-    return $! (fromIntegral (B.length s) + L.length ss)---- | Test whether all input has been consumed,--- i.e. there are no remaining unparsed bytes.-isEmpty :: Parser Bool-isEmpty = do-    S s ss _ <- get-    return $! (B.null s && L.null ss)----------------------------------------------------------------------------- Utility with ByteStrings---- | An efficient 'get' method for strict ByteStrings. Fails if fewer--- than @n@ bytes are left in the input.-getByteString :: Int -> Parser B.ByteString-getByteString n = readN n id---- | An efficient 'get' method for lazy ByteStrings. Does not fail if fewer than--- @n@ bytes are left in the input.-getLazyByteString :: Int64 -> Parser L.ByteString-getLazyByteString n = do-    S s ss bytes <- get-    let big = s `bsJoin` ss-    case splitAtST n big of-      (consume, rest) -> do put $ mkState rest (bytes + n)-                            return consume---- | Get a lazy ByteString that is terminated with a NUL byte. Fails--- if it reaches the end of input without hitting a NUL.-getLazyByteStringNul :: Parser L.ByteString-getLazyByteStringNul = do-    S s ss bytes <- get-    let big = s `bsJoin` ss-        (consume, t) = L.break (== 0) big-        (h, rest) = L.splitAt 1 t-    when (L.null h) $ fail "too few bytes"-    put $ mkState rest (bytes + L.length consume + 1)-    return consume---- | Get the remaining bytes as a lazy ByteString-getRemainingLazyByteString :: Parser L.ByteString-getRemainingLazyByteString = do-    S s ss _ <- get-    return $! (s `bsJoin` ss)----------------------------------------------------------------------------- Helpers---- | Pull @n@ bytes from the input, as a strict ByteString.-getBytes :: Int -> Parser B.ByteString-getBytes n = do-    S s ss bytes <- get-    if n <= B.length s-        then do let (consume,rest) = B.splitAt n s-                put $! S rest ss (bytes + fromIntegral n)-                return $! consume-        else-              case L.splitAt (fromIntegral n) (s `bsJoin` ss) of-                (consuming, rest) ->-                    do let now = B.concat . L.toChunks $ consuming-                       put $! mkState rest (bytes + fromIntegral n)-                       -- forces the next chunk before this one is returned-                       when (B.length now < n) $ fail "too few bytes"-                       return now--bsJoin :: B.ByteString -> L.ByteString -> L.ByteString-bsJoin bb lb-    | B.null bb = lb-    | otherwise = L.Chunk bb lb---- | Split a ByteString. If the first result is consumed before the ----- second, this runs in constant heap space.------ You must force the returned tuple for that to work, e.g.------ > case splitAtST n xs of--- >    (ys,zs) -> consume ys ... consume zs----splitAtST :: Int64 -> L.ByteString -> (L.ByteString, L.ByteString)-splitAtST i ps | i <= 0 = (L.empty, ps)-splitAtST i ps          = runST (-     do r  <- newSTRef undefined-        xs <- first r i ps-        ys <- unsafeInterleaveST (readSTRef r)-        return (xs, ys))--  where-        first r 0 xs@(L.Chunk _ _) = writeSTRef r xs    >> return L.Empty-        first r _ L.Empty          = writeSTRef r L.Empty >> return L.Empty--        first r n (L.Chunk x xs)-          | n < l     = do writeSTRef r (L.Chunk (B.drop (fromIntegral n) x) xs)-                           return $! L.Chunk (B.take (fromIntegral n) x) L.Empty-          | otherwise = do writeSTRef r (L.drop (n - l) xs)-                           liftM (L.Chunk x) $ unsafeInterleaveST (first r (n - l) xs)--         where l = fromIntegral (B.length x)---- Pull n bytes from the input, and apply a parser to those bytes,--- yielding a value. If less than @n@ bytes are available, fail with an--- error. This wraps @getBytes@.-readN :: Int -> (B.ByteString -> a) -> Parser a-readN n f = fmap f $ getBytes n------------------------------------------------------------------------------ Primtives---- helper, get a raw Ptr onto a strict ByteString copied out of the--- underlying lazy byteString. So many indirections from the raw parser--- state that my head hurts...--getPtr :: Storable a => Int -> Parser a-getPtr n = do-    (fp,o,_) <- readN n B.toForeignPtr-    return . B.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)----------------------------------------------------------------------------satisfy :: (Word8 -> Bool) -> Parser Word8-satisfy f = do-  w <- getWord8-  guard (f w)-  return w---- | Read a Word8 from the monad state-getWord8 :: Parser Word8-getWord8 = getPtr (sizeOf (undefined :: Word8))--word8 :: Word8 -> Parser Word8-word8 w = expect (w ==) getWord8---- | Read a Word16 in big endian format-getWord16be :: Parser Word16-getWord16be = do-    s <- readN 2 id-    return $! (fromIntegral (s `B.index` 0) `shiftL` 8) .|.-              (fromIntegral (s `B.index` 1))--word16be :: Word16 -> Parser Word16-word16be w = expect (w ==) getWord16be---- | Read a Word16 in little endian format-getWord16le :: Parser Word16-getWord16le = do-    s <- readN 2 id-    return $! (fromIntegral (s `B.index` 1) `shiftL` 8) .|.-              (fromIntegral (s `B.index` 0) )--word16le :: Word16 -> Parser Word16-word16le w = expect (w ==) getWord16le---- | Read a 24 bit word into Word32 in big endian format-getWord24be :: Parser Word32-getWord24be = do-    s <- readN 3 id-    return $! (fromIntegral (s `B.index` 0) `shiftL` 16) .|.-              (fromIntegral (s `B.index` 1) `shiftL`  8) .|.-              (fromIntegral (s `B.index` 2) )--word24be :: Word32 -> Parser Word32-word24be w = expect (w ==) getWord24be--getWord24le :: Parser Word32-getWord24le = do-    s <- readN 3 id-    return $! (fromIntegral (s `B.index` 2) `shiftL` 16) .|.-              (fromIntegral (s `B.index` 1) `shiftL`  8) .|.-              (fromIntegral (s `B.index` 0) )--word24le :: Word32 -> Parser Word32-word24le w = expect (w ==) getWord24le---- | Read a Word32 in big endian format-getWord32be :: Parser Word32-getWord32be = do-    s <- readN 4 id-    return $! (fromIntegral (s `B.index` 0) `shiftL` 24) .|.-              (fromIntegral (s `B.index` 1) `shiftL` 16) .|.-              (fromIntegral (s `B.index` 2) `shiftL`  8) .|.-              (fromIntegral (s `B.index` 3) )--word32be :: Word32 -> Parser Word32-word32be w = expect (w ==) getWord32be---- | Read a Word32 in little endian format-getWord32le :: Parser Word32-getWord32le = do-    s <- readN 4 id-    return $! (fromIntegral (s `B.index` 3) `shiftL` 24) .|.-              (fromIntegral (s `B.index` 2) `shiftL` 16) .|.-              (fromIntegral (s `B.index` 1) `shiftL`  8) .|.-              (fromIntegral (s `B.index` 0) )--word32le :: Word32 -> Parser Word32-word32le w = expect (w ==) getWord32le----- | Read a Word64 in big endian format-getWord64be :: Parser Word64-getWord64be = do-    s <- readN 8 id-    return $! (fromIntegral (s `B.index` 0) `shiftL` 56) .|.-              (fromIntegral (s `B.index` 1) `shiftL` 48) .|.-              (fromIntegral (s `B.index` 2) `shiftL` 40) .|.-              (fromIntegral (s `B.index` 3) `shiftL` 32) .|.-              (fromIntegral (s `B.index` 4) `shiftL` 24) .|.-              (fromIntegral (s `B.index` 5) `shiftL` 16) .|.-              (fromIntegral (s `B.index` 6) `shiftL`  8) .|.-              (fromIntegral (s `B.index` 7) )--word64be :: Word64 -> Parser Word64-word64be w = expect (w ==) getWord64be---- | Read a Word64 in little endian format-getWord64le :: Parser Word64-getWord64le = do-    s <- readN 8 id-    return $! (fromIntegral (s `B.index` 7) `shiftL` 56) .|.-              (fromIntegral (s `B.index` 6) `shiftL` 48) .|.-              (fromIntegral (s `B.index` 5) `shiftL` 40) .|.-              (fromIntegral (s `B.index` 4) `shiftL` 32) .|.-              (fromIntegral (s `B.index` 3) `shiftL` 24) .|.-              (fromIntegral (s `B.index` 2) `shiftL` 16) .|.-              (fromIntegral (s `B.index` 1) `shiftL`  8) .|.-              (fromIntegral (s `B.index` 0) )--word64le :: Word64 -> Parser Word64-word64le w = expect (w ==) getWord64le--------------------------------------------------------------------------getInt8 :: Parser Int8-getInt8 = getWord8 >>= return . fromIntegral--int8 :: Int8 -> Parser Int8-int8 i = expect (i ==) getInt8--getInt16le :: Parser Int16-getInt16le = getWord16le >>= return . fromIntegral--int16le :: Int16 -> Parser Int16-int16le i = expect (i ==) getInt16le--getInt16be :: Parser Int16-getInt16be = getWord16be >>= return . fromIntegral--int16be :: Int16 -> Parser Int16-int16be i = expect (i ==) getInt16be--getInt32le :: Parser Int32-getInt32le = getWord32le >>= return . fromIntegral--int32le :: Int32 -> Parser Int32-int32le i = expect (i ==) getInt32le--getInt32be :: Parser Int32-getInt32be = getWord32be >>= return . fromIntegral--int32be :: Int32 -> Parser Int32-int32be i = expect (i ==) getInt32be--getInt64le :: Parser Int64-getInt64le = getWord64le >>= return . fromIntegral--int64le :: Int64 -> Parser Int64-int64le i = expect (i ==) getInt64le--getInt64be :: Parser Int64-getInt64be = getWord64be >>= return . fromIntegral--int64be :: Int64 -> Parser Int64-int64be i = expect (i ==) getInt64be----------------------------------------------------------------------------- Host-endian reads---- | /O(1)./ Read a single native machine word. The word is read in--- host order, host endian form, for the machine you're on. On a 64 bit--- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes.-getWordHost :: Parser Word-getWordHost = getPtr (sizeOf (undefined :: Word))--wordHost :: Word -> Parser Word-wordHost w = expect (w ==) getWordHost---- | /O(1)./ Read a 2 byte Word16 in native host order and host endianness.-getWord16host :: Parser Word16-getWord16host = getPtr (sizeOf (undefined :: Word16))--word16host :: Word16 -> Parser Word16-word16host w = expect (w ==) getWord16host---- | /O(1)./ Read a Word32 in native host order and host endianness.-getWord32host :: Parser Word32-getWord32host = getPtr  (sizeOf (undefined :: Word32))--word32host :: Word32 -> Parser Word32-word32host w = expect (w ==) getWord32host---- | /O(1)./ Read a Word64 in native host order and host endianess.-getWord64host   :: Parser Word64-getWord64host = getPtr  (sizeOf (undefined :: Word64))--word64host :: Word64 -> Parser Word64-word64host w = expect (w ==) getWord64host---- Variable length numbers--getVarLenBe :: Parser Word64-getVarLenBe = f 0-  where-  f :: Word64 -> Parser Word64-  f acc =  do-    w <- getWord8 >>= return . fromIntegral-    if testBit w 7-      then f      $! (shiftL acc 7) .|. (clearBit w 7)-      else return $! (shiftL acc 7) .|. w--varLenBe :: Word64 -> Parser Word64-varLenBe a = expect (a ==) getVarLenBe--getVarLenLe :: Parser Word64-getVarLenLe = do-  w <- getWord8 >>= return . fromIntegral-  if testBit w 7-    then do-      w' <- getVarLenLe-      return $! (clearBit w 7) .|. (shiftL w' 7)-    else return $! w--varLenLe :: Word64 -> Parser Word64-varLenLe a = expect (a ==) getVarLenLe

@@ -1,118 +0,0 @@-module Main (main) where--import Codec.Midi-import qualified Codec.Wav as Wav-import qualified Codec.SoundFont as SF-import Data.Audio--import Internal.ByteString.Parser-import Internal.ByteString.Builder--import Test.QuickCheck-import Data.Int-import Data.Word-import Data.Bits--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L--import Data.Monoid-import Debug.Trace--roundTrip :: (Eq a, Show a) => (a -> Builder) -> Parser a -> a -> Bool-roundTrip b p a = if Right a == ea'-  then True-  else trace (unlines $ [show ea']) $ False-  where ea' = runParser p bs-        bs = toLazyByteString $ b a--testAudio :: IO ()-testAudio = do-  putStrLn "TESTING Inctances of Audible"-  test (prop_audible :: Word8 -> Bool)-  test (prop_audible :: Word16 -> Bool)-  test (prop_audible :: Word32 -> Bool)-  -- test (prop_audible :: Word64 -> Bool)-  test (prop_audible :: Int8 -> Bool)-  test (prop_audible :: Int16 -> Bool)-  test (prop_audible :: Int32 -> Bool)-  -- test (prop_audible :: Int64 -> Bool)--  -- These two tests are commented, because they fail-  -- Reason for that is the fact that Double is not abble to accomodate-  -- 64 bit numbers in full precision-  where-  prop_audible :: (Eq a, Audible a) => a -> Bool-  prop_audible a = (a ==  fromSample s) && (s >= -1.0) && (s <= 1.0)-    where s = toSample a--testMidi :: IO ()-testMidi =  do-  putStrLn "TESTING PARSING AND BUILDING of Midi"--  test $ roundTrip buildMessage (parseMessage Nothing)-  test $ roundTrip buildMidi parseMidi-  test $ \trk -> trk == fromAbsTime (toAbsTime trk :: Track Ticks)-  test $ \trk td -> trk == fromRealTime td (toRealTime td trk)--  test $ \m -> (not $ null $ tracks m) ==>-               let (Midi SingleTrack _ trks) = toSingleTrack m-               in   length (concat $ tracks m) - length (concat trks) == length (tracks m) - 1--testWav :: IO ()-testWav =  do-  putStrLn "TESTING PARSING AND BUILDING of Wav"-  test $ roundTrip (Wav.buildWav :: Audio Word8 -> Builder) Wav.parseWav-  test $ roundTrip (Wav.buildWav :: Audio Int16 -> Builder) Wav.parseWav-  test $ roundTrip (Wav.buildWav :: Audio Int32 -> Builder) Wav.parseWav--testSoundFont :: IO ()-testSoundFont =  do-  putStrLn "TESTING PARSING AND BUILDING of SoundFont"-  test $ roundTrip SF.buildSoundFont SF.parseSoundFont--testParserBuilder :: IO ()-testParserBuilder = do-  putStrLn "TESTING PARSING AND BUILDING OF NUMERICAL TYPES"--  test $ roundTrip putWord8 getWord8-  test $ roundTrip putWord16be getWord16be-  test $ roundTrip putWord16le getWord16le-  test $ \w -> roundTrip putWord24be getWord24be (w .&. 0xFFFFFF)-  test $ \w -> roundTrip putWord24le getWord24le (w .&. 0xFFFFFF)-  test $ roundTrip putWord32be getWord32be-  test $ roundTrip putWord32le getWord32le-  test $ roundTrip putWord64be getWord64be-  test $ roundTrip putWord64le getWord64le--  test $ roundTrip putInt8 getInt8-  test $ roundTrip putInt16be getInt16be-  test $ roundTrip putInt16le getInt16le-  test $ roundTrip putInt32be getInt32be-  test $ roundTrip putInt32le getInt32le-  test $ roundTrip putInt64be getInt64be-  test $ roundTrip putInt64le getInt64le--  test $ roundTrip putWordHost getWordHost-  test $ roundTrip putWord16host getWord16host-  test $ roundTrip putWord32host getWord32host-  test $ roundTrip putWord64host getWord64host--  test $ roundTrip putVarLenBe getVarLenBe-  test $ roundTrip putVarLenLe getVarLenLe--  putStrLn "TESTING PARSING AND BUILDING OF String and ByteString"--  test $ \s1 s2 -> roundTrip (\s -> putString s `mappend` putString s2) (getString $ length s1) s1-  test $ \s1 s2 -> roundTrip (\s -> fromByteString s `mappend` fromByteString s2) (getByteString $ B.length s1) s1-  test $ \s1 s2 -> roundTrip (\s -> fromLazyByteString s `mappend` fromLazyByteString s2) (getLazyByteString $  L.length s1) s1-  test $ \bs -> roundTrip fromLazyByteString getRemainingLazyByteString bs---main :: IO ()-main = do-  testAudio-  testParserBuilder-  testMidi-  testWav-  testSoundFont