diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml new file mode 100644 --- /dev/null +++ b/.stylish-haskell.yaml @@ -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 diff --git a/CD/AccurateRip.hs b/CD/AccurateRip.hs --- a/CD/AccurateRip.hs +++ b/CD/AccurateRip.hs @@ -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) . diff --git a/CD/CDDB.hs b/CD/CDDB.hs --- a/CD/CDDB.hs +++ b/CD/CDDB.hs @@ -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 diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,4 @@ +Version 0.2.1 +------------- + +- Clean up code. diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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 \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 diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. diff --git a/flaccuraterip.cabal b/flaccuraterip.cabal --- a/flaccuraterip.cabal +++ b/flaccuraterip.cabal @@ -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 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 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 -