module Codec.Audio.Vorbis (readAudioInfoAndComment, AudioInfo(..)) where
import qualified Codec.Binary.UTF8.String as UTF8
import Control.Monad.Error
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import Data.Binary.Strict.Get
import Data.Char (toLower)
import Data.Word
data AudioInfo = AudioInfo {channels :: Word8, sampleRate :: Word32, maxBitrate :: Word32,
nominalBitrate :: Word32, minBitrate :: Word32,
playtime :: Maybe Double}
deriving Show
readAudioInfoAndComment :: FilePath -> IO (Either String (AudioInfo, [(String, String)]))
readAudioInfoAndComment fname = do
content <- B.readFile fname
return $ case readVorbisAudioInfo content of
Left e -> Left e
Right audioInfo -> case readVorbisCommentFromOgg content of
Left e -> Left e
Right comment -> Right (audioInfo, comment)
readVorbisCommentFromOgg :: Char8.ByteString -> Either String [(String, String)]
readVorbisCommentFromOgg fileContent = case runGet readVorbisCommentOggPage fileContent of
(Left e, _) -> Left e
(Right p2, _) ->
case runGet (readVorbisComment False) commentData of
(Left e, _) -> Left e
(Right comment, _) -> Right comment
where commentData = B.drop 7 $ packetData p2
readVorbisCommentOggPage = do
p1 <- readOggPage
p2 <- readOggPage
when (not $ isVorbisPage p1) $ fail "First page is not a vorbis page"
when (serialNum p1 /= serialNum p2) $ fail "First two pages do not have same serial number"
return p2
readVorbisComment framingXXX = do
vendorLength <- getWord32le
vendor <- getAByteString $ fromIntegral vendorLength
numItems <- getWord32le
readEntries numItems
where
readEntries 0 = return []
readEntries numItems = do
len <- getWord32le
rawStr <- getAByteString $ fromIntegral len
let ustr = UTF8.decode $ B.unpack rawStr
restOfEntries <- readEntries (numItems 1)
return $ (downcase $ takeWhile (/= '=') ustr, tail $ dropWhile (/= '=') ustr) : restOfEntries
downcase = map toLower
readVorbisAudioInfo :: Char8.ByteString -> Either String AudioInfo
readVorbisAudioInfo fileContent = do
firstPage <- readOggPageOrBust fileContent "Failed to parse first Ogg page"
let reversed = B.reverse fileContent
let oggs = Char8.pack "OggS"
let lastPageData = B.concat [oggs, B.reverse $ fst $ B.breakSubstring (B.reverse oggs) reversed]
lastPage <- readOggPageOrBust lastPageData "Failed to parse last Ogg page"
let (maybeInfo, _) = runGet (readFromVorbisPacket (granulePosition lastPage)) (packetData firstPage)
maybeInfo
where
readFromVorbisPacket totalNumSamples = do
skip 11
channels <- getWord8
sampleRate <- getWord32le
maxBitrate <- getWord32le
nominalBitrate <- getWord32le
minBitrate <- getWord32le
let playtime = (toDouble totalNumSamples) / (toDouble sampleRate) :: Double
return $ AudioInfo channels sampleRate maxBitrate nominalBitrate minBitrate (Just playtime)
toDouble :: Integral a => a -> Double
toDouble = fromInteger . toInteger
readOggPageOrBust :: Char8.ByteString -> String -> Either String OggPage
readOggPageOrBust content err = case maybePage of
Left e -> Left $ err ++ ": " ++ e
Right p -> Right p
where (maybePage, _) = runGet readOggPage content
isVorbisPage page = B.take 7 (packetData page) == Char8.pack "\x01vorbis"
data OggPage = OggPage { version :: Word8, typeFlags :: Word8, granulePosition :: Word64,
serialNum :: Word32, pageNum :: Word32, checkSum :: Word32,
segmentsCount :: Word8, packetData :: B.ByteString
}
readOggPage = do
oggs <- getAByteString 4
version <- getWord8
typeFlags <- getWord8
granulePosition <- getWord64le
serialNum <- getWord32le
pageNum <- getWord32le
checkSum <- getWord32le
segmentsCount <- getWord8
lacingBytes <- getAByteString $ fromIntegral $ toInteger segmentsCount
when (B.length lacingBytes /= (fromIntegral $ toInteger segmentsCount)) $
fail "Unable to read sufficient \"lacing\" bytes"
packetData <- getAByteString $ fromIntegral $ byteSum lacingBytes
return $ OggPage version typeFlags granulePosition serialNum pageNum checkSum segmentsCount
packetData
byteSum :: B.ByteString -> Integer
byteSum bs = B.foldl (\total byte -> total + (toInteger byte)) 0 bs
getAByteString = getByteString