diff --git a/idiii.cabal b/idiii.cabal --- a/idiii.cabal +++ b/idiii.cabal @@ -1,17 +1,27 @@ Name: idiii -Version: 0.1.2 -Synopsis: Reading and writing of ID3v2 tags -Description: Reading and writing of ID3v2 tags +Cabal-version: >= 1.8 +Version: 0.1.3 +Synopsis: ID3v2 (tagging standard for MP3 files) library +Description: ID3v2 (tagging standard for MP3 files) library Category: Text, Sound License: BSD3 License-file: LICENSE Author: Alexey Alekhin, Chris Wagner Maintainer: christopher.t.wagner@gmail.com, alekhin.alexey@gmail.com -Build-Depends: base < 5, haskell98, bytestring, polyparse, text, data-accessor, utf8-string, containers, MissingH Build-Type: Simple -hs-source-dirs: src extra-source-files: LICENSE read-idiii.hs -Exposed-modules: ID3, +data-dir: test/resources +data-files: *.mp3 + +Executable read-idiii + hs-source-dirs: ., src + build-depends: base + main-is: read-idiii.hs + +Library + Build-Depends: base < 5, bytestring, polyparse, text, data-accessor, utf8-string, containers, MissingH + hs-source-dirs: src + Exposed-modules: ID3, ID3.Simple, ID3.Parser, @@ -34,4 +44,20 @@ ID3.ReadTag, ID3.WriteTag -ghc-options: -Wall + ghc-options: -Wall + +Test-Suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test, src + main-is: Tests.hs + build-depends: base, filepath, process, directory, HUnit + other-modules: Paths_idiii + +Source-repository head + type: bazaar + location: lp:idiii + +Source-repository this + type: bazaar + location: lp:idiii + tag: 0.1.3 diff --git a/read-idiii.hs b/read-idiii.hs --- a/read-idiii.hs +++ b/read-idiii.hs @@ -2,7 +2,7 @@ import ID3 import qualified Data.Map as Map -import System (getArgs) +import System.Environment (getArgs) main = do args <- getArgs diff --git a/src/ID3/Parser/ExtHeader.hs b/src/ID3/Parser/ExtHeader.hs --- a/src/ID3/Parser/ExtHeader.hs +++ b/src/ID3/Parser/ExtHeader.hs @@ -10,42 +10,48 @@ import ID3.Type.ExtHeader import Data.Accessor -import Data.Word (Word8) +import Data.Bits (testBit) +import Data.Word (Word8) ---- -- | Parses Extended Header as 'ID3ExtHeader' structure parseExtHeader :: TagParser ID3ExtHeader parseExtHeader = do - s <- parseSize 4 True `err` "ext header size" -- Extended header size 4 * %0xxxxxxx - word8 0x01 `err` "ext header pre-flags" -- Number of flag bytes $01 - [b,c,d] <- parseFlags_ [2,3,4] `err` "ext header flags" -- Extended Flags %0bcd0000 + s <- parseSize 4 True `err` "ext header size" -- Extended header size: 4 * %0xxxxxxx + _ <- word8 0x01 `err` "ext header pre-flags" -- Number of flag bytes: $01 + flags <- anyWord8 `err` "ext header flags" -- Extended Flags: %0bcd0000 + let (b, c, d) = (testBit flags 6, testBit flags 5, testBit flags 4) bb <- if b then parseB else return False - cc <- if c then parseC else return [] - dd <- if d then parseD else return [] + cc <- if c + then do + crc <- parseC + return $ Just crc + else return Nothing + dd <- if d then parseD else return False return $ initID3ExtHeader [ extSize^=s - , extFlags^=(initExtFlags [ isUpdate^=bb - , crc^=cc - , restrictions^=dd - ]) + , isUpdate^=bb + , crcData^=cc + , restrictionsPresent^=dd ] -- | parser for @b@ flag - 'isUpdate' parseB :: TagParser Bool parseB = do - word8 0x00 + _ <- word8 0x00 return True -- | parser for @c@ flag - CRC data parseC :: TagParser [Word8] parseC = do - word8 0x05 - count 5 anyWord8 + _ <- word8 0x05 + count (5::Integer) anyWord8 -- | parser for @d@ flag - restrictions flags --- TODO: make Flags type and structure for these flags -parseD :: TagParser [Bool] +-- TODO: Properly read these flags into a data structure... +parseD :: TagParser Bool parseD = do - word8 0x01 - parseFlags_ [1..8] + _ <- word8 0x01 + _ <- anyWord8 + return True diff --git a/src/ID3/Parser/Frame.hs b/src/ID3/Parser/Frame.hs --- a/src/ID3/Parser/Frame.hs +++ b/src/ID3/Parser/Frame.hs @@ -8,10 +8,10 @@ import ID3.Parser.General import ID3.Parser.NativeFrames import ID3.Type.Frame -import ID3.Type.Flags -import ID3.Type.Header (unsynch) +import ID3.Type.Header (unsynchFlag) import Data.Accessor +import Data.Bits (testBit) import Data.Either (rights) import Data.Map (Map) import qualified Data.Map as Map @@ -50,7 +50,7 @@ frameID :: TagParser FrameID frameID = do - name <- count 4 $ upper `onFail` digit + name <- count (4::Integer) $ upper `onFail` digit posUpdate (+4) return $ C.unpack $ BS.pack name @@ -59,24 +59,49 @@ version <- tagVersionGet let (majorVersion, _) = version flags <- flagsGet - let doDecoding = (majorVersion >= 4 || flags^.unsynch) + let doDecoding = (majorVersion >= 4 || unsynchFlag flags) size <- parseSize 4 doDecoding return size +frameFlags :: TagParser FrameFlags frameFlags = do s <- frameStatusFlags `err` "status flags" f <- frameFormatFlags `err` "format flags" - return $ initFrameFlags [status^=s, format^=f] + return $ initFrameFlags [statusFlags^=s, formatFlags^=f] +frameStatusFlags :: Parser St Token StatusFlags frameStatusFlags = do - fs <- parseFlags_ [2,3,4] - return $ mkFlags [2,3,4] fs - -- i.e. %0abc0000 + (v, _) <- tagVersionGet + if v < 3 + then return $ StatusFlags v (False, False, False) + else do + flags <- anyWord8 + sizeInc + let bit = testBit flags + case v of + 3 -> + return $ StatusFlags v (bit 7, bit 6, bit 5) -- i.e., %abc00000 + 4 -> + return $ StatusFlags v (bit 6, bit 5, bit 4) -- i.e., %0abc0000 + _ -> + error "internal error: status flag bits for unknown version" +frameFormatFlags :: Parser St Token FormatFlags frameFormatFlags = do - fs <- parseFlags_ [2,5,6,7,8] - return $ mkFlags [2,5,6,7,8] fs - -- i.e. %0h00kmnp + (v, _) <- tagVersionGet + if v < 3 + then return $ FormatFlags v (False, False, False, False, False) + else do + flags <- anyWord8 + sizeInc + let bit = testBit flags + case v of + 3 -> + return $ FormatFlags v (bit 5, bit 7, bit 6, False, False) -- i.e., %ijk00000 + 4 -> + return $ FormatFlags v (bit 6, bit 3, bit 2, bit 1, bit 0) -- i.e., %0h00kmnp + _ -> + error "internal error: format flag bits for unknown version" -- {-- FRAME CONTENT diff --git a/src/ID3/Parser/General.hs b/src/ID3/Parser/General.hs --- a/src/ID3/Parser/General.hs +++ b/src/ID3/Parser/General.hs @@ -3,21 +3,17 @@ ---- IMPORTS import Text.ParserCombinators.Poly.State (Parser, runParser, stGet, stUpdate, onFail, next, - satisfy, adjustErr, exactly) + satisfy, adjustErr) import ID3.Parser.UnSync -import ID3.Type.Header (TagVersion, unsynch) -import ID3.Type.Flags (Flags(..)) +import ID3.Type.Header (TagVersion, TagFlags(..)) --import qualified Data.ByteString.Lazy as BS --import qualified Data.ByteString.Lazy.Char8 as C import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C import Data.Word (Word8) -import Bits -import Data.Accessor import qualified Data.Text as Text -import Data.Text.Encoding (decodeASCII, decodeUtf16LE, decodeUtf16BE, decodeUtf8) -import Data.ByteString.Lazy.UTF8 (toString) -import Codec.Binary.UTF8.String as Codec +import Data.Text.Encoding (decodeUtf16LE, decodeUtf16BE, decodeUtf8) +import Data.Char (chr) import Control.Monad (when) ---- @@ -27,7 +23,7 @@ -- | Parsers state data St = State { id3TagVersion :: TagVersion - , headerFlags :: Flags -- ^ flags from tag's header + , headerFlags :: TagFlags -- ^ flags from tag's header , tagPos :: Integer -- ^ current position in tag -- , frFlags :: [Bool]} -- ^ current frame flags , curSize :: Integer -- ^ current frame size @@ -35,7 +31,8 @@ instance Show St where show st = show (tagPos st, curSize st) -initState = State (4, 0) (Flags []) 0 10 +initState :: St +initState = State (4, 0) (TagFlags (False, False, False, False)) 0 10 type CharEncoding = Integer @@ -53,10 +50,10 @@ tagVersionSet v = stUpdate (\st -> st {id3TagVersion = v}) ---,-------------------------------- -flagsGet :: TagParser Flags +flagsGet :: TagParser TagFlags flagsGet = stGet >>= return . headerFlags -flagsSet :: Flags -> TagParser () +flagsSet :: TagFlags -> TagParser () flagsSet fs = stUpdate (\st -> st {headerFlags = fs}) ---,-------------------------------- @@ -108,6 +105,7 @@ -- | Wrapper for atomic parsers. -- Increases 'tagPos' and decreases 'curSize'. +withSize :: TagParser b -> TagParser b withSize p = do x <- p sizeDec @@ -161,8 +159,6 @@ xs <- manyTill' p end return (x:xs)) -skipTill p end = end `onFail` do {p; skipTill p end} - ---,-------------------------------- -- | Parse a list of items separated by discarded junk. sepBy' :: TagParser a -> TagParser sep -> TagParser [a] @@ -177,7 +173,7 @@ ---,-------------------------------- -- | 'count n p' parses a precise number of items, n, using the parser p, in sequence. -count :: (Num n) => n -> TagParser a -> TagParser [a] +count :: (Num n, Eq n) => n -> TagParser a -> TagParser [a] count 0 _ = return [] count n p = do x <- p @@ -185,7 +181,7 @@ return (x:xs) -- | 'count' n p' parses a precise number of items, n, using the parser p, in sequence. -count' :: (Num n) => n -> TagParser a -> TagParser [a] +count' :: (Num n, Eq n) => n -> TagParser a -> TagParser [a] count' 0 _ = return [] count' n p = ifSize $ do x <- p @@ -194,15 +190,20 @@ ---,-------------------------------- -- | Hybrid of 'count' and 'sepBy\'' -countSepBy' :: (Num n) => n -> TagParser a -> TagParser sep -> TagParser [a] +countSepBy' :: (Num n, Eq n) => n -> TagParser a -> TagParser sep -> TagParser [a] countSepBy' 0 _ _ = return [] countSepBy' n p sep = ifSize $ do x <- p xs <- count' (n-1) (sep >> p) return (x:xs) +-- decodeLatin1 is due to be merged into Data.Text.Encoding +-- https://github.com/hvr/text/commit/c1c338717e4c278b54d940ec00df926f83ec3643 +-- http://stackoverflow.com/questions/7544919/convert-between-latin1-encoded-data-bytestring-and-data-text +-- In the meantime we just hack it. + encPack :: CharEncoding -> [Token] -> String -encPack 0x00 s = Text.unpack $ decodeASCII $ BS.pack s +encPack 0x00 s = map (chr . fromIntegral) s encPack 0x01 (0xFF:0xFE:s) = Text.unpack $ decodeUtf16LE $ BS.pack s encPack 0x01 (0xFE:0xFF:s) = Text.unpack $ decodeUtf16BE $ BS.pack s encPack 0x02 s = Text.unpack $ decodeUtf16BE $ BS.pack s @@ -228,6 +229,7 @@ else return [] -- any byte except null +nonNull :: Parser St Token Token nonNull = withSize $ satisfy (/=0x00) `adjustErr` (++"\nWTF: nonNull") -- | Parses a character-encoding "code", a one-byte value that should be 0, 1, 2, or 3 @@ -251,7 +253,7 @@ -- | Parses 3 bytes of language value (as a String) and returns a pair ("Language", value) parseLanguage :: TagParser String parseLanguage = do - lang <- count' 3 anyWord8 + lang <- count' (3 :: Integer) anyWord8 return $ encPack 0x03 lang --(<|>) = onFail @@ -295,6 +297,7 @@ anyWord8 :: TagParser Token anyWord8 = withSize next `err` "anyWord8" +err :: TagParser t -> String -> TagParser t err p s = do pos <- posGet p `adjustErr` (++"\n"++"at "++(show pos)++": "++s) @@ -309,13 +312,3 @@ let size = if unsynchDecode then unSynchronise s else wordsToInteger s sizeSet size return size - --- | Takes template of flags-byte and returns it as ['Bool'] value. --- For example, for %abcd0000 template you should use 'parseFlags_ [1..4]'. -parseFlags_ :: [Int] -> TagParser [Bool] -parseFlags_ nums = do - flag <- anyWord8 - sizeInc --- posInc - return $ map (\i -> testBit flag (i-1)) nums - diff --git a/src/ID3/Parser/Header.hs b/src/ID3/Parser/Header.hs --- a/src/ID3/Parser/Header.hs +++ b/src/ID3/Parser/Header.hs @@ -1,20 +1,11 @@ -{- | -This module provides parsers for Header. - -() --} -module ID3.Parser.Header - ( parseHeader - , parseFooter - ) -where +module ID3.Parser.Header (parseHeader, parseFooter) where ---- IMPORTS import Text.ParserCombinators.Poly.State import ID3.Parser.General import ID3.Type.Header -import ID3.Type.Flags import Data.Accessor +import Data.Bits (testBit) ---- @@ -22,9 +13,10 @@ -- | Parses id3v2 'Header' parseHeader :: TagParser ID3Header parseHeader = do - string "ID3" `err` "ID3" + _ <- string "ID3" `err` "ID3" parseHeader_ +parseHeader_ :: Parser St Token ID3Header parseHeader_ = do v <- parseVersion `err` "tag version" f <- parseFlags `err` "tag flags" @@ -39,9 +31,9 @@ parseFlags :: TagParser TagFlags parseFlags = do - fs <- parseFlags_ [1..4] - return $ mkFlags [1..4] fs - -- i.e. %abcd0000 + flags <- anyWord8 + let bit = testBit flags + return $ TagFlags (bit 7, bit 6, bit 5, bit 4) parseTagSize :: TagParser TagSize parseTagSize = parseSize 4 True @@ -64,5 +56,5 @@ -} parseFooter :: TagParser ID3Header parseFooter = do - string "3DI" + _ <- string "3DI" parseHeader_ diff --git a/src/ID3/Parser/NativeFrames.hs b/src/ID3/Parser/NativeFrames.hs --- a/src/ID3/Parser/NativeFrames.hs +++ b/src/ID3/Parser/NativeFrames.hs @@ -2,11 +2,10 @@ where -- {-- IMPORTS -import qualified Data.ByteString.Lazy as BS -import qualified Data.ByteString.Lazy.Char8 as C import ID3.Parser.UnSync import ID3.Parser.General import ID3.Type.FrameInfo +import Text.ParserCombinators.Poly.StateParser (Parser) {-import ID3.Type.Frame-} ----} @@ -33,9 +32,9 @@ textInfo :: String -> TagParser FrameInfo textInfo _ = do - enc <- parseEncoding - info <- parseString enc - return $ Text enc info + enc0 <- parseEncoding + info <- parseString enc0 + return $ Text enc0 info ---- {-- 4.3. URL link frames @@ -53,9 +52,10 @@ -- described in 4.3.2.> -- URL -urlInfo name = do - url <- parseString 0 - return $ URL url +urlInfo :: String -> Parser St Token FrameInfo +urlInfo _ = do + url0 <- parseString 0 + return $ URL url0 ---- {-- 4.1. Unique file identifier @@ -80,10 +80,11 @@ -- Owner identifier $00 -- Identifier +frameInfo :: String -> Parser St Token FrameInfo frameInfo "UFID" = do - ownerId <- parseString 0 + ownerId0 <- parseString 0 identifier <- many' anyWord8 - return $ UFID ownerId identifier + return $ UFID ownerId0 identifier ---- --} @@ -487,7 +488,7 @@ ---- --} frameInfo "TCMP" = do - parseEncoding -- XXX: Is the encoding really not used here?? + _ <- parseEncoding -- XXX: Is the encoding really not used here?? f <- parseNumber return $ TCMP (f == 1) @@ -505,10 +506,10 @@ -- Value frameInfo "TXXX" = do - enc <- parseEncoding - descr <- parseString enc - value <- parseString enc - return $ TXXX enc descr value + enc0 <- parseEncoding + descr0 <- parseString enc0 + value0 <- parseString enc0 + return $ TXXX enc0 descr0 value0 ---- --} }}} @@ -574,10 +575,10 @@ -- URL frameInfo "WXXX" = do - enc <- parseEncoding - descr <- parseString enc - url <- parseString 0 -- URLs are always encoded in ISO-8859-1 (I think) - return $ WXXX enc descr url + enc0 <- parseEncoding + descr0 <- parseString enc0 + url0 <- parseString 0 -- URLs are always encoded in ISO-8859-1 (I think) + return $ WXXX enc0 descr0 url0 ---- --} }}} @@ -599,9 +600,9 @@ -- CD TOC frameInfo "MCDI" = do - sz <- sizeGet - tocData <- many' anyWord8 - return $ MCDI tocData + _ <- sizeGet + tocData0 <- many' anyWord8 + return $ MCDI tocData0 ---- --} @@ -760,11 +761,11 @@ -- Lyrics/text frameInfo "USLT" = do - enc <- parseEncoding - lang <- parseLanguage - descr <- parseString enc - text <- parseString enc - return $ USLT enc lang descr text + enc0 <- parseEncoding + lang0 <- parseLanguage + descr0 <- parseString enc0 + text0 <- parseString enc0 + return $ USLT enc0 lang0 descr0 text0 ---- --} @@ -860,12 +861,12 @@ -- The actual text frameInfo "COMM" = do - enc <- parseEncoding - lang <- parseLanguage - descr <- parseString enc - text <- parseString enc + enc0 <- parseEncoding + lang0 <- parseLanguage + descr0 <- parseString enc0 + text0 <- parseString enc0 --many' terminator -- ???!!!! - return $ COMM enc lang descr text + return $ COMM enc0 lang0 descr0 text0 ---- --} @@ -1008,12 +1009,12 @@ -- Picture data frameInfo "APIC" = do - enc <- parseEncoding - mime <- parseString 0 -- mimetype always encoded in ISO-8859-1 - picType <- anyWord8 - descr <- parseString enc - picData <- many' anyWord8 - return $ APIC enc mime picType descr picData + enc0 <- parseEncoding + mime0 <- parseString 0 -- mimetype always encoded in ISO-8859-1 + picType0 <- anyWord8 + descr0 <- parseString enc0 + picData0 <- many' anyWord8 + return $ APIC enc0 mime0 picType0 descr0 picData0 -- Picture type: $00 Other -- $01 32x32 pixels 'file icon' (PNG only) @@ -1382,9 +1383,9 @@ -- The private data frameInfo "PRIV" = do - ownerId <- parseString 0 - privateData <- many' anyWord8 - return $ PRIV ownerId privateData + ownerId0 <- parseString 0 + privateData0 <- many' anyWord8 + return $ PRIV ownerId0 privateData0 ---- --} @@ -1493,5 +1494,5 @@ -- for some reason... All frames coming after the unidentified frame -- will fail to be read. frameInfo _ = do - frameData <- many' anyWord8 - return $ Unknown frameData + frameData0 <- many' anyWord8 + return $ Unknown frameData0 diff --git a/src/ID3/Parser/Tag.hs b/src/ID3/Parser/Tag.hs --- a/src/ID3/Parser/Tag.hs +++ b/src/ID3/Parser/Tag.hs @@ -20,9 +20,9 @@ parseTag_ h = do tagVersionSet (h^.tagVersion) flagsSet (h^.tagFlags) - ext <- if (h^.tagFlags^.extended) + ext <- if (extendedHeaderFlag $ h^.tagFlags) then parseExtHeader >>= return . Just else return Nothing `err` "ext header" - (idList, fs) <- parseFrames `err` "frames" - if (h^.tagFlags^.footed) then parseFooter else return h `err` "footer" + (idList, fs) <- parseFrames `err` "frames" + _ <- if (footerFlag $ h^.tagFlags) then parseFooter else return h `err` "footer" return $ initID3Tag [header^=h, extHeader^=ext, frames^=fs, framesOrder^=idList, padding^=(h^.tagSize) - (framesSize fs)] diff --git a/src/ID3/Parser/UnSync.hs b/src/ID3/Parser/UnSync.hs --- a/src/ID3/Parser/UnSync.hs +++ b/src/ID3/Parser/UnSync.hs @@ -100,7 +100,7 @@ -- | converting list of bytes to 'Integer' value wordsToInteger :: [Word8] -> Integer -wordsToInteger = sum . (zipWith (*) (iterate (*16^2) 1)) . reverse . map toInteger +wordsToInteger = sum . (zipWith (*) (iterate (*16^(2::Integer)) 1)) . reverse . map toInteger -- | unsynchronisation between 'Integer's unSyncInteger :: Integer -> Integer @@ -119,8 +119,8 @@ integerToWords :: Int -> Integer -> [Word8] integerToWords n x = map (fromInteger . getByte x) $ reverse [0..(n-1)] where - byte n = 2^(8*n) * (2^8 - 1) - x `getByte` n = (x .&. (byte n)) `shiftR` (8*n) + byte n0 = 2^(8*n0) * (2^(8::Integer) - 1) + x0 `getByte` n0 = (x0 .&. (byte n0)) `shiftR` (8*n0) -- | synchronisation between 'Integer's diff --git a/src/ID3/Simple.hs b/src/ID3/Simple.hs --- a/src/ID3/Simple.hs +++ b/src/ID3/Simple.hs @@ -27,13 +27,13 @@ type Tag = ID3Tag getFrameText :: FrameID -> Tag -> Maybe String -getFrameText id tag = case tag^.frame id of +getFrameText frid tag = case tag^.frame frid of Nothing -> Nothing Just fr -> Just (fr^.textContent) setFrameText :: FrameID -> String -> Tag -> Tag -setFrameText id x tag = edit $ fromMaybe (initFrame id) (tag^.frame id) - where edit f = (frame id) ^= Just (updateSize $ textContent^=x $ f ) $ tag +setFrameText frid x tag = edit $ fromMaybe (initFrame frid) (tag^.frame frid) + where edit f = (frame frid) ^= Just (updateSize $ textContent^=x $ f ) $ tag ----------------------------------- diff --git a/src/ID3/Type/ExtHeader.hs b/src/ID3/Type/ExtHeader.hs --- a/src/ID3/Type/ExtHeader.hs +++ b/src/ID3/Type/ExtHeader.hs @@ -1,25 +1,9 @@ -module ID3.Type.ExtHeader - ( - -- * ID3 Extended Header - -- ** Types - ID3ExtHeader - , emptyID3ExtHeader - , initID3ExtHeader - , ExtFlags - , emptyExtFlags - , initExtFlags - -- ** Accessors - , extSize - , extFlags - , isUpdate - , crc - , restrictions - ) -where +module ID3.Type.ExtHeader (ID3ExtHeader, initID3ExtHeader, extSize, isUpdate, crcData, + restrictionsPresent) where import Data.Accessor import Data.Accessor.Basic (compose) -import ID3.Type.Flags +import ID3.Type.Flags (flagsToWord8) import ID3.Type.Unparse import Data.Word (Word8) @@ -42,31 +26,56 @@ thus never have a size of fewer than six bytes. -} data ID3ExtHeader = ID3ExtHeader - { extSize_ :: Integer -- ^ size of extended header - , extFlags_ :: ExtFlags -- ^ flags + { extSize_ :: Integer -- ^ size of extended header + , isUpdate_ :: Bool -- ^ is this tag an update? + , crcData_ :: Maybe [Word8] -- ^ CRC data, if present + + -- XXX: No support for actually reading restriction bits yet?? + , restrictionsPresent_ :: Bool -- ^ Are tag restrictions present? + --, extFlags_ :: ExtFlags -- ^ flags } deriving Eq -- | Forming empty value to return, if there is no Extended Header -emptyID3ExtHeader = ID3ExtHeader 0 emptyExtFlags +emptyID3ExtHeader :: ID3ExtHeader +emptyID3ExtHeader = ID3ExtHeader 0 False Nothing False +initID3ExtHeader :: [ID3ExtHeader -> ID3ExtHeader] -> ID3ExtHeader initID3ExtHeader = flip compose emptyID3ExtHeader +extSize :: Accessor ID3ExtHeader Integer extSize = accessor extSize_ (\x e -> e {extSize_ = x}) -extFlags = accessor extFlags_ (\x e -> e {extFlags_ = x}) +isUpdate :: Accessor ID3ExtHeader Bool +isUpdate = accessor isUpdate_ (\x e -> e {isUpdate_ = x}) +crcData :: Accessor ID3ExtHeader (Maybe [Word8]) +crcData = accessor crcData_ (\x e -> e {crcData_ = x}) +restrictionsPresent :: Accessor ID3ExtHeader Bool +restrictionsPresent = accessor restrictionsPresent_ (\x e -> e {restrictionsPresent_ = x}) +--extFlags = accessor extFlags_ (\x e -> e {extFlags_ = x}) + instance Show ID3ExtHeader where - show eh = if (eh^.extSize)==0 then "" else - "Extended Header:\n"++ - "Size: "++(show $ eh^.extSize)++" bytes\n"++ - (show $ eh^.extFlags) + show eh = if (eh^.extSize) == 0 then "" else + ("Extended Header:\n" ++ + "Size: " ++ (show $ eh^.extSize) ++ " bytes\n" ++ + "Extended Flags:\n" ++ + (if eh^.isUpdate then "\t- This tag is an update\n" else "") ++ + (if eh^.crcData /= Nothing then "\t- There is some CRC data...\n" else "") ++ + (if eh^.restrictionsPresent then "\t- There are some restrictions...\n" else "")) + --(show $ eh^.extFlags) instance Parsed ID3ExtHeader where unparse eh = (unparse $ eh^.extSize) ++ - [0x01] ++ - (unparse $ initFlags [ (accessFlag 2)^=(eh^.extFlags^.isUpdate ) - , (accessFlag 3)^=(eh^.extFlags^.crc == []) - , (accessFlag 4)^=(eh^.extFlags^.restrictions == []) - ]) ++ - (unparse $ eh^.extFlags) + [0x01, (flagsToWord8 (False, eh^.isUpdate, eh^.crcData /= Nothing, + eh^.restrictionsPresent, False, False, False, False))] ++ + --(unparse $ initFlags [ (accessFlag 2)^=(eh^.extFlags^.isUpdate ) + -- , (accessFlag 3)^=(eh^.extFlags^.crc == []) + -- , (accessFlag 4)^=(eh^.extFlags^.restrictions == []) + -- ]) ++ + (if eh^.isUpdate then [0x00] else []) ++ + (case eh^.crcData of { Nothing -> []; Just crc -> [0x05] ++ crc }) ++ + (if eh^.restrictionsPresent then + [0x01] ++ + (error $ "No support for writing extended-header restriction flags yet!") + else []) {- | /Extended Header Flags Meaning/ @@ -180,6 +189,8 @@ otherwise. @ -} + +{- data ExtFlags = ExtFlags { extIsUpdate :: Bool -- ^ True if tag is an update , extCrc :: [Word8] -- ^ CRC data present @@ -203,3 +214,4 @@ unparse ef = (if ef^.isUpdate then [0x00] else []) ++ (if ef^.crc /= [] then [0x05]++(ef^.crc) else []) ++ (if ef^.restrictions /= [] then [0x01]++(unparse $ Flags $ ef^.restrictions) else []) +-} diff --git a/src/ID3/Type/Flags.hs b/src/ID3/Type/Flags.hs --- a/src/ID3/Type/Flags.hs +++ b/src/ID3/Type/Flags.hs @@ -1,30 +1,10 @@ -module ID3.Type.Flags -where +module ID3.Type.Flags (flagsToWord8) where -import Data.Accessor -import Data.Accessor.Basic (compose) -import Data.Bits +import Data.Bits (bit) import Data.Word (Word8) -import ID3.Type.Unparse -data Flags = Flags [Bool] deriving (Eq, Show) - -emptyFlags :: Flags -emptyFlags = Flags $ replicate 8 False - -initFlags = flip compose emptyFlags - --- It works as 'initFlags', but changes only specified values -mkFlags ns fs = initFlags $ zipWith access ns fs - where access n f = (accessFlag n) ^= f - -allFlags :: Accessor Flags [Bool] -allFlags = accessor (\(Flags fs) -> fs) (\x _ -> Flags x) - -accessFlag :: Int -> Accessor Flags Bool -accessFlag n = accessor (\(Flags fs) -> fs!!(n-1)) (\x (Flags fs) -> Flags $ (take (n-1) fs)++[x]++(drop n fs)) - -instance Parsed Flags where - unparse fs = [foldr fromBool 0 (zip [0..] (fs^.allFlags))] - where fromBool (i, True) = flip setBit i - fromBool (i, False) = flip clearBit i +flagsToWord8 :: (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) -> Word8 +flagsToWord8 (b7, b6, b5, b4, b3, b2, b1, b0) = getBit 7 b7 + getBit 6 b6 + getBit 5 b5 + + getBit 4 b4 + getBit 3 b3 + getBit 2 b2 + + getBit 1 b1 + getBit 0 b0 + where getBit bitNum shouldSet = if shouldSet then bit bitNum else 0 diff --git a/src/ID3/Type/Frame.hs b/src/ID3/Type/Frame.hs --- a/src/ID3/Type/Frame.hs +++ b/src/ID3/Type/Frame.hs @@ -5,7 +5,9 @@ import ID3.Type.Flags import ID3.Type.Unparse import ID3.Type.FrameInfo -import ID3.Parser.NativeFrames +import Numeric +import Data.Char +import Data.Word {-- | /ID3V2 FRAME OVERVIEW/ @@ -26,10 +28,14 @@ , frInfo_ :: FrameInfo -- ^ frame Information Value } deriving Eq +emptyID3Frame :: ID3Frame emptyID3Frame = ID3Frame emptyFrameHeader (Unknown []) +initID3Frame :: [ID3Frame -> ID3Frame] -> ID3Frame initID3Frame = flip compose emptyID3Frame +frHeader :: Accessor ID3Frame FrameHeader frHeader = accessor frHeader_ (\x fr -> fr {frHeader_ = x}) +frInfo :: Accessor ID3Frame FrameInfo frInfo = accessor frInfo_ (\x fr -> fr {frInfo_ = x}) instance HasSize ID3Frame where @@ -37,6 +43,7 @@ --content :: (FrameInfo -> a) -> Accessor ID3Frame a --content a = accessor (\f -> a (f^.frInfo)) (\x f -> frInfo^=((f^.frInfo) {a=x}) $ f) +textContent :: Accessor ID3Frame String textContent = frInfo .> infoTextContent instance Show ID3Frame where @@ -62,11 +69,16 @@ , frFlags_ :: FrameFlags -- ^ frame Flags } deriving Eq +emptyFrameHeader :: FrameHeader emptyFrameHeader = FrameHeader "" 0 emptyFrameFlags +initFrameHeader :: [FrameHeader -> FrameHeader] -> FrameHeader initFrameHeader = flip compose emptyFrameHeader +frID :: Accessor FrameHeader FrameID frID = accessor frID_ (\x h -> h {frID_ = x}) +frSize :: Accessor FrameHeader FrameSize frSize = accessor frSize_ (\x h -> h {frSize_ = x}) +frFlags :: Accessor FrameHeader FrameFlags frFlags = accessor frFlags_ (\x h -> h {frFlags_ = x}) @@ -129,25 +141,31 @@ altered', i.e. @%00000000@. --} data FrameFlags = FrameFlags - { statusF :: StatusFlags -- ^ Frame status flags - , formatF :: FormatFlags -- ^ Frame format flags - } deriving Eq + { statusFlags_ :: StatusFlags -- ^ Frame status flags + , formatFlags_ :: FormatFlags -- ^ Frame format flags + } deriving Eq -emptyFrameFlags = FrameFlags emptyFlags emptyFlags +emptyFrameFlags :: FrameFlags +emptyFrameFlags = FrameFlags (StatusFlags 4 (False, False, False)) + (FormatFlags 4 (False, False, False, False, False)) +initFrameFlags :: [FrameFlags -> FrameFlags] -> FrameFlags initFrameFlags = flip compose emptyFrameFlags -status = accessor statusF (\x fs -> fs {statusF = x}) -format = accessor formatF (\x fs -> fs {formatF = x}) +statusFlags :: Accessor FrameFlags StatusFlags +statusFlags = accessor statusFlags_ (\x fs -> fs {statusFlags_ = x}) +formatFlags :: Accessor FrameFlags FormatFlags +formatFlags = accessor formatFlags_ (\x fs -> fs {formatFlags_ = x}) instance Show FrameFlags where - show fs = if not ((or $ fs^.status^.allFlags) || (or $ fs^.format^.allFlags)) then "" else - "\tFlags:\n"++ - (showStatusFlags $ fs^.status)++"\n"++ - (showFormatFlags $ fs^.format) + show fs = if not ((anyStatusFlagsOn $ fs^.statusFlags) || (anyFormatFlagsOn $ fs^.formatFlags)) + then "" else + "\tFlags " ++ (showBinary $ unparse $ fs^.statusFlags) ++ + " " ++ (showBinary $ unparse $ fs^.formatFlags) ++ ":\n"++ + (showStatusFlags $ fs^.statusFlags) ++ "\n" ++ + (showFormatFlags $ fs^.formatFlags) instance Parsed FrameFlags where - unparse fs = (unparse $ fs^.status ) ++ - (unparse $ fs^.format ) + unparse fs = (unparse $ fs^.statusFlags) ++ (unparse $ fs^.formatFlags) {-- | /Frame status flags/ @@ -185,19 +203,37 @@ without taking the proper means to compensate, e.g. recalculating the signature, the bit MUST be cleared. --} -type StatusFlags = Flags +data StatusFlags = StatusFlags Word8 (Bool, Bool, Bool) deriving Eq -frameDiscard = accessFlag 1 -fileDiscard = accessFlag 2 -readOnly = accessFlag 3 +frameDiscardFlag :: StatusFlags -> Bool +frameDiscardFlag (StatusFlags _ (a, _, _)) = a +fileDiscardFlag :: StatusFlags -> Bool +fileDiscardFlag (StatusFlags _ (_, b, _)) = b +readOnlyFlag :: StatusFlags -> Bool +readOnlyFlag (StatusFlags _ (_, _, c)) = c +anyStatusFlagsOn :: StatusFlags -> Bool +anyStatusFlagsOn (StatusFlags _ (a, b, c)) = a || b || c -showStatusFlags stat = if not (or $ stat^.allFlags) then "" else - "\t\tStatus Flags:\n"++ - (if stat^.frameDiscard then "\t\t\t- Frame should be discarded\n" else "")++ - (if stat^.fileDiscard then "\t\t\t- Frame should be discarded\n" else "")++ - (if stat^.readOnly then "\t\t\t- Read only!\n" else "") +showBinary :: [Word8] -> String +showBinary [n] = + pad $ showIntAtBase 2 intToDigit n "" + where + pad s = replicate (8 - length s) '0' ++ s +showBinary _ = error "internal error: flags unparsed incorrectly" +showStatusFlags :: StatusFlags -> String +showStatusFlags stat = if not (anyStatusFlagsOn stat) then "" else "\t\tStatus Flags:\n" ++ finfo + where finfo = (if frameDiscardFlag stat then "\t\t\t- Frame should be discarded when tag is altered\n" else "") ++ + (if fileDiscardFlag stat then "\t\t\t- Frame should be discarded when file contents are altered\n" else "") ++ + (if readOnlyFlag stat then "\t\t\t- Frame is read only!\n" else "") +instance Parsed StatusFlags where + unparse (StatusFlags v (a, b, c)) = + case v of + 3 -> [flagsToWord8 (a, b, c, False, False, False, False, False)] + 4 -> [flagsToWord8 (False, a, b, c, False, False, False, False)] + _ -> [0] + {-- | /Frame format flags/ Format: @%0h00kmnp@ where @@ -266,27 +302,44 @@ 1 A data length Indicator has been added to the frame. @ --} -type FormatFlags = Flags +data FormatFlags = FormatFlags Word8 (Bool, Bool, Bool, Bool, Bool) deriving Eq -groupPart = accessFlag 1 -- Grouping identity -compressed = accessFlag 2 -- Compression -encrypted = accessFlag 3 -- Encryption -unsychronised = accessFlag 4 -- Unsynchronisation -dataLengthId = accessFlag 5 -- Data length indicator +groupPartFlag :: FormatFlags -> Bool +groupPartFlag (FormatFlags _ (h, _, _, _, _)) = h -- Grouping identity +compressedFlag :: FormatFlags -> Bool +compressedFlag (FormatFlags _ (_, k, _, _, _)) = k -- Compression +encryptedFlag :: FormatFlags -> Bool +encryptedFlag (FormatFlags _ (_, _, m, _, _)) = m -- Encryption +unsychronisedFlag :: FormatFlags -> Bool +unsychronisedFlag (FormatFlags _ (_, _, _, n, _)) = n -- Unsynchronisation +dataLengthIdFlag :: FormatFlags -> Bool +dataLengthIdFlag (FormatFlags _ (_, _, _, _, p)) = p -- Data length indicator +anyFormatFlagsOn :: FormatFlags -> Bool +anyFormatFlagsOn (FormatFlags _ (h, k, m, n, p)) = h || k || m || n || p -showFormatFlags form = if not (or $ form^.allFlags) then "" else - "\t\tFormat Flags:\n"++ - (if form^.groupPart then "\t\t\t- frame is a part of group\n" else "")++ - (if form^.compressed then "\t\t\t- frame is compressed\n" else "")++ - (if form^.encrypted then "\t\t\t- frame is encrypted\n" else "")++ - (if form^.unsychronised then "\t\t\t- frame is unsynchronised\n" else "")++ - (if form^.dataLengthId then "\t\t\t- frame has data length indicator\n" else "") +showFormatFlags :: FormatFlags -> String +showFormatFlags fs = if not (anyFormatFlagsOn fs) then "" else finfo + where finfo = "\t\tFormat Flags:\n" ++ (concat $ map (\i -> "\t\t\t- " ++ i ++ "\n") items) + items = [] ++ + (if groupPartFlag fs then ["frame is a part of group"] else []) ++ + (if compressedFlag fs then ["frame is compressed"] else []) ++ + (if encryptedFlag fs then ["frame is encrypted"] else []) ++ + (if unsychronisedFlag fs then ["frame is unsynchronised"] else []) ++ + (if dataLengthIdFlag fs then ["frame has data length indicator"] else []) +instance Parsed FormatFlags where + unparse (FormatFlags v (h, k, m, n, p)) = + case v of + 3 -> [flagsToWord8 (k, m, h, False, False, False, False, False)] + 4 -> [flagsToWord8 (False, h, False, False, k, m, n, p)] + _ -> [0] + -------------------------------------------------------------------------------------------- -initFrame id = updateSize $ initID3Frame [ frHeader.>frID ^= id, frInfo ^= inf ] - where inf = case id of +initFrame :: FrameID -> ID3Frame +initFrame frid = updateSize $ initID3Frame [ frHeader.>frID ^= frid, frInfo ^= inf ] + where inf = case frid of "UFID" -> UFID "" [] "TXXX" -> TXXX 03 "" "" "TCMP" -> TCMP False diff --git a/src/ID3/Type/FrameInfo.hs b/src/ID3/Type/FrameInfo.hs --- a/src/ID3/Type/FrameInfo.hs +++ b/src/ID3/Type/FrameInfo.hs @@ -1,8 +1,8 @@ module ID3.Type.FrameInfo where -import ID3.Parser.UnSync (synchronise, integerToWords) +import ID3.Parser.UnSync (integerToWords) import ID3.Type.Unparse -import Codec.Binary.UTF8.String (encode, encodeString, decode) +import Codec.Binary.UTF8.String (encode) import Data.Accessor import Data.Word (Word8) @@ -70,45 +70,47 @@ deriving (Eq, Show) +encodeAll :: [String] -> [Word8] encodeAll = concatMap encode +infoTextContent :: Accessor FrameInfo String infoTextContent = accessor text (\x f -> f {text = x}) --url = accessor (encode . url) (\x f -> f {url = decode x}) instance Parsed FrameInfo where unparse inf = case inf of - UFID owner theid -> (encode owner) ++ [0x00] ++ theid - Text enc text -> (fromInteger enc) : (encode text) - TXXX enc descr text -> (fromInteger enc) : (encode descr) ++ [0x00] ++ (encode text) - URL url -> encode url - WXXX enc descr url -> (fromInteger enc) : (encode descr) ++ [0x00] ++ (encode url) - MCDI tocData -> tocData + UFID owner0 theid0 -> (encode owner0) ++ [0x00] ++ theid0 + Text enc0 text0 -> (fromInteger enc0) : (encode text0) + TXXX enc0 descr0 text0 -> (fromInteger enc0) : (encode descr0) ++ [0x00] ++ (encode text0) + URL url0 -> encode url0 + WXXX enc0 descr0 url0 -> (fromInteger enc0) : (encode descr0) ++ [0x00] ++ (encode url0) + MCDI tocData0 -> tocData0 --ETCO -- { format :: Integer -- , events :: [Event]} -- TODO --MLLT -- TODO --SYTC -- TODO - USLT enc lang descr text -> (fromInteger enc) : (encodeAll [lang, descr]) ++ [0x00] ++ (encode text) + USLT enc0 lang0 descr0 text0 -> (fromInteger enc0) : (encodeAll [lang0, descr0]) ++ [0x00] ++ (encode text0) --SYLT enc lang timeFormat content descr - COMM enc lang descr text -> (fromInteger enc) : (encodeAll [lang, descr]) ++ [0x00] ++ (encode text) + COMM enc0 lang0 descr0 text0 -> (fromInteger enc0) : (encodeAll [lang0, descr0]) ++ [0x00] ++ (encode text0) --RVA2 -- TODO --EQU2 -- TODO --RVRB -- TODO - APIC enc mime picType descr picData -> (fromInteger enc) : (encode mime) ++ [0x00,picType] ++ (encode descr) ++[0x00]++ picData + APIC enc0 mime0 picType0 descr0 picData0 -> (fromInteger enc0) : (encode mime0) ++ [0x00,picType0] ++ (encode descr0) ++[0x00]++ picData0 --GEOB -- TODO - PCNT counter -> integerToWords 4 counter - POPM email rating counter -> (encode email) ++ [0x00, fromInteger rating] ++ (integerToWords 4 counter) + PCNT counter0 -> integerToWords 4 counter0 + POPM email0 rating0 counter0 -> (encode email0) ++ [0x00, fromInteger rating0] ++ (integerToWords 4 counter0) --RBUF -- TODO --AENC -- TODO --LINK -- TODO --POSS -- TODO - USER enc lang text -> (fromInteger enc) : (encode lang) ++ [0x00] ++ (encode text) + USER enc0 lang0 text0 -> (fromInteger enc0) : (encode lang0) ++ [0x00] ++ (encode text0) --OWNE -- TODO --COMR -- TODO --ENCR -- TODO --GRID -- TODO - PRIV ownerId privateData -> (encode ownerId) ++ privateData + PRIV ownerId0 privateData0 -> (encode ownerId0) ++ privateData0 --SIGN -- TODO --ASPI -- TODO - TCMP isPart -> 0x03 : (encode $ if isPart then "1" else "0") + TCMP isPart0 -> 0x03 : (encode $ if isPart0 then "1" else "0") Unknown x -> x f -> error $ "No pattern matched for encoding following frame: " ++ show f diff --git a/src/ID3/Type/Header.hs b/src/ID3/Type/Header.hs --- a/src/ID3/Type/Header.hs +++ b/src/ID3/Type/Header.hs @@ -1,8 +1,7 @@ -module ID3.Type.Header -where +module ID3.Type.Header where import ID3.Type.Unparse -import ID3.Type.Flags +import ID3.Type.Flags (flagsToWord8) import Data.Word (Word8) import Data.Accessor import Data.Accessor.Basic (compose) @@ -33,11 +32,17 @@ , tagSize_ :: TagSize -- ^ full size of tag } deriving Eq -emptyID3Header = ID3Header (4, 0) emptyFlags 0 +emptyID3Header :: ID3Header +--emptyID3Header = ID3Header (4, 0) emptyFlags 0 +emptyID3Header = ID3Header (4, 0) (TagFlags (False, False, False, False)) 0 +initID3Header :: [ID3Header -> ID3Header] -> ID3Header initID3Header = flip compose emptyID3Header +tagVersion :: Accessor ID3Header TagVersion tagVersion = accessor tagVersion_ (\v h -> h {tagVersion_ = v}) +tagFlags :: Accessor ID3Header TagFlags tagFlags = accessor tagFlags_ (\f h -> h {tagFlags_ = f}) +tagSize :: Accessor ID3Header TagSize tagSize = accessor tagSize_ (\s h -> h {tagSize_ = s}) instance Show ID3Header where @@ -94,19 +99,29 @@ are set, the tag might not be readable for a parser that does not know the flags function. -} -type TagFlags = Flags -unsynch = accessFlag 1 -extended = accessFlag 2 -experimental = accessFlag 3 -footed = accessFlag 4 +data TagFlags = TagFlags (Bool, Bool, Bool, Bool) deriving (Show, Eq) +unsynchFlag :: TagFlags -> Bool +unsynchFlag (TagFlags (f, _, _, _)) = f +extendedHeaderFlag :: TagFlags -> Bool +extendedHeaderFlag (TagFlags (_, f, _, _)) = f +experimentalFlag :: TagFlags -> Bool +experimentalFlag (TagFlags (_, _, f, _)) = f +footerFlag :: TagFlags -> Bool +footerFlag (TagFlags (_, _, _, f)) = f +anyFlagsOn :: TagFlags -> Bool +anyFlagsOn (TagFlags (a, b, c, d)) = a || b || c || d -showTagFlags f = if not (or $ f^.allFlags) then "" else - "Flags: \n"++ - (if f^.unsynch then "\t- all frames are unsynchronised\n" else "")++ - (if f^.extended then "\t- tag has extended header\n" else "")++ - (if f^.experimental then "\t- tag is in experimental stage\n" else "")++ - (if f^.footed then "\t- tag has footer at the very end\n" else "") +showTagFlags :: TagFlags -> String +showTagFlags f = if not $ anyFlagsOn f then "" else + "Flags:\n" ++ + (if unsynchFlag f then "\t- all frames are unsynchronised\n" else "") ++ + (if extendedHeaderFlag f then "\t- tag has extended header\n" else "") ++ + (if experimentalFlag f then "\t- tag is in experimental stage\n" else "") ++ + (if footerFlag f then "\t- tag has footer at the very end\n" else "") + +instance Parsed TagFlags where + unparse (TagFlags (a, b, c, d)) = [flagsToWord8 (a, b, c, d, False, False, False, False)] {- | /SIZE BYTES/ diff --git a/src/ID3/Type/Tag.hs b/src/ID3/Type/Tag.hs --- a/src/ID3/Type/Tag.hs +++ b/src/ID3/Type/Tag.hs @@ -64,45 +64,63 @@ , tagPadding :: Integer } deriving Eq +emptyID3Tag :: ID3Tag emptyID3Tag = ID3Tag emptyID3Header Nothing Map.empty [] 0 +initID3Tag :: [ID3Tag -> ID3Tag] -> ID3Tag initID3Tag = flip compose emptyID3Tag +header :: Accessor ID3Tag ID3Header header = accessor tagHeader (\x t -> t {tagHeader = x}) +version :: Accessor ID3Tag TagVersion version = header .> tagVersion --------------------- instance HasSize ID3Tag where size = accessor getFullSize setSize +setSize :: TagSize -> ID3Tag -> ID3Tag setSize = setVal $ header .> tagSize +getFullSize :: ID3Tag -> FrameSize getFullSize t = getActualSize t + (t^.padding) +getActualSize :: ID3Tag -> FrameSize getActualSize t = (footerSize t) + (framesSize (t^.frames)) + (extHSize t) +framesSize :: Map FrameID ID3Frame -> FrameSize framesSize fs = Map.fold (\fr x -> fr^.frHeader^.frSize + 10 + x) 0 fs -footerSize t = if t^.flags^.footed then 10 else 0 +footerSize :: ID3Tag -> Integer +footerSize t = if (footerFlag $ t^.flags) then 10 else 0 +extHSize :: ID3Tag -> Integer extHSize t = case t^.extHeader of Just eH -> eH^.extSize Nothing -> 0 +padding :: Accessor ID3Tag Integer padding = accessor tagPadding (\x t -> t {tagPadding = x}) --------------------- +flags :: Accessor ID3Tag TagFlags flags = header .> tagFlags +extHeader :: Accessor ID3Tag (Maybe ID3ExtHeader) extHeader = accessor tagExtHeader (\x t -> t {tagExtHeader = x}) +frames :: Accessor ID3Tag (Map FrameID ID3Frame) frames = accessor tagFrames (\x t -> t {tagFrames = x}) +framesOrder :: Accessor ID3Tag [FrameID] framesOrder = accessor tagFramesOrder (\x t -> t {tagFramesOrder = x}) frame :: FrameID -> Accessor ID3Tag (Maybe ID3Frame) -frame id = accessor (\t -> getFrame t id) (\x t -> setFrame t id x) +frame frid = accessor (\t -> getFrame t frid) (\x t -> setFrame t frid x) +getFrame :: ID3Tag -> FrameID -> Maybe ID3Frame getFrame t f = Map.lookup f (t^.frames) +setFrame :: ID3Tag -> FrameID -> Maybe ID3Frame -> ID3Tag setFrame t f x = updateSize $ frames ^= Map.alter (\_ -> x) f (t^.frames) $ t --------------------------------------------------------- -sortFrames fs ids = mapMaybe (\id -> Map.lookup id fs) $ ids ++ (Map.keys fs \\ ids) +sortFrames :: Map FrameID ID3Frame -> [FrameID] -> [ID3Frame] +sortFrames fs ids = mapMaybe (\frid -> Map.lookup frid fs) $ ids ++ (Map.keys fs \\ ids) instance Show ID3Tag where show t = ( show $ t^.header) ++"\n"++ @@ -117,7 +135,7 @@ unparse t = ( unparse $ t^.header ) ++ ( maybe [] unparse $ t^.extHeader ) ++ ( concatMap unparse $ sortFrames (t^.frames) (t^.framesOrder) ) ++ - ( if t^.flags^.footed then unparseFooter ++ (drop 10 unparsePadding) else unparsePadding ) + ( if (footerFlag $ t^.flags) then unparseFooter ++ (drop 10 unparsePadding) else unparsePadding ) where unparseFooter = (unparse $ Str "3DI") ++ (drop 3 $ unparse $ t^.header) unparsePadding = replicate (fromInteger $ t^.padding) 0x00 diff --git a/src/ID3/Type/Unparse.hs b/src/ID3/Type/Unparse.hs --- a/src/ID3/Type/Unparse.hs +++ b/src/ID3/Type/Unparse.hs @@ -2,10 +2,8 @@ import ID3.Parser.UnSync (synchronise) import Codec.Binary.UTF8.String (encode, encodeString) -import Data.List (intersperse) import Data.Word (Word8) import Data.Accessor -import System.IO.UTF8 as U class Parsed a where unparse :: a -> [Word8] diff --git a/src/ID3/WriteTag.hs b/src/ID3/WriteTag.hs --- a/src/ID3/WriteTag.hs +++ b/src/ID3/WriteTag.hs @@ -4,7 +4,6 @@ ) where import ID3.Type -import ID3.Parser import ID3.ReadTag import Data.Accessor import System.IO diff --git a/test/Tests.hs b/test/Tests.hs new file mode 100644 --- /dev/null +++ b/test/Tests.hs @@ -0,0 +1,20 @@ +module Main where + +import Test.HUnit + +import qualified CharacterEncodingTests +import qualified FrameSupportTests +import qualified HandlingOfUnsupportedFilesTests +import qualified HeaderTests +import qualified UnsynchronisationHandlingTests + +main :: IO () +main = do + let tests = + CharacterEncodingTests.tests ++ + FrameSupportTests.tests ++ + HandlingOfUnsupportedFilesTests.tests ++ + HeaderTests.tests ++ + UnsynchronisationHandlingTests.tests + runTestTT $ TestList tests + return () diff --git a/test/resources/has-extended-header.mp3 b/test/resources/has-extended-header.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/has-extended-header.mp3 differ diff --git a/test/resources/has-illegal-newline.mp3 b/test/resources/has-illegal-newline.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/has-illegal-newline.mp3 differ diff --git a/test/resources/has-mcdi-frame.mp3 b/test/resources/has-mcdi-frame.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/has-mcdi-frame.mp3 differ diff --git a/test/resources/has-priv-frame.mp3 b/test/resources/has-priv-frame.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/has-priv-frame.mp3 differ diff --git a/test/resources/has-tsiz-frame.mp3 b/test/resources/has-tsiz-frame.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/has-tsiz-frame.mp3 differ diff --git a/test/resources/has-tyer-and-tdat-frames.mp3 b/test/resources/has-tyer-and-tdat-frames.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/has-tyer-and-tdat-frames.mp3 differ diff --git a/test/resources/has-ufid-frame.mp3 b/test/resources/has-ufid-frame.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/has-ufid-frame.mp3 differ diff --git a/test/resources/has-unsupported-frames.mp3 b/test/resources/has-unsupported-frames.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/has-unsupported-frames.mp3 differ diff --git a/test/resources/iso88591-with-non-ascii-chars.mp3 b/test/resources/iso88591-with-non-ascii-chars.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/iso88591-with-non-ascii-chars.mp3 differ diff --git a/test/resources/large-comm-frame-with-unsync-not-used.mp3 b/test/resources/large-comm-frame-with-unsync-not-used.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/large-comm-frame-with-unsync-not-used.mp3 differ diff --git a/test/resources/utf16-in-big-endian-with-bom.mp3 b/test/resources/utf16-in-big-endian-with-bom.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/utf16-in-big-endian-with-bom.mp3 differ diff --git a/test/resources/utf16-in-little-endian-with-bom.mp3 b/test/resources/utf16-in-little-endian-with-bom.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/utf16-in-little-endian-with-bom.mp3 differ diff --git a/test/resources/utf16-with-no-null-termination-char.mp3 b/test/resources/utf16-with-no-null-termination-char.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/utf16-with-no-null-termination-char.mp3 differ diff --git a/test/resources/utf16-without-bom.mp3 b/test/resources/utf16-without-bom.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/utf16-without-bom.mp3 differ diff --git a/test/resources/wxxx-with-desc-in-utf16.mp3 b/test/resources/wxxx-with-desc-in-utf16.mp3 new file mode 100644 Binary files /dev/null and b/test/resources/wxxx-with-desc-in-utf16.mp3 differ