Множественные правки

level.hs

@@ -1,16 +1,17 @@
 {-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
 
 -- Создан:  Ср 28 сен 2016 10:18:53
--- Изменен: Пт 14 окт 2016 12:07:33
+-- Изменен: Пт 14 окт 2016 17:53:23
 
 import System.Console.CmdArgs
 import System.Environment
 import System.Directory
-import Control.Monad
+import System.Exit
 import Data.WAVE
 import Data.Char
 import Data.List
 import Data.List.Split
+import Control.Monad
 
 -- =============================================================================
 
@@ -20,7 +21,7 @@ median l = let (t,n) = foldl' (\(b,c) a -> (a+b,c+1)) (0,0) l in t/n
 
 --
 everyN :: Int -> [Double] -> [[Double]]
-everyN n list = [take (n + n) $ drop (x-1) list | x <- [1, n..length list]]
+everyN n list = [(n+n) ## drop (x-1) list | x <- [1, n..length list]]
 
 -- Перевод между типами
 convert :: (Show a, Read c) => a -> c
@@ -30,16 +31,26 @@ convert = read . show
 notEmpty :: String -> Bool
 notEmpty = (/=) (show "")
 
+-- Проверка на действительное ненулевое значение
+notZero :: RealFloat a => a -> Bool
+notZero x = (not $ isNaN x) && (x /= 0)
+
+-- Синтаксический сахар
+(<@) = map     -- a <@ b = map a b
+(<#) = filter  -- a <# b = filter a b
+(##) = take    -- n##b = take n b
+(//) = drop    -- n//b = drop n b
+
 -- =============================================================================
 
 -- Чтение данных аудиофайла
 audioread :: WAVE -> [[Double]]
-audioread file = map samplesToDouble (waveSamples file)
+audioread = map samplesToDouble . waveSamples
 	where samplesToDouble (l:r:[]) = [sampleToDouble l, sampleToDouble r]
 
 --Выбор канала из пары
 getChannel :: [Char] -> [[Double]] -> [Double]
-getChannel ch (xs) = map selectChannel xs where
+getChannel ch = map selectChannel where
 	selectChannel (l:r:[])  | ch == "R" = r
 				| ch == "L" = l
 				| otherwise  = l
@@ -47,17 +58,17 @@ getChannel ch (xs) = map selectChannel xs where
 -- k десятичных логарифмов
 float2db :: (RealFloat a, Integral b) => b -> a -> a
 float2db k x
-	| isNaN x   = 0
+	| notZero x = fromIntegral k * (logBase 10 x)
-	| otherwise = fromIntegral k * (logBase 10 x)
+	| otherwise = 0
 
 -- Пиковое значение уровня сигнала на отрезке
 peak :: (Ord a, Floating a) => [a] -> a
-peak [] = acos(2) -- NaN
+peak [] = acos(1) -- NaN
 peak xs = maximum xs
 
 -- Вычисление уровня сигнала
 calcLevel :: [Char] -> Int -> [Double] -> Int
-calcLevel vu = case (map toLower vu) of
+calcLevel vu = case (toLower <@ vu) of
 		"lufs" -> calcLevelLUFS
 		"db"   -> calcLevelDb
 
@@ -67,14 +78,14 @@ calcLevelDb fs samples = case dd of
 		[] -> -52 -- Неслышимый звук
 		_  -> round (median dd)
 	where
-		dd = [x | x <- map (float2db 20 . peak) slices, not (isNaN x), x /= 0]
+		dd = notZero <# map (float2db 20 . peak) slices
-		slices = splitWhen (== 0) $ take fs samples;
+		slices = splitWhen (== 0) $ take fs samples
 
 -- Вычисление уровня сигнала / LUFS
 calcLevelLUFS :: Int -> [Double] -> Int
-calcLevelLUFS fs samples = round (median values)
+calcLevelLUFS fs samples = round (median $ getlufs <@ chunks)
 	where
-		values = map (\l -> float2db 10 (1 / fd' * (sum $ map (^2) l))) chunks
+		getlufs l = float2db 10 (1 / fd' * (sum $ map (^2) l))
 		chunks = everyN fd $ take fs samples
 		fd  = fs `div` 10
 		fd' = convert fd :: Double
@@ -83,7 +94,7 @@ calcLevelLUFS fs samples = round (median values)
 calcPhase :: (Ord a, Fractional a) => [[a]] -> a
 calcPhase samples
 		| sum [ abs l + abs r | [l,r] <- samples] < 0.01 = 0
-		| otherwise = median (map ph (zip3 samples (drop 1 samples) (drop 2 samples))) where
+		| otherwise = median (map ph (zip3 samples (1//samples) (2//samples))) where
 	ph ([0,0], [l2,r2], [l3,r3])    | (signum l2 /= signum r2) && (signum l3 /= signum r3) = 0
 					| otherwise = 1
 
@@ -130,23 +141,24 @@ main = do
 	args <- getArgs
 	cmd <- (if null args then withArgs ["--help"] else id) defaultOptions
 
-	if (isInfixOf ".wav" $ file cmd) then do
+	unless (isInfixOf ".wav" $ file cmd) $ do
-		d <- getWAVEFile $ file cmd
-		let w = take (samples cmd) (audioread d)
-
-		let exec fx = do
-			describe (title cmd) ("\n---[ " ++ fx) "" (" ]:")
-			case fx of
-				"samples" -> mapM_ print $ getChannel (map toUpper $ channel cmd) w
-				"phase"   -> print $ calcPhase w
-				"level"      -> do
-					describe (title cmd) "L: "
-						(calcLevel (vu cmd) (samples cmd) (getChannel "L" w)) (vu cmd)
-					describe (title cmd) "R: "
-						(calcLevel (vu cmd) (samples cmd) (getChannel "R" w)) (vu cmd)
-				_         -> putStrLn $ "WARNING: Unknown type of information: " ++ fx ++ "\n"
-
-		mapM_ exec (splitOn "," $ info cmd)
-	else do
 		putStrLn "ERROR: You must specify a correct filename."
+		exitFailure
+
+	d <- getWAVEFile $ file cmd
+	let w = samples cmd ## audioread d
+
+	let exec fx = do
+		describe (title cmd) ("\n---[ " ++ fx) "" (" ]:")
+		case fx of
+			"samples" -> mapM_ print $ getChannel (toUpper <@ channel cmd) w
+			"phase"   -> print $ calcPhase w
+			"level"   -> do
+				describe (title cmd) "L: "
+					(calcLevel (vu cmd) (samples cmd) (getChannel "L" w)) (vu cmd)
+				describe (title cmd) "R: "
+					(calcLevel (vu cmd) (samples cmd) (getChannel "R" w)) (vu cmd)
+			_         -> putStrLn $ "WARNING: Unknown type of information: " ++ fx ++ "\n"
+
+	mapM_ exec (splitOn "," $ info cmd)