diff --git a/Data/Riff.hs b/Data/Riff.hs --- a/Data/Riff.hs +++ b/Data/Riff.hs @@ -44,11 +44,21 @@ ParseError, -- * Reading (parsing) RIFF Files withRiffFile, - parseRiffData, + parseRiffFileStream, + getRiffFile, + -- * Writing (assembling) RIFF Files assembleRiffFile, - assembleRiffFileStream + assembleRiffFileStream, + putRiffFile ) where import Data.Riff.RiffData import Data.Riff.Parse import Data.Riff.Assemble + +import Data.Binary + +-- | A binary instance of a RiffFile. +instance Binary RiffFile where + get = getRiffFile + put = putRiffFile diff --git a/Data/Riff/Assemble.hs b/Data/Riff/Assemble.hs --- a/Data/Riff/Assemble.hs +++ b/Data/Riff/Assemble.hs @@ -28,6 +28,7 @@ module Data.Riff.Assemble ( assembleRiffFile , assembleRiffFileStream + , putRiffFile ) where import Data.Riff.RiffData @@ -55,14 +56,17 @@ assembleRiffFileStream :: RiffFile -- ^ The RIFF file to be written out. -> BL.ByteString -- ^ The resultant stream of bytes representing the file. -assembleRiffFileStream = runPut . writeRiffFile +assembleRiffFileStream = runPut . putRiffFile -writeRiffFile :: RiffFile -> Put -writeRiffFile riffFile = do +-- | A Binary put instance so that you can write a riff file right out to any stream. +putRiffFile + :: RiffFile -- ^ The riff file to write out to the stream. + -> Put -- ^ The Put monad that will do the writing. +putRiffFile riffFile = do printHeader . riffFileType $ riffFile -- Do not need safeId, chosen to be correrct putSize context . calculateFileLength $ riffFile putString . safeId . riffFileFormatType $ riffFile - sequence_ $ fmap (writeRiffChunk context) (riffFileChildren riffFile) + sequence_ $ fmap (putRiffChunk context) (riffFileChildren riffFile) where context = getContext . riffFileType $ riffFile -- TODO do we need to word align the end of a riff file? @@ -75,19 +79,19 @@ { putSize :: RiffChunkSize -> Put } -writeRiffChunk :: AssemblyContext -> RiffChunk -> Put -writeRiffChunk context chunk@(RiffChunkChild _ _) = do +putRiffChunk :: AssemblyContext -> RiffChunk -> Put +putRiffChunk context chunk@(RiffChunkChild _ _) = do putString . safeId . riffChunkId $ chunk let chunkSize = calculateChunkLength chunk putSize context chunkSize putLazyByteString . riffData $ chunk maybeFillBlank chunkSize -writeRiffChunk context chunk@(RiffChunkParent _ _) = do +putRiffChunk context chunk@(RiffChunkParent _ _) = do putString "LIST" -- Do not need to pass through safeId, chosen to be correct let chunkSize = calculateChunkLength chunk putSize context chunkSize putString . safeId . riffFormTypeInfo $ chunk - sequence_ $ fmap (writeRiffChunk context) (riffChunkChildren chunk) + sequence_ $ fmap (putRiffChunk context) (riffChunkChildren chunk) maybeFillBlank chunkSize maybeFillBlank :: RiffChunkSize -> Put diff --git a/Data/Riff/Parse.hs b/Data/Riff/Parse.hs --- a/Data/Riff/Parse.hs +++ b/Data/Riff/Parse.hs @@ -15,15 +15,14 @@ -} module Data.Riff.Parse ( withRiffFile - , parseRiffData + , parseRiffFileStream + , getRiffFile ) where import Data.Riff.RiffData import Data.Riff.InternalUtil import Control.Monad (when, replicateM) -import Control.Monad.Trans.Either (EitherT(..), left, right) -import Control.Monad.Trans.Class import Data.Binary.Get import qualified Data.ByteString.Lazy as BL import Data.Char (chr) @@ -40,34 +39,34 @@ -- parsed file -> IO () -- ^ The resultant IO action. withRiffFile filePath action = withBinaryFile filePath ReadMode $ \h -> do - riffData <- fmap parseRiffData (BL.hGetContents h) + riffData <- fmap parseRiffFileStream (BL.hGetContents h) action riffData -- | You can parse a raw ByteString and try and convert it into a RiffFile. This will give -- a best attempt at parsing the data and, if success is not possible, will give you a -- ParseError. -parseRiffData :: BL.ByteString -- A lazy bytestring for input. - -> Either ParseError RiffFile -- The result of our attempted parse. -parseRiffData input = - case runGetOrFail (runEitherT getRiffStart) input of +parseRiffFileStream :: BL.ByteString -- A lazy bytestring for input. + -> Either ParseError RiffFile -- The result of our attempted parse. +parseRiffFileStream input = + case runGetOrFail getRiffFile input of Left (_, offset, error) -> Left (offset, error) - Right (_, _, result) -> result + Right (_, _, result) -> Right result data ParseContext = ParseContext { getSize :: Get RiffChunkSize } -getRiffStart :: EitherT ParseError Get RiffFile -getRiffStart = do - id <- lift getIdentifier +-- | A binary instance of RiffFile so that you can parse one wherever you find it. +getRiffFile :: Get RiffFile +getRiffFile = do + id <- getIdentifier (context, fileType) <- case id of - "RIFF" -> right (leContext, RIFF) - "RIFX" -> right (beContext, RIFX) + "RIFF" -> return (leContext, RIFF) + "RIFX" -> return (beContext, RIFX) _ -> do - read <- lift bytesRead - left (read, "RIFF file not allowed to start with chunk id: '" ++ id ++ "'. Must start with either RIFF or RIFX") - size <- lift . getSize $ context - riffType <- lift getIdentifier + fail $ "RIFF file not allowed to start with chunk id: '" ++ id ++ "'. Must start with either RIFF or RIFX" + size <- getSize $ context + riffType <- getIdentifier contents <- parseChunkList context (size - 4) return RiffFile { riffFileType = fileType @@ -78,7 +77,7 @@ leContext = ParseContext getWord32le beContext = ParseContext getWord32be -parseChunkList :: ParseContext -> RiffChunkSize -> EitherT ParseError Get [RiffChunk] +parseChunkList :: ParseContext -> RiffChunkSize -> Get [RiffChunk] parseChunkList _ 0 = return [] parseChunkList context totalSize = do (nextChunk, dataSize) <- getRiffChunk context @@ -90,33 +89,32 @@ following <- parseChunkList context (totalSize - chunkSize) return $ nextChunk : following -getRiffChunk :: ParseContext -> EitherT ParseError Get (RiffChunk, RiffChunkSize) +getRiffChunk :: ParseContext -> Get (RiffChunk, RiffChunkSize) getRiffChunk context = do - id <- lift getIdentifier - size <- lift . getSize $ context + id <- getIdentifier + size <- getSize $ context if id == "LIST" then do guardListSize id size - formType <- lift getIdentifier + formType <- getIdentifier -- Minus 4 because of the formType before that is part of the size children <- parseChunkList context (size - 4) - lift $ skipToWordBoundary size + skipToWordBoundary size return (RiffChunkParent { riffFormTypeInfo = formType , riffChunkChildren = children }, size) else do -- TODO do we need to consider byte boundaries here? - riffData <- lift $ getLazyByteString (fromIntegral size) - lift $ skipToWordBoundary size + riffData <- getLazyByteString (fromIntegral size) + skipToWordBoundary size return (RiffChunkChild { riffChunkId = id , riffData = riffData }, size) where guardListSize id size = when (size < 4) $ do - read <- lift bytesRead - left (read, message id size) + fail $ message id size where message id size = "List Chunk Id '" ++ id diff --git a/riff.cabal b/riff.cabal --- a/riff.cabal +++ b/riff.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.2.0.0 +version: 0.3.0.0 -- A short (one-line) description of the package. synopsis: RIFF parser for Haskell