-- | The Sound.Wav.Info module is responsible for abolutely everything in the INFO -- Metadata chunk of a RIFF file. It allows you to read, write and modify that chunk of -- data easily. module Sound.Wav.Info ( parseWaveInfo , updateWaveInfo , getInfoData , waveInfoToRiffChunks ) where import Data.List (intercalate) import Data.List.Split (splitOn) import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Riff as R import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import Sound.Wav.Data import Control.Applicative ((<$>)) -- TODO the code in this function could be greatly cleaned up via lenses -- | Update the INFO metadata chunk inside an existing WaveFile. This will allow you to -- edit the metadata inside a file. updateWaveInfo :: (WaveInfo -> WaveInfo) -- ^ The conversion function from original to new metadata. -> WaveFile -- ^ The input WaveFile that will be modified. -> WaveFile -- ^ A new WaveFile that contains the updated INFO section. updateWaveInfo updater waveFile = waveFile { waveInfo = updater <$> waveInfo waveFile } -- | You want to be able to get the info chunk from your WaveFiles, however, if the info -- chunk does not exist then you will be provided with a default info chunk. getInfoData :: WaveFile -- ^ The file that you wish to extract INFO metadata from. -> WaveInfo -- ^ The info metadata. getInfoData = fromMaybe waveInfoDefault . waveInfo waveInfoToRiffChunks :: WaveInfo -> [R.RiffChunk] waveInfoToRiffChunks waveInfo = catMaybes $ fmap (\x -> x waveInfo) [ convertString "IARL" . archiveLocation , convertString "IART" . artist , convertString "ICMS" . commissionedBy , convertString "ICMT" . comments , convertStringList "ICOP" . copyrights , convertString "ICRD" . creationDate , convertString "ICRP" . croppedDetails , convertString "IDIM" . originalDimensions , convertString "IDPI" . dotsPerInch , convertStringList "IENG" . engineers , convertString "IGNR" . genre , convertStringList "IKEY" . keywords , convertString "ILGT" . lightness , convertString "IMED" . originalMedium , convertString "INAM" . name , convertString "IPLT" . coloursInPalette , convertString "IPRD" . originalProduct , convertString "ISBJ" . subject -- TODO put our own name in here, then make it optional , convertString "ISFT" . creationSoftware , convertString "ISHP" . sharpness , convertString "ISCR" . contentSource , convertString "ISRF" . originalForm , convertString "ITCH" . technician ] where convertString :: String -> Maybe String -> Maybe R.RiffChunk convertString riffId = fmap (R.RiffChunkChild riffId . BLC.pack) convertStringList :: String -> Maybe [String] -> Maybe R.RiffChunk convertStringList riffId = convertString riffId . fmap (intercalate "; ") -- | Get the INFO metadata from a Byte Stream. parseWaveInfo :: [R.RiffChunk] -> WaveInfo parseWaveInfo = foldr appendWaveInfo waveInfoDefault appendWaveInfo :: R.RiffChunk -> WaveInfo -> WaveInfo appendWaveInfo (R.RiffChunkChild riffId rawData) initial = case riffId of "IARL" -> initial { archiveLocation = Just asString} "IART" -> initial { artist = Just asString} "ICMS" -> initial { commissionedBy = Just asString} "ICMT" -> initial { comments = Just asString} "ICOP" -> initial { copyrights = Just asStringList} "ICRD" -> initial { creationDate = Just asString} "ICRP" -> initial { croppedDetails = Just asString} "IDIM" -> initial { originalDimensions = Just asString} "IDPI" -> initial { dotsPerInch = Just asString} "IENG" -> initial { engineers = Just asStringList} "IGNR" -> initial { genre = Just asString} "IKEY" -> initial { keywords = Just asStringList} "ILGT" -> initial { lightness = Just asString} "IMED" -> initial { originalMedium = Just asString} "INAM" -> initial { name = Just asString} "IPLT" -> initial { coloursInPalette = Just asString} "IPRD" -> initial { originalProduct = Just asString} "ISBJ" -> initial { subject = Just asString} "ISFT" -> initial { creationSoftware = Just asString} "ISHP" -> initial { sharpness = Just asString} "ISCR" -> initial { contentSource = Just asString} "ISRF" -> initial { originalForm = Just asString} "ITCH" -> initial { technician = Just asString} -- Skipping and ignoring them kinda sucks, in the future make it so -- that you put them in a buffer somewhere _ -> initial where asString = parseInfoString rawData asStringList = parseInfoStrings rawData appendWaveInfo _ initial = initial parseInfoString :: BL.ByteString -> String parseInfoString = dropTrailingNull . BLC.unpack dropTrailingNull :: String -> String dropTrailingNull = reverse . dropWhile (== '\0') . reverse parseInfoStrings :: BL.ByteString -> [String] parseInfoStrings = splitOn "; " . parseInfoString