-- {-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Sound.SoXBasics
-- Copyright   :  (c) OleksandrZhabenko 2019-2021, 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr.zhabenko@yahoo.com
--
-- A program and a library that can be used as a simple basic interface to some SoX functionality.
--


module Sound.SoXBasics (
  -- * Encoding file extensions and types functional data type
  ULencode(..)
  , SoundFileExts(..)
  -- * Working with two extensions
  , soxOpG, soxOpG1, ulAccessParameters, ulResultParameters
  -- * Some generalized common functions
  , doubleCleanCheck, presenseCheck, secondFileClean, twoIntermediateFs, twoExceptions1File, applyExts2, beforeExtStr
  -- * Get Information
  , maxAbs, getMaxAG, getMinAG, selMaxAbsG, selMAG, extremeSG, extremeSG1G, soxStatG, upperBndG, durationAG, sampleAnG
  -- * Produce sound
  -- ** Trimming the silence
  , alterVadBG, alterVadEG, alterVadHelpG, opFileG
  -- ** Amplitude modification
  , normG, normLG, gainLG, quarterSinFadeG
  -- ** Adding silence
  , silenceBothG
  -- ** Changing sample rate
  , resampleAG
  -- ** Working with noise
  , noiseProfBG, noiseProfEG, noiseReduceBG, noiseReduceEG, noiseReduceBUG, noiseReduceEUG
  -- ** Filtering
  , sincAG
  -- ** Volume amplification
  , volSG, volS2G
  -- * Variants that uses just .wav files
  , getMaxA, getMinA, selMaxAbs, selMA, extremeS, extremeS1, soxStat, upperBnd, durationA, sampleAn
  , alterVadB, alterVadE, alterVadHelp, opFile
  , norm, normL, gainL, quarterSinFade
  , silenceBoth
  , resampleA
  , noiseProfB, noiseProfE, noiseReduceB, noiseReduceE, noiseReduceBU, noiseReduceEU
  , sincA
  , volS, volS2
  -- * Playback
  , playA
) where

import System.Directory
import Data.Maybe (isJust, fromJust)
import Data.List (isSuffixOf)
import Numeric
import Data.Char
import System.Process
import System.IO
import EndOfExe2
import System.Exit
import Control.Concurrent (threadDelay)
import Control.Exception (onException)
import System.Info (os)
import Sound.Control.Exception.FinalException
import GHC.Base (mconcat)

-- | Function 'maxAbs' allows to choose a maximum by absolute value if the values are written as 'String'. Bool 'True' corresponds to maximum value, 'False' - to minimum value
maxAbs :: (String, String) -> (String, Bool)
maxAbs :: ([Char], [Char]) -> ([Char], Bool)
maxAbs ([Char]
xs, [Char]
ys) | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
xs Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys = ([], Bool
False)
                | [Char]
hx [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" Bool -> Bool -> Bool
&& [Char]
hy [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" = if [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Char]
xs [Char]
ys Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT then ([Char]
xs, Bool
False) else ([Char]
ys, Bool
False)
                | [Char]
hx [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"-" Bool -> Bool -> Bool
&& [Char]
hy [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"-" = if [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Char]
xs [Char]
ys Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then ([Char]
xs, Bool
True) else ([Char]
ys, Bool
True)
                | [Char]
hx [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" Bool -> Bool -> Bool
&& [Char]
hy [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"-" = if [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
xs) [Char]
ys Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT then ([Char]
xs, Bool
False) else ([Char]
ys, Bool
True)
                | Bool
otherwise = if [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Char]
xs (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
ys) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then ([Char]
xs, Bool
True) else ([Char]
ys, Bool
False)
            where hx :: [Char]
hx = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
xs
                  hy :: [Char]
hy = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
ys

ulAccessParameters :: [String]
ulAccessParameters :: [[Char]]
ulAccessParameters = [[Char]
"-r22050",[Char]
"-c1"]

ulResultParameters :: [String]
ulResultParameters :: [[Char]]
ulResultParameters = [[Char]
"-r22050",[Char]
"-c1"]

data ULencode = W | UL1 | UL0 | UL deriving (ULencode -> ULencode -> Bool
(ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> Bool) -> Eq ULencode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ULencode -> ULencode -> Bool
== :: ULencode -> ULencode -> Bool
$c/= :: ULencode -> ULencode -> Bool
/= :: ULencode -> ULencode -> Bool
Eq, Eq ULencode
Eq ULencode =>
(ULencode -> ULencode -> Ordering)
-> (ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> ULencode)
-> (ULencode -> ULencode -> ULencode)
-> Ord ULencode
ULencode -> ULencode -> Bool
ULencode -> ULencode -> Ordering
ULencode -> ULencode -> ULencode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ULencode -> ULencode -> Ordering
compare :: ULencode -> ULencode -> Ordering
$c< :: ULencode -> ULencode -> Bool
< :: ULencode -> ULencode -> Bool
$c<= :: ULencode -> ULencode -> Bool
<= :: ULencode -> ULencode -> Bool
$c> :: ULencode -> ULencode -> Bool
> :: ULencode -> ULencode -> Bool
$c>= :: ULencode -> ULencode -> Bool
>= :: ULencode -> ULencode -> Bool
$cmax :: ULencode -> ULencode -> ULencode
max :: ULencode -> ULencode -> ULencode
$cmin :: ULencode -> ULencode -> ULencode
min :: ULencode -> ULencode -> ULencode
Ord)

instance Show ULencode where
  show :: ULencode -> [Char]
show ULencode
W = [Char]
"(False, False)" -- Only working with .wav files.
  show ULencode
UL1 = [Char]
"(False, True)" -- .ul appears.
  show ULencode
UL0 = [Char]
"(True, False)" -- .ul disappears.
  show ULencode
_ = [Char]
"(True, True)" -- .ul is constantly used.

class SoundFileExts a where
  getExts :: a -> (String,String)
  isFileExtsR :: a -> FilePath -> FilePath -> Bool
  isFileExtsR a
ul [Char]
file1 [Char]
file2 = [Char]
xs [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
file1 Bool -> Bool -> Bool
&& [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
file2
    where ([Char]
xs,[Char]
ys) = a -> ([Char], [Char])
forall a. SoundFileExts a => a -> ([Char], [Char])
getExts a
ul

instance SoundFileExts ULencode where
  getExts :: ULencode -> ([Char], [Char])
getExts ULencode
W = ([Char]
".wav",[Char]
".wav")
  getExts ULencode
UL1 = ([Char]
".wav",[Char]
".ul")
  getExts ULencode
UL0 = ([Char]
".ul",[Char]
".wav")
  getExts ULencode
_ = ([Char]
".ul",[Char]
".ul")

-- | Is partially defined, is used internally here.
applyExts2 :: ULencode -> FilePath -> FilePath -> (FilePath, FilePath)
applyExts2 :: ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file1 [Char]
file2 = ([Char] -> [Char]
beforeExtStr [Char]
file1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
xs, [Char] -> [Char]
beforeExtStr [Char]
file2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ys)
  where ([Char]
xs,[Char]
ys) = ULencode -> ([Char], [Char])
forall a. SoundFileExts a => a -> ([Char], [Char])
getExts ULencode
ul

beforeExtStr :: FilePath -> String
beforeExtStr :: [Char] -> [Char]
beforeExtStr [Char]
file =
 case [Char]
end of
  [Char]
".wav" -> [Char]
begin
  (Char
z:[Char]
".ul") -> [Char]
begin [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
z]
  [Char]
_  -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Sound.SoXBasics.beforeExtStr: The file has neither .wav, nor .ul extension."
  where l :: Int
l = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4
        ([Char]
begin,[Char]
end) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
l [Char]
file

-- | The 'FilePath' cannot be \"-n\", please, use in such a case a more convinient function 'soxOpG1'.
soxOpG :: ULencode -> [String] -> FilePath -> [String] -> FilePath -> [String] -> IO (ExitCode, String, String)
soxOpG :: ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [[Char]]
xss [Char]
file1 [[Char]]
yss [Char]
file2 [[Char]]
zss
 | ULencode -> [Char] -> [Char] -> Bool
forall a. SoundFileExts a => a -> [Char] -> [Char] -> Bool
isFileExtsR ULencode
ul [Char]
file1 [Char]
file2 = [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]])
-> ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
  case ULencode
ul of { ULencode
W -> [[[Char]]
xss, [[Char]
file10], [[Char]]
yss, [[Char]
file20], [[Char]]
zss] ; ULencode
UL1 -> [[[Char]]
xss, [[Char]
file10], [[Char]]
yss, [[Char]]
ulResultParameters, [[Char]
file20], [[Char]]
zss] ; ULencode
UL0 -> [[[Char]]
xss, [[Char]]
ulAccessParameters, [[Char]
file10], [[Char]]
yss, [[Char]
file20], [[Char]]
zss] ; ~ULencode
bbb -> [[[Char]]
xss, [[Char]]
ulAccessParameters, [[Char]
file10], [[Char]]
yss, [[Char]]
ulResultParameters, [[Char]
file20], [[Char]]
zss] }) [Char]
""
 | Bool
otherwise = [Char] -> IO (ExitCode, [Char], [Char])
forall a. HasCallStack => [Char] -> a
error [Char]
"Sound.SoXBasics.soxOpG: At least one of the two given files has inappropriate file extension. Please, check the arguments. "
    where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file1 [Char]
file2

-- | The variant of the 'soxOpG' that is used if the second file is not used (or in the situation where some
-- other file is used, too, e. g. with the .prof extension). For the functions in the module, this corresponds
-- to the \"-n\" second file argument.
soxOpG1 :: ULencode -> [String] -> FilePath -> [String] -> [String] -> IO (ExitCode, String, String)
soxOpG1 :: ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [[Char]]
xss [Char]
file1 [[Char]]
yss [[Char]]
zss
 | (([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst (([Char], [Char]) -> [Char])
-> (ULencode -> ([Char], [Char])) -> ULencode -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ULencode -> ([Char], [Char])
forall a. SoundFileExts a => a -> ([Char], [Char])
getExts (ULencode -> [Char]) -> ULencode -> [Char]
forall a b. (a -> b) -> a -> b
$ ULencode
ul) [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
file1 =
    if ULencode
ul ULencode -> ULencode -> Bool
forall a. Ord a => a -> a -> Bool
< ULencode
UL0 then [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]])
-> ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
       [[[Char]]
xss, [[Char]
file1], [[Char]]
yss, [[Char]
"-n"], [[Char]]
zss]) [Char]
""
    else [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]])
-> ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
       [[[Char]]
xss, [[Char]]
ulAccessParameters, [[Char]
file1], [[Char]]
yss, [[Char]
"-n"], [[Char]]
zss]) [Char]
""
 | Bool
otherwise = [Char] -> IO (ExitCode, [Char], [Char])
forall a. HasCallStack => [Char] -> a
error [Char]
"Sound.SoXBasics.soxOpG1: A given file has inappropriate file extension. Please, check the arguments. "

-- | Function 'getMaxAG' returns a maximum amplitude of the sound in the file in the given lower and upper bounds represented as a tuple of 'Int' values.
getMaxAG :: ULencode -> FilePath -> (Int, Int) -> IO String
getMaxAG :: ULencode -> [Char] -> (Int, Int) -> IO [Char]
getMaxAG ULencode
ul [Char]
file (Int
lowerbound, Int
upperbound) = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
_, [Char]
_, [Char]
herr) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [] [Char]
file [] [[Char]
"trim", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lowerbound [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", [Char]
"=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
upperbound [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", [Char]
"stat"]
    let zs :: [[Char]]
zs = [Char] -> [[Char]]
lines [Char]
herr in [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (let u :: [Char]
u = ([Char] -> [[Char]]
words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
zs [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
2 in if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
u [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
9 [Char]
u else Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
8 [Char]
u)
  else do
    FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
    [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Function 'getMinAG' returns a minimum amplitude of the sound in the file in the given lower and upper bounds represented as a tuple of 'Int' values.
getMinAG :: ULencode -> FilePath -> (Int, Int) -> IO String
getMinAG :: ULencode -> [Char] -> (Int, Int) -> IO [Char]
getMinAG ULencode
ul [Char]
file (Int
lowerbound, Int
upperbound) = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
_, [Char]
_, [Char]
herr1) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [] [Char]
file [] [[Char]
"trim", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lowerbound [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", [Char]
"=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
upperbound [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", [Char]
"stat"]
    let zs :: [[Char]]
zs = [Char] -> [[Char]]
lines [Char]
herr1 in [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (let u :: [Char]
u = ([Char] -> [[Char]]
words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
zs [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
4) [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
2 in if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
u [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
9 [Char]
u else Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
8 [Char]
u)
  else do
    FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
    [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Function 'selMaxAbsG' returns a maximum by absolute value amplitude of the sound and allows by its second value in the tuple determine whether it is a maximum or minimum.
-- Bool 'True' corresponds to maximum value, 'False' - to minimum value.
selMaxAbsG :: ULencode -> FilePath -> (Int, Int) -> IO (String, Bool)
selMaxAbsG :: ULencode -> [Char] -> (Int, Int) -> IO ([Char], Bool)
selMaxAbsG ULencode
ul [Char]
file (Int
lowerbnd, Int
upperbnd) = do
  [Char]
tX <- ULencode -> [Char] -> (Int, Int) -> IO [Char]
getMaxAG ULencode
ul [Char]
file (Int
lowerbnd, Int
upperbnd)
  [Char]
tN <- ULencode -> [Char] -> (Int, Int) -> IO [Char]
getMinAG ULencode
ul [Char]
file (Int
lowerbnd, Int
upperbnd)
  ([Char], Bool) -> IO ([Char], Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([Char], [Char]) -> ([Char], Bool)
maxAbs ([Char]
tX, [Char]
tN))

-- | Function 'selMAG' returns a maximum or a minimum of the sound amplitude of the file depending on the @Bool@ value given.
-- Bool 'True' corresponds to maximum value, 'False' - to minimum value.
selMAG :: ULencode -> FilePath -> (Int, Int) -> Bool -> IO String
selMAG :: ULencode -> [Char] -> (Int, Int) -> Bool -> IO [Char]
selMAG ULencode
ul [Char]
file (Int
lowerbnd, Int
upperbnd) Bool
x = if Bool
x then ULencode -> [Char] -> (Int, Int) -> IO [Char]
getMaxAG ULencode
ul [Char]
file (Int
lowerbnd, Int
upperbnd) else ULencode -> [Char] -> (Int, Int) -> IO [Char]
getMinAG ULencode
ul [Char]
file (Int
lowerbnd, Int
upperbnd)

-- | Function 'extremeSG' returns an approximate sample number of the extremum, which will be used further for fade effect.
extremeSG :: ULencode -> FilePath -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeSG :: ULencode
-> [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeSG ULencode
ul [Char]
file (Int
lowerbnd, Int
upperbnd) Int
eps IO ([Char], Bool)
x = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int
upperbnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lowerbnd) (Int
eps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
33) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
  then Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ (Int
upperbnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lowerbnd) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
  else do
    ([Char]
ys, Bool
z) <- IO ([Char], Bool)
x
    let t :: Int
t = (Int
lowerbnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperbnd) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
    [Char]
rs <- ULencode -> [Char] -> (Int, Int) -> Bool -> IO [Char]
selMAG ULencode
ul [Char]
file (Int
lowerbnd, Int
t) Bool
z
    if ([Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
rs)
         then ULencode
-> [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeSG ULencode
ul [Char]
file (Int
lowerbnd, Int
t) Int
eps IO ([Char], Bool)
x
         else ULencode
-> [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeSG ULencode
ul [Char]
file (Int
t, Int
upperbnd) Int
eps IO ([Char], Bool)
x

-- | Function 'alterVadBG' removes an approximate silence measured by the absolute value of the sound amplitude from the beginning of the file.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from). The file must have maximum amplitude absolute value close to 1 before call to the 'alterVadBG'.
-- The second @Float@ parameter is used to exit the iteration cycle. The 'Int' parameter from the range [0..3] specifies a maximum amplitude, starting from
-- which the sound will not be trimmed.
alterVadBG :: ULencode -> FilePath -> Float -> Int -> Float -> IO ()
alterVadBG :: ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadBG ULencode
ul [Char]
file Float
lim Int
noiseMax Float
exit
 | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
lim Float
exit Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"File " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is ready for further processing."
 | Bool
otherwise =
  if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
   then do
     Float
lim1 <- ULencode -> [Char] -> IO Float
durationAG ULencode
ul [Char]
file
     ULencode -> [Char] -> Float -> Float -> Int -> Float -> IO ()
alterVadHelpG ULencode
ul [Char]
file Float
lim1 Float
lim Int
noiseMax Float
exit
   else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

doubleCleanCheck :: FilePath -> FinalException -> IO ()
doubleCleanCheck :: [Char] -> FinalException -> IO ()
doubleCleanCheck [Char]
file FinalException
exception = do
  Bool
e0 <- [Char] -> IO Bool
doesFileExist [Char]
file
  if Bool
e0 then [Char] -> IO ()
removeFile [Char]
file IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FinalException -> IO ()
catchEnd FinalException
exception else FinalException -> IO ()
catchEnd FinalException
exception

-- | Function 'alterVadHelpG' is used internally in the 'alterVadBG' and 'alterVadEG' functions.
alterVadHelpG :: ULencode -> FilePath -> Float -> Float -> Int -> Float -> IO ()
alterVadHelpG :: ULencode -> [Char] -> Float -> Float -> Int -> Float -> IO ()
alterVadHelpG ULencode
ul [Char]
file Float
lim1 Float
lim Int
noiseMax Float
exit
 | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
lim1 Float
lim Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadBG ULencode
ul [Char]
file Float
lim1 Int
noiseMax Float
exit
 | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
lim1 Float
lim Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ =
   let noiseM :: [Char]
noiseM = (case Int
noiseMax of
                 Int
0 -> [Char]
"0.01"
                 Int
1 -> [Char]
"0.02"
                 Int
2 -> [Char]
"0.04"
                 Int
3 -> [Char]
"0.08"
                 Int
_ -> [Char]
"0.04") in do
        (ExitCode
_, [Char]
_, [Char]
herr) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [] [Char]
file [] [[Char]
"trim", [Char]
"0", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float
lim1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0, [Char]
"stat"]
        let zs :: [[Char]]
zs = [Char] -> [[Char]]
lines [Char]
herr in let z :: [Char]
z = ([Char] -> [Char]) -> [[Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit)) ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
1 ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
3 ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
zs in if [Char]
z [Char] -> [Char] -> Bool
forall a. Ord a => a -> a -> Bool
< [Char]
noiseM
          then do
            (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"trim", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float
lim1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0, [Char]
"-0.000000"]
            if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess then Int -> IO ()
threadDelay Int
100000 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ULencode -> [Char] -> [Char] -> Float -> Int -> IO ()
opFileG ULencode
ul [Char]
file10 [Char]
file20 Float
exit Int
noiseMax
            else [Char] -> FinalException -> IO ()
doubleCleanCheck [Char]
file20 FinalException
MaybePartiallyTrimmed
          else ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadBG ULencode
ul [Char]
file10 (Float
lim1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4.0) Int
noiseMax Float
exit
 | Bool
otherwise =
  let noiseM :: [Char]
noiseM = (case Int
noiseMax of
                 Int
0 -> [Char]
"0.01"
                 Int
1 -> [Char]
"0.02"
                 Int
2 -> [Char]
"0.04"
                 Int
3 -> [Char]
"0.08"
                 Int
_ -> [Char]
"0.04") in do
        (ExitCode
_, [Char]
_, [Char]
herr) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [] [Char]
file [] [[Char]
"trim", [Char]
"0", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float
lim Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0, [Char]
"stat"]
        let zs :: [[Char]]
zs = [Char] -> [[Char]]
lines [Char]
herr in let z :: [Char]
z = ([Char] -> [Char]) -> [[Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit)) ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
1 ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
3 ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
zs in if [Char]
z [Char] -> [Char] -> Bool
forall a. Ord a => a -> a -> Bool
< [Char]
noiseM
          then do
            (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"trim", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float
lim Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0, [Char]
"-0.000000"]
            if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess then Int -> IO ()
threadDelay Int
100000 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ULencode -> [Char] -> [Char] -> Float -> Int -> IO ()
opFileG ULencode
ul [Char]
file10 [Char]
file20 Float
exit Int
noiseMax
            else [Char] -> FinalException -> IO ()
doubleCleanCheck [Char]
file20 FinalException
MaybePartiallyTrimmed
          else ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadBG ULencode
ul [Char]
file10 (Float
lim Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4.0) Int
noiseMax Float
exit
             where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"7" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'opFileG' is used internally in 'alterVadB' to check whether 'FilePath' exist and if so to do some processing to allow the 'alterVadB' function iterate further.
opFileG :: ULencode -> FilePath -> FilePath -> Float -> Int -> IO ()
opFileG :: ULencode -> [Char] -> [Char] -> Float -> Int -> IO ()
opFileG ULencode
ul [Char]
file1 [Char]
file2 Float
exit Int
noiseMax = do
  [Char] -> IO ()
removeFile [Char]
file1
  Bool
exist0 <- [Char] -> IO Bool
doesFileExist [Char]
file1
  if Bool
exist0
    then ULencode -> [Char] -> [Char] -> Float -> Int -> IO ()
opFileG ULencode
ul [Char]
file1 [Char]
file2 Float
exit Int
noiseMax
    else do
      [Char] -> [Char] -> IO ()
renameFile [Char]
file2 [Char]
file1
      Float
lim2 <- ULencode -> [Char] -> IO Float
durationAG ULencode
ul [Char]
file1
      ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadBG ULencode
ul [Char]
file1 Float
lim2 Int
noiseMax Float
exit

presenseCheck :: FilePath -> FinalException -> IO ()
presenseCheck :: [Char] -> FinalException -> IO ()
presenseCheck [Char]
file FinalException
exception = do
  Bool
e2 <- [Char] -> IO Bool
doesFileExist [Char]
file
  if Bool
e2 then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () else FinalException -> IO ()
catchEnd FinalException
exception

twoExceptions1File :: ExitCode -> FilePath -> FinalException -> FinalException -> IO ()
twoExceptions1File :: ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file FinalException
exc1 FinalException
exc2 =
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess then [Char] -> FinalException -> IO ()
doubleCleanCheck [Char]
file FinalException
exc1 else [Char] -> FinalException -> IO ()
presenseCheck [Char]
file FinalException
exc2

-- | Function 'norm' applies a SoX normalization effect on the audio file.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
normG :: ULencode -> FilePath -> IO ()
normG :: ULencode -> [Char] -> IO ()
normG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"norm"]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"norm") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'normLG' applies a SoX gain effect on the audio file with the maximum absolute dB value given by the 'Int' argument.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
normLG :: ULencode -> FilePath -> Int -> IO ()
normLG :: ULencode -> [Char] -> Int -> IO ()
normLG ULencode
ul [Char]
file Int
level = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"gain", [Char]
"-n", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
level]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"gain -n") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'normLG' applies a SoX \"gain -b [db-Value]\" effect on the audio file with dB value given by the @Float@ argument.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
gainLG :: ULencode -> FilePath -> Float -> IO ()
gainLG :: ULencode -> [Char] -> Float -> IO ()
gainLG ULencode
ul [Char]
file Float
level = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"gain", [Char]
"-b", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6) Float
level ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"gain -b") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'soxStatG' prints a SoX statistics for the audio file.
soxStatG :: ULencode -> FilePath -> IO ()
soxStatG :: ULencode -> [Char] -> IO ()
soxStatG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
_, [Char]
_, [Char]
herr) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [] [Char]
file [] [[Char]
"stat"]
    [Char] -> IO ()
putStrLn [Char]
herr
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

secondFileClean :: FilePath -> FilePath -> FinalException -> IO ()
secondFileClean :: [Char] -> [Char] -> FinalException -> IO ()
secondFileClean [Char]
file1 [Char]
file2 FinalException
exception = do
  Bool
e1 <- [Char] -> IO Bool
doesFileExist [Char]
file2
  if Bool
e1 then [Char] -> IO ()
removeFile [Char]
file2 else [Char] -> IO ()
putStr [Char]
""
  [Char] -> IO ()
removeFile [Char]
file1
  FinalException -> IO ()
catchEnd FinalException
exception

twoIntermediateFs :: ExitCode -> FilePath ->  FilePath -> FilePath -> FinalException -> IO ()
twoIntermediateFs :: ExitCode -> [Char] -> [Char] -> [Char] -> FinalException -> IO ()
twoIntermediateFs ExitCode
code [Char]
file1 [Char]
file2 [Char]
file3 FinalException
exception = do
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
  then [Char] -> [Char] -> FinalException -> IO ()
secondFileClean [Char]
file1 [Char]
file2 FinalException
exception
  else do
    Bool
e2 <- [Char] -> IO Bool
doesFileExist [Char]
file2
    if Bool
e2
      then do
        [Char] -> IO ()
removeFile [Char]
file1
        [Char] -> IO ()
removeFile [Char]
file3
        [Char] -> [Char] -> IO ()
renameFile [Char]
file2 [Char]
file3
      else do
        [Char] -> IO ()
removeFile [Char]
file1
        FinalException -> IO ()
catchEnd FinalException
exception

-- | Function 'alterVadE' removes an approximate silence measured by the absolute value of the sound amplitude from the end of the file.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from). The second @Float@ parameter is used to exit the iteration cycle. The 'Int' parameter
-- from the range [0..3] specifies a maximum amplitude, starting from which the sound will not be trimmed.
alterVadEG :: ULencode -> FilePath -> Float -> Int -> Float -> IO ()
alterVadEG :: ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadEG ULencode
ul [Char]
file Float
lim Int
noiseMax Float
exit
 | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
lim Float
exit Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"File " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is ready for further processing"
 | Bool
otherwise =
  if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
   then do
     (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"reverse"]
     if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then [Char] -> FinalException -> IO ()
doubleCleanCheck [Char]
file20 ([Char] -> FinalException
NotCreated [Char]
file10)
      else do
        ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadBG ULencode
ul [Char]
file20 Float
lim Int
noiseMax Float
exit
        (ExitCode
code1, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file30 [] [Char]
file40 [[Char]
"reverse"]
        ExitCode -> [Char] -> [Char] -> [Char] -> FinalException -> IO ()
twoIntermediateFs ExitCode
code1 [Char]
file20 [Char]
file40 [Char]
file10 ([Char] -> FinalException
NotCreated [Char]
file10)
   else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
       where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)
             ([Char]
file30, [Char]
file40) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file20 ([Char]
"76" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file10)

-- | Function 'upperBndG' returns a maximum number of samples for use in other functions.
upperBndG :: ULencode -> FilePath -> IO Int
upperBndG :: ULencode -> [Char] -> IO Int
upperBndG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"soxi")
  then do {
    (Maybe Handle
_, Just Handle
hout, Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ([Char] -> [[Char]] -> CreateProcess
proc (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"soxi")) (if ULencode
ul ULencode -> ULencode -> Bool
forall a. Ord a => a -> a -> Bool
< ULencode
UL0 then [[Char]
"-s",[Char]
file] else [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat [[[Char]
"-s"],[[Char]]
ulAccessParameters,[[Char]
file]])){ std_out = CreatePipe } ;
    [Char]
x0 <- Handle -> IO [Char]
hGetContents Handle
hout ;
    let z :: Int
z = [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
x0::Int in Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
z }
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled IO () -> IO Int -> IO Int
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0::Int)

-- | Variant of the function 'extremeSG' with all the additional information included.
extremeSG1G :: ULencode -> FilePath -> IO Int
extremeSG1G :: ULencode -> [Char] -> IO Int
extremeSG1G ULencode
ul [Char]
file = do
  Int
upp <- ULencode -> [Char] -> IO Int
upperBndG ULencode
ul [Char]
file
  ULencode
-> [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeSG ULencode
ul [Char]
file (Int
0::Int, Int
upp) (if Int
upp Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
32 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then Int
upp Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
32 else Int
2::Int) (ULencode -> [Char] -> (Int, Int) -> IO ([Char], Bool)
selMaxAbsG ULencode
ul [Char]
file (Int
0::Int, Int
upp))

-- | Function 'quarterSinFadeG' applies a fade effect by SoX to the audio file with \"q\" type.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
quarterSinFadeG :: ULencode -> FilePath -> IO ()
quarterSinFadeG :: ULencode -> [Char] -> IO ()
quarterSinFadeG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    Int
pos <- ULencode -> [Char] -> IO Int
extremeSG1G ULencode
ul [Char]
file
    Int
upp <- ULencode -> [Char] -> IO Int
upperBndG ULencode
ul [Char]
file
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"fade", [Char]
"q", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
pos [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", [Char]
"=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
upp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
upp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s"]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"fade q") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"4" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'silenceBothG' adds some silence to both ends of the audio.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
silenceBothG :: ULencode -> FilePath -> Int -> Int -> IO ()
silenceBothG :: ULencode -> [Char] -> Int -> Int -> IO ()
silenceBothG ULencode
ul [Char]
file Int
beginning Int
end = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode, [Char], [Char])
_ <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"delay", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
beginning [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", [Char]
"reverse"]
    (ExitCode, [Char], [Char])
_ <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file20 [] [Char]
file40 [[Char]
"delay", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
end [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", [Char]
"reverse"]
    [Char] -> IO ()
removeFile [Char]
file20
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)
            ([Char]
file30, [Char]
file40) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file20 ([Char]
"2" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file10)

-- | Function 'resampleAG' changes the sample rate for the recorded audio for further processing.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
resampleAG :: ULencode -> FilePath -> Int -> IO ()
resampleAG :: ULencode -> [Char] -> Int -> IO ()
resampleAG ULencode
ul [Char]
file Int
frequency = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"rate", [Char]
"-s", [Char]
"-I", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
frequency]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"rate") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'durationAG' returns a duration of the audio file in seconds.
durationAG :: ULencode -> FilePath -> IO Float
durationAG :: ULencode -> [Char] -> IO Float
durationAG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"soxi")
  then do
    (Maybe Handle
_, Just Handle
hout, Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ([Char] -> [[Char]] -> CreateProcess
proc (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"soxi")) (if ULencode
ul ULencode -> ULencode -> Bool
forall a. Ord a => a -> a -> Bool
< ULencode
UL0 then [[Char]
"-D",[Char]
file] else [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat [[[Char]
"-D"],[[Char]]
ulAccessParameters,[[Char]
file]])) { std_out = CreatePipe }
    [Char]
x0 <- Handle -> IO [Char]
hGetContents Handle
hout
    let z :: Float
z = [Char] -> Float
forall a. Read a => [Char] -> a
read [Char]
x0::Float in Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
z
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled IO () -> IO Float -> IO Float
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
0.0

-- | Function 'noiseProfBG' creates with SoX a file containing a noise profile for the first 0.05 s of the audio file given.
noiseProfBG :: ULencode -> FilePath -> IO ()
noiseProfBG :: ULencode -> [Char] -> IO ()
noiseProfBG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [] [Char]
file [] [[Char]
"trim", [Char]
"0", [Char]
"0.05", [Char]
"noiseprof",[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof"]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof") ([Char] -> FinalException
NoiseProfileNotCreatedB [Char]
file) ([Char] -> FinalException
NoiseProfileNotCreatedB [Char]
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'noiseProfEG' creates with SoX a file containing a noise profile for the last 0.05 s of the audio file given.
noiseProfEG :: ULencode -> FilePath -> IO ()
noiseProfEG :: ULencode -> [Char] -> IO ()
noiseProfEG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [] [Char]
file [] [[Char]
"trim", [Char]
"-0.05", [Char]
"0.05", [Char]
"noiseprof",[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof"]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof") ([Char] -> FinalException
NoiseProfileNotCreatedE [Char]
file) ([Char] -> FinalException
NoiseProfileNotCreatedE [Char]
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'noiseReduceBG' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfBG' function.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
noiseReduceBG :: ULencode -> FilePath -> IO ()
noiseReduceBG :: ULencode -> [Char] -> IO ()
noiseReduceBG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"noisered", [Char]
file10 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof"]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'noiseReduceEG' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfEG' function.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
noiseReduceEG :: ULencode -> FilePath -> IO ()
noiseReduceEG :: ULencode -> [Char] -> IO ()
noiseReduceEG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"noisered", [Char]
file10 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof"]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'noiseReduceBUG' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfBUG' function.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from). The @Float@ parameter is a number between 0 and 1 showing the level of
-- reducing the noise (the greater number means that the function will reduce more intensively may be even aggressively so that for greater
-- numbers it can remove some sensitive and important sound data as a noise). Internally this parameter is passed unchanged to the \"sox\"
-- so that it uses it as an amount parameter for the \"noisered\" effect. Therefore, please, (as being stated in the SoX manual) experiment
-- with the amount to get suitable results.
noiseReduceBUG :: ULencode -> FilePath -> Float -> IO ()
noiseReduceBUG :: ULencode -> [Char] -> Float -> IO ()
noiseReduceBUG ULencode
ul [Char]
file Float
amount = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"noisered", [Char]
file10 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
amount ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'noiseReduceEUG' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfEGU' function.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from). The @Float@ parameter is a number between 0 and 1 showing the level of
-- reducing the noise (the greater number means that the function will reduce more intensively may be even aggressively so that for greater
-- numbers it can remove some sensitive and important sound data as a noise). Internally this parameter is passed unchanged to the \"sox\"
-- so that it uses it as an amount parameter for the \"noisered\" effect. Therefore, please, (as being stated in the SoX manual) experiment
-- with the amount to get suitable results.
noiseReduceEUG :: ULencode -> FilePath -> Float -> IO ()
noiseReduceEUG :: ULencode -> [Char] -> Float -> IO ()
noiseReduceEUG ULencode
ul [Char]
file Float
amount = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"noisered", [Char]
file10 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
amount ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'volS' changes the given audio with the linear ratio for the amplitude so that the resulting amlitude is equal to the given @Float@ parameter.
-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be
-- in the same directory where the function is called from).
volSG :: ULencode -> FilePath -> Float -> IO ()
volSG :: ULencode -> [Char] -> Float -> IO ()
volSG ULencode
ul [Char]
file Float
amplitude = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    ULencode -> [Char] -> IO ()
normG ULencode
ul [Char]
file
    Bool
e0 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
    if Bool
e0
      then do
        (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"vol", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplitude ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0, [Char]
"amplitude"]
        if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
          then [Char] -> [Char] -> FinalException -> IO ()
secondFileClean [Char]
file10 [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"vol")
          else [Char] -> FinalException -> IO ()
presenseCheck [Char]
file20 ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
      else FinalException -> IO ()
catchEnd ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul ([Char]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file) ([Char]
"8." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'volS2G' changes the given audio (the first 'FilePath' parameter, which must be normalized e. g. by the 'norm' function before) with
-- the linear ratio for the amplitude so that the resulting amlitude is equal to the maximum by absolute value amplitude for the file given
-- by the second 'FilePath' parameter. The function must be used with the first 'FilePath' parameter containing no directories in its name
-- (that means the file of the first 'FilePath' parameter must be in the same directory where the function is called from).
volS2G :: ULencode -> FilePath -> FilePath -> IO ()
volS2G :: ULencode -> [Char] -> [Char] -> IO ()
volS2G ULencode
ul [Char]
fileA [Char]
fileB = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    Int
upp <- ULencode -> [Char] -> IO Int
upperBndG ULencode
ul [Char]
fileB
    [Char]
amplMax <- ULencode -> [Char] -> (Int, Int) -> Bool -> IO [Char]
selMAG ULencode
ul [Char]
fileB (Int
0, Int
upp) Bool
True
    [Char]
amplMin <- ULencode -> [Char] -> (Int, Int) -> Bool -> IO [Char]
selMAG ULencode
ul [Char]
fileB (Int
0, Int
upp) Bool
False
    let ampl :: Float
ampl = [Char] -> Float
forall a. Read a => [Char] -> a
read (([Char], Bool) -> [Char]
forall a b. (a, b) -> a
fst (([Char], Bool) -> [Char])
-> (([Char], [Char]) -> ([Char], Bool))
-> ([Char], [Char])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> ([Char], Bool)
maxAbs (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char]
amplMax, [Char]
amplMin))::Float
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"vol", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
ampl ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0, [Char]
"amplitude"]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"vol") ([Char] -> FinalException
InitialFileNotChanged [Char]
fileA)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
fileA ([Char]
"8." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
fileA)

-- | Function 'sincAG' uses a \"sinc\" effect with @-a 50 -I 0.07k-11k@ band-pass filter for the audio file given.
sincAG :: ULencode -> FilePath -> IO ()
sincAG :: ULencode -> [Char] -> IO ()
sincAG ULencode
ul [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [Char]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG ULencode
ul [] [Char]
file10 [] [Char]
file20 [[Char]
"sinc", [Char]
"-a", [Char]
"50", [Char]
"-I", [Char]
"0.07k-11k"]
    ExitCode -> [Char] -> FinalException -> FinalException -> IO ()
twoExceptions1File ExitCode
code [Char]
file20 ([Char] -> FinalException
NotCreatedWithEffect [Char]
"sinc") ([Char] -> FinalException
InitialFileNotChanged [Char]
file10)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
      where ([Char]
file10, [Char]
file20) = ULencode -> [Char] -> [Char] -> ([Char], [Char])
applyExts2 ULencode
ul [Char]
file ([Char]
"4." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

-- | Function 'sampleAnG' analyzes the one sample of the 1-channel sound file (or k samples for the k-channel file) and returns a tuple pair of
-- the maximum and minimum amplitudes of the sound given as 'String's. For the 1-channel sound file they are the same.
-- The 'Integer' parameter is the number of the sample, starting from which SoX analyzes the sound. If it is less than number of the samples available,
-- then the function returns the value for the last one sample for the 1-channel file (or the last k samples for the k-channel sound file).
-- The file must not be in a RAW format for the function to work properly.
sampleAnG :: ULencode -> FilePath -> Integer -> IO (String, String)
sampleAnG :: ULencode -> [Char] -> Integer -> IO ([Char], [Char])
sampleAnG ULencode
ul [Char]
file Integer
pos = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") Bool -> Bool -> Bool
&& Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"soxi")
  then IO ([Char], [Char]) -> IO () -> IO ([Char], [Char])
forall a b. IO a -> IO b -> IO a
onException (do
    (ExitCode
_, [Char]
hout, [Char]
_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"soxi")) (if ULencode
ul ULencode -> ULencode -> Bool
forall a. Ord a => a -> a -> Bool
< ULencode
UL0 then [[Char]
"-s", [Char]
file] else [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat [[[Char]
"-s"],[[Char]]
ulAccessParameters,[[Char]
file]]) [Char]
""
    let length0 :: Integer
length0 = [Char] -> Integer
forall a. Read a => [Char] -> a
read [Char]
hout::Integer
        f :: a -> IO ([Char], [Char])
f a
param = do
          (ExitCode
_, [Char]
_, [Char]
herr) <- ULencode
-> [[Char]]
-> [Char]
-> [[Char]]
-> [[Char]]
-> IO (ExitCode, [Char], [Char])
soxOpG1 ULencode
ul [] [Char]
file [] [[Char]
"trim", a -> [Char]
forall a. Show a => a -> [Char]
show a
param [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s", [Char]
"1s", [Char]
"stat"]
          let lns :: [[Char]]
lns = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words) ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
3 ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
5 ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
herr in ([Char], [Char]) -> IO ([Char], [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
lns, [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last [[Char]]
lns)
    if Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
length0 (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pos) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
      then Integer -> IO ([Char], [Char])
forall {a}. Show a => a -> IO ([Char], [Char])
f Integer
pos
      else Integer -> IO ([Char], [Char])
forall {a}. Show a => a -> IO ([Char], [Char])
f (Integer
length0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)) (FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotEnoughData [Char]
file))
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled IO () -> IO ([Char], [Char]) -> IO ([Char], [Char])
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char], [Char]) -> IO ([Char], [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"",[Char]
"")

---------------------------------------------------------------

-- | Function 'playA' plays the given file with SoX. For Windows it uses \"-t waveaudio -d\" options for SoX.
playA :: FilePath -> IO ()
playA :: [Char] -> IO ()
playA [Char]
file 
   | Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
5 [Char]
os [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"mingw" = 
      if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
          then [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) [[Char]
file, [Char]
"-t", [Char]
"waveaudio", [Char]
"-d"] [Char]
"" IO (ExitCode, [Char], [Char]) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
   | Bool
otherwise = 
      if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"play") 
          then [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"play")) [[Char]
file] [Char]
"" IO (ExitCode, [Char], [Char]) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

--------------------------------------------------------------

getMaxA :: [Char] -> (Int, Int) -> IO [Char]
getMaxA = ULencode -> [Char] -> (Int, Int) -> IO [Char]
getMaxAG ULencode
W

getMinA :: [Char] -> (Int, Int) -> IO [Char]
getMinA = ULencode -> [Char] -> (Int, Int) -> IO [Char]
getMinAG ULencode
W

selMaxAbs :: [Char] -> (Int, Int) -> IO ([Char], Bool)
selMaxAbs = ULencode -> [Char] -> (Int, Int) -> IO ([Char], Bool)
selMaxAbsG ULencode
W

selMA :: [Char] -> (Int, Int) -> Bool -> IO [Char]
selMA = ULencode -> [Char] -> (Int, Int) -> Bool -> IO [Char]
selMAG ULencode
W

extremeS :: [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeS = ULencode
-> [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeSG ULencode
W

extremeS1 :: [Char] -> IO Int
extremeS1 = ULencode -> [Char] -> IO Int
extremeSG1G ULencode
W

soxStat :: [Char] -> IO ()
soxStat = ULencode -> [Char] -> IO ()
soxStatG ULencode
W

upperBnd :: [Char] -> IO Int
upperBnd = ULencode -> [Char] -> IO Int
upperBndG ULencode
W

durationA :: [Char] -> IO Float
durationA = ULencode -> [Char] -> IO Float
durationAG ULencode
W

sampleAn :: [Char] -> Integer -> IO ([Char], [Char])
sampleAn = ULencode -> [Char] -> Integer -> IO ([Char], [Char])
sampleAnG ULencode
W

alterVadB :: [Char] -> Float -> Int -> Float -> IO ()
alterVadB = ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadBG ULencode
W

alterVadE :: [Char] -> Float -> Int -> Float -> IO ()
alterVadE = ULencode -> [Char] -> Float -> Int -> Float -> IO ()
alterVadEG ULencode
W

alterVadHelp :: [Char] -> Float -> Float -> Int -> Float -> IO ()
alterVadHelp = ULencode -> [Char] -> Float -> Float -> Int -> Float -> IO ()
alterVadHelpG ULencode
W

opFile :: [Char] -> [Char] -> Float -> Int -> IO ()
opFile = ULencode -> [Char] -> [Char] -> Float -> Int -> IO ()
opFileG ULencode
W

norm :: [Char] -> IO ()
norm = ULencode -> [Char] -> IO ()
normG ULencode
W

normL :: [Char] -> Int -> IO ()
normL = ULencode -> [Char] -> Int -> IO ()
normLG ULencode
W

gainL :: [Char] -> Float -> IO ()
gainL = ULencode -> [Char] -> Float -> IO ()
gainLG ULencode
W

quarterSinFade :: [Char] -> IO ()
quarterSinFade = ULencode -> [Char] -> IO ()
quarterSinFadeG ULencode
W

silenceBoth :: [Char] -> Int -> Int -> IO ()
silenceBoth = ULencode -> [Char] -> Int -> Int -> IO ()
silenceBothG ULencode
W

resampleA :: [Char] -> Int -> IO ()
resampleA = ULencode -> [Char] -> Int -> IO ()
resampleAG ULencode
W

noiseProfB :: [Char] -> IO ()
noiseProfB = ULencode -> [Char] -> IO ()
noiseProfBG ULencode
W

noiseProfE :: [Char] -> IO ()
noiseProfE = ULencode -> [Char] -> IO ()
noiseProfEG ULencode
W

noiseReduceB :: [Char] -> IO ()
noiseReduceB = ULencode -> [Char] -> IO ()
noiseReduceBG ULencode
W

noiseReduceE :: [Char] -> IO ()
noiseReduceE = ULencode -> [Char] -> IO ()
noiseReduceEG ULencode
W

noiseReduceBU :: [Char] -> Float -> IO ()
noiseReduceBU = ULencode -> [Char] -> Float -> IO ()
noiseReduceBUG ULencode
W

noiseReduceEU :: [Char] -> Float -> IO ()
noiseReduceEU = ULencode -> [Char] -> Float -> IO ()
noiseReduceEUG ULencode
W

sincA :: [Char] -> IO ()
sincA = ULencode -> [Char] -> IO ()
sincAG ULencode
W

volS :: [Char] -> Float -> IO ()
volS = ULencode -> [Char] -> Float -> IO ()
volSG ULencode
W

volS2 :: [Char] -> [Char] -> IO ()
volS2 = ULencode -> [Char] -> [Char] -> IO ()
volS2G ULencode
W