-- |
-- Module      :  SoXBasics.Arr
-- Copyright   :  (c) OleksandrZhabenko 2019-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A program and a library that can be used as a simple 
-- basic interface to some SoX functionality or for producing 
-- the approximately Ukrainian speech with your own recorded 
-- voice (actually it produces the needed sound representations).
--


module SoXBasics.Arr (
  -- * Get Information
  maxAbs
  , getMaxA
  , getMinA
  , selMaxAbs
  , selMA
  , extremeS
  , extremeS1
  , soxStat
  , upperBnd
  , durationA
  , sampleAn
  -- * Produce sound
  -- ** Trimming the silence
  , alterVadB
  , alterVadE
  , alterVadHelp
  , opFile
  -- ** Amplitude modification
  , norm
  , normL
  , gainL
  , quarterSinFade
  -- ** Adding silence
  , silenceBoth
  -- ** Recording
  , recA
  , recB
  -- ** Changing sample rate
  , resampleA
  -- ** Working with noise
  , noiseProfB
  , noiseProfE
  , noiseReduceB
  , noiseReduceE
  , noiseReduceBU
  , noiseReduceEU
  -- ** Filtering
  , sincA
  -- ** Volume amplification
  , volS
  , volS2
  -- * Playing sound
  , playA
) where

import System.Directory
import Data.Maybe (isJust, fromJust)
import Numeric
import Data.Char
import System.Process
import System.IO
import EndOfExe
import System.Exit
import Control.Concurrent (threadDelay)
import Control.Exception (onException)
import System.Info (os)
import Sound.Control.Exception.FinalException

-- | 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 :: (String, String) -> (String, Bool)
maxAbs (String
xs, String
ys) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys = ([], Bool
False)
                | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
head String
ys Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = if String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
xs String
ys Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT then (String
xs, Bool
False) else (String
ys, Bool
False)
                | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
head String
ys Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' = if String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
xs String
ys Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then (String
xs, Bool
True) else (String
ys, Bool
True)
                | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
head String
ys Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' = if String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String
forall a. [a] -> [a]
tail String
xs) String
ys Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT then (String
xs, Bool
False) else (String
ys, Bool
True)
                | Bool
otherwise = if String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
xs (String -> String
forall a. [a] -> [a]
tail String
ys) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then (String
xs, Bool
True) else (String
ys, Bool
False)

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

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

-- | Function 'selMaxAbs' 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.
selMaxAbs :: FilePath -> (Int, Int) -> IO (String, Bool)
selMaxAbs :: String -> (Int, Int) -> IO (String, Bool)
selMaxAbs String
file (Int
lowerbnd, Int
upperbnd) = do 
  String
tX <- String -> (Int, Int) -> IO String
getMaxA String
file (Int
lowerbnd, Int
upperbnd)
  String
tN <- String -> (Int, Int) -> IO String
getMinA String
file (Int
lowerbnd, Int
upperbnd)
  (String, Bool) -> IO (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String) -> (String, Bool)
maxAbs (String
tX, String
tN))

-- | Function 'selMA' 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.
selMA :: FilePath -> (Int, Int) -> Bool -> IO String
selMA :: String -> (Int, Int) -> Bool -> IO String
selMA String
file (Int
lowerbnd, Int
upperbnd) Bool
x = if Bool
x then String -> (Int, Int) -> IO String
getMaxA String
file (Int
lowerbnd, Int
upperbnd) else String -> (Int, Int) -> IO String
getMinA String
file (Int
lowerbnd, Int
upperbnd)

-- | Function 'extremeS' returns an approximate sample number of the extremum, which will be used further for fade effect.
extremeS :: FilePath -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeS :: String -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeS String
file (Int
lowerbnd, Int
upperbnd) Int
eps IO (String, 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 (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   
    (String
ys, Bool
z) <- IO (String, 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 
    String
rs <- String -> (Int, Int) -> Bool -> IO String
selMA String
file (Int
lowerbnd, Int
t) Bool
z
    if (String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
rs) 
         then String -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeS String
file (Int
lowerbnd, Int
t) Int
eps IO (String, Bool)
x
         else String -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeS String
file (Int
t, Int
upperbnd) Int
eps IO (String, Bool)
x

-- | Function 'alterVadB' 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 'alterVadB'. 
-- 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.
alterVadB :: FilePath -> Float -> Int -> Float -> IO ()
alterVadB :: String -> Float -> Int -> Float -> IO ()
alterVadB String
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 = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"File " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is ready for further processing."
                                 | Bool
otherwise = 
 if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox")
  then do
         Float
lim1 <- String -> IO Float
durationA String
file
         String -> Float -> Float -> Int -> Float -> IO ()
alterVadHelp String
file Float
lim1 Float
lim Int
noiseMax Float
exit  
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
  
-- | Function 'alterVadHelp' is used internally in the 'alterVadB' and 'alterVadE' functions. 
alterVadHelp :: FilePath -> Float -> Float -> Int -> Float -> IO ()
alterVadHelp :: String -> Float -> Float -> Int -> Float -> IO ()
alterVadHelp String
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 = String -> Float -> Int -> Float -> IO ()
alterVadB String
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 :: String
noiseM = (case Int
noiseMax of 
                Int
0 -> String
"0.01"
                Int
1 -> String
"0.02"
                Int
2 -> String
"0.04"
                Int
3 -> String
"0.08"
                Int
_ -> String
"0.04") in do 
       (ExitCode
_, String
_, String
herr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"-n", String
"trim", String
"0", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float
lim1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0, String
"stat"] String
""
       let zs :: [String]
zs = String -> [String]
lines String
herr in let z :: String
z = (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> Bool) -> String -> String
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)) ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
3 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
zs in if String
z String -> String -> Bool
forall a. Ord a => a -> a -> Bool
< String
noiseM
          then do 
            (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"trim", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float
lim1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0, String
"-0.000000"] String
""
            if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
              then do
                Int -> IO ()
threadDelay Int
100000
                String -> Float -> Int -> IO ()
opFile String
file Float
exit Int
noiseMax
              else do
                Bool
e0 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                if Bool
e0
                  then do
                    String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                    FinalException -> IO ()
catchEnd FinalException
MaybePartiallyTrimmed
                  else FinalException -> IO ()
catchEnd FinalException
MaybePartiallyTrimmed
          else String -> Float -> Int -> Float -> IO ()
alterVadB String
file (Float
lim1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4.0) Int
noiseMax Float
exit  
                                         | Bool
otherwise = 
 let noiseM :: String
noiseM = (case Int
noiseMax of 
                Int
0 -> String
"0.01"
                Int
1 -> String
"0.02"
                Int
2 -> String
"0.04"
                Int
3 -> String
"0.08"
                Int
_ -> String
"0.04") in do 
       (ExitCode
_, String
_, String
herr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"-n", String
"trim", String
"0", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float
lim Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0, String
"stat"] String
""
       let zs :: [String]
zs = String -> [String]
lines String
herr in let z :: String
z = (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> Bool) -> String -> String
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)) ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
3 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
zs in if String
z String -> String -> Bool
forall a. Ord a => a -> a -> Bool
< String
noiseM
          then do 
            (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"trim", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float
lim Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0, String
"-0.000000"] String
""
            if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
              then do
                Int -> IO ()
threadDelay Int
100000
                String -> Float -> Int -> IO ()
opFile String
file Float
exit Int
noiseMax
              else do
                Bool
e0 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                if Bool
e0
                  then do
                    String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                    FinalException -> IO ()
catchEnd FinalException
MaybePartiallyTrimmed
                  else FinalException -> IO ()
catchEnd FinalException
MaybePartiallyTrimmed
          else String -> Float -> Int -> Float -> IO ()
alterVadB String
file (Float
lim Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4.0) Int
noiseMax Float
exit

-- | Function 'opFile' is used internally in 'alterVadB' to check whether @FilePath@ exist and if so to do some processing to allow the 'alterVadB' function iterate further.
opFile :: FilePath -> Float -> Int -> IO ()
opFile :: String -> Float -> Int -> IO ()
opFile String
file Float
exit Int
noiseMax = do
  String -> IO ()
removeFile String
file
  Bool
exist0 <- String -> IO Bool
doesFileExist String
file
  if Bool -> Bool
not Bool
exist0 
    then do 
      String -> String -> IO ()
renameFile (String
"7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file) String
file
      Float
lim2 <- String -> IO Float
durationA String
file
      String -> Float -> Int -> Float -> IO ()
alterVadB String
file Float
lim2 Int
noiseMax Float
exit
    else String -> Float -> Int -> IO ()
opFile String
file Float
exit Int
noiseMax

-- | 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).
norm :: FilePath -> IO ()
norm :: String -> IO ()
norm String
file = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"norm"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"norm")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"norm")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'normL' 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).
normL :: FilePath -> Int -> IO ()
normL :: String -> Int -> IO ()
normL String
file Int
level = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"gain", String
"-n", Int -> String
forall a. Show a => a -> String
show Int
level] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"gain -n")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"gain -n")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'normL' 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).
gainL :: FilePath -> Float -> IO ()
gainL :: String -> Float -> IO ()
gainL String
file Float
level = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"gain", String
"-b", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6) Float
level (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"gain -b")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"gain -b")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'soxStat' prints a SoX statistics for the audio file.
soxStat :: FilePath -> IO ()
soxStat :: String -> IO ()
soxStat String
file = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do 
    (ExitCode
_, String
_, String
herr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"-n", String
"stat"] String
""
    String -> IO ()
putStrLn String
herr
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
  
-- | 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.
alterVadE :: FilePath -> Float -> Int -> Float -> IO ()
alterVadE :: String -> Float -> Int -> Float -> IO ()
alterVadE String
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 = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"File " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is ready for further processing"
                                 | Bool
otherwise = 
 if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"reverse"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then do
        Bool
e0 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e0
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreated String
file)
          else do
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreated String
file)
      else do
        String -> Float -> Int -> Float -> IO ()
alterVadB (String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file) Float
lim Int
noiseMax Float
exit
        (ExitCode
code1, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"76" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"reverse"] String
""
        if ExitCode
code1 ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
          then do
            Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"76" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            if Bool
e1
              then do
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"76" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                FinalException -> IO ()
catchEnd (String -> FinalException
NotCreated String
file)
              else do
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                FinalException -> IO ()
catchEnd (String -> FinalException
NotCreated String
file)
          else do
            Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"76" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            if Bool
e2
              then do
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                String -> IO ()
removeFile String
file
                String -> String -> IO ()
renameFile (String
"76" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file) String
file
              else do
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                FinalException -> IO ()
catchEnd (String -> FinalException
NotCreated String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

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

-- | Variant of the function 'extremeS' with all the additional information included.
extremeS1 :: FilePath -> IO Int
extremeS1 :: String -> IO Int
extremeS1 String
file = do
  Int
upp <- String -> IO Int
upperBnd String
file
  String -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeS String
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) (String -> (Int, Int) -> IO (String, Bool)
selMaxAbs String
file (Int
0::Int, Int
upp))

-- | Function 'quarterSinFade' 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).
quarterSinFade :: FilePath -> IO ()
quarterSinFade :: String -> IO ()
quarterSinFade String
file = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    Int
pos <- String -> IO Int
extremeS1 String
file
    Int
upp <- String -> IO Int
upperBnd String
file
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"fade", String
"q", Int -> String
forall a. Show a => a -> String
show Int
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
upp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", Int -> String
forall a. Show a => a -> String
show (Int
upp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"fade q")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"fade q")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'silenceBoth' 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).
silenceBoth :: FilePath -> Int -> Int -> IO ()
silenceBoth :: String -> Int -> Int -> IO ()
silenceBoth String
file Int
beginning Int
end = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"delay", Int -> String
forall a. Show a => a -> String
show Int
beginning String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", String
"reverse"] String
""
    (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
"3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"delay", Int -> String
forall a. Show a => a -> String
show Int
end String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", String
"reverse"] String
""
    String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'recA' records audio file with the given name and duration in seconds. For Windows it uses a default audio device and \"-t waveaudio -d\" option to the SoX.
recA :: FilePath -> Float -> IO ()
recA :: String -> Float -> IO ()
recA String
file Float
x | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw" = do 
  (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
"-t",String
"waveaudio",String
"-d",String
"-b16", String
"-c1", String
"-esigned-integer", String
"-L", String
file, String
"trim", String
"0.5", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0] String
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- String -> IO Bool
doesFileExist String
file
      if Bool
e0
        then do
          String -> IO ()
removeFile String
file
          FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
    else do
      Bool
e1 <- String -> IO Bool
doesFileExist String
file
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
            | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"rec") = do
  (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"rec")) [String
"-b16", String
"-c1", String
"-esigned-integer", String
"-L", String
file, String
"trim", String
"0.5", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0] String
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- String -> IO Bool
doesFileExist String
file
      if Bool
e0
        then do
          String -> IO ()
removeFile String
file
          FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
    else do
      Bool
e1 <- String -> IO Bool
doesFileExist String
file
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
            | Bool
otherwise = FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'recB' records audio file with the given name and duration in seconds. For Windows it uses a default audio device and \"-t waveaudio -d\" option 
-- to the SoX. Unlike 'recA', the duration of the pause in seconds (before the SoX executable actually starts to record sound data after
-- an initialization of the sound recording device) is controlled by the second @Float@ function argument. 
recB :: FilePath -> (Float, Float) -> IO ()
recB :: String -> (Float, Float) -> IO ()
recB String
file (Float
x, Float
y) | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw" = do 
  (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
"-t",String
"waveaudio",String
"-d",String
"-b16", String
"-c1", String
"-esigned-integer", String
"-L", String
file, String
"trim", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0, Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0] String
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- String -> IO Bool
doesFileExist String
file
      if Bool
e0
        then do
          String -> IO ()
removeFile String
file
          FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
    else do
      Bool
e1 <- String -> IO Bool
doesFileExist String
file
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
                 | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"rec") = do
  (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"rec")) [String
"-b16", String
"-c1", String
"-esigned-integer", String
"-L", String
file, String
"trim", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0, Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0] String
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- String -> IO Bool
doesFileExist String
file
      if Bool
e0
        then do
          String -> IO ()
removeFile String
file
          FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
    else do
      Bool
e1 <- String -> IO Bool
doesFileExist String
file
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
                 | Bool
otherwise = FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'resampleA' 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).
resampleA :: FilePath -> Int -> IO ()
resampleA :: String -> Int -> IO ()
resampleA String
file Int
frequency = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"rate", String
"-s", String
"-I", Int -> String
forall a. Show a => a -> String
show Int
frequency] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"rate")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"rate")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

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

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

-- | Function 'noiseProfB' creates with SoX a file containing a noise profile for the first 0.05 s of the audio file given.
noiseProfB :: FilePath -> IO ()
noiseProfB :: String -> IO ()
noiseProfB String
file = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"-n", String
"trim", String
"0", String
"0.05", String
"noiseprof",String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".b.prof"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then do
        Bool
e0 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".b.prof"
        if Bool
e0
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".b.prof"
            FinalException -> IO ()
catchEnd (String -> FinalException
NoiseProfileNotCreatedB String
file)
          else FinalException -> IO ()
catchEnd (String -> FinalException
NoiseProfileNotCreatedB String
file)
      else do 
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".b.prof"
        if Bool
e1
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
NoiseProfileNotCreatedB String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'noiseProfE' creates with SoX a file containing a noise profile for the last 0.05 s of the audio file given. 
noiseProfE :: FilePath -> IO ()
noiseProfE :: String -> IO ()
noiseProfE String
file = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"-n", String
"trim", String
"-0.05", String
"0.05", String
"noiseprof",String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".e.prof"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then do
        Bool
e0 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".e.prof"
        if Bool
e0
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".e.prof"
            FinalException -> IO ()
catchEnd (String -> FinalException
NoiseProfileNotCreatedE String
file)
          else FinalException -> IO ()
catchEnd (String -> FinalException
NoiseProfileNotCreatedE String
file)
      else do 
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".e.prof"
        if Bool
e1
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
NoiseProfileNotCreatedE String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'noiseReduceB' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfB' 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).
noiseReduceB :: FilePath -> IO ()
noiseReduceB :: String -> IO ()
noiseReduceB String
file = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox")
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"noisered", String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".b.prof"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'noiseReduceE' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfE' 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).
noiseReduceE :: FilePath -> IO ()
noiseReduceE :: String -> IO ()
noiseReduceE String
file = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"_." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"noisered", String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".e.prof"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"_." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"_." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"_." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'noiseReduceBU' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfBU' 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. 
noiseReduceBU :: FilePath -> Float -> IO ()
noiseReduceBU :: String -> Float -> IO ()
noiseReduceBU String
file Float
amount = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox")
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"noisered", String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".b.prof", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
amount (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'noiseReduceEU' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfEU' 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. 
noiseReduceEU :: FilePath -> Float -> IO ()
noiseReduceEU :: String -> Float -> IO ()
noiseReduceEU String
file Float
amount = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"_." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"noisered", String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".e.prof", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
amount (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"_." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"_." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
      else do 
        Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"_." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e2 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | 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).
volS :: FilePath -> Float -> IO ()
volS :: String -> Float -> IO ()
volS String
file Float
amplitude = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    String -> IO ()
norm String
file
    Bool
e0 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
    if Bool
e0
      then do
        (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"vol", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplitude (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0, String
"amplitude"] String
""
        if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
          then do
            Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            if Bool
e1
              then do
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"vol")
              else do
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"vol")
          else do 
            Bool
e2 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            if Bool
e2 
              then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              else do 
                String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
                FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
      else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'volS2' 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).
volS2 :: FilePath -> FilePath -> IO ()
volS2 :: String -> String -> IO ()
volS2 String
fileA String
fileB = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    Int
upp <- String -> IO Int
upperBnd String
fileB
    String
amplMax <- String -> (Int, Int) -> Bool -> IO String
selMA String
fileB (Int
0, Int
upp) Bool
True
    String
amplMin <- String -> (Int, Int) -> Bool -> IO String
selMA String
fileB (Int
0, Int
upp) Bool
False
    let ampl :: Float
ampl = String -> Float
forall a. Read a => String -> a
read ((String, Bool) -> String
forall a b. (a, b) -> a
fst ((String, Bool) -> String)
-> ((String, String) -> (String, Bool))
-> (String, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> (String, Bool)
maxAbs ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ (String
amplMax, String
amplMin))::Float
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
fileA, String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
tail String
fileA, String
"vol", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
ampl (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0, String
"amplitude"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
tail String
fileA
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
tail String
fileA
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"vol")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"vol")
      else do 
        Bool
file8e <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
tail String
fileA
        if Bool
file8e 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
fileA)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'sincA' uses a \"sinc\" effect with @-a 50 -I 0.07k-11k@ band-pass filter for the audio file given.
sincA :: FilePath -> IO ()
sincA :: String -> IO ()
sincA String
file = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
  then do
    (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"4." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file, String
"sinc", String
"-a", String
"50", String
"-I", String
"0.07k-11k"] String
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"4." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e1
          then do
            String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"4." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
            FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"sinc")
          else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"sinc")
      else do 
        Bool
e0 <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"4." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        if Bool
e0 
          then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'sampleAn' analyzes the one samle 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.
sampleAn :: FilePath -> Integer -> IO (String, String)
sampleAn :: String -> Integer -> IO (String, String)
sampleAn String
file Integer
pos = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"soxi")
  then IO (String, String) -> IO () -> IO (String, String)
forall a b. IO a -> IO b -> IO a
onException (do
    (ExitCode
_, String
hout, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"soxi")) [String
"-s", String
file] String
""
    let length0 :: Integer
length0 = String -> Integer
forall a. Read a => String -> a
read String
hout::Integer
        f :: a -> IO (String, String)
f a
param = do 
          (ExitCode
_, String
_, String
herr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
file, String
"-n", String
"trim", a -> String
forall a. Show a => a -> String
show a
param String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", String
"1s", String
"stat"] String
""
          let lns :: [String]
lns = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
forall a. [a] -> a
last ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
3 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
5 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
herr in (String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall a. [a] -> a
head [String]
lns, [String] -> String
forall a. [a] -> a
last [String]
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 (String, String)
forall a. Show a => a -> IO (String, String)
f Integer
pos
      else Integer -> IO (String, String)
forall a. Show a => a -> IO (String, String)
f (Integer
length0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)) (FinalException -> IO ()
catchEnd (String -> FinalException
NotEnoughData String
file))
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled IO () -> IO (String, String) -> IO (String, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"",String
"")