Parse.hs

-- | This module contains all of the Parsing operations for this library. In our nonmenclature
-- Assemble is the opposite of parse so you should look at that module if you wish to perform the
-- opposite operations.
module Sound.Wav.Parse 
   ( withWaveFile
   , parseWaveStream
   , getWaveFile
   ) where

import qualified Data.Riff as R
import Sound.Wav.Data
import Sound.Wav.WaveFormat
import Sound.Wav.Info (parseWaveInfo)
import Sound.Wav.Constants

import Data.Binary.Get
import qualified Data.ByteString.Lazy as BL
import System.IO (withBinaryFile, IOMode(..))

-- | We would like to be able to pass in a path to a WaveFile and a handler so that we don't have to
-- deal with opening / closing a file and parsing the contents just to apply a handler to the data.
-- This is a convenience method that just lets you do something with a wave file.
withWaveFile 
   :: FilePath                                     -- ^ The location of the WaveFile in the filesystem.
   -> (Either WaveParseError WaveFile -> IO ())    -- ^ A handler for the parse result. Note that the parse may fail and you should handle that.
   -> IO ()                                        -- ^ An IO context is required because you are reading from the filesystem.
withWaveFile filePath action = withBinaryFile filePath ReadMode $ \h -> do
   waveData <- fmap parseWaveStream (BL.hGetContents h)
   action waveData

parseWaveStream :: BL.ByteString -> Either WaveParseError WaveFile
parseWaveStream input = case runGetOrFail getWaveFile input of
   Left (_, offset, error) -> Left $ error ++ " (" ++ show offset ++ ")"
   Right (_, _, waveFile) -> Right waveFile

-- | Provide a context that will parse a wave file.
getWaveFile :: Get WaveFile
getWaveFile = fromRiffFile =<< R.getRiffFile
      
fromRiffFile :: R.RiffFile -> Get WaveFile
fromRiffFile (R.RiffFile _ formatType chunks) = 
   if formatType == waveHeader
      then fromRiffChunks chunks
      else fail $ "This is not a WAVE file format type was: " ++ formatType

fromRiffChunks :: [R.RiffChunk] -> Get WaveFile
fromRiffChunks chunks = do
   format <- runGetWaveFormat =<< formatChunk
   rawData <- dataChunk
   -- TODO potentially get the other chunks that we know about
   -- TODO Store the remaining chunks in an overflow of the riff chunks
   return WaveFile 
      { waveFormat = format 
      , waveData = R.riffData rawData
      , waveFact = Nothing 
      , waveInfo = infoChunk
      }
   where
      formatChunk = onlyOneChunk waveFormatHeader $ filter (riffIdIs waveFormatHeader) chunks
      dataChunk = onlyOneChunk waveDataHeader $ filter (riffIdIs waveDataHeader) chunks
      infoChunk = case filter (riffListIdIs waveInfoListType) chunks of
         [] -> Nothing
         -- TODO what if there is more than one INFO chunk? is that allowed? How would we
         -- merge it anyway?
         (R.RiffChunkParent _ children : _) -> Just . parseWaveInfo $ children
         _ -> Nothing

runGetWaveFormat :: R.RiffChunk -> Get WaveFormat
runGetWaveFormat riffChunk@(R.RiffChunkChild _ _) = 
   case runGetOrFail getWaveFormat (R.riffData riffChunk) of
      Left (_, offset, error) -> fail $ "Error in format chunk: " ++ error ++ postfix offset
      Right (_, _, waveFormat) -> return waveFormat
   where 
      postfix offset = " (" ++ show offset ++ ")"
runGetWaveFormat _ = fail "Format chunk is not allowed to be a nested chunk!"

-- TODO parse the fact chunk out of WAVE files
getFactChunkHelper :: Get WaveFact
getFactChunkHelper = fmap WaveFact getWord32le

onlyOneChunk :: String -> [R.RiffChunk] -> Get R.RiffChunk
onlyOneChunk chunkType []  = fail $ "There were no chunks of type: " ++ chunkType 
onlyOneChunk _         [x] = return x
onlyOneChunk chunkType xs  = fail $ "There are " ++ stringLength ++ " chunks of type '" ++ chunkType ++ "' in the WAVE data."
   where
      stringLength = show . length $ xs

riffIdIs :: String -> R.RiffChunk -> Bool
riffIdIs comp riffChunk@(R.RiffChunkChild _ _) = comp == R.riffChunkId riffChunk
riffIdIs _    _ = False

riffListIdIs :: String -> R.RiffChunk -> Bool
riffListIdIs comp (R.RiffChunkParent formatType _) = comp == formatType
riffListIdIs _    _ = False