idiii 0.1.2 → 0.1.3
raw patch · 34 files changed
+408/−268 lines, 34 filesdep +HUnitdep +directorydep +filepathdep −haskell98dep ~basenew-component:exe:read-idiiinew-uploaderbinary-added
Dependencies added: HUnit, directory, filepath, process
Dependencies removed: haskell98
Dependency ranges changed: base
Files
- idiii.cabal +33/−7
- read-idiii.hs +1/−1
- src/ID3/Parser/ExtHeader.hs +23/−17
- src/ID3/Parser/Frame.hs +36/−11
- src/ID3/Parser/General.hs +22/−29
- src/ID3/Parser/Header.hs +8/−16
- src/ID3/Parser/NativeFrames.hs +44/−43
- src/ID3/Parser/Tag.hs +3/−3
- src/ID3/Parser/UnSync.hs +3/−3
- src/ID3/Simple.hs +3/−3
- src/ID3/Type/ExtHeader.hs +45/−33
- src/ID3/Type/Flags.hs +7/−27
- src/ID3/Type/Frame.hs +90/−37
- src/ID3/Type/FrameInfo.hs +18/−16
- src/ID3/Type/Header.hs +30/−15
- src/ID3/Type/Tag.hs +22/−4
- src/ID3/Type/Unparse.hs +0/−2
- src/ID3/WriteTag.hs +0/−1
- test/Tests.hs +20/−0
- test/resources/has-extended-header.mp3 binary
- test/resources/has-illegal-newline.mp3 binary
- test/resources/has-mcdi-frame.mp3 binary
- test/resources/has-priv-frame.mp3 binary
- test/resources/has-tsiz-frame.mp3 binary
- test/resources/has-tyer-and-tdat-frames.mp3 binary
- test/resources/has-ufid-frame.mp3 binary
- test/resources/has-unsupported-frames.mp3 binary
- test/resources/iso88591-with-non-ascii-chars.mp3 binary
- test/resources/large-comm-frame-with-unsync-not-used.mp3 binary
- test/resources/utf16-in-big-endian-with-bom.mp3 binary
- test/resources/utf16-in-little-endian-with-bom.mp3 binary
- test/resources/utf16-with-no-null-termination-char.mp3 binary
- test/resources/utf16-without-bom.mp3 binary
- test/resources/wxxx-with-desc-in-utf16.mp3 binary
idiii.cabal view
@@ -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
read-idiii.hs view
@@ -2,7 +2,7 @@ import ID3 import qualified Data.Map as Map-import System (getArgs)+import System.Environment (getArgs) main = do args <- getArgs
src/ID3/Parser/ExtHeader.hs view
@@ -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
src/ID3/Parser/Frame.hs view
@@ -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
src/ID3/Parser/General.hs view
@@ -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-
src/ID3/Parser/Header.hs view
@@ -1,20 +1,11 @@-{- |-This module provides parsers for Header.--(<http://www.id3.org/id3v2.4.0-structure>)--}-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_
src/ID3/Parser/NativeFrames.hs view
@@ -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 <text string> -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 <text string> $00 -- Identifier <up to 64 bytes binary data> +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 <text string according to encoding> 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 <text string> 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 <binary data> frameInfo "MCDI" = do- sz <- sizeGet- tocData <- many' anyWord8- return $ MCDI tocData+ _ <- sizeGet+ tocData0 <- many' anyWord8+ return $ MCDI tocData0 ---- --} @@ -760,11 +761,11 @@ -- Lyrics/text <full text string according to encoding> 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 <full text string according to encoding> 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 <binary 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 <binary 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
src/ID3/Parser/Tag.hs view
@@ -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)]
src/ID3/Parser/UnSync.hs view
@@ -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
src/ID3/Simple.hs view
@@ -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 -----------------------------------
src/ID3/Type/ExtHeader.hs view
@@ -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 [])+-}
src/ID3/Type/Flags.hs view
@@ -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
src/ID3/Type/Frame.hs view
@@ -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
src/ID3/Type/FrameInfo.hs view
@@ -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
src/ID3/Type/Header.hs view
@@ -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/
src/ID3/Type/Tag.hs view
@@ -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
src/ID3/Type/Unparse.hs view
@@ -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]
src/ID3/WriteTag.hs view
@@ -4,7 +4,6 @@ ) where import ID3.Type-import ID3.Parser import ID3.ReadTag import Data.Accessor import System.IO
+ test/Tests.hs view
@@ -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 ()
+ test/resources/has-extended-header.mp3 view
binary file changed (absent → 9873 bytes)
+ test/resources/has-illegal-newline.mp3 view
binary file changed (absent → 9878 bytes)
+ test/resources/has-mcdi-frame.mp3 view
binary file changed (absent → 10034 bytes)
+ test/resources/has-priv-frame.mp3 view
binary file changed (absent → 11273 bytes)
+ test/resources/has-tsiz-frame.mp3 view
binary file changed (absent → 9876 bytes)
+ test/resources/has-tyer-and-tdat-frames.mp3 view
binary file changed (absent → 9876 bytes)
+ test/resources/has-ufid-frame.mp3 view
binary file changed (absent → 16993 bytes)
+ test/resources/has-unsupported-frames.mp3 view
binary file changed (absent → 9876 bytes)
+ test/resources/iso88591-with-non-ascii-chars.mp3 view
binary file changed (absent → 16472 bytes)
+ test/resources/large-comm-frame-with-unsync-not-used.mp3 view
binary file changed (absent → 10342 bytes)
+ test/resources/utf16-in-big-endian-with-bom.mp3 view
binary file changed (absent → 16993 bytes)
+ test/resources/utf16-in-little-endian-with-bom.mp3 view
binary file changed (absent → 16993 bytes)
+ test/resources/utf16-with-no-null-termination-char.mp3 view
binary file changed (absent → 16993 bytes)
+ test/resources/utf16-without-bom.mp3 view
binary file changed (absent → 16991 bytes)
+ test/resources/wxxx-with-desc-in-utf16.mp3 view
binary file changed (absent → 9918 bytes)