flaccuraterip 0.2 → 0.2.1
raw patch · 7 files changed
+228/−111 lines, 7 filesdep ~binary
Dependency ranges changed: binary
Files
- .stylish-haskell.yaml +77/−0
- CD/AccurateRip.hs +44/−43
- CD/CDDB.hs +18/−16
- CHANGELOG.md +4/−0
- Main.hs +34/−34
- README.md +22/−0
- flaccuraterip.cabal +29/−18
+ .stylish-haskell.yaml view
@@ -0,0 +1,77 @@+# stylish-haskell configuration file+# ==================================++# The stylish-haskell tool is mainly configured by specifying steps. These steps+# are a list, so they have an order, and one specific step may appear more than+# once (if needed). Each file is processed by these steps in the given order.+steps:+ # Convert some ASCII sequences to their Unicode equivalents. This is disabled+ # by default.+ # - unicode_syntax:+ # # In order to make this work, we also need to insert the UnicodeSyntax+ # # language pragma. If this flag is set to true, we insert it when it's+ # # not already present. You may want to disable it if you configure+ # # language extensions using some other method than pragmas. Default:+ # # true.+ # add_language_pragma: true++ # Import cleanup+ - imports:+ # There are different ways we can align names and lists.+ #+ # - global: Align the import names and import list throughout the entire+ # file.+ #+ # - file: Like global, but don't add padding when there are no qualified+ # imports in the file.+ #+ # - group: Only align the imports per group (a group is formed by adjacent+ # import lines).+ #+ # - none: Do not perform any alignment.+ #+ # Default: global.+ align: global++ # Language pragmas+ - language_pragmas:+ # We can generate different styles of language pragma lists.+ #+ # - vertical: Vertical-spaced language pragmas, one per line.+ #+ # - compact: A more compact style.+ #+ # - compact_line: Similar to compact, but wrap each line with+ # `{-#LANGUAGE #-}'.+ #+ # Default: vertical.+ style: vertical++ # stylish-haskell can detect redundancy of some language pragmas. If this+ # is set to true, it will remove those redundant pragmas. Default: true.+ remove_redundant: true++ # Align the types in record declarations+ - records: {}++ # Replace tabs by spaces. This is disabled by default.+ # - tabs:+ # # Number of spaces to use for each tab. Default: 8, as specified by the+ # # Haskell report.+ # spaces: 8++ # Remove trailing whitespace+ - trailing_whitespace: {}++# A common setting is the number of columns (parts of) code will be wrapped+# to. Different steps take this into account. Default: 80.+columns: 80++# Sometimes, language extensions are specified in a cabal file or from the+# command line instead of using language pragmas in the file. stylish-haskell+# needs to be aware of these, so it can parse the file correctly.+#+# No language extensions are enabled by default.+# language_extensions:+ # - TemplateHaskell+ # - QuasiQuotes
CD/AccurateRip.hs view
@@ -1,22 +1,23 @@ {-# LANGUAGE BangPatterns #-} -module CD.AccurateRip where +module CD.AccurateRip where -import CD.CDDB-import Data.Binary-import Data.Binary.Get-import Data.Binary.Put-import Data.Bits-import Data.List (find)+import CD.CDDB+import Control.Monad (liftM)+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.Bits+import Data.List (find) type Sample = Word32 type CRC = DiscID data ArCrcEntry = ArCrcEntry {- id1 :: DiscID,- id2 :: DiscID,- cddb :: DiscID,+ id1 :: DiscID,+ id2 :: DiscID,+ cddb :: DiscID, trackCRCs :: [(Word8,CRC)] -- (confidence,crc) } @@ -36,7 +37,7 @@ i1 <- get i2 <- get i3 <- get- cs <- mapM (\_ -> getTrackCRCs) [1..l]+ cs <- mapM (const getTrackCRCs) [1..l] return $ ArCrcEntry i1 i2 i3 cs where getTrackCRCs = do c <- getWord8 s <- get@@ -44,9 +45,9 @@ return (c,s) instance Show ArCrcEntry where- show (ArCrcEntry w1 w2 w3 xs) = "ID: " ++ (show w1) ++ "-" ++- (show w2) ++ "-" ++- (show w3) ++ "\n\n" +++ show (ArCrcEntry w1 w2 w3 xs) = "ID: " ++ show w1 ++ "-" +++ show w2 ++ "-" +++ show w3 ++ "\n\n" ++ showEntry where showEntry = concat $ zipWith f [(1::Int)..] xs f i (c,s) | c == 0 && s == DiscID 0 = "track " ++ show i ++@@ -58,7 +59,7 @@ showArCrcEntry :: ArCrcEntry -> String showArCrcEntry (ArCrcEntry w1 w2 w3 xs) =- (show w1) ++ "-" ++ (show w2) ++ "-" ++ (show w3)+ show w1 ++ "-" ++ show w2 ++ "-" ++ show w3 ++ "\n" ++ "Track No.\tChecksum\tAccuracy" ++ "\n\n" ++ showEntry where showEntry = concat $ zipWith f [(1::Int)..] xs@@ -73,13 +74,13 @@ instance Binary ArData where put (ArData ents) = mapM_ put ents- get = getList >>= return . ArData+ get = liftM ArData getList where getList = do b <- isEmpty- case b of- True -> return []- False -> do a <- get- as <- getList- return (a:as)+ if b+ then return []+ else do a <- get+ as <- getList+ return (a:as) instance Show ArData where showsPrec _ (ArData []) = id@@ -103,20 +104,20 @@ showArResult NotPresent = "not present in the database" -} data RipHash = RipHash {- ripId1 :: DiscID,- ripId2 :: DiscID,+ ripId1 :: DiscID,+ ripId2 :: DiscID, ripCddb :: DiscID,- ripCrc :: [(CRC,CRC)]+ ripCrc :: [(CRC,CRC)] } matchPressing :: ArData -> RipHash -> (Maybe [Word8], Maybe [Word8]) matchPressing (ArData ardata) hash = let cs = map trackCRCs ardata in (matchV1 cs, matchV2 cs)- where matchV1 xs = let a = find (\ys -> (snd $ unzip ys) == v1Sums) xs+ where matchV1 xs = let a = find (\ys -> snd (unzip ys) == v1Sums) xs in case a of Just zs -> Just $ fst $ unzip zs Nothing -> Nothing- matchV2 xs = let a = find (\ys -> (snd $ unzip ys) == v2Sums) xs+ matchV2 xs = let a = find (\ys -> snd (unzip ys) == v2Sums) xs in case a of Just zs -> Just $ fst $ unzip zs Nothing -> Nothing@@ -126,7 +127,7 @@ verifyTracks :: ArData -> RipHash -> [(Word,Word)] verifyTracks (ArData ardata) (RipHash i1 i2 i3 csum) = zipWith (trackConf (filter p ardata)) [0..length csum - 1] csum- where trackConf ents i = go (map (\e -> (trackCRCs e)!!i) ents) (0,0)+ where trackConf ents i = go (map (\e -> trackCRCs e !! i) ents) (0,0) go [] (a1,a2) _ = (a1,a2) go ((c,s):xs) (a1,a2) (v1,v2) = go xs (a1 + fromIntegral (if v1 == s then c else 0), a2 + fromIntegral (if v2 == s then c else 0)) (v1,v2)@@ -164,15 +165,15 @@ arUrl :: [Int] -> String arUrl xs = "http://www.accuraterip.com/accuraterip/" ++- ((show $ discId1 xs)!!7) : '/' :- ((show $ discId1 xs)!!6) : '/' :- ((show $ discId1 xs)!!5) : "/dBAR-" ++- (addZeros 3 $ show (length xs)) ++- '-' : (show $ discId1 xs) ++- '-' : (show $ discId2 xs) ++- '-' : (show $ cddbDiscId xs) +++ (show (discId1 xs)!!7) : '/' :+ (show (discId1 xs)!!6) : '/' :+ (show (discId1 xs)!!5) : "/dBAR-" +++ addZeros 3 (show (length xs)) +++ '-' : show (discId1 xs) +++ '-' : show (discId2 xs) +++ '-' : show (cddbDiscId xs) ++ ".bin"- where addZeros n s = if (length s) >= n+ where addZeros n s = if length s >= n then s else addZeros n ('0':s) @@ -186,11 +187,11 @@ {- crcFromTo :: Int -> Int -> [Sample] -> CRC crcFromTo m n = snd . foldl' step (m,0) . take (n-m+1)- where + where step (!l,!acc) y = (l+1,acc + (toEnum l)*y) -}- + samplesPerSector :: Num a => a samplesPerSector = 588 @@ -251,8 +252,8 @@ zeroEnd l = zipWith (\i x -> if i >= l - droppedSamples then 0 else x) [0..] applyOff :: Int -> [Sample] -> [Sample]-applyOff off dat | off >= 0 = (drop off dat) ++ (replicate off 0)- | otherwise = (replicate off 0) ++ dat+applyOff off dat | off >= 0 = drop off dat ++ replicate off 0+ | otherwise = replicate off 0 ++ dat crc :: [Sample] -> CRC --crc = foldl1' (+) . zipWith (*) [1..]@@ -266,16 +267,16 @@ go !acc !n (x:xs) = go (acc + f n x) (n+1) xs f :: Word64 -> Sample -> Word32 f n x = let a = n * fromIntegral x- in (fromIntegral (a .&. 0xFFFFFFFF)) +- (fromIntegral $ shiftR (a .&. 0xFFFFFFFF00000000) 32)+ in fromIntegral (a .&. 0xFFFFFFFF) ++ fromIntegral (shiftR (a .&. 0xFFFFFFFF00000000) 32) pairCrc :: [Sample] -> (CRC,CRC) pairCrc = go (0,0) 1 where go (a1,a2) _ [] = (DiscID a1, DiscID a2) go (!a1,!a2) !n (x:xs) = go (a1 + n*x, a2 + f n x) (n+1) xs f n x = let a = fromIntegral n * fromIntegral x :: Word64- in (fromIntegral (a .&. 0xFFFFFFFF)) +- (fromIntegral $ shiftR (a .&. 0xFFFFFFFF00000000) 32)+ in fromIntegral (a .&. 0xFFFFFFFF) ++ fromIntegral (shiftR (a .&. 0xFFFFFFFF00000000) 32) listPairCrcs :: Int -> [Int] -> [Sample] -> [(CRC,CRC)] listPairCrcs off ls = map pairCrc . chunks ls . zeroEnd (sum ls) .
CD/CDDB.hs view
@@ -2,30 +2,32 @@ module CD.CDDB where -import Control.DeepSeq-import Data.Binary-import Data.Binary.Get-import Data.Binary.Put-import Data.Bits-import Data.Char+import Control.DeepSeq+import Control.Monad (liftM)+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.Bits+import Data.Char newtype DiscID = DiscID Word32 deriving (Eq, NFData) instance Binary DiscID where put (DiscID w) = putWord32le w- get = getWord32le >>= return . DiscID+ get = liftM DiscID getWord32le instance Show DiscID where- show (DiscID w) = - (intToDigit $ fromIntegral ((shiftR w 28) .&. 15)) :- (intToDigit $ fromIntegral ((shiftR w 24) .&. 15)) :- (intToDigit $ fromIntegral ((shiftR w 20) .&. 15)) :- (intToDigit $ fromIntegral ((shiftR w 16) .&. 15)) :- (intToDigit $ fromIntegral ((shiftR w 12) .&. 15)) :- (intToDigit $ fromIntegral ((shiftR w 8) .&. 15)) :- (intToDigit $ fromIntegral ((shiftR w 4) .&. 15)) :- (intToDigit $ fromIntegral (w .&. 15)) : []+ show (DiscID w) =+ [ intToDigit (fromIntegral (shiftR w 28 .&. 15))+ , intToDigit (fromIntegral (shiftR w 24 .&. 15))+ , intToDigit (fromIntegral (shiftR w 20 .&. 15))+ , intToDigit (fromIntegral (shiftR w 16 .&. 15))+ , intToDigit (fromIntegral (shiftR w 12 .&. 15))+ , intToDigit (fromIntegral (shiftR w 8 .&. 15))+ , intToDigit (fromIntegral (shiftR w 4 .&. 15))+ , intToDigit (fromIntegral (w .&. 15))+ ] -- |Calculate CDDB DiscID: the result is XXYYYYZZ where XX is the number of tracks, YYYY is the total length of the CD is seconds, and ZZ is ... cddbDiscId :: [Int] -> DiscID
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+Version 0.2.1+-------------++- Clean up code.
Main.hs view
@@ -1,19 +1,19 @@ {-# LANGUAGE DeriveDataTypeable #-} -import CD.AccurateRip-import CD.CDDB-import Control.DeepSeq-import Control.Monad-import Data.Binary-import Data.Bits-import Data.String-import Data.Version-import Network.HTTP-import System.Console.CmdArgs-import System.IO-import System.Environment-import System.Exit-import System.Process+import CD.AccurateRip+import CD.CDDB+import Control.DeepSeq+import Control.Monad+import Data.Binary+import Data.Bits+import Data.String+import Data.Version+import Network.HTTP+import System.Console.CmdArgs+import System.Environment+import System.Exit+import System.IO+import System.Process progName :: String@@ -23,22 +23,22 @@ exeName = "flaccuraterip" version :: Version-version = Version [0,2] []+version = Version [0,2,1] [] intro :: String intro = progName ++ " " ++ showVersion version ++ "\n\- \Copyright (C) 2012 Nicola Squartini.\n\+ \Copyright (C) 2012-2014 Nicola Squartini.\n\ \License GPLv3+: GNU GPL version 3 or \ \later <http://gnu.org/licenses/gpl.html>\n\ \This is free software: you are free to change and redistribute it.\n\ \There is NO WARRANTY, to the extent permitted by law." data Options = Options- { optOffset :: Int- , opt30Samples :: Bool- , optShowEntry :: Bool- , optFiles :: [String]+ { optOffset :: Int+ , opt30Samples :: Bool+ , optShowEntry :: Bool+ , optFiles :: [String] } deriving (Data, Typeable) options :: Options@@ -71,11 +71,11 @@ offsetsToLengths :: Num a => [a] -> [a] offsetsToLengths [] = [] offsetsToLengths [x] = [x]-offsetsToLengths xs = (offsetsToLengths $ i) ++ [(last xs) - (last i)]+offsetsToLengths xs = offsetsToLengths i ++ [last xs - last i] where i = init xs -getFlacSampleNumber :: FilePath -> IO (Int)+getFlacSampleNumber :: FilePath -> IO Int getFlacSampleNumber file = do (_,b, _) <- readProcessWithExitCode "metaflac"@@ -84,7 +84,7 @@ return (read b) -getOffsetsFromFlacs :: [FilePath] -> IO ([Int])+getOffsetsFromFlacs :: [FilePath] -> IO [Int] getOffsetsFromFlacs [file] = do (a,_,_) <- readProcessWithExitCode "metaflac"@@ -100,20 +100,20 @@ return [quot l samplesPerSector] getOffsetsFromFlacs filelist = do s <- mapM getFlacSampleNumber filelist- return $ lengthsToOffsets (map (\a -> quot a samplesPerSector) s)+ return $ lengthsToOffsets (map (`quot` samplesPerSector) s) stringToWord32List :: String -> [Word32] stringToWord32List [] = []-stringToWord32List (x1:x2:x3:x4:xs) = - (fourCharToWord32 x1 x2 x3 x4):stringToWord32List xs- where fourCharToWord32 c1 c2 c3 c4 = - (fromIntegral $ fromEnum c1) +- (fromIntegral $ fromEnum c2) `shiftL` 8 +- (fromIntegral $ fromEnum c3) `shiftL` 16 +- (fromIntegral $ fromEnum c4) `shiftL` 24+stringToWord32List (x1:x2:x3:x4:xs) =+ fourCharToWord32 x1 x2 x3 x4 : stringToWord32List xs+ where fourCharToWord32 c1 c2 c3 c4 =+ fromIntegral (fromEnum c1) ++ fromIntegral (fromEnum c2) `shiftL` 8 ++ fromIntegral (fromEnum c3) `shiftL` 16 ++ fromIntegral (fromEnum c4) `shiftL` 24 stringToWord32List _ = error "stringToWord32List: length of String should be \ \divisible by 4." @@ -182,7 +182,7 @@ putStrLn $ showArData ardata else do putStrLn ("Found " ++ show n ++ " pressings:\n") putStrLn $ showArData ardata- let offset = (optOffset opts) + 30*(fromEnum $ opt30Samples opts)+ let offset = optOffset opts + 30 * fromEnum (opt30Samples opts) putStr "Computing track checksums from input files" whenLoud $ putStr (" (using " ++ show offset ++ " samples offset)") putStrLn "..."@@ -192,7 +192,7 @@ let cs = listPairCrcs offset (map (\n -> samplesPerSector * n) (offsetsToLengths list)) (stringToWord32List str)- (\x -> showAccuracy ardata- (RipHash (discId1 list) (discId2 list) (cddbDiscId list) x))+ (showAccuracy ardata .+ RipHash (discId1 list) (discId2 list) (cddbDiscId list)) $!! cs hClose a
+ README.md view
@@ -0,0 +1,22 @@+Introduction+------------++*flAccurateRip* is a command line tool to verify the accuracy of FLAC files+ripped form CD, using the information contained in the AccurateRip™ database+about other rips of the same CD.++Usage+-----++Suppose you ripped a CD into `track01.flac`, `track02.flac`, ...,+`trackNN.flac`. Open a shell in the directory containing the FLAC files, and+run:++ $ flaccuraterip track01.flac track02.flac ... trackNN.flac++If a pressing of this CD is present in the AccurateRip™ database,+`flaccuraterip` will output the ripping accuracy for each track. If the CD was+ripped without setting the drive offset, you should use the flag+`--sample-offset=N`, where N is the offset indicated+[here](http://accuraterip.com/driveoffsets.htm+"http://accuraterip.com/driveoffsets.htm") for your drive.
flaccuraterip.cabal view
@@ -1,42 +1,53 @@ Name: flaccuraterip-Version: 0.2+Version: 0.2.1 Cabal-Version: >= 1.8 Build-Type: Simple License: GPL-3 License-File: LICENSE-Copyright: Copyright © 2012 Nicola Squartini+Copyright: © 2012-2014 Nicola Squartini Author: Nicola Squartini Maintainer: Nicola Squartini <tensor5@gmail.com> Homepage: http://noaxiom.org/flAccurateRip Synopsis: Verify FLAC files ripped form CD using AccurateRip™ Description: - /flAccurateRip/ is a command line tool to verify the accuracy of FLAC- files ripped form CD, using the information contained in the- AccurateRip™ database about other rips of the same CD.+ /flAccurateRip/ is a command line tool to verify the accuracy of FLAC files+ ripped form CD, using the information contained in the AccurateRip™ database+ about other rips of the same CD. .- Usage: suppose you ripped a CD into @track01.flac@, @track02.flac@,- ..., @trackNN.flac@. Open a shell in the directory containing the- FLAC files, and run:+ Usage: suppose you ripped a CD into @track01.flac@, @track02.flac@, ...,+ @trackNN.flac@. Open a shell in the directory containing the FLAC files, and+ run: .- >>> flaccuraterip track01.flac track02.flac ... trackNN.flac+ >$ flaccuraterip track01.flac track02.flac ... trackNN.flac . If a pressing of this CD is present in the AccurateRip™ database,- @flaccuraterip@ will output the ripping accuracy for each track. If- the CD was ripped without setting the drive offset, you should use- the flag @--sample-offset=N@, where N is the offset indicated in+ @flaccuraterip@ will output the ripping accuracy for each track. If the CD was+ ripped without setting the drive offset, you should use the flag+ @--sample-offset=N@, where N is the offset indicated in <http://accuraterip.com/driveoffsets.htm> for your drive. -Category: Sound+Category: Sound+Extra-Source-Files: .stylish-haskell.yaml+ CHANGELOG.md+ README.md +Source-Repository head+ Type: git+ Location: git://github.com/tensor5/flAccurateRip.git++Source-Repository this+ Type: git+ Location: git://github.com/tensor5/flAccurateRip.git+ Tag: v0.2.1+ Executable flaccuraterip- Build-Depends: base == 4.*,- binary == 0.5.*,+ Build-Depends: base == 4.*,+ binary >= 0.5 && < 0.8, cmdargs == 0.10.*, deepseq == 1.3.*,- HTTP == 4000.2.*,- process == 1.1.*+ HTTP == 4000.2.*,+ process >= 1.1 && < 1.3 GHC-Options: -Wall Main-Is: Main.hs Other-Modules: CD.CDDB, CD.AccurateRip-